Imported from mainline FSF repositories

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@94600 138bc75d-0d04-0410-961f-82ee72b054a4

152 files changed, 132562 insertions, 0 deletions

diff --git a/gcc/config/dsp16xx/dsp16xx-modes.def b/gcc/config/dsp16xx/dsp16xx-modes.def
new file mode 100644
index 00000000000..968e271ff44
--- /dev/null
+++ b/gcc/config/dsp16xx/dsp16xx-modes.def
@@ -0,0 +1,23 @@
+/* DSP16xx extra modes.
+   Copyright (C) 2003 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* HFmode is the DSP16xx's equivalent of SFmode.
+   FIXME: What format is this anyway? */ 
+FLOAT_MODE (HF, 2, 0);
diff --git a/gcc/config/dsp16xx/dsp16xx-protos.h b/gcc/config/dsp16xx/dsp16xx-protos.h
new file mode 100644
index 00000000000..802c69b62ec
--- /dev/null
+++ b/gcc/config/dsp16xx/dsp16xx-protos.h
@@ -0,0 +1,86 @@
+/* Definitions of target machine for GNU compiler.  AT&T DSP1600.
+   Copyright (C) 2000 Free Software Foundation, Inc.
+   Contributed by Michael Collison (collison@world.std.com).
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifdef RTX_CODE
+extern struct rtx_def *gen_compare_reg (enum rtx_code, rtx, rtx);
+extern int call_address_operand (rtx, enum machine_mode);
+extern int arith_reg_operand (rtx, enum machine_mode);
+extern int symbolic_address_operand (rtx, enum machine_mode);
+extern int Y_address_operand (rtx, enum machine_mode);
+extern int sp_operand (rtx, enum machine_mode);
+extern int sp_operand2 (rtx, enum machine_mode);
+extern int nonmemory_arith_operand (rtx, enum machine_mode);
+extern int dsp16xx_comparison_operator (rtx, enum machine_mode);
+extern int unx_comparison_operator (rtx, enum machine_mode);
+extern int signed_comparison_operator (rtx, enum machine_mode);
+
+extern void notice_update_cc (rtx);
+extern void double_reg_from_memory (rtx[]);
+extern void double_reg_to_memory (rtx[]);
+extern enum rtx_code next_cc_user_code (rtx);
+extern int next_cc_user_unsigned (rtx);
+extern struct rtx_def *gen_tst_reg (rtx);
+extern const char *output_block_move (rtx[]);
+extern enum reg_class preferred_reload_class (rtx, enum reg_class);
+extern enum reg_class secondary_reload_class (enum reg_class,
+					      enum machine_mode, rtx);
+extern int emit_move_sequence (rtx *, enum machine_mode);
+extern void print_operand (FILE *, rtx, int);
+extern void print_operand_address (FILE *, rtx);
+extern void output_dsp16xx_float_const (rtx *);
+extern void emit_1600_core_shift (enum rtx_code, rtx *, int);
+extern int symbolic_address_p (rtx);
+extern int uns_comparison_operator (rtx, enum machine_mode);
+#endif /* RTX_CODE */
+
+
+#ifdef TREE_CODE
+extern struct rtx_def *dsp16xx_function_arg (CUMULATIVE_ARGS,
+					     enum machine_mode,
+					     tree, int);
+extern void dsp16xx_function_arg_advance (CUMULATIVE_ARGS *,
+					  enum machine_mode,
+					  tree, int);
+#endif /* TREE_CODE */
+
+extern void dsp16xx_invalid_register_for_compare (void);
+extern int class_max_nregs (enum reg_class, enum machine_mode);
+extern enum reg_class limit_reload_class (enum reg_class, enum machine_mode);
+extern int dsp16xx_register_move_cost (enum reg_class, enum reg_class);
+extern int dsp16xx_makes_calls (void);
+extern long compute_frame_size (int);
+extern int dsp16xx_call_saved_register (int);
+extern int dsp16xx_call_saved_register (int);
+extern void init_emulation_routines (void);
+extern int ybase_regs_ever_used (void);
+extern void override_options (void);
+extern int dsp16xx_starting_frame_offset (void);
+extern int initial_frame_pointer_offset (void);
+extern void asm_output_common (FILE *, const char *, int, int);
+extern void asm_output_local (FILE *, const char *, int, int);
+extern void asm_output_float (FILE *, double);
+extern bool dsp16xx_compare_gen;
+extern int hard_regno_mode_ok (int, enum machine_mode);
+extern enum reg_class dsp16xx_reg_class_from_letter (int);
+extern int regno_reg_class (int);
+extern void function_prologue (FILE *, int);
+extern void function_epilogue (FILE *, int);
+extern int num_1600_core_shifts (int);
diff --git a/gcc/config/dsp16xx/dsp16xx.c b/gcc/config/dsp16xx/dsp16xx.c
new file mode 100644
index 00000000000..14d9c5e088e
--- /dev/null
+++ b/gcc/config/dsp16xx/dsp16xx.c
@@ -0,0 +1,2632 @@
+/* Subroutines for assembler code output on the DSP1610.
+   Copyright (C) 1994, 1995, 1997, 1998, 2001 Free Software Foundation, Inc.
+   Contributed by Michael Collison (collison@isisinc.net).
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Some output-actions in dsp1600.md need these.  */
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "rtl.h"
+#include "regs.h"
+#include "hard-reg-set.h"
+#include "real.h"
+#include "insn-config.h"
+#include "conditions.h"
+#include "output.h"
+#include "insn-attr.h"
+#include "tree.h"
+#include "expr.h"
+#include "function.h"
+#include "flags.h"
+#include "ggc.h"
+#include "toplev.h"
+#include "recog.h"
+#include "tm_p.h"
+#include "target.h"
+#include "target-def.h"
+
+const char *text_seg_name;
+const char *rsect_text;
+const char *data_seg_name;
+const char *rsect_data;
+const char *bss_seg_name;
+const char *rsect_bss;
+const char *const_seg_name;
+const char *rsect_const;
+
+const char *chip_name;
+const char *save_chip_name;
+
+/* Save the operands of a compare. The 16xx has not lt or gt, so
+   in these cases we swap the operands and reverse the condition.  */
+
+rtx dsp16xx_compare_op0;
+rtx dsp16xx_compare_op1;
+bool dsp16xx_compare_gen;
+
+static const char *fp;
+static const char *sp;
+static const char *rr;
+static const char *a1h;
+
+struct dsp16xx_frame_info current_frame_info;
+struct dsp16xx_frame_info zero_frame_info;
+
+rtx dsp16xx_addhf3_libcall = (rtx) 0;
+rtx dsp16xx_subhf3_libcall = (rtx) 0;
+rtx dsp16xx_mulhf3_libcall = (rtx) 0;
+rtx dsp16xx_divhf3_libcall = (rtx) 0;
+rtx dsp16xx_cmphf3_libcall = (rtx) 0;
+rtx dsp16xx_fixhfhi2_libcall = (rtx) 0;
+rtx dsp16xx_floathihf2_libcall = (rtx) 0;
+rtx dsp16xx_neghf2_libcall = (rtx) 0;
+
+rtx dsp16xx_mulhi3_libcall = (rtx) 0;
+rtx dsp16xx_udivqi3_libcall = (rtx) 0;
+rtx dsp16xx_udivhi3_libcall = (rtx) 0;
+rtx dsp16xx_divqi3_libcall = (rtx) 0;
+rtx dsp16xx_divhi3_libcall = (rtx) 0;
+rtx dsp16xx_modqi3_libcall = (rtx) 0;
+rtx dsp16xx_modhi3_libcall = (rtx) 0;
+rtx dsp16xx_umodqi3_libcall = (rtx) 0;
+rtx dsp16xx_umodhi3_libcall = (rtx) 0;
+rtx dsp16xx_ashrhi3_libcall = (rtx) 0;
+rtx dsp16xx_ashlhi3_libcall = (rtx) 0;
+rtx dsp16xx_ucmphi2_libcall = (rtx) 0;
+rtx dsp16xx_lshrhi3_libcall = (rtx) 0;
+
+static const char *const himode_reg_name[] = HIMODE_REGISTER_NAMES;
+
+#define SHIFT_INDEX_1   0
+#define SHIFT_INDEX_4   1
+#define SHIFT_INDEX_8   2
+#define SHIFT_INDEX_16  3
+
+static const char *const ashift_right_asm[] = 
+{
+  "%0=%0>>1",
+  "%0=%0>>4",
+  "%0=%0>>8",
+  "%0=%0>>16"
+};
+
+static const char *const ashift_right_asm_first[] = 
+{
+  "%0=%1>>1",
+  "%0=%1>>4",
+  "%0=%1>>8",
+  "%0=%1>>16"
+};
+
+static const char *const ashift_left_asm[] = 
+{
+  "%0=%0<<1",
+  "%0=%0<<4",
+  "%0=%0<<8",
+  "%0=%0<<16"
+};
+
+static const char *const ashift_left_asm_first[] = 
+{
+  "%0=%1<<1",
+  "%0=%1<<4",
+  "%0=%1<<8",
+  "%0=%1<<16"
+};
+
+static const char *const lshift_right_asm[] = 
+{
+  "%0=%0>>1\n\t%0=%b0&0x7fff",
+  "%0=%0>>4\n\t%0=%b0&0x0fff",
+  "%0=%0>>8\n\t%0=%b0&0x00ff",
+  "%0=%0>>16\n\t%0=%b0&0x0000"
+};
+
+static const char *const lshift_right_asm_first[] = 
+{
+  "%0=%1>>1\n\t%0=%b0&0x7fff",
+  "%0=%1>>4\n\t%0=%b0&0x0fff",
+  "%0=%1>>8\n\t%0=%b0&0x00ff",
+  "%0=%1>>16\n\t%0=%b0&0x0000"
+};
+
+static int reg_save_size (void);
+static void dsp16xx_output_function_prologue (FILE *, HOST_WIDE_INT);
+static void dsp16xx_output_function_epilogue (FILE *, HOST_WIDE_INT);
+static void dsp16xx_file_start (void);
+static bool dsp16xx_rtx_costs (rtx, int, int, int *);
+static int dsp16xx_address_cost (rtx);
+
+/* Initialize the GCC target structure.  */
+
+#undef TARGET_ASM_BYTE_OP
+#define TARGET_ASM_BYTE_OP "\tint\t"
+#undef TARGET_ASM_ALIGNED_HI_OP
+#define TARGET_ASM_ALIGNED_HI_OP NULL
+#undef TARGET_ASM_ALIGNED_SI_OP
+#define TARGET_ASM_ALIGNED_SI_OP NULL
+
+#undef TARGET_ASM_FUNCTION_PROLOGUE
+#define TARGET_ASM_FUNCTION_PROLOGUE dsp16xx_output_function_prologue
+#undef TARGET_ASM_FUNCTION_EPILOGUE
+#define TARGET_ASM_FUNCTION_EPILOGUE dsp16xx_output_function_epilogue
+
+#undef TARGET_ASM_FILE_START
+#define TARGET_ASM_FILE_START dsp16xx_file_start
+
+#undef TARGET_RTX_COSTS
+#define TARGET_RTX_COSTS dsp16xx_rtx_costs
+#undef TARGET_ADDRESS_COST
+#define TARGET_ADDRESS_COST dsp16xx_address_cost
+
+struct gcc_target targetm = TARGET_INITIALIZER;
+
+int 
+hard_regno_mode_ok (regno, mode)
+     int regno;
+     enum machine_mode mode;
+{
+  switch ((int) mode)
+    {
+    case VOIDmode:
+      return 1;
+      
+      /* We can't use the c0-c2 for QImode, since they are only
+	 8 bits in length.  */
+
+    case QImode:
+      if (regno != REG_C0 && regno != REG_C1 && regno != REG_C2)
+	return 1;
+      else
+	return 0;
+      
+      /* We only allow a0, a1, y, and p to be allocated for 32-bit modes.
+         Additionally we allow the virtual ybase registers to be used for 32-bit
+	 modes.  */
+      
+    case HFmode:
+    case HImode:
+#if 0 /* ??? These modes do not appear in the machine description nor
+         are there library routines for them.  */
+    case SFmode:
+    case DFmode:
+    case XFmode:
+    case SImode:
+    case DImode:
+#endif
+      if (regno == REG_A0 || regno == REG_A1 || regno == REG_Y || regno == REG_PROD
+	  || (IS_YBASE_REGISTER_WINDOW(regno) && ((regno & 1) == 0)))
+	return 1;
+      else
+	return 0;
+      
+    default:
+      return 0;
+    }
+}
+
+enum reg_class
+dsp16xx_reg_class_from_letter (c)
+     int c;
+{
+  switch (c)
+    {
+    case 'A':
+      return ACCUM_REGS;
+
+    case 'l':
+      return A0_REG;
+
+    case 'C':
+      return A1_REG;
+      
+    case 'h':
+      return ACCUM_HIGH_REGS;
+      
+    case 'j':
+      return A0H_REG;
+      
+    case 'k':
+      return A0L_REG;
+      
+    case 'q':
+      return A1H_REG;
+      
+    case 'u':
+      return A1L_REG;
+      
+    case 'x':
+      return X_REG;
+
+    case 'y':
+      return YH_REG;
+
+    case 'z':
+      return YL_REG;
+
+    case 't':
+      return P_REG;
+
+    case 'Z':
+      return Y_OR_P_REGS;
+
+    case 'd':
+      return ACCUM_Y_OR_P_REGS;
+
+    case 'a':
+      return Y_ADDR_REGS;
+
+    case 'B':
+      return (TARGET_BMU ? BMU_REGS : NO_REGS);
+
+    case 'Y':
+      return YBASE_VIRT_REGS;
+
+    case 'v':
+      return PH_REG;
+
+    case 'w':
+      return PL_REG;
+
+    case 'W':
+      return J_REG;
+
+    case 'e':
+      return YBASE_ELIGIBLE_REGS;
+
+    case 'b':
+      return ACCUM_LOW_REGS;
+
+    case 'c':
+      return NON_YBASE_REGS;
+
+    case 'f':
+      return Y_REG;
+
+    case 'D':
+      return SLOW_MEM_LOAD_REGS;
+
+    default:
+      return NO_REGS;
+    }
+}
+
+/* Return the class number of the smallest class containing
+   reg number REGNO.  */
+
+int 
+regno_reg_class(regno)
+     int regno;
+{
+  switch (regno)
+    {
+    case REG_A0L:
+      return (int) A0L_REG;
+    case REG_A1L:
+      return (int) A1L_REG;
+      
+    case REG_A0:
+      return (int) A0H_REG;
+    case REG_A1:
+      return (int) A1H_REG;
+      
+    case REG_X:
+      return (int) X_REG;
+      
+    case REG_Y:
+      return (int) YH_REG;
+    case REG_YL:
+      return (int) YL_REG;
+      
+    case REG_PROD:
+      return (int) PH_REG;
+    case REG_PRODL:
+      return (int) PL_REG;
+      
+    case REG_R0: case REG_R1: case REG_R2: case REG_R3:
+      return (int) Y_ADDR_REGS;
+      
+    case REG_J:
+      return (int) J_REG;
+    case REG_K:
+      return (int) GENERAL_REGS;
+      
+    case REG_YBASE:
+      return (int) GENERAL_REGS;
+      
+    case REG_PT:
+      return (int) GENERAL_REGS;
+      
+    case REG_AR0: case REG_AR1: case REG_AR2: case REG_AR3:
+      return (int) BMU_REGS;
+      
+    case REG_C0: case REG_C1: case REG_C2:
+      return (int) GENERAL_REGS;
+      
+    case REG_PR:
+      return (int) GENERAL_REGS;
+      
+    case REG_RB:
+      return (int) GENERAL_REGS;
+      
+    case REG_YBASE0: case REG_YBASE1: case REG_YBASE2: case REG_YBASE3:
+    case REG_YBASE4: case REG_YBASE5: case REG_YBASE6: case REG_YBASE7:
+    case REG_YBASE8: case REG_YBASE9: case REG_YBASE10: case REG_YBASE11:
+    case REG_YBASE12: case REG_YBASE13: case REG_YBASE14: case REG_YBASE15:
+    case REG_YBASE16: case REG_YBASE17: case REG_YBASE18: case REG_YBASE19:
+    case REG_YBASE20: case REG_YBASE21: case REG_YBASE22: case REG_YBASE23:
+    case REG_YBASE24: case REG_YBASE25: case REG_YBASE26: case REG_YBASE27:
+    case REG_YBASE28: case REG_YBASE29: case REG_YBASE30: case REG_YBASE31:
+      return (int) YBASE_VIRT_REGS;
+      
+    default:
+      return (int) NO_REGS;
+    }
+}
+
+/* A C expression for the maximum number of consecutive registers of class CLASS
+   needed to hold a value of mode MODE.  */
+
+int
+class_max_nregs(class, mode)
+     enum reg_class class ATTRIBUTE_UNUSED;
+     enum machine_mode mode;
+{
+    return (GET_MODE_SIZE(mode));
+}
+
+enum reg_class
+limit_reload_class (mode, class)
+     enum machine_mode mode ATTRIBUTE_UNUSED;
+     enum reg_class class;
+{
+  return class;
+}
+
+int
+dsp16xx_register_move_cost (from, to)
+     enum reg_class from, to;
+{
+  if (from == A0H_REG || from == A0L_REG || from == A0_REG ||
+      from == A1H_REG || from == ACCUM_HIGH_REGS || from == A1L_REG ||
+      from == ACCUM_LOW_REGS || from == A1_REG || from == ACCUM_REGS)
+    {
+      if (to == Y_REG || to == P_REG)
+	return 4;
+      else
+	return 2;
+    }
+
+  if (to == A0H_REG || to == A0L_REG || to == A0_REG ||
+      to == A1H_REG || to == ACCUM_HIGH_REGS || to == A1L_REG ||
+      to == ACCUM_LOW_REGS || to == A1_REG || to == ACCUM_REGS)
+    {
+      return 2;
+    }
+
+  if (from == YBASE_VIRT_REGS)
+    {
+      if (to == YBASE_VIRT_REGS)
+	return 16;
+
+      if (to == X_REG || to == YH_REG || to == YL_REG ||
+	  to == Y_REG || to == PL_REG || to == PH_REG ||
+	  to == P_REG || to == Y_ADDR_REGS || to == YBASE_ELIGIBLE_REGS ||
+	  to == Y_OR_P_REGS)
+	{
+	  return 8;
+	}
+      else
+	return 10;
+    }
+
+  if (to == YBASE_VIRT_REGS)
+    {
+      if (from == X_REG || from == YH_REG || from == YL_REG ||
+	  from == Y_REG || from == PL_REG || from == PH_REG ||
+	  from == P_REG || from == Y_ADDR_REGS || from == YBASE_ELIGIBLE_REGS ||
+	  from == Y_OR_P_REGS)
+	{
+	  return 8;
+	}
+      else
+	return 10;
+    }
+
+  return 8;
+}
+
+/* Given an rtx X being reloaded into a reg required to be
+   in class CLASS, return the class of reg to actually use.
+   In general this is just CLASS; but on some machines
+   in some cases it is preferable to use a more restrictive class.
+   Also, we must ensure that a PLUS is reloaded either
+   into an accumulator or an address register.  */
+
+enum reg_class
+preferred_reload_class (x, class)
+     rtx x;
+     enum reg_class class;
+{
+  /* The ybase registers cannot have constants copied directly
+     to them.  */
+
+  if (CONSTANT_P (x))
+    {
+      switch ((int) class)
+	{
+	case YBASE_VIRT_REGS:
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case ACCUM_LOW_OR_YBASE_REGS:
+	  return ACCUM_LOW_REGS;
+
+	case ACCUM_OR_YBASE_REGS:
+	  return ACCUM_REGS;
+
+	case X_OR_YBASE_REGS:
+	  return X_REG;
+
+	case Y_OR_YBASE_REGS:
+	  return Y_REG;
+
+	case ACCUM_LOW_YL_PL_OR_YBASE_REGS:
+	  return YL_OR_PL_OR_ACCUM_LOW_REGS;
+
+	case P_OR_YBASE_REGS:
+	  return P_REG;
+
+	case ACCUM_Y_P_OR_YBASE_REGS:
+	  return ACCUM_Y_OR_P_REGS;
+
+	case Y_ADDR_OR_YBASE_REGS:
+	  return Y_ADDR_REGS;
+
+	case YBASE_OR_NOHIGH_YBASE_ELIGIBLE_REGS:
+	  return NON_HIGH_YBASE_ELIGIBLE_REGS;;
+	  
+	case YBASE_OR_YBASE_ELIGIBLE_REGS:
+	  return YBASE_ELIGIBLE_REGS;
+
+	case NO_HIGH_ALL_REGS:
+	  return NOHIGH_NON_YBASE_REGS;
+
+	case ALL_REGS:
+	  return NON_YBASE_REGS;
+
+	default:
+	  return class;
+	}
+    }
+
+  /* If x is not an accumulator or a ybase register, restrict the class of registers
+     we can copy the register into.  */
+
+  if (REG_P (x) && !IS_ACCUM_REG (REGNO (x)) && !IS_YBASE_REGISTER_WINDOW (REGNO (x)))
+    {
+      switch ((int) class)
+	{
+	case NO_REGS:
+	case A0H_REG: case A0L_REG: case A0_REG: case A1H_REG:
+	case ACCUM_HIGH_REGS: case A1L_REG: case ACCUM_LOW_REGS: 
+	case A1_REG: case ACCUM_REGS:
+	  return class;
+
+	case X_REG: 
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case X_OR_ACCUM_LOW_REGS: 
+	  return ACCUM_LOW_REGS;
+
+	case X_OR_ACCUM_REGS:
+	  return ACCUM_REGS;
+
+	case YH_REG:
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case YH_OR_ACCUM_HIGH_REGS:
+	  return ACCUM_HIGH_REGS;
+
+	case X_OR_YH_REGS: 
+	case YL_REG:
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case YL_OR_ACCUM_LOW_REGS: 
+	  return ACCUM_LOW_REGS;
+
+	case X_OR_YL_REGS:
+	case X_OR_Y_REGS: case Y_REG:
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case ACCUM_OR_Y_REGS: 
+	  return ACCUM_REGS;
+
+	case PH_REG:
+	case X_OR_PH_REGS: case PL_REG: 
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case PL_OR_ACCUM_LOW_REGS:
+ 	  return ACCUM_LOW_REGS;
+
+	case X_OR_PL_REGS:
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case YL_OR_PL_OR_ACCUM_LOW_REGS: 
+ 	  return ACCUM_LOW_REGS;
+
+	case P_REG:
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case ACCUM_OR_P_REGS: 
+	  return ACCUM_REGS;
+
+	case YL_OR_P_REGS:
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case ACCUM_LOW_OR_YL_OR_P_REGS: 
+ 	  return ACCUM_LOW_REGS;
+
+	case Y_OR_P_REGS:
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case ACCUM_Y_OR_P_REGS: 
+	  return ACCUM_REGS;
+
+	case NO_FRAME_Y_ADDR_REGS:
+	case Y_ADDR_REGS:
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case ACCUM_LOW_OR_Y_ADDR_REGS:
+ 	  return ACCUM_LOW_REGS;
+
+	case ACCUM_OR_Y_ADDR_REGS: 
+	  return ACCUM_REGS;
+
+	case X_OR_Y_ADDR_REGS:
+	case Y_OR_Y_ADDR_REGS: 
+	case P_OR_Y_ADDR_REGS:
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case NON_HIGH_YBASE_ELIGIBLE_REGS: 
+ 	  return ACCUM_LOW_REGS;
+
+	case YBASE_ELIGIBLE_REGS:
+	  return ACCUM_REGS;
+
+	case J_REG:
+	case J_OR_DAU_16_BIT_REGS:
+	case BMU_REGS: 
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case YBASE_VIRT_REGS:
+	  if (IS_YBASE_ELIGIBLE_REG (REGNO (x)))
+	    return class;
+	  else
+	    return (!reload_in_progress ? NO_REGS : class);
+
+	case ACCUM_LOW_OR_YBASE_REGS:
+	  if (IS_YBASE_ELIGIBLE_REG (REGNO (x)))
+	    return class;
+	  else
+	    return ACCUM_LOW_REGS;
+
+	case ACCUM_OR_YBASE_REGS:
+	  if (IS_YBASE_ELIGIBLE_REG (REGNO (x)))
+	    return class;
+	  else
+	    return ACCUM_REGS;
+
+	case X_OR_YBASE_REGS:
+	case Y_OR_YBASE_REGS:
+	  if (IS_YBASE_ELIGIBLE_REG (REGNO (x)))
+	    return YBASE_VIRT_REGS;
+	  else
+	    return (!reload_in_progress ? NO_REGS : class);
+
+	case ACCUM_LOW_YL_PL_OR_YBASE_REGS:
+	  if (IS_YBASE_ELIGIBLE_REG (REGNO (x)))
+	    return ACCUM_LOW_OR_YBASE_REGS;
+	  else
+	    return ACCUM_LOW_REGS;
+
+	case P_OR_YBASE_REGS:
+	  if (IS_YBASE_ELIGIBLE_REG (REGNO (x)))
+	    return YBASE_VIRT_REGS;
+	  else
+	    return (!reload_in_progress ? NO_REGS : class);
+
+	case ACCUM_Y_P_OR_YBASE_REGS:
+	  if (IS_YBASE_ELIGIBLE_REG (REGNO (x)))
+	    return ACCUM_OR_YBASE_REGS;
+	  else
+	    return ACCUM_REGS;
+
+	case Y_ADDR_OR_YBASE_REGS:
+	  if (IS_YBASE_ELIGIBLE_REG (REGNO (x)))
+	    return YBASE_VIRT_REGS;
+	  else
+	    return (!reload_in_progress ? NO_REGS : class);
+
+	case YBASE_OR_NOHIGH_YBASE_ELIGIBLE_REGS:
+	  if (IS_YBASE_ELIGIBLE_REG (REGNO (x)))
+	    return ACCUM_LOW_OR_YBASE_REGS;
+	  else
+	    return ACCUM_LOW_REGS;
+
+	case YBASE_OR_YBASE_ELIGIBLE_REGS:
+	  if (IS_YBASE_ELIGIBLE_REG (REGNO (x)))
+	    return ACCUM_OR_YBASE_REGS;
+	  else
+	    return ACCUM_REGS;
+
+	case NO_HIGH_ALL_REGS:
+	  if (IS_YBASE_ELIGIBLE_REG (REGNO (x)))
+	    return ACCUM_LOW_OR_YBASE_REGS;
+	  else
+	    return ACCUM_LOW_REGS;
+
+	case ALL_REGS: 
+	  if (IS_YBASE_ELIGIBLE_REG (REGNO (x)))
+	    return ACCUM_OR_YBASE_REGS;
+	  else
+	    return ACCUM_REGS;
+
+	case NOHIGH_NON_ADDR_REGS:
+	    return ACCUM_LOW_REGS;
+
+	case NON_ADDR_REGS:
+	case SLOW_MEM_LOAD_REGS:
+	    return ACCUM_REGS;
+
+	case NOHIGH_NON_YBASE_REGS:
+	    return ACCUM_LOW_REGS;
+
+	case NO_ACCUM_NON_YBASE_REGS:
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case NON_YBASE_REGS:
+	    return ACCUM_REGS;
+
+	default:
+	  return class;
+	}
+    }
+
+  /* If x (the input) is a ybase register, restrict the class of registers
+     we can copy the register into.  */
+
+  if (REG_P (x) && !TARGET_RESERVE_YBASE
+      && IS_YBASE_REGISTER_WINDOW (REGNO(x)))
+    {
+      switch ((int) class)
+	{
+	case NO_REGS:
+	case A0H_REG: case A0L_REG: case A0_REG: case A1H_REG:
+	case ACCUM_HIGH_REGS: case A1L_REG: case ACCUM_LOW_REGS: 
+	case A1_REG: case ACCUM_REGS: case X_REG: 
+	case X_OR_ACCUM_LOW_REGS: case X_OR_ACCUM_REGS:
+	case YH_REG: case YH_OR_ACCUM_HIGH_REGS:
+	case X_OR_YH_REGS: case YL_REG:
+	case YL_OR_ACCUM_LOW_REGS: case X_OR_YL_REGS:
+	case X_OR_Y_REGS: case Y_REG:
+	case ACCUM_OR_Y_REGS: case PH_REG:
+	case X_OR_PH_REGS: case PL_REG: 
+	case PL_OR_ACCUM_LOW_REGS: case X_OR_PL_REGS:
+	case YL_OR_PL_OR_ACCUM_LOW_REGS: case P_REG:
+	case ACCUM_OR_P_REGS: case YL_OR_P_REGS:
+	case ACCUM_LOW_OR_YL_OR_P_REGS: case Y_OR_P_REGS:
+	case ACCUM_Y_OR_P_REGS: case NO_FRAME_Y_ADDR_REGS:
+	case Y_ADDR_REGS: case ACCUM_LOW_OR_Y_ADDR_REGS:
+	case ACCUM_OR_Y_ADDR_REGS: case X_OR_Y_ADDR_REGS:
+	case Y_OR_Y_ADDR_REGS: case P_OR_Y_ADDR_REGS:
+	case NON_HIGH_YBASE_ELIGIBLE_REGS: case YBASE_ELIGIBLE_REGS:
+	default:
+	  return class;
+
+	case J_REG:
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case J_OR_DAU_16_BIT_REGS:
+	  return ACCUM_HIGH_REGS;
+
+	case BMU_REGS: 
+	case YBASE_VIRT_REGS:
+	  return (!reload_in_progress ? NO_REGS : class);
+
+	case ACCUM_LOW_OR_YBASE_REGS:
+	  return ACCUM_LOW_REGS;
+
+	case ACCUM_OR_YBASE_REGS:
+	  return ACCUM_REGS;
+
+	case X_OR_YBASE_REGS:
+	  return X_REG;
+
+	case Y_OR_YBASE_REGS:
+	  return Y_REG;
+
+	case ACCUM_LOW_YL_PL_OR_YBASE_REGS:
+	  return YL_OR_PL_OR_ACCUM_LOW_REGS; 
+
+	case P_OR_YBASE_REGS:
+	  return P_REG;
+
+	case ACCUM_Y_P_OR_YBASE_REGS:
+	  return ACCUM_Y_OR_P_REGS;
+
+	case Y_ADDR_OR_YBASE_REGS:
+	  return Y_ADDR_REGS;
+
+	case YBASE_OR_NOHIGH_YBASE_ELIGIBLE_REGS:
+	  return NON_HIGH_YBASE_ELIGIBLE_REGS;
+
+	case YBASE_OR_YBASE_ELIGIBLE_REGS:
+	  return YBASE_ELIGIBLE_REGS;
+
+	case NO_HIGH_ALL_REGS:
+	  return NON_HIGH_YBASE_ELIGIBLE_REGS;
+
+	case ALL_REGS: 
+	  return YBASE_ELIGIBLE_REGS;
+
+	case NOHIGH_NON_ADDR_REGS:
+	  return ACCUM_LOW_OR_YL_OR_P_REGS;
+
+	case NON_ADDR_REGS:
+	  return ACCUM_Y_OR_P_REGS;
+
+	case SLOW_MEM_LOAD_REGS:
+	  return ACCUM_OR_Y_ADDR_REGS;
+
+	case NOHIGH_NON_YBASE_REGS:
+    	  return NON_HIGH_YBASE_ELIGIBLE_REGS;
+
+    	case NO_ACCUM_NON_YBASE_REGS:
+	  return Y_ADDR_REGS;
+
+    	case NON_YBASE_REGS:
+	  return YBASE_ELIGIBLE_REGS;
+	}
+    }
+
+  if (GET_CODE (x) == PLUS)
+    {
+      if (GET_MODE (x) == QImode
+	  && REG_P (XEXP (x,0))
+	  && (XEXP (x,0) == frame_pointer_rtx
+	      || XEXP (x,0) == stack_pointer_rtx)
+	  && (GET_CODE (XEXP (x,1)) == CONST_INT))
+	{
+	  if (class == ACCUM_HIGH_REGS)
+	    return class;
+
+	  /* If the accumulators are not part of the class
+	     being reloaded into, return NO_REGS.  */
+#if 0
+	  if (!reg_class_subset_p (ACCUM_REGS, class))
+	    return (!reload_in_progress ? NO_REGS : class);
+#endif
+	  if (reg_class_subset_p (ACCUM_HIGH_REGS, class))
+	    return ACCUM_HIGH_REGS;
+
+	  /* We will use accumulator 'a1l' for reloading a
+	     PLUS.  We can only use one accumulator because
+	     'reload_inqi' only allows one alternative to be
+	     used.  */
+
+	  else if (class == ACCUM_LOW_REGS)
+	    return A1L_REG;
+	  else if (class == A0L_REG)
+	    return NO_REGS;
+	  else
+	    return class;
+	}
+
+      if (class == NON_YBASE_REGS || class == YBASE_ELIGIBLE_REGS)
+	return Y_ADDR_REGS;
+      else
+	return class;
+    }
+  else if (GET_CODE (x) == MEM)
+    {
+      /* We can't copy from a memory location into a
+	 ybase register.  */
+      if (reg_class_subset_p(YBASE_VIRT_REGS, class))
+	{
+	  switch ((int) class)
+	    {
+	    case YBASE_VIRT_REGS:
+	      return (!reload_in_progress ? NO_REGS : class);
+
+	    case ACCUM_LOW_OR_YBASE_REGS:
+	      return ACCUM_LOW_REGS;
+
+	    case ACCUM_OR_YBASE_REGS:
+	      return ACCUM_REGS;
+
+	    case X_OR_YBASE_REGS:
+	      return X_REG;
+
+	    case Y_OR_YBASE_REGS:
+	      return Y_REG;
+
+	    case ACCUM_LOW_YL_PL_OR_YBASE_REGS:
+	      return YL_OR_PL_OR_ACCUM_LOW_REGS;
+
+	    case P_OR_YBASE_REGS:
+	      return P_REG;
+
+	    case ACCUM_Y_P_OR_YBASE_REGS:
+	      return ACCUM_Y_OR_P_REGS;
+
+	    case Y_ADDR_OR_YBASE_REGS:
+	      return Y_ADDR_REGS;
+
+	    case YBASE_OR_NOHIGH_YBASE_ELIGIBLE_REGS:
+	      return NON_HIGH_YBASE_ELIGIBLE_REGS;
+	  
+	    case YBASE_OR_YBASE_ELIGIBLE_REGS:
+	      return YBASE_ELIGIBLE_REGS;
+
+	    case NO_HIGH_ALL_REGS:
+	      return NOHIGH_NON_YBASE_REGS;
+
+	    case ALL_REGS:
+	      return NON_YBASE_REGS;
+
+	    default:
+	      return class;
+	    }
+	}
+      else
+	return class;
+    }
+  else
+    return class;
+}
+	
+/* Return the register class of a scratch register needed to copy IN into
+   or out of a register in CLASS in MODE.  If it can be done directly,
+   NO_REGS is returned.  */
+
+enum reg_class
+secondary_reload_class (class, mode, in)
+     enum reg_class class;
+     enum machine_mode mode;
+     rtx in;
+{
+  int regno = -1;
+
+  if (GET_CODE (in) == REG || GET_CODE (in) == SUBREG)
+    regno = true_regnum (in);
+
+  /* If we are reloading a plus into a high accumulator register,
+     we need a scratch low accumulator, because the low half gets
+     clobbered.  */
+
+  if (class == ACCUM_HIGH_REGS 
+      || class == A1H_REG
+      || class == A0H_REG)
+    {
+      if (GET_CODE (in) == PLUS && mode == QImode)
+	return ACCUM_LOW_REGS;
+    }
+
+  if (class == ACCUM_HIGH_REGS 
+      || class == ACCUM_LOW_REGS
+      || class == A1L_REG
+      || class == A0L_REG
+      || class == A1H_REG
+      || class == A0H_REG)
+    {
+      if (GET_CODE (in) == PLUS && mode == QImode)
+	{
+	  rtx addr0 = XEXP (in, 0);
+	  rtx addr1 = XEXP (in, 1);
+	  
+	  /* If we are reloading a plus (reg:QI) (reg:QI)
+	     we need an additional register.  */ 
+	  if (REG_P (addr0) && REG_P (addr1))
+	    return NO_REGS;
+	}
+    }
+
+  /* We can place anything into ACCUM_REGS and can put ACCUM_REGS
+     into anything.  */
+
+  if ((class == ACCUM_REGS || class == ACCUM_HIGH_REGS ||
+       class == ACCUM_LOW_REGS || class == A0H_REG || class == A0L_REG ||
+       class == A1H_REG || class == A1_REG) || 
+      (regno >= REG_A0 && regno < REG_A1L + 1))
+    return NO_REGS;
+
+  if (class == ACCUM_OR_YBASE_REGS && REG_P(in)
+      && IS_YBASE_ELIGIBLE_REG(regno))
+    {
+      return NO_REGS;
+    }
+
+  /* We can copy the ybase registers into:
+     r0-r3, a0-a1, y, p, & x or the union of
+     any of these.  */
+
+  if (!TARGET_RESERVE_YBASE && IS_YBASE_REGISTER_WINDOW(regno))
+    {
+      switch ((int) class)
+	{
+	case (int) X_REG:
+	case (int) X_OR_ACCUM_LOW_REGS:
+	case (int) X_OR_ACCUM_REGS:
+	case (int) YH_REG:
+	case (int) YH_OR_ACCUM_HIGH_REGS:
+	case (int) X_OR_YH_REGS:
+	case (int) YL_REG:
+	case (int) YL_OR_ACCUM_LOW_REGS:
+	case (int) X_OR_Y_REGS:
+	case (int) X_OR_YL_REGS:
+	case (int) Y_REG:
+	case (int) ACCUM_OR_Y_REGS:
+	case (int) PH_REG:
+	case (int) X_OR_PH_REGS:
+	case (int) PL_REG:
+	case (int) PL_OR_ACCUM_LOW_REGS:
+	case (int) X_OR_PL_REGS:
+	case (int) YL_OR_PL_OR_ACCUM_LOW_REGS:
+	case (int) P_REG:
+	case (int) ACCUM_OR_P_REGS:
+	case (int) YL_OR_P_REGS:
+	case (int) ACCUM_LOW_OR_YL_OR_P_REGS:
+	case (int) Y_OR_P_REGS:
+	case (int) ACCUM_Y_OR_P_REGS:
+	case (int) Y_ADDR_REGS:
+	case (int) ACCUM_LOW_OR_Y_ADDR_REGS:
+	case (int) ACCUM_OR_Y_ADDR_REGS:
+	case (int) X_OR_Y_ADDR_REGS:
+	case (int) Y_OR_Y_ADDR_REGS:
+	case (int) P_OR_Y_ADDR_REGS:
+	case (int) YBASE_ELIGIBLE_REGS:
+	  return NO_REGS;
+
+	default:
+	  return ACCUM_HIGH_REGS;
+	}
+    }
+
+  /* We can copy r0-r3, a0-a1, y, & p
+     directly to the ybase registers. In addition
+     we can use any of the ybase virtual registers
+     as the secondary reload registers when copying
+     between any of these registers.  */
+
+  if (!TARGET_RESERVE_YBASE && regno != -1)
+    {
+      switch (regno)
+	{
+	case REG_A0:
+	case REG_A0L:
+	case REG_A1:
+	case REG_A1L:
+	case REG_X:
+	case REG_Y:
+	case REG_YL:
+	case REG_PROD:
+	case REG_PRODL:
+	case REG_R0:
+	case REG_R1:
+	case REG_R2:
+	case REG_R3:
+	  if (class == YBASE_VIRT_REGS)
+	    return NO_REGS;
+	  else
+	    {
+	      switch ((int) class)
+		{
+		case (int) X_REG:
+		case (int) X_OR_ACCUM_LOW_REGS:
+		case (int) X_OR_ACCUM_REGS:
+		case (int) YH_REG:
+		case (int) YH_OR_ACCUM_HIGH_REGS:
+		case (int) X_OR_YH_REGS:
+		case (int) YL_REG:
+		case (int) YL_OR_ACCUM_LOW_REGS:
+		case (int) X_OR_Y_REGS:
+		case (int) X_OR_YL_REGS:
+		case (int) Y_REG:
+		case (int) ACCUM_OR_Y_REGS:
+		case (int) PH_REG:
+		case (int) X_OR_PH_REGS:
+		case (int) PL_REG:
+		case (int) PL_OR_ACCUM_LOW_REGS:
+		case (int) X_OR_PL_REGS:
+		case (int) YL_OR_PL_OR_ACCUM_LOW_REGS:
+		case (int) P_REG:
+		case (int) ACCUM_OR_P_REGS:
+		case (int) YL_OR_P_REGS:
+		case (int) ACCUM_LOW_OR_YL_OR_P_REGS:
+		case (int) Y_OR_P_REGS:
+		case (int) ACCUM_Y_OR_P_REGS:
+		case (int) Y_ADDR_REGS:
+		case (int) ACCUM_LOW_OR_Y_ADDR_REGS:
+		case (int) ACCUM_OR_Y_ADDR_REGS:
+		case (int) X_OR_Y_ADDR_REGS:
+		case (int) Y_OR_Y_ADDR_REGS:
+		case (int) P_OR_Y_ADDR_REGS:
+		case (int) YBASE_ELIGIBLE_REGS:
+		  return YBASE_VIRT_REGS;
+
+		default:
+		  break;
+		}
+	    }
+	}
+    }
+
+  /* Memory or constants can be moved from or to any register
+     except the ybase virtual registers.  */
+  if (regno == -1 && GET_CODE(in) != PLUS)
+    {
+      if (class == YBASE_VIRT_REGS)
+	return NON_YBASE_REGS;
+      else
+        return NO_REGS;
+    }
+
+  if (GET_CODE (in) == PLUS && mode == QImode)
+    {
+      rtx addr0 = XEXP (in, 0);
+      rtx addr1 = XEXP (in, 1);
+
+      /* If we are reloading a plus (reg:QI) (reg:QI)
+	 we need a low accumulator, not a high one.  */
+      if (REG_P (addr0) && REG_P (addr1))
+	return ACCUM_LOW_REGS;
+    }
+
+#if 0
+  if (REG_P(in))
+    return ACCUM_REGS;
+#endif
+
+  /* Otherwise, we need a high accumulator(s).  */
+  return ACCUM_HIGH_REGS;
+}
+
+int
+symbolic_address_operand (op, mode)
+     rtx op;
+     enum machine_mode mode ATTRIBUTE_UNUSED;
+{
+  return (symbolic_address_p (op));
+}
+
+int
+symbolic_address_p (op)
+     rtx op;
+{
+  switch (GET_CODE (op))
+    {
+    case SYMBOL_REF:
+    case LABEL_REF:
+      return 1;
+
+    case CONST:
+      op = XEXP (op, 0);
+      return ((GET_CODE (XEXP (op, 0)) == SYMBOL_REF
+	       || GET_CODE (XEXP (op, 0)) == LABEL_REF)
+	      && GET_CODE (XEXP (op, 1)) == CONST_INT
+              && INTVAL (XEXP (op,1)) < 0x20);
+
+    default:
+      return 0;
+    }
+}
+
+/* For a Y address space operand we allow only *rn, *rn++, *rn--.
+   This routine only recognizes *rn, the '<>' constraints recognize
+   (*rn++), and (*rn--).  */
+
+int
+Y_address_operand (op, mode)
+     rtx op;
+     enum machine_mode mode;
+{
+  return (memory_address_p (mode, op) && !symbolic_address_p (op));
+}	     
+
+int
+sp_operand (op, mode)
+     rtx op;
+     enum machine_mode mode ATTRIBUTE_UNUSED;
+{
+    return (GET_CODE (op) == PLUS
+	    && (XEXP (op, 0) == stack_pointer_rtx
+		|| XEXP (op, 0) == frame_pointer_rtx)
+	    && GET_CODE (XEXP (op,1)) == CONST_INT);
+}
+
+int
+sp_operand2 (op, mode)
+     rtx op;
+     enum machine_mode mode ATTRIBUTE_UNUSED;
+{
+  if ((GET_CODE (op) == PLUS 
+       && (XEXP (op, 0) == stack_pointer_rtx
+	   || XEXP (op, 0) == frame_pointer_rtx)
+       && (REG_P (XEXP (op,1))
+	   && IS_ADDRESS_REGISTER (REGNO (XEXP(op, 1))))))
+    return 1;
+  else if ((GET_CODE (op) == PLUS
+       && (XEXP (op, 1) == stack_pointer_rtx
+	   || XEXP (op, 1) == frame_pointer_rtx)
+       && (REG_P (XEXP (op,0))
+	   && IS_ADDRESS_REGISTER (REGNO (XEXP(op, 1))))))
+    return 1;
+  else
+    return 0;
+}
+
+int
+nonmemory_arith_operand (op, mode)
+     rtx op;
+     enum machine_mode mode;
+{
+  return (immediate_operand (op, mode) || arith_reg_operand (op, mode));
+}
+
+int
+arith_reg_operand (op, mode)
+     rtx op;
+     enum machine_mode mode;
+{
+  return (register_operand (op, mode)
+	  && (GET_CODE (op) != REG
+	      || REGNO (op) >= FIRST_PSEUDO_REGISTER
+	      || (!(IS_YBASE_REGISTER_WINDOW (REGNO (op)))
+		  && REGNO (op) != FRAME_POINTER_REGNUM)));
+}
+
+int
+call_address_operand (op, mode)
+     rtx op;
+     enum machine_mode mode ATTRIBUTE_UNUSED;
+{
+    if (symbolic_address_p (op) || REG_P(op))
+    {
+	return 1;
+    }
+
+    return 0;
+}
+
+int
+dsp16xx_comparison_operator (op, mode)
+    register rtx op;
+    enum machine_mode mode;
+{
+  return ((mode == VOIDmode || GET_MODE (op) == mode)
+	  && GET_RTX_CLASS (GET_CODE (op)) == '<'
+	  && (GET_CODE(op) != GE && GET_CODE (op) != LT &&
+	      GET_CODE (op) != GEU && GET_CODE (op) != LTU));
+}
+
+void
+notice_update_cc(exp)
+     rtx exp;
+{
+    if (GET_CODE (exp) == SET)
+    {
+	/* Jumps do not alter the cc's.  */
+
+	if (SET_DEST (exp) == pc_rtx)
+	    return;
+
+	/* Moving register or memory into a register:
+	   it doesn't alter the cc's, but it might invalidate
+	   the RTX's which we remember the cc's came from.
+	   (Note that moving a constant 0 or 1 MAY set the cc's).  */
+	if (REG_P (SET_DEST (exp))
+	    && (REG_P (SET_SRC (exp)) || GET_CODE (SET_SRC (exp)) == MEM))
+	{
+	    if (cc_status.value1
+		&& reg_overlap_mentioned_p (SET_DEST (exp), cc_status.value1))
+		cc_status.value1 = 0;
+	    if (cc_status.value2
+		&& reg_overlap_mentioned_p (SET_DEST (exp), cc_status.value2))
+		cc_status.value2 = 0;
+	    return;
+	}
+	/* Moving register into memory doesn't alter the cc's.
+	   It may invalidate the RTX's which we remember the cc's came from.  */
+	if (GET_CODE (SET_DEST (exp)) == MEM && REG_P (SET_SRC (exp)))
+	{
+	    if (cc_status.value1 && GET_CODE (cc_status.value1) == MEM)
+		cc_status.value1 = 0;
+	    if (cc_status.value2 && GET_CODE (cc_status.value2) == MEM)
+		cc_status.value2 = 0;
+	    return;
+	}
+	/* Function calls clobber the cc's.  */
+	else if (GET_CODE (SET_SRC (exp)) == CALL)
+	{
+	    CC_STATUS_INIT;
+	    return;
+	}
+	/* Tests and compares set the cc's in predictable ways.  */
+	else if (SET_DEST (exp) == cc0_rtx)
+	{
+	    CC_STATUS_INIT;
+	    cc_status.value1 = SET_SRC (exp);
+	    return;
+	}
+	/* Certain instructions effect the condition codes.  */
+	else if (GET_MODE_CLASS (GET_MODE (SET_SRC (exp))) == MODE_INT)
+	    switch (GET_CODE (SET_SRC (exp)))
+	    {
+	    case PLUS: 
+	    case MINUS:
+	      if (REG_P (SET_DEST (exp)))
+		{
+		  /* Address registers don't set the condition codes.  */
+		  if (IS_ADDRESS_REGISTER (REGNO (SET_DEST (exp))))
+		    {
+		      CC_STATUS_INIT;
+		      break;
+		    }
+		}
+	    case ASHIFTRT: 
+	    case LSHIFTRT:
+	    case ASHIFT: 
+	    case AND: 
+	    case IOR: 
+	    case XOR:
+	    case MULT:
+	    case NEG:
+	    case NOT:
+	      cc_status.value1 = SET_SRC (exp);
+	      cc_status.value2 = SET_DEST (exp);
+	      break;
+	      
+	    default:
+	      CC_STATUS_INIT;
+	    }
+	else
+	{
+	    CC_STATUS_INIT;
+	}
+    }
+    else if (GET_CODE (exp) == PARALLEL
+	     && GET_CODE (XVECEXP (exp, 0, 0)) == SET)
+    {
+	if (SET_DEST (XVECEXP (exp, 0, 0)) == pc_rtx)
+	    return;
+
+	if (SET_DEST (XVECEXP (exp, 0, 0)) == cc0_rtx)
+	{
+	    CC_STATUS_INIT;
+	    cc_status.value1 = SET_SRC (XVECEXP (exp, 0, 0));
+	    return;
+	}
+
+	CC_STATUS_INIT;
+    }
+    else
+    {
+	CC_STATUS_INIT;
+    }
+}
+
+int
+dsp16xx_makes_calls ()
+{
+  rtx insn;
+
+  for (insn = get_insns (); insn; insn = next_insn (insn))
+    if (GET_CODE (insn) == CALL_INSN)
+      return (1);
+
+  return 0;
+}
+
+long
+compute_frame_size (size)
+     int size;
+{
+  long total_size;
+  long var_size;
+  long args_size;
+  long extra_size;
+  long reg_size;
+
+  /* This value is needed to compute reg_size.  */
+  current_frame_info.function_makes_calls = !leaf_function_p ();
+
+  reg_size = 0;
+  extra_size = 0;
+  var_size = size;
+  args_size = current_function_outgoing_args_size;
+  reg_size = reg_save_size ();  
+
+  total_size = var_size + args_size + extra_size + reg_size;
+
+
+  /* Save other computed information.  */
+  current_frame_info.total_size  = total_size;
+  current_frame_info.var_size    = var_size;
+  current_frame_info.args_size   = args_size;
+  current_frame_info.extra_size  = extra_size;
+  current_frame_info.reg_size    = reg_size;
+  current_frame_info.initialized = reload_completed;
+  current_frame_info.reg_size	 = reg_size / UNITS_PER_WORD;
+
+  if (reg_size)
+    {
+      unsigned long offset = args_size + var_size + reg_size;
+      current_frame_info.sp_save_offset = offset;
+      current_frame_info.fp_save_offset = offset - total_size;
+    }
+
+  return total_size;
+}
+
+int
+dsp16xx_call_saved_register (regno)
+     int regno;
+{
+#if 0
+  if (regno == REG_PR && current_frame_info.function_makes_calls)
+    return 1;
+#endif
+  return (regs_ever_live[regno] && !call_used_regs[regno] &&
+	  !IS_YBASE_REGISTER_WINDOW(regno));
+}
+
+int
+ybase_regs_ever_used ()
+{
+  int regno;
+  int live = 0;
+
+  for (regno = REG_YBASE0; regno <= REG_YBASE31; regno++)
+    if (regs_ever_live[regno])
+      {
+	live = 1;
+	break;
+      }
+
+  return live;
+}
+
+static void 
+dsp16xx_output_function_prologue (file, size)
+     FILE *file;
+     HOST_WIDE_INT size;
+{
+  int regno;
+  long total_size;
+  fp = reg_names[FRAME_POINTER_REGNUM];
+  sp = reg_names[STACK_POINTER_REGNUM];
+  rr = reg_names[RETURN_ADDRESS_REGNUM];   /* return address register */
+  a1h = reg_names[REG_A1];
+  
+  total_size = compute_frame_size (size);
+  
+  fprintf (file, "\t/* FUNCTION PROLOGUE: */\n");
+  fprintf (file, "\t/* total=%ld, vars= %ld, regs= %d, args=%d, extra= %ld */\n",
+	   current_frame_info.total_size,
+	   current_frame_info.var_size,
+	   current_frame_info.reg_size,
+	   current_function_outgoing_args_size,
+	   current_frame_info.extra_size);
+  
+  fprintf (file, "\t/* fp save offset= %ld, sp save_offset= %ld */\n\n",
+	   current_frame_info.fp_save_offset,
+	   current_frame_info.sp_save_offset);
+  /* Set up the 'ybase' register window.  */
+  
+  if (ybase_regs_ever_used())
+    {
+      fprintf (file, "\t%s=%s\n", a1h, reg_names[REG_YBASE]);
+      if (TARGET_YBASE_HIGH)
+	fprintf (file, "\t%s=%sh-32\n", reg_names[REG_A1], a1h);
+      else
+	fprintf (file, "\t%s=%sh+32\n", reg_names[REG_A1], a1h);
+      fprintf (file, "\t%s=%s\n", reg_names[REG_YBASE], a1h);
+    }
+  
+  if (current_frame_info.var_size)
+    {
+      if (current_frame_info.var_size == 1)
+	fprintf (file, "\t*%s++\n", sp);
+      else
+        {
+	  if (SMALL_INTVAL(current_frame_info.var_size) && ((current_frame_info.var_size & 0x8000) == 0))
+	    fprintf (file, "\t%s=%ld\n\t*%s++%s\n", reg_names[REG_J], current_frame_info.var_size, sp, reg_names[REG_J]);
+	  else
+	    fatal_error ("stack size > 32k");
+	}
+    }
+  
+  /* Save any registers this function uses, unless they are
+     used in a call, in which case we don't need to.  */
+  
+  for(regno = 0; regno < FIRST_PSEUDO_REGISTER; ++ regno)
+    if (dsp16xx_call_saved_register (regno)) 
+      {
+	fprintf (file, "\tpush(*%s)=%s\n", sp, reg_names[regno]);
+      }
+
+  /* For debugging purposes, we want the return address to be at a predictable
+     location.  */
+  if (current_frame_info.function_makes_calls)
+    fprintf (file, "\tpush(*%s)=%s\n", sp, reg_names[RETURN_ADDRESS_REGNUM]);
+
+  if (current_frame_info.args_size)
+    {
+      if (current_frame_info.args_size == 1)
+	fprintf (file, "\t*%s++\n", sp);
+      else
+	error ("stack size > 32k");
+    }
+   
+  if (frame_pointer_needed)
+    {
+      fprintf (file, "\t%s=%s\n", a1h, sp);
+      fprintf (file, "\t%s=%s\n", fp, a1h);  /* Establish new base frame */
+      fprintf (file, "\t%s=%ld\n", reg_names[REG_J], -total_size);
+      fprintf (file, "\t*%s++%s\n", fp, reg_names[REG_J]);
+    }
+  
+  fprintf (file, "\t/* END FUNCTION PROLOGUE: */\n\n");
+}
+
+void
+init_emulation_routines ()
+{
+ dsp16xx_addhf3_libcall = (rtx) 0;
+ dsp16xx_subhf3_libcall = (rtx) 0;
+ dsp16xx_mulhf3_libcall = (rtx) 0;
+ dsp16xx_divhf3_libcall = (rtx) 0;
+ dsp16xx_cmphf3_libcall = (rtx) 0;
+ dsp16xx_fixhfhi2_libcall = (rtx) 0;
+ dsp16xx_floathihf2_libcall = (rtx) 0;
+ dsp16xx_neghf2_libcall = (rtx) 0;
+
+ dsp16xx_mulhi3_libcall = (rtx) 0;
+ dsp16xx_udivqi3_libcall = (rtx) 0;
+ dsp16xx_udivhi3_libcall = (rtx) 0;
+ dsp16xx_divqi3_libcall = (rtx) 0;
+ dsp16xx_divhi3_libcall = (rtx) 0;
+ dsp16xx_modqi3_libcall = (rtx) 0;
+ dsp16xx_modhi3_libcall = (rtx) 0;
+ dsp16xx_umodqi3_libcall = (rtx) 0;
+ dsp16xx_umodhi3_libcall = (rtx) 0;
+ dsp16xx_ashrhi3_libcall = (rtx) 0;
+ dsp16xx_ashlhi3_libcall = (rtx) 0;
+ dsp16xx_ucmphi2_libcall = (rtx) 0;
+ dsp16xx_lshrhi3_libcall = (rtx) 0;
+
+}
+static void
+dsp16xx_output_function_epilogue (file, size)
+     FILE *file;
+     HOST_WIDE_INT size ATTRIBUTE_UNUSED;
+{
+  int regno;
+  
+  fp = reg_names[FRAME_POINTER_REGNUM];
+  sp = reg_names[STACK_POINTER_REGNUM];
+  rr = reg_names[RETURN_ADDRESS_REGNUM];   /* return address register */
+  a1h = reg_names[REG_A1];
+  
+  fprintf (file, "\n\t/* FUNCTION EPILOGUE: */\n");
+  
+  if (current_frame_info.args_size)
+    {
+      if (current_frame_info.args_size == 1)
+	fprintf (file, "\t*%s--\n", sp);
+      else
+	{
+	  fprintf (file, "\t%s=%ld\n\t*%s++%s\n", 
+		   reg_names[REG_J], -current_frame_info.args_size, sp, reg_names[REG_J]);
+	}
+    }
+  
+  if (ybase_regs_ever_used())
+    {
+      fprintf (file, "\t%s=%s\n", a1h, reg_names[REG_YBASE]);
+      if (TARGET_YBASE_HIGH)
+	fprintf (file, "\t%s=%sh+32\n", reg_names[REG_A1], a1h);
+      else
+	fprintf (file, "\t%s=%sh-32\n", reg_names[REG_A1], a1h);
+      fprintf (file, "\t%s=%s\n", reg_names[REG_YBASE], a1h);
+    }
+
+  if (current_frame_info.function_makes_calls)
+    fprintf (file, "\t%s=pop(*%s)\n", reg_names[RETURN_ADDRESS_REGNUM], sp);
+  
+  for (regno = FIRST_PSEUDO_REGISTER - 1; regno >= 0; --regno)
+    if (dsp16xx_call_saved_register(regno))
+      {
+	fprintf (file, "\t%s=pop(*%s)\n", reg_names[regno], sp);
+      }
+  
+  if (current_frame_info.var_size)
+    {
+      if (current_frame_info.var_size == 1)
+	fprintf (file, "\t*%s--\n", sp);
+      else
+	{
+	  fprintf (file, "\t%s=%ld\n\t*%s++%s\n", 
+		   reg_names[REG_J], -current_frame_info.var_size, sp, reg_names[REG_J]);
+	}
+    }
+  
+  fprintf (file, "\treturn\n");
+  /* Reset the frame info for the next function.  */
+  current_frame_info = zero_frame_info;
+  init_emulation_routines ();
+}
+
+/* Emit insns to move operands[1] into operands[0].
+
+   Return 1 if we have written out everything that needs to be done to
+   do the move.  Otherwise, return 0 and the caller will emit the move
+   normally.  */
+
+int
+emit_move_sequence (operands, mode)
+     rtx *operands;
+     enum machine_mode mode;
+{
+  register rtx operand0 = operands[0];
+  register rtx operand1 = operands[1];
+
+  /* We can only store registers to memory.  */
+
+  if (GET_CODE (operand0) == MEM && GET_CODE (operand1) != REG)
+    operands[1] = force_reg (mode, operand1);
+
+  return 0;
+}
+
+void
+double_reg_from_memory (operands)
+     rtx operands[];
+{
+    rtx xoperands[4];
+
+    if (GET_CODE(XEXP(operands[1],0)) == POST_INC)
+    {
+	output_asm_insn ("%u0=%1", operands);
+	output_asm_insn ("%w0=%1", operands);
+    }
+    else if (GET_CODE(XEXP(operands[1],0)) == POST_DEC)
+    {
+	xoperands[1] = XEXP (XEXP (operands[1], 0), 0);
+	xoperands[0] = operands[0];
+	
+	/* We can't use j anymore since the compiler can allocate it.  */
+/*	output_asm_insn ("j=-3\n\t%u0=*%1++\n\t%w0=*%1++j", xoperands); */
+	output_asm_insn ("%u0=*%1++\n\t%w0=*%1--\n\t*%1--\n\t*%1--", xoperands);
+    }
+    else if (GET_CODE(XEXP(operands[1],0)) == PLUS)
+    {
+      rtx addr;
+      int offset = 0;
+
+      output_asm_insn ("%u0=%1", operands);
+
+
+      /* In order to print out the least significant word we must
+	 use 'offset + 1'.  */
+      addr = XEXP (operands[1], 0);
+      if (GET_CODE (XEXP(addr,0)) == CONST_INT)
+	offset = INTVAL(XEXP(addr,0)) + 1;
+      else if (GET_CODE (XEXP(addr,1)) == CONST_INT)
+	offset = INTVAL(XEXP(addr,1)) + 1;
+
+      fprintf (asm_out_file, "\t%s=*(%d)\n", reg_names[REGNO(operands[0]) + 1], offset + 31);
+    }
+    else
+    {
+	xoperands[1] = XEXP(operands[1],0);
+	xoperands[0] = operands[0];
+
+	output_asm_insn ("%u0=*%1++\n\t%w0=*%1--", xoperands);
+    }
+}
+
+
+void
+double_reg_to_memory (operands)
+     rtx operands[];
+{
+    rtx xoperands[4];
+
+    if (GET_CODE(XEXP(operands[0],0)) == POST_INC)
+    {
+	output_asm_insn ("%0=%u1", operands);
+	output_asm_insn ("%0=%w1", operands);
+    }
+    else if (GET_CODE(XEXP(operands[0],0)) == POST_DEC)
+    {
+	xoperands[0] = XEXP (XEXP (operands[0], 0), 0);
+	xoperands[1] = operands[1];
+	
+	/* We can't use j anymore since the compiler can allocate it.  */
+
+/*	output_asm_insn ("j=-3\n\t*%0++=%u1\n\t*%0++j=%w1", xoperands); */
+	output_asm_insn ("*%0++=%u1\n\t*%0--=%w1\n\t*%0--\n\t*%0--", xoperands);
+
+    }
+    else if (GET_CODE(XEXP(operands[0],0)) == PLUS)
+    {
+      rtx addr;
+      int offset = 0;
+
+      output_asm_insn ("%0=%u1", operands);
+
+      /* In order to print out the least significant word we must
+	 use 'offset + 1'.  */
+      addr = XEXP (operands[0], 0);
+      if (GET_CODE (XEXP(addr,0)) == CONST_INT)
+	offset = INTVAL(XEXP(addr,0)) + 1;
+      else if (GET_CODE (XEXP(addr,1)) == CONST_INT)
+	offset = INTVAL(XEXP(addr,1)) + 1;
+      else
+	fatal_error ("invalid addressing mode");
+
+      fprintf (asm_out_file, "\t*(%d)=%s\n", offset + 31, reg_names[REGNO(operands[1]) + 1]);
+    }
+    else
+    {
+	xoperands[0] = XEXP(operands[0],0);
+	xoperands[1] = operands[1];
+
+	output_asm_insn ("*%0++=%u1\n\t*%0--=%w1", xoperands);
+    }
+}
+
+void
+override_options ()
+{
+  if (chip_name == (char *) 0)
+    chip_name = DEFAULT_CHIP_NAME;
+
+  if (text_seg_name == (char *) 0)
+    text_seg_name = DEFAULT_TEXT_SEG_NAME;
+  
+  if (data_seg_name == (char *) 0)
+    data_seg_name = DEFAULT_DATA_SEG_NAME;
+  
+  if (bss_seg_name == (char *) 0)
+    bss_seg_name = DEFAULT_BSS_SEG_NAME;
+  
+  if (const_seg_name == (char *) 0)
+    const_seg_name = DEFAULT_CONST_SEG_NAME;
+  
+  save_chip_name = xstrdup (chip_name);
+
+  rsect_text = concat (".rsect \"", text_seg_name, "\"", NULL);
+  rsect_data = concat (".rsect \"", data_seg_name, "\"", NULL);
+  rsect_bss = concat (".rsect \"", bss_seg_name, "\"", NULL);
+  rsect_const = concat (".rsect \"", const_seg_name, "\"", NULL);
+}
+
+int
+next_cc_user_unsigned (insn)
+     rtx insn;
+{
+  switch (next_cc_user_code (insn))
+    {
+    case GTU:
+    case GEU:
+    case LTU:
+    case LEU:
+      return 1;
+    default:
+      return 0;
+    }
+}
+
+enum rtx_code
+next_cc_user_code (insn)
+     rtx insn;
+{
+  /* If no insn could be found we assume that the jump has been
+     deleted and the compare will be deleted later.  */
+
+  if (!(insn = next_cc0_user (insn)))
+    return (enum rtx_code) 0;
+  else if (GET_CODE (insn) == JUMP_INSN
+	   && GET_CODE (PATTERN (insn)) == SET
+	   && GET_CODE (SET_SRC (PATTERN (insn))) == IF_THEN_ELSE)
+    return GET_CODE (XEXP (SET_SRC (PATTERN (insn)), 0));
+  else if (GET_CODE (insn) == INSN
+	   && GET_CODE (PATTERN (insn)) == SET
+	   && comparison_operator (SET_SRC (PATTERN (insn)), VOIDmode))
+    return GET_CODE (SET_SRC (PATTERN (insn)));
+  else
+    abort ();
+}
+
+void
+print_operand(file, op, letter)
+     FILE *file;
+     rtx op;
+     int letter;
+{
+    enum rtx_code code;
+
+    code = GET_CODE(op);
+
+    switch (letter)
+    {
+       case 'I':
+	  code = reverse_condition (code);
+	  /* Fallthrough */
+
+       case 'C':
+          if (code == EQ) 
+          { 
+	      fputs ("eq", file); 
+	      return; 
+	  }
+          else if (code == NE)  
+	  { 
+	      fputs ("ne", file); 
+	      return; 
+	  }
+          else if (code == GT || code == GTU)  
+	  { 
+	      fputs ("gt", file); 
+	      return; 
+	  }
+          else if (code == LT || code == LTU)  
+	  { 
+	      fputs ("mi", file); 
+	      return; 
+	  }
+          else if (code == GE || code == GEU)  
+	  {
+	      fputs ("pl", file); 
+	      return; 
+	  }
+          else if (code == LE || code == LEU)  
+	  { 
+	      fputs ("le", file); 
+	      return; 
+	  }
+          else 
+	      abort ();
+	  break;
+
+       default:
+          break;  
+    }
+
+    if (code == REG)
+    {
+	/* Print the low half of a 32-bit register pair.  */
+        if (letter == 'w')
+           fprintf (file, "%s", reg_names[REGNO (op) + 1]);
+        else if (letter == 'u' || !letter)
+           fprintf (file, "%s", reg_names[REGNO (op)]);
+	else if (letter == 'b')
+	    fprintf (file, "%sh", reg_names[REGNO (op)]);
+	else if (letter == 'm')
+	  fprintf (file, "%s", himode_reg_name[REGNO (op)]);
+        else
+	  output_operand_lossage ("bad register extension code");
+    }
+    else if (code == MEM)
+      output_address (XEXP(op,0));
+    else if (code == CONST_INT)
+      { 
+	HOST_WIDE_INT val = INTVAL (op);
+
+        if (letter == 'H')
+	  fprintf (file, HOST_WIDE_INT_PRINT_HEX, val & 0xffff);
+	else if (letter == 'h')
+	  fprintf (file, HOST_WIDE_INT_PRINT_DEC, val);
+        else if (letter == 'U')
+	  fprintf (file, HOST_WIDE_INT_PRINT_HEX, (val >> 16) & 0xffff);
+        else
+           output_addr_const(file, op);
+      }
+    else if (code == CONST_DOUBLE && GET_MODE(op) != DImode)
+      {
+	long l;
+	REAL_VALUE_TYPE r;
+	REAL_VALUE_FROM_CONST_DOUBLE (r, op);
+	REAL_VALUE_TO_TARGET_SINGLE (r, l);
+	fprintf (file, "0x%lx", l);
+      }
+    else if (code == CONST)
+      {
+	rtx addr = XEXP (op, 0);
+	
+	if (GET_CODE (addr) != PLUS)
+	  {
+	    output_addr_const(file, op);
+	    return;
+	  }
+	
+	if ((GET_CODE (XEXP (addr, 0)) == SYMBOL_REF
+	     || GET_CODE (XEXP (addr, 0)) == LABEL_REF)
+	    && (GET_CODE (XEXP (addr, 1)) == CONST_INT))
+	  {
+	    int n = INTVAL (XEXP(addr, 1));
+	    output_addr_const (file, XEXP (addr, 0));
+	    
+	    if (n >= 0)
+	      fprintf (file, "+");
+	    
+	    n = (int) (short) n;
+	    fprintf (file, "%d", n);
+	  }
+	else if ((GET_CODE (XEXP (addr, 1)) == SYMBOL_REF
+		  || GET_CODE (XEXP (addr, 1)) == LABEL_REF)
+		 && (GET_CODE (XEXP (addr, 0)) == CONST_INT))
+	  {
+	    int n = INTVAL (XEXP(addr, 0));
+	    output_addr_const (file, XEXP (addr, 1));
+	    
+	    if (n >= 0)
+	      fprintf (file, "+");
+	    
+	    n = (int) (short) n;
+	    fprintf (file, "%d", n);
+	  }
+	else
+	  output_addr_const(file, op);
+      }
+    else
+      output_addr_const (file, op);
+}
+
+
+void
+print_operand_address(file, addr)
+     FILE *file;
+     rtx addr;
+{
+  rtx base;
+  int offset = 0;;
+  
+  switch (GET_CODE (addr))
+    {
+    case REG:
+      fprintf (file, "*%s", reg_names[REGNO (addr)]);
+      break;
+    case POST_DEC:
+      fprintf (file, "*%s--", reg_names[REGNO (XEXP (addr, 0))]);
+      break;
+    case POST_INC:
+      fprintf (file, "*%s++", reg_names[REGNO (XEXP (addr, 0))]);
+      break;
+    case PLUS:
+      if (GET_CODE (XEXP(addr,0)) == CONST_INT)
+	offset = INTVAL(XEXP(addr,0)), base = XEXP(addr,1);
+      else if (GET_CODE (XEXP(addr,1)) == CONST_INT)
+	offset = INTVAL(XEXP(addr,1)), base = XEXP(addr,0);
+      else
+	abort();
+      if (GET_CODE (base) == REG && REGNO(base) == STACK_POINTER_REGNUM)
+	{
+	  if (offset >= -31 && offset <= 0)
+	    offset = 31 + offset;
+	  else
+	    fatal_error ("invalid offset in ybase addressing");
+	}
+      else
+	fatal_error ("invalid register in ybase addressing");
+      
+      fprintf (file, "*(%d)", offset);
+      break;
+      
+    default:
+      if (FITS_5_BITS (addr))
+	fprintf (file, "*(0x%x)", (int)(INTVAL (addr) & 0x20));
+      else
+	output_addr_const (file, addr);
+    }
+}
+
+void
+output_dsp16xx_float_const (operands)
+     rtx *operands;
+{
+  rtx src = operands[1];
+  
+  REAL_VALUE_TYPE d;
+  long value;
+  
+  REAL_VALUE_FROM_CONST_DOUBLE (d, src);
+  REAL_VALUE_TO_TARGET_SINGLE (d, value);
+  
+  operands[1] = GEN_INT (value);
+  output_asm_insn ("%u0=%U1\n\t%w0=%H1", operands);
+}
+
+static int
+reg_save_size ()
+{
+  int reg_save_size = 0;
+  int regno;
+
+  for (regno = 0; regno < FIRST_PSEUDO_REGISTER; regno++)
+    if (dsp16xx_call_saved_register (regno))
+      {
+	reg_save_size += UNITS_PER_WORD;
+      }
+
+  /* If the function makes calls we will save need to save the 'pr' register.  */
+  if (current_frame_info.function_makes_calls)
+    reg_save_size += 1;
+
+  return (reg_save_size);
+}
+
+#if 0
+int
+dsp16xx_starting_frame_offset()
+{
+  int reg_save_size = 0;
+ int regno;
+ 
+  for (regno = 0; regno < FIRST_PSEUDO_REGISTER; regno++)
+    if (dsp16xx_call_saved_register (regno))
+      {
+	reg_save_size += UNITS_PER_WORD;
+      }
+
+  return (reg_save_size);
+}
+#endif
+
+int
+initial_frame_pointer_offset()
+{
+  int offset = 0;
+  
+  offset = compute_frame_size (get_frame_size());
+
+#ifdef STACK_GROWS_DOWNWARD
+  return (offset);
+#else
+  return (-offset);
+#endif
+}
+
+/* Generate the minimum number of 1600 core shift instructions
+   to shift by 'shift_amount'.  */
+
+#if 0
+void
+emit_1600_core_shift (shift_op, operands, shift_amount, mode)
+     enum rtx_code shift_op;
+     rtx *operands;
+     int shift_amount;
+     enum machine_mode mode;
+{
+  int quotient;
+  int i;
+  int first_shift_emitted = 0;
+  
+  while (shift_amount != 0)
+    {
+      if (shift_amount/16)
+	{
+	  quotient = shift_amount/16;
+	  shift_amount = shift_amount - (quotient * 16);
+	  for (i = 0; i < quotient; i++)
+	    emit_insn (gen_rtx_SET (VOIDmode, operands[0],
+				    gen_rtx (shift_op, mode, 
+					     first_shift_emitted
+					     ? operands[0] : operands[1],
+					     GEN_INT (16))));
+	  first_shift_emitted = 1;
+	}
+      else if (shift_amount/8)
+	{
+	  quotient = shift_amount/8;
+	  shift_amount = shift_amount - (quotient * 8);
+	  for (i = 0; i < quotient; i++)
+	    emit_insn (gen_rtx_SET (VOIDmode, operands[0],
+				    gen_rtx (shift_op, mode, 
+					     first_shift_emitted
+					     ? operands[0] : operands[1],
+					     GEN_INT (8))));
+	  first_shift_emitted = 1;
+	}
+      else if (shift_amount/4)
+	{
+	  quotient = shift_amount/4;
+	  shift_amount = shift_amount - (quotient * 4);
+	  for (i = 0; i < quotient; i++)
+	    emit_insn (gen_rtx_SET (VOIDmode, operands[0],
+				    gen_rtx (shift_op, mode, 
+					     first_shift_emitted
+					     ? operands[0] : operands[1],
+					     GEN_INT (4))));
+	  first_shift_emitted = 1;
+	}
+      else if (shift_amount/1)
+	{
+	  quotient = shift_amount/1;
+	  shift_amount = shift_amount - (quotient * 1);
+	  for (i = 0; i < quotient; i++)
+	    emit_insn (gen_rtx_SET (VOIDmode, operands[0],
+				    gen_rtx (shift_op, mode, 
+					     first_shift_emitted
+					     ? operands[0] : operands[1],
+					     GEN_INT (1))));
+	  first_shift_emitted = 1;
+	}
+    }
+}
+#else
+void
+emit_1600_core_shift (shift_op, operands, shift_amount)
+     enum rtx_code shift_op;
+     rtx *operands;
+     int shift_amount;
+{
+  int quotient;
+  int i;
+  int first_shift_emitted = 0;
+  const char * const *shift_asm_ptr;
+  const char * const *shift_asm_ptr_first;
+
+  if (shift_op == ASHIFT)
+    {
+      shift_asm_ptr = ashift_left_asm;
+      shift_asm_ptr_first = ashift_left_asm_first;
+    }
+  else if (shift_op == ASHIFTRT)
+    {
+      shift_asm_ptr = ashift_right_asm;
+      shift_asm_ptr_first = ashift_right_asm_first;
+    }
+  else if (shift_op == LSHIFTRT)
+    {
+      shift_asm_ptr = lshift_right_asm;
+      shift_asm_ptr_first = lshift_right_asm_first;
+    }
+  else
+    fatal_error ("invalid shift operator in emit_1600_core_shift");
+
+  while (shift_amount != 0)
+    {
+      if (shift_amount/16)
+	{
+	  quotient = shift_amount/16;
+	  shift_amount = shift_amount - (quotient * 16);
+	  for (i = 0; i < quotient; i++)
+	    output_asm_insn ((first_shift_emitted ? shift_asm_ptr[SHIFT_INDEX_16]
+			      : shift_asm_ptr_first[SHIFT_INDEX_16]), operands);
+	  first_shift_emitted = 1;
+	}
+      else if (shift_amount/8)
+	{
+	  quotient = shift_amount/8;
+	  shift_amount = shift_amount - (quotient * 8);
+	  for (i = 0; i < quotient; i++)
+	    output_asm_insn ((first_shift_emitted ? shift_asm_ptr[SHIFT_INDEX_8]
+			      : shift_asm_ptr_first[SHIFT_INDEX_8]), operands);
+	  first_shift_emitted = 1;
+	}
+      else if (shift_amount/4)
+	{
+	  quotient = shift_amount/4;
+	  shift_amount = shift_amount - (quotient * 4);
+	  for (i = 0; i < quotient; i++)
+	    output_asm_insn ((first_shift_emitted ? shift_asm_ptr[SHIFT_INDEX_4]
+			      : shift_asm_ptr_first[SHIFT_INDEX_4]), operands);
+	  first_shift_emitted = 1;
+	}
+      else if (shift_amount/1)
+	{
+	  quotient = shift_amount/1;
+	  shift_amount = shift_amount - (quotient * 1);
+	  for (i = 0; i < quotient; i++)
+	    output_asm_insn ((first_shift_emitted ? shift_asm_ptr[SHIFT_INDEX_1]
+			      : shift_asm_ptr_first[SHIFT_INDEX_1]), operands);
+	  first_shift_emitted = 1;
+	}
+    }
+}
+#endif
+
+int
+num_1600_core_shifts (shift_amount)
+int shift_amount;
+{
+  int quotient;
+  int i;
+  int first_shift_emitted = 0;
+  int num_shifts = 0;
+
+  while (shift_amount != 0)
+    {
+      if (shift_amount/16)
+	{
+	  quotient = shift_amount/16;
+	  shift_amount = shift_amount - (quotient * 16);
+	  for (i = 0; i < quotient; i++)
+	    num_shifts++;
+	  first_shift_emitted = 1;
+	}
+      else if (shift_amount/8)
+	{
+	  quotient = shift_amount/8;
+	  shift_amount = shift_amount - (quotient * 8);
+	  for (i = 0; i < quotient; i++)
+	    num_shifts++;
+
+	  first_shift_emitted = 1;
+	}
+      else if (shift_amount/4)
+	{
+	  quotient = shift_amount/4;
+	  shift_amount = shift_amount - (quotient * 4);
+	  for (i = 0; i < quotient; i++)
+	    num_shifts++;
+
+	  first_shift_emitted = 1;
+	}
+      else if (shift_amount/1)
+	{
+	  quotient = shift_amount/1;
+	  shift_amount = shift_amount - (quotient * 1);
+	  for (i = 0; i < quotient; i++)
+	    num_shifts++;
+
+	  first_shift_emitted = 1;
+	}
+    }
+  return num_shifts;
+}
+
+void
+asm_output_common(file, name, size, rounded)
+     FILE *file;
+     const char *name;
+     int size ATTRIBUTE_UNUSED;
+     int rounded;
+{
+    bss_section ();
+    (*targetm.asm_out.globalize_label) (file, name);
+    assemble_name (file, name);
+    fputs (":", file);
+    if (rounded > 1)
+	fprintf (file, "%d * int\n", rounded);
+    else
+	fprintf (file, "int\n");
+}
+
+void
+asm_output_local(file, name, size, rounded)
+     FILE *file;
+     const char *name;
+     int size ATTRIBUTE_UNUSED;
+     int rounded;
+{
+    bss_section ();
+    assemble_name (file, name);
+    fputs (":", file);
+    if (rounded > 1)
+	fprintf (file, "%d * int\n", rounded);
+    else
+	fprintf (file, "int\n");
+}
+
+static int
+dsp16xx_address_cost (addr)
+     rtx addr;
+{
+    switch (GET_CODE (addr))
+    {
+	  default:
+	     break;
+
+	  case REG:
+	     return 1;
+
+	  case CONST:
+	     {
+	        rtx offset = const0_rtx;
+	        addr = eliminate_constant_term (addr, &offset);
+
+	        if (GET_CODE (addr) == LABEL_REF)
+	            return 2;
+
+	        if (GET_CODE (addr) != SYMBOL_REF)
+	            return 4;
+
+	        if (INTVAL (offset) == 0)
+	            return 2;
+             }
+	     /* fall through */
+
+	  case POST_INC: case POST_DEC:
+	     return (GET_MODE (addr) == QImode ? 1 : 2);
+
+	  case SYMBOL_REF: case LABEL_REF:
+	     return 2;
+
+	  case PLUS:
+	  {
+	     register rtx plus0 = XEXP (addr, 0);
+	     register rtx plus1 = XEXP (addr, 1);
+	     
+	     if (GET_CODE (plus0) != REG && GET_CODE (plus1) == REG)
+	     {
+		 plus0 = XEXP (addr, 1);
+		 plus1 = XEXP (addr, 0);
+	     }
+	     
+	     if (GET_CODE (plus0) != REG)
+		 break;
+	     
+	     switch (GET_CODE (plus1))
+	     {
+		   default:
+		      break;
+		 
+		   case CONST_INT:
+		      return 4;
+
+		   case CONST:
+		   case SYMBOL_REF:
+		   case LABEL_REF:
+		      return dsp16xx_address_cost (plus1) + 1;
+	     }
+	  }
+     }
+	     
+     return 4;
+}
+
+
+/* Determine whether a function argument is passed in a register, and
+   which register.
+
+   The arguments are CUM, which summarizes all the previous
+   arguments; MODE, the machine mode of the argument; TYPE,
+   the data type of the argument as a tree node or 0 if that is not known
+   (which happens for C support library functions); and NAMED,
+   which is 1 for an ordinary argument and 0 for nameless arguments that
+   correspond to `...' in the called function's prototype.
+
+   The value of the expression should either be a `reg' RTX for the
+   hard register in which to pass the argument, or zero to pass the
+   argument on the stack.
+
+   On the dsp1610 the first four words of args are normally in registers
+   and the rest are pushed. If we a long or on float mode, the argument
+   must begin on an even register boundary
+
+   Note that FUNCTION_ARG and FUNCTION_INCOMING_ARG were different.
+   For structures that are passed in memory, but could have been
+   passed in registers, we first load the structure into the
+   register, and then when the last argument is passed, we store
+   the registers into the stack locations.  This fixes some bugs
+   where GCC did not expect to have register arguments, followed.  */
+
+struct rtx_def *
+dsp16xx_function_arg (args_so_far, mode, type, named)
+     CUMULATIVE_ARGS args_so_far;
+     enum machine_mode mode;
+     tree type;
+     int named;
+{
+  if (TARGET_REGPARM)
+    {
+      if ((args_so_far & 1) != 0
+	  && (mode == HImode || GET_MODE_CLASS(mode) == MODE_FLOAT))
+	args_so_far++;
+
+      if (type == void_type_node)
+	return (struct rtx_def *) 0;
+
+      if (named && args_so_far < 4 && !MUST_PASS_IN_STACK (mode,type))
+	return gen_rtx_REG (mode, args_so_far + FIRST_REG_FOR_FUNCTION_ARG);
+      else
+	return (struct rtx_def *) 0;
+    }
+  else
+    return (struct rtx_def *) 0;
+}
+
+/* Advance the argument to the next argument position.  */
+
+void
+dsp16xx_function_arg_advance (cum, mode, type, named)
+     CUMULATIVE_ARGS *cum;	/* current arg information */
+     enum machine_mode mode;	/* current arg mode */
+     tree type;			/* type of the argument or 0 if lib support */
+     int named ATTRIBUTE_UNUSED;/* whether or not the argument was named */
+{
+  if (TARGET_REGPARM)
+    {
+      if ((*cum & 1) != 0
+	  && (mode == HImode || GET_MODE_CLASS(mode) == MODE_FLOAT))
+	*cum += 1;
+
+      if (mode != BLKmode)
+	*cum += GET_MODE_SIZE (mode);
+      else
+	*cum += int_size_in_bytes (type);
+    }
+}
+
+static void
+dsp16xx_file_start ()
+{
+  fprintf (asm_out_file, "#include <%s.h>\n", save_chip_name);
+}
+
+rtx
+gen_tst_reg (x)
+     rtx x;
+{
+  enum machine_mode mode;
+
+  mode = GET_MODE (x);
+
+  if (mode == QImode)
+    emit_insn (gen_rtx_PARALLEL
+	       (VOIDmode,
+		gen_rtvec (2, gen_rtx_SET (VOIDmode, cc0_rtx, x),
+			   gen_rtx_CLOBBER (VOIDmode,
+					    gen_rtx_SCRATCH (QImode)))));
+  else if (mode == HImode)
+    emit_insn (gen_rtx_SET (VOIDmode, cc0_rtx, x));
+  else
+    fatal_error ("invalid mode for gen_tst_reg");
+
+  return cc0_rtx;
+}
+
+rtx
+gen_compare_reg (code, x, y)
+     enum rtx_code code;
+     rtx x, y;
+{
+  enum machine_mode mode;
+
+  mode = GET_MODE (x);
+  /* For floating point compare insns, a call is generated so don't
+     do anything here.  */
+
+  if (GET_MODE_CLASS (mode) == MODE_FLOAT)
+    return cc0_rtx;
+
+  if (mode == QImode)
+    {
+      if (code == GTU || code == GEU
+	  || code == LTU || code == LEU)
+	{
+	  emit_insn (gen_rtx_PARALLEL
+		     (VOIDmode,
+		      gen_rtvec (3,
+				 gen_rtx_SET (VOIDmode, cc0_rtx,
+					      gen_rtx_COMPARE (mode, x, y)),
+				 gen_rtx_CLOBBER (VOIDmode,
+						  gen_rtx_SCRATCH (QImode)),
+				 gen_rtx_CLOBBER (VOIDmode,
+						  gen_rtx_SCRATCH (QImode)))));
+	}
+      else
+	{
+	  emit_insn (gen_rtx_PARALLEL
+		     (VOIDmode,
+		      gen_rtvec (3, gen_rtx_SET (VOIDmode, cc0_rtx,
+						 gen_rtx_COMPARE (mode, x, y)),
+				 gen_rtx_CLOBBER (VOIDmode,
+						  gen_rtx_SCRATCH (QImode)),
+				 gen_rtx_CLOBBER (VOIDmode,
+						  gen_rtx_SCRATCH (QImode)))));
+	}
+    }
+  else if (mode == HImode)
+    {
+      if (code == GTU || code == GEU
+	  || code == LTU || code == LEU)
+	{
+	  emit_insn (gen_rtx_PARALLEL 
+		     (VOIDmode, 
+		      gen_rtvec (5,
+				 gen_rtx_SET (VOIDmode, cc0_rtx, 
+					      gen_rtx_COMPARE (VOIDmode, x, y)),
+				 gen_rtx_CLOBBER (VOIDmode, 
+						  gen_rtx_SCRATCH (QImode)),
+				 gen_rtx_CLOBBER (VOIDmode, 
+						  gen_rtx_SCRATCH (QImode)),
+				 gen_rtx_CLOBBER (VOIDmode, 
+						  gen_rtx_SCRATCH (QImode)),
+				 gen_rtx_CLOBBER (VOIDmode, 
+						  gen_rtx_SCRATCH (QImode)))));
+	}
+      else
+	emit_insn (gen_rtx_SET (VOIDmode, cc0_rtx,
+				gen_rtx_COMPARE (VOIDmode,
+						 force_reg (HImode, x), 
+						 force_reg (HImode,y))));
+    }
+  else
+    fatal_error ("invalid mode for integer comparison in gen_compare_reg");
+
+  return cc0_rtx;
+}
+
+const char *
+output_block_move (operands)
+     rtx operands[];
+{
+  int loop_count = INTVAL(operands[2]);
+  rtx xoperands[4];
+
+  fprintf (asm_out_file, "\tdo %d {\n", loop_count);
+  xoperands[0] = operands[4];
+  xoperands[1] = operands[1];
+  output_asm_insn ("%0=*%1++", xoperands);
+
+  xoperands[0] = operands[0];
+  xoperands[1] = operands[4];
+  output_asm_insn ("*%0++=%1", xoperands);
+
+  fprintf (asm_out_file, "\t}\n");
+  return "";
+}
+
+int
+uns_comparison_operator (op, mode)
+     rtx op;
+     enum machine_mode mode;
+{
+  if (mode == VOIDmode || GET_MODE (op) == mode)
+    {
+      enum rtx_code code;
+      
+      code = GET_CODE(op);
+
+      if (code == LEU || code == LTU || code == GEU
+	  || code == GTU)
+	{
+	  return 1;
+	}
+      else
+	return 0;
+    }
+
+  return 0;
+}
+
+int
+signed_comparison_operator (op, mode)
+     rtx op;
+     enum machine_mode mode;
+{
+  if (mode == VOIDmode || GET_MODE (op) == mode)
+    {
+      enum rtx_code code;
+      
+      code = GET_CODE(op);
+
+      if (!(code == LEU || code == LTU || code == GEU
+	  || code == GTU))
+	{
+	  return 1;
+	}
+      else
+	return 0;
+    }
+
+  return 0;
+}
+
+static bool
+dsp16xx_rtx_costs (x, code, outer_code, total)
+     rtx x;
+     int code;
+     int outer_code ATTRIBUTE_UNUSED;
+     int *total;
+{
+  switch (code)
+    {
+    case CONST_INT:
+      *total = (unsigned HOST_WIDE_INT) INTVAL (x) < 65536 ? 0 : 2;
+      return true;
+
+    case LABEL_REF:
+    case SYMBOL_REF:
+    case CONST:
+      *total = COSTS_N_INSNS (1);
+      return true;
+
+    case CONST_DOUBLE:
+      *total = COSTS_N_INSNS (2);
+      return true;
+
+    case MEM:
+      *total = COSTS_N_INSNS (GET_MODE (x) == QImode ? 2 : 4);
+      return true;
+
+    case DIV:
+    case MOD:
+      *total = COSTS_N_INSNS (38);
+      return true;
+
+    case MULT:
+      if (GET_MODE (x) == QImode)
+        *total = COSTS_N_INSNS (2);
+      else
+	*total = COSTS_N_INSNS (38);
+      return true;
+
+    case PLUS:
+    case MINUS:
+    case AND:
+    case IOR:
+    case XOR:
+      if (GET_MODE_CLASS (GET_MODE (x)) == MODE_INT)
+	{
+	  *total = 1;
+	  return false;
+	}
+      else
+	{
+          *total = COSTS_N_INSNS (38);
+	  return true;
+	}
+
+    case NEG:
+    case NOT:
+      *total = COSTS_N_INSNS (1);
+      return true;
+
+    case ASHIFT:
+    case ASHIFTRT:
+    case LSHIFTRT:
+      if (GET_CODE (XEXP (x, 1)) == CONST_INT)
+	{
+	  HOST_WIDE_INT number = INTVAL (XEXP (x, 1));
+	  if (number == 1 || number == 4 || number == 8
+	      || number == 16)
+	    *total = COSTS_N_INSNS (1);
+	  else if (TARGET_BMU)
+            *total = COSTS_N_INSNS (2);
+          else
+            *total = COSTS_N_INSNS (num_1600_core_shifts (number));
+	  return true;
+	}
+      break;
+    }
+
+  if (TARGET_BMU)
+    *total = COSTS_N_INSNS (1);
+  else
+    *total = COSTS_N_INSNS (15);
+  return true;
+}
diff --git a/gcc/config/dsp16xx/dsp16xx.h b/gcc/config/dsp16xx/dsp16xx.h
new file mode 100644
index 00000000000..472ba1f0d9b
--- /dev/null
+++ b/gcc/config/dsp16xx/dsp16xx.h
@@ -0,0 +1,1768 @@
+/* Definitions of target machine for GNU compiler.  AT&T DSP1600.
+   Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003
+   Free Software Foundation, Inc.
+   Contributed by Michael Collison (collison@isisinc.net).
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+extern const char *low_reg_names[];
+extern const char *text_seg_name;
+extern const char *rsect_text;
+extern const char *data_seg_name;
+extern const char *rsect_data;
+extern const char *bss_seg_name;
+extern const char *rsect_bss;
+extern const char *const_seg_name;
+extern const char *rsect_const;
+extern const char *chip_name;
+extern const char *save_chip_name;
+extern GTY(()) rtx dsp16xx_compare_op0;
+extern GTY(()) rtx dsp16xx_compare_op1;
+extern GTY(()) rtx dsp16xx_addhf3_libcall;
+extern GTY(()) rtx dsp16xx_subhf3_libcall;
+extern GTY(()) rtx dsp16xx_mulhf3_libcall;
+extern GTY(()) rtx dsp16xx_divhf3_libcall;
+extern GTY(()) rtx dsp16xx_cmphf3_libcall;
+extern GTY(()) rtx dsp16xx_fixhfhi2_libcall;
+extern GTY(()) rtx dsp16xx_floathihf2_libcall;
+extern GTY(()) rtx dsp16xx_neghf2_libcall;
+extern GTY(()) rtx dsp16xx_mulhi3_libcall;
+extern GTY(()) rtx dsp16xx_udivqi3_libcall;
+extern GTY(()) rtx dsp16xx_udivhi3_libcall;
+extern GTY(()) rtx dsp16xx_divqi3_libcall;
+extern GTY(()) rtx dsp16xx_divhi3_libcall;
+extern GTY(()) rtx dsp16xx_modqi3_libcall;
+extern GTY(()) rtx dsp16xx_modhi3_libcall;
+extern GTY(()) rtx dsp16xx_umodqi3_libcall;
+extern GTY(()) rtx dsp16xx_umodhi3_libcall;
+
+extern GTY(()) rtx dsp16xx_ashrhi3_libcall;
+extern GTY(()) rtx dsp16xx_ashlhi3_libcall;
+extern GTY(()) rtx dsp16xx_lshrhi3_libcall;
+
+/* RUN-TIME TARGET SPECIFICATION */
+#define DSP16XX   1
+
+/* Name of the AT&T assembler */
+
+#define ASM_PROG "as1600"
+
+/* Name of the AT&T linker */
+
+#define LD_PROG "ld1600"
+
+/* Define which switches take word arguments */
+#define WORD_SWITCH_TAKES_ARG(STR)              \
+  (!strcmp (STR, "ifile") ? 1 :                 \
+   0)
+
+#undef  CC1_SPEC
+#define CC1_SPEC       "%{!O*:-O}"
+
+/* Define this as a spec to call the AT&T assembler */
+
+#define CROSS_ASM_SPEC   "%{!S:as1600 %a %i\n }"
+
+/* Define this as a spec to call the AT&T linker */
+
+#define CROSS_LINK_SPEC  "%{!c:%{!M:%{!MM:%{!E:%{!S:ld1600 %l %X %{o*} %{m} \
+			%{r} %{s} %{t} %{u*} %{x}\
+			%{!A:%{!nostdlib:%{!nostartfiles:%S}}} %{static:}\
+			%{L*} %D %o %{!nostdlib:-le1600 %L -le1600}\
+			%{!A:%{!nostdlib:%{!nostartfiles:%E}}}\n }}}}}"
+
+/* Nothing complicated here, just link with libc.a under normal
+   circumstances */
+#define LIB_SPEC "-lc"
+
+/* Specify the startup file to link with.  */
+#define STARTFILE_SPEC "%{mmap1:m1_crt0.o%s}  \
+%{mmap2:m2_crt0.o%s}                          \
+%{mmap3:m3_crt0.o%s}                          \
+%{mmap4:m4_crt0.o%s}                          \
+%{!mmap*: %{!ifile*: m4_crt0.o%s} %{ifile*:     \
+%ea -ifile option requires a -map option}}"
+
+/* Specify the end file to link with */
+
+#define ENDFILE_SPEC "%{mmap1:m1_crtn.o%s}  \
+%{mmap2:m2_crtn.o%s}                          \
+%{mmap3:m3_crtn.o%s}                          \
+%{mmap4:m4_crtn.o%s}                          \
+%{!mmap*: %{!ifile*: m4_crtn.o%s} %{ifile*:     \
+%ea -ifile option requires a -map option}}"
+
+
+/* Tell gcc where to look for the startfile */
+/*#define STANDARD_STARTFILE_PREFIX   "/d1600/lib"*/
+
+/* Tell gcc where to look for it's executables */
+/*#define STANDARD_EXEC_PREFIX  "/d1600/bin"*/
+
+/* Command line options to the AT&T assembler */
+#define ASM_SPEC  "%{V} %{v:%{!V:-V}} %{g*:-g}"
+
+/* Command line options for the AT&T linker */
+
+#define LINK_SPEC "%{V} %{v:%{!V:-V}} %{minit:-i}  \
+%{!ifile*:%{mmap1:m1_deflt.if%s}         \
+          %{mmap2:m2_deflt.if%s}         \
+          %{mmap3:m3_deflt.if%s}         \
+          %{mmap4:m4_deflt.if%s}         \
+          %{!mmap*:m4_deflt.if%s}}       \
+%{ifile*:%*} %{r}"
+
+/* Include path is determined from the environment variable */
+#define INCLUDE_DEFAULTS     \
+{                            \
+  { 0, 0, 0, 0, 0 }          \
+}
+
+/* Names to predefine in the preprocessor for this target machine.  */
+#define TARGET_CPU_CPP_BUILTINS()		\
+  do						\
+    {						\
+      builtin_define_std ("dsp1600");		\
+      builtin_define_std ("DSP1600");		\
+    }						\
+  while (0)
+
+#ifdef __MSDOS__
+# define TARGET_OS_CPP_BUILTINS()		\
+  do						\
+    {						\
+      builtin_define_std ("MSDOS");		\
+    }						\
+  while (0)
+#else
+# define TARGET_OS_CPP_BUILTINS()		\
+  do						\
+    {						\
+      builtin_define_std ("dsp1610");		\
+      builtin_define_std ("DSP1610");		\
+    }						\
+  while (0)
+#endif
+
+/* Run-time compilation parameters selecting different hardware subsets.  */
+
+extern int target_flags;
+
+/* Macros used in the machine description to test the flags.  */
+
+#define MASK_REGPARM         0x00000001    /* Pass parameters in registers */
+#define MASK_NEAR_CALL       0x00000002    /* The call is on the same 4k page */
+#define MASK_NEAR_JUMP       0x00000004    /* The jump is on the same 4k page */
+#define MASK_BMU             0x00000008    /* Use the 'bmu' shift instructions */
+#define MASK_MAP1            0x00000040    /* Link with map1 */
+#define MASK_MAP2            0x00000080    /* Link with map2 */
+#define MASK_MAP3            0x00000100    /* Link with map3 */
+#define MASK_MAP4            0x00000200    /* Link with map4 */
+#define MASK_YBASE_HIGH      0x00000400    /* The ybase register window starts high */
+#define MASK_INIT	     0x00000800    /* Have the linker generate tables to
+					      initialize data at startup */
+#define MASK_RESERVE_YBASE   0x00002000    /* Reserved the ybase registers */
+#define MASK_DEBUG           0x00004000	   /* Debugging turned on*/
+#define MASK_SAVE_TEMPS      0x00008000    /* Save temps. option seen */
+
+/* Compile passing first two args in regs 0 and 1.
+   This exists only to test compiler features that will
+   be needed for RISC chips.  It is not usable
+   and is not intended to be usable on this cpu.  */
+#define TARGET_REGPARM   (target_flags & MASK_REGPARM)
+
+/* The call is on the same 4k page, so instead of loading
+   the 'pt' register and branching, we can branch directly */
+
+#define TARGET_NEAR_CALL (target_flags & MASK_NEAR_CALL)
+
+/* The jump is on the same 4k page, so instead of loading
+   the 'pt' register and branching, we can branch directly */
+
+#define TARGET_NEAR_JUMP (target_flags & MASK_NEAR_JUMP)
+
+/* Generate shift instructions to use the 1610 Bit Manipulation
+   Unit.  */
+#define TARGET_BMU (target_flags & MASK_BMU)
+
+#define TARGET_YBASE_HIGH (target_flags & MASK_YBASE_HIGH)
+
+/* Direct the linker to output extra info for initialized data */
+#define TARGET_MASK_INIT (target_flags & MASK_INIT)
+
+#define TARGET_INLINE_MULT (target_flags & MASK_INLINE_MULT)
+
+/* Reserve the ybase registers *(0) - *(31) */
+#define TARGET_RESERVE_YBASE (target_flags & MASK_RESERVE_YBASE)
+
+/* We turn this option on internally after seeing "-g" */
+#define TARGET_DEBUG            (target_flags & MASK_DEBUG)
+
+/* We turn this option on internally after seeing "-save-temps */
+#define TARGET_SAVE_TEMPS       (target_flags & MASK_SAVE_TEMPS)
+
+
+/* Macro to define tables used to set the flags.
+   This is a list in braces of pairs in braces,
+   each pair being { "NAME", VALUE }
+   where VALUE is the bits to set or minus the bits to clear.
+   An empty string NAME is used to identify the default VALUE.  */
+
+
+#define TARGET_SWITCHES                                           \
+  {				                                  \
+    { "regparm",       MASK_REGPARM,                              \
+      N_("Pass parameters in registers (default)") },             \
+    { "no-regparm",   -MASK_REGPARM,	                          \
+      N_("Don't pass parameters in registers") },                 \
+    { "near-call",     MASK_NEAR_JUMP,                            \
+      N_("Generate code for near calls") },                       \
+    { "no-near-call", -MASK_NEAR_CALL,                            \
+      N_("Don't generate code for near calls") },                 \
+    { "near-jump",     MASK_NEAR_JUMP,                            \
+      N_("Generate code for near jumps") },                       \
+    { "no-near-jump", -MASK_NEAR_JUMP,                            \
+      N_("Don't generate code for near jumps") },                 \
+    { "bmu",           MASK_BMU,                                  \
+      N_("Generate code for a bit-manipulation unit") },          \
+    { "no-bmu",       -MASK_BMU,                                  \
+      N_("Don't generate code for a bit-manipulation unit") },    \
+    { "map1",          MASK_MAP1,                                 \
+      N_("Generate code for memory map1") },                      \
+    { "map2",          MASK_MAP2,                                 \
+      N_("Generate code for memory map2") },                      \
+    { "map3",          MASK_MAP3,                                 \
+      N_("Generate code for memory map3") },                      \
+    { "map4",          MASK_MAP4,                                 \
+      N_("Generate code for memory map4") },                      \
+    { "init",          MASK_INIT,                                 \
+      N_("Ouput extra code for initialized data") },              \
+    { "reserve-ybase", MASK_RESERVE_YBASE,                        \
+      N_("Don't let reg. allocator use ybase registers") },       \
+    { "debug",         MASK_DEBUG,                                \
+      N_("Output extra debug info in Luxworks environment") },    \
+    { "save-temporaries",    MASK_SAVE_TEMPS,                     \
+      N_("Save temp. files in Luxworks environment") },           \
+    { "",              TARGET_DEFAULT, ""}                        \
+  }
+
+/* Default target_flags if no switches are specified */
+#ifndef TARGET_DEFAULT
+#define TARGET_DEFAULT  MASK_REGPARM|MASK_YBASE_HIGH
+#endif
+
+#define TARGET_OPTIONS						\
+{								\
+  { "text=",	&text_seg_name,				        \
+    N_("Specify alternate name for text section"), 0},          \
+  { "data=",	&data_seg_name,				        \
+    N_("Specify alternate name for data section"), 0},          \
+  { "bss=",	&bss_seg_name,				        \
+    N_("Specify alternate name for bss section"), 0},           \
+  { "const=",   &const_seg_name,                                \
+    N_("Specify alternate name for constant section"), 0},      \
+  { "chip=",    &chip_name,                                     \
+    N_("Specify alternate name for dsp16xx chip"), 0},          \
+}
+
+/* Sometimes certain combinations of command options do not make sense
+   on a particular target machine.  You can define a macro
+   `OVERRIDE_OPTIONS' to take account of this.  This macro, if
+   defined, is executed once just after all the command options have
+   been parsed.
+  
+   Don't use this macro to turn on various extra optimizations for
+   `-O'.  That is what `OPTIMIZATION_OPTIONS' is for.  */
+
+#define OVERRIDE_OPTIONS override_options ()
+
+#define OPTIMIZATION_OPTIONS(LEVEL,SIZE)              \
+{                                                     \
+    if (LEVEL >= 2)                                   \
+    {                                                 \
+        /* The dsp16xx family has so few registers    \
+         * that running the first instruction         \
+         * scheduling is bad for reg. allocation      \
+         * since it increases lifetimes of pseudos.   \
+         * So turn of first scheduling pass.          \
+         */                                           \
+        flag_schedule_insns          = FALSE;         \
+    }                                                 \
+}
+
+/* STORAGE LAYOUT */
+
+/* Define this if most significant bit is lowest numbered
+   in instructions that operate on numbered bit-fields.
+ */
+#define BITS_BIG_ENDIAN  0
+
+/* Define this if most significant byte of a word is the lowest numbered.
+   We define big-endian, but since the 1600 series cannot address bytes
+   it does not matter.  */
+#define BYTES_BIG_ENDIAN 1
+
+/* Define this if most significant word of a multiword number is numbered.
+   For the 1600 we can decide arbitrarily since there are no machine instructions for them.  */
+#define WORDS_BIG_ENDIAN 1
+
+/* number of bits in an addressable storage unit */
+#define BITS_PER_UNIT 16
+
+/* Maximum number of bits in a word.  */
+#define MAX_BITS_PER_WORD 16
+
+/* Width of a word, in units (bytes).  */
+#define UNITS_PER_WORD 1
+
+/* Allocation boundary (in *bits*) for storing pointers in memory.  */
+#define POINTER_BOUNDARY 16
+
+/* Allocation boundary (in *bits*) for storing arguments in argument list.  */
+#define PARM_BOUNDARY 16
+
+/* Boundary (in *bits*) on which stack pointer should be aligned.  */
+#define STACK_BOUNDARY 16
+
+/* Allocation boundary (in *bits*) for the code of a function.  */
+#define FUNCTION_BOUNDARY 16
+
+/* Biggest alignment that any data type can require on this machine, in bits.  */
+#define BIGGEST_ALIGNMENT 16
+
+/* Biggest alignment that any structure field can require on this machine, in bits */
+#define BIGGEST_FIELD_ALIGNMENT 16
+
+/* Alignment of field after `int : 0' in a structure.  */
+#define EMPTY_FIELD_BOUNDARY 16
+
+/* Number of bits which any structure or union's size must be a multiple of. Each structure
+   or union's size is rounded up to a multiple of this */
+#define STRUCTURE_SIZE_BOUNDARY 16
+
+/* Define this if move instructions will actually fail to work
+   when given unaligned data.  */
+#define STRICT_ALIGNMENT  1
+
+/* An integer expression for the size in bits of the largest integer machine mode that
+   should actually be used. All integer machine modes of this size or smaller can be
+   used for structures and unions with the appropriate sizes.  */
+#define MAX_FIXED_MODE_SIZE 32
+
+/* LAYOUT OF SOURCE LANGUAGE DATA TYPES */
+
+#define SHORT_TYPE_SIZE        16
+#define INT_TYPE_SIZE          16
+#define LONG_TYPE_SIZE         32
+#define LONG_LONG_TYPE_SIZE    32
+#define FLOAT_TYPE_SIZE        32
+#define DOUBLE_TYPE_SIZE       32
+#define LONG_DOUBLE_TYPE_SIZE  32
+
+/* An expression whose value is 1 or 0, according to whether the type char should be
+   signed or unsigned by default.  */
+
+#define DEFAULT_SIGNED_CHAR 1
+
+/* A C expression to determine whether to give an enum type only as many bytes
+   as it takes to represent the range of possible values of that type. A nonzero
+   value means to do that; a zero value means all enum types should be allocated
+   like int.  */
+
+#define DEFAULT_SHORT_ENUMS 0
+
+/* A C expression for a string describing the name of the data type to use for
+   size values.  */
+
+#define SIZE_TYPE    "unsigned int"
+
+/* A C expression for a string describing the name of the data type to use for the
+   result of subtracting two pointers */
+
+#define PTRDIFF_TYPE "int"
+
+
+/* REGISTER USAGE.  */
+
+#define ALL_16_BIT_REGISTERS  1
+
+/* Number of actual hardware registers.
+   The hardware registers are assigned numbers for the compiler
+   from 0 to FIRST_PSEUDO_REGISTER-1 */
+
+#define FIRST_PSEUDO_REGISTER (REG_YBASE31 + 1)
+
+/* 1 for registers that have pervasive standard uses
+   and are not available for the register allocator.
+
+   The registers are laid out as follows:
+
+   {a0,a0l,a1,a1l,x,y,yl,p,pl} - Data Arithmetic Unit
+   {r0,r1,r2,r3,j,k,ybase} - Y Space Address Arithmetic Unit
+   {pt} - X Space Address Arithmetic Unit
+   {ar0,ar1,ar2,ar3} - Bit Manipulation UNit
+   {pr} - Return Address Register
+
+   We reserve r2 for the Stack Pointer.
+   We specify r3 for the Frame Pointer but allow the compiler
+   to omit it when possible since we have so few pointer registers.  */
+
+#define REG_A0     0
+#define REG_A0L    1
+#define REG_A1     2
+#define REG_A1L    3 
+#define REG_X      4
+#define REG_Y      5
+#define REG_YL     6
+#define REG_PROD   7
+#define REG_PRODL  8
+#define REG_R0     9
+#define REG_R1     10
+#define REG_R2     11
+#define REG_R3     12
+#define REG_J      13
+#define REG_K      14
+#define REG_YBASE  15
+#define REG_PT     16
+#define REG_AR0    17
+#define REG_AR1    18
+#define REG_AR2    19
+#define REG_AR3    20
+#define REG_C0     21
+#define REG_C1     22
+#define REG_C2     23
+#define REG_PR     24
+#define REG_RB     25
+#define REG_YBASE0 26
+#define REG_YBASE1 27
+#define REG_YBASE2 28
+#define REG_YBASE3 29
+#define REG_YBASE4 30
+#define REG_YBASE5 31
+#define REG_YBASE6 32
+#define REG_YBASE7 33
+#define REG_YBASE8 34
+#define REG_YBASE9 35
+#define REG_YBASE10 36
+#define REG_YBASE11 37
+#define REG_YBASE12 38
+#define REG_YBASE13 39
+#define REG_YBASE14 40
+#define REG_YBASE15 41
+#define REG_YBASE16 42
+#define REG_YBASE17 43
+#define REG_YBASE18 44
+#define REG_YBASE19 45
+#define REG_YBASE20 46
+#define REG_YBASE21 47
+#define REG_YBASE22 48
+#define REG_YBASE23 49
+#define REG_YBASE24 50
+#define REG_YBASE25 51
+#define REG_YBASE26 52
+#define REG_YBASE27 53
+#define REG_YBASE28 54
+#define REG_YBASE29 55
+#define REG_YBASE30 56
+#define REG_YBASE31 57
+
+/* Do we have an accumulator register? */
+#define IS_ACCUM_REG(REGNO) IN_RANGE ((REGNO), REG_A0, REG_A1L)
+#define IS_ACCUM_LOW_REG(REGNO) ((REGNO) == REG_A0L || (REGNO) == REG_A1L)
+
+/* Do we have a virtual ybase register */
+#define IS_YBASE_REGISTER_WINDOW(REGNO) ((REGNO) >= REG_YBASE0 && (REGNO) <= REG_YBASE31)
+
+#define IS_YBASE_ELIGIBLE_REG(REGNO) (IS_ACCUM_REG (REGNO) || IS_ADDRESS_REGISTER(REGNO) \
+                                      || REGNO == REG_X || REGNO == REG_Y || REGNO == REG_YL \
+                                      || REGNO == REG_PROD || REGNO == REG_PRODL)
+
+#define IS_ADDRESS_REGISTER(REGNO) ((REGNO) >= REG_R0 && (REGNO) <= REG_R3)
+
+#define FIXED_REGISTERS     \
+{0, 0, 0, 0, 0, 0, 0, 0, 0, \
+ 0, 0, 0, 1, 0, 0, 1,       \
+ 1,                         \
+ 0, 0, 0, 0,                \
+ 1, 1, 1,                   \
+ 1, 0,                      \
+ 0, 0, 0, 0, 0, 0, 0, 0,    \
+ 0, 0, 0, 0, 0, 0, 0, 0,    \
+ 0, 0, 0, 0, 0, 0, 0, 0,    \
+ 0, 0, 0, 0, 0, 0, 0, 0}
+
+/* 1 for registers not available across function calls.
+   These must include the FIXED_REGISTERS and also any
+   registers that can be used without being saved.
+   The latter must include the registers where values are returned
+   and the register where structure-value addresses are passed.
+   On the 1610 'a0' holds return values from functions. 'r0' holds
+   structure-value addresses.
+
+   In addition we don't save either j, k, ybase or any of the
+   bit manipulation registers.  */
+
+
+#define CALL_USED_REGISTERS			\
+{1, 1, 1, 1, 0, 1, 1, 1, 1,	/* 0-8 */	\
+ 1, 0, 0, 1, 1, 1, 1,		/* 9-15 */	\
+ 1,                             /* 16 */	\
+ 0, 0, 1, 1,			/* 17-20 */	\
+ 1, 1, 1,			/* 21-23 */	\
+ 1, 1,				/* 24-25 */	\
+ 0, 0, 0, 0, 0, 0, 0, 0,	/* 26-33 */	\
+ 0, 0, 0, 0, 0, 0, 0, 0,	/* 34-41 */	\
+ 0, 0, 0, 0, 0, 0, 0, 0,	/* 42-49 */	\
+ 0, 0, 0, 0, 0, 0, 0, 0}	/* 50-57 */
+
+/* List the order in which to allocate registers.  Each register must be
+   listed once, even those in FIXED_REGISTERS.
+
+   We allocate in the following order:
+ */
+
+#if 0
+#define REG_ALLOC_ORDER					\
+{ REG_R0, REG_R1, REG_R2, REG_PROD, REG_Y, REG_X,       \
+  REG_PRODL, REG_YL, REG_AR0, REG_AR1,                  \
+  REG_RB, REG_A0, REG_A1, REG_A0L,                      \
+  REG_A1L, REG_AR2, REG_AR3,                            \
+  REG_YBASE, REG_J, REG_K, REG_PR, REG_PT, REG_C0,      \
+  REG_C1, REG_C2, REG_R3,				\
+  REG_YBASE0, REG_YBASE1, REG_YBASE2, REG_YBASE3,       \
+  REG_YBASE4, REG_YBASE5, REG_YBASE6, REG_YBASE7,       \
+  REG_YBASE8, REG_YBASE9, REG_YBASE10, REG_YBASE11,     \
+  REG_YBASE12, REG_YBASE13, REG_YBASE14, REG_YBASE15,   \
+  REG_YBASE16, REG_YBASE17, REG_YBASE18, REG_YBASE19,   \
+  REG_YBASE20, REG_YBASE21, REG_YBASE22, REG_YBASE23,   \
+  REG_YBASE24, REG_YBASE25, REG_YBASE26, REG_YBASE27,   \
+  REG_YBASE28, REG_YBASE29, REG_YBASE30, REG_YBASE31 }
+#else
+#define REG_ALLOC_ORDER                                 \
+{                                                       \
+  REG_A0, REG_A0L, REG_A1, REG_A1L, REG_Y, REG_YL,      \
+  REG_PROD,                                             \
+  REG_PRODL, REG_R0, REG_J, REG_K, REG_AR2, REG_AR3,    \
+  REG_X, REG_R1, REG_R2, REG_RB, REG_AR0, REG_AR1,      \
+  REG_YBASE0, REG_YBASE1, REG_YBASE2, REG_YBASE3,       \
+  REG_YBASE4, REG_YBASE5, REG_YBASE6, REG_YBASE7,       \
+  REG_YBASE8, REG_YBASE9, REG_YBASE10, REG_YBASE11,     \
+  REG_YBASE12, REG_YBASE13, REG_YBASE14, REG_YBASE15,   \
+  REG_YBASE16, REG_YBASE17, REG_YBASE18, REG_YBASE19,   \
+  REG_YBASE20, REG_YBASE21, REG_YBASE22, REG_YBASE23,   \
+  REG_YBASE24, REG_YBASE25, REG_YBASE26, REG_YBASE27,   \
+  REG_YBASE28, REG_YBASE29, REG_YBASE30, REG_YBASE31,   \
+  REG_R3, REG_YBASE, REG_PT, REG_C0, REG_C1, REG_C2,    \
+  REG_PR }
+#endif
+/* Zero or more C statements that may conditionally modify two
+   variables `fixed_regs' and `call_used_regs' (both of type `char
+   []') after they have been initialized from the two preceding
+   macros.
+
+   This is necessary in case the fixed or call-clobbered registers
+   depend on target flags.
+
+   You need not define this macro if it has no work to do.
+
+   If the usage of an entire class of registers depends on the target
+   flags, you may indicate this to GCC by using this macro to modify
+   `fixed_regs' and `call_used_regs' to 1 for each of the registers in
+   the classes which should not be used by GCC.  Also define the macro
+   `REG_CLASS_FROM_LETTER' to return `NO_REGS' if it is called with a
+   letter for a class that shouldn't be used.
+
+   (However, if this class is not included in `GENERAL_REGS' and all
+   of the insn patterns whose constraints permit this class are
+   controlled by target switches, then GCC will automatically avoid
+   using these registers when the target switches are opposed to
+   them.)  If the user tells us there is no BMU, we can't use
+   ar0-ar3 for register allocation */
+
+#define CONDITIONAL_REGISTER_USAGE					\
+do									\
+  {									\
+    if (!TARGET_BMU)						        \
+      {									\
+	int regno;							\
+									\
+	for (regno = REG_AR0; regno <= REG_AR3; regno++)	        \
+	  fixed_regs[regno] = call_used_regs[regno] = 1;		\
+      }									\
+    if (TARGET_RESERVE_YBASE)						\
+      {									\
+	int regno;							\
+									\
+	for (regno = REG_YBASE0; regno <= REG_YBASE31; regno++)	        \
+	  fixed_regs[regno] = call_used_regs[regno] = 1;		\
+      }									\
+  }									\
+while (0)
+
+/* Determine which register classes are very likely used by spill registers.
+   local-alloc.c won't allocate pseudos that have these classes as their
+   preferred class unless they are "preferred or nothing".  */
+
+#define CLASS_LIKELY_SPILLED_P(CLASS) \
+ ((CLASS) != ALL_REGS && (CLASS) != YBASE_VIRT_REGS)
+
+/* Return number of consecutive hard regs needed starting at reg REGNO
+   to hold something of mode MODE.
+   This is ordinarily the length in words of a value of mode MODE
+   but can be less for certain modes in special long registers.  */
+
+#define HARD_REGNO_NREGS(REGNO, MODE)                                 \
+  (GET_MODE_SIZE(MODE))
+
+/* Value is 1 if hard register REGNO can hold a value of machine-mode MODE.  */
+
+#define HARD_REGNO_MODE_OK(REGNO, MODE) hard_regno_mode_ok(REGNO, MODE)
+
+/* Value is 1 if it is a good idea to tie two pseudo registers
+   when one has mode MODE1 and one has mode MODE2.
+   If HARD_REGNO_MODE_OK could produce different values for MODE1 and MODE2,
+   for any hard reg, then this must be 0 for correct output.  */
+#define MODES_TIEABLE_P(MODE1, MODE2)		     \
+  (((MODE1) == (MODE2)) ||                           \
+   (GET_MODE_CLASS((MODE1)) == MODE_FLOAT)           \
+    == (GET_MODE_CLASS((MODE2)) == MODE_FLOAT))
+
+/* Specify the registers used for certain standard purposes.
+   The values of these macros are register numbers.  */
+
+/* DSP1600 pc isn't overloaded on a register.  */
+/* #define PC_REGNUM  */
+
+/* Register to use for pushing function arguments.  
+   This is r3 in our case */
+#define STACK_POINTER_REGNUM  REG_R3
+
+/* Base register for access to local variables of the function.
+   This is r2 in our case   */
+#define FRAME_POINTER_REGNUM  REG_R2
+
+/* We can debug without the frame pointer */
+#define CAN_DEBUG_WITHOUT_FP 1
+
+/* The 1610 saves the return address in this register */
+#define RETURN_ADDRESS_REGNUM REG_PR
+
+/* Base register for access to arguments of the function.  */
+#define ARG_POINTER_REGNUM FRAME_POINTER_REGNUM
+
+/* Register in which static-chain is passed to a function.  */
+
+#define STATIC_CHAIN_REGNUM 4
+
+/* Register in which address to store a structure value
+   is passed to a function.  This is 'r0' in our case */
+#define STRUCT_VALUE_REGNUM   REG_R0
+
+/* Define the classes of registers for register constraints in the
+   machine description.  Also define ranges of constants.
+
+   One of the classes must always be named ALL_REGS and include all hard regs.
+   If there is more than one class, another class must be named NO_REGS
+   and contain no registers.
+
+   The name GENERAL_REGS must be the name of a class (or an alias for
+   another name such as ALL_REGS).  This is the class of registers
+   that is allowed by "g" or "r" in a register constraint.
+   Also, registers outside this class are allocated only when
+   instructions express preferences for them.
+
+   The classes must be numbered in nondecreasing order; that is,
+   a larger-numbered class must never be contained completely
+   in a smaller-numbered class.
+
+   For any two classes, it is very desirable that there be another
+   class that represents their union.  */
+
+
+enum reg_class 
+{ 
+    NO_REGS, 
+    A0H_REG,
+    A0L_REG,
+    A0_REG,
+    A1H_REG,
+    ACCUM_HIGH_REGS,
+    A1L_REG,
+    ACCUM_LOW_REGS, 
+    A1_REG,
+    ACCUM_REGS, 
+    X_REG, 
+    X_OR_ACCUM_LOW_REGS,
+    X_OR_ACCUM_REGS,
+    YH_REG,
+    YH_OR_ACCUM_HIGH_REGS,
+    X_OR_YH_REGS,
+    YL_REG,
+    YL_OR_ACCUM_LOW_REGS,
+    X_OR_YL_REGS,
+    X_OR_Y_REGS,
+    Y_REG,
+    ACCUM_OR_Y_REGS,
+    PH_REG,
+    X_OR_PH_REGS, 
+    PL_REG, 
+    PL_OR_ACCUM_LOW_REGS,
+    X_OR_PL_REGS,
+    YL_OR_PL_OR_ACCUM_LOW_REGS,
+    P_REG,
+    ACCUM_OR_P_REGS,
+    YL_OR_P_REGS,
+    ACCUM_LOW_OR_YL_OR_P_REGS,
+    Y_OR_P_REGS,
+    ACCUM_Y_OR_P_REGS, 
+    NO_FRAME_Y_ADDR_REGS,
+    Y_ADDR_REGS, 
+    ACCUM_LOW_OR_Y_ADDR_REGS,
+    ACCUM_OR_Y_ADDR_REGS,
+    X_OR_Y_ADDR_REGS,
+    Y_OR_Y_ADDR_REGS,
+    P_OR_Y_ADDR_REGS,
+    NON_HIGH_YBASE_ELIGIBLE_REGS,
+    YBASE_ELIGIBLE_REGS,
+    J_REG,
+    J_OR_DAU_16_BIT_REGS,
+    BMU_REGS, 
+    NOHIGH_NON_ADDR_REGS,
+    NON_ADDR_REGS,
+    SLOW_MEM_LOAD_REGS,
+    NOHIGH_NON_YBASE_REGS,
+    NO_ACCUM_NON_YBASE_REGS,
+    NON_YBASE_REGS,
+    YBASE_VIRT_REGS,
+    ACCUM_LOW_OR_YBASE_REGS,
+    ACCUM_OR_YBASE_REGS,
+    X_OR_YBASE_REGS,
+    Y_OR_YBASE_REGS,
+    ACCUM_LOW_YL_PL_OR_YBASE_REGS,
+    P_OR_YBASE_REGS,
+    ACCUM_Y_P_OR_YBASE_REGS,
+    Y_ADDR_OR_YBASE_REGS,
+    YBASE_OR_NOHIGH_YBASE_ELIGIBLE_REGS,
+    YBASE_OR_YBASE_ELIGIBLE_REGS,
+    NO_HIGH_ALL_REGS,
+    ALL_REGS, 
+    LIM_REG_CLASSES 
+};
+
+/* GENERAL_REGS must be the name of a register class */
+#define GENERAL_REGS ALL_REGS
+
+#define N_REG_CLASSES (int) LIM_REG_CLASSES
+
+/* Give names of register classes as strings for dump file.  */
+
+#define REG_CLASS_NAMES        \
+{                              \
+    "NO_REGS",                 \
+    "A0H_REG",                 \
+    "A0L_REG",                 \
+    "A0_REG",                  \
+    "A1H_REG",                 \
+    "ACCUM_HIGH_REGS",         \
+    "A1L_REG",                 \
+    "ACCUM_LOW_REGS",          \
+    "A1_REG",                  \
+    "ACCUM_REGS",              \
+    "X_REG",                   \
+    "X_OR_ACCUM_LOW_REGS",     \
+    "X_OR_ACCUM_REGS",         \
+    "YH_REG",                  \
+    "YH_OR_ACCUM_HIGH_REGS",   \
+    "X_OR_YH_REGS",            \
+    "YL_REG",                  \
+    "YL_OR_ACCUM_LOW_REGS",    \
+    "X_OR_YL_REGS",            \
+    "X_OR_Y_REGS",             \
+    "Y_REG",                   \
+    "ACCUM_OR_Y_REGS",         \
+    "PH_REG",                  \
+    "X_OR_PH_REGS",            \
+    "PL_REG",                  \
+    "PL_OR_ACCUM_LOW_REGS",    \
+    "X_OR_PL_REGS",            \
+    "PL_OR_YL_OR_ACCUM_LOW_REGS", \
+    "P_REG",                   \
+    "ACCUM_OR_P_REGS",         \
+    "YL_OR_P_REGS",            \
+    "ACCUM_LOW_OR_YL_OR_P_REGS", \
+    "Y_OR_P_REGS",             \
+    "ACCUM_Y_OR_P_REGS",       \
+    "NO_FRAME_Y_ADDR_REGS",      \
+    "Y_ADDR_REGS",               \
+    "ACCUM_LOW_OR_Y_ADDR_REGS",  \
+    "ACCUM_OR_Y_ADDR_REGS",    \
+    "X_OR_Y_ADDR_REGS",        \
+    "Y_OR_Y_ADDR_REGS",        \
+    "P_OR_Y_ADDR_REGS",        \
+    "NON_HIGH_YBASE_ELIGIBLE_REGS", \
+    "YBASE_ELIGIBLE_REGS",     \
+    "J_REG",                   \
+    "J_OR_DAU_16_BIT_REGS",    \
+    "BMU_REGS",                \
+    "NOHIGH_NON_ADDR_REGS",    \
+    "NON_ADDR_REGS",           \
+    "SLOW_MEM_LOAD_REGS",      \
+    "NOHIGH_NON_YBASE_REGS",   \
+    "NO_ACCUM_NON_YBASE_REGS", \
+    "NON_YBASE_REGS",          \
+    "YBASE_VIRT_REGS",         \
+    "ACCUM_LOW_OR_YBASE_REGS", \
+    "ACCUM_OR_YBASE_REGS",     \
+    "X_OR_YBASE_REGS",         \
+    "Y_OR_YBASE_REGS",         \
+    "ACCUM_LOW_YL_PL_OR_YBASE_REGS", \
+    "P_OR_YBASE_REGS",         \
+    "ACCUM_Y_P_OR_YBASE_REGS", \
+    "Y_ADDR_OR_YBASE_REGS",    \
+    "YBASE_OR_NOHIGH_YBASE_ELIGIBLE_REGS", \
+    "YBASE_OR_YBASE_ELIGIBLE_REGS", \
+    "NO_HIGH_ALL_REGS",        \
+    "ALL_REGS"                 \
+}
+
+/* Define which registers fit in which classes.
+   This is an initializer for a vector of HARD_REG_SET
+   of length N_REG_CLASSES.  */
+
+#define REG_CLASS_CONTENTS   \
+{                            \
+    {0x00000000,  0x00000000},      /* no reg */                             \
+    {0x00000001,  0x00000000},      /* a0h */                                \
+    {0x00000002,  0x00000000},      /* a0l */                                \
+    {0x00000003,  0x00000000},      /* a0h:a0l */                            \
+    {0x00000004,  0x00000000},      /* a1h */                                \
+    {0x00000005,  0x00000000},      /* accum high */                         \
+    {0x00000008,  0x00000000},      /* a1l */                                \
+    {0x0000000A,  0x00000000},      /* accum low */                          \
+    {0x0000000c,  0x00000000},      /* a1h:a1l */                            \
+    {0x0000000f,  0x00000000},      /* accum regs */                         \
+    {0x00000010,  0x00000000},      /* x reg */                              \
+    {0x0000001A,  0x00000000},      /* x & accum_low_regs */                 \
+    {0x0000001f,  0x00000000},      /* x & accum regs */                     \
+    {0x00000020,  0x00000000},      /* y high */                             \
+    {0x00000025,  0x00000000},      /* yh, accum high */                     \
+    {0x00000030,  0x00000000},      /* x & yh */                             \
+    {0x00000040,  0x00000000},      /* y low */                              \
+    {0x0000004A,  0x00000000},      /* y low, accum_low */                   \
+    {0x00000050,  0x00000000},      /* x & yl */                             \
+    {0x00000060,  0x00000000},      /* yl:yh */                              \
+    {0x00000070,  0x00000000},      /* x, yh,a nd yl */                      \
+    {0x0000006F,  0x00000000},      /* accum, y */                           \
+    {0x00000080,  0x00000000},      /* p high */                             \
+    {0x00000090,  0x00000000},      /* x & ph */                             \
+    {0x00000100,  0x00000000},      /* p low */                              \
+    {0x0000010A,  0x00000000},      /* p_low and accum_low */                \
+    {0x00000110,  0x00000000},      /* x & pl */                             \
+    {0x0000014A,  0x00000000},      /* pl,yl,a1l,a0l */                      \
+    {0x00000180,  0x00000000},      /* pl:ph */                              \
+    {0x0000018F,  0x00000000},      /* accum, p */                           \
+    {0x000001C0,  0x00000000},      /* pl:ph and yl */                       \
+    {0x000001CA,  0x00000000},      /* pl:ph, yl, a0l, a1l */                \
+    {0x000001E0,  0x00000000},      /* y or p */                             \
+    {0x000001EF,  0x00000000},      /* accum, y or p */                      \
+    {0x00000E00,  0x00000000},      /* r0-r2 */                              \
+    {0x00001E00,  0x00000000},      /* r0-r3 */                              \
+    {0x00001E0A,  0x00000000},      /* r0-r3, accum_low */                   \
+    {0x00001E0F,  0x00000000},      /* accum,r0-r3 */                        \
+    {0x00001E10,  0x00000000},      /* x,r0-r3 */                            \
+    {0x00001E60,  0x00000000},      /* y,r0-r3 */                            \
+    {0x00001F80,  0x00000000},      /* p,r0-r3 */                            \
+    {0x00001FDA,  0x00000000},      /* ph:pl, r0-r3, x,a0l,a1l */            \
+    {0x00001fff,  0x00000000},      /* accum,x,y,p,r0-r3 */                  \
+    {0x00002000,  0x00000000},      /* j */                                  \
+    {0x00002025,  0x00000000},      /* j, yh, a1h, a0h */                    \
+    {0x001E0000,  0x00000000},      /* ar0-ar3 */                            \
+    {0x03FFE1DA,  0x00000000},      /* non_addr except yh,a0h,a1h */         \
+    {0x03FFE1FF,  0x00000000},      /* non_addr regs */                      \
+    {0x03FFFF8F,  0x00000000},      /* non ybase except yh, yl, and x */     \
+    {0x03FFFFDA,  0x00000000},      /* non ybase regs except yh,a0h,a1h */   \
+    {0x03FFFFF0,  0x00000000},      /* non ybase except a0,a0l,a1,a1l */     \
+    {0x03FFFFFF,  0x00000000},      /* non ybase regs */                     \
+    {0xFC000000,  0x03FFFFFF},      /* virt ybase regs */                    \
+    {0xFC00000A,  0x03FFFFFF},      /* accum_low, virt ybase regs */         \
+    {0xFC00000F,  0x03FFFFFF},      /* accum, virt ybase regs */             \
+    {0xFC000010,  0x03FFFFFF},      /* x,virt ybase regs */                  \
+    {0xFC000060,  0x03FFFFFF},      /* y,virt ybase regs */                  \
+    {0xFC00014A,  0x03FFFFFF},      /* accum_low, yl, pl, ybase */           \
+    {0xFC000180,  0x03FFFFFF},      /* p,virt ybase regs */                  \
+    {0xFC0001EF,  0x03FFFFFF},      /* accum,y,p,ybase regs */               \
+    {0xFC001E00,  0x03FFFFFF},      /* r0-r3, ybase regs */                  \
+    {0xFC001FDA,  0x03FFFFFF},      /* r0-r3, pl:ph,yl,x,a1l,a0l */          \
+    {0xFC001FFF,  0x03FFFFFF},      /* virt ybase, ybase eligible regs */    \
+    {0xFCFFFFDA,  0x03FFFFFF},      /* all regs except yh,a0h,a1h */         \
+    {0xFFFFFFFF,  0x03FFFFFF}       /* all regs */                           \
+}
+
+
+/* The same information, inverted:
+   Return the class number of the smallest class containing
+   reg number REGNO.  This could be a conditional expression
+   or could index an array.  */
+
+#define REGNO_REG_CLASS(REGNO) regno_reg_class(REGNO)
+
+/* The class value for index registers, and the one for base regs.  */
+
+#define INDEX_REG_CLASS NO_REGS
+#define BASE_REG_CLASS  Y_ADDR_REGS
+
+/* Get reg_class from a letter such as appears in the machine description.  */
+
+#define REG_CLASS_FROM_LETTER(C) \
+  dsp16xx_reg_class_from_letter(C)
+
+#define SECONDARY_RELOAD_CLASS(CLASS, MODE, X)  \
+   secondary_reload_class(CLASS, MODE, X)
+
+/* When defined, the compiler allows registers explicitly used in the
+   rtl to be used as spill registers but prevents the compiler from
+   extending the lifetime of these registers.  */
+
+#define SMALL_REGISTER_CLASSES 1
+
+/* Macros to check register numbers against specific register classes.  */
+
+/* These assume that REGNO is a hard or pseudo reg number.
+   They give nonzero only if REGNO is a hard reg of the suitable class
+   or a pseudo reg currently allocated to a suitable hard reg.
+   Since they use reg_renumber, they are safe only once reg_renumber
+   has been allocated, which happens in local-alloc.c.  */
+
+/* A C expression which is nonzero if register REGNO is suitable for use
+   as a base register in operand addresses. It may be either a suitable
+   hard register or a pseudo register that has been allocated such a
+   hard register. 
+
+  On the 1610 the Y address pointers can be used as a base registers */
+#define REGNO_OK_FOR_BASE_P(REGNO) \
+(((REGNO) >= REG_R0 && (REGNO) < REG_R3 + 1) || ((unsigned) reg_renumber[REGNO] >= REG_R0  \
+                                   && (unsigned) reg_renumber[REGNO] < REG_R3 + 1))
+
+#define REGNO_OK_FOR_YBASE_P(REGNO) \
+  (((REGNO) == REG_YBASE) || ((unsigned) reg_renumber[REGNO] == REG_YBASE))
+
+#define REGNO_OK_FOR_INDEX_P(REGNO)  0
+
+#ifdef ALL_16_BIT_REGISTERS
+#define IS_32_BIT_REG(REGNO)  0
+#else
+#define IS_32_BIT_REG(REGNO)     \
+  ((REGNO) == REG_A0 || (REGNO) == REG_A1 || (REGNO) == REG_Y || (REGNO) == REG_PROD)
+#endif
+
+/* Given an rtx X being reloaded into a reg required to be
+   in class CLASS, return the class of reg to actually use.
+   In general this is just CLASS; but on some machines
+   in some cases it is preferable to use a more restrictive class.
+   Also, we must ensure that a PLUS is reloaded either
+   into an accumulator or an address register.  */
+
+#define PREFERRED_RELOAD_CLASS(X,CLASS)	 preferred_reload_class (X, CLASS)
+
+/*   A C expression that places additional restrictions on the register
+     class to use when it is necessary to be able to hold a value of
+     mode MODE in a reload register for which class CLASS would
+     ordinarily be used.
+
+     Unlike `PREFERRED_RELOAD_CLASS', this macro should be used when
+     there are certain modes that simply can't go in certain reload
+     classes.
+
+     The value is a register class; perhaps CLASS, or perhaps another,
+     smaller class.
+
+     Don't define this macro unless the target machine has limitations
+     which require the macro to do something nontrivial.  */
+
+#if 0
+#define LIMIT_RELOAD_CLASS(MODE, CLASS) dsp16xx_limit_reload_class (MODE, CLASS)
+#endif
+
+/* A C expression for the maximum number of consecutive registers of class CLASS
+   needed to hold a value of mode MODE */
+#define CLASS_MAX_NREGS(CLASS, MODE)                                \
+    class_max_nregs(CLASS, MODE)
+
+/* The letters 'I' through 'P' in a register constraint string
+   can be used to stand for particular ranges of immediate operands.
+   This macro defines what the ranges are.
+   C is the letter, and VALUE is a constant value.
+   Return 1 if VALUE is in the range specified by C.
+
+   For the 16xx, the following constraints are used:
+   'I' requires a non-negative 16-bit value.
+   'J' requires a non-negative 9-bit value
+   'K' requires a constant 0 operand.
+   'L' constant for use in add or sub from low 16-bits
+   'M' 32-bit value -- low 16-bits zero
+   'N' constant for use incrementing or decrementing an address register
+   'O' constant for use with and'ing only high 16-bit
+   'P' constant for use with and'ing only low 16-bit
+ */
+
+#define SMALL_INT(X) (SMALL_INTVAL (INTVAL (X)))
+#define SMALL_INTVAL(I) ((unsigned) (I) < 0x10000)
+#define SHORT_IMMEDIATE(X)  (SHORT_INTVAL (INTVAL(X)))
+#define SHORT_INTVAL(I)     ((unsigned) (I) < 0x100)
+#define ADD_LOW_16(I)       ((I) >= 0 && (I) <= 32767)
+#define ADD_HIGH_16(I)      (((I) & 0x0000ffff) == 0)
+#define AND_LOW_16(I)       ((I) >= 0 && (I) <= 32767)
+#define AND_HIGH_16(I)      (((I) & 0x0000ffff) == 0)
+
+#define CONST_OK_FOR_LETTER_P(VALUE, C)                           \
+   ((C) == 'I' ? (SMALL_INTVAL(VALUE))                            \
+    : (C) == 'J' ? (SHORT_INTVAL(VALUE))                          \
+    : (C) == 'K' ? ((VALUE) == 0)                                 \
+    : (C) == 'L' ? ((VALUE) >= 0 && (VALUE) <= 32767)             \
+    : (C) == 'M' ? (((VALUE) & 0x0000ffff) == 0)                  \
+    : (C) == 'N' ? ((VALUE) == -1 || (VALUE) == 1                 \
+                    || (VALUE) == -2 || (VALUE) == 2)             \
+    : (C) == 'O' ? (((VALUE) & 0xffff0000) == 0xffff0000)         \
+    : (C) == 'P' ? (((VALUE) & 0x0000ffff) == 0xffff)             \
+    : 0)
+
+#define CONST_DOUBLE_OK_FOR_LETTER_P(VALUE, C)   1
+
+/* Optional extra constraints for this machine */
+#define EXTRA_CONSTRAINT(OP,C)                                    \
+  ((C) == 'R' ? symbolic_address_p (OP)                           \
+   : 0)
+
+/* DESCRIBING STACK LAYOUT AND CALLING CONVENTIONS */
+
+/* Define this if pushing a word on the stack
+   makes the stack pointer a smaller address.  */
+/* #define STACK_GROWS_DOWNWARD */
+
+/* Define this if the nominal address of the stack frame
+   is at the high-address end of the local variables;
+   that is, each additional local variable allocated
+   goes at a more negative offset in the frame.  */
+/* #define FRAME_GROWS_DOWNWARD */
+
+#define ARGS_GROW_DOWNWARD
+
+/* We use post decrement on the 1600 because there isn't
+   a pre-decrement addressing mode. This means that we
+   assume the stack pointer always points at the next
+   FREE location on the stack.  */
+#define STACK_PUSH_CODE POST_INC
+
+/* Offset within stack frame to start allocating local variables at.
+   If FRAME_GROWS_DOWNWARD, this is the offset to the END of the
+   first local allocated.  Otherwise, it is the offset to the BEGINNING
+   of the first local allocated.  */
+#define STARTING_FRAME_OFFSET  0
+
+/* Offset from the stack pointer register to the first
+   location at which outgoing arguments are placed.  */
+#define STACK_POINTER_OFFSET (0)
+
+struct dsp16xx_frame_info
+{
+  unsigned long total_size;	/* # bytes that the entire frame takes up */
+  unsigned long var_size;	/* # bytes that variables take up */
+  unsigned long args_size;	/* # bytes that outgoing arguments take up */
+  unsigned long extra_size;	/* # bytes of extra gunk */
+  unsigned int  reg_size;	/* # bytes needed to store regs */
+  long		fp_save_offset;	/* offset from vfp to store registers */
+  unsigned long sp_save_offset;	/* offset from new sp to store registers */
+  int		pr_save_offset;	/* offset to saved PR */
+  int		initialized;	/* != 0 if frame size already calculated */
+  int		num_regs;	/* number of registers saved */
+  int           function_makes_calls;  /* Does the function make calls */
+};
+
+extern struct dsp16xx_frame_info current_frame_info;
+
+#define RETURN_ADDR_OFF current_frame_info.pr_save_offset
+
+/* If we generate an insn to push BYTES bytes,
+   this says how many the stack pointer really advances by.  */
+/* #define PUSH_ROUNDING(BYTES) ((BYTES)) */
+
+/* If defined, the maximum amount of space required for outgoing
+   arguments will be computed and placed into the variable
+   'current_function_outgoing_args_size'. No space will be pushed
+   onto the stack for each call; instead, the function prologue should
+   increase the stack frame size by this amount.
+
+   It is not proper to define both 'PUSH_ROUNDING' and
+   'ACCUMULATE_OUTGOING_ARGS'.  */
+#define ACCUMULATE_OUTGOING_ARGS 1
+
+/* Offset of first parameter from the argument pointer
+   register value.  */
+
+#define FIRST_PARM_OFFSET(FNDECL)   (0)
+
+/* Value is 1 if returning from a function call automatically
+   pops the arguments described by the number-of-args field in the call.
+   FUNDECL is the declaration node of the function (as a tree),
+   FUNTYPE is the data type of the function (as a tree),
+   or for a library call it is an identifier node for the subroutine name.  */
+
+#define RETURN_POPS_ARGS(FUNDECL,FUNTYPE,SIZE) 0
+
+/* Define how to find the value returned by a function.
+   VALTYPE is the data type of the value (as a tree).
+   If the precise function being called is known, FUNC is its FUNCTION_DECL;
+   otherwise, FUNC is 0. On the 1610 all function return their values
+   in a0 (i.e. the upper 16 bits). If the return value is 32-bits the
+   entire register is significant.  */
+
+#define VALUE_REGNO(MODE)  (REG_Y)
+
+#define FUNCTION_VALUE(VALTYPE, FUNC)  \
+  gen_rtx_REG (TYPE_MODE (VALTYPE), VALUE_REGNO(TYPE_MODE(VALTYPE)))
+
+/* Define how to find the value returned by a library function
+   assuming the value has mode MODE.  */
+#define LIBCALL_VALUE(MODE)  gen_rtx_REG (MODE, VALUE_REGNO(MODE))
+
+/* 1 if N is a possible register number for a function value.  */
+#define FUNCTION_VALUE_REGNO_P(N) ((N) == REG_Y)
+
+
+/* Define where to put the arguments to a function.
+   Value is zero to push the argument on the stack,
+   or a hard register in which to store the argument.
+
+   MODE is the argument's machine mode.
+   TYPE is the data type of the argument (as a tree).
+    This is null for libcalls where that information may
+    not be available.
+   CUM is a variable of type CUMULATIVE_ARGS which gives info about
+    the preceding args and about the function being called.
+   NAMED is nonzero if this argument is a named parameter
+    (otherwise it is an extra parameter matching an ellipsis).  */
+
+/* On the 1610 all args are pushed, except if -mregparm is specified
+   then the first two words of arguments are passed in a0, a1.  */
+#define FUNCTION_ARG(CUM, MODE, TYPE, NAMED) \
+  dsp16xx_function_arg (CUM, MODE, TYPE, NAMED)
+
+/* Define the first register to be used for argument passing */
+#define FIRST_REG_FOR_FUNCTION_ARG REG_Y
+
+/* Define the profitability of saving registers around calls.
+   NOTE: For now we turn this off because of a bug in the
+   caller-saves code and also because i'm not sure it is helpful
+   on the 1610.  */
+
+#define CALLER_SAVE_PROFITABLE(REFS,CALLS) 0
+
+/* This indicates that an argument is to be passed with an invisible reference
+   (i.e., a pointer to the object is passed).
+
+   On the dsp16xx, we do this if it must be passed on the stack.  */
+
+#define FUNCTION_ARG_PASS_BY_REFERENCE(CUM, MODE, TYPE, NAMED)	\
+  (MUST_PASS_IN_STACK (MODE, TYPE))
+
+/* For an arg passed partly in registers and partly in memory,
+   this is the number of registers used.
+   For args passed entirely in registers or entirely in memory, zero.  */
+
+#define FUNCTION_ARG_PARTIAL_NREGS(CUM, MODE, TYPE, NAMED)  (0)
+
+/* Define a data type for recording info about an argument list
+   during the scan of that argument list.  This data type should
+   hold all necessary information about the function itself
+   and about the args processed so far, enough to enable macros
+   such as FUNCTION_ARG to determine where the next arg should go.  */
+#define CUMULATIVE_ARGS int
+
+/* Initialize a variable CUM of type CUMULATIVE_ARGS
+   for a call to a function whose data type is FNTYPE.
+   For a library call, FNTYPE is 0.  */
+#define INIT_CUMULATIVE_ARGS(CUM, FNTYPE, LIBNAME, INDIRECT, N_NAMED_ARGS) \
+  ((CUM) = 0)
+
+/* Update the data in CUM to advance over an argument
+   of mode MODE and data type TYPE.
+   (TYPE is null for libcalls where that information may not be available.)  */
+
+#define FUNCTION_ARG_ADVANCE(CUM, MODE, TYPE, NAMED)	\
+  dsp16xx_function_arg_advance (&CUM, MODE,TYPE, NAMED)
+
+/* 1 if N is a possible register number for function argument passing.  */
+#define FUNCTION_ARG_REGNO_P(N)   \
+  ((N) == REG_Y || (N) == REG_YL || (N) == REG_PROD || (N) == REG_PRODL)
+
+/* Output assembler code to FILE to increment profiler label # LABELNO
+   for profiling a function entry.  */
+
+#define FUNCTION_PROFILER(FILE, LABELNO)        \
+  internal_error ("profiling not implemented yet")
+
+/* EXIT_IGNORE_STACK should be nonzero if, when returning from a function,
+   the stack pointer does not matter.  The value is tested only in
+   functions that have frame pointers.
+   No definition is equivalent to always zero.  */
+
+#define EXIT_IGNORE_STACK  (0)
+
+#define TRAMPOLINE_TEMPLATE(FILE) \
+  internal_error ("trampolines not yet implemented");
+
+/* Length in units of the trampoline for entering a nested function.
+   This is a dummy value  */
+
+#define TRAMPOLINE_SIZE 20
+
+/* Emit RTL insns to initialize the variable parts of a trampoline.
+   FNADDR is an RTX for the address of the function's pure code.
+   CXT is an RTX for the static chain value for the function.  */
+
+#define INITIALIZE_TRAMPOLINE(TRAMP, FNADDR, CXT)			\
+  internal_error ("trampolines not yet implemented");
+
+/* A C expression which is nonzero if a function must have and use a
+   frame pointer. If its value is nonzero the functions will have a
+   frame pointer.  */
+#define FRAME_POINTER_REQUIRED  (current_function_calls_alloca)
+
+/* A C statement to store in the variable 'DEPTH' the difference
+   between the frame pointer and the stack pointer values immediately
+   after the function prologue.  */
+#define INITIAL_FRAME_POINTER_OFFSET(DEPTH)                     \
+{  (DEPTH) = initial_frame_pointer_offset();	                \
+}
+
+/* IMPLICIT CALLS TO LIBRARY ROUTINES */
+
+#define ADDHF3_LIBCALL      "__Emulate_addhf3"
+#define SUBHF3_LIBCALL      "__Emulate_subhf3"
+#define MULHF3_LIBCALL      "__Emulate_mulhf3"
+#define DIVHF3_LIBCALL      "__Emulate_divhf3"
+#define CMPHF3_LIBCALL      "__Emulate_cmphf3"
+#define FIXHFHI2_LIBCALL    "__Emulate_fixhfhi2"
+#define FLOATHIHF2_LIBCALL  "__Emulate_floathihf2"
+#define NEGHF2_LIBCALL      "__Emulate_neghf2"
+
+#define UMULHI3_LIBCALL     "__Emulate_umulhi3"
+#define MULHI3_LIBCALL      "__Emulate_mulhi3"
+#define UDIVQI3_LIBCALL     "__Emulate_udivqi3"
+#define UDIVHI3_LIBCALL     "__Emulate_udivhi3"
+#define DIVQI3_LIBCALL      "__Emulate_divqi3"
+#define DIVHI3_LIBCALL      "__Emulate_divhi3"
+#define MODQI3_LIBCALL      "__Emulate_modqi3"
+#define MODHI3_LIBCALL      "__Emulate_modhi3"
+#define UMODQI3_LIBCALL     "__Emulate_umodqi3"
+#define UMODHI3_LIBCALL     "__Emulate_umodhi3"
+#define ASHRHI3_LIBCALL     "__Emulate_ashrhi3"
+#define LSHRHI3_LIBCALL     "__Emulate_lshrhi3"
+#define ASHLHI3_LIBCALL     "__Emulate_ashlhi3"
+#define LSHLHI3_LIBCALL     "__Emulate_lshlhi3"   /* NOT USED */
+
+/* Define this macro if calls to the ANSI C library functions memcpy and
+   memset should be generated instead of the BSD function bcopy & bzero.  */
+#define TARGET_MEM_FUNCTIONS
+
+
+/* ADDRESSING MODES */
+
+/* The 1610 has post-increment and decrement, but no pre-modify */
+#define HAVE_POST_INCREMENT 1
+#define HAVE_POST_DECREMENT 1
+
+/* Recognize any constant value that is a valid address.  */
+#define CONSTANT_ADDRESS_P(X)  CONSTANT_P (X)
+
+/* Maximum number of registers that can appear in a valid memory address.  */
+#define MAX_REGS_PER_ADDRESS 1
+
+/* The macros REG_OK_FOR..._P assume that the arg is a REG rtx
+   and check its validity for a certain class.
+   We have two alternate definitions for each of them.
+   The usual definition accepts all pseudo regs; the other rejects
+   them unless they have been allocated suitable hard regs.
+   The symbol REG_OK_STRICT causes the latter definition to be used.
+
+   Most source files want to accept pseudo regs in the hope that
+   they will get allocated to the class that the insn wants them to be in.
+   Source files for reload pass need to be strict.
+   After reload, it makes no difference, since pseudo regs have
+   been eliminated by then.  */
+
+#ifndef REG_OK_STRICT
+
+/* Nonzero if X is a hard reg that can be used as an index
+   or if it is a pseudo reg.  */
+#define REG_OK_FOR_INDEX_P(X)  0
+
+/* Nonzero if X is a hard reg that can be used as a base reg
+   or if it is a pseudo reg.  */
+#define REG_OK_FOR_BASE_P(X)    \
+    ((REGNO (X) >= REG_R0 && REGNO (X) < REG_R3 + 1 )          \
+       || (REGNO (X) >= FIRST_PSEUDO_REGISTER))
+
+/* Nonzero if X is the 'ybase' register */
+#define REG_OK_FOR_YBASE_P(X)   \
+  (REGNO(X) == REG_YBASE || (REGNO (X) >= FIRST_PSEUDO_REGISTER))
+#else
+
+/* Nonzero if X is a hard reg that can be used as an index.  */
+#define REG_OK_FOR_INDEX_P(X) REGNO_OK_FOR_INDEX_P (REGNO (X))
+
+/* Nonzero if X is a hard reg that can be used as a base reg.  */
+#define REG_OK_FOR_BASE_P(X) REGNO_OK_FOR_BASE_P (REGNO (X))
+
+/* Nonzero if X is the 'ybase' register */
+#define REG_OK_FOR_YBASE_P(X) REGNO_OK_FOR_YBASE_P (REGNO(X))
+
+#endif
+
+/* GO_IF_LEGITIMATE_ADDRESS recognizes an RTL expression
+   that is a valid memory address for an instruction.
+   The MODE argument is the machine mode for the MEM expression
+   that wants to use this address.
+
+   On the 1610, the actual legitimate addresses must be N (N must fit in
+   5 bits), *rn (register indirect), *rn++, or *rn-- */
+
+#define INT_FITS_5_BITS(I)    ((unsigned long) (I) < 0x20)
+#define INT_FITS_16_BITS(I)   ((unsigned long) (I) < 0x10000)
+#define YBASE_CONST_OFFSET(I)       ((I) >= -31 && (I) <= 0)
+#define YBASE_OFFSET(X)       (GET_CODE (X) == CONST_INT && YBASE_CONST_OFFSET (INTVAL(X)))
+
+#define FITS_16_BITS(X)       (GET_CODE (X) == CONST_INT && INT_FITS_16_BITS(INTVAL(X)))
+#define FITS_5_BITS(X)        (GET_CODE (X) == CONST_INT && INT_FITS_5_BITS(INTVAL(X)))
+#define ILLEGAL_HIMODE_ADDR(MODE, CONST)  ((MODE) == HImode && CONST == -31)
+
+#define INDIRECTABLE_ADDRESS_P(X)                            \
+    ((GET_CODE(X) == REG && REG_OK_FOR_BASE_P(X))            \
+  || ((GET_CODE(X) == POST_DEC || GET_CODE(X) == POST_INC)   \
+       && REG_P(XEXP(X,0)) && REG_OK_FOR_BASE_P(XEXP(X,0)))  \
+  || (GET_CODE(X) == CONST_INT && (unsigned long) (X) < 0x20))
+
+
+#define INDEXABLE_ADDRESS_P(X,MODE)                                 \
+   ((GET_CODE(X) == PLUS && GET_CODE (XEXP (X,0)) == REG &&         \
+     XEXP(X,0) == stack_pointer_rtx && YBASE_OFFSET(XEXP(X,1)) &&   \
+     !ILLEGAL_HIMODE_ADDR(MODE, INTVAL(XEXP(X,1)))) ||              \
+    (GET_CODE(X) == PLUS && GET_CODE (XEXP (X,1)) == REG &&         \
+     XEXP(X,1) == stack_pointer_rtx && YBASE_OFFSET(XEXP(X,0)) &&  \
+     !ILLEGAL_HIMODE_ADDR(MODE, INTVAL(XEXP(X,0)))))
+
+#define GO_IF_LEGITIMATE_ADDRESS(MODE, X, ADDR)                     \
+{							            \
+    if (INDIRECTABLE_ADDRESS_P(X))                                  \
+        goto ADDR;                                                  \
+}
+
+
+/* Try machine-dependent ways of modifying an illegitimate address
+   to be legitimate.  If we find one, return the new, valid address.
+   This macro is used in only one place: `memory_address' in explow.c.
+
+   OLDX is the address as it was before break_out_memory_refs was called.
+   In some cases it is useful to look at this to decide what needs to be done.
+
+   MODE and WIN are passed so that this macro can use
+   GO_IF_LEGITIMATE_ADDRESS.
+
+   It is always safe for this macro to do nothing.  It exists to recognize
+   opportunities to optimize the output.
+
+   For the 1610, we need not do anything.  However, if we don't,
+   `memory_address' will try lots of things to get a valid address, most of
+   which will result in dead code and extra pseudos.  So we make the address
+   valid here.
+
+   This is easy:  The only valid addresses are an offset from a register
+   and we know the address isn't valid.  So just call either `force_operand'
+   or `force_reg' unless this is a (plus (reg ...) (const_int 0)).  */
+
+#define LEGITIMIZE_ADDRESS(X,OLDX,MODE,WIN)			\
+{ if (GET_CODE (X) == PLUS && XEXP (X, 1) == const0_rtx)	\
+    X = XEXP (x, 0);						\
+  if (GET_CODE (X) == MULT || GET_CODE (X) == PLUS)		\
+    X = force_operand (X, 0);					\
+  else								\
+    X = force_reg (Pmode, X);					\
+  goto WIN;							\
+}
+
+/* Go to LABEL if ADDR (a legitimate address expression)
+   has an effect that depends on the machine mode it is used for.
+   On the 1610, only postdecrement and postincrement address depend thus
+   (the amount of decrement or increment being the length of the operand).  */
+
+#define GO_IF_MODE_DEPENDENT_ADDRESS(ADDR,LABEL)	\
+ if (GET_CODE (ADDR) == POST_INC || GET_CODE (ADDR) == POST_DEC) goto LABEL
+
+/* Nonzero if the constant value X is a legitimate general operand.
+   It is given that X satisfies CONSTANT_P or is a CONST_DOUBLE.  */
+#define LEGITIMATE_CONSTANT_P(X) (1)
+
+
+/* CONDITION CODE INFORMATION */
+
+/* Store in cc_status the expressions
+   that the condition codes will describe
+   after execution of an instruction whose pattern is EXP.
+   Do not alter them if the instruction would not alter the cc's.  */
+
+#define NOTICE_UPDATE_CC(EXP, INSN) \
+   notice_update_cc( (EXP) )
+
+/* DESCRIBING RELATIVE COSTS OF OPERATIONS */
+
+/* A c expression for the cost of moving data from a register in
+   class FROM to one in class TO. The classes are expressed using
+   the enumeration values such as GENERAL_REGS. A value of 2 is
+   the default.  */
+#define REGISTER_MOVE_COST(MODE,FROM,TO)  dsp16xx_register_move_cost (FROM, TO)
+
+/* A C expression for the cost of moving data of mode MODE between
+   a register and memory. A value of 2 is the default.  */
+#define MEMORY_MOVE_COST(MODE,CLASS,IN)                          \
+  (GET_MODE_CLASS(MODE) == MODE_INT && MODE == QImode ? 12       \
+   : 16)
+
+/* A C expression for the cost of a branch instruction. A value of
+   1 is the default; */
+#define BRANCH_COST 1
+
+
+/* Define this because otherwise gcc will try to put the function address
+   in any old pseudo register. We can only use pt.  */
+#define NO_FUNCTION_CSE
+
+/* Define this macro as a C expression which is nonzero if accessing less
+   than a word of memory (i.e a char or short) is no faster than accessing
+   a word of memory, i.e if such access require more than one instruction
+   or if there is no difference in cost between byte and (aligned) word
+   loads.  */
+#define SLOW_BYTE_ACCESS 1
+
+/* Define this macro if unaligned accesses have a cost many times greater than
+   aligned accesses, for example if they are emulated in a trap handler */
+/* define SLOW_UNALIGNED_ACCESS(MODE, ALIGN) */
+
+
+/* DIVIDING THE OUTPUT IN SECTIONS */
+/* Output before read-only data.  */
+
+#define DEFAULT_TEXT_SEG_NAME ".text"
+#define TEXT_SECTION_ASM_OP  rsect_text
+
+/* Output before constants and strings */
+#define DEFAULT_CONST_SEG_NAME  ".const"
+#define READONLY_DATA_SECTION_ASM_OP rsect_const
+
+/* Output before writable data.  */
+#define DEFAULT_DATA_SEG_NAME ".data"
+#define DATA_SECTION_ASM_OP  rsect_data
+
+#define DEFAULT_BSS_SEG_NAME ".bss"
+#define BSS_SECTION_ASM_OP rsect_bss
+
+/* We will default to using 1610 if the user doesn't
+   specify it.  */
+#define DEFAULT_CHIP_NAME "1610"
+
+/* THE OVERALL FRAMEWORK OF AN ASSEMBLER FILE */
+
+/* A C string constant describing how to begin a comment in the target
+   assembler language.  */
+#define ASM_COMMENT_START ""
+#define ASM_COMMENT_END ""
+
+/* Output to assembler file text saying following lines
+   may contain character constants, extra white space, comments, etc.  */
+#define ASM_APP_ON ""
+
+/* Output to assembler file text saying following lines
+   no longer contain unusual constructs.  */
+#define ASM_APP_OFF ""
+
+/* OUTPUT OF DATA */
+
+/* This is how we output a 'c' character string. For the 16xx
+   assembler we have to do it one letter at a time */
+
+#define ASCII_LENGTH 10
+
+#define ASM_OUTPUT_ASCII(MYFILE, MYSTRING, MYLENGTH) \
+  do {									      \
+    FILE *_hide_asm_out_file = (MYFILE);				      \
+    const unsigned char *_hide_p = (const unsigned char *) (MYSTRING);	      \
+    int _hide_thissize = (MYLENGTH);					      \
+    {									      \
+      FILE *asm_out_file = _hide_asm_out_file;				      \
+      const unsigned char *p = _hide_p;					      \
+      int thissize = _hide_thissize;					      \
+      int i;								      \
+									      \
+      for (i = 0; i < thissize; i++)					      \
+	{								      \
+	  register int c = p[i];					      \
+	  								      \
+	  if (i % ASCII_LENGTH == 0) \
+	    fprintf (asm_out_file, "\tint ");				      \
+	    								\
+	  if (c >= ' ' && c < 0177 && c != '\'')			      \
+	  {								      \
+	    putc ('\'', asm_out_file);					      \
+	    putc (c, asm_out_file);					      \
+	    putc ('\'', asm_out_file);					      \
+	  }								      \
+	  else								      \
+	    {								      \
+	      fprintf (asm_out_file, "%d", c);			              \
+	      /* After an octal-escape, if a digit follows,		      \
+		 terminate one string constant and start another.	      \
+		 The VAX assembler fails to stop reading the escape	      \
+		 after three digits, so this is the only way we		      \
+		 can get it to parse the data properly.  		      \
+	      if (i < thissize - 1 && ISDIGIT (p[i + 1]))		      \
+		fprintf (asm_out_file, "\'\n\tint \'");		              \
+		*/ \
+	  }								      \
+	  /* if: \
+	     we are not at the last char (i != thissize -1) \
+	     and (we are not at a line break multiple  \
+	     but i == 0) (it will be the very first time) \
+	     then put out a comma to extend. \
+	   */ \
+	  if ((i != thissize - 1) && ((i + 1) % ASCII_LENGTH))	      \
+	    fprintf(asm_out_file, ",");	 	                      \
+	  if (!((i + 1) % ASCII_LENGTH)) \
+	    fprintf (asm_out_file, "\n");			      \
+	}								      \
+      fprintf (asm_out_file, "\n");					      \
+    }									      \
+  }									      \
+  while (0)
+
+#define ASM_PN_FORMAT "*L%s_%lu"
+
+/* OUTPUT OF UNINITIALIZED VARIABLES */
+
+/* This says how to output an assembler line
+   to define a global common symbol.  */
+
+#define ASM_OUTPUT_COMMON(FILE, NAME, SIZE, ROUNDED)  \
+  asm_output_common (FILE, NAME, SIZE, ROUNDED);
+
+/* This says how to output an assembler line
+   to define a local common symbol.  */
+
+#define ASM_OUTPUT_LOCAL(FILE, NAME, SIZE, ROUNDED)  \
+  asm_output_local (FILE, NAME, SIZE, ROUNDED);
+
+/* OUTPUT AND GENERATION OF LABELS */
+
+/* Globalizing directive for a label.  */
+#define GLOBAL_ASM_OP ".global "
+
+/* A C statement to output to the stdio stream any text necessary
+   for declaring the name of an external symbol named name which
+   is referenced in this compilation but not defined.  */
+
+#define ASM_OUTPUT_EXTERNAL(FILE, DECL, NAME)   \
+{					\
+	fprintf (FILE, ".extern ");	\
+	assemble_name (FILE, NAME);	\
+	fprintf (FILE, "\n");		\
+}
+/* A C statement to output on stream an assembler pseudo-op to
+   declare a library function named external.  */
+
+#define ASM_OUTPUT_EXTERNAL_LIBCALL(FILE, FUN)    \
+{						\
+	fprintf (FILE, ".extern ");		\
+	assemble_name (FILE, XSTR (FUN, 0));	\
+	fprintf (FILE, "\n");			\
+}
+
+/* The prefix to add to user-visible assembler symbols.  */
+
+#define USER_LABEL_PREFIX "_"
+
+/* This is how to store into the string LABEL
+   the symbol_ref name of an internal numbered label where
+   PREFIX is the class of label and NUM is the number within the class.
+   This is suitable for output with `assemble_name'.  */
+#define ASM_GENERATE_INTERNAL_LABEL(LABEL,PREFIX,NUM)	\
+  sprintf (LABEL, "*%s%lu", PREFIX, (unsigned long)(NUM))
+
+
+/* OUTPUT OF ASSEMBLER INSTRUCTIONS */
+
+/* How to refer to registers in assembler output.
+   This sequence is indexed by compiler's hard-register-number (see above).  */
+
+#define REGISTER_NAMES \
+{"a0", "a0l", "a1", "a1l", "x", "y", "yl", "p", "pl",  \
+ "r0", "r1", "r2",  "r3", "j", "k", "ybase", "pt",     \
+ "ar0", "ar1", "ar2", "ar3",                           \
+ "c0", "c1", "c2", "pr", "rb",                         \
+ "*(0)", "*(1)", "*(2)", "*(3)", "*(4)", "*(5)",       \
+ "*(6)", "*(7)", "*(8)", "*(9)", "*(10)", "*(11)",     \
+ "*(12)", "*(13)", "*(14)", "*(15)", "*(16)", "*(17)", \
+ "*(18)", "*(19)", "*(20)", "*(21)", "*(22)", "*(23)", \
+ "*(24)", "*(25)", "*(26)", "*(27)", "*(28)", "*(29)", \
+ "*(30)", "*(31)" }
+
+#define HIMODE_REGISTER_NAMES \
+{"a0", "a0", "a1", "a1", "x", "y", "y", "p", "p",  \
+ "r0", "r1", "r2",  "r3", "j", "k", "ybase", "pt",     \
+ "ar0", "ar1", "ar2", "ar3",                           \
+ "c0", "c1", "c2", "pr", "rb",                         \
+ "*(0)", "*(1)", "*(2)", "*(3)", "*(4)", "*(5)",       \
+ "*(6)", "*(7)", "*(8)", "*(9)", "*(10)", "*(11)",     \
+ "*(12)", "*(13)", "*(14)", "*(15)", "*(16)", "*(17)", \
+ "*(18)", "*(19)", "*(20)", "*(21)", "*(22)", "*(23)", \
+ "*(24)", "*(25)", "*(26)", "*(27)", "*(28)", "*(29)", \
+ "*(30)", "*(31)" }
+
+#define PRINT_OPERAND_PUNCT_VALID_P(CODE)  0
+
+/* Print operand X (an rtx) in assembler syntax to file FILE.
+   CODE is a letter or dot (`z' in `%z0') or 0 if no letter was specified.
+   For `%' followed by punctuation, CODE is the punctuation and X is null.
+   
+   DSP1610 extensions for operand codes:
+
+   %H - print lower 16 bits of constant
+   %U - print upper 16 bits of constant
+   %w - print low half of register (e.g 'a0l')
+   %u - print upper half of register (e.g 'a0')
+   %b - print high half of accumulator for F3 ALU instructions
+   %h - print constant in decimal   */
+
+#define PRINT_OPERAND(FILE, X, CODE) print_operand(FILE, X, CODE)
+
+
+/* Print a memory address as an operand to reference that memory location.  */
+
+#define PRINT_OPERAND_ADDRESS(FILE, ADDR)  print_operand_address (FILE, ADDR)
+
+/* This is how to output an insn to push a register on the stack.
+   It need not be very fast code since it is used only for profiling  */
+#define ASM_OUTPUT_REG_PUSH(FILE,REGNO)    \
+  internal_error ("profiling not implemented yet");
+
+/* This is how to output an insn to pop a register from the stack.
+   It need not be very fast code since it is used only for profiling  */
+#define ASM_OUTPUT_REG_POP(FILE,REGNO)     \
+  internal_error ("profiling not implemented yet"); 
+
+/* OUTPUT OF DISPATCH TABLES */
+
+/* This macro should be provided on machines where the addresses in a dispatch
+   table are relative to the table's own address.  */
+#define ASM_OUTPUT_ADDR_DIFF_ELT(FILE, BODY, VALUE, REL)  \
+  fprintf (FILE, "\tint L%d-L%d\n", VALUE, REL)
+
+/* This macro should be provided on machines where the addresses in a dispatch
+   table are absolute.  */
+#define ASM_OUTPUT_ADDR_VEC_ELT(FILE, VALUE)  \
+  fprintf (FILE, "\tint L%d\n", VALUE)
+
+/* ASSEMBLER COMMANDS FOR ALIGNMENT */
+
+/* This is how to output an assembler line that says to advance 
+   the location counter to a multiple of 2**LOG bytes. We should
+   not have to do any alignment since the 1610 is a word machine.  */
+#define ASM_OUTPUT_ALIGN(FILE,LOG)
+
+/* Define this macro if ASM_OUTPUT_SKIP should not be used in the text section
+   because it fails to put zero1 in the bytes that are skipped.  */
+#define ASM_NO_SKIP_IN_TEXT 1
+
+#define ASM_OUTPUT_SKIP(FILE,SIZE)  \
+  fprintf (FILE, "\t%d * int 0\n", (int)(SIZE))
+
+/* CONTROLLING DEBUGGING INFORMATION FORMAT */
+
+#define PREFERRED_DEBUGGING_TYPE DWARF2_DEBUG
+
+#define ASM_OUTPUT_DEF(asm_out_file, LABEL1, LABEL2) \
+         do {						\
+	 fprintf (asm_out_file, ".alias " ); \
+         ASM_OUTPUT_LABELREF(asm_out_file, LABEL1);  \
+	 fprintf (asm_out_file, "=" ); \
+         ASM_OUTPUT_LABELREF(asm_out_file, LABEL2); \
+	 fprintf (asm_out_file, "\n" );			\
+	 } while (0)
+
+
+/* MISCELLANEOUS PARAMETERS */
+
+/* Specify the machine mode that this machine uses
+   for the index in the tablejump instruction.  */
+#define CASE_VECTOR_MODE QImode
+
+/* Define as C expression which evaluates to nonzero if the tablejump
+   instruction expects the table to contain offsets from the address of the
+   table.
+   Do not define this if the table should contain absolute addresses.  */
+/* #define CASE_VECTOR_PC_RELATIVE 1 */
+
+/* Max number of bytes we can move from memory to memory
+   in one reasonably fast instruction.  */
+#define MOVE_MAX 1
+
+/* Defining this macro causes the compiler to omit a sign-extend, zero-extend,
+   or bitwise 'and' instruction that truncates the count of a shift operation
+   to a width equal to the number of bits needed to represent the size of the
+   object being shifted. Do not define this macro unless the truncation applies
+   to both shift operations and bit-field operations (if any).  */
+/* #define SHIFT_COUNT_TRUNCATED */
+
+/* Value is 1 if truncating an integer of INPREC bits to OUTPREC bits
+   is done just by pretending it is already truncated.  */
+#define TRULY_NOOP_TRUNCATION(OUTPREC, INPREC) 1
+
+/* When a prototype says `char' or `short', really pass an `int'.  */
+#define PROMOTE_PROTOTYPES 1
+
+/* An alias for the machine mode used for pointers */
+#define Pmode  QImode
+
+/* A function address in a call instruction
+   is a byte address (for indexing purposes)
+   so give the MEM rtx a byte's mode.  */
+#define FUNCTION_MODE  QImode
+
+#if !defined(__DATE__)
+#define TARGET_VERSION fprintf (stderr, " (%s)", VERSION_INFO1)
+#else
+#define TARGET_VERSION fprintf (stderr, " (%s, %s)", VERSION_INFO1, __DATE__)
+#endif
+
+#define VERSION_INFO1 "Lucent DSP16xx C Cross Compiler, version 1.3.0b"
+
+
+/* Define this as 1 if `char' should by default be signed; else as 0.  */
+#define DEFAULT_SIGNED_CHAR 1
+
+/* Define this so gcc does not output a call to __main, since we
+   are not currently supporting c++.  */
+#define INIT_SECTION_ASM_OP  1
+
diff --git a/gcc/config/dsp16xx/dsp16xx.md b/gcc/config/dsp16xx/dsp16xx.md
new file mode 100644
index 00000000000..fffd2a9d9e0
--- /dev/null
+++ b/gcc/config/dsp16xx/dsp16xx.md
@@ -0,0 +1,3049 @@
+;;- Machine description for the AT&T DSP1600 for GCC
+;;  Copyright (C) 1994, 1995, 1997, 1998, 2001, 2002
+;;  Free Software Foundation, Inc.
+;;  Contributed by Michael Collison (collison@isisinc.net).
+
+;; This file is part of GCC.
+
+;; GCC is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GCC is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GCC; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;- See file "rtl.def" for documentation on define_insn, match_*, et. al.
+
+;; Attribute specifications
+
+; Type of each instruction.  Default is arithmetic.
+; I'd like to write the list as this, but genattrtab won't accept it.
+;
+; "jump,cond_jump,call,			; flow-control instructions
+;  load_i,load, store, move		; Y space address arithmetic instructions
+;  malu,special,f3_alu,f3_alu_i		; data arithmetic unit instructions
+;  shift_i,shift, bfield_i, bfield	; bit manipulation unit instructions
+;  arith,				; integer unit instructions
+;  nop
+
+; Classification of each insn.  Some insns of TYPE_BRANCH are multi-word.
+(define_attr "type"
+  "jump,cond_jump,call,load_i,load,move,store,malu,malu_mul,tstqi,special,special_2,f3_alu,f3_alu_i,f3_alu_i_mult,shift_i,shift,shift_multiple,shift_i_multiple,bfield_i,bfield,nop,ld_short_i,data_move,data_move_i,data_move_memory,data_move_memory_2,data_move_short_i,data_move_multiple,data_move_2,nothing"
+  (const_string "malu"))
+
+;; Data arithmetic unit
+(define_function_unit "dau" 1 1 (eq_attr "type" "data_move,data_move_i,f3_alu_i") 2 0)
+
+(define_function_unit "dau" 1 1 (eq_attr "type" "special_2") 3 0)
+
+(define_function_unit "dau" 1 1 (eq_attr "type" "data_move_2") 4 0)
+
+;; Bit manipulation
+(define_function_unit "bmu" 1 1 (eq_attr "type" "shift_i,shift_i_multiple") 2 0)
+
+(define_function_unit "bmu" 1 1 (eq_attr "type" "shift_multiple") 4 0)
+
+;; Y-memory addressing arithmetic unit
+(define_function_unit "yaau" 1 1 (eq_attr "type" "data_move_memory") 2 0)
+
+(define_function_unit "yaau" 1 1 (eq_attr "type" "data_move_memory_2") 4 0)
+
+
+;;  ....................
+;;
+;;  Test against 0 instructions
+;;
+;;  ....................
+
+(define_expand "tsthi"
+  [(set (cc0)
+        (match_operand:HI 0 "register_operand" ""))]
+  ""
+  "
+{
+  dsp16xx_compare_gen = false;
+  dsp16xx_compare_op0 = operands[0];
+  dsp16xx_compare_op1 = const0_rtx;
+  DONE;
+}")
+
+(define_insn "tsthi_1"
+  [(set (cc0)
+	(match_operand:HI 0 "register_operand" "A"))]
+  ""
+  "%0=%0"
+  [(set_attr "type" "malu")])
+
+(define_expand "tstqi"
+  [(set (cc0)
+        (match_operand:QI 0 "register_operand" ""))]
+  ""
+  "
+{
+  dsp16xx_compare_gen = false;
+  dsp16xx_compare_op0 = operands[0];
+  dsp16xx_compare_op1 = const0_rtx;
+  DONE;
+}")
+
+(define_split
+  [(set (cc0)
+	(match_operand:QI 0 "register_operand" "j,q"))
+   (clobber (match_scratch:QI 1 "=k,u"))]
+  "reload_completed"
+  [(set (match_dup 1)
+	(const_int 0))
+   (parallel [(set (cc0)
+		   (match_dup 0))
+	      (use (match_dup 1))])]
+  "")
+
+(define_insn "tstqi_split"
+  [(set (cc0)
+	(match_operand:QI 0 "register_operand" "j,q"))
+   (use (match_scratch:QI 1 "=k,u"))]
+  ""
+  "@
+   %b0-0
+   %b0-0"
+  [(set_attr "type" "f3_alu_i,f3_alu_i")])
+
+(define_insn "tstqi_1"
+  [(set (cc0)
+	(match_operand:QI 0 "register_operand" "j,q"))
+   (clobber (match_scratch:QI 1 "=k,u"))]
+  ""
+  "@
+   %1=0\;%b0-0
+   %1=0\;%b0-0"
+  [(set_attr "type" "tstqi,tstqi")])
+
+
+;;
+;;  ....................
+;;
+;;  Bit test instructions
+;;
+;;  ....................
+
+(define_insn ""
+  [(set (cc0)
+	(and:HI (match_operand:HI 0 "register_operand" "A,!A")
+		(match_operand:HI 1 "register_operand" "Z,A")))]
+  "" 
+  "*
+{
+	switch (which_alternative)
+	{
+	   case 0:
+	   case 1:
+   	      return \"%0&%1\";
+           default:
+             abort();
+         }
+}"
+  [(set_attr "type" "f3_alu,f3_alu")])
+
+
+;;(define_insn ""
+;;  [(set (cc0)
+;;	(and:QI (match_operand:QI 0 "register_operand" "h")
+;;		(match_operand:QI 1 "const_int_operand" "I")))]
+;;  "" 
+;;  "%b0&%H1"
+;;  [(set_attr "type" "f3_alu_i")])
+
+;;
+;;
+;; Compare Instructions
+;;
+
+(define_expand "cmphi"
+  [(parallel [(set (cc0)
+		   (compare (match_operand:HI 0 "general_operand" "")
+			    (match_operand:HI 1 "general_operand" "")))
+	      (clobber (match_scratch:QI 2 ""))
+	      (clobber (match_scratch:QI 3 ""))
+	      (clobber (match_scratch:QI 4 ""))
+	      (clobber (match_scratch:QI 5 ""))])]
+  ""
+  "
+{
+  if (GET_CODE (operands[1]) == CONST_INT)
+    operands[1] = force_reg (HImode, operands[1]);
+
+  dsp16xx_compare_gen = true;
+  dsp16xx_compare_op0 = operands[0];
+  dsp16xx_compare_op1 = operands[1];
+  DONE;
+}")
+
+(define_insn ""
+  [(set (cc0) 
+	(compare (match_operand:HI 0 "general_operand" "Z*r*m*i")
+		 (match_operand:HI 1 "general_operand" "Z*r*m*i")))
+   (clobber (match_scratch:QI 2 "=&A"))
+   (clobber (match_scratch:QI 3 "=&A"))
+   (clobber (match_scratch:QI 4 "=&A"))
+   (clobber (match_scratch:QI 5 "=&A"))]
+  "next_cc_user_unsigned (insn)"
+  "*
+{
+  if (GET_CODE(operands[0]) == REG)
+    {
+      if (REGNO (operands[0]) == REG_Y ||
+	  REGNO (operands[0]) == REG_PROD)
+	{
+	  output_asm_insn (\"a0=%0\", operands);
+	}
+      else if (IS_YBASE_REGISTER_WINDOW (REGNO (operands[0])))
+	output_asm_insn (\"a0=%u0\;a0l=%w0\", operands);
+      else
+	fatal_error (\"Invalid register for compare\");
+    }
+  else if (GET_CODE(operands[0]) == CONST_INT)
+    output_asm_insn (\"a0=%U0\;a0l=%H0\", operands);
+  else if (GET_CODE (operands[0]) == MEM)
+    {
+      rtx xoperands[2];
+
+      xoperands[0] = gen_rtx_REG (HImode, REG_A0);
+      xoperands[1] = operands[0];
+      double_reg_from_memory (xoperands);
+    }
+
+  if (GET_CODE(operands[1]) == REG)
+    {
+      if (REGNO (operands[1]) == REG_Y || REGNO (operands[1]) == REG_PROD)
+	output_asm_insn (\"a1=%1\", operands);
+      else if (IS_YBASE_REGISTER_WINDOW (REGNO (operands[1])))
+	output_asm_insn (\"a1=%u1\;a1l=%w1\", operands);
+      else
+	fatal_error (\"Invalid register for compare\");
+    }
+  else if (GET_CODE (operands[1]) == MEM)
+    {
+      rtx xoperands[2];
+
+      xoperands[0] = gen_rtx_REG (HImode, REG_A1);
+      xoperands[1] = operands[1];
+      double_reg_from_memory (xoperands);
+    }
+  else if (GET_CODE(operands[1]) == CONST_INT)
+    {
+      output_asm_insn (\"a1=%U1\;a1l=%H1\", operands);
+    }
+  
+  return \"psw = 0\;a0 - a1\";
+}")
+
+(define_insn ""
+  [(set (cc0) (compare (match_operand:HI 0 "register_operand" "A,!A")
+		       (match_operand:HI 1 "register_operand" "Z,*A")))]
+  ""
+  "@
+   %0-%1
+   %0-%1"
+  [(set_attr "type" "malu,f3_alu")])
+
+(define_expand "cmpqi"
+  [(parallel [(set (cc0)
+		   (compare (match_operand:QI 0 "register_operand" "")
+			    (match_operand:QI 1 "nonmemory_operand" "")))
+	      (clobber (match_operand:QI 2 "register_operand" ""))
+	      (clobber (match_operand:QI 3 "register_operand" ""))])]
+  ""
+  "
+ {
+  if (operands[0])	/* Avoid unused code warning */
+    {
+      dsp16xx_compare_gen = true;
+      dsp16xx_compare_op0 = operands[0];
+      dsp16xx_compare_op1 = operands[1];
+      DONE;
+    }
+ }")
+
+(define_split
+  [(set (cc0)
+	(compare (match_operand:QI 0 "register_operand" "")
+		 (match_operand:QI 1 "register_operand" "")))
+   (clobber (match_scratch:QI 2 ""))
+   (clobber (match_scratch:QI 3 ""))]
+  "reload_completed && next_cc_user_unsigned (insn)"
+  [(set (match_dup 2)
+	(const_int 0))
+   (set (match_dup 3)
+	(const_int 0))
+   (parallel [(set (cc0)
+		   (compare (match_dup 0)
+			    (match_dup 1)))
+	      (use (match_dup 2))
+	      (use (match_dup 3))])]
+  "")
+
+(define_split
+  [(set (cc0)
+	(compare (match_operand:QI 0 "register_operand" "")
+		 (match_operand:QI 1 "const_int_operand" "")))
+   (clobber (match_scratch:QI 2 ""))
+   (clobber (match_scratch:QI 3 ""))]
+  "reload_completed && next_cc_user_unsigned (insn)"
+  [(set (match_dup 2)
+	(const_int 0))
+   (parallel [(set (cc0)
+		   (compare (match_dup 0)
+			    (match_dup 1)))
+	      (use (match_dup 2))])]
+  "")
+
+(define_insn "cmpqi_split_unsigned_reg"
+  [(set (cc0) (compare (match_operand:QI 0 "register_operand"  "k,k,!k,u,u,!u")
+                       (match_operand:QI 1 "register_operand"  "w,z,u,w,z,k")))
+	(use (match_scratch:QI 2 "=j,j,j,q,q,q"))
+	(use (match_scratch:QI 3 "=v,y,q,v,y,j"))]
+  "next_cc_user_unsigned (insn)"
+  "@
+   %2-%3
+   %2-%3
+   %2-%3
+   %2-%3
+   %2-%3
+   %2-%3"
+  [(set_attr "type" "malu,malu,malu,malu,malu,malu")])
+
+(define_insn "cmpqi_split_unsigned_int"
+  [(set (cc0) (compare (match_operand:QI 0 "register_operand"  "k,u")
+                       (match_operand:QI 1 "const_int_operand" "i,i")))
+	(use (match_scratch:QI 2 "=j,q"))]
+  "next_cc_user_unsigned (insn)"
+  "@
+   %0-%H1
+   %0-%H1"
+  [(set_attr "type" "f3_alu_i,f3_alu_i")])
+
+(define_insn ""
+  [(set (cc0) (compare (match_operand:QI 0 "register_operand"  "k,k,!k,k,u,u,!u,u")
+                       (match_operand:QI 1 "nonmemory_operand" "w,z,u,i,w,z,k,i")))
+	(clobber (match_scratch:QI 2 "=j,j,j,j,q,q,q,q"))
+	(clobber (match_scratch:QI 3 "=v,y,q,X,v,y,j,X"))]
+  "next_cc_user_unsigned (insn)"
+  "@
+   %2=0\;%3=0\;%2-%3
+   %2=0\;%3=0\;%2-%3
+   %2=0\;%3=0\;%2-%3
+   %2=0\;%0-%H1
+   %2=0\;%3=0\;%2-%3
+   %2=0\;%3=0\;%2-%3
+   %2=0\;%3=0\;%2-%3
+   %2=0\;%0-%H1")
+
+(define_split
+  [(set (cc0)
+	(compare (match_operand:QI 0 "register_operand" "")
+		 (match_operand:QI 1 "register_operand" "")))
+   (clobber (match_scratch:QI 2 ""))
+   (clobber (match_scratch:QI 3 ""))]
+  "reload_completed"
+  [(set (match_dup 2)
+	(const_int 0))
+   (set (match_dup 3)
+	(const_int 0))
+   (parallel [(set (cc0)
+		   (compare (match_dup 0)
+			    (match_dup 1)))
+	      (use (match_dup 2))
+	      (use (match_dup 3))])]
+  "")
+
+(define_split
+  [(set (cc0)
+	(compare (match_operand:QI 0 "register_operand" "")
+		 (match_operand:QI 1 "const_int_operand" "")))
+   (clobber (match_scratch:QI 2 ""))
+   (clobber (match_scratch:QI 3 ""))]
+  "reload_completed"
+  [(set (match_dup 2)
+	(const_int 0))
+   (parallel [(set (cc0)
+		   (compare (match_dup 0)
+			    (match_dup 1)))
+	      (use (match_dup 2))])]
+  "")
+
+(define_insn "cmpqi_split_reg"
+  [(set (cc0) (compare (match_operand:QI 0 "register_operand"  "j,j,!j,q,q,!q")
+                       (match_operand:QI 1 "register_operand"  "v,y,q,v,y,j")))
+	(use (match_scratch:QI 2 "=k,k,k,u,u,u"))
+	(use (match_scratch:QI 3 "=w,z,u,w,z,k"))]
+  ""
+  "@
+   %0-%1
+   %0-%1
+   %0-%1
+   %0-%1
+   %0-%1
+   %0-%1"
+  [(set_attr "type" "malu,malu,malu,malu,malu,malu")])
+
+
+(define_insn "cmpqi_split_int"
+  [(set (cc0) (compare (match_operand:QI 0 "register_operand"  "j,q")
+                       (match_operand:QI 1 "const_int_operand" "i,i")))
+	(use (match_scratch:QI 2 "=k,u"))]
+  ""
+  "@
+   %b0-%H1
+   %b0-%H1"
+  [(set_attr "type" "f3_alu_i,f3_alu_i")])
+
+(define_insn ""
+  [(set (cc0) (compare (match_operand:QI 0 "register_operand"  "j,j,!j,j,q,q,!q,q")
+                       (match_operand:QI 1 "nonmemory_operand" "v,y,q,i,v,y,j,i")))
+	(clobber (match_scratch:QI 2 "=k,k,k,k,u,u,u,u"))
+	(clobber (match_scratch:QI 3 "=w,z,u,X,w,z,k,X"))]
+  ""
+  "@
+   %2=0\;%3=0\;%0-%1
+   %2=0\;%3=0\;%0-%1
+   %2=0\;%3=0\;%0-%1
+   %2=0\;%b0-%H1
+   %2=0\;%3=0\;%0-%1
+   %2=0\;%3=0\;%0-%1
+   %2=0\;%3=0\;%0-%1
+   %2=0\;%b0-%H1")
+
+
+(define_expand "cmphf"
+  [(set (cc0)
+	(compare (match_operand:HF 0 "register_operand" "")
+		 (match_operand:HF 1 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_cmphf3_libcall)
+    dsp16xx_cmphf3_libcall = gen_rtx_SYMBOL_REF (Pmode, CMPHF3_LIBCALL);
+
+   dsp16xx_compare_gen = true;
+   dsp16xx_compare_op0 = operands[0];
+   dsp16xx_compare_op1 = operands[1];
+   emit_library_call (dsp16xx_cmphf3_libcall, 1, HImode, 2,
+		      operands[0], HFmode,
+		      operands[1], HFmode);
+   emit_insn (gen_tsthi_1 (copy_to_reg(hard_libcall_value (HImode))));
+   DONE;
+}")
+
+
+;;  ....................
+;;
+;;  Add instructions
+;;
+;;  ....................
+
+(define_split
+  [(set (match_operand:HI 0 "register_operand" "")
+	(plus:HI (match_operand:HI 1 "register_operand" "")
+		 (match_operand:HI 2 "const_int_operand" "")))]
+  "reload_completed && !ADD_LOW_16(INTVAL(operands[2])) && 
+   !ADD_HIGH_16(INTVAL(operands[2]))"
+  [(parallel [(set (match_dup 3)
+		   (plus:QI (match_dup 4)
+			    (match_dup 5)))
+	      (clobber (match_dup 6))])
+
+   (parallel [(set (match_dup 6)
+		   (plus:QI (match_dup 7)
+			    (match_dup 8)))
+	      (clobber (match_scratch:QI 9 ""))])]
+  "
+{
+  operands[3] = gen_lowpart(QImode, operands[0]);
+  operands[4] = gen_lowpart(QImode, operands[1]);
+  operands[5] = gen_rtx (CONST_INT, VOIDmode, INTVAL (operands[2]) & 0xffff);
+
+  operands[6] = gen_highpart(QImode, operands[0]);
+  operands[7] = gen_highpart(QImode, operands[0]);
+  operands[8] = gen_rtx (CONST_INT, VOIDmode, (((INTVAL (operands[2]) & 0xffff0000) >> 16) & 0xffff));
+}")
+
+
+(define_insn "addhi3"
+  [(set (match_operand:HI 0 "register_operand" "=A,A,A,A,A")
+	(plus:HI (match_operand:HI 1 "register_operand" "%A,A,A,A,A")
+		 (match_operand:HI 2 "nonmemory_operand" "Z,d,L,M,?i")))]
+  ""
+  "@
+   %0=%1+%2
+   %0=%1+%2
+   %0=%w1+%H2
+   %0=%b1+%U2
+   %0=%w1+%H2\;%0=%b0+%U2"
+  [(set_attr "type" "malu,malu,f3_alu_i,f3_alu_i,f3_alu_i")])
+
+(define_insn ""
+  [(set (match_operand:QI 0 "register_operand" "=k,u,!k,!u")
+	(plus:QI (plus:QI (match_operand:QI 1 "register_operand" "uk,uk,uk,uk")
+			  (match_operand:QI 2 "register_operand" "wz,wz,uk,uk"))
+		 (match_operand:QI 3 "immediate_operand" "i,i,i,i")))
+   (clobber (match_scratch:QI 4 "=j,q,j,q"))]
+  ""
+  "@
+   %m0=%m1+%m2\;%m0=%0+%H3
+   %m0=%m1+%m2\;%m0=%0+%H3
+   %m0=%m1+%m2\;%m0=%0+%H3
+   %m0=%m1+%m2\;%m0=%0+%H3")
+
+(define_expand "addqi3"
+  [(parallel [(set (match_operand:QI 0 "register_operand" "")
+		   (plus:QI (match_operand:QI 1 "register_operand" "")
+			    (match_operand:QI 2 "nonmemory_operand" "")))
+	      (clobber (match_scratch:QI 3 ""))])]
+  ""
+  "
+{
+  if (reload_in_progress)
+    {
+      if (REG_P (operands[1]) && 
+	  (REGNO(operands[1]) == STACK_POINTER_REGNUM ||
+	   REGNO(operands[1]) == FRAME_POINTER_REGNUM) &&
+	  GET_CODE (operands[2]) == CONST_INT)
+	{
+	  if (REG_P (operands[0]) && IS_ACCUM_REG(REGNO(operands[0])))
+	    emit_move_insn (operands[0], operands[1]);
+
+	  operands[1] = operands[0];
+	}
+    }
+}")
+
+	
+(define_insn "match_addqi3"
+  [(set (match_operand:QI 0 "register_operand" "=a,a,k,u,k,u,!k,!u,j,j,q,q")
+	(plus:QI (match_operand:QI 1 "register_operand" "0,0,uk,uk,uk,uk,uk,uk,0,q,0,j")
+		 (match_operand:QI 2 "nonmemory_operand" "W,N,i,i,wz,wz,uk,uk,i,i,i,i")))
+	(clobber (match_scratch:QI 3 "=X,X,j,q,j,q,j,q,X,k,X,u"))]
+  ""
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+      return \"*%0++%2\";
+
+    case 1:
+      switch (INTVAL (operands[2]))
+	{
+	case -1:
+	  return \"*%0--\";
+
+	case 1:
+	  return \"*%0++\";
+
+	case -2:
+	  return \"*%0--\;*%0--\";
+
+	case 2:
+	  return \"*%0++\;*%0++\";
+        default:
+          abort();
+	}
+
+    case 2:
+    case 3:
+        return \"%m0=%1+%H2\";
+
+    case 4:
+    case 5:
+        return \"%m0=%m1+%m2\";
+
+
+    case 6:
+    case 7:
+      return \"%m0=%m1+%m2\";
+
+    case 8:
+    case 9:
+    case 10:
+    case 11:
+      return \"%0=%b1+%H2\";
+    default:
+      abort();
+    }
+}"
+[(set_attr "type" "data_move_memory,data_move_multiple,f3_alu_i,f3_alu_i,f3_alu,f3_alu,f3_alu,f3_alu,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu_i")])
+
+
+(define_expand "addhf3"
+  [(set (match_operand:HF 0 "register_operand" "")
+	(plus:HF (match_operand:HF 1 "register_operand" "")
+		 (match_operand:HF 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_addhf3_libcall)
+    dsp16xx_addhf3_libcall = gen_rtx_SYMBOL_REF (Pmode, ADDHF3_LIBCALL);
+
+   emit_library_call (dsp16xx_addhf3_libcall, 1, HFmode, 2,
+		      operands[1], HFmode,
+		      operands[2], HFmode);
+   emit_move_insn (operands[0], hard_libcall_value(HFmode));
+   DONE;
+}")
+		      
+
+;;
+;;  ....................
+;;
+;;  Subtract instructions
+;;
+;;  ....................
+
+(define_split
+  [(set (match_operand:HI 0 "register_operand" "")
+	(minus:HI (match_operand:HI 1 "register_operand" "")
+		  (match_operand:HI 2 "const_int_operand" "")))]
+  "reload_completed && !ADD_LOW_16(INTVAL(operands[2])) && 
+   !ADD_HIGH_16(INTVAL(operands[2]))"
+  [(parallel [(set (match_dup 3)
+		   (minus:QI (match_dup 4)
+			     (match_dup 5)))
+	      (clobber (match_dup 6))])
+
+   (parallel [(set (match_dup 6)
+		   (minus:QI (match_dup 7)
+			     (match_dup 8)))
+	      (clobber (match_scratch:QI 9 ""))])]
+  "
+{
+  operands[3] = gen_lowpart(QImode, operands[0]);
+  operands[4] = gen_lowpart(QImode, operands[1]);
+  operands[5] = gen_rtx (CONST_INT, VOIDmode, INTVAL (operands[2]) & 0xffff);
+
+  operands[6] = gen_highpart(QImode, operands[0]);
+  operands[7] = gen_highpart(QImode, operands[0]);
+  operands[8] = gen_rtx (CONST_INT, VOIDmode, (((INTVAL (operands[2]) & 0xffff0000) >> 16) & 0xffff));
+}")
+
+
+(define_insn "subhi3"
+  [(set (match_operand:HI 0 "register_operand" "=A,A,A,A,A")
+	(minus:HI (match_operand:HI 1 "register_operand" "A,A,A,A,A")
+		  (match_operand:HI 2 "nonmemory_operand" "Z,d,L,M,?i")))]
+  ""
+  "@
+   %0=%1-%2
+   %0=%1-%2
+   %0=%w1-%H2
+   %0=%b1-%U2
+   %0=%w1-%H2\;%0=%b0-%U2"
+  [(set_attr "type" "malu,malu,f3_alu_i,f3_alu_i,f3_alu_i")])
+
+(define_insn "subqi3"
+  [(set (match_operand:QI 0 "register_operand" "=a,k,u,k,u,!k,!u,j,j,q,q")
+	(minus:QI (match_operand:QI 1 "register_operand" "0,uk,uk,uk,uk,uk,uk,0,q,0,j")
+		 (match_operand:QI 2 "nonmemory_operand" "N,i,i,wz,wz,uk,uk,i,i,i,i")))
+	(clobber (match_scratch:QI 3 "=X,j,q,j,q,j,q,X,k,X,u"))]
+  ""
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+      switch (INTVAL (operands[2]))
+	{
+	case 1:
+	  return \"*%0--\";
+	  
+	case -1:
+	  return \"*%0++\";
+
+	default:
+	  operands[2] = GEN_INT (-INTVAL (operands[2]));
+	  
+	  if (SHORT_IMMEDIATE(operands[2]))
+	    return \"set %3=%H2\;*%0++%3\";
+	  else
+	    return \"%3=%H2\;*%0++%3\";
+	}
+      
+    case 1:
+    case 2:
+        return \"%m0=%1-%H2\";
+
+    case 3:
+    case 4:
+        return \"%m0=%m1-%m2\";
+
+    case 5:
+    case 6:
+      return \"%m0=%m1-%m2\";
+
+    case 7: case 8:
+    case 9: case 10:
+      return \"%0=%b1-%H2\";
+    default:
+      abort();
+    }
+}"
+[(set_attr "type" "data_move_multiple,f3_alu_i,f3_alu_i,f3_alu,f3_alu,f3_alu,f3_alu,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu_i")])
+
+(define_expand "subhf3"
+  [(set (match_operand:HF 0 "register_operand" "")
+	(minus:HF (match_operand:HF 1 "register_operand" "")
+		 (match_operand:HF 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_subhf3_libcall)
+    dsp16xx_subhf3_libcall = gen_rtx_SYMBOL_REF (Pmode, SUBHF3_LIBCALL);
+  
+  emit_library_call (dsp16xx_subhf3_libcall, 1, HFmode, 2,
+		     operands[1], HFmode,
+		     operands[2], HFmode);
+  emit_move_insn (operands[0], hard_libcall_value(HFmode));
+  DONE;
+}")
+
+(define_insn "neghi2"
+  [(set (match_operand:HI 0 "register_operand" "=A")
+        (neg:HI (match_operand:HI 1 "register_operand" "A")))]
+  ""
+  "%0=-%1"
+  [(set_attr "type" "special")])
+
+(define_expand "neghf2"
+  [(set (match_operand:HF 0 "register_operand" "")
+	(neg:HF (match_operand:HF 1 "register_operand" "")))]
+  ""
+  "
+{
+  rtx result;
+  rtx target;
+
+    {
+      target = gen_lowpart(HImode, operands[0]);
+      result = expand_binop (HImode, xor_optab,
+			     gen_lowpart(HImode, operands[1]),
+			     GEN_INT(0x80000000), target, 0, OPTAB_WIDEN);
+      if (result == 0)
+	abort ();
+
+      if (result != target)
+	emit_move_insn (result, target);
+
+      /* Make a place for REG_EQUAL.  */
+      emit_move_insn (operands[0], operands[0]);
+      DONE;
+    }
+}")
+
+;;
+;;  ....................
+;;
+;;  Multiply instructions
+;;
+
+(define_expand "mulhi3"
+  [(set (match_operand:HI 0 "register_operand" "")
+	(mult:HI (match_operand:HI 1 "register_operand" "")
+		 (match_operand:HI 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_mulhi3_libcall)
+    dsp16xx_mulhi3_libcall = gen_rtx_SYMBOL_REF (Pmode, MULHI3_LIBCALL);
+
+   emit_library_call (dsp16xx_mulhi3_libcall, 1, HImode, 2,
+		      operands[1], HImode,
+		      operands[2], HImode);
+   emit_move_insn (operands[0], hard_libcall_value(HImode));
+   DONE;
+}")
+
+(define_insn "mulqi3"
+  [(set (match_operand:QI 0 "register_operand" "=w")
+        (mult:QI (match_operand:QI 1 "register_operand" "%x")
+                 (match_operand:QI 2 "register_operand" "y")))
+   (clobber (match_scratch:QI 3 "=v"))]
+  ""
+  "%m0=%1*%2"
+  [(set_attr "type" "malu_mul")])
+
+(define_insn "mulqihi3"
+  [(set (match_operand:HI 0 "register_operand" "=t")
+        (mult:HI (sign_extend:HI (match_operand:QI 1 "register_operand" "%x"))
+                 (sign_extend:HI (match_operand:QI 2 "register_operand" "y"))))]
+  ""
+  "%0=%1*%2"
+  [(set_attr "type" "malu_mul")])
+
+(define_expand "mulhf3"
+  [(set (match_operand:HF 0 "register_operand" "")
+	(mult:HF (match_operand:HF 1 "register_operand" "")
+		 (match_operand:HF 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_mulhf3_libcall)
+    dsp16xx_mulhf3_libcall = gen_rtx_SYMBOL_REF (Pmode, MULHF3_LIBCALL);
+  
+  emit_library_call (dsp16xx_mulhf3_libcall, 1, HFmode, 2,
+		     operands[1], HFmode,
+		     operands[2], HFmode);
+  emit_move_insn (operands[0], hard_libcall_value(HFmode));
+  DONE;
+}")
+
+
+
+;;
+;; *******************
+;;
+;; Divide Instructions
+;;
+
+(define_expand "divhi3"
+  [(set (match_operand:HI 0 "register_operand" "")
+	(div:HI (match_operand:HI 1 "register_operand" "")
+		 (match_operand:HI 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_divhi3_libcall)
+    dsp16xx_divhi3_libcall = gen_rtx_SYMBOL_REF (Pmode, DIVHI3_LIBCALL);
+
+   emit_library_call (dsp16xx_divhi3_libcall, 1, HImode, 2,
+		      operands[1], HImode,
+		      operands[2], HImode);
+   emit_move_insn (operands[0], hard_libcall_value(HImode));
+   DONE;
+}")
+
+(define_expand "udivhi3"
+  [(set (match_operand:HI 0 "register_operand" "")
+	(udiv:HI (match_operand:HI 1 "register_operand" "")
+		 (match_operand:HI 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_udivhi3_libcall)
+    dsp16xx_udivhi3_libcall = gen_rtx_SYMBOL_REF (Pmode, UDIVHI3_LIBCALL);
+  
+  emit_library_call (dsp16xx_udivhi3_libcall, 1, HImode, 2,
+		     operands[1], HImode,
+		     operands[2], HImode);
+  emit_move_insn (operands[0], hard_libcall_value(HImode));
+  DONE;
+}")
+
+(define_expand "divqi3"
+  [(set (match_operand:QI 0 "register_operand" "")
+	(div:QI (match_operand:QI 1 "register_operand" "")
+		 (match_operand:QI 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_divqi3_libcall)
+    dsp16xx_divqi3_libcall = gen_rtx_SYMBOL_REF (Pmode, DIVQI3_LIBCALL);
+  
+  emit_library_call (dsp16xx_divqi3_libcall, 1, QImode, 2,
+		     operands[1], QImode,
+		     operands[2], QImode);
+  emit_move_insn (operands[0], hard_libcall_value(QImode));
+  DONE;
+}")
+
+(define_expand "udivqi3"
+  [(set (match_operand:QI 0 "register_operand" "")
+	(udiv:QI (match_operand:QI 1 "register_operand" "")
+		 (match_operand:QI 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_udivqi3_libcall)
+    dsp16xx_udivqi3_libcall = gen_rtx_SYMBOL_REF (Pmode, UDIVQI3_LIBCALL);
+
+   emit_library_call (dsp16xx_udivqi3_libcall, 1, QImode, 2,
+		      operands[1], QImode,
+		      operands[2], QImode);
+   emit_move_insn (operands[0], hard_libcall_value(QImode));
+   DONE;
+}")
+
+;;
+;;  ....................
+;;
+;;  Modulo instructions
+;;
+;;  ....................
+
+(define_expand "modhi3"
+  [(set (match_operand:HI 0 "register_operand" "")
+	(mod:HI (match_operand:HI 1 "register_operand" "")
+		(match_operand:HI 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_modhi3_libcall)
+    dsp16xx_modhi3_libcall = gen_rtx_SYMBOL_REF (Pmode, MODHI3_LIBCALL);
+  
+  emit_library_call (dsp16xx_modhi3_libcall, 1, HImode, 2,
+		     operands[1], HImode,
+		     operands[2], HImode);
+  emit_move_insn (operands[0], hard_libcall_value(HImode));
+  DONE;
+}")
+
+(define_expand "umodhi3"
+  [(set (match_operand:HI 0 "register_operand" "")
+	(umod:HI (match_operand:HI 1 "register_operand" "")
+		 (match_operand:HI 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_umodhi3_libcall)
+    dsp16xx_umodhi3_libcall = gen_rtx_SYMBOL_REF (Pmode, UMODHI3_LIBCALL);
+  
+  emit_library_call (dsp16xx_umodhi3_libcall, 1, HImode, 2,
+		     operands[1], HImode,
+		     operands[2], HImode);
+  emit_move_insn (operands[0], hard_libcall_value(HImode));
+  DONE;
+}")
+
+(define_expand "modqi3"
+  [(set (match_operand:QI 0 "register_operand" "")
+	(mod:QI (match_operand:QI 1 "register_operand" "")
+		(match_operand:QI 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_modqi3_libcall)
+    dsp16xx_modqi3_libcall = gen_rtx_SYMBOL_REF (Pmode, MODQI3_LIBCALL);
+  
+  emit_library_call (dsp16xx_modqi3_libcall, 1, QImode, 2,
+		     operands[1], QImode,
+		     operands[2], QImode);
+  emit_move_insn (operands[0], hard_libcall_value(QImode));
+  DONE;
+}")
+
+(define_expand "umodqi3"
+  [(set (match_operand:QI 0 "register_operand" "")
+	(umod:QI (match_operand:QI 1 "register_operand" "")
+		 (match_operand:QI 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_umodqi3_libcall)
+    dsp16xx_umodqi3_libcall = gen_rtx_SYMBOL_REF (Pmode, UMODQI3_LIBCALL);
+  
+  emit_library_call (dsp16xx_umodqi3_libcall, 1, QImode, 2,
+		     operands[1], QImode,
+		     operands[2], QImode);
+  emit_move_insn (operands[0], hard_libcall_value(QImode));
+  DONE;
+}")
+
+(define_expand "divhf3"
+  [(set (match_operand:HF 0 "register_operand" "")
+	(div:HF (match_operand:HF 1 "register_operand" "")
+		(match_operand:HF 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_divhf3_libcall)
+    dsp16xx_divhf3_libcall = gen_rtx_SYMBOL_REF (Pmode, DIVHF3_LIBCALL);
+  
+  emit_library_call (dsp16xx_divhf3_libcall, 1, HFmode, 2,
+		     operands[1], HFmode,
+		     operands[2], HFmode);
+  emit_move_insn (operands[0], hard_libcall_value(HFmode));
+  DONE;
+}")
+
+
+
+;;
+;; ********************
+;;
+;; Logical Instructions
+;;
+
+(define_split
+  [(set (match_operand:HI 0 "register_operand" "")
+	(and:HI (match_operand:HI 1 "register_operand" "")
+		 (match_operand:HI 2 "const_int_operand" "")))]
+  "reload_completed && !AND_LOW_16(INTVAL(operands[2])) && 
+   !AND_HIGH_16(INTVAL(operands[2])) 
+   && (REGNO (operands[0]) == REGNO (operands[1]))"
+  [(parallel [(set (match_dup 3)
+		   (and:QI (match_dup 4)
+			   (match_dup 5)))
+	      (clobber (match_scratch:QI 6 ""))])
+   (parallel [(set (match_dup 7)
+		   (and:QI (match_dup 8)
+			   (match_dup 9)))
+	      (clobber (match_scratch:QI 10 ""))])]
+  "
+{
+  operands[3] = gen_lowpart(QImode, operands[0]);
+  operands[4] = gen_lowpart(QImode, operands[1]);
+  operands[5] = gen_rtx (CONST_INT, VOIDmode, INTVAL (operands[2]) & 0xffff);
+
+  operands[7] = gen_highpart(QImode, operands[0]);
+  operands[8] = gen_highpart(QImode, operands[0]);
+  operands[9] = gen_rtx (CONST_INT, VOIDmode, (((INTVAL (operands[2]) & 0xffff0000) >> 16) & 0xffff));
+}")
+
+(define_split
+  [(set (match_operand:HI 0 "register_operand" "")
+	(and:HI (match_operand:HI 1 "register_operand" "")
+		(match_operand:HI 2 "const_int_operand" "")))]
+  "reload_completed && !AND_LOW_16(INTVAL(operands[2])) && 
+   !AND_HIGH_16(INTVAL(operands[2]))
+   && (REGNO (operands[0]) != REGNO (operands[1]))"
+  [(parallel [(set (match_dup 3)
+		   (and:QI (match_dup 4)
+			   (match_dup 5)))
+	      (clobber (match_dup 6))])
+   (parallel [(set (match_dup 6)
+		   (and:QI (match_dup 7)
+			   (match_dup 8)))
+	      (clobber (match_scratch:QI 9 ""))])]
+  "
+{
+  operands[3] = gen_lowpart(QImode, operands[0]);
+  operands[4] = gen_lowpart(QImode, operands[1]);
+  operands[5] = gen_rtx (CONST_INT, VOIDmode, INTVAL (operands[2]) & 0xffff);
+
+  operands[6] = gen_highpart(QImode, operands[0]);
+  operands[7] = gen_highpart(QImode, operands[0]);
+  operands[8] = gen_rtx (CONST_INT, VOIDmode, (((INTVAL (operands[2]) & 0xffff0000) >> 16) & 0xffff));
+}")
+
+(define_insn "andhi3"
+  [(set (match_operand:HI 0 "register_operand" "=A,A,A,A,?A")
+        (and:HI (match_operand:HI 1 "register_operand" "%A,!A,A,A,A")
+                (match_operand:HI 2 "nonmemory_operand" "Z,A,O,P,i")))]
+  ""
+  "@
+   %0=%1&%2
+   %0=%1&%2
+   %0=%w1&%H2
+   %0=%b1&%U2
+   %0=%w1&%H2\;%0=%b0&%U2"
+  [(set_attr "type" "f3_alu,f3_alu,f3_alu_i,f3_alu_i,f3_alu_i_mult")])
+
+(define_insn "andqi3"
+  [(set (match_operand:QI 0 "register_operand" "=k,u,!k,!u,k,u,k,u,j,q,j,q,j,q,!j,!q")
+	(and:QI (match_operand:QI 1 "register_operand" "%uk,uk,uk,uk,0,0,u,k,jq,jq,0,0,q,j,jq,jq")
+		(match_operand:QI 2 "nonmemory_operand" "wz,wz,uk,uk,i,i,i,i,yv,yv,i,i,i,i,jq,jq")))
+   (clobber (match_scratch:QI 3 "=j,q,j,q,X,X,j,q,k,u,X,X,k,u,k,u"))]
+  ""
+  "@
+    %m0=%m1&%m2
+    %m0=%m1&%m2
+    %m0=%m1&%m2
+    %m0=%m1&%m2
+    %m0=%1&%H2
+    %m0=%1&%H2
+    %m0=%1&%H2
+    %m0=%1&%H2
+    %m0=%m1&%m2
+    %m0=%m1&%m2
+    %m0=%b1&%H2
+    %m0=%b1&%H2
+    %m0=%b1&%H2
+    %m0=%b1&%H2
+    %m0=%m1&%m2
+    %m0=%m1&%m2"
+  [(set_attr "type" "f3_alu,f3_alu,f3_alu,f3_alu,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu,f3_alu,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu,f3_alu")])
+
+
+(define_split
+  [(set (match_operand:HI 0 "register_operand" "")
+	(ior:HI (match_operand:HI 1 "register_operand" "")
+		(match_operand:HI 2 "const_int_operand" "")))]
+  "reload_completed && !SMALL_INTVAL(INTVAL(operands[2])) && 
+   !ADD_HIGH_16(INTVAL(operands[2]))
+   && (REGNO (operands[0]) == REGNO (operands[1]))"
+  [(parallel [(set (match_dup 3)
+		   (ior:QI (match_dup 4)
+			   (match_dup 5)))
+	      (clobber (match_scratch:QI 6 ""))])
+   (parallel [(set (match_dup 7)
+		   (ior:QI (match_dup 8)
+			   (match_dup 9)))
+	      (clobber (match_scratch:QI 10 ""))])]
+  "
+{
+  operands[3] = gen_lowpart(QImode, operands[0]);
+  operands[4] = gen_lowpart(QImode, operands[1]);
+  operands[5] = gen_rtx (CONST_INT, VOIDmode, INTVAL (operands[2]) & 0xffff);
+
+  operands[7] = gen_highpart(QImode, operands[0]);
+  operands[8] = gen_highpart(QImode, operands[0]);
+  operands[9] = gen_rtx (CONST_INT, VOIDmode, (((INTVAL (operands[2]) & 0xffff0000) >> 16) & 0xffff));
+}")
+
+(define_split
+  [(set (match_operand:HI 0 "register_operand" "")
+	(ior:HI (match_operand:HI 1 "register_operand" "")
+		(match_operand:HI 2 "const_int_operand" "")))]
+  "reload_completed && !SMALL_INTVAL(INTVAL(operands[2])) && 
+   !ADD_HIGH_16(INTVAL(operands[2]))
+   && (REGNO (operands[0]) != REGNO (operands[1]))"
+  [(parallel [(set (match_dup 3)
+		   (ior:QI (match_dup 4)
+			   (match_dup 5)))
+	      (clobber (match_dup 6))])
+   (parallel [(set (match_dup 6)
+		   (ior:QI (match_dup 7)
+			   (match_dup 8)))
+	      (clobber (match_scratch:QI 9 ""))])]
+  "
+{
+  operands[3] = gen_lowpart(QImode, operands[0]);
+  operands[4] = gen_lowpart(QImode, operands[1]);
+  operands[5] = gen_rtx (CONST_INT, VOIDmode, INTVAL (operands[2]) & 0xffff);
+
+  operands[6] = gen_highpart(QImode, operands[0]);
+  operands[7] = gen_highpart(QImode, operands[0]);
+  operands[8] = gen_rtx (CONST_INT, VOIDmode, (((INTVAL (operands[2]) & 0xffff0000) >> 16) & 0xffff));
+}")
+
+
+(define_insn "iorhi3"
+  [(set (match_operand:HI 0 "register_operand" "=A,A,A,A,?A")
+        (ior:HI (match_operand:HI 1 "register_operand" "%A,!A,A,A,A")
+                (match_operand:HI 2 "nonmemory_operand" "Z,A,I,M,i")))]
+ ""
+ "@
+   %0=%u1|%u2
+   %0=%u1|%u2
+   %0=%w1|%H2
+   %0=%b1|%U2
+   %0=%w1|%H2\;%0=%b0|%U2"
+  [(set_attr "type" "f3_alu,f3_alu,f3_alu_i,f3_alu_i,f3_alu_i_mult")])
+
+(define_insn "iorqi3"
+  [(set (match_operand:QI 0 "register_operand" "=k,u,!k,!u,k,u,k,u,j,q,j,q,j,q,!j,!q")
+	(ior:QI (match_operand:QI 1 "register_operand" "%uk,uk,uk,uk,0,0,u,k,jq,jq,0,0,q,j,jq,jq")
+		(match_operand:QI 2 "nonmemory_operand" "wz,wz,uk,uk,i,i,i,i,yv,yv,i,i,i,i,jq,jq")))
+   (clobber (match_scratch:QI 3 "=j,q,j,q,X,X,j,q,k,u,X,X,k,u,k,u"))]
+  ""
+  "@
+    %m0=%m1|%m2
+    %m0=%m1|%m2
+    %m0=%m1|%m2
+    %m0=%m1|%m2
+    %m0=%1|%H2
+    %m0=%1|%H2
+    %m0=%1|%H2
+    %m0=%1|%H2
+    %m0=%m1|%m2
+    %m0=%m1|%m2
+    %m0=%b1|%H2
+    %m0=%b1|%H2
+    %m0=%b1|%H2
+    %m0=%b1|%H2
+    %m0=%m1|%m2
+    %m0=%m1|%m2"
+  [(set_attr "type" "f3_alu,f3_alu,f3_alu,f3_alu,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu,f3_alu,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu,f3_alu")])
+
+
+
+(define_split
+  [(set (match_operand:HI 0 "register_operand" "")
+	(xor:HI (match_operand:HI 1 "register_operand" "")
+		(match_operand:HI 2 "const_int_operand" "")))]
+  "reload_completed && !SMALL_INTVAL(INTVAL(operands[2])) && 
+   !ADD_HIGH_16(INTVAL(operands[2]))
+   && (REGNO (operands[0]) == REGNO (operands[1]))"
+  [(parallel [(set (match_dup 3)
+		   (xor:QI (match_dup 4)
+			   (match_dup 5)))
+	      (clobber (match_scratch:QI 6 ""))])
+   (parallel [(set (match_dup 7)
+		   (xor:QI (match_dup 8)
+			   (match_dup 9)))
+	      (clobber (match_scratch:QI 10 ""))])]
+  "
+{
+  operands[3] = gen_lowpart(QImode, operands[0]);
+  operands[4] = gen_lowpart(QImode, operands[1]);
+  operands[5] = gen_rtx (CONST_INT, VOIDmode, INTVAL (operands[2]) & 0xffff);
+
+  operands[7] = gen_highpart(QImode, operands[0]);
+  operands[8] = gen_highpart(QImode, operands[0]);
+  operands[9] = gen_rtx (CONST_INT, VOIDmode, (((INTVAL (operands[2]) & 0xffff0000) >> 16) & 0xffff));
+}")
+
+(define_split
+  [(set (match_operand:HI 0 "register_operand" "")
+	(xor:HI (match_operand:HI 1 "register_operand" "")
+		(match_operand:HI 2 "const_int_operand" "")))]
+  "reload_completed && !SMALL_INTVAL(INTVAL(operands[2])) && 
+   !ADD_HIGH_16(INTVAL(operands[2]))
+   && (REGNO (operands[0]) != REGNO (operands[1]))"
+  [(parallel [(set (match_dup 3)
+		   (xor:QI (match_dup 4)
+			   (match_dup 5)))
+	      (clobber (match_dup 6))])
+   (parallel [(set (match_dup 6)
+		   (xor:QI (match_dup 7)
+			   (match_dup 8)))
+	      (clobber (match_scratch:QI 9 ""))])]
+  "
+{
+  operands[3] = gen_lowpart(QImode, operands[0]);
+  operands[4] = gen_lowpart(QImode, operands[1]);
+  operands[5] = gen_rtx (CONST_INT, VOIDmode, INTVAL (operands[2]) & 0xffff);
+
+  operands[6] = gen_highpart(QImode, operands[0]);
+  operands[7] = gen_highpart(QImode, operands[0]);
+  operands[8] = gen_rtx (CONST_INT, VOIDmode, (((INTVAL (operands[2]) & 0xffff0000) >> 16) & 0xffff));
+}")
+
+(define_insn "xorhi3"
+  [(set (match_operand:HI 0 "register_operand" "=A,A,A,A,?A")
+        (xor:HI (match_operand:HI 1 "register_operand" "%A,!A,A,A,A")
+                (match_operand:HI 2 "nonmemory_operand" "Z,A,I,M,i")))]
+  ""
+  "@
+   %0=%1^%2
+   %0=%1^%2
+   %0=%w1^%H2
+   %0=%b1^%U2
+   %0=%w1^%H2\;%0=%b0^%U2"
+  [(set_attr "type" "f3_alu,f3_alu,f3_alu_i,f3_alu_i,f3_alu_i_mult")])
+
+(define_insn "xorqi3"
+  [(set (match_operand:QI 0 "register_operand" "=k,u,!k,!u,k,u,k,u,j,q,j,q,j,q,!j,!q")
+	(xor:QI (match_operand:QI 1 "register_operand" "%uk,uk,uk,uk,0,0,u,k,jq,jq,0,0,q,j,jq,jq")
+		(match_operand:QI 2 "nonmemory_operand" "wz,wz,uk,uk,i,i,i,i,yv,yv,i,i,i,i,jq,jq")))
+   (clobber (match_scratch:QI 3 "=j,q,j,q,X,X,j,q,k,u,X,X,k,u,k,u"))]
+  ""
+  "@
+    %m0=%m1^%m2
+    %m0=%m1^%m2
+    %m0=%m1^%m2
+    %m0=%m1^%m2
+    %m0=%1^%H2
+    %m0=%1^%H2
+    %m0=%1^%H2
+    %m0=%1^%H2
+    %m0=%m1^%m2
+    %m0=%m1^%m2
+    %m0=%b1^%H2
+    %m0=%b1^%H2
+    %m0=%b1^%H2
+    %m0=%b1^%H2
+    %m0=%m1^%m2
+    %m0=%m1^%m2"
+  [(set_attr "type" "f3_alu,f3_alu,f3_alu,f3_alu,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu,f3_alu,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu,f3_alu")])
+
+(define_insn "one_cmplhi2"
+  [(set (match_operand:HI 0 "register_operand" "=A")
+        (not:HI (match_operand:HI 1 "register_operand" "A")))]
+  ""
+  "%0= ~%1"
+  [(set_attr "type" "special")])
+
+
+(define_insn "one_cmplqi2"
+  [(set (match_operand:QI 0 "register_operand" "=k,k,u,u,j,j,q,q")
+        (not:QI (match_operand:QI 1 "register_operand" "0,u,0,q,0,q,0,j")))
+   (clobber (match_scratch:QI 2 "=X,j,X,q,X,k,X,u"))]
+  ""
+  "@
+   %m0= %1 ^ 0xffff
+   %m0= %1 ^ 0xffff
+   %m0= %1 ^ 0xffff
+   %m0= %1 ^ 0xffff
+   %m0= %b1 ^ 0xffff
+   %m0= %b1 ^ 0xffff
+   %m0= %b1 ^ 0xffff
+   %m0= %b1 ^ 0xffff"
+  [(set_attr "type" "f3_alu_i,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu_i,f3_alu_i")])
+
+
+;;
+;; MOVE INSTRUCTIONS
+;;
+
+(define_split
+  [(set (mem:HI (match_operand:QI 0 "register_operand" ""))
+	(match_operand:HI 1 "register_operand" ""))]
+  "reload_completed && (operands[0] != stack_pointer_rtx)"
+  [(set (mem:QI (post_inc:QI (match_dup 0)))
+	(match_dup 2))
+   (set (mem:QI (post_dec:QI (match_dup 0)))
+	(match_dup 3))]
+  "
+{
+  operands[2] = gen_highpart(QImode, operands[1]);
+  operands[3] = gen_lowpart(QImode, operands[1]);
+}")
+
+
+(define_split
+  [(set (match_operand:HI 0 "register_operand" "")
+	(mem:HI (match_operand:QI 1 "register_operand" "")))]
+  "reload_completed && (operands[1] != stack_pointer_rtx)"
+  [(set (match_dup 2)
+	(mem:QI (post_inc:QI (match_dup 1))))
+   (set (match_dup 3)
+	(mem:QI (post_dec:QI (match_dup 1))))]
+  "
+{
+  operands[2] = gen_highpart(QImode, operands[0]);
+  operands[3] = gen_lowpart(QImode, operands[0]);
+}")
+
+(define_split
+  [(set (mem:HI (post_inc:HI (match_operand:QI 0 "register_operand" "")))
+	(match_operand:HI 1 "register_operand" ""))]
+  "reload_completed"
+  [(set (mem:QI (post_inc:QI (match_dup 0)))
+	(match_dup 2))
+   (set (mem:QI (post_inc:QI (match_dup 0)))
+	(match_dup 3))]
+  "
+{
+  operands[2] = gen_highpart(QImode, operands[1]);
+  operands[3] = gen_lowpart(QImode, operands[1]);
+}")
+
+(define_split
+  [(set (match_operand:HI 0 "register_operand" "")
+	(mem:HI (post_inc:HI (match_operand:QI 1 "register_operand" ""))))]
+  "reload_completed"
+  [(set (match_dup 2)
+	(mem:QI (post_inc:QI (match_dup 1))))
+   (set (match_dup 3)
+	(mem:QI (post_inc:QI (match_dup 1))))]
+  "
+{
+  operands[2] = gen_highpart(QImode, operands[0]);
+  operands[3] = gen_lowpart(QImode, operands[0]);
+}")
+
+
+(define_split
+  [(set (match_operand:HI 0 "register_operand" "")
+	(match_operand:HI 1 "register_operand" ""))]
+  "reload_completed && 
+   !(IS_ACCUM_REG (REGNO(operands[0])) && 
+    (REGNO(operands[1]) == REG_PROD || REGNO(operands[1]) == REG_Y))"
+  [(set (match_dup 2)
+	(match_dup 3))
+   (set (match_dup 4)
+	(match_dup 5))]
+  "
+{
+  operands[2] = gen_highpart(QImode, operands[0]);
+  operands[3] = gen_highpart(QImode, operands[1]);
+  operands[4] = gen_lowpart(QImode, operands[0]);
+  operands[5] = gen_lowpart(QImode, operands[1]);
+}")
+
+(define_split
+  [(set (match_operand:HI 0 "register_operand" "")
+	(match_operand:HI 1 "const_int_operand" ""))]
+  "reload_completed"
+  [(set (match_dup 2)
+	(match_dup 3))
+   (set (match_dup 4)
+	(match_dup 5))]
+   "
+{
+  operands[2] = gen_lowpart(QImode, operands[0]);
+  operands[3] = gen_rtx (CONST_INT, VOIDmode, INTVAL (operands[1]) & 0xffff);
+
+  operands[4] = gen_highpart(QImode, operands[0]);
+  operands[5] = gen_rtx (CONST_INT, VOIDmode, (((INTVAL (operands[1]) & 0xffff0000) >> 16) & 0xffff));
+}")
+
+(define_expand "movhi"
+  [(set (match_operand:HI 0 "general_operand" "")
+	(match_operand:HI 1 "general_operand" ""))]
+  ""
+  "
+{
+  if (emit_move_sequence (operands, HImode))
+    DONE;
+}")
+
+
+(define_insn "match_movhi1"
+  [(set (match_operand:HI 0 "nonimmediate_operand"  "=A,Z,A,d,d,m,?d,*Y,t,f")
+	(match_operand:HI 1 "general_operand"        "d,A,K,i,m,d,*Y,?d,t,f"))]
+  "register_operand(operands[0], HImode)
+   || register_operand(operands[1], HImode)"
+  "*
+{
+	switch (which_alternative)
+        {
+		/* register to accumulator */
+		case 0:
+ 		   return \"%0=%1\";
+		case 1:
+		   return \"%u0=%u1\;%w0=%w1\";
+	        case 2:
+	           return \"%0=%0^%0\";
+		case 3:
+		     return \"%u0=%U1\;%w0=%H1\";
+		case 4:
+		   double_reg_from_memory(operands);
+		   return \"\";
+		case 5:
+		   double_reg_to_memory(operands);
+		   return \"\";
+		case 6:
+		case 7:
+		   return \"%u0=%u1\;%w0=%w1\";
+		case 8:
+		case 9:
+		   return \"\";
+                default:
+                  abort();
+        }
+}"
+[(set_attr "type" "special,data_move_multiple,f3_alu,data_move_multiple,data_move_multiple,data_move_multiple,data_move_multiple,data_move_multiple,nothing,nothing")])
+
+
+;; NOTE: It is cheaper to do 'y = *r0', than 'r0 = *r0'.
+
+(define_expand "movqi"
+  [(set (match_operand:QI 0 "nonimmediate_operand" "")
+	(match_operand:QI 1 "general_operand" ""))]
+  ""
+  "
+{
+  if (emit_move_sequence (operands, QImode))
+    DONE;
+}")
+
+;; The movqi pattern with the parallel is used for addqi insns (which have a parallel)
+;; that are turned into moveqi insns by the flow phase. This happens when an auto-increment
+;; is detected.
+
+(define_insn "match_movqi1"
+  [(parallel [(set (match_operand:QI 0 "nonimmediate_operand" "=A,r,aW,c,?D,m<>,e,Y,r,xyz,m<>")
+		   (match_operand:QI 1 "general_operand"       "r,A,J,i,m<>,D,Y,e,0,m<>,xyz"))
+	      (clobber (match_scratch:QI 2 "=X,X,X,X,X,X,X,X,X,X,X"))])]
+  "register_operand(operands[0], QImode)
+   || register_operand(operands[1], QImode)"
+  "*
+{
+	switch (which_alternative)
+	{
+		case 0:
+		   /* We have to use the move mneumonic otherwise the 1610 will
+		      attempt to transfer all 32-bits of 'y', 'p' or an accumulator
+		      , which we don't want */
+		   if (REGNO(operands[1]) == REG_Y || REGNO(operands[1]) == REG_PROD
+			|| IS_ACCUM_REG(REGNO(operands[1])))
+		       return \"move %0=%1\";
+		   else
+		       return \"%0=%1\";
+
+		case 1:
+ 		   return \"%0=%1\";
+
+		case 2:
+		   return \"set %0=%H1\";
+
+		case 3:
+                   return \"%0=%H1\";
+
+		case 4:
+		   return \"%0=%1\";
+
+		case 5:
+		case 6:
+                   return \"%0=%1\";
+
+		case 7:
+		   return \"%0=%1\";
+
+		case 8:
+		   return \"\";
+
+                case 9: case 10:
+		   return \"%0=%1\";
+                default:
+                  abort();
+	}
+}"
+[(set_attr "type" "data_move,data_move,data_move_short_i,data_move_i,data_move_memory,data_move_memory,data_move_memory,data_move_memory,nothing,malu,malu")])
+
+(define_insn "match_movqi2"
+  [(set (match_operand:QI 0 "nonimmediate_operand" "=A,r,aW,c,?D,m<>,e,Y,r,xyz,m<>")
+	(match_operand:QI 1 "general_operand"       "r,A,J,i,m<>,D,Y,e,0,m<>,xyz"))]
+  "register_operand(operands[0], QImode)
+   || register_operand(operands[1], QImode)"
+  "*
+{
+	switch (which_alternative)
+	{
+		case 0:
+		   /* We have to use the move mneumonic otherwise the 1610 will
+		      attempt to transfer all 32-bits of 'y', 'p' or an accumulator
+		      , which we don't want */
+		   if (REGNO(operands[1]) == REG_Y || REGNO(operands[1]) == REG_PROD
+			|| IS_ACCUM_REG(REGNO(operands[1])))
+		       return \"move %0=%1\";
+		   else
+		       return \"%0=%1\";
+
+		case 1:
+ 		   return \"%0=%1\";
+
+		case 2:
+		   return \"set %0=%H1\";
+
+		case 3:
+                   return \"%0=%H1\";
+
+		case 4:
+		   return \"%0=%1\";
+
+		case 5:
+		case 6:
+                   return \"%0=%1\";
+
+		case 7:
+		   return \"%0=%1\";
+
+		case 8:
+		   return \"\";
+
+                case 9: case 10:
+		   return \"%0=%1\";
+                default:
+                  abort();
+	}
+}"
+[(set_attr "type" "data_move,data_move,data_move_short_i,data_move_i,data_move_memory,data_move_memory,data_move_memory,data_move_memory,nothing,malu,malu")])
+
+(define_expand "reload_inqi"
+  [(set (match_operand:QI 0 "register_operand" "=u")
+        (match_operand:QI 1 "sp_operand" ""))
+   (clobber (match_operand:QI 2 "register_operand" "=&q"))]
+  ""
+  "
+{
+  rtx addr_reg = XEXP (operands[1], 0);
+  rtx offset = XEXP (operands[1], 1);
+
+  /* First, move the frame or stack pointer to the accumulator */
+  emit_move_insn (operands[0], addr_reg);
+
+  /* Then generate the add insn */
+  emit_insn (gen_rtx_PARALLEL
+	     (VOIDmode, 
+	      gen_rtvec (2,
+			 gen_rtx_SET (VOIDmode, operands[0], 
+				      gen_rtx_PLUS (QImode, operands[0],
+						    offset)),
+			 gen_rtx_CLOBBER (VOIDmode, operands[2]))));
+  DONE;
+}")
+
+(define_expand "reload_inhi"
+  [(set (match_operand:HI 0 "register_operand" "=r")
+        (match_operand:HI 1 "register_operand" "r"))
+   (clobber (match_operand:QI 2 "register_operand" "=&h"))]
+  ""
+  "
+{
+  /* Check for an overlap of operand 2 (an accumulator) with
+     the msw of operand 0. If we have an overlap we must reverse
+     the order of the moves.  */
+
+  if (REGNO(operands[2]) == REGNO(operands[0]))
+    {
+      emit_move_insn (operands[2], operand_subword (operands[1], 1, 0, HImode));
+      emit_move_insn (operand_subword (operands[0], 1, 0, HImode), operands[2]);
+      emit_move_insn (operands[2], operand_subword (operands[1], 0, 0, HImode));
+      emit_move_insn (operand_subword (operands[0], 0, 0, HImode), operands[2]);
+    }
+  else
+    {
+      emit_move_insn (operands[2], operand_subword (operands[1], 0, 0, HImode));
+      emit_move_insn (operand_subword (operands[0], 0, 0, HImode), operands[2]);
+      emit_move_insn (operands[2], operand_subword (operands[1], 1, 0, HImode));
+      emit_move_insn (operand_subword (operands[0], 1, 0, HImode), operands[2]);
+    }
+
+  DONE;
+}")
+
+
+(define_expand "reload_outhi"
+  [(set (match_operand:HI 0 "register_operand" "=r")
+        (match_operand:HI 1 "register_operand" "r"))
+   (clobber (match_operand:QI 2 "register_operand" "=&h"))]
+  ""
+  "
+{
+	emit_move_insn (operands[2], operand_subword (operands[1], 0, 0, HImode));
+	emit_move_insn (operand_subword (operands[0], 0, 0, HImode), operands[2]);
+	emit_move_insn (operands[2], operand_subword (operands[1], 1, 0, HImode));
+	emit_move_insn (operand_subword (operands[0], 1, 0, HImode), operands[2]);
+	DONE;
+}")
+
+(define_expand "movstrqi"
+  [(parallel [(set (match_operand:BLK 0 "memory_operand" "")
+		   (match_operand:BLK 1 "memory_operand" ""))
+	      (use (match_operand:QI 2 "const_int_operand" ""))
+	      (use (match_operand:QI 3 "const_int_operand" ""))
+	      (clobber (match_scratch:QI 4 ""))
+	      (clobber (match_dup 5))
+	      (clobber (match_dup 6))])]
+  ""
+  "
+{
+  rtx addr0, addr1;
+
+  if (GET_CODE (operands[2]) != CONST_INT)
+    FAIL;
+
+  if (INTVAL(operands[2]) > 127)
+    FAIL;
+
+  addr0 = copy_to_mode_reg (Pmode, XEXP (operands[0], 0));
+  addr1 = copy_to_mode_reg (Pmode, XEXP (operands[1], 0));
+
+  operands[5] = addr0;
+  operands[6] = addr1;
+
+  operands[0] = change_address (operands[0], VOIDmode, addr0);
+  operands[1] = change_address (operands[1], VOIDmode, addr1);
+}")
+
+(define_insn ""
+  [(set (mem:BLK (match_operand:QI 0 "register_operand" "a"))
+	(mem:BLK (match_operand:QI 1 "register_operand" "a")))
+   (use (match_operand:QI 2 "const_int_operand" "n"))
+   (use (match_operand:QI 3 "immediate_operand" "i"))
+   (clobber (match_scratch:QI 4 "=x"))
+   (clobber (match_dup 0))
+   (clobber (match_dup 1))]
+  ""
+  "*
+{ return output_block_move (operands); }")
+
+
+;; Floating point move insns
+
+
+(define_expand "movhf"
+  [(set (match_operand:HF 0 "general_operand" "")
+	(match_operand:HF 1 "general_operand" ""))]
+  ""
+  "
+{
+  if (emit_move_sequence (operands, HFmode))
+    DONE;
+}")
+
+(define_insn "match_movhf"
+  [(set (match_operand:HF 0 "nonimmediate_operand" "=A,Z,d,d,m,d,Y")
+	(match_operand:HF 1 "general_operand"       "d,A,F,m,d,Y,d"))]
+  ""
+  "*
+{
+	/* NOTE: When loading the register 16 bits at a time we
+	   MUST load the high half FIRST (because the 1610 zeros
+	   the low half) and then load the low half */
+
+	switch (which_alternative)
+        {
+		/* register to accumulator */
+		case 0:
+ 		   return \"%0=%1\";
+		case 1:
+		   return \"%u0=%u1\;%w0=%w1\";
+		case 2:
+		   output_dsp16xx_float_const(operands);
+		   return \"\";
+		case 3:
+		   double_reg_from_memory(operands);
+		   return \"\";
+		case 4:
+		   double_reg_to_memory(operands);
+		   return \"\";
+		case 5:
+		case 6:
+		   return \"%u0=%u1\;%w0=%w1\";
+                default:
+                  abort();
+        }
+}"
+[(set_attr "type" "move,move,load_i,load,store,load,store")])
+
+
+
+(define_expand "reload_inhf"
+  [(set (match_operand:HF 0 "register_operand" "=r")
+        (match_operand:HF 1 "register_operand" "r"))
+   (clobber (match_operand:QI 2 "register_operand" "=&h"))]
+  ""
+  "
+{
+  /* Check for an overlap of operand 2 (an accumulator) with
+     the msw of operand 0. If we have an overlap we must reverse
+     the order of the moves.  */
+
+  if (REGNO(operands[2]) == REGNO(operands[0]))
+    {
+      emit_move_insn (operands[2], operand_subword (operands[1], 1, 0, HFmode));
+      emit_move_insn (operand_subword (operands[0], 1, 0, HFmode), operands[2]);
+      emit_move_insn (operands[2], operand_subword (operands[1], 0, 0, HFmode));
+      emit_move_insn (operand_subword (operands[0], 0, 0, HFmode), operands[2]);
+    }
+  else
+    {
+      emit_move_insn (operands[2], operand_subword (operands[1], 0, 0, HFmode));
+      emit_move_insn (operand_subword (operands[0], 0, 0, HFmode), operands[2]);
+      emit_move_insn (operands[2], operand_subword (operands[1], 1, 0, HFmode));
+      emit_move_insn (operand_subword (operands[0], 1, 0, HFmode), operands[2]);
+    }
+  
+  DONE;
+}")
+
+(define_expand "reload_outhf"
+  [(set (match_operand:HF 0 "register_operand" "=r")
+        (match_operand:HF 1 "register_operand" "r"))
+   (clobber (match_operand:QI 2 "register_operand" "=&h"))]
+  ""
+  "
+{
+	emit_move_insn (operands[2], operand_subword (operands[1], 0, 0, HFmode));
+	emit_move_insn (operand_subword (operands[0], 0, 0, HFmode), operands[2]);
+	emit_move_insn (operands[2], operand_subword (operands[1], 1, 0, HFmode));
+	emit_move_insn (operand_subword (operands[0], 1, 0, HFmode), operands[2]);
+	DONE;
+}")
+
+
+;;
+;; CONVERSION INSTRUCTIONS
+;;
+
+(define_expand "extendqihi2"
+  [(clobber (match_dup 2))
+   (set (match_dup 3) (match_operand:QI 1 "register_operand" ""))
+   (set (match_operand:HI 0 "register_operand" "")
+	(ashift:HI (match_dup 2)
+		   (const_int 16)))
+   (set (match_dup 0)
+	(ashiftrt:HI (match_dup 0) (const_int 16)))]
+  ""
+  "
+{
+	operands[2] = gen_reg_rtx (HImode);
+	operands[3] = gen_rtx_SUBREG (QImode, operands[2], 1);
+}")
+
+(define_insn "internal_extendqihi2"
+  [(set (match_operand:HI 0 "register_operand" "=A")
+	(sign_extend:HI (match_operand:QI 1 "register_operand" "ku")))]
+  "TARGET_BMU"
+  "%0 = extracts(%m1, 0x1000)"
+[(set_attr "type" "shift_i")])
+
+;;(define_insn "extendqihi2"
+;;  [(set (match_operand:HI 0 "register_operand" "=A")
+;;        (sign_extend:HI (match_operand:QI 1 "register_operand" "h")))]
+;;  ""
+;;  "%0 = %1 >> 16")
+
+;;(define_insn "zero_extendqihi2"
+;;  [(set (match_operand:HI 0 "register_operand" "=t,f,A,?d,?A")
+;;        (zero_extend:HI (match_operand:QI 1 "register_operand" "w,z,ku,A,r")))]
+;;  ""
+;;  "*
+;; {
+;;  switch (which_alternative)
+;;    {
+;;    case 0:
+;;    case 1:
+;;      return \"%0=0\";
+;;
+;;    case 2:
+;;      if (REGNO(operands[1]) == (REGNO(operands[0]) + 1))
+;;        return \"%0=0\";
+;;      else
+;;	return \"%w0=%1\;%0=0\";
+;;    case 3:
+;;      return \"%w0=%1\;%0=0\";
+;;
+;;    case 4:
+;;      if (REGNO(operands[1]) == REG_Y || REGNO(operands[1]) == REG_PROD
+;;	  || IS_ACCUM_REG(REGNO(operands[1])))
+;;	return \"move %w0=%1\;%0=0\";
+;;      else
+;;	return \"%w0=%1\;%0=0\";
+;;    default:
+;;      abort();
+;;    }
+;; }")
+
+;;(define_expand "zero_extendqihi2"
+;;  [(clobber (match_dup 2))
+;;   (set (match_dup 3) (match_operand:QI 1 "register_operand" ""))
+;;   (set (match_operand:HI 0 "register_operand" "")
+;;	(ashift:HI (match_dup 2)
+;;		   (const_int 16)))
+;;   (set (match_dup 0)
+;;	(lshiftrt:HI (match_dup 0) (const_int 16)))]
+;;  ""
+;;  "
+;;{
+;;	operands[2] = gen_reg_rtx (HImode);
+;;	operands[3] = gen_rtx (SUBREG, QImode, operands[2], 1);
+;;}")
+
+(define_expand "zero_extendqihi2"
+  [(set (match_operand:HI 0 "register_operand" "")
+      (zero_extend:HI (match_operand:QI 1 "register_operand" "")))]
+  ""
+  "")  
+	
+
+(define_insn "match_zero_extendqihi_bmu"
+  [(set (match_operand:HI 0 "register_operand" "=?*Z,?*Z,?A,A")
+        (zero_extend:HI (match_operand:QI 1 "register_operand" "?A,?*Y,*Z*x*a*W*Y,ku")))]
+  "TARGET_BMU"
+  "*
+ {
+    switch (which_alternative)
+      {
+        case 0:
+          return \"%w0=%1\;%0=0\";
+
+        case 1:
+          return \"%w0=%1\;%0=0\";
+
+        case 2:
+          if (REGNO(operands[1]) == (REGNO(operands[0]) + 1))
+            return \"%0=0\";
+          else if (REGNO(operands[1]) == REG_Y || REGNO(operands[1]) == REG_PROD
+	           || IS_ACCUM_REG(REGNO(operands[1])))
+          {
+            return \"move %w0=%1\;%0=0\";
+          }
+          else
+            return \"%w0=%1\;%0=0\";
+
+	case 3:
+	  return \"%0 = extractz(%m1, 0x1000)\";
+        default:
+          abort();
+      }
+  }"
+  [(set_attr "type" "data_move_2,data_move_2,data_move_2,shift_i")])
+
+(define_insn "match_zero_extendqihi2_nobmu"
+  [(set (match_operand:HI 0 "register_operand" "=?Z,?Z,A")
+        (zero_extend:HI (match_operand:QI 1 "register_operand" "A,Y,r")))]
+  ""
+  "*
+ {
+    switch (which_alternative)
+      {
+        case 0:
+          return \"%w0=%1\;%0=0\";
+
+        case 1:
+          return \"%w0=%1\;%0=0\";
+
+        case 2:
+          if (REGNO(operands[1]) + 1 == (REGNO(operands[0]) + 1))
+            return \"%0=0\";
+          else if (REGNO(operands[1]) == REG_Y || REGNO(operands[1]) == REG_PROD
+	           || IS_ACCUM_REG(REGNO(operands[1])))
+          {
+            return \"move %w0=%1\;%0=0\";
+          }
+          else
+            return \"%w0=%1\;%0=0\";
+          default:
+            abort();
+      }
+  }"
+  [(set_attr "type" "data_move_2,data_move_2,data_move_2")])
+
+;;
+;; Floating point conversions
+;;
+(define_expand "floathihf2"
+  [(set (match_operand:HF 0 "register_operand" "")
+	(float:HF (match_operand:HI 1 "register_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_floathihf2_libcall)
+    dsp16xx_floathihf2_libcall = gen_rtx_SYMBOL_REF (Pmode, FLOATHIHF2_LIBCALL);
+  
+  emit_library_call (dsp16xx_floathihf2_libcall, 1, HFmode, 1,
+		     operands[1], HImode);
+  emit_move_insn (operands[0], hard_libcall_value(HFmode));
+  DONE;
+}")
+
+(define_expand "fix_trunchfhi2"
+  [(set (match_operand:HI 0 "register_operand" "")
+	(fix:HI (match_operand:HF 1 "register_operand" "")))]
+  ""
+  "
+{
+  if (!dsp16xx_fixhfhi2_libcall)
+    dsp16xx_fixhfhi2_libcall = gen_rtx_SYMBOL_REF (Pmode, FIXHFHI2_LIBCALL);
+  
+  emit_library_call (dsp16xx_fixhfhi2_libcall, 1, HImode, 1,
+		     operands[1], HFmode);
+  emit_move_insn (operands[0], hard_libcall_value(HImode));
+  DONE;
+}")
+
+(define_expand "fixuns_trunchfhi2"
+  [(set (match_operand:HI 0 "register_operand" "")
+	(unsigned_fix:HI (match_operand:HF 1 "register_operand" "")))]
+  ""
+  "
+{
+  rtx reg1 = gen_reg_rtx (HFmode);
+  rtx reg2 = gen_reg_rtx (HFmode);
+  rtx reg3 = gen_reg_rtx (HImode);
+  rtx label1 = gen_label_rtx ();
+  rtx label2 = gen_label_rtx ();
+  REAL_VALUE_TYPE offset;
+
+  real_2expN (&offset, 31);
+
+  if (reg1)			/* turn off complaints about unreached code */
+    {
+      emit_move_insn (reg1, CONST_DOUBLE_FROM_REAL_VALUE (offset, HFmode));
+      do_pending_stack_adjust ();
+
+      emit_insn (gen_cmphf (operands[1], reg1));
+      emit_jump_insn (gen_bge (label1));
+
+      emit_insn (gen_fix_trunchfhi2 (operands[0], operands[1]));
+      emit_jump_insn (gen_rtx_SET (VOIDmode, pc_rtx,
+				   gen_rtx_LABEL_REF (VOIDmode, label2)));
+      emit_barrier ();
+
+      emit_label (label1);
+      emit_insn (gen_subhf3 (reg2, operands[1], reg1));
+      emit_move_insn (reg3, GEN_INT (0x80000000));;
+
+      emit_insn (gen_fix_trunchfhi2 (operands[0], reg2));
+      emit_insn (gen_iorhi3 (operands[0], operands[0], reg3));
+
+      emit_label (label2);
+
+      /* allow REG_NOTES to be set on last insn (labels don't have enough
+	 fields, and can't be used for REG_NOTES anyway).  */
+      emit_insn (gen_rtx_USE (VOIDmode, stack_pointer_rtx));
+      DONE;
+    }
+}")
+
+;;
+;; SHIFT INSTRUCTIONS
+;;
+
+(define_insn ""
+  [(set (match_operand:HI 0 "register_operand" "=A")
+        (ashiftrt:HI (match_operand:HI 1 "register_operand" "A")
+                     (const_int 1)))]
+  ""
+  "%0=%1>>1"
+  [(set_attr "type" "special")])
+
+(define_insn ""
+  [(set (match_operand:HI 0 "register_operand" "=A")
+        (ashiftrt:HI (match_operand:HI 1 "register_operand" "A")
+                     (const_int 4)))]
+  ""
+  "%0=%1>>4"
+  [(set_attr "type" "special")])
+
+(define_insn ""
+  [(set (match_operand:HI 0 "register_operand" "=A")
+        (ashiftrt:HI (match_operand:HI 1 "register_operand" "A")
+                     (const_int 8)))]
+  ""
+  "%0=%1>>8"
+  [(set_attr "type" "special")])
+
+(define_insn ""
+  [(set (match_operand:HI 0 "register_operand" "=A")
+        (ashiftrt:HI (match_operand:HI 1 "register_operand" "A")
+                     (const_int 16)))]
+  ""
+  "%0=%1>>16"
+  [(set_attr "type" "special")])
+
+;;
+;; Arithmetic Right shift
+
+(define_expand "ashrhi3"
+  [(set (match_operand:HI 0 "register_operand" "")
+        (ashiftrt:HI (match_operand:HI 1 "register_operand" "")
+                     (match_operand:QI 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!TARGET_BMU)
+  {
+      /* If we are shifting by a constant we can do it in 1 or more
+	 1600 core shift instructions. The core instructions can
+	 shift by 1, 4, 8, or 16.  */
+      
+      if (GET_CODE(operands[2]) == CONST_INT)
+	;
+      else
+      {
+	rtx label1 = gen_label_rtx ();
+	rtx label2 = gen_label_rtx ();
+
+#if 0
+	if (!dsp16xx_ashrhi3_libcall)
+	  dsp16xx_ashrhi3_libcall
+	    = gen_rtx_SYMBOL_REF (Pmode, ASHRHI3_LIBCALL);
+
+	  emit_library_call (dsp16xx_ashrhi3_libcall, 1, HImode, 2,
+			     operands[1], HImode,
+			     operands[2], QImode);
+	  emit_move_insn (operands[0], hard_libcall_value(HImode));
+	  DONE;
+#else
+	do_pending_stack_adjust ();
+	emit_insn (gen_tstqi (operands[2]));
+	emit_jump_insn (gen_bne (label1));
+	emit_move_insn (operands[0], operands[1]);
+	emit_jump_insn (gen_jump (label2));
+	emit_barrier ();
+	emit_label (label1);
+
+	if (GET_CODE(operands[2]) != MEM)
+	  {
+	    rtx stack_slot;
+	    
+	    stack_slot = assign_stack_temp (QImode, GET_MODE_SIZE(QImode), 0);
+	    stack_slot = change_address (stack_slot, VOIDmode, XEXP (stack_slot, 0));
+	    emit_move_insn (stack_slot, operands[2]);
+	    operands[2] = stack_slot;
+	  }
+
+	emit_insn (gen_match_ashrhi3_nobmu (operands[0], operands[1], operands[2]));
+	emit_label (label2);
+	DONE;
+#endif
+      }
+  }
+}")
+
+(define_insn "match_ashrhi3_bmu"
+  [(set (match_operand:HI 0 "register_operand" "=A,A,A")
+        (ashiftrt:HI (match_operand:HI 1 "register_operand" "A,A,!A")
+                     (match_operand:QI 2 "nonmemory_operand" "B,I,h")))]
+  "TARGET_BMU"
+  "@
+   %0=%1>>%2
+   %0=%1>>%H2
+   %0=%1>>%2"
+  [(set_attr "type" "shift,shift_i,shift")])
+
+(define_insn "match_ashrhi3_nobmu"
+  [(set (match_operand:HI 0 "register_operand" "=A,A")
+        (ashiftrt:HI (match_operand:HI 1 "register_operand" "A,0")
+                     (match_operand:QI 2 "general_operand" "n,m")))]
+  "!TARGET_BMU"
+  "*
+{
+  if (which_alternative == 0)
+    {
+      emit_1600_core_shift (ASHIFTRT, operands, INTVAL(operands[2]));
+      return \"\";
+    }
+  else
+    {
+      output_asm_insn (\"cloop=%2\", operands);
+      output_asm_insn (\"do 0 {\", operands);
+      output_asm_insn (\"%0=%0>>1\", operands);
+      return \"}\";
+    }
+}")
+		   
+
+
+;;
+;; Logical Right Shift
+
+(define_insn ""
+  [(set (match_operand:HI 0 "register_operand" "=A")
+        (lshiftrt:HI (match_operand:HI 1 "register_operand" "A")
+                     (const_int 1)))]
+  "!TARGET_BMU"
+  "%0=%1>>1\;%0=%b0&0x7fff"
+  [(set_attr "type" "special")])
+
+(define_insn ""
+  [(set (match_operand:HI 0 "register_operand" "=A")
+        (lshiftrt:HI (match_operand:HI 1 "register_operand" "A")
+                     (const_int 4)))]
+  "!TARGET_BMU"
+  "%0=%1>>4\;%0=%b0&0x0fff"
+  [(set_attr "type" "special")])
+
+(define_insn ""
+  [(set (match_operand:HI 0 "register_operand" "=A")
+        (lshiftrt:HI (match_operand:HI 1 "register_operand" "A")
+                     (const_int 8)))]
+  "!TARGET_BMU"
+  "%0=%1>>8\;%0=%b0&0x00ff"
+  [(set_attr "type" "special")])
+
+(define_insn ""
+  [(set (match_operand:HI 0 "register_operand" "=A")
+        (lshiftrt:HI (match_operand:HI 1 "register_operand" "A")
+                     (const_int 16)))]
+  "!TARGET_BMU"
+  "%0=%1>>16\;%0=%b0&0x0000"
+  [(set_attr "type" "special")])
+
+(define_expand "lshrhi3"
+  [(set (match_operand:HI 0 "register_operand" "")
+        (lshiftrt:HI (match_operand:HI 1 "register_operand" "")
+                     (match_operand:QI 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!TARGET_BMU)
+    {
+      /* If we are shifting by a constant we can do it in 1 or more
+	 1600 core shift instructions. The core instructions can
+	 shift by 1, 4, 8, or 16.  */
+      
+      if (GET_CODE(operands[2]) == CONST_INT)
+	emit_insn (gen_match_lshrhi3_nobmu (operands[0], operands[1], operands[2]));	
+      else
+	{
+	  rtx label1 = gen_label_rtx ();
+	  rtx label2 = gen_label_rtx ();
+#if 0
+	  if (!dsp16xx_lshrhi3_libcall)
+	    dsp16xx_lshrhi3_libcall
+	      = gen_rtx_SYMBOL_REF (Pmode, LSHRHI3_LIBCALL);
+	  
+	  emit_library_call (dsp16xx_lshrhi3_libcall, 1, HImode, 2,
+			     operands[1], HImode,
+			     operands[2], QImode);
+	  emit_move_insn (operands[0], hard_libcall_value(HImode));
+	  DONE;
+#else
+	  do_pending_stack_adjust ();
+	  emit_insn (gen_tstqi (operands[2]));
+	  emit_jump_insn (gen_bne (label1));
+	  emit_move_insn (operands[0], operands[1]);
+	  emit_jump_insn (gen_jump (label2));
+	  emit_barrier ();
+	  emit_label (label1);
+
+	  if (GET_CODE(operands[2]) != MEM)
+	    {
+	      rtx stack_slot;
+	    
+	      stack_slot = assign_stack_temp (QImode, GET_MODE_SIZE(QImode), 0);
+	      stack_slot = change_address (stack_slot, VOIDmode, XEXP (stack_slot, 0));
+	      emit_move_insn (stack_slot, operands[2]);
+	      operands[2] = stack_slot;
+	    }
+
+	  emit_insn (gen_match_lshrhi3_nobmu (operands[0], operands[1], operands[2]));
+	  emit_label (label2);
+	  DONE;
+#endif
+	}
+    }
+}")
+
+(define_insn "match_lshrhi3"
+  [(set (match_operand:HI 0 "register_operand" "=A,A,A")
+        (lshiftrt:HI (match_operand:HI 1 "register_operand" "A,A,!A")
+                     (match_operand:QI 2 "nonmemory_operand" "B,I,h")))]
+  "TARGET_BMU"
+  "@
+   %0=%1>>>%2
+   %0=%1>>>%H2
+   %0=%1>>>%2"
+  [(set_attr "type" "shift,shift_i,shift")])
+
+(define_insn "match_lshrhi3_nobmu"
+  [(set (match_operand:HI 0 "register_operand" "=A,A")
+        (lshiftrt:HI (match_operand:HI 1 "register_operand" "A,0")
+                     (match_operand:QI 2 "general_operand" "n,m")))
+   (clobber (match_scratch:QI 3 "=X,Y"))]
+  "!TARGET_BMU"
+  "*
+{
+  if (which_alternative == 0)
+    {
+      emit_1600_core_shift (LSHIFTRT, operands, INTVAL(operands[2]));
+      return \"\";
+    }
+  else
+    {
+      output_asm_insn (\"%3=psw\;psw=0\",operands);
+      output_asm_insn (\"cloop=%2\", operands);
+      output_asm_insn (\"do 0 {\", operands);
+      output_asm_insn (\"%0=%0>>1\", operands);
+      output_asm_insn (\"}\", operands);
+      return \"psw=%3\";
+    }
+}")
+
+
+;;
+;; Arithmetic Left shift
+
+;; Start off with special case arithmetic left shift by 1,4,8 or 16.
+
+
+(define_insn ""
+  [(set (match_operand:HI 0 "register_operand" "=A")
+        (ashift:HI (match_operand:HI 1 "register_operand" "A")
+                   (const_int 1)))]
+  ""
+  "%0=%1<<1"
+  [(set_attr "type" "special")])
+
+(define_insn ""
+  [(set (match_operand:HI 0 "register_operand" "=A")
+        (ashift:HI (match_operand:HI 1 "register_operand" "A")
+                   (const_int 4)))]
+  ""
+  "%0=%1<<4"
+  [(set_attr "type" "special")])
+
+(define_insn ""
+  [(set (match_operand:HI 0 "register_operand" "=A")
+        (ashift:HI (match_operand:HI 1 "register_operand" "A")
+                   (const_int 8)))]
+  ""
+  "%0=%1<<8"
+  [(set_attr "type" "special")])
+
+(define_insn ""
+  [(set (match_operand:HI 0 "register_operand" "=A")
+        (ashift:HI (match_operand:HI 1 "general_operand" "A")
+                   (const_int 16)))]
+  ""
+  "%0=%1<<16"
+  [(set_attr "type" "special")])
+
+
+
+;; Normal Arithmetic Shift Left
+
+
+(define_expand "ashlhi3"
+  [(set (match_operand:HI 0 "register_operand" "")
+        (ashift:HI (match_operand:HI 1 "register_operand" "")
+                   (match_operand:QI 2 "nonmemory_operand" "")))]
+  ""
+  "
+{
+  if (!TARGET_BMU)
+  {
+      /* If we are shifting by a constant we can do it in 1 or more
+	 1600 core shift instructions. The core instructions can
+	 shift by 1, 4, 8, or 16.  */
+      
+      if (GET_CODE(operands[2]) == CONST_INT)
+	;
+      else
+      {
+	rtx label1 = gen_label_rtx ();
+	rtx label2 = gen_label_rtx ();
+#if 0
+	if (!dsp16xx_ashlhi3_libcall)
+	  dsp16xx_ashlhi3_libcall
+	    = gen_rtx_SYMBOL_REF (Pmode, ASHLHI3_LIBCALL);
+
+	  emit_library_call (dsp16xx_ashlhi3_libcall, 1, HImode, 2,
+			     operands[1], HImode, operands[2], QImode);
+	  emit_move_insn (operands[0], hard_libcall_value(HImode));
+	  DONE;
+#else
+	do_pending_stack_adjust ();
+	emit_insn (gen_tstqi (operands[2]));
+	emit_jump_insn (gen_bne (label1));
+	emit_move_insn (operands[0], operands[1]);
+	emit_jump_insn (gen_jump (label2));
+	emit_barrier ();
+	emit_label (label1);
+
+	if (GET_CODE(operands[2]) != MEM)
+	  {
+	    rtx stack_slot;
+	    
+	    stack_slot = assign_stack_temp (QImode, GET_MODE_SIZE(QImode), 0);
+	    stack_slot = change_address (stack_slot, VOIDmode, XEXP (stack_slot, 0));
+	    emit_move_insn (stack_slot, operands[2]);
+	    operands[2] = stack_slot;
+	  }
+	emit_insn (gen_match_ashlhi3_nobmu (operands[0], operands[1], operands[2]));
+	emit_label (label2);
+	DONE;
+#endif
+      }
+  }
+}")
+
+(define_insn "match_ashlhi3"
+  [(set (match_operand:HI 0 "register_operand" "=A,A,A")
+        (ashift:HI (match_operand:HI 1 "register_operand" "A,A,A")
+                   (match_operand:QI 2 "nonmemory_operand" "B,I,!h")))]
+  "TARGET_BMU"
+  "@
+   %0=%1<<%2\;move %u0=%u0
+   %0=%1<<%H2\;move %u0=%u0
+   %0=%1<<%2\;move %u0=%u0"
+  [(set_attr "type" "shift_multiple,shift_multiple,shift_multiple")])
+
+(define_insn "match_ashlhi3_nobmu"
+  [(set (match_operand:HI 0 "register_operand" "=A,A")
+        (ashift:HI (match_operand:HI 1 "register_operand" "A,0")
+		   (match_operand:QI 2 "general_operand" "n,m")))]
+  "!TARGET_BMU"
+  "*
+{
+  if (which_alternative == 0)
+    {
+      emit_1600_core_shift (ASHIFT, operands, INTVAL(operands[2]));
+      return \"\";
+    }
+  else
+    {
+      output_asm_insn (\"cloop=%2\", operands);
+      output_asm_insn (\"do 0 {\", operands);
+      output_asm_insn (\"%0=%0<<1\", operands);
+      return \"}\";
+    }
+}")
+
+
+
+
+(define_insn "extv"
+  [(set (match_operand:QI 0 "register_operand" "=k,u")
+	(sign_extract:QI (match_operand:QI 1 "register_operand" "ku,ku")
+			 (match_operand:QI 2 "const_int_operand" "n,n")
+			 (match_operand:QI 3 "const_int_operand" "n,n")))
+	(clobber (match_scratch:QI 4 "=j,q"))]
+  "TARGET_BMU"
+  "*
+{
+	operands[5]
+	= GEN_INT ((INTVAL (operands[2]) << 8) + (INTVAL (operands[3]) & 0xff));
+	return \"%m0 = extracts (%m1, %H5)\";
+}"
+[(set_attr "type" "shift_i")])
+
+(define_insn "extzv"
+  [(set (match_operand:QI 0 "register_operand" "=k,u")
+	(zero_extract:QI (match_operand:QI 1 "register_operand" "ku,ku")
+			 (match_operand:QI 2 "const_int_operand" "n,n")
+			 (match_operand:QI 3 "const_int_operand" "n,n")))
+	(clobber (match_scratch:QI 4 "=j,q"))]
+  "TARGET_BMU"
+  "*
+{
+	operands[5]
+	= GEN_INT ((INTVAL (operands[2]) << 8) + (INTVAL (operands[3]) & 0xff));
+	return \"%m0 = extractz (%m1, %H5)\";
+}"
+[(set_attr "type" "shift_i")])
+
+;;
+;; conditional instructions
+;;
+
+(define_expand "seq"
+  [(set (match_operand:QI 0 "register_operand" "")
+	(eq:QI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (EQ, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+(define_expand "sne"
+  [(set (match_operand:QI 0 "register_operand" "")
+	(ne:QI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (NE, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_expand "sgt"
+  [(set (match_operand:QI 0 "register_operand" "")
+	(gt:QI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (GT, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_expand "slt"
+  [(set (match_operand:QI 0 "register_operand" "")
+	(lt:QI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (LT, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+(define_expand "sge"
+  [(set (match_operand:QI 0 "register_operand" "")
+	(ge:QI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (GE, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_expand "sle"
+  [(set (match_operand:QI 0 "register_operand" "")
+	(le:QI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (LE, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_expand "sgtu"
+  [(set (match_operand:QI 0 "register_operand" "")
+	(gtu:QI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (GTU, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_expand "sltu"
+  [(set (match_operand:QI 0 "register_operand" "")
+	(ltu:QI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (LTU, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_expand "sgeu"
+  [(set (match_operand:QI 0 "register_operand" "")
+	(geu:QI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (GEU, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_expand "sleu"
+  [(set (match_operand:QI 0 "register_operand" "")
+	(leu:QI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (LEU, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_insn "scc"
+  [(set (match_operand:QI 0 "register_operand" "=jq")
+	(match_operator:QI 1 "comparison_operator" [(cc0) (const_int 0)]))]
+  ""
+  "%0 = 0\;if %C1 %b0 = %b0 + 1"
+  [(set_attr "type" "special_2")])
+
+;;
+;; Jump Instructions
+;;
+
+(define_expand "beq"
+  [(set (pc)
+	(if_then_else (eq (match_dup 1)
+	                  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (EQ, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+(define_expand "bne"
+  [(set (pc)
+	(if_then_else (ne (match_dup 1)
+			  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (NE, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_expand "bgt"
+  [(set (pc)
+	(if_then_else (gt (match_dup 1)
+	                  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (GT, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_expand "bge"
+  [(set (pc)
+	(if_then_else (ge (match_dup 1)
+	                  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (GE, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_expand "blt"
+  [(set (pc)
+	(if_then_else (lt (match_dup 1)
+	                  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (LT, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_expand "ble"
+  [(set (pc)
+	(if_then_else (le (match_dup 1)
+	                  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (LE, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_expand "bgtu"
+  [(set (pc)
+	(if_then_else (gtu (match_dup 1)
+	                   (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (GTU, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_expand "bgeu"
+  [(set (pc)
+	(if_then_else (geu (match_dup 1)
+	                   (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (GEU, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_expand "bltu"
+  [(set (pc)
+	(if_then_else (ltu (match_dup 1)
+	                   (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (LTU, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_expand "bleu"
+  [(set (pc)
+	(if_then_else (leu (match_dup 1)
+	                   (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ 
+   if (dsp16xx_compare_gen)
+     operands[1] = gen_compare_reg (LEU, dsp16xx_compare_op0, dsp16xx_compare_op1);
+   else
+     operands[1] = gen_tst_reg (dsp16xx_compare_op0);
+}")
+
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (match_operator 1 "comparison_operator" 
+                                      [(cc0) (const_int 0)])
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  "!TARGET_NEAR_JUMP"
+  "pt=%l0\;if %C1 goto pt"
+  [(set_attr "type" "cond_jump")])
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (match_operator 1 "comparison_operator" 
+                                      [(cc0) (const_int 0)])
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  "TARGET_NEAR_JUMP"
+  "if %C1 goto %l0"
+  [(set_attr "type" "cond_jump")])
+
+;;
+;; Negated conditional jump instructions.
+;; These are necessary because jump optimization can turn
+;; direct-conditional branches into reverse-conditional
+;; branches.
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (match_operator 1 "comparison_operator" 
+                                      [(cc0) (const_int 0)])
+	              (pc)
+		      (label_ref (match_operand 0 "" ""))))]
+  "!TARGET_NEAR_JUMP"
+  "pt=%l0\;if %I1 goto pt"
+  [(set_attr "type" "cond_jump")])
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (match_operator 1 "comparison_operator" 
+                                      [(cc0) (const_int 0)])
+	              (pc)
+		      (label_ref (match_operand 0 "" ""))))]
+  "TARGET_NEAR_JUMP"
+  "if %I1 goto %l0"
+  [(set_attr "type" "cond_jump")])
+
+
+;;
+;; JUMPS
+;;
+
+(define_insn "jump"
+  [(set (pc)
+        (label_ref (match_operand 0 "" "")))]
+  ""
+  "*
+   {
+	if (TARGET_NEAR_JUMP)
+	    return \"goto %l0\";
+        else
+	    return \"pt=%l0\;goto pt\";
+   }"
+   [(set_attr "type" "jump")])
+
+
+(define_insn "indirect_jump"
+  [(set (pc) (match_operand:QI 0 "register_operand" "A"))]
+  ""
+  "pt=%0\;goto pt"
+   [(set_attr "type" "jump")])
+
+(define_insn "tablejump"
+  [(set (pc) (match_operand:QI 0 "register_operand" "A"))
+   (use (label_ref (match_operand 1 "" "")))]
+  ""
+  "pt=%0\;goto pt"
+   [(set_attr "type" "jump")])
+
+;;
+;; FUNCTION CALLS
+;;
+
+;; Call subroutine with no return value.
+
+
+(define_expand "call"
+  [(parallel [(call (match_operand:QI 0 "" "")
+	            (match_operand 1 "" ""))
+	     (clobber (reg:QI 24))])]
+  ""
+  "
+{
+  if (GET_CODE (operands[0]) == MEM
+      && ! call_address_operand (XEXP (operands[0], 0), QImode))
+    operands[0] = gen_rtx_MEM (GET_MODE (operands[0]),
+			       force_reg (Pmode, XEXP (operands[0], 0)));
+}")
+
+(define_insn ""
+  [(parallel [(call (mem:QI (match_operand:QI 0 "call_address_operand" "hR"))
+	                    (match_operand 1 "" ""))
+	      (clobber (reg:QI 24))])]
+  ""
+  "*
+{
+    if (GET_CODE (operands[0]) == REG || 
+	(GET_CODE(operands[0]) == SYMBOL_REF && !TARGET_NEAR_CALL))
+	return \"pt=%0\;call pt\";
+    else
+        return \"call %0\";
+}"
+[(set_attr "type" "call")])
+
+;; Call subroutine with return value.
+
+(define_expand "call_value"
+  [(parallel [(set (match_operand 0 "register_operand" "=f")
+		  (call (match_operand:QI 1 "call_address_operand" "hR")
+	                (match_operand:QI 2 "" "")))
+	      (clobber (reg:QI 24))])]
+  ""
+  "
+{
+  if (GET_CODE (operands[1]) == MEM
+      && ! call_address_operand (XEXP (operands[1], 0), QImode))
+    operands[1] = gen_rtx_MEM (GET_MODE (operands[1]),
+			       force_reg (Pmode, XEXP (operands[1], 0)));
+}")
+
+(define_insn ""
+  [(parallel [(set (match_operand 0 "register_operand" "=f")
+		  (call (mem:QI (match_operand:QI 1 "call_address_operand" "hR"))
+	                        (match_operand:QI 2 "" "")))
+	      (clobber (reg:QI 24))])]
+  ""
+  "*
+{
+    if (GET_CODE (operands[1]) == REG ||
+	(GET_CODE(operands[1]) == SYMBOL_REF && !TARGET_NEAR_CALL))
+	return \"pt=%1\;call pt\";
+    else
+        return \"call %1\";
+}"
+[(set_attr "type" "call")])
+
+
+(define_expand "untyped_call"
+  [(parallel [(call (match_operand 0 "" "")
+		    (const_int 0))
+	      (match_operand 1 "" "")
+	      (match_operand 2 "" "")])]
+  ""
+  "
+{
+  int i;
+
+  emit_call_insn (GEN_CALL (operands[0], const0_rtx, NULL, const0_rtx));
+
+  for (i = 0; i < XVECLEN (operands[2], 0); i++)
+    {
+      rtx set = XVECEXP (operands[2], 0, i);
+      emit_move_insn (SET_DEST (set), SET_SRC (set));
+    }
+
+  /* The optimizer does not know that the call sets the function value
+     registers we stored in the result block.  We avoid problems by
+     claiming that all hard registers are used and clobbered at this
+     point.  */
+  emit_insn (gen_blockage ());
+
+  DONE;
+}")
+
+;; UNSPEC_VOLATILE is considered to use and clobber all hard registers and
+;; all of memory.  This blocks insns from being moved across this point.
+
+(define_insn "blockage"
+  [(unspec_volatile [(const_int 0)] 0)]
+  ""
+  "")
+
+(define_insn "nop"
+  [(const_int 0)]
+  ""
+  "nop"
+  [(set_attr "type"     "nop")])
+
+;;
+;; PEEPHOLE PATTERNS
+;;
+
+
+(define_peephole
+  [(parallel [(set (cc0) 
+		   (compare (match_operand:QI 0 "register_operand"  "k,k,!k,u,u,!u")
+			    (match_operand:QI 1 "register_operand"  "w,z,u,w,z,k")))
+	      (use (match_operand:QI 2 "register_operand" "=j,j,j,q,q,q"))
+	      (use (match_operand:QI 3 "register_operand" "=v,y,q,v,y,j"))])
+   (set (pc)	
+	(if_then_else (match_operator 5 "uns_comparison_operator" 
+                                      [(cc0) (const_int 0)])
+		      (label_ref (match_operand 4 "" ""))
+		      (pc)))]
+  "!TARGET_NEAR_JUMP"
+  "pt=%l4\;%2-%3\;if %C5 goto pt")
+
+(define_peephole
+  [(parallel [(set (cc0) 
+		   (compare (match_operand:QI 0 "register_operand"  "k,k,!k,u,u,!u")
+			    (match_operand:QI 1 "register_operand"  "w,z,u,w,z,k")))
+	      (use (match_operand:QI 2 "register_operand" "=j,j,j,q,q,q"))
+	      (use (match_operand:QI 3 "register_operand" "=v,y,q,v,y,j"))])
+   (set (pc)	
+	(if_then_else (match_operator 5 "uns_comparison_operator" 
+                                      [(cc0) (const_int 0)])
+		      (pc)
+		      (label_ref (match_operand 4 "" ""))))]
+  "!TARGET_NEAR_JUMP"
+  "pt=%l4\;%2-%3\;if %I5 goto pt")
+
+
+(define_peephole
+  [(parallel [(set (cc0) 
+		   (compare (match_operand:QI 0 "register_operand"  "k,u")
+			    (match_operand:QI 1 "const_int_operand" "i,i")))
+	      (use (match_operand:QI 2 "register_operand" "=j,q"))])
+   (set (pc)	
+	(if_then_else (match_operator 4 "uns_comparison_operator" 
+                                      [(cc0) (const_int 0)])
+		      (label_ref (match_operand 3 "" ""))
+		      (pc)))]
+  "!TARGET_NEAR_JUMP"
+  "pt=%l3\;%0-%H1\;if %C4 goto pt")
+
+(define_peephole
+  [(parallel [(set (cc0) 
+		   (compare (match_operand:QI 0 "register_operand"  "k,u")
+			    (match_operand:QI 1 "const_int_operand" "i,i")))
+	      (use (match_operand:QI 2 "register_operand" "=j,q"))])
+   (set (pc)	
+	(if_then_else (match_operator 4 "uns_comparison_operator" 
+                                      [(cc0) (const_int 0)])
+		      (pc)
+		      (label_ref (match_operand 3 "" ""))))]
+  "!TARGET_NEAR_JUMP"
+  "pt=%l3\;%0-%H1\;if %I4 goto pt")
+
+;;
+;;; QImode SIGNED COMPARE PEEPHOLE OPTIMIZATIONS
+;;
+
+(define_peephole
+  [(parallel [(set (cc0) 
+		   (compare (match_operand:QI 0 "register_operand"  "j,j,h,q,q,q")
+			    (match_operand:QI 1 "register_operand"  "v,y,q,v,y,j")))
+	      (use (match_operand:QI 2 "register_operand" "=k,k,k,u,u,u"))
+	      (use (match_operand:QI 3 "register_operand" "=w,z,u,w,z,k"))])
+   (set (pc)	
+	(if_then_else (match_operator 5 "signed_comparison_operator" 
+                                      [(cc0) (const_int 0)])
+		      (label_ref (match_operand 4 "" ""))
+		      (pc)))]
+  "!TARGET_NEAR_JUMP"
+  "pt=%l4\;%0-%1\;if %C5 goto pt")
+
+
+(define_peephole
+  [(parallel [(set (cc0) 
+		   (compare (match_operand:QI 0 "register_operand"  "j,j,j,q,q,q")
+			    (match_operand:QI 1 "register_operand"  "v,y,q,v,y,j")))
+	      (use (match_operand:QI 2 "register_operand" "=k,k,k,u,u,u"))
+	      (use (match_operand:QI 3 "register_operand" "=w,z,u,w,z,k"))])
+   (set (pc)	
+	(if_then_else (match_operator 5 "signed_comparison_operator" 
+                                      [(cc0) (const_int 0)])
+		      (pc)
+		      (label_ref (match_operand 4 "" ""))))]
+  "!TARGET_NEAR_JUMP"
+  "pt=%l4\;%0-%1\;if %I5 goto pt")
+
+
+(define_peephole
+  [(parallel [(set (cc0) 
+		   (compare (match_operand:QI 0 "register_operand"  "j,q")
+			    (match_operand:QI 1 "const_int_operand" "i,i")))
+	      (use (match_operand:QI 2 "register_operand" "=k,u"))])
+   (set (pc)	
+	(if_then_else (match_operator 4 "signed_comparison_operator" 
+                                      [(cc0) (const_int 0)])
+		      (label_ref (match_operand 3 "" ""))
+		      (pc)))]
+  "!TARGET_NEAR_JUMP"
+  "pt=%l3\;%b0-%H1\;if %C4 goto pt")
+
+(define_peephole
+  [(parallel [(set (cc0) 
+		   (compare (match_operand:QI 0 "register_operand"  "j,q")
+			    (match_operand:QI 1 "const_int_operand" "i,i")))
+	      (use (match_operand:QI 2 "register_operand" "=k,u"))])
+   (set (pc)	
+	(if_then_else (match_operator 4 "signed_comparison_operator" 
+                                      [(cc0) (const_int 0)])
+		      (pc)
+		      (label_ref (match_operand 3 "" ""))))]
+  "!TARGET_NEAR_JUMP"
+  "pt=%l3\;%b0-%H1\;if %I4 goto pt")
+
+;; TST PEEPHOLE PATTERNS
+
+(define_peephole
+  [(parallel [(set (cc0) 
+		   (match_operand:QI 0 "register_operand"  "j,q"))
+	      (use (match_operand:QI 1 "register_operand" "=k,u"))])
+   (set (pc)	
+	(if_then_else (match_operator 3 "signed_comparison_operator" 
+                                      [(cc0) (const_int 0)])
+		      (pc)
+		      (label_ref (match_operand 2 "" ""))))]
+  "!TARGET_NEAR_JUMP"
+  "pt=%l2\;%b0-0\;if %I3 goto pt")
+
+(define_peephole
+  [(parallel [(set (cc0) 
+		   (match_operand:QI 0 "register_operand"  "j,q"))
+	      (use (match_operand:QI 1 "register_operand" "=k,u"))])
+   (set (pc)	
+	(if_then_else (match_operator 3 "signed_comparison_operator" 
+                                      [(cc0) (const_int 0)])
+		      (label_ref (match_operand 2 "" ""))
+		      (pc)))]
+  "!TARGET_NEAR_JUMP"
+  "pt=%l2\;%b0-0\;if %C3 goto pt")
+
+;; HImode peephole patterns
+
+(define_peephole
+  [(set (cc0) 
+	(compare (match_operand:HI 0 "register_operand"  "A,A")
+		 (match_operand:HI 1 "register_operand"  "Z,A")))
+   (set (pc)	
+	(if_then_else (match_operator 3 "signed_comparison_operator" 
+                                      [(cc0) (const_int 0)])
+		      (label_ref (match_operand 2 "" ""))
+		      (pc)))]
+  "!TARGET_NEAR_JUMP"
+  "pt=%l2\;%0-%1\;if %C3 goto pt")
+
+(define_peephole
+  [(set (cc0) 
+	(compare (match_operand:HI 0 "register_operand"  "A,A")
+		 (match_operand:HI 1 "register_operand"  "Z,A")))
+   (set (pc)	
+	(if_then_else (match_operator 3 "signed_comparison_operator" 
+                                      [(cc0) (const_int 0)])
+		      (pc)
+		      (label_ref (match_operand 2 "" ""))))]
+  "!TARGET_NEAR_JUMP"
+  "pt=%l2\;%0-%1\;if %I3 goto pt")
diff --git a/gcc/config/i370/README b/gcc/config/i370/README
new file mode 100644
index 00000000000..56c6342dc64
--- /dev/null
+++ b/gcc/config/i370/README
@@ -0,0 +1,125 @@
+
+This directory contains code for building a compiler for the
+32-bit ESA/390 architecture.  It supports three different styles 
+of assembly:
+
+-- MVS for use with the HLASM assembler
+-- Open Edition (USS Unix System Services) 
+-- ELF/Linux for use with the binutils/gas GNU assembler.
+
+
+Cross-compiling Hints
+---------------------
+When building a cross-compiler on AIX, set the environment variable CC
+and be sure to set the -ma and -qcpluscmt flags; i.e.
+
+   export CC="cc -ma -qcpluscmt"
+
+do this *before* running configure, e.g.
+
+   configure --target=i370-ibm-linux --prefix=/where/to/install/usr
+
+The Objective-C and FORTRAN front ends don't build.  To avoid looking at
+errors, do only 
+
+   make LANGUAGES=c
+
+
+OpenEdition Hints
+-----------------
+The shell script "install" is handy for users of OpenEdition.
+
+
+The ELF ABI
+-----------
+This compiler, in conjunction with the gas/binutils assembler, defines
+a defacto ELF-based ABI for the ESA/390 architecture.  Be warned: this 
+ABI has several major faults.  It should be fixed.  As it is fixed,
+it is subject to change without warning.  You should not commit to major
+software systems without further exploring and fixing these problems.
+Here are some of the problems:
+
+-- No support for shared libraries or dynamically loadable objects.
+   This is because the compiler currently places address literals in 
+   the text section.  Although the GAS assembler supports a syntax for 
+   USING that will place address literals in the data section, this forces
+   the use of two base registers, one for branches and one for the literal 
+   pool. Work is needed to redesign the function prologue, epilogue and the 
+   base register reloads to minimize the currently excessive use of reserved 
+   registers. 
+
+   I beleive the best solution would be to add a toc or plt, and extending
+   the meaning of the USING directive to encompass this.  This would 
+   allow the continued use of the human-readable and familiar practice
+   of using =A() and =F'' to denote address literals, as opposed to more 
+   difficult jump-table notation.
+
+-- the stackframe is almost twice as big as it needs to be.
+
+-- currently, r15 is used to return 32-bit values.  Because this is the
+   last register, it prevents 64-bit ints and small structures from being 
+   returned in registers, forcing return in memory.  It would be more
+   efficient to use r14 to return 32-bit values, and r14+r15 to return
+   64-bit values.
+
+-- all arguments are currently passed in memory.  It would be more efficient 
+   to pass arguments in registers.
+
+
+
+
+ChangeLog
+---------
+Oct98-Dec98 -- add ELF back end; work on getting ABI more or less functional.
+98.12.05 -- fix numerous MVC bugs
+99.02.06 -- multiply insn sometimes not generated when needed.
+         -- extendsidi bugs, bad literal values printed
+         -- remove broken adddi subdi patterns
+99.02.15 -- add clrstrsi pattern
+         -- fix -O2 divide bug
+99.03.04 -- base & index reg usage bugs
+99.03.15 -- fixes for returning long longs and structs (struct value return)
+99.03.29 -- fix handling & alignment of shorts
+99.03.31 -- clobbered register 14 is not always clobbered
+99.04.02 -- operand constraints for cmphi
+99.04.07 -- function pointer fixes for call, call_value patterns,
+            function pointers derefed once too often.
+99.04.14 -- add pattern to print double-wide int
+         -- check intval<4096 for misc operands
+         -- add clrstrsi pattern
+         -- movstrsi fixes
+99.04.16 -- use r2 to pass args into r11 in subroutine call.
+         -- fixes to movsi; some operand combinations impossible;
+            rework constraints
+         -- start work on forward jump optimization
+         -- char alignment bug
+99.04.25 -- add untyped_call pattern so that builtin_apply works
+99.04.27 -- fixes to compare logical under mask
+99.04.28 -- reg 2 is clobbered by calls
+99.04.30 -- fix rare mulsi bug
+99.04.30 -- add constraints so that all RS, SI, SS forms insns have valid
+            addressing modes
+99.04.30 -- major condition code fixes. The old code was just way off 
+            w.r.t. which insns set condition code, and the codes that
+            were set.  The extent of this damage was unbeleivable.
+99.05.01 -- restructuring of operand constraints on many patterns,
+            many lead to invalid instructions being genned.
+99.05.02 -- float pt fixes
+         -- fix movdi issue bugs
+99.05.03 -- fix divide insn; was dividing incorrectly
+99.05.05 -- fix sign extension problems on andhi
+         -- deprecate some constraints
+99.05.06 -- add set_attr insn lengths; fix misc litpool sizes
+         -- add notes about how unsigned jumps work (i.e. 
+            arithmetic vs. logical vs. signed vs unsigned).
+99.05.11 -- use insn length to predict forward branch target;
+            use relative branchining where possible,
+            remove un-needed base register reload.
+99.05.15 -- fix movstrsi, clrstrsi, cmpstrsi patterns as per conversation 
+            w/ Richard Henderson
+
+
+
+
+
+
diff --git a/gcc/config/i370/i370-c.c b/gcc/config/i370/i370-c.c
new file mode 100644
index 00000000000..fe39191cfa2
--- /dev/null
+++ b/gcc/config/i370/i370-c.c
@@ -0,0 +1,64 @@
+/* Subroutines for the C front end for System/370.
+   Copyright (C) 1989, 1993, 1995, 1997, 1998, 1999, 2000
+   Free Software Foundation, Inc.
+   Contributed by Jan Stein (jan@cd.chalmers.se).
+   Modified for OS/390 LanguageEnvironment C by Dave Pitts (dpitts@cozx.com)
+   Hacked for Linux-ELF/390 by Linas Vepstas (linas@linas.org) 
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "tree.h"
+#include "toplev.h"
+#include "cpplib.h"
+#include "c-pragma.h"
+#include "tm_p.h"
+
+#ifdef TARGET_HLASM
+
+/* #pragma map (name, alias) -
+   In this implementation both name and alias are required to be
+   identifiers.  The older code seemed to be more permissive.  Can
+   anyone clarify?  */
+
+void
+i370_pr_map (pfile)
+     cpp_reader *pfile ATTRIBUTE_UNUSED;
+{
+  tree name, alias, x;
+
+  if (c_lex (&x)        == CPP_OPEN_PAREN
+      && c_lex (&name)  == CPP_NAME
+      && c_lex (&x)     == CPP_COMMA
+      && c_lex (&alias) == CPP_NAME
+      && c_lex (&x)     == CPP_CLOSE_PAREN)
+    {
+      if (c_lex (&x) != CPP_EOF)
+	warning ("junk at end of #pragma map");
+
+      mvs_add_alias (IDENTIFIER_POINTER (name), IDENTIFIER_POINTER (alias), 1);
+      return;
+    }
+
+  warning ("malformed #pragma map, ignored");
+}
+
+#endif
diff --git a/gcc/config/i370/i370-protos.h b/gcc/config/i370/i370-protos.h
new file mode 100644
index 00000000000..666db0b7aa6
--- /dev/null
+++ b/gcc/config/i370/i370-protos.h
@@ -0,0 +1,55 @@
+/* Definitions of target machine for GNU compiler.  System/370 version.
+   Copyright (C) 2000 Free Software Foundation, Inc.
+   Contributed by Jan Stein (jan@cd.chalmers.se).
+   Modified for OS/390 LanguageEnvironment C by Dave Pitts (dpitts@cozx.com)
+   Hacked for Linux-ELF/390 by Linas Vepstas (linas@linas.org)
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifndef GCC_I370_PROTOS_H
+#define GCC_I370_PROTOS_H
+
+extern void override_options (void);
+
+#ifdef RTX_CODE
+extern int i370_branch_dest (rtx);
+extern int i370_branch_length (rtx);
+extern int i370_short_branch (rtx);
+extern int s_operand (rtx, enum machine_mode);
+extern int r_or_s_operand (rtx, enum machine_mode);
+extern int unsigned_jump_follows_p (rtx);
+#endif /* RTX_CODE */
+
+#ifdef TREE_CODE
+extern int handle_pragma (int (*)(void), void (*)(int), const char *);
+#endif /* TREE_CODE */
+
+extern void mvs_add_label (int);
+extern int mvs_check_label (int);
+extern int mvs_check_page (FILE *, int, int);
+extern int mvs_function_check (const char *);
+extern void mvs_add_alias (const char *, const char *, int);
+extern int mvs_need_alias (const char *);
+extern int mvs_get_alias (const char *, char *);
+extern int mvs_check_alias (const char *, char *);
+extern void check_label_emit (void);
+extern void mvs_free_label_list (void);
+
+extern void i370_pr_map (struct cpp_reader *);
+
+#endif /* ! GCC_I370_PROTOS_H */
diff --git a/gcc/config/i370/i370.c b/gcc/config/i370/i370.c
new file mode 100644
index 00000000000..2cfe4fe3269
--- /dev/null
+++ b/gcc/config/i370/i370.c
@@ -0,0 +1,1514 @@
+/* Subroutines for insn-output.c for System/370.
+   Copyright (C) 1989, 1993, 1995, 1997, 1998, 1999, 2000, 2002
+   Free Software Foundation, Inc.
+   Contributed by Jan Stein (jan@cd.chalmers.se).
+   Modified for OS/390 LanguageEnvironment C by Dave Pitts (dpitts@cozx.com)
+   Hacked for Linux-ELF/390 by Linas Vepstas (linas@linas.org) 
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "rtl.h"
+#include "tree.h"
+#include "regs.h"
+#include "hard-reg-set.h"
+#include "real.h"
+#include "insn-config.h"
+#include "conditions.h"
+#include "output.h"
+#include "insn-attr.h"
+#include "function.h"
+#include "expr.h"
+#include "flags.h"
+#include "recog.h"
+#include "toplev.h"
+#include "cpplib.h"
+#include "tm_p.h"
+#include "target.h"
+#include "target-def.h"
+
+extern FILE *asm_out_file;
+
+/* Label node.  This structure is used to keep track of labels 
+      on the various pages in the current routine.
+   The label_id is the numeric ID of the label,
+   The label_page is the page on which it actually appears,
+   The first_ref_page is the page on which the true first ref appears.
+   The label_addr is an estimate of its location in the current routine,
+   The label_first & last_ref are estimates of where the earliest and
+      latest references to this label occur.  */
+
+typedef struct label_node
+  {
+    struct label_node *label_next;
+    int label_id;
+    int label_page;
+    int first_ref_page;
+
+    int label_addr;
+    int label_first_ref;
+    int label_last_ref;
+  }
+label_node_t;
+
+/* Is 1 when a label has been generated and the base register must be reloaded.  */
+int mvs_need_base_reload = 0;
+
+/* Current function starting base page.  */
+int function_base_page;
+
+/* Length of the current page code.  */
+int mvs_page_code;
+
+/* Length of the current page literals.  */
+int mvs_page_lit;
+
+/* Current function name.  */
+char *mvs_function_name = 0;
+
+/* Current function name length.  */
+size_t mvs_function_name_length = 0;
+
+/* Page number for multi-page functions.  */
+int mvs_page_num = 0;
+
+/* Label node list anchor.  */
+static label_node_t *label_anchor = 0;
+
+/* Label node free list anchor.  */
+static label_node_t *free_anchor = 0;
+
+/* Assembler source file descriptor.  */
+static FILE *assembler_source = 0;
+
+static label_node_t * mvs_get_label (int);
+static void i370_label_scan (void);
+#ifdef TARGET_HLASM
+static bool i370_hlasm_assemble_integer (rtx, unsigned int, int);
+static void i370_globalize_label (FILE *, const char *);
+#endif
+static void i370_output_function_prologue (FILE *, HOST_WIDE_INT);
+static void i370_output_function_epilogue (FILE *, HOST_WIDE_INT);
+static void i370_file_start (void);
+static void i370_file_end (void);
+
+#ifdef LONGEXTERNAL
+static int mvs_hash_alias (const char *);
+#endif
+static void i370_internal_label (FILE *, const char *, unsigned long);
+static bool i370_rtx_costs (rtx, int, int, int *);
+
+/* ===================================================== */
+/* defines and functions specific to the HLASM assembler */
+#ifdef TARGET_HLASM
+
+#define MVS_HASH_PRIME 999983
+#if HOST_CHARSET == HOST_CHARSET_EBCDIC
+#define MVS_SET_SIZE 256
+#else
+#define MVS_SET_SIZE 128
+#endif
+
+#ifndef MAX_MVS_LABEL_SIZE
+#define MAX_MVS_LABEL_SIZE 8
+#endif
+
+#define MAX_LONG_LABEL_SIZE 255
+
+/* Alias node, this structure is used to keep track of aliases to external
+   variables. The IBM assembler allows an alias to an external name 
+   that is longer that 8 characters; but only once per assembly.
+   Also, this structure stores the #pragma map info.  */
+typedef struct alias_node
+  {
+    struct alias_node *alias_next;
+    int  alias_emitted;
+    char alias_name [MAX_MVS_LABEL_SIZE + 1];
+    char real_name [MAX_LONG_LABEL_SIZE + 1];
+  }
+alias_node_t;
+
+/* Alias node list anchor.  */
+static alias_node_t *alias_anchor = 0;
+
+/* Define the length of the internal MVS function table.  */
+#define MVS_FUNCTION_TABLE_LENGTH 32
+
+/* C/370 internal function table.  These functions use non-standard linkage
+   and must handled in a special manner.  */
+static const char *const mvs_function_table[MVS_FUNCTION_TABLE_LENGTH] =
+{
+#if HOST_CHARSET == HOST_CHARSET_EBCDIC /* Changed for EBCDIC collating sequence */
+   "ceil",     "edc_acos", "edc_asin", "edc_atan", "edc_ata2", "edc_cos",
+   "edc_cosh", "edc_erf",  "edc_erfc", "edc_exp",  "edc_gamm", "edc_lg10",
+   "edc_log",  "edc_sin",  "edc_sinh", "edc_sqrt", "edc_tan",  "edc_tanh",
+   "fabs",     "floor",    "fmod",     "frexp",    "hypot",    "jn",
+   "j0",       "j1",       "ldexp",    "modf",     "pow",      "yn",
+   "y0",       "y1"
+#else
+   "ceil",     "edc_acos", "edc_asin", "edc_ata2", "edc_atan", "edc_cos",
+   "edc_cosh", "edc_erf",  "edc_erfc", "edc_exp",  "edc_gamm", "edc_lg10",
+   "edc_log",  "edc_sin",  "edc_sinh", "edc_sqrt", "edc_tan",  "edc_tanh",
+   "fabs",     "floor",    "fmod",     "frexp",    "hypot",    "j0",
+   "j1",       "jn",       "ldexp",    "modf",     "pow",      "y0",
+   "y1",       "yn"
+#endif
+};
+
+#endif /* TARGET_HLASM */
+/* ===================================================== */
+
+
+/* Initialize the GCC target structure.  */
+#ifdef TARGET_HLASM
+#undef TARGET_ASM_BYTE_OP
+#define TARGET_ASM_BYTE_OP NULL
+#undef TARGET_ASM_ALIGNED_HI_OP
+#define TARGET_ASM_ALIGNED_HI_OP NULL
+#undef TARGET_ASM_ALIGNED_SI_OP
+#define TARGET_ASM_ALIGNED_SI_OP NULL
+#undef TARGET_ASM_INTEGER
+#define TARGET_ASM_INTEGER i370_hlasm_assemble_integer
+#undef TARGET_ASM_GLOBALIZE_LABEL
+#define TARGET_ASM_GLOBALIZE_LABEL i370_globalize_label
+#endif
+
+#undef TARGET_ASM_FUNCTION_PROLOGUE
+#define TARGET_ASM_FUNCTION_PROLOGUE i370_output_function_prologue
+#undef TARGET_ASM_FUNCTION_EPILOGUE
+#define TARGET_ASM_FUNCTION_EPILOGUE i370_output_function_epilogue
+#undef TARGET_ASM_FILE_START
+#define TARGET_ASM_FILE_START i370_file_start
+#undef TARGET_ASM_FILE_END
+#define TARGET_ASM_FILE_END i370_file_end
+#undef TARGET_ASM_INTERNAL_LABEL
+#define  TARGET_ASM_INTERNAL_LABEL i370_internal_label
+#undef TARGET_RTX_COSTS
+#define TARGET_RTX_COSTS i370_rtx_costs
+
+struct gcc_target targetm = TARGET_INITIALIZER;
+
+/* Set global variables as needed for the options enabled.  */
+
+void
+override_options ()
+{
+  /* We're 370 floating point, not IEEE floating point.  */
+  memset (real_format_for_mode, 0, sizeof real_format_for_mode);
+  REAL_MODE_FORMAT (SFmode) = &i370_single_format;
+  REAL_MODE_FORMAT (DFmode) = &i370_double_format;
+}
+
+/* ===================================================== */
+/* The following three routines are used to determine whther 
+   forward branch is on this page, or is a far jump.  We use
+   the "length" attr on an insn [(set_atter "length" "4")]
+   to store the largest possible code length that insn
+   could have.  This gives us a hint of the address of a
+   branch destination, and from that, we can work out 
+   the length of the jump, and whether its on page or not. 
+ */
+
+/* Return the destination address of a branch.  */
+
+int
+i370_branch_dest (branch)
+     rtx branch;
+{
+  rtx dest = SET_SRC (PATTERN (branch));
+  int dest_uid;
+  int dest_addr;
+
+  /* first, compute the estimated address of the branch target */
+  if (GET_CODE (dest) == IF_THEN_ELSE)
+    dest = XEXP (dest, 1);
+  dest = XEXP (dest, 0);
+  dest_uid = INSN_UID (dest);
+  dest_addr = INSN_ADDRESSES (dest_uid);
+
+  /* next, record the address of this insn as the true addr of first ref */
+  {
+     label_node_t *lp;
+     rtx label = JUMP_LABEL (branch);
+     int labelno = CODE_LABEL_NUMBER (label);
+
+     if (!label || CODE_LABEL != GET_CODE (label)) abort ();
+
+     lp = mvs_get_label (labelno);
+     if (-1 == lp -> first_ref_page) lp->first_ref_page = mvs_page_num;
+  }
+  return dest_addr;
+}
+
+int
+i370_branch_length (insn)
+     rtx insn;
+{
+  int here, there;
+  here = INSN_ADDRESSES (INSN_UID (insn));
+  there = i370_branch_dest (insn);
+  return (there - here);
+}
+
+
+int
+i370_short_branch (insn)
+     rtx insn;
+{
+  int base_offset;
+
+  base_offset = i370_branch_length(insn);
+  if (0 > base_offset) 
+    {
+      base_offset += mvs_page_code;
+    } 
+  else 
+    {
+      /* avoid bumping into lit pool; use 2x to estimate max possible lits */
+      base_offset *= 2;
+      base_offset += mvs_page_code + mvs_page_lit;
+    }
+  
+  /* make a conservative estimate of room left on page */
+  if ((4060 >base_offset) && ( 0 < base_offset)) return 1;
+  return 0;
+}
+
+/* The i370_label_scan() routine is supposed to loop over
+   all labels and label references in a compilation unit,
+   and determine whether all label refs appear on the same 
+   code page as the label. If they do, then we can avoid 
+   a reload of the base register for that label.
+  
+   Note that the instruction addresses used here are only 
+   approximate, and make the sizes of the jumps appear
+   farther apart then they will actually be.  This makes 
+   this code far more conservative than it needs to be.
+ */
+
+#define I370_RECORD_LABEL_REF(label,addr) {				\
+	label_node_t *lp;						\
+	int labelno = CODE_LABEL_NUMBER (label);			\
+	lp = mvs_get_label (labelno);					\
+	if (addr < lp -> label_first_ref) lp->label_first_ref = addr;	\
+	if (addr > lp -> label_last_ref) lp->label_last_ref = addr;	\
+}
+
+static void 
+i370_label_scan () 
+{
+   rtx insn;
+   label_node_t *lp;
+   int tablejump_offset = 0;
+
+   for (insn = get_insns(); insn; insn = NEXT_INSN(insn))
+     {
+       int here = INSN_ADDRESSES (INSN_UID (insn));
+       enum rtx_code code = GET_CODE(insn);
+
+       /* ??? adjust for tables embedded in the .text section that
+        * the compiler didn't take into account */
+       here += tablejump_offset;
+       INSN_ADDRESSES (INSN_UID (insn)) = here;
+
+       /* check to see if this insn is a label ...  */
+       if (CODE_LABEL == code)
+         {
+           int labelno = CODE_LABEL_NUMBER (insn);
+
+           lp = mvs_get_label (labelno);
+           lp -> label_addr = here;
+#if 0
+           /* Supposedly, labels are supposed to have circular
+              lists of label-refs that reference them, 
+              setup in flow.c, but this does not appear to be the case.  */
+           rtx labelref = LABEL_REFS (insn);
+           rtx ref = labelref;
+           do 
+             {
+               rtx linsn = CONTAINING_INSN(ref);
+               ref =  LABEL_NEXTREF(ref);
+             } while (ref && (ref != labelref));
+#endif
+         }
+       else
+       if (JUMP_INSN == code)
+         {
+           rtx label = JUMP_LABEL (insn);
+
+           /* If there is no label for this jump, then this
+              had better be a ADDR_VEC or an ADDR_DIFF_VEC
+              and there had better be a vector of labels.  */
+           if (!label) 
+             {
+               int j;
+               rtx body = PATTERN (insn);
+               if (ADDR_VEC == GET_CODE(body)) 
+                 {
+                    for (j=0; j < XVECLEN (body, 0); j++)
+                      {
+                         rtx lref = XVECEXP (body, 0, j);
+                         if (LABEL_REF != GET_CODE (lref)) abort ();
+                         label = XEXP (lref,0);
+                         if (CODE_LABEL != GET_CODE (label)) abort ();
+                         tablejump_offset += 4;
+                         here += 4;
+                         I370_RECORD_LABEL_REF(label,here);
+                      }
+                    /* finished with the vector go do next insn */
+                    continue;
+                 }
+               else
+               if (ADDR_DIFF_VEC == GET_CODE(body))
+                 {
+/* XXX hack alert.
+   Right now, we leave this as a no-op, but strictly speaking,
+   this is incorrect.  It is possible that a table-jump
+   driven off of a relative address could take us off-page,
+   to a place where we need to reload the base reg.  So really,
+   we need to examing both labels, and compare thier values
+   to the current basereg value.
+  
+   More generally, this brings up a troubling issue overall:
+   what happens if a tablejump is split across two pages? I do 
+   not beleive that this case is handled correctly at all, and
+   can only lead to horrible results if this were to occur.
+  
+   However, the current situation is not any worse than it was 
+   last week, and so we punt for now.  */
+
+                    debug_rtx (insn);
+                    for (j=0; j < XVECLEN (body, 0); j++)
+                      {
+                      }
+                    /* finished with the vector go do next insn */
+                    continue;
+                 }
+               else 
+                 {
+/* XXX hack alert.
+   Compiling the exception handling (L_eh) in libgcc2.a will trip
+   up right here, with something that looks like
+   (set (pc) (mem:SI (plus:SI (reg/v:SI 1 r1) (const_int 4))))
+      {indirect_jump} 
+   I'm not sure of what leads up to this, but it looks like
+   the makings of a long jump which will surely get us into trouble
+   because the base & page registers don't get reloaded.  For now
+   I'm not sure of what to do ... again we punt ... we are not worse
+   off than yesterday.  */
+
+                    /* print_rtl_single (stdout, insn); */
+                    debug_rtx (insn);
+                    /* abort(); */
+                    continue;
+                 }
+            }
+          else
+            {
+              /* At this point, this jump_insn had better be a plain-old
+                 ordinary one, grap the label id and go */
+              if (CODE_LABEL != GET_CODE (label)) abort ();
+              I370_RECORD_LABEL_REF(label,here);
+            }
+        }
+
+      /* Sometimes, we take addresses of labels and use them
+         as instruction operands ... these show up as REG_NOTES */
+      else
+      if (INSN == code)
+       {
+         if ('i' == GET_RTX_CLASS (code)) 
+           {
+              rtx note;
+              for (note = REG_NOTES (insn); note;  note = XEXP(note,1))
+                {
+                   if (REG_LABEL == REG_NOTE_KIND(note))
+                     {
+                        rtx label = XEXP (note,0);
+                        if (!label || CODE_LABEL != GET_CODE (label)) abort ();
+
+                        I370_RECORD_LABEL_REF(label,here);
+                     }
+                }
+           }
+       }
+   }
+}
+
+/* ===================================================== */
+
+/* Emit reload of base register if indicated.  This is to eliminate multiple
+   reloads when several labels are generated pointing to the same place
+   in the code.  
+
+   The page table is written at the end of the function. 
+   The entries in the page table look like
+     .LPGT0:          // PGT0 EQU *
+     .long .LPG0      // DC A(PG0)
+     .long .LPG1      // DC A(PG1)
+  while the prologue generates
+      L       r4,=A(.LPGT0)
+
+  Note that this paging scheme breaks down if a single subroutine 
+  has more than about 10MB of code in it ... as long as humans write
+  code, this shouldn't be a problem ...
+ */
+
+void
+check_label_emit ()
+{
+  if (mvs_need_base_reload)
+    {
+      mvs_need_base_reload = 0;
+
+      mvs_page_code += 4;
+      fprintf (assembler_source, "\tL\t%d,%d(,%d)\n",
+	  BASE_REGISTER, (mvs_page_num - function_base_page) * 4,
+	  PAGE_REGISTER);
+    }
+}
+
+/* Add the label to the current page label list.  If a free element is available
+   it will be used for the new label.  Otherwise, a label element will be
+   allocated from memory.
+   ID is the label number of the label being added to the list.  */
+
+static label_node_t *
+mvs_get_label (id)
+     int id;
+{
+  label_node_t *lp;
+
+  /* first, lets see if we already go one, if so, use that.  */
+  for (lp = label_anchor; lp; lp = lp->label_next)
+    {
+      if (lp->label_id == id) return lp;
+    }
+
+  /* not found, get a new one */
+  if (free_anchor)
+    {
+      lp = free_anchor;
+      free_anchor = lp->label_next;
+    }
+  else
+    {
+      lp = (label_node_t *) xmalloc (sizeof (label_node_t));
+    }
+
+  /* initialize for new label */
+  lp->label_id = id;
+  lp->label_page = -1;
+  lp->label_next = label_anchor;
+  lp->label_first_ref = 2000123123;
+  lp->label_last_ref = -1;
+  lp->label_addr = -1;
+  lp->first_ref_page = -1;
+  label_anchor = lp;
+
+  return lp;
+}
+
+void
+mvs_add_label (id)
+     int id;
+{
+  label_node_t *lp;
+  int fwd_distance;
+
+  lp = mvs_get_label (id);
+  lp->label_page = mvs_page_num;
+
+  /* OK, we just saw the label.  Determine if this label
+   * needs a reload of the base register */
+  if ((-1 != lp->first_ref_page) && 
+      (lp->first_ref_page != mvs_page_num)) 
+    {
+      /* Yep; the first label_ref was on a different page.  */
+      mvs_need_base_reload ++;
+      return;
+    }
+
+  /* Hmm.  Try to see if the estimated address of the last
+     label_ref is on the current page.  If it is, then we
+     don't need a base reg reload.  Note that this estimate
+     is very conservatively handled; we'll tend to have 
+     a good bit more reloads than actually needed.  Someday,
+     we should tighten the estimates (which are driven by
+     the (set_att "length") insn attibute.
+    
+     Currently, we estimate that number of page literals 
+     same as number of insns, which is a vast overestimate,
+     esp that the estimate of each insn size is its max size.  */
+
+  /* if latest ref comes before label, we are clear */
+  if (lp->label_last_ref < lp->label_addr) return;
+
+  fwd_distance = lp->label_last_ref - lp->label_addr;
+
+  if (mvs_page_code + 2 * fwd_distance + mvs_page_lit < 4060) return;
+
+  mvs_need_base_reload ++;
+}
+
+/* Check to see if the label is in the list and in the current
+   page.  If not found, we have to make worst case assumption 
+   that label will be on a different page, and thus will have to
+   generate a load and branch on register.  This is rather
+   ugly for forward-jumps, but what can we do? For backward
+   jumps on the same page we can branch directly to address.
+   ID is the label number of the label being checked.  */
+
+int
+mvs_check_label (id)
+     int id;
+{
+  label_node_t *lp;
+
+  for (lp = label_anchor; lp; lp = lp->label_next)
+    {
+      if (lp->label_id == id) 
+        {
+          if (lp->label_page == mvs_page_num) 
+            {
+               return 1;
+            } 
+          else 
+            {
+	       return 0;
+            } 
+        }
+    }
+  return 0;
+}
+
+/* Get the page on which the label sits.  This will be used to 
+   determine is a register reload is really needed.  */
+
+#if 0
+int
+mvs_get_label_page(int id)
+{
+  label_node_t *lp;
+
+  for (lp = label_anchor; lp; lp = lp->label_next)
+    {
+      if (lp->label_id == id)
+	return lp->label_page;
+    }
+  return -1;
+}
+#endif
+
+/* The label list for the current page freed by linking the list onto the free
+   label element chain.  */
+
+void
+mvs_free_label_list ()
+{
+
+  if (label_anchor)
+    {
+      label_node_t *last_lp = label_anchor;
+      while (last_lp->label_next) last_lp = last_lp->label_next;
+      last_lp->label_next = free_anchor;
+      free_anchor = label_anchor;
+    }
+  label_anchor = 0;
+}
+
+/* ====================================================================== */
+/* If the page size limit is reached a new code page is started, and the base
+   register is set to it.  This page break point is counted conservatively,
+   most literals that have the same value are collapsed by the assembler.
+   True is returned when a new page is started.
+   FILE is the assembler output file descriptor.
+   CODE is the length, in bytes, of the instruction to be emitted.
+   LIT is the length of the literal to be emitted.  */
+
+#ifdef TARGET_HLASM
+int
+mvs_check_page (file, code, lit)
+     FILE *file;
+     int code, lit;
+{
+  if (file)
+    assembler_source = file;
+
+  if (mvs_page_code + code + mvs_page_lit + lit > MAX_MVS_PAGE_LENGTH)
+    {
+      fprintf (assembler_source, "\tB\tPGE%d\n", mvs_page_num);
+      fprintf (assembler_source, "\tDS\t0F\n");
+      fprintf (assembler_source, "\tLTORG\n");
+      fprintf (assembler_source, "\tDS\t0F\n");
+      fprintf (assembler_source, "PGE%d\tEQU\t*\n", mvs_page_num);
+      fprintf (assembler_source, "\tDROP\t%d\n", BASE_REGISTER);
+      mvs_page_num++;
+      /* Safe to use BASR not BALR, since we are
+       * not switching addressing mode here ...  */
+      fprintf (assembler_source, "\tBASR\t%d,0\n", BASE_REGISTER);
+      fprintf (assembler_source, "PG%d\tEQU\t*\n", mvs_page_num);
+      fprintf (assembler_source, "\tUSING\t*,%d\n", BASE_REGISTER);
+      mvs_page_code = code;
+      mvs_page_lit = lit;
+      return 1;
+    }
+  mvs_page_code += code;
+  mvs_page_lit += lit;
+  return 0;
+}
+#endif /* TARGET_HLASM */
+
+
+#ifdef TARGET_ELF_ABI
+int
+mvs_check_page (file, code, lit)
+     FILE *file;
+     int code, lit;
+{
+  if (file)
+    assembler_source = file;
+
+  if (mvs_page_code + code + mvs_page_lit + lit > MAX_MVS_PAGE_LENGTH)
+    {
+      /* hop past the literal pool */
+      fprintf (assembler_source, "\tB\t.LPGE%d\n", mvs_page_num);
+
+      /* dump the literal pool. The .baligns are optional, since 
+       * ltorg will align to the size of the largest literal 
+       * (which is possibly 8 bytes) */
+      fprintf (assembler_source, "\t.balign\t4\n");
+      fprintf (assembler_source, "\t.LTORG\n");
+      fprintf (assembler_source, "\t.balign\t4\n");
+
+      /* we continue execution here ...  */
+      fprintf (assembler_source, ".LPGE%d:\n", mvs_page_num);
+      fprintf (assembler_source, "\t.DROP\t%d\n", BASE_REGISTER);
+      mvs_page_num++;
+
+      /* BASR puts the contents of the PSW into r3
+       * that is, r3 will be loaded with the address of "." */
+      fprintf (assembler_source, "\tBASR\tr%d,0\n", BASE_REGISTER);
+      fprintf (assembler_source, ".LPG%d:\n", mvs_page_num);
+      fprintf (assembler_source, "\t.USING\t.,r%d\n", BASE_REGISTER);
+      mvs_page_code = code;
+      mvs_page_lit = lit;
+      return 1;
+    }
+  mvs_page_code += code;
+  mvs_page_lit += lit;
+  return 0;
+}
+#endif /* TARGET_ELF_ABI */
+
+/* ===================================================== */
+/* defines and functions specific to the HLASM assembler */
+#ifdef TARGET_HLASM
+
+/* Check for C/370 runtime function, they don't use standard calling
+   conventions.  True is returned if the function is in the table.
+   NAME is the name of the current function.  */
+
+int
+mvs_function_check (name)
+     const char *name;
+{
+  int lower, middle, upper;
+  int i;
+
+  lower = 0;
+  upper = MVS_FUNCTION_TABLE_LENGTH - 1;
+  while (lower <= upper)
+    {
+      middle = (lower + upper) / 2;
+      i = strcmp (name, mvs_function_table[middle]);
+      if (i == 0)
+	return 1;
+      if (i < 0)
+	upper = middle - 1;
+      else
+	lower = middle + 1;
+    }
+  return 0;
+}
+
+/* Generate a hash for a given key.  */
+
+#ifdef LONGEXTERNAL
+static int
+mvs_hash_alias (key)
+     const char *key;
+{
+  int h;
+  int i;
+  int l = strlen (key);
+
+  h = key[0];
+  for (i = 1; i < l; i++)
+    h = ((h * MVS_SET_SIZE) + key[i]) % MVS_HASH_PRIME;
+  return (h);
+}
+#endif
+
+/* Add the alias to the current alias list.  */
+
+void
+mvs_add_alias (realname, aliasname, emitted)
+     const char *realname;
+     const char *aliasname;
+     int   emitted;
+{
+  alias_node_t *ap;
+
+  ap = (alias_node_t *) xmalloc (sizeof (alias_node_t));
+  if (strlen (realname) > MAX_LONG_LABEL_SIZE)
+    {
+      warning ("real name is too long - alias ignored");
+      return;
+    }
+  if (strlen (aliasname) > MAX_MVS_LABEL_SIZE)
+    {
+      warning ("alias name is too long - alias ignored");
+      return;
+    }
+      
+  strcpy (ap->real_name, realname);
+  strcpy (ap->alias_name, aliasname);
+  ap->alias_emitted = emitted;
+  ap->alias_next = alias_anchor;
+  alias_anchor = ap;
+}
+
+/* Check to see if the name needs aliasing. ie. the name is either:
+     1. Longer than 8 characters
+     2. Contains an underscore
+     3. Is mixed case */
+
+int
+mvs_need_alias (realname)
+      const char *realname;
+{
+   int i, j = strlen (realname);
+
+   if (mvs_function_check (realname))
+     return 0;
+#if 0
+   if (!strcmp (realname, "gccmain"))
+     return 0;
+   if (!strcmp (realname, "main"))
+     return 0;
+#endif
+   if (j > MAX_MVS_LABEL_SIZE)
+     return 1;
+   if (strchr (realname, '_') != 0)
+     return 1;
+   if (ISUPPER (realname[0]))
+     {
+       for (i = 1; i < j; i++)
+	 {
+	   if (ISLOWER (realname[i]))
+	     return 1;
+	 }
+     }
+   else
+     {
+       for (i = 1; i < j; i++)
+         {
+	   if (ISUPPER (realname[i]))
+	     return 1;
+	 }
+     }
+
+   return 0;
+}
+
+/* Get the alias from the list. 
+   If 1 is returned then it's in the alias list, 0 if it was not */
+
+int
+mvs_get_alias (realname, aliasname)
+     const char *realname;
+     char *aliasname;
+{
+#ifdef LONGEXTERNAL
+  alias_node_t *ap;
+
+  for (ap = alias_anchor; ap; ap = ap->alias_next)
+    {
+      if (!strcmp (ap->real_name, realname))
+	{
+	  strcpy (aliasname, ap->alias_name);
+	  return 1;
+	}
+    }
+  if (mvs_need_alias (realname))
+    {
+      char c1, c2;
+
+      c1 = realname[0];
+      c2 = realname[1];
+      if (ISLOWER (c1)) c1 = TOUPPER (c1);
+      else if (c1 == '_') c1 = 'A';
+      if (ISLOWER (c2)) c2 = TOUPPER (c2);
+      else if (c2 == '_' || c2 == '\0') c2 = '#';
+
+      sprintf (aliasname, "%c%c%06d", c1, c2, mvs_hash_alias (realname));
+      mvs_add_alias (realname, aliasname, 0);
+      return 1;
+    }
+#else
+  if (strlen (realname) > MAX_MVS_LABEL_SIZE)
+    {
+      strncpy (aliasname, realname, MAX_MVS_LABEL_SIZE);
+      aliasname[MAX_MVS_LABEL_SIZE] = '\0';
+      return 1;
+    }
+#endif
+  return 0;
+}
+
+/* Check to see if the alias is in the list. 
+   If 1 is returned then it's in the alias list, 2 it was emitted  */
+
+int
+mvs_check_alias (realname, aliasname)
+     const char *realname;
+     char *aliasname;
+{
+#ifdef LONGEXTERNAL
+  alias_node_t *ap;
+
+  for (ap = alias_anchor; ap; ap = ap->alias_next)
+    {
+      if (!strcmp (ap->real_name, realname))
+	{
+	  int rc = (ap->alias_emitted == 1) ? 1 : 2; 
+	  strcpy (aliasname, ap->alias_name);
+	  ap->alias_emitted = 1; 
+	  return rc;
+	}
+    }
+  if (mvs_need_alias (realname))
+    {
+      char c1, c2;
+
+      c1 = realname[0];
+      c2 = realname[1];
+      if (ISLOWER (c1)) c1 = TOUPPER (c1);
+      else if (c1 == '_') c1 = 'A';
+      if (ISLOWER (c2)) c2 = TOUPPER (c2);
+      else if (c2 == '_' || c2 == '\0') c2 = '#';
+
+      sprintf (aliasname, "%c%c%06d", c1, c2, mvs_hash_alias (realname));
+      mvs_add_alias (realname, aliasname, 0);
+      alias_anchor->alias_emitted = 1;
+      return 2;
+    }
+#else
+  if (strlen (realname) > MAX_MVS_LABEL_SIZE)
+    {
+      strncpy (aliasname, realname, MAX_MVS_LABEL_SIZE);
+      aliasname[MAX_MVS_LABEL_SIZE] = '\0';
+      return 1;
+    }
+#endif
+  return 0;
+}
+
+/* defines and functions specific to the HLASM assembler */
+#endif /* TARGET_HLASM */
+/* ===================================================== */
+/* ===================================================== */
+/* defines and functions specific to the gas assembler */
+#ifdef TARGET_ELF_ABI
+
+/* Check for C/370 runtime function, they don't use standard calling
+   conventions.  True is returned if the function is in the table.
+   NAME is the name of the current function.  */
+/* no special calling conventions (yet ??) */
+
+int
+mvs_function_check (name)
+     const char *name ATTRIBUTE_UNUSED;
+{
+   return 0;
+}
+
+#endif /* TARGET_ELF_ABI */
+/* ===================================================== */
+
+
+/* Return 1 if OP is a valid S operand for an RS, SI or SS type instruction.
+   OP is the current operation.
+   MODE is the current operation mode.  */
+
+int
+s_operand (op, mode)
+     register rtx op;
+     enum machine_mode mode;
+{
+  extern int volatile_ok;
+  register enum rtx_code code = GET_CODE (op);
+
+  if (CONSTANT_ADDRESS_P (op))
+    return 1;
+  if (mode == VOIDmode || GET_MODE (op) != mode)
+    return 0;
+  if (code == MEM)
+    {
+      register rtx x = XEXP (op, 0);
+
+      if (!volatile_ok && op->volatil)
+	return 0;
+      if (REG_P (x) && REG_OK_FOR_BASE_P (x))
+	return 1;
+      if (GET_CODE (x) == PLUS
+	  && REG_P (XEXP (x, 0)) && REG_OK_FOR_BASE_P (XEXP (x, 0))
+	  && GET_CODE (XEXP (x, 1)) == CONST_INT
+	  && (unsigned) INTVAL (XEXP (x, 1)) < 4096)
+	return 1;
+    }
+  return 0;
+}
+
+
+/* Return 1 if OP is a valid R or S operand for an RS, SI or SS type
+   instruction.
+   OP is the current operation.
+   MODE is the current operation mode.  */
+
+int
+r_or_s_operand (op, mode)
+     register rtx op;
+     enum machine_mode mode;
+{
+  extern int volatile_ok;
+  register enum rtx_code code = GET_CODE (op);
+
+  if (CONSTANT_ADDRESS_P (op))
+    return 1;
+  if (mode == VOIDmode || GET_MODE (op) != mode)
+    return 0;
+  if (code == REG)
+    return 1;
+  else if (code == MEM)
+    {
+      register rtx x = XEXP (op, 0);
+
+      if (!volatile_ok && op->volatil)
+	return 0;
+      if (REG_P (x) && REG_OK_FOR_BASE_P (x))
+	return 1;
+      if (GET_CODE (x) == PLUS
+	  && REG_P (XEXP (x, 0)) && REG_OK_FOR_BASE_P (XEXP (x, 0))
+	  && GET_CODE (XEXP (x, 1)) == CONST_INT
+	  && (unsigned) INTVAL (XEXP (x, 1)) < 4096)
+	return 1;
+    }
+  return 0;
+}
+
+
+/* Some remarks about unsigned_jump_follows_p():
+   gcc is built around the assumption that branches are signed
+   or unsigned, whereas the 370 doesn't care; its the compares that
+   are signed or unsigned.  Thus, we need to somehow know if we
+   need to do a signed or an unsigned compare, and we do this by 
+   looking ahead in the instruction sequence until we find a jump.
+   We then note whether this jump is signed or unsigned, and do the 
+   compare appropriately.  Note that we have to scan ahead indefinitley,
+   as the gcc optimizer may insert any number of instructions between 
+   the compare and the jump.
+  
+   Note that using conditional branch expanders seems to be be a more 
+   elegant/correct way of doing this.   See, for instance, the Alpha 
+   cmpdi and bgt patterns.  Note also that for the i370, various
+   arithmetic insn's set the condition code as well.
+
+   The unsigned_jump_follows_p() routine  returns a 1 if the next jump 
+   is unsigned.  INSN is the current instruction.  */
+
+int
+unsigned_jump_follows_p (insn)
+     register rtx insn;
+{
+  rtx orig_insn = insn;
+  while (1) 
+    {
+      register rtx tmp_insn;
+      enum rtx_code coda;
+  
+      insn = NEXT_INSN (insn);
+      if (!insn) fatal_insn ("internal error--no jump follows compare:", orig_insn);
+  
+      if (GET_CODE (insn) != JUMP_INSN) continue;
+    
+      tmp_insn = XEXP (insn, 3);
+      if (GET_CODE (tmp_insn) != SET) continue;
+    
+      if (GET_CODE (XEXP (tmp_insn, 0)) != PC) continue;
+    
+      tmp_insn = XEXP (tmp_insn, 1);
+      if (GET_CODE (tmp_insn) != IF_THEN_ELSE) continue;
+    
+      /* if we got to here, this instruction is a jump.  Is it signed? */
+      tmp_insn = XEXP (tmp_insn, 0);
+      coda = GET_CODE (tmp_insn);
+  
+      return coda != GE && coda != GT && coda != LE && coda != LT;
+    }
+}
+
+#ifdef TARGET_HLASM
+
+/* Target hook for assembling integer objects.  This version handles all
+   objects when TARGET_HLASM is defined.  */
+
+static bool
+i370_hlasm_assemble_integer (x, size, aligned_p)
+     rtx x;
+     unsigned int size;
+     int aligned_p;
+{
+  const char *int_format = NULL;
+
+  if (aligned_p)
+    switch (size)
+      {
+      case 1:
+	int_format = "\tDC\tX'%02X'\n";
+	break;
+
+      case 2:
+	int_format = "\tDC\tX'%04X'\n";
+	break;
+
+      case 4:
+	if (GET_CODE (x) == CONST_INT)
+	  {
+	    fputs ("\tDC\tF'", asm_out_file);
+	    output_addr_const (asm_out_file, x);
+	    fputs ("'\n", asm_out_file);
+	  }
+	else
+	  {
+	    fputs ("\tDC\tA(", asm_out_file);
+	    output_addr_const (asm_out_file, x);
+	    fputs (")\n", asm_out_file);
+	  }
+	return true;
+      }
+
+  if (int_format && GET_CODE (x) == CONST_INT)
+    {
+      fprintf (asm_out_file, int_format, INTVAL (x));
+      return true;
+    }
+  return default_assemble_integer (x, size, aligned_p);
+}
+
+/* Generate the assembly code for function entry.  FILE is a stdio
+   stream to output the code to.  SIZE is an int: how many units of
+   temporary storage to allocate.
+
+   Refer to the array `regs_ever_live' to determine which registers to
+   save; `regs_ever_live[I]' is nonzero if register number I is ever
+   used in the function.  This function is responsible for knowing
+   which registers should not be saved even if used.  */
+
+static void
+i370_output_function_prologue (f, l)
+     FILE *f;
+     HOST_WIDE_INT l;
+{
+#if MACROPROLOGUE == 1
+  fprintf (f, "* Function %s prologue\n", mvs_function_name);
+  fprintf (f, "\tEDCPRLG USRDSAL=%d,BASEREG=%d\n",
+	   STACK_POINTER_OFFSET + l - 120 +
+	   current_function_outgoing_args_size, BASE_REGISTER);
+#else /* MACROPROLOGUE != 1 */
+  static int function_label_index = 1;
+  static int function_first = 0;
+  static int function_year, function_month, function_day;
+  static int function_hour, function_minute, function_second;
+#if defined(LE370)
+  if (!function_first)
+    {
+      struct tm *function_time;
+      time_t lcltime;
+      time (&lcltime);
+      function_time = localtime (&lcltime);
+      function_year = function_time->tm_year + 1900;
+      function_month = function_time->tm_mon + 1;
+      function_day = function_time->tm_mday;
+      function_hour = function_time->tm_hour;
+      function_minute = function_time->tm_min;
+      function_second = function_time->tm_sec;
+    }
+  fprintf (f, "* Function %s prologue\n", mvs_function_name);
+  fprintf (f, "FDSE%03d\tDSECT\n", function_label_index);
+  fprintf (f, "\tDS\tD\n");
+  fprintf (f, "\tDS\tCL(" HOST_WIDE_INT_PRINT_DEC ")\n",
+	   STACK_POINTER_OFFSET + l
+	   + current_function_outgoing_args_size);
+  fprintf (f, "\tORG\tFDSE%03d\n", function_label_index);
+  fprintf (f, "\tDS\tCL(120+8)\n");
+  fprintf (f, "\tORG\n");
+  fprintf (f, "\tDS\t0D\n");
+  fprintf (f, "FDSL%03d\tEQU\t*-FDSE%03d-8\n", function_label_index,
+	   function_label_index);
+  fprintf (f, "\tDS\t0H\n");
+  assemble_name (f, mvs_function_name);
+  fprintf (f, "\tCSECT\n");
+  fprintf (f, "\tUSING\t*,15\n");
+  fprintf (f, "\tB\tFENT%03d\n", function_label_index);
+  fprintf (f, "\tDC\tAL1(FNAM%03d+4-*)\n", function_label_index);
+  fprintf (f, "\tDC\tX'CE',X'A0',AL1(16)\n");
+  fprintf (f, "\tDC\tAL4(FPPA%03d)\n", function_label_index);
+  fprintf (f, "\tDC\tAL4(0)\n");
+  fprintf (f, "\tDC\tAL4(FDSL%03d)\n", function_label_index);
+  fprintf (f, "FNAM%03d\tEQU\t*\n", function_label_index);
+  fprintf (f, "\tDC\tAL2(%d),C'%s'\n", strlen (mvs_function_name),
+	mvs_function_name);
+  fprintf (f, "FPPA%03d\tDS\t0F\n", function_label_index);
+  fprintf (f, "\tDC\tX'03',X'00',X'33',X'00'\n");
+  fprintf (f, "\tDC\tV(CEESTART)\n");
+  fprintf (f, "\tDC\tAL4(0)\n");
+  fprintf (f, "\tDC\tAL4(FTIM%03d)\n", function_label_index);
+  fprintf (f, "FTIM%03d\tDS\t0F\n", function_label_index);
+  fprintf (f, "\tDC\tCL4'%d',CL4'%02d%02d',CL6'%02d%02d00'\n",
+  		 function_year, function_month, function_day,
+    		 function_hour, function_minute);
+  fprintf (f, "\tDC\tCL2'01',CL4'0100'\n");
+  fprintf (f, "FENT%03d\tDS\t0H\n", function_label_index);
+  fprintf (f, "\tSTM\t14,12,12(13)\n");
+  fprintf (f, "\tL\t2,76(,13)\n");
+  fprintf (f, "\tL\t0,16(,15)\n");
+  fprintf (f, "\tALR\t0,2\n");
+  fprintf (f, "\tCL\t0,12(,12)\n");
+  fprintf (f, "\tBNH\t*+10\n");
+  fprintf (f, "\tL\t15,116(,12)\n");
+  fprintf (f, "\tBALR\t14,15\n");
+  fprintf (f, "\tL\t15,72(,13)\n");
+  fprintf (f, "\tSTM\t15,0,72(2)\n");
+  fprintf (f, "\tMVI\t0(2),X'10'\n");
+  fprintf (f, "\tST\t2,8(,13)\n ");
+  fprintf (f, "\tST\t13,4(,2)\n ");
+  fprintf (f, "\tLR\t13,2\n");
+  fprintf (f, "\tDROP\t15\n");
+  fprintf (f, "\tBALR\t%d,0\n", BASE_REGISTER);
+  fprintf (f, "\tUSING\t*,%d\n", BASE_REGISTER);
+  function_first = 1;
+  function_label_index ++;
+#else /* !LE370 */
+  if (!function_first)
+    {
+      struct tm *function_time;
+      time_t lcltime;
+      time (&lcltime);
+      function_time = localtime (&lcltime);
+      function_year = function_time->tm_year + 1900;
+      function_month = function_time->tm_mon + 1;
+      function_day = function_time->tm_mday;
+      function_hour = function_time->tm_hour;
+      function_minute = function_time->tm_min;
+      function_second = function_time->tm_sec;
+      fprintf (f, "PPA2\tDS\t0F\n");
+      fprintf (f, "\tDC\tX'03',X'00',X'33',X'00'\n");
+      fprintf (f, "\tDC\tV(CEESTART),A(0)\n");
+      fprintf (f, "\tDC\tA(CEETIMES)\n");
+      fprintf (f, "CEETIMES\tDS\t0F\n");
+      fprintf (f, "\tDC\tCL4'%d',CL4'%02d%02d',CL6'%02d%02d00'\n",
+    		 function_year, function_month, function_day,
+    		 function_hour, function_minute, function_second);
+      fprintf (f, "\tDC\tCL2'01',CL4'0100'\n");
+    }
+  fprintf (f, "* Function %s prologue\n", mvs_function_name);
+  fprintf (f, "FDSD%03d\tDSECT\n", function_label_index);
+  fprintf (f, "\tDS\tD\n");
+  fprintf (f, "\tDS\tCL(%d)\n", STACK_POINTER_OFFSET + l
+			+ current_function_outgoing_args_size);
+  fprintf (f, "\tORG\tFDSD%03d\n", function_label_index);
+  fprintf (f, "\tDS\tCL(120+8)\n");
+  fprintf (f, "\tORG\n");
+  fprintf (f, "\tDS\t0D\n");
+  fprintf (f, "FDSL%03d\tEQU\t*-FDSD%03d-8\n", function_label_index,
+	   function_label_index);
+  fprintf (f, "\tDS\t0H\n");
+  assemble_name (f, mvs_function_name);
+  fprintf (f, "\tCSECT\n");
+  fprintf (f, "\tUSING\t*,15\n");
+  fprintf (f, "\tB\tFPL%03d\n", function_label_index);
+  fprintf (f, "\tDC\tAL1(FPL%03d+4-*)\n", function_label_index + 1);
+  fprintf (f, "\tDC\tX'CE',X'A0',AL1(16)\n");
+  fprintf (f, "\tDC\tAL4(PPA2)\n");
+  fprintf (f, "\tDC\tAL4(0)\n");
+  fprintf (f, "\tDC\tAL4(FDSL%03d)\n", function_label_index);
+  fprintf (f, "FPL%03d\tEQU\t*\n", function_label_index + 1);
+  fprintf (f, "\tDC\tAL2(%d),C'%s'\n", strlen (mvs_function_name),
+	mvs_function_name);
+  fprintf (f, "FPL%03d\tDS\t0H\n", function_label_index);
+  fprintf (f, "\tSTM\t14,12,12(13)\n");
+  fprintf (f, "\tL\t2,76(,13)\n");
+  fprintf (f, "\tL\t0,16(,15)\n");
+  fprintf (f, "\tALR\t0,2\n");
+  fprintf (f, "\tCL\t0,12(,12)\n");
+  fprintf (f, "\tBNH\t*+10\n");
+  fprintf (f, "\tL\t15,116(,12)\n");
+  fprintf (f, "\tBALR\t14,15\n");
+  fprintf (f, "\tL\t15,72(,13)\n");
+  fprintf (f, "\tSTM\t15,0,72(2)\n");
+  fprintf (f, "\tMVI\t0(2),X'10'\n");
+  fprintf (f, "\tST\t2,8(,13)\n ");
+  fprintf (f, "\tST\t13,4(,2)\n ");
+  fprintf (f, "\tLR\t13,2\n");
+  fprintf (f, "\tDROP\t15\n");
+  fprintf (f, "\tBALR\t%d,0\n", BASE_REGISTER);
+  fprintf (f, "\tUSING\t*,%d\n", BASE_REGISTER);
+  function_first = 1;
+  function_label_index += 2;
+#endif /* !LE370 */
+#endif /* MACROPROLOGUE */
+  fprintf (f, "PG%d\tEQU\t*\n", mvs_page_num );
+  fprintf (f, "\tLR\t11,1\n"); 
+  fprintf (f, "\tL\t%d,=A(PGT%d)\n", PAGE_REGISTER, mvs_page_num);
+  fprintf (f, "* Function %s code\n", mvs_function_name);
+
+  mvs_free_label_list ();
+  mvs_page_code = 6;
+  mvs_page_lit = 4;
+  mvs_check_page (f, 0, 0);
+  function_base_page = mvs_page_num;
+
+  /* find all labels in this routine */
+  i370_label_scan ();
+}
+
+static void
+i370_globalize_label (stream, name)
+     FILE *stream;
+     const char *name;
+{
+  char temp[MAX_MVS_LABEL_SIZE + 1];
+  if (mvs_check_alias (name, temp) == 2)
+    fprintf (stream, "%s\tALIAS\tC'%s'\n", temp, name);
+  fputs ("\tENTRY\t", stream);
+  assemble_name (stream, name);
+  putc ('\n', stream);
+}
+#endif /* TARGET_HLASM */
+
+
+#ifdef TARGET_ELF_ABI
+/*
+   The 370_function_prolog() routine generates the current ELF ABI ES/390 prolog.
+   It implements a stack that grows downward. 
+   It performs the following steps:
+   -- saves the callers non-volatile registers on the callers stack.
+   -- subtracts stackframe size from the stack pointer.
+   -- stores backpointer to old caller stack.
+  
+   XXX hack alert -- if the global var int leaf_function is nonzero, 
+   then this is a leaf, and it might be possible to optimize the prologue
+   into doing even less, e.g. not grabbing a new stackframe or maybe just a
+   partial stack frame.
+  
+   XXX hack alert -- the current stack frame is bloated into twice the 
+   needed size by unused entries. These entries make it marginally 
+   compatible with MVS/OE/USS C environment, but really they're not used
+   and could probably chopped out. Modifications to i370.md would be needed
+   also, to quite using addresses 136, 140, etc.
+ */
+
+static void
+i370_output_function_prologue (f, frame_size)
+     FILE *f;
+     HOST_WIDE_INT frame_size;
+{
+  static int function_label_index = 1;
+  static int function_first = 0;
+  int stackframe_size, aligned_size;
+
+  fprintf (f, "# Function prologue\n");
+  /* define the stack, put it into its own data segment
+     FDSE == Function Stack Entry
+     FDSL == Function Stack Length */
+  stackframe_size = 
+     STACK_POINTER_OFFSET + current_function_outgoing_args_size + frame_size;
+  aligned_size = (stackframe_size + 7) >> 3;
+  aligned_size <<= 3;
+  
+  fprintf (f, "# arg_size=0x%x frame_size=" HOST_WIDE_INT_PRINT_HEX
+	   " aligned size=0x%x\n", 
+     current_function_outgoing_args_size, frame_size, aligned_size);
+
+  fprintf (f, "\t.using\t.,r15\n");
+
+  /* Branch to exectuable part of prologue.  */
+  fprintf (f, "\tB\t.LFENT%03d\n", function_label_index);
+
+  /* write the length of the stackframe */
+  fprintf (f, "\t.long\t%d\n", aligned_size);
+
+  /* FENT == function prologue entry */
+  fprintf (f, "\t.balign 2\n.LFENT%03d:\n",
+              function_label_index);
+
+  /* store multiple registers 14,15,0,...12 at 12 bytes from sp */
+  fprintf (f, "\tSTM\tr14,r12,12(sp)\n");
+
+  /* r3 == saved callee stack pointer */
+  fprintf (f, "\tLR\tr3,sp\n");
+
+  /* 4(r15) == stackframe size */
+  fprintf (f, "\tSL\tsp,4(,r15)\n");
+
+  /* r11 points to arg list in callers stackframe; was passed in r2 */
+  fprintf (f, "\tLR\tr11,r2\n");
+
+  /* store callee stack pointer at 8(sp) */
+  /* fprintf (f, "\tST\tsp,8(,r3)\n ");  wasted cycles, no one uses this ...  */
+
+  /* backchain -- store caller sp at 4(callee_sp)  */
+  fprintf (f, "\tST\tr3,4(,sp)\n ");
+
+  fprintf (f, "\t.drop\tr15\n");
+  /* Place contents of the PSW into r3
+     that is, place the address of "." into r3 */
+  fprintf (f, "\tBASR\tr%d,0\n", BASE_REGISTER);
+  fprintf (f, "\t.using\t.,r%d\n", BASE_REGISTER);
+  function_first = 1;
+  function_label_index ++;
+
+  fprintf (f, ".LPG%d:\n", mvs_page_num  );
+  fprintf (f, "\tL\tr%d,=A(.LPGT%d)\n", PAGE_REGISTER, mvs_page_num);
+  fprintf (f, "# Function code\n");
+
+  mvs_free_label_list ();
+  mvs_page_code = 6;
+  mvs_page_lit = 4;
+  mvs_check_page (f, 0, 0);
+  function_base_page = mvs_page_num;
+
+  /* find all labels in this routine */
+  i370_label_scan ();
+}
+#endif /* TARGET_ELF_ABI */
+
+/* This function generates the assembly code for function exit.
+   Args are as for output_function_prologue ().
+
+   The function epilogue should not depend on the current stack
+   pointer!  It should use the frame pointer only.  This is mandatory
+   because of alloca; we also take advantage of it to omit stack
+   adjustments before returning.  */
+
+static void
+i370_output_function_epilogue (file, l)
+     FILE *file;
+     HOST_WIDE_INT l ATTRIBUTE_UNUSED;
+{
+  int i;
+
+  check_label_emit ();
+  mvs_check_page (file, 14, 0);
+  fprintf (file, "* Function %s epilogue\n", mvs_function_name);
+  mvs_page_num++;
+
+#if MACROEPILOGUE == 1
+  fprintf (file, "\tEDCEPIL\n");
+#else /* MACROEPILOGUE != 1 */
+  fprintf (file, "\tL\t13,4(,13)\n");
+  fprintf (file, "\tL\t14,12(,13)\n");
+  fprintf (file, "\tLM\t2,12,28(13)\n");
+  fprintf (file, "\tBALR\t1,14\n");
+  fprintf (file, "\tDC\tA(");
+  assemble_name (file, mvs_function_name);
+  fprintf (file, ")\n" );
+#endif /* MACROEPILOGUE */
+
+  fprintf (file, "* Function %s literal pool\n", mvs_function_name);
+  fprintf (file, "\tDS\t0F\n" );
+  fprintf (file, "\tLTORG\n");
+  fprintf (file, "* Function %s page table\n", mvs_function_name);
+  fprintf (file, "\tDS\t0F\n");
+  fprintf (file, "PGT%d\tEQU\t*\n", function_base_page);
+
+  mvs_free_label_list();
+  for (i = function_base_page; i < mvs_page_num; i++)
+    fprintf (file, "\tDC\tA(PG%d)\n", i);
+}
+
+static void
+i370_file_start ()
+{
+  fputs ("\tRMODE\tANY\n\tCSECT\n", asm_out_file);
+}
+
+static void
+i370_file_end ()
+{
+  fputs ("\tEND\n", asm_out_file);
+}
+
+static void
+i370_internal_label (stream, prefix, labelno)
+     FILE *stream;
+     const char *prefix;
+     unsigned long labelno;
+{
+  if (!strcmp (prefix, "L"))
+    mvs_add_label(labelno);
+
+  default_internal_label (stream, prefix, labelno);
+}
+
+static bool
+i370_rtx_costs (x, code, outer_code, total)
+     rtx x;
+     int code;
+     int outer_code ATTRIBUTE_UNUSED;
+     int *total;
+{
+  switch (code)
+    {
+    case CONST_INT:
+      if ((unsigned HOST_WIDE_INT) INTVAL (x) < 0xfff)
+	{
+	  *total = 1;
+	  return true;
+	}
+      /* FALLTHRU */
+
+    case CONST:
+    case LABEL_REF:
+    case SYMBOL_REF:
+      *total = 2;
+      return true;
+
+    case CONST_DOUBLE:
+      *total = 4;
+      return true;
+
+    default:
+      return false;
+    }
+}
diff --git a/gcc/config/i370/i370.h b/gcc/config/i370/i370.h
new file mode 100644
index 00000000000..5d7037f4902
--- /dev/null
+++ b/gcc/config/i370/i370.h
@@ -0,0 +1,1863 @@
+/* Definitions of target machine for GNU compiler.  System/370 version.
+   Copyright (C) 1989, 1993, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
+   2003 Free Software Foundation, Inc.
+   Contributed by Jan Stein (jan@cd.chalmers.se).
+   Modified for OS/390 LanguageEnvironment C by Dave Pitts (dpitts@cozx.com)
+   Hacked for Linux-ELF/390 by Linas Vepstas (linas@linas.org)
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifndef GCC_I370_H
+#define GCC_I370_H
+
+/* Target CPU builtins.  */
+#define TARGET_CPU_CPP_BUILTINS()		\
+  do						\
+    {						\
+      builtin_define_std ("GCC");		\
+      builtin_define_std ("gcc");		\
+      builtin_assert ("machine=i370");		\
+      builtin_assert ("cpu=i370");		\
+    }						\
+  while (0)
+
+/* Run-time compilation parameters selecting different hardware subsets.  */
+
+extern int target_flags;
+
+/* The sizes of the code and literals on the current page.  */
+
+extern int mvs_page_code, mvs_page_lit;
+
+/* The current page number and the base page number for the function.  */
+
+extern int mvs_page_num, function_base_page;
+
+/* The name of the current function.  */
+
+extern char *mvs_function_name;
+
+/* The length of the function name malloc'd area.  */
+
+extern size_t mvs_function_name_length;
+
+/* Compile using char instructions (mvc, nc, oc, xc).  On 4341 use this since
+   these are more than twice as fast as load-op-store.
+   On 3090 don't use this since load-op-store is much faster.  */
+
+#define TARGET_CHAR_INSTRUCTIONS (target_flags & 1)
+
+/* Default target switches */
+
+#define TARGET_DEFAULT 1
+
+/* Macro to define tables used to set the flags.  This is a list in braces
+   of pairs in braces, each pair being { "NAME", VALUE }
+   where VALUE is the bits to set or minus the bits to clear.
+   An empty string NAME is used to identify the default VALUE.  */
+
+#define TARGET_SWITCHES							\
+{ { "char-instructions", 1, N_("Generate char instructions")},            \
+  { "no-char-instructions", -1, N_("Do not generate char instructions")}, \
+  { "", TARGET_DEFAULT, 0} }
+
+#define OVERRIDE_OPTIONS  override_options ()
+
+/* To use IBM supplied macro function prologue and epilogue, define the
+   following to 1.  Should only be needed if IBM changes the definition
+   of their prologue and epilogue.  */
+
+#define MACROPROLOGUE 0
+#define MACROEPILOGUE 0
+
+/* Target machine storage layout */
+
+/* Define this if most significant bit is lowest numbered in instructions
+   that operate on numbered bit-fields.  */
+
+#define BITS_BIG_ENDIAN 1
+
+/* Define this if most significant byte of a word is the lowest numbered.  */
+
+#define BYTES_BIG_ENDIAN 1
+
+/* Define this if MS word of a multiword is the lowest numbered.  */
+
+#define WORDS_BIG_ENDIAN 1
+
+/* Width of a word, in units (bytes).  */
+
+#define UNITS_PER_WORD 4
+
+/* Allocation boundary (in *bits*) for storing pointers in memory.  */
+
+#define POINTER_BOUNDARY 32
+
+/* Allocation boundary (in *bits*) for storing arguments in argument list.  */
+
+#define PARM_BOUNDARY 32
+
+/* Boundary (in *bits*) on which stack pointer should be aligned.  */
+
+#define STACK_BOUNDARY 32
+
+/* Allocation boundary (in *bits*) for the code of a function.  */
+
+#define FUNCTION_BOUNDARY 32
+
+/* There is no point aligning anything to a rounder boundary than this.  */
+
+#define BIGGEST_ALIGNMENT 64
+
+/* Alignment of field after `int : 0' in a structure.  */
+
+#define EMPTY_FIELD_BOUNDARY 32
+
+/* Define this if move instructions will actually fail to work when given
+   unaligned data.  */
+
+#define STRICT_ALIGNMENT 0
+
+/* Define target floating point format.  */
+
+#define TARGET_FLOAT_FORMAT IBM_FLOAT_FORMAT
+
+#ifdef TARGET_HLASM
+/* HLASM requires #pragma map.  */
+#define REGISTER_TARGET_PRAGMAS() c_register_pragma (0, "map", i370_pr_map)
+#endif /* TARGET_HLASM */
+
+/* Define maximum length of page minus page escape overhead.  */
+
+#define MAX_MVS_PAGE_LENGTH 4080
+
+/* Define special register allocation order desired.  
+   Don't fiddle with this.  I did, and I got all sorts of register 
+   spill errors when compiling even relatively simple programs...
+   I have no clue why ...
+   E.g. this one is bad:
+   { 0, 1, 2, 9, 8, 7, 6, 5, 10, 15, 14, 12, 3, 4, 16, 17, 18, 19, 11, 13 }
+ */
+
+#define REG_ALLOC_ORDER							\
+{ 0, 1, 2, 3, 14, 15, 12, 10, 9, 8, 7, 6, 5, 4, 16, 17, 18, 19, 11, 13 }
+
+/* Standard register usage.  */
+
+/* Number of actual hardware registers.  The hardware registers are
+   assigned numbers for the compiler from 0 to just below
+   FIRST_PSEUDO_REGISTER.
+   All registers that the compiler knows about must be given numbers,
+   even those that are not normally considered general registers.
+   For the 370, we give the data registers numbers 0-15,
+   and the floating point registers numbers 16-19.  */
+
+#define FIRST_PSEUDO_REGISTER 20
+
+/* Define base and page registers.  */
+
+#define BASE_REGISTER 3
+#define PAGE_REGISTER 4
+
+#ifdef TARGET_HLASM
+/* 1 for registers that have pervasive standard uses and are not available
+   for the register allocator.  These are registers that must have fixed,
+   valid values stored in them for the entire length of the subroutine call,
+   and must not in any way be moved around, jiggered with, etc. That is,
+   they must never be clobbered, and, if clobbered, the register allocator 
+   will never restore them back.
+   
+   We use five registers in this special way:
+   -- R3 which is used as the base register
+   -- R4 the page origin table pointer used to load R3,
+   -- R11 the arg pointer.  
+   -- R12 the TCA pointer
+   -- R13 the stack (DSA) pointer
+
+   A fifth register is also exceptional: R14 is used in many branch
+   instructions to hold the target of the branch.  Technically, this
+   does not qualify R14 as a register with a long-term meaning; it should
+   be enough, theoretically, to note that these instructions clobber
+   R14, and let the compiler deal with that.  In practice, however,
+   the "clobber" directive acts as a barrier to optimization, and the
+   optimizer appears to be unable to perform optimizations around branches.
+   Thus, a much better strategy appears to give R14 a pervasive use;
+   this eliminates it from the register pool witout hurting optimization.
+
+   There are other registers which have special meanings, but its OK
+   for them to get clobbered, since other allocator config below will
+   make sure that they always have the right value.  These are for 
+   example:
+   -- R1 the returned structure pointer.
+   -- R10 the static chain reg.
+   -- R15 holds the value a subroutine returns.
+
+   Notice that it is *almost* safe to mark R11 as available to the allocator.
+   By marking it as a call_used_register, in most cases, the compiler
+   can handle it being clobbered.  However, there are a few rare
+   circumstances where the register allocator will allocate r11 and 
+   also try to use it as the arg pointer ... thus it must be marked fixed.
+   I think this is a bug, but I can't track it down...
+ */
+
+#define FIXED_REGISTERS 						\
+{ 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0 }
+/*0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19*/
+
+/* 1 for registers not available across function calls.  These must include
+   the FIXED_REGISTERS and also any registers that can be used without being
+   saved.
+   The latter must include the registers where values are returned
+   and the register where structure-value addresses are passed.
+   NOTE: all floating registers are undefined across calls.  
+*/
+
+#define CALL_USED_REGISTERS 						\
+{ 1, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1 }
+/*0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19*/
+
+/* Return number of consecutive hard regs needed starting at reg REGNO
+   to hold something of mode MODE.
+   This is ordinarily the length in words of a value of mode MODE
+   but can be less for certain modes in special long registers.  
+   Note that DCmode (complex double) needs two regs.
+*/
+#endif /* TARGET_HLASM */
+
+/* ================= */
+#ifdef TARGET_ELF_ABI 
+/* The Linux/ELF ABI uses the same register layout as the 
+ * the MVS/OE version, with the following exceptions:
+ * -- r12 (rtca) is not used.
+ */
+
+#define FIXED_REGISTERS 						\
+{ 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0 }
+/*0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19*/
+
+#define CALL_USED_REGISTERS 						\
+{ 1, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1 }
+/*0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19*/
+
+#endif /* TARGET_ELF_ABI */
+/* ================= */
+
+
+#define HARD_REGNO_NREGS(REGNO, MODE) 					\
+  ((REGNO) > 15 ? 							\
+   ((GET_MODE_SIZE (MODE) + 2*UNITS_PER_WORD - 1) / (2*UNITS_PER_WORD)) :	\
+   (GET_MODE_SIZE(MODE)+UNITS_PER_WORD-1) / UNITS_PER_WORD)
+
+/* Value is 1 if hard register REGNO can hold a value of machine-mode MODE.
+   On the 370, the cpu registers can hold QI, HI, SI, SF and DF.  The
+   even registers can hold DI.  The floating point registers can hold
+   either SF, DF, SC or DC.  */
+
+#define HARD_REGNO_MODE_OK(REGNO, MODE)					\
+  ((REGNO) < 16 ? (((REGNO) & 1) == 0 || 				\
+		  (((MODE) != DImode) && ((MODE) != DFmode)))		\
+		: ((MODE) == SFmode || (MODE) == DFmode) ||		\
+                   (MODE) == SCmode || (MODE) == DCmode)
+
+/* Value is 1 if it is a good idea to tie two pseudo registers when one has
+   mode MODE1 and one has mode MODE2.
+   If HARD_REGNO_MODE_OK could produce different values for MODE1 and MODE2,
+   for any hard reg, then this must be 0 for correct output.  */
+
+#define MODES_TIEABLE_P(MODE1, MODE2)					\
+  (((MODE1) == SFmode || (MODE1) == DFmode)				\
+   == ((MODE2) == SFmode || (MODE2) == DFmode))
+
+/* Specify the registers used for certain standard purposes.
+   The values of these macros are register numbers.  */
+
+/* 370 PC isn't overloaded on a register.  */
+
+/* #define PC_REGNUM */
+
+/* Register to use for pushing function arguments.  */
+
+#define STACK_POINTER_REGNUM 13
+
+/* Base register for access to local variables of the function.  */
+
+#define FRAME_POINTER_REGNUM 13
+
+/* Value should be nonzero if functions must have frame pointers.
+   Zero means the frame pointer need not be set up (and parms may be
+   accessed via the stack pointer) in functions that seem suitable.
+   This is computed in `reload', in reload1.c.  */
+
+#define FRAME_POINTER_REQUIRED 1
+
+/* Base register for access to arguments of the function.  */
+
+#define ARG_POINTER_REGNUM 11
+
+/* R10 is register in which static-chain is passed to a function.  
+   Static-chaining is done when a nested function references as a global
+   a stack variable of its parent: e.g.
+        int parent_func (int arg) { 
+             int x;                            // x is in parents stack
+             void child_func (void) { x++: }   // child references x as global var
+             ... 
+        }
+ */
+
+#define STATIC_CHAIN_REGNUM 10
+
+/* R1 is register in which address to store a structure value is passed to
+   a function.  This is used only when returning 64-bit long-long in a 32-bit arch
+   and when calling functions that return structs by value. e.g.
+        typedef struct A_s { int a,b,c; } A_t;
+        A_t fun_returns_value (void) { 
+            A_t a; a.a=1; a.b=2 a.c=3;
+            return a;
+        } 
+   In the above, the storage for the return value is in the callers stack, and 
+   the R1 points at that mem location.
+ */
+
+#define STRUCT_VALUE_REGNUM 1
+
+/* Define the classes of registers for register constraints in the
+   machine description.  Also define ranges of constants.
+
+   One of the classes must always be named ALL_REGS and include all hard regs.
+   If there is more than one class, another class must be named NO_REGS
+   and contain no registers.
+
+   The name GENERAL_REGS must be the name of a class (or an alias for
+   another name such as ALL_REGS).  This is the class of registers
+   that is allowed by "g" or "r" in a register constraint.
+   Also, registers outside this class are allocated only when
+   instructions express preferences for them.
+
+   The classes must be numbered in nondecreasing order; that is,
+   a larger-numbered class must never be contained completely
+   in a smaller-numbered class.
+
+   For any two classes, it is very desirable that there be another
+   class that represents their union.  */
+
+enum reg_class
+  {
+    NO_REGS, ADDR_REGS, DATA_REGS,
+    FP_REGS, ALL_REGS, LIM_REG_CLASSES
+  };
+
+#define GENERAL_REGS DATA_REGS
+#define N_REG_CLASSES (int) LIM_REG_CLASSES
+
+/* Give names of register classes as strings for dump file.  */
+
+#define REG_CLASS_NAMES 						\
+{ "NO_REGS", "ADDR_REGS", "DATA_REGS", "FP_REGS", "ALL_REGS" }
+
+/* Define which registers fit in which classes.  This is an initializer for
+   a vector of HARD_REG_SET of length N_REG_CLASSES.  */
+
+#define REG_CLASS_CONTENTS {{0}, {0x0fffe}, {0x0ffff}, {0xf0000}, {0xfffff}}
+
+/* The same information, inverted:
+   Return the class number of the smallest class containing
+   reg number REGNO.  This could be a conditional expression
+   or could index an array.  */
+
+#define REGNO_REG_CLASS(REGNO) 						\
+  ((REGNO) >= 16 ? FP_REGS : (REGNO) != 0 ? ADDR_REGS : DATA_REGS)
+
+/* The class value for index registers, and the one for base regs.  */
+
+#define INDEX_REG_CLASS ADDR_REGS
+#define BASE_REG_CLASS ADDR_REGS
+
+/* Get reg_class from a letter such as appears in the machine description.  */
+
+#define REG_CLASS_FROM_LETTER(C)					\
+  ((C) == 'a' ? ADDR_REGS :						\
+  ((C) == 'd' ? DATA_REGS :						\
+  ((C) == 'f' ? FP_REGS   : NO_REGS)))
+
+/* The letters I, J, K, L and M in a register constraint string can be used
+   to stand for particular ranges of immediate operands.
+   This macro defines what the ranges are.
+   C is the letter, and VALUE is a constant value.
+   Return 1 if VALUE is in the range specified by C.  */
+
+#define CONST_OK_FOR_LETTER_P(VALUE, C)					\
+  ((C) == 'I' ? (unsigned) (VALUE) < 256 :				\
+   (C) == 'J' ? (unsigned) (VALUE) < 4096 :				\
+   (C) == 'K' ? (VALUE) >= -32768 && (VALUE) < 32768 : 0)
+
+/* Similar, but for floating constants, and defining letters G and H.
+   Here VALUE is the CONST_DOUBLE rtx itself.  */
+
+#define CONST_DOUBLE_OK_FOR_LETTER_P(VALUE, C)  1
+
+/* see recog.c for details */
+#define EXTRA_CONSTRAINT(OP,C)						\
+   ((C) == 'R' ? r_or_s_operand (OP, GET_MODE(OP)) :			\
+    (C) == 'S' ? s_operand (OP, GET_MODE(OP)) :	0)			\
+
+/* Given an rtx X being reloaded into a reg required to be in class CLASS,
+   return the class of reg to actually use.  In general this is just CLASS;
+   but on some machines in some cases it is preferable to use a more
+   restrictive class.  
+
+   XXX We reload CONST_INT's into ADDR not DATA regs because on certain 
+   rare occasions when lots of egisters are spilled, reload() will try
+   to put a const int into r0 and then use r0 as an index register.
+*/
+
+#define PREFERRED_RELOAD_CLASS(X, CLASS)				\
+    (GET_CODE(X) == CONST_DOUBLE ? FP_REGS :				\
+     GET_CODE(X) == CONST_INT ? (reload_in_progress ? ADDR_REGS : DATA_REGS) :	\
+     GET_CODE(X) == LABEL_REF ||					\
+     GET_CODE(X) == SYMBOL_REF ||					\
+     GET_CODE(X) == CONST ? ADDR_REGS : (CLASS))
+
+/* Return the maximum number of consecutive registers needed to represent
+   mode MODE in a register of class CLASS.  
+   Note that DCmode (complex double) needs two regs.
+*/
+
+#define CLASS_MAX_NREGS(CLASS, MODE)					\
+  ((CLASS) == FP_REGS ? 						\
+   ((GET_MODE_SIZE (MODE) + 2*UNITS_PER_WORD - 1) / (2*UNITS_PER_WORD)) :	\
+   (GET_MODE_SIZE (MODE) + UNITS_PER_WORD - 1) / UNITS_PER_WORD)
+
+/* Stack layout; function entry, exit and calling.  */
+
+/* Define this if pushing a word on the stack makes the stack pointer a
+   smaller address.  */
+/* ------------------------------------------------------------------- */
+
+/* ================= */
+#ifdef TARGET_HLASM
+/* #define STACK_GROWS_DOWNWARD */
+
+/* Define this if the nominal address of the stack frame is at the
+   high-address end of the local variables; that is, each additional local
+   variable allocated goes at a more negative offset in the frame.  */
+
+/* #define FRAME_GROWS_DOWNWARD */
+
+/* Offset within stack frame to start allocating local variables at.
+   If FRAME_GROWS_DOWNWARD, this is the offset to the END of the
+   first local allocated.  Otherwise, it is the offset to the BEGINNING
+   of the first local allocated.  */
+
+#define STARTING_FRAME_OFFSET  						\
+     (STACK_POINTER_OFFSET + current_function_outgoing_args_size)
+
+#define INITIAL_FRAME_POINTER_OFFSET(DEPTH) (DEPTH) = STARTING_FRAME_OFFSET
+
+/* If we generate an insn to push BYTES bytes, this says how many the stack
+   pointer really advances by.  On the 370, we have no push instruction.  */
+
+#endif /* TARGET_HLASM */
+
+/* ================= */
+#ifdef TARGET_ELF_ABI 
+
+/* With ELF/Linux, stack is placed at large virtual addrs and grows down.
+   But we want the compiler to generate posistive displacements from the 
+   stack pointer, and so we make the frame lie above the stack.  */
+
+#define STACK_GROWS_DOWNWARD 
+/* #define FRAME_GROWS_DOWNWARD */
+
+/* Offset within stack frame to start allocating local variables at.
+   This is the offset to the BEGINNING of the first local allocated.  */
+
+#define STARTING_FRAME_OFFSET  						\
+     (STACK_POINTER_OFFSET + current_function_outgoing_args_size)
+
+#define INITIAL_FRAME_POINTER_OFFSET(DEPTH) (DEPTH) = STARTING_FRAME_OFFSET
+
+#endif /* TARGET_ELF_ABI */
+/* ================= */
+
+/* #define PUSH_ROUNDING(BYTES) */
+
+/* Accumulate the outgoing argument count so we can request the right
+   DSA size and determine stack offset.  */
+
+#define ACCUMULATE_OUTGOING_ARGS 1
+
+/* Define offset from stack pointer, to location where a parm can be
+   pushed.  */
+
+#define STACK_POINTER_OFFSET 148
+
+/* Offset of first parameter from the argument pointer register value.  */
+
+#define FIRST_PARM_OFFSET(FNDECL) 0
+
+/* 1 if N is a possible register number for function argument passing.
+   On the 370, no registers are used in this way.  */
+
+#define FUNCTION_ARG_REGNO_P(N) 0
+
+/* Define a data type for recording info about an argument list during
+   the scan of that argument list.  This data type should hold all
+   necessary information about the function itself and about the args
+   processed so far, enough to enable macros such as FUNCTION_ARG to
+   determine where the next arg should go.  */
+
+#define CUMULATIVE_ARGS int
+
+/* Initialize a variable CUM of type CUMULATIVE_ARGS for a call to
+   a function whose data type is FNTYPE.
+   For a library call, FNTYPE is 0.  */
+
+#define INIT_CUMULATIVE_ARGS(CUM, FNTYPE, LIBNAME, INDIRECT, N_NAMED_ARGS) \
+  ((CUM) = 0)
+
+/* Update the data in CUM to advance over an argument of mode MODE and
+   data type TYPE.  (TYPE is null for libcalls where that information
+   may not be available.) */
+
+#define FUNCTION_ARG_ADVANCE(CUM, MODE, TYPE, NAMED)			\
+ ((CUM) += ((MODE) == DFmode || (MODE) == SFmode			\
+	    ? 256							\
+	    : (MODE) != BLKmode                 			\
+	    ? (GET_MODE_SIZE (MODE) + 3) / 4 				\
+	    : (int_size_in_bytes (TYPE) + 3) / 4))
+
+/* Define where to put the arguments to a function.  Value is zero to push
+   the argument on the stack, or a hard register in which to store the
+   argument.  */
+
+#define FUNCTION_ARG(CUM, MODE, TYPE, NAMED) 0
+
+/* For an arg passed partly in registers and partly in memory, this is the
+   number of registers used.  For args passed entirely in registers or
+   entirely in memory, zero.  */
+
+#define FUNCTION_ARG_PARTIAL_NREGS(CUM, MODE, TYPE, NAMED) 0
+
+/* Define if returning from a function call automatically pops the
+   arguments described by the number-of-args field in the call.  */
+
+#define RETURN_POPS_ARGS(FUNDECL,FUNTYPE,SIZE) 0
+
+/* The FUNCTION_VALUE macro defines how to find the value returned by a 
+   function.  VALTYPE is the data type of the value (as a tree).
+   If the precise function being called is known, FUNC is its FUNCTION_DECL;
+   otherwise, FUNC is NULL.  
+
+   On the 370 the return value is in R15 or R16.  However,
+   DImode (64-bit ints) scalars need to get returned on the stack, 
+   with r15 pointing to the location.  To accomplish this, we define
+   the RETURN_IN_MEMORY macro to be true for both blockmode (structures)
+   and the DImode scalars.
+ */
+
+#define RET_REG(MODE)	\
+    (((MODE) == DCmode || (MODE) == SCmode \
+      || (MODE) == DFmode || (MODE) == SFmode) ? 16 : 15)
+
+#define FUNCTION_VALUE(VALTYPE, FUNC)  					\
+  gen_rtx_REG (TYPE_MODE (VALTYPE), RET_REG (TYPE_MODE (VALTYPE)))
+
+#define RETURN_IN_MEMORY(VALTYPE)  \
+  ((DImode == TYPE_MODE (VALTYPE)) || (BLKmode == TYPE_MODE (VALTYPE)))
+
+/* Define how to find the value returned by a library function assuming
+   the value has mode MODE.  */
+
+#define LIBCALL_VALUE(MODE)  gen_rtx_REG (MODE, RET_REG (MODE))
+
+/* 1 if N is a possible register number for a function value.
+   On the 370 under C/370, R15 and R16 are thus used.  */
+
+#define FUNCTION_VALUE_REGNO_P(N) ((N) == 15 || (N) == 16)
+
+/* This macro definition sets up a default value for `main' to return.  */
+
+#define DEFAULT_MAIN_RETURN  c_expand_return (integer_zero_node)
+
+
+/* Output assembler code for a block containing the constant parts of a
+   trampoline, leaving space for the variable parts.
+
+   On the 370, the trampoline contains these instructions:
+
+        BALR  14,0
+        USING *,14
+        L     STATIC_CHAIN_REGISTER,X
+        L     15,Y
+        BR    15
+   X    DS    0F
+   Y    DS    0F  */
+/*
+   I am confused as to why this emitting raw binary, instead of instructions ...
+   see for example, rs6000/rs000.c for an example of a different way to
+   do this ... especially since BASR should probably be substituted for BALR.
+ */
+
+#define TRAMPOLINE_TEMPLATE(FILE)					\
+{									\
+  assemble_aligned_integer (2, GEN_INT (0x05E0));			\
+  assemble_aligned_integer (2, GEN_INT (0x5800 | STATIC_CHAIN_REGNUM << 4)); \
+  assemble_aligned_integer (2, GEN_INT (0xE00A));			\
+  assemble_aligned_integer (2, GEN_INT (0x58F0)); 			\
+  assemble_aligned_integer (2, GEN_INT (0xE00E));			\
+  assemble_aligned_integer (2, GEN_INT (0x07FF));			\
+  assemble_aligned_integer (2, const0_rtx);				\
+  assemble_aligned_integer (2, const0_rtx);				\
+  assemble_aligned_integer (2, const0_rtx);				\
+  assemble_aligned_integer (2, const0_rtx);				\
+}
+
+/* Length in units of the trampoline for entering a nested function.  */
+
+#define TRAMPOLINE_SIZE 20
+
+/* Emit RTL insns to initialize the variable parts of a trampoline.  */
+
+#define INITIALIZE_TRAMPOLINE(TRAMP, FNADDR, CXT)			\
+{									\
+  emit_move_insn (gen_rtx_MEM (SImode, plus_constant (TRAMP, 12)), CXT); \
+  emit_move_insn (gen_rtx_MEM (SImode, plus_constant (TRAMP, 16)), FNADDR); \
+}
+
+/* Define EXIT_IGNORE_STACK if, when returning from a function, the stack
+   pointer does not matter (provided there is a frame pointer).  */
+
+#define EXIT_IGNORE_STACK	1
+
+/* Addressing modes, and classification of registers for them.  */
+
+/* These assume that REGNO is a hard or pseudo reg number.  They give
+   nonzero only if REGNO is a hard reg of the suitable class or a pseudo
+   reg currently allocated to a suitable hard reg.
+   These definitions are NOT overridden anywhere.  */
+
+#define REGNO_OK_FOR_INDEX_P(REGNO) 					\
+  (((REGNO) > 0 && (REGNO) < 16)					\
+    || (reg_renumber[REGNO] > 0 && reg_renumber[REGNO] < 16))
+
+#define REGNO_OK_FOR_BASE_P(REGNO) REGNO_OK_FOR_INDEX_P(REGNO)
+
+#define REGNO_OK_FOR_DATA_P(REGNO) 					\
+  ((REGNO) < 16 || (unsigned) reg_renumber[REGNO] < 16)
+
+#define REGNO_OK_FOR_FP_P(REGNO) 					\
+  ((unsigned) ((REGNO) - 16) < 4 || (unsigned) (reg_renumber[REGNO] - 16) < 4)
+
+/* Now macros that check whether X is a register and also,
+   strictly, whether it is in a specified class.  */
+
+/* 1 if X is a data register.  */
+
+#define DATA_REG_P(X) (REG_P (X) && REGNO_OK_FOR_DATA_P (REGNO (X)))
+
+/* 1 if X is an fp register.  */
+
+#define FP_REG_P(X) (REG_P (X) && REGNO_OK_FOR_FP_P (REGNO (X)))
+
+/* 1 if X is an address register.  */
+
+#define ADDRESS_REG_P(X) (REG_P (X) && REGNO_OK_FOR_BASE_P (REGNO (X)))
+
+/* Maximum number of registers that can appear in a valid memory address.  */
+
+#define MAX_REGS_PER_ADDRESS 2
+
+/* Recognize any constant value that is a valid address.  */
+
+#define CONSTANT_ADDRESS_P(X)						\
+  (GET_CODE (X) == LABEL_REF || GET_CODE (X) == SYMBOL_REF		\
+  || GET_CODE (X) == CONST_INT || GET_CODE (X) == CONST_DOUBLE		\
+  || (GET_CODE (X) == CONST						\
+	  && GET_CODE (XEXP (XEXP (X, 0), 0)) == LABEL_REF)		\
+  || (GET_CODE (X) == CONST						\
+	  && GET_CODE (XEXP (XEXP (X, 0), 0)) == SYMBOL_REF		\
+	  && !SYMBOL_REF_EXTERNAL_P (XEXP (XEXP (X, 0), 0))))
+
+/* Nonzero if the constant value X is a legitimate general operand.
+   It is given that X satisfies CONSTANT_P or is a CONST_DOUBLE.  */
+
+#define LEGITIMATE_CONSTANT_P(X) 1
+
+/* The macros REG_OK_FOR..._P assume that the arg is a REG rtx and check
+   its validity for a certain class.  We have two alternate definitions
+   for each of them.  The usual definition accepts all pseudo regs; the
+   other rejects them all.  The symbol REG_OK_STRICT causes the latter
+   definition to be used.
+
+   Most source files want to accept pseudo regs in the hope that they will
+   get allocated to the class that the insn wants them to be in.
+   Some source files that are used after register allocation
+   need to be strict.  */
+
+#ifndef REG_OK_STRICT
+
+/* Nonzero if X is a hard reg that can be used as an index or if it is
+  a pseudo reg.  */
+
+#define REG_OK_FOR_INDEX_P(X)						\
+  ((REGNO(X) > 0 && REGNO(X) < 16) || REGNO(X) >= 20)
+
+/* Nonzero if X is a hard reg that can be used as a base reg or if it is
+   a pseudo reg.  */
+
+#define REG_OK_FOR_BASE_P(X)	REG_OK_FOR_INDEX_P(X)
+
+#else /* REG_OK_STRICT */
+
+/* Nonzero if X is a hard reg that can be used as an index.  */
+
+#define REG_OK_FOR_INDEX_P(X) REGNO_OK_FOR_INDEX_P(REGNO(X))
+
+/* Nonzero if X is a hard reg that can be used as a base reg.  */
+
+#define REG_OK_FOR_BASE_P(X) REGNO_OK_FOR_BASE_P(REGNO(X))
+
+#endif /* REG_OK_STRICT */
+
+/* GO_IF_LEGITIMATE_ADDRESS recognizes an RTL expression that is a
+   valid memory address for an instruction.
+   The MODE argument is the machine mode for the MEM expression
+   that wants to use this address.
+
+   The other macros defined here are used only in GO_IF_LEGITIMATE_ADDRESS,
+   except for CONSTANT_ADDRESS_P which is actually machine-independent.  
+*/
+
+#define COUNT_REGS(X, REGS, FAIL)					\
+ if (REG_P (X)) {							\
+   if (REG_OK_FOR_BASE_P (X)) REGS += 1;				\
+   else goto FAIL;							\
+ }									\
+ else if (GET_CODE (X) != CONST_INT || (unsigned) INTVAL (X) >= 4096)	\
+   goto FAIL;
+
+#define GO_IF_LEGITIMATE_ADDRESS(MODE, X, ADDR)				\
+{									\
+  if (REG_P (X) && REG_OK_FOR_BASE_P (X))				\
+    goto ADDR;								\
+  if (GET_CODE (X) == PLUS)						\
+    {									\
+      int regs = 0;							\
+      rtx x0 = XEXP (X, 0);						\
+      rtx x1 = XEXP (X, 1);						\
+      if (GET_CODE (x0) == PLUS)					\
+	{								\
+	  COUNT_REGS (XEXP (x0, 0), regs, FAIL);			\
+	  COUNT_REGS (XEXP (x0, 1), regs, FAIL);			\
+	  COUNT_REGS (x1, regs, FAIL);					\
+	  if (regs == 2)						\
+	    goto ADDR;							\
+	}								\
+      else if (GET_CODE (x1) == PLUS)					\
+	{								\
+	  COUNT_REGS (x0, regs, FAIL);					\
+	  COUNT_REGS (XEXP (x1, 0), regs, FAIL);			\
+	  COUNT_REGS (XEXP (x1, 1), regs, FAIL);			\
+	  if (regs == 2)						\
+	    goto ADDR;							\
+	}								\
+      else								\
+	{								\
+	  COUNT_REGS (x0, regs, FAIL);					\
+	  COUNT_REGS (x1, regs, FAIL);					\
+	  if (regs != 0)						\
+	    goto ADDR;							\
+	}								\
+    }									\
+  FAIL: ;								\
+}
+
+/* The 370 has no mode dependent addresses.  */
+
+#define GO_IF_MODE_DEPENDENT_ADDRESS(ADDR, LABEL)
+
+/* Macro: LEGITIMIZE_ADDRESS(X, OLDX, MODE, WIN)
+   Try machine-dependent ways of modifying an illegitimate address
+   to be legitimate.  If we find one, return the new, valid address.
+   This macro is used in only one place: `memory_address' in explow.c. 
+  
+   Several comments:
+   (1) It's not obvious that this macro results in better code
+       than its omission does. For historical reasons we leave it in.
+  
+   (2) This macro may be (???) implicated in the accidental promotion
+       or RS operand to RX operands, which bombs out any RS, SI, SS 
+       instruction that was expecting a simple address.  Note that 
+       this occurs fairly rarely ...
+  
+   (3) There is a bug somewhere that causes either r4 to be spilled,
+       or causes r0 to be used as a base register.  Changeing the macro 
+       below will make the bug move around, but will not make it go away 
+       ... Note that this is a rare bug ...
+   
+ */
+
+#define LEGITIMIZE_ADDRESS(X, OLDX, MODE, WIN)				\
+{									\
+  if (GET_CODE (X) == PLUS && CONSTANT_ADDRESS_P (XEXP (X, 1)))		\
+    (X) = gen_rtx_PLUS (SImode, XEXP (X, 0),				\
+			copy_to_mode_reg (SImode, XEXP (X, 1)));	\
+  if (GET_CODE (X) == PLUS && CONSTANT_ADDRESS_P (XEXP (X, 0)))		\
+    (X) = gen_rtx_PLUS (SImode, XEXP (X, 1),				\
+			copy_to_mode_reg (SImode, XEXP (X, 0)));	\
+  if (GET_CODE (X) == PLUS && GET_CODE (XEXP (X, 0)) == MULT)		\
+    (X) = gen_rtx_PLUS (SImode, XEXP (X, 1),				\
+			force_operand (XEXP (X, 0), 0));		\
+  if (GET_CODE (X) == PLUS && GET_CODE (XEXP (X, 1)) == MULT)		\
+    (X) = gen_rtx_PLUS (SImode, XEXP (X, 0),				\
+			force_operand (XEXP (X, 1), 0));		\
+  if (memory_address_p (MODE, X))					\
+    goto WIN;								\
+}
+
+/* Specify the machine mode that this machine uses for the index in the
+   tablejump instruction.  */
+
+#define CASE_VECTOR_MODE SImode
+
+/* Define this if the tablejump instruction expects the table to contain
+   offsets from the address of the table.
+   Do not define this if the table should contain absolute addresses.  */
+
+/* #define CASE_VECTOR_PC_RELATIVE */
+
+/* Define this if fixuns_trunc is the same as fix_trunc.  */
+
+#define FIXUNS_TRUNC_LIKE_FIX_TRUNC
+
+/* We use "unsigned char" as default.  */
+
+#define DEFAULT_SIGNED_CHAR 0
+
+/* Max number of bytes we can move from memory to memory in one reasonably
+   fast instruction.  */
+
+#define MOVE_MAX 256
+
+/* Nonzero if access to memory by bytes is slow and undesirable.  */
+
+#define SLOW_BYTE_ACCESS 1
+
+/* Define if shifts truncate the shift count which implies one can omit
+   a sign-extension or zero-extension of a shift count.  */
+
+/* #define SHIFT_COUNT_TRUNCATED */
+
+/* Value is 1 if truncating an integer of INPREC bits to OUTPREC bits
+   is done just by pretending it is already truncated.  */
+
+#define TRULY_NOOP_TRUNCATION(OUTPREC, INPREC)	(OUTPREC != 16)
+
+/* ??? Investigate defining STORE_FLAG_VALUE to (-1).  */
+
+/* When a prototype says `char' or `short', really pass an `int'.  */
+
+#define PROMOTE_PROTOTYPES 1
+
+/* Don't perform CSE on function addresses.  */
+
+#define NO_FUNCTION_CSE
+
+/* Specify the machine mode that pointers have.
+   After generation of rtl, the compiler makes no further distinction
+   between pointers and any other objects of this machine mode.  */
+
+#define Pmode SImode
+
+/* A function address in a call instruction is a byte address (for
+   indexing purposes) so give the MEM rtx a byte's mode.  */
+
+#define FUNCTION_MODE QImode
+
+/*   A C statement (sans semicolon) to update the integer variable COST
+     based on the relationship between INSN that is dependent on
+     DEP_INSN through the dependence LINK.  The default is to make no
+     adjustment to COST.  This can be used for example to specify to
+     the scheduler that an output- or anti-dependence does not incur
+     the same cost as a data-dependence. 
+
+     We will want to use this to indicate that there is a cost associated 
+     with the loading, followed by use of base registers ... 
+#define ADJUST_COST (INSN, LINK, DEP_INSN, COST)
+ */
+
+/* Tell final.c how to eliminate redundant test instructions.  */
+
+/* Here we define machine-dependent flags and fields in cc_status
+   (see `conditions.h').  */
+
+/* Store in cc_status the expressions that the condition codes will
+   describe after execution of an instruction whose pattern is EXP.
+   Do not alter them if the instruction would not alter the cc's.
+
+   On the 370, load insns do not alter the cc's.  However, in some
+   cases these instructions can make it possibly invalid to use the
+   saved cc's.  In those cases we clear out some or all of the saved
+   cc's so they won't be used.  
+
+   Note that only some arith instructions set the CC.  These include
+   add, subtract, complement, various shifts.  Note that multiply
+   and divide do *not* set set the CC.  Therefore, in the code below,
+   don't set the status for MUL, DIV, etc.
+
+   Note that the bitwise ops set the condition code, but not in a 
+   way that we can make use of it. So we treat these as clobbering, 
+   rather than setting the CC.  These are clobbered in the individual
+   instruction patterns that use them.  Use CC_STATUS_INIT to clobber.
+*/
+
+#define NOTICE_UPDATE_CC(EXP, INSN)					\
+{									\
+  rtx exp = (EXP);							\
+  if (GET_CODE (exp) == PARALLEL) /* Check this */			\
+    exp = XVECEXP (exp, 0, 0);						\
+  if (GET_CODE (exp) != SET)						\
+    CC_STATUS_INIT;							\
+  else									\
+    {									\
+      if (XEXP (exp, 0) == cc0_rtx)					\
+	{								\
+	  cc_status.value1 = XEXP (exp, 0);				\
+	  cc_status.value2 = XEXP (exp, 1);				\
+	  cc_status.flags = 0;						\
+	}								\
+      else								\
+	{								\
+	  if (cc_status.value1						\
+	      && reg_mentioned_p (XEXP (exp, 0), cc_status.value1))	\
+	    cc_status.value1 = 0;					\
+	  if (cc_status.value2						\
+	      && reg_mentioned_p (XEXP (exp, 0), cc_status.value2))	\
+	    cc_status.value2 = 0;					\
+	  switch (GET_CODE (XEXP (exp, 1)))				\
+	    {								\
+	      case PLUS:     case MINUS: case NEG:    			\
+	      case NOT:	 case ABS:					\
+		CC_STATUS_SET (XEXP (exp, 0), XEXP (exp, 1));		\
+									\
+              /* mult and div don't set any cc codes !! */		\
+	      case MULT:  /* case UMULT: */ case DIV:      case UDIV: 	\
+              /* and, or and xor set the cc's the wrong way !! */	\
+	      case AND:   case IOR:    case XOR:  			\
+              /* some shifts set the CC some don't.  */			\
+              case ASHIFT: 	 case ASHIFTRT:  			\
+                 do {} while (0);					\
+              default:							\
+                break;							\
+	    }								\
+	}								\
+    }									\
+}
+
+
+#define CC_STATUS_SET(V1, V2)						\
+{									\
+  cc_status.flags = 0;							\
+  cc_status.value1 = (V1);						\
+  cc_status.value2 = (V2);						\
+  if (cc_status.value1							\
+      && reg_mentioned_p (cc_status.value1, cc_status.value2))		\
+    cc_status.value2 = 0;						\
+}
+
+#define OUTPUT_JUMP(NORMAL, FLOAT, NO_OV) 				\
+{ if (cc_status.flags & CC_NO_OVERFLOW)	return NO_OV; return NORMAL; }
+
+/* ------------------------------------------ */
+/* Control the assembler format that we output.  */
+
+/* Define standard character escape sequences for non-ASCII targets
+   only.  */
+
+#ifdef TARGET_EBCDIC
+#define TARGET_ESC	39
+#define TARGET_BELL	47
+#define TARGET_BS	22
+#define TARGET_TAB	5
+#define TARGET_NEWLINE	21
+#define TARGET_VT	11
+#define TARGET_FF	12
+#define TARGET_CR	13
+#endif
+
+/* ======================================================== */
+
+#ifdef TARGET_HLASM
+#define TEXT_SECTION_ASM_OP "* Program text area"
+#define DATA_SECTION_ASM_OP "* Program data area"
+#define INIT_SECTION_ASM_OP "* Program initialization area"
+#define SHARED_SECTION_ASM_OP "* Program shared data"
+#define CTOR_LIST_BEGIN		/* NO OP */
+#define CTOR_LIST_END		/* NO OP */
+#define MAX_MVS_LABEL_SIZE 8
+
+/* How to refer to registers in assembler output.  This sequence is
+   indexed by compiler's hard-register-number (see above).  */
+
+#define REGISTER_NAMES							\
+{ "0",  "1",  "2",  "3",  "4",  "5",  "6",  "7",			\
+  "8",  "9", "10", "11", "12", "13", "14", "15",			\
+  "0",  "2",  "4",  "6"							\
+}
+
+#define ASM_COMMENT_START "*"
+#define ASM_APP_OFF ""
+#define ASM_APP_ON ""
+
+#define ASM_OUTPUT_LABEL(FILE, NAME) 					\
+{ assemble_name (FILE, NAME); fputs ("\tEQU\t*\n", FILE); }
+
+#define ASM_OUTPUT_EXTERNAL(FILE, DECL, NAME)				\
+{									\
+  char temp[MAX_MVS_LABEL_SIZE + 1];					\
+  if (mvs_check_alias (NAME, temp) == 2)				\
+    {									\
+      fprintf (FILE, "%s\tALIAS\tC'%s'\n", temp, NAME);			\
+    }									\
+}
+
+/* MVS externals are limited to 8 characters, upper case only.
+   The '_' is mapped to '@', except for MVS functions, then '#'.  */
+
+
+#define ASM_OUTPUT_LABELREF(FILE, NAME)					\
+{									\
+  char *bp, ch, temp[MAX_MVS_LABEL_SIZE + 1];				\
+  if (!mvs_get_alias (NAME, temp))					\
+    strcpy (temp, NAME);						\
+  if (!strcmp (temp,"main"))						\
+    strcpy (temp,"gccmain");						\
+  if (mvs_function_check (temp))					\
+    ch = '#';								\
+  else									\
+    ch = '@';								\
+  for (bp = temp; *bp; bp++)						\
+    *bp = (*bp == '_' ? ch : TOUPPER (*bp));				\
+  fprintf (FILE, "%s", temp);						\
+}
+
+#define ASM_GENERATE_INTERNAL_LABEL(LABEL, PREFIX, NUM)			\
+  sprintf (LABEL, "*%s%lu", PREFIX, (unsigned long)(NUM))
+
+/* Generate case label.  For HLASM we can change to the data CSECT
+   and put the vectors out of the code body. The assembler just
+   concatenates CSECTs with the same name.  */
+
+#define ASM_OUTPUT_CASE_LABEL(FILE, PREFIX, NUM, TABLE)			\
+  fprintf (FILE, "\tDS\t0F\n");                                         \
+  fprintf (FILE,"\tCSECT\n");                                           \
+  fprintf (FILE, "%s%d\tEQU\t*\n", PREFIX, NUM)
+
+/* Put the CSECT back to the code body */
+
+#define ASM_OUTPUT_CASE_END(FILE, NUM, TABLE)                           \
+  assemble_name (FILE, mvs_function_name);                              \
+  fputs ("\tCSECT\n", FILE);
+
+/* This is how to output an element of a case-vector that is absolute.  */
+
+#define ASM_OUTPUT_ADDR_VEC_ELT(FILE, VALUE)  				\
+  fprintf (FILE, "\tDC\tA(L%d)\n", VALUE)
+
+/* This is how to output an element of a case-vector that is relative.  */
+
+#define ASM_OUTPUT_ADDR_DIFF_ELT(FILE, BODY, VALUE, REL) 		\
+  fprintf (FILE, "\tDC\tA(L%d-L%d)\n", VALUE, REL)
+
+/* This is how to output an insn to push a register on the stack.
+    It need not be very fast code.  
+   Right now, PUSH & POP are used only when profiling is enabled, 
+   and then, only to push the static chain reg and the function struct 
+   value reg, and only if those are used.  Since profiling is not
+   supported anyway, punt on this.  */
+
+#define ASM_OUTPUT_REG_PUSH(FILE, REGNO)				\
+  mvs_check_page (FILE, 8, 4);						\
+  fprintf (FILE, "\tS\t13,=F'4'\n\tST\t%s,%d(13)\n",			\
+     reg_names[REGNO], STACK_POINTER_OFFSET)
+
+/* This is how to output an insn to pop a register from the stack.
+   It need not be very fast code.  */
+
+#define ASM_OUTPUT_REG_POP(FILE, REGNO)					\
+  mvs_check_page (FILE, 8, 0);						\
+  fprintf (FILE, "\tL\t%s,%d(13)\n\tLA\t13,4(13)\n",			\
+     reg_names[REGNO], STACK_POINTER_OFFSET)
+
+/* This outputs a text string.  The string are chopped up to fit into
+   an 80 byte record.  Also, control and special characters, interpreted
+   by the IBM assembler, are output numerically.  */
+
+#define MVS_ASCII_TEXT_LENGTH 48
+
+#define ASM_OUTPUT_ASCII(FILE, PTR, LEN)				\
+{									\
+  size_t i, limit = (LEN);						\
+  int j;								\
+  for (j = 0, i = 0; i < limit; j++, i++)				\
+    {									\
+      int c = (PTR)[i];							\
+      if (ISCNTRL (c) || c == '&')					\
+	{								\
+	  if (j % MVS_ASCII_TEXT_LENGTH != 0 )				\
+	    fprintf (FILE, "'\n");					\
+	  j = -1;							\
+	  fprintf (FILE, "\tDC\tX'%X'\n", c );				\
+	}								\
+      else								\
+	{								\
+	  if (j % MVS_ASCII_TEXT_LENGTH == 0)				\
+            fprintf (FILE, "\tDC\tC'");					\
+          if ( c == '\'' )                                       	\
+	    fprintf (FILE, "%c%c", c, c);                        	\
+	  else                                                   	\
+	    fprintf (FILE, "%c", c);                             	\
+	  if (j % MVS_ASCII_TEXT_LENGTH == MVS_ASCII_TEXT_LENGTH - 1)	\
+	    fprintf (FILE, "'\n" );					\
+	}								\
+    }									\
+  if (j % MVS_ASCII_TEXT_LENGTH != 0)					\
+    fprintf (FILE, "'\n");						\
+}
+
+/* This is how to output an assembler line that says to advance the
+   location counter to a multiple of 2**LOG bytes.  */
+
+#define ASM_OUTPUT_ALIGN(FILE, LOG)					\
+  if (LOG)								\
+    {									\
+      if ((LOG) == 1)							\
+        fprintf (FILE, "\tDS\t0H\n" );					\
+      else 								\
+        fprintf (FILE, "\tDS\t0F\n" );					\
+    }									\
+
+/* The maximum length of memory that the IBM assembler will allow in one
+   DS operation.  */
+
+#define MAX_CHUNK 32767
+
+/* A C statement to output to the stdio stream FILE an assembler
+   instruction to advance the location counter by SIZE bytes. Those
+   bytes should be zero when loaded.  */
+
+#define ASM_OUTPUT_SKIP(FILE, SIZE)  					\
+{									\
+  unsigned HOST_WIDE_INT s;						\
+  int  k;								\
+  for (s = (SIZE); s > 0; s -= MAX_CHUNK)				\
+    {									\
+      if (s > MAX_CHUNK)						\
+	k = MAX_CHUNK;							\
+      else								\
+	k = s;								\
+      fprintf (FILE, "\tDS\tXL%d\n", k);				\
+    }									\
+}
+
+/* A C statement (sans semicolon) to output to the stdio stream
+   FILE the assembler definition of a common-label named NAME whose
+   size is SIZE bytes.  The variable ROUNDED is the size rounded up
+   to whatever alignment the caller wants.  */
+
+#define ASM_OUTPUT_COMMON(FILE, NAME, SIZE, ROUNDED) 			\
+{									\
+  char temp[MAX_MVS_LABEL_SIZE + 1];					\
+  if (mvs_check_alias(NAME, temp) == 2)					\
+    {									\
+      fprintf (FILE, "%s\tALIAS\tC'%s'\n", temp, NAME);			\
+    }									\
+  fputs ("\tENTRY\t", FILE);						\
+  assemble_name (FILE, NAME);						\
+  fputs ("\n", FILE);							\
+  fprintf (FILE, "\tDS\t0F\n");						\
+  ASM_OUTPUT_LABEL (FILE,NAME);						\
+  ASM_OUTPUT_SKIP (FILE,SIZE);						\
+}
+
+/* A C statement (sans semicolon) to output to the stdio stream
+   FILE the assembler definition of a local-common-label named NAME
+   whose size is SIZE bytes.  The variable ROUNDED is the size
+   rounded up to whatever alignment the caller wants.  */
+
+#define ASM_OUTPUT_LOCAL(FILE, NAME, SIZE, ROUNDED) 			\
+{									\
+  fprintf (FILE, "\tDS\t0F\n");						\
+  ASM_OUTPUT_LABEL (FILE,NAME);						\
+  ASM_OUTPUT_SKIP (FILE,SIZE);						\
+}
+
+#define ASM_PN_FORMAT "%s%lu"
+
+/* Print operand XV (an rtx) in assembler syntax to file FILE.
+   CODE is a letter or dot (`z' in `%z0') or 0 if no letter was specified.
+   For `%' followed by punctuation, CODE is the punctuation and XV is null.  */
+
+#define PRINT_OPERAND(FILE, XV, CODE)					\
+{									\
+  switch (GET_CODE (XV))						\
+    {									\
+      static char curreg[4];						\
+      case REG:								\
+	if (CODE == 'N')						\
+	    strcpy (curreg, reg_names[REGNO (XV) + 1]);			\
+	else								\
+	    strcpy (curreg, reg_names[REGNO (XV)]);			\
+	fprintf (FILE, "%s", curreg);					\
+	break;								\
+      case MEM:								\
+	{								\
+	  rtx addr = XEXP (XV, 0);					\
+	  if (CODE == 'O')						\
+	    {								\
+	      if (GET_CODE (addr) == PLUS)				\
+		fprintf (FILE, HOST_WIDE_INT_PRINT_DEC, INTVAL (XEXP (addr, 1))); \
+	      else							\
+		fprintf (FILE, "0");					\
+	    }								\
+	  else if (CODE == 'R')						\
+	    {								\
+	      if (GET_CODE (addr) == PLUS)				\
+		fprintf (FILE, "%s", reg_names[REGNO (XEXP (addr, 0))]);\
+	      else							\
+		fprintf (FILE, "%s", reg_names[REGNO (addr)]);		\
+	    }								\
+	  else								\
+	    output_address (XEXP (XV, 0));				\
+	}								\
+	break;								\
+      case SYMBOL_REF:							\
+      case LABEL_REF:							\
+	mvs_page_lit += 4;						\
+	if (SYMBOL_REF_EXTERNAL_P (XV)) fprintf (FILE, "=V(");		\
+	else                      fprintf (FILE, "=A(");		\
+	output_addr_const (FILE, XV);					\
+	fprintf (FILE, ")");						\
+	break;								\
+      case CONST_INT:					        	\
+	if (CODE == 'B')						\
+	  fprintf (FILE, "%d", (int) (INTVAL (XV) & 0xff));		\
+	else if (CODE == 'X')						\
+	  fprintf (FILE, "%02X", (int) (INTVAL (XV) & 0xff));		\
+	else if (CODE == 'h')						\
+	  fprintf (FILE, HOST_WIDE_INT_PRINT_DEC, (INTVAL (XV) << 16) >> 16); \
+	else if (CODE == 'H')						\
+	  {								\
+	    mvs_page_lit += 2;						\
+	    fprintf (FILE, "=H'" HOST_WIDE_INT_PRINT_DEC "'", (INTVAL (XV) << 16) >> 16); \
+	  }								\
+	else if (CODE == 'K')						\
+	  {								\
+            /* auto sign-extension of signed 16-bit to signed 32-bit */	\
+	    mvs_page_lit += 4;						\
+	    fprintf (FILE, "=F'" HOST_WIDE_INT_PRINT_DEC "'", (INTVAL (XV) << 16) >> 16); \
+	  }								\
+	else if (CODE == 'W')						\
+	  {								\
+            /* hand-built sign-extension of signed 32-bit to 64-bit */	\
+	    mvs_page_lit += 8;						\
+	    if (0 <=  INTVAL (XV)) {					\
+	       fprintf (FILE, "=XL8'00000000");				\
+            } else {							\
+	       fprintf (FILE, "=XL8'FFFFFFFF");				\
+            }								\
+	    fprintf (FILE, "%08X'", INTVAL (XV));			\
+	  }								\
+	else								\
+	  {								\
+	    mvs_page_lit += 4;						\
+	    fprintf (FILE, "=F'" HOST_WIDE_INT_PRINT_DEC "'", INTVAL (XV)); \
+	  }								\
+	break;								\
+      case CONST_DOUBLE:						\
+	if (GET_MODE (XV) == DImode)					\
+	  {								\
+	    if (CODE == 'M')						\
+	      {								\
+		mvs_page_lit += 4;					\
+		fprintf (FILE, "=XL4'%08X'", CONST_DOUBLE_LOW (XV));	\
+	      }								\
+	    else if (CODE == 'L')					\
+	      {								\
+		mvs_page_lit += 4;					\
+		fprintf (FILE, "=XL4'%08X'", CONST_DOUBLE_HIGH (XV));	\
+	      }								\
+	    else							\
+	      {								\
+		mvs_page_lit += 8;					\
+		fprintf (FILE, "=XL8'%08X%08X'", CONST_DOUBLE_LOW (XV),	\
+			CONST_DOUBLE_HIGH (XV));			\
+	      }								\
+	  }								\
+	else								\
+	  { 								\
+            char buf[50];						\
+	    if (GET_MODE (XV) == SFmode)				\
+	      {								\
+		mvs_page_lit += 4;					\
+		real_to_decimal (buf, CONST_DOUBLE_REAL_VALUE (XV),	\
+				 sizeof (buf), 0, 1);			\
+		fprintf (FILE, "=E'%s'", buf);				\
+	      }								\
+	    else if (GET_MODE (XV) == DFmode)				\
+	      {								\
+		mvs_page_lit += 8;					\
+		real_to_decimal (buf, CONST_DOUBLE_REAL_VALUE (XV),	\
+				 sizeof (buf), 0, 1);			\
+		fprintf (FILE, "=D'%s'", buf);				\
+	      }								\
+	    else /* VOIDmode */						\
+	      {								\
+		mvs_page_lit += 8;					\
+		fprintf (FILE, "=XL8'%08X%08X'", 			\
+			CONST_DOUBLE_HIGH (XV), CONST_DOUBLE_LOW (XV));	\
+	      }								\
+	  }								\
+	break;								\
+      case CONST:							\
+	if (GET_CODE (XEXP (XV, 0)) == PLUS				\
+	   && GET_CODE (XEXP (XEXP (XV, 0), 0)) == SYMBOL_REF)		\
+	  {								\
+	    mvs_page_lit += 4;						\
+	    if (SYMBOL_REF_EXTERNAL_P (XEXP (XEXP (XV, 0), 0)))		\
+	      {								\
+		fprintf (FILE, "=V(");					\
+		ASM_OUTPUT_LABELREF (FILE,				\
+				  XSTR (XEXP (XEXP (XV, 0), 0), 0));	\
+		fprintf (FILE, ")\n\tA\t%s,=F'" HOST_WIDE_INT_PRINT_DEC "'", \
+			 curreg, INTVAL (XEXP (XEXP (XV, 0), 1)));	\
+	      }								\
+	    else							\
+	      {								\
+		fprintf (FILE, "=A(");					\
+		output_addr_const (FILE, XV);				\
+		fprintf (FILE, ")");					\
+	      }								\
+	  }								\
+	else								\
+	  {								\
+	    mvs_page_lit += 4;						\
+	    fprintf (FILE, "=F'");					\
+	    output_addr_const (FILE, XV);				\
+	    fprintf (FILE, "'");					\
+	  }								\
+	break;								\
+      default:								\
+	abort();							\
+    }									\
+}
+
+#define PRINT_OPERAND_ADDRESS(FILE, ADDR)				\
+{									\
+  rtx breg, xreg, offset, plus;						\
+  									\
+  switch (GET_CODE (ADDR))						\
+    {									\
+      case REG:								\
+	fprintf (FILE, "0(%s)", reg_names[REGNO (ADDR)]);		\
+	break;								\
+      case PLUS:							\
+	breg = 0;							\
+	xreg = 0;							\
+	offset = 0;							\
+	if (GET_CODE (XEXP (ADDR, 0)) == PLUS)				\
+	  {								\
+	    if (GET_CODE (XEXP (ADDR, 1)) == REG)			\
+	      breg = XEXP (ADDR, 1);					\
+	    else							\
+	      offset = XEXP (ADDR, 1);					\
+	    plus = XEXP (ADDR, 0);					\
+	  }								\
+	else								\
+	  {								\
+	    if (GET_CODE (XEXP (ADDR, 0)) == REG)			\
+	      breg = XEXP (ADDR, 0);					\
+	    else							\
+	      offset = XEXP (ADDR, 0);					\
+	    plus = XEXP (ADDR, 1);					\
+	  }								\
+	if (GET_CODE (plus) == PLUS)					\
+	  {								\
+	    if (GET_CODE (XEXP (plus, 0)) == REG)			\
+	      {								\
+		if (breg)						\
+		  xreg = XEXP (plus, 0);				\
+		else							\
+		  breg = XEXP (plus, 0);				\
+	      }								\
+	    else							\
+	      {								\
+		offset = XEXP (plus, 0);				\
+	      }								\
+	    if (GET_CODE (XEXP (plus, 1)) == REG)			\
+	      {								\
+		if (breg)						\
+		  xreg = XEXP (plus, 1);				\
+		else							\
+		  breg = XEXP (plus, 1);				\
+	      }								\
+	    else							\
+	      {								\
+		offset = XEXP (plus, 1);				\
+	      }								\
+	  }								\
+	else if (GET_CODE (plus) == REG)				\
+	  {								\
+	    if (breg)							\
+	      xreg = plus;						\
+	    else							\
+	      breg = plus;						\
+	  }								\
+	else								\
+	  {								\
+	    offset = plus;						\
+	  }								\
+	if (offset)							\
+	  {								\
+	    if (GET_CODE (offset) == LABEL_REF)				\
+	      fprintf (FILE, "L%d",					\
+			CODE_LABEL_NUMBER (XEXP (offset, 0)));		\
+	    else							\
+	      output_addr_const (FILE, offset);				\
+	  }								\
+	else								\
+	  fprintf (FILE, "0");						\
+	if (xreg)							\
+	    fprintf (FILE, "(%s,%s)",					\
+		    reg_names[REGNO (xreg)], reg_names[REGNO (breg)]); 	\
+	else								\
+	  fprintf (FILE, "(%s)", reg_names[REGNO (breg)]);		\
+	break;								\
+      default:								\
+	mvs_page_lit += 4;						\
+	if (SYMBOL_REF_EXTERNAL_P (ADDR)) fprintf (FILE, "=V(");	\
+	else                        fprintf (FILE, "=A(");		\
+	output_addr_const (FILE, ADDR);					\
+	fprintf (FILE, ")");						\
+	break;								\
+    }									\
+}
+
+#define ASM_DECLARE_FUNCTION_NAME(FILE, NAME, DECL)			\
+{									\
+  if (strlen (NAME) + 1 > mvs_function_name_length)			\
+    {									\
+      if (mvs_function_name)						\
+	free (mvs_function_name);					\
+      mvs_function_name = 0;						\
+    }									\
+  if (!mvs_function_name)						\
+    {									\
+      mvs_function_name_length = strlen (NAME) * 2 + 1;			\
+      mvs_function_name = (char *) xmalloc (mvs_function_name_length);	\
+    }									\
+  if (!strcmp (NAME, "main"))						\
+    strcpy (mvs_function_name, "gccmain");				\
+  else									\
+    strcpy (mvs_function_name, NAME);					\
+  fprintf (FILE, "\tDS\t0F\n");						\
+  assemble_name (FILE, mvs_function_name);				\
+  fputs ("\tRMODE\tANY\n", FILE);					\
+  assemble_name (FILE, mvs_function_name);				\
+  fputs ("\tCSECT\n", FILE);						\
+}
+
+/* Output assembler code to FILE to increment profiler label # LABELNO
+   for profiling a function entry.  */
+
+#define FUNCTION_PROFILER(FILE, LABELNO) 				\
+  fprintf (FILE, "Error: No profiling available.\n")
+
+#endif /* TARGET_HLASM */
+
+/* ======================================================== */
+
+#ifdef TARGET_ELF_ABI 
+
+/* How to refer to registers in assembler output.  This sequence is
+   indexed by compiler's hard-register-number (see above).  */
+
+#define REGISTER_NAMES							\
+{ "r0",  "r1",  "r2",  "r3",  "r4",  "r5",  "r6",  "r7",		\
+  "r8",  "r9", "r10", "r11", "r12", "r13", "r14", "r15",		\
+  "f0",  "f2",  "f4",  "f6"						\
+}
+
+/* Print operand XV (an rtx) in assembler syntax to file FILE.
+   CODE is a letter or dot (`z' in `%z0') or 0 if no letter was specified.
+   For `%' followed by punctuation, CODE is the punctuation and XV is null.  */
+
+#define PRINT_OPERAND(FILE, XV, CODE)					\
+{									\
+  switch (GET_CODE (XV))						\
+    {									\
+      static char curreg[4];						\
+      case REG:								\
+	if (CODE == 'N')						\
+	    strcpy (curreg, reg_names[REGNO (XV) + 1]);			\
+	else								\
+	    strcpy (curreg, reg_names[REGNO (XV)]);			\
+	fprintf (FILE, "%s", curreg);					\
+	break;								\
+      case MEM:								\
+	{								\
+	  rtx addr = XEXP (XV, 0);					\
+	  if (CODE == 'O')						\
+	    {								\
+	      if (GET_CODE (addr) == PLUS)				\
+		fprintf (FILE, HOST_WIDE_INT_PRINT_DEC, INTVAL (XEXP (addr, 1))); \
+	      else							\
+		fprintf (FILE, "0");					\
+	    }								\
+	  else if (CODE == 'R')						\
+	    {								\
+	      if (GET_CODE (addr) == PLUS)				\
+		fprintf (FILE, "%s", reg_names[REGNO (XEXP (addr, 0))]);\
+	      else							\
+		fprintf (FILE, "%s", reg_names[REGNO (addr)]);		\
+	    }								\
+	  else								\
+	    output_address (XEXP (XV, 0));				\
+	}								\
+	break;								\
+      case SYMBOL_REF:							\
+      case LABEL_REF:							\
+	mvs_page_lit += 4;						\
+        if (SYMBOL_REF_EXTERNAL_P (XV)) fprintf (FILE, "=V(");		\
+        else                      fprintf (FILE, "=A(");                \
+        output_addr_const (FILE, XV);                                   \
+        fprintf (FILE, ")");                                            \
+	break;								\
+      case CONST_INT:					        	\
+	if (CODE == 'B')						\
+	  fprintf (FILE, "%d", (int) (INTVAL (XV) & 0xff));		\
+	else if (CODE == 'X')						\
+	  fprintf (FILE, "%02X", (int) (INTVAL (XV) & 0xff));		\
+	else if (CODE == 'h')						\
+	  fprintf (FILE, HOST_WIDE_INT_PRINT_DEC, (INTVAL (XV) << 16) >> 16); \
+	else if (CODE == 'H')						\
+	  {								\
+	    mvs_page_lit += 2;						\
+	    fprintf (FILE, "=H'" HOST_WIDE_INT_PRINT_DEC "'",		\
+		     (INTVAL (XV) << 16) >> 16);			\
+	  }								\
+	else if (CODE == 'K')						\
+	  {								\
+            /* auto sign-extension of signed 16-bit to signed 32-bit */	\
+	    mvs_page_lit += 4;						\
+	    fprintf (FILE, "=F'" HOST_WIDE_INT_PRINT_DEC "'",		\
+		     (INTVAL (XV) << 16) >> 16);			\
+	  }								\
+	else if (CODE == 'W')						\
+	  {								\
+            /* hand-built sign-extension of signed 32-bit to 64-bit */	\
+	    mvs_page_lit += 8;						\
+	    if (0 <=  INTVAL (XV)) {					\
+	       fprintf (FILE, "=XL8'00000000");				\
+            } else {							\
+	       fprintf (FILE, "=XL8'FFFFFFFF");				\
+            }								\
+	    fprintf (FILE, "%08X'", INTVAL (XV));			\
+	  }								\
+	else								\
+	  {								\
+	    mvs_page_lit += 4;						\
+	    fprintf (FILE, "=F'" HOST_WIDE_INT_PRINT_DEC "'", INTVAL (XV)); \
+	  }								\
+	break;								\
+      case CONST_DOUBLE:						\
+	if (GET_MODE (XV) == DImode)					\
+	  {								\
+	    if (CODE == 'M')						\
+	      {								\
+		mvs_page_lit += 4;					\
+		fprintf (FILE, "=XL4'%08X'", CONST_DOUBLE_LOW (XV));	\
+	      }								\
+	    else if (CODE == 'L')					\
+	      {								\
+		mvs_page_lit += 4;					\
+		fprintf (FILE, "=XL4'%08X'", CONST_DOUBLE_HIGH (XV));	\
+	      }								\
+	    else							\
+	      {								\
+		mvs_page_lit += 8;					\
+		fprintf (FILE, "=yyyyXL8'%08X%08X'", 			\
+			CONST_DOUBLE_HIGH (XV), CONST_DOUBLE_LOW (XV));	\
+	      }								\
+	  }								\
+	else								\
+	  { 								\
+            char buf[50];						\
+	    if (GET_MODE (XV) == SFmode)				\
+	      {								\
+		mvs_page_lit += 4;					\
+		real_to_decimal (buf, CONST_DOUBLE_REAL_VALUE (XV),	\
+				 sizeof (buf), 0, 1);			\
+		fprintf (FILE, "=E'%s'", buf);				\
+	      }								\
+	    else if (GET_MODE (XV) == DFmode)				\
+	      {								\
+		mvs_page_lit += 8;					\
+		real_to_decimal (buf, CONST_DOUBLE_REAL_VALUE (XV),	\
+				 sizeof (buf), 0, 1);			\
+		fprintf (FILE, "=D'%s'", buf);				\
+	      }								\
+	    else /* VOIDmode */						\
+	      {								\
+		mvs_page_lit += 8;					\
+		fprintf (FILE, "=XL8'%08X%08X'", 			\
+			CONST_DOUBLE_HIGH (XV), CONST_DOUBLE_LOW (XV));	\
+	      }								\
+	  }								\
+	break;								\
+      case CONST:							\
+	if (GET_CODE (XEXP (XV, 0)) == PLUS				\
+	   && GET_CODE (XEXP (XEXP (XV, 0), 0)) == SYMBOL_REF)		\
+	  {								\
+	    mvs_page_lit += 4;						\
+	    if (SYMBOL_REF_EXTERNAL_P (XEXP (XEXP (XV, 0), 0)))		\
+	      {								\
+		fprintf (FILE, "=V(");					\
+		ASM_OUTPUT_LABELREF (FILE,				\
+				  XSTR (XEXP (XEXP (XV, 0), 0), 0));	\
+		fprintf (FILE, ")\n\tA\t%s,=F'" HOST_WIDE_INT_PRINT_DEC "'", \
+			 curreg, INTVAL (XEXP (XEXP (XV, 0), 1)));	\
+	      }								\
+	    else							\
+	      {								\
+		fprintf (FILE, "=A(");					\
+		output_addr_const (FILE, XV);				\
+		fprintf (FILE, ")");					\
+	      }								\
+	  }								\
+	else								\
+	  {								\
+	    mvs_page_lit += 4;						\
+	    fprintf (FILE, "=bogus_bad_F'");				\
+	    output_addr_const (FILE, XV);				\
+	    fprintf (FILE, "'");					\
+/* XXX hack alert this gets gen'd in -fPIC code in relation to a tablejump */  \
+/* but its somehow fundamentally broken, I can't make any sense out of it */  \
+debug_rtx (XV); \
+abort(); \
+	  }								\
+	break;								\
+      default:								\
+	abort();							\
+    }									\
+}
+
+#define PRINT_OPERAND_ADDRESS(FILE, ADDR)				\
+{									\
+  rtx breg, xreg, offset, plus;						\
+  									\
+  switch (GET_CODE (ADDR))						\
+    {									\
+      case REG:								\
+	fprintf (FILE, "0(%s)", reg_names[REGNO (ADDR)]);		\
+	break;								\
+      case PLUS:							\
+	breg = 0;							\
+	xreg = 0;							\
+	offset = 0;							\
+	if (GET_CODE (XEXP (ADDR, 0)) == PLUS)				\
+	  {								\
+	    if (GET_CODE (XEXP (ADDR, 1)) == REG)			\
+	      breg = XEXP (ADDR, 1);					\
+	    else							\
+	      offset = XEXP (ADDR, 1);					\
+	    plus = XEXP (ADDR, 0);					\
+	  }								\
+	else								\
+	  {								\
+	    if (GET_CODE (XEXP (ADDR, 0)) == REG)			\
+	      breg = XEXP (ADDR, 0);					\
+	    else							\
+	      offset = XEXP (ADDR, 0);					\
+	    plus = XEXP (ADDR, 1);					\
+	  }								\
+	if (GET_CODE (plus) == PLUS)					\
+	  {								\
+	    if (GET_CODE (XEXP (plus, 0)) == REG)			\
+	      {								\
+		if (breg)						\
+		  xreg = XEXP (plus, 0);				\
+		else							\
+		  breg = XEXP (plus, 0);				\
+	      }								\
+	    else							\
+	      {								\
+		offset = XEXP (plus, 0);				\
+	      }								\
+	    if (GET_CODE (XEXP (plus, 1)) == REG)			\
+	      {								\
+		if (breg)						\
+		  xreg = XEXP (plus, 1);				\
+		else							\
+		  breg = XEXP (plus, 1);				\
+	      }								\
+	    else							\
+	      {								\
+		offset = XEXP (plus, 1);				\
+	      }								\
+	  }								\
+	else if (GET_CODE (plus) == REG)				\
+	  {								\
+	    if (breg)							\
+	      xreg = plus;						\
+	    else							\
+	      breg = plus;						\
+	  }								\
+	else								\
+	  {								\
+	    offset = plus;						\
+	  }								\
+	if (offset)							\
+	  {								\
+	    if (GET_CODE (offset) == LABEL_REF)				\
+	      fprintf (FILE, "L%d",					\
+			CODE_LABEL_NUMBER (XEXP (offset, 0)));		\
+	    else							\
+	      output_addr_const (FILE, offset);				\
+	  }								\
+	else								\
+	  fprintf (FILE, "0");						\
+	if (xreg)							\
+	    fprintf (FILE, "(%s,%s)",					\
+		    reg_names[REGNO (xreg)], reg_names[REGNO (breg)]); 	\
+	else								\
+	  fprintf (FILE, "(%s)", reg_names[REGNO (breg)]);		\
+	break;								\
+      default:								\
+	mvs_page_lit += 4;						\
+	if (SYMBOL_REF_EXTERNAL_P (ADDR)) fprintf (FILE, "=V(");	\
+	else                        fprintf (FILE, "=A(");		\
+	output_addr_const (FILE, ADDR);					\
+	fprintf (FILE, ")");						\
+	break;								\
+    }									\
+}
+
+/* Output assembler code to FILE to increment profiler label # LABELNO
+   for profiling a function entry.  */
+/* Make it a no-op for now, so we can at least compile glibc */
+#define FUNCTION_PROFILER(FILE, LABELNO)  {				\
+  mvs_check_page (FILE, 24, 4);						\
+     fprintf (FILE, "\tSTM\tr1,r2,%d(sp)\n", STACK_POINTER_OFFSET-8);	\
+     fprintf (FILE, "\tLA\tr1,1(0,0)\n"); 				\
+     fprintf (FILE, "\tL\tr2,=A(.LP%d)\n", LABELNO);			\
+     fprintf (FILE, "\tA\tr1,0(r2)\n");			 		\
+     fprintf (FILE, "\tST\tr1,0(r2)\n");		 		\
+     fprintf (FILE, "\tLM\tr1,r2,%d(sp)\n", STACK_POINTER_OFFSET-8);	\
+}
+
+/* Don't bother to output .extern pseudo-ops.  They are not needed by
+   ELF assemblers.  */
+
+#undef ASM_OUTPUT_EXTERNAL
+
+#define ASM_DOUBLE "\t.double"     
+
+/* #define ASM_OUTPUT_LABELREF(FILE, NAME) */	/* use gas -- defaults.h */
+
+/* let config/svr4.h define this ...
+ *  #define ASM_OUTPUT_CASE_LABEL(FILE, PREFIX, NUM, TABLE)
+ *    fprintf (FILE, "%s%d:\n", PREFIX, NUM)
+ */
+
+/* This is how to output an element of a case-vector that is absolute.  */
+#define ASM_OUTPUT_ADDR_VEC_ELT(FILE, VALUE)  				\
+  mvs_check_page (FILE, 4, 0);						\
+  fprintf (FILE, "\t.long\t.L%d\n", VALUE)
+
+/* This is how to output an element of a case-vector that is relative.  */
+#define ASM_OUTPUT_ADDR_DIFF_ELT(FILE, BODY, VALUE, REL) 		\
+  mvs_check_page (FILE, 4, 0);						\
+  fprintf (FILE, "\t.long\t.L%d-.L%d\n", VALUE, REL)
+
+/* Right now, PUSH & POP are used only when profiling is enabled, 
+   and then, only to push the static chain reg and the function struct 
+   value reg, and only if those are used by the function being profiled.
+   We don't need this for profiling, so punt.  */
+#define ASM_OUTPUT_REG_PUSH(FILE, REGNO) 
+#define ASM_OUTPUT_REG_POP(FILE, REGNO)	
+
+
+/* Indicate that jump tables go in the text section.  This is
+   necessary when compiling PIC code.  */
+#define JUMP_TABLES_IN_TEXT_SECTION 1
+
+/* Define macro used to output shift-double opcodes when the shift
+   count is in %cl.  Some assemblers require %cl as an argument;
+   some don't.
+
+   GAS requires the %cl argument, so override i386/unix.h.  */
+
+#undef SHIFT_DOUBLE_OMITS_COUNT
+#define SHIFT_DOUBLE_OMITS_COUNT 0
+
+/* Implicit library calls should use memcpy, not bcopy, etc.  */
+#define TARGET_MEM_FUNCTIONS
+ 
+/* Output before read-only data.  */
+#define TEXT_SECTION_ASM_OP "\t.text"
+
+/* Output before writable (initialized) data.  */
+#define DATA_SECTION_ASM_OP "\t.data"
+
+/* Output before writable (uninitialized) data.  */
+#define BSS_SECTION_ASM_OP "\t.bss"
+
+/* In the past there was confusion as to what the argument to .align was
+   in GAS.  For the last several years the rule has been this: for a.out
+   file formats that argument is LOG, and for all other file formats the
+   argument is 1<<LOG.
+
+   However, GAS now has .p2align and .balign pseudo-ops so to remove any
+   doubt or guess work, and since this file is used for both a.out and other
+   file formats, we use one of them.  */
+
+#define ASM_OUTPUT_ALIGN(FILE,LOG) \
+  if ((LOG)!=0) fprintf ((FILE), "\t.balign %d\n", 1<<(LOG))
+ 
+/* Globalizing directive for a label.  */
+#define GLOBAL_ASM_OP ".globl "
+
+/* This says how to output an assembler line
+   to define a global common symbol.  */
+
+#define ASM_OUTPUT_COMMON(FILE, NAME, SIZE, ROUNDED)  \
+( fputs (".comm ", (FILE)),                     \
+  assemble_name ((FILE), (NAME)),               \
+  fprintf ((FILE), ","HOST_WIDE_INT_PRINT_UNSIGNED"\n", (ROUNDED)))
+
+/* This says how to output an assembler line
+   to define a local common symbol.  */
+
+#define ASM_OUTPUT_LOCAL(FILE, NAME, SIZE, ROUNDED)  \
+( fputs (".lcomm ", (FILE)),                    \
+  assemble_name ((FILE), (NAME)),               \
+  fprintf ((FILE), ","HOST_WIDE_INT_PRINT_UNSIGNED"\n", (ROUNDED)))
+
+#endif /* TARGET_ELF_ABI */
+#endif /* ! GCC_I370_H */
diff --git a/gcc/config/i370/i370.md b/gcc/config/i370/i370.md
new file mode 100644
index 00000000000..342b6e8727e
--- /dev/null
+++ b/gcc/config/i370/i370.md
@@ -0,0 +1,4739 @@
+;;- Machine description for GNU compiler -- System/370 version.
+;;  Copyright (C) 1989, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2002
+;;  Free Software Foundation, Inc.
+;;  Contributed by Jan Stein (jan@cd.chalmers.se).
+;;  Modified for OS/390 LanguageEnvironment C by Dave Pitts (dpitts@cozx.com)
+;;  Lots of Bug Fixes & Enhancements by Linas Vepstas (linas@linas.org)
+
+;; This file is part of GCC.
+
+;; GCC is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GCC is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GCC; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;; =======================================================================
+;; Condition codes for some of the instructions (in particular, for 
+;; add, sub, shift, abs, etc. are handled with the cpp macro NOTICE_UPDATE_CC 
+;;
+;; Special constraints for 370 machine description:
+;;
+;;    a -- Any address register from 1 to 15.
+;;    d -- Any register from 0 to 15.
+;;    I -- An 8-bit constant (0..255).
+;;    J -- A 12-bit constant (0..4095).
+;;    K -- A 16-bit constant (-32768..32767).
+;;    R -- a valid S operand in an RS, SI or SS instruction, or register
+;;    S -- a valid S operand in an RS, SI or SS instruction
+;;
+;; Note this well: 
+;; When defining an instruction, e.g. the movsi pattern:
+;; 
+;;    (define_insn ""
+;;        [(set (match_operand:SI 0 "r_or_s_operand" "=dm,d,dm")
+;;            (match_operand:SI 1 "r_or_s_operand" "diR,dim,*fF"))]
+;;
+;; The "r_or_s_operand" predicate is used to recognize the instruction;
+;; however, it is not further used to enforce a constraint at later stages.
+;; Thus, for example, although "r_or_s_operand" bars operands of the form
+;; base+index+displacement, such operands can none-the-less show up during
+;; post-instruction-recog processing: thus, for example, garbage like
+;; MVC     152(4,r13),0(r5,r13) might be generated if both op0 and op1 are 
+;; mem operands.   To avoid this, use the S constraint.
+;; 
+;;
+;; Special formats used for outputting 370 instructions.
+;;
+;;   %B -- Print a constant byte integer.
+;;   %H -- Print a signed 16-bit constant.
+;;   %K -- Print a signed 16-bit constant signed-extended to 32-bits.
+;;   %L -- Print least significant word of a CONST_DOUBLE.
+;;   %M -- Print most significant word of a CONST_DOUBLE.
+;;   %N -- Print next register (second word of a DImode reg).
+;;   %O -- Print the offset of a memory reference (PLUS (REG) (CONST_INT)).
+;;   %R -- Print the register of a memory reference (PLUS (REG) (CONST_INT)).
+;;   %X -- Print a constant byte integer in hex.
+;;   %W -- Print a signed 32-bit int sign-extended to 64-bits.
+;;
+;; We have a special constraint for pattern matching.
+;;
+;;   s_operand -- Matches a valid S operand in a RS, SI or SS type instruction.
+;;
+;;   r_or_s_operand -- Matches a register or a valid S operand in a RS, SI
+;;		       or SS type instruction or a register
+;;
+;; For MVS C/370 we use the following stack locations for:
+;;
+;;   136 - internal function result buffer
+;;   140 - numeric conversion buffer
+;;   144 - pointer to internal function result buffer
+;;   148 - start of automatic variables and function arguments
+;;
+;; To support programs larger than a page, 4096 bytes, PAGE_REGISTER points
+;; to a page origin table, all internal labels are generated to reload the
+;; BASE_REGISTER knowing what page it is on and all branch instructions go
+;; directly to the target if it is known that the target is on the current
+;; page (essentially backward references).  All forward references and off
+;; page references are handled by loading the address of target into a
+;; register and branching indirectly.
+;;
+;; Some *di patterns have been commented out per advice from RMS, as gcc
+;; will generate the right things to do.
+;;
+;; See the note in i370.h about register 14, clobbering it, and optimization.
+;; Basically, using clobber in egcs-1.1.1 will ruin ability to optimize around
+;; branches, so don't do it.
+;;
+;; We use the "length" attirbute to store the max possible code size of an
+;; insn.  We use this length to estimate the length of forward branches, to
+;; determine if they're on page or off.
+
+(define_attr "length" "" (const_int 0))
+
+;;
+;;- Test instructions.
+;;
+
+;
+; tstdi instruction pattern(s).
+;
+
+(define_insn "tstdi"
+  [(set (cc0)
+	(match_operand:DI 0 "register_operand" "d"))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  return \"SRDA	%0,0\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; tstsi instruction pattern(s).
+;
+
+(define_insn "tstsi"
+  [(set (cc0)
+	(match_operand:SI 0 "register_operand" "d"))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 2, 0);
+  return \"LTR	%0,%0\";
+}"
+   [(set_attr "length" "2")]
+)
+
+;
+; tsthi instruction pattern(s).
+;
+
+(define_insn "tsthi"
+  [(set (cc0)
+	(match_operand:HI 0 "register_operand" "d"))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 2);
+  return \"CH	%0,=H'0'\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; tstqi instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (cc0)
+	(match_operand:QI 0 "r_or_s_operand" "dm"))]
+  "unsigned_jump_follows_p (insn)"
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      /* an unsigned compare to zero is always zero/not-zero...  */
+      mvs_check_page (0, 4, 4);
+      return \"N	%0,=XL4'000000FF'\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"CLI	%0,0\";
+}"
+   [(set_attr "length" "4")]
+)
+
+(define_insn "tstqi"
+  [(set (cc0)
+     (match_operand:QI 0 "register_operand" "d"))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (unsigned_jump_follows_p (insn))
+    {
+      /* an unsigned compare to zero is always zero/not-zero...  */
+      mvs_check_page (0, 4, 4);
+      return \"N	%0,=XL4'000000FF'\";
+    }
+  mvs_check_page (0, 8, 0);
+  return \"SLL	%0,24\;SRA	%0,24\";
+}"
+   [(set_attr "length" "8")]
+)
+
+;
+; tstdf instruction pattern(s).
+;
+
+(define_insn "tstdf"
+  [(set (cc0)
+	(match_operand:DF 0 "general_operand" "f"))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 2, 0);
+  return \"LTDR	%0,%0\";
+}"
+   [(set_attr "length" "2")]
+)
+
+;
+; tstsf instruction pattern(s).
+;
+
+(define_insn "tstsf"
+  [(set (cc0)
+	(match_operand:SF 0 "general_operand" "f"))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 2, 0);
+  return \"LTER	%0,%0\";
+}"
+   [(set_attr "length" "2")]
+)
+
+;;
+;;- Compare instructions.
+;;
+
+;
+; cmpdi instruction pattern(s).
+;
+
+;(define_insn "cmpdi"
+;  [(set (cc0)
+;	(compare (match_operand:DI 0 "register_operand" "d")
+;		 (match_operand:DI 1 "general_operand" "")))]
+;  ""
+;  "*
+;{
+;  check_label_emit ();
+;  if (REG_P (operands[1]))
+;    {
+;      mvs_check_page (0, 8, 0);
+;      if (unsigned_jump_follows_p (insn))
+;        return \"CLR	%0,%1\;BNE	*+6\;CLR	%N0,%N1\";
+;      return \"CR	%0,%1\;BNE	*+6\;CLR	%N0,%N1\";
+;    }
+;  mvs_check_page (0, 12, 0);
+;  if (unsigned_jump_follows_p (insn))
+;    return \"CL	%0,%M1\;BNE	*+8\;CL	%N0,%L1\";
+;  return \"C	%0,%M1\;BNE	*+8\;CL	%N0,%L1\";
+;}")
+
+;
+; cmpsi instruction pattern(s).
+;
+
+(define_insn "cmpsi"
+  [(set (cc0)
+	(compare (match_operand:SI 0 "register_operand" "d")
+		 (match_operand:SI 1 "general_operand" "md")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[1]))
+    {
+      mvs_check_page (0, 2, 0);
+      if (unsigned_jump_follows_p (insn))
+	return \"CLR	%0,%1\";
+      return \"CR	%0,%1\";
+    }
+  if (GET_CODE (operands[1]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 4);
+      if (unsigned_jump_follows_p (insn))
+	 return \"CL	%0,=F'%c1'\";
+      return \"C	%0,=F'%c1'\";
+    }
+  mvs_check_page (0, 4, 0);
+  if (unsigned_jump_follows_p (insn))
+    return \"CL	%0,%1\";
+  return \"C	%0,%1\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; cmphi instruction pattern(s).
+;
+
+; deprecate constraint d because it takes multiple instructions
+; and a memeory access ...
+(define_insn "cmphi"
+  [(set (cc0)
+	(compare (match_operand:HI 0 "register_operand" "d")
+		 (match_operand:HI 1 "general_operand" "???dim")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[1]))
+    {
+      mvs_check_page (0, 8, 0);
+      if (unsigned_jump_follows_p (insn))
+	return \"STH	%1,140(,13)\;CLM	%0,3,140(13)\";
+      return \"STH	%1,140(,13)\;CH	%0,140(,13)\";
+    }
+  if (GET_CODE (operands[1]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 0);
+      return \"CH	%0,%H1\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"CH	%0,%1\";
+}"
+   [(set_attr "length" "8")]
+)
+
+;
+; cmpqi instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (cc0)
+	(compare (match_operand:QI 0 "r_or_s_operand" "dS")
+		 (match_operand:QI 1 "r_or_s_operand" "diS")))]
+  "unsigned_jump_follows_p (insn)"
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 8, 0);
+          return \"STC	%1,140(,13)\;CLM	%0,1,140(13)\";
+        }
+      if (GET_CODE (operands[1]) == CONST_INT)
+	{
+	  mvs_check_page (0, 4, 1);
+          return \"CLM	%0,1,=XL1'%X1'\";
+        }
+      mvs_check_page (0, 4, 0);
+      return \"CLM	%0,1,%1\";
+    }
+  else if (GET_CODE (operands[0]) == CONST_INT)
+    {
+      cc_status.flags |= CC_REVERSED;
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 4, 1);
+          return \"CLM	%1,1,=XL1'%X0'\";
+        }
+      mvs_check_page (0, 4, 0);
+      return \"CLI	%1,%B0\";
+    }
+  if (GET_CODE (operands[1]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 0);
+      return \"CLI	%0,%B1\";
+    }
+  if (GET_CODE (operands[1]) == MEM)
+    {
+      mvs_check_page (0, 6, 0);
+      return \"CLC	%O0(1,%R0),%1\";
+    }
+  cc_status.flags |= CC_REVERSED;
+  mvs_check_page (0, 4, 0);
+  return \"CLM	%1,1,%0\";
+}"
+   [(set_attr "length" "8")]
+)
+
+(define_insn "cmpqi"
+  [(set (cc0)
+	(compare (match_operand:QI 0 "register_operand" "d")
+		 (match_operand:QI 1 "general_operand" "di")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (unsigned_jump_follows_p (insn))
+    {
+      if (GET_CODE (operands[1]) == CONST_INT)
+	{
+	  mvs_check_page (0, 4, 1);
+          return \"CLM	%0,1,=XL1'%X1'\";
+        }
+      if (!(REG_P (operands[1])))
+	{
+	  mvs_check_page (0, 4, 0);
+          return \"CLM	%0,1,%1\";
+        }
+      mvs_check_page (0, 8, 0);
+      return \"STC	%1,140(,13)\;CLM	%0,1,140(13)\";
+    }
+  if (REG_P (operands[1]))
+    {
+      mvs_check_page (0, 18, 0);
+      return \"SLL	%0,24\;SRA	%0,24\;SLL	%1,24\;SRA	%1,24\;CR	%0,%1\";
+    }
+  mvs_check_page (0, 12, 0);
+  return \"SLL	%0,24\;SRA	%0,24\;C	%0,%1\";
+}"
+   [(set_attr "length" "18")]
+)
+
+;
+; cmpdf instruction pattern(s).
+;
+
+(define_insn "cmpdf"
+  [(set (cc0)
+	(compare (match_operand:DF 0 "general_operand" "f,mF")
+		 (match_operand:DF 1 "general_operand" "fmF,f")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (FP_REG_P (operands[0]))
+    {
+      if (FP_REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 2, 0);
+	  return \"CDR	%0,%1\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"CD	%0,%1\";
+    }
+  cc_status.flags |= CC_REVERSED;
+  mvs_check_page (0, 4, 0);
+  return \"CD	%1,%0\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; cmpsf instruction pattern(s).
+;
+
+(define_insn "cmpsf"
+  [(set (cc0)
+	(compare (match_operand:SF 0 "general_operand" "f,mF")
+		 (match_operand:SF 1 "general_operand" "fmF,f")))]
+  ""
+  "*
+{
+check_label_emit ();
+  if (FP_REG_P (operands[0]))
+    {
+      if (FP_REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 2, 0);
+	  return \"CER	%0,%1\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"CE	%0,%1\";
+    }
+  cc_status.flags |= CC_REVERSED;
+  mvs_check_page (0, 4, 0);
+  return \"CE	%1,%0\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; cmpmemsi instruction pattern(s).
+;
+
+(define_expand "cmpmemsi"
+  [(set (match_operand:SI 0 "general_operand" "")
+	  (compare (match_operand:BLK 1 "general_operand" "")
+		   (match_operand:BLK 2 "general_operand" "")))
+     (use (match_operand:SI 3 "general_operand" ""))
+     (use (match_operand:SI 4 "" ""))]
+   ""
+   "
+{
+  rtx op1, op2;
+
+  op1 = XEXP (operands[1], 0);
+  if (GET_CODE (op1) == REG
+      || (GET_CODE (op1) == PLUS && GET_CODE (XEXP (op1, 0)) == REG
+	  && GET_CODE (XEXP (op1, 1)) == CONST_INT
+	  && (unsigned) INTVAL (XEXP (op1, 1)) < 4096))
+    {
+      op1 = operands[1];
+    }
+  else
+    {
+      op1 = gen_rtx_MEM (BLKmode, copy_to_mode_reg (SImode, op1));
+    }
+
+  op2 = XEXP (operands[2], 0);
+  if (GET_CODE (op2) == REG
+      || (GET_CODE (op2) == PLUS && GET_CODE (XEXP (op2, 0)) == REG
+	  && GET_CODE (XEXP (op2, 1)) == CONST_INT
+	  && (unsigned) INTVAL (XEXP (op2, 1)) < 4096))
+    {
+      op2 = operands[2];
+    }
+  else
+    {
+      op2 = gen_rtx_MEM (BLKmode, copy_to_mode_reg (SImode, op2));
+    }
+      
+  if (GET_CODE (operands[3]) == CONST_INT && INTVAL (operands[3]) < 256)
+    {
+      emit_insn (gen_rtx_PARALLEL (VOIDmode, gen_rtvec (2,
+		gen_rtx_SET (VOIDmode, operands[0], 
+			gen_rtx_COMPARE (VOIDmode, op1, op2)),
+		gen_rtx_USE (VOIDmode, operands[3]))));
+    }
+  else
+    {
+        /* implementation suggested by  Richard Henderson <rth@cygnus.com> */
+        rtx reg1 = gen_reg_rtx (DImode);
+        rtx reg2 = gen_reg_rtx (DImode);
+        rtx result = operands[0];
+        rtx mem1 = operands[1];
+        rtx mem2 = operands[2];
+        rtx len = operands[3];
+        if (!CONSTANT_P (len))
+          len = force_reg (SImode, len);
+
+        /* Load up the address+length pairs.  */
+        emit_insn (gen_rtx_CLOBBER (VOIDmode, reg1));
+        emit_move_insn (gen_rtx_SUBREG (SImode, reg1, 0),
+                        force_operand (XEXP (mem1, 0), NULL_RTX));
+        emit_move_insn (gen_rtx_SUBREG (SImode, reg1, GET_MODE_SIZE (SImode)), len);
+
+        emit_insn (gen_rtx_CLOBBER (VOIDmode, reg2));
+        emit_move_insn (gen_rtx_SUBREG (SImode, reg2, 0),
+                        force_operand (XEXP (mem2, 0), NULL_RTX));
+        emit_move_insn (gen_rtx_SUBREG (SImode, reg2, GET_MODE_SIZE (SImode)), len);
+
+        /* Compare! */
+        emit_insn (gen_cmpmemsi_1 (result, reg1, reg2));
+    }
+  DONE;
+}")
+
+; Compare a block that is less than 256 bytes in length.
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(compare (match_operand:BLK 1 "s_operand" "m")
+		 (match_operand:BLK 2 "s_operand" "m")))
+   (use (match_operand:QI 3 "immediate_operand" "I"))]
+  "((unsigned) INTVAL (operands[3]) < 256)"
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 22, 0);
+  return \"LA	%0,%1\;CLC	%O1(%c3,%R1),%2\;BH	*+12\;BL	*+6\;SLR	%0,%0\;LNR	%0,%0\";
+}"
+   [(set_attr "length" "22")]
+)
+
+; Compare a block that is larger than 255 bytes in length.
+
+(define_insn "cmpmemsi_1"
+  [(set (match_operand:SI 0 "register_operand" "+d")
+        (compare
+        (mem:BLK (subreg:SI (match_operand:DI 1 "register_operand" "+d") 0))
+        (mem:BLK (subreg:SI (match_operand:DI 2 "register_operand" "+d") 0))))
+   (use (match_dup 1))
+   (use (match_dup 2))
+   (clobber (match_dup 1))
+   (clobber (match_dup 2))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 18, 0);
+  return \"LA	%0,1(0,0)\;CLCL	%1,%2\;BH	*+12\;BL	*+6\;SLR	%0,%0\;LNR	%0,%0\";
+}"
+   [(set_attr "length" "18")]
+)
+
+;;
+;;- Move instructions.
+;;
+
+;
+; movdi instruction pattern(s).
+;
+
+(define_insn ""
+;;  [(set (match_operand:DI 0 "r_or_s_operand" "=dm")
+;;        (match_operand:DI 1 "r_or_s_operand" "dim*fF"))]
+  [(set (match_operand:DI 0 "r_or_s_operand" "=dS,m")
+        (match_operand:DI 1 "r_or_s_operand" "diS*fF,d*fF"))]
+
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      if (FP_REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 8, 0);
+	  return \"STD	%1,140(,13)\;LM	%0,%N0,140(13)\";
+	}
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 4, 0);
+	  return \"LR	%0,%1\;LR	%N0,%N1\";
+	}
+      if (operands[1] == const0_rtx)
+	{
+	  CC_STATUS_INIT;
+	  mvs_check_page (0, 4, 0);
+	  return \"SLR	%0,%0\;SLR	%N0,%N0\";
+	}
+      if (GET_CODE (operands[1]) == CONST_INT
+  	  && (unsigned) INTVAL (operands[1]) < 4096)
+	{
+	  CC_STATUS_INIT;
+	  mvs_check_page (0, 6, 0);
+	  return \"SLR	%0,%0\;LA	%N0,%c1(0,0)\";
+	}
+      if (GET_CODE (operands[1]) == CONST_INT)
+	{
+	  CC_STATUS_SET (operands[0], operands[1]);
+	  mvs_check_page (0, 8, 0);
+	  return \"L	%0,%1\;SRDA	%0,32\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"LM	%0,%N0,%1\";
+    }
+  else if (FP_REG_P (operands[1]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"STD	%1,%0\";
+    }
+  else if (REG_P (operands[1]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"STM	%1,%N1,%0\"; 
+    }
+  mvs_check_page (0, 6, 0);
+  return \"MVC	%O0(8,%R0),%W1\";
+}"
+   [(set_attr "length" "8")]
+)
+
+(define_insn "movdi"
+;;  [(set (match_operand:DI 0 "general_operand" "=d,dm")
+;;	(match_operand:DI 1 "general_operand" "dimF,*fd"))]
+  [(set (match_operand:DI 0 "general_operand" "=d,dm")
+	(match_operand:DI 1 "r_or_s_operand" "diSF,*fd"))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      if (FP_REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 8, 0);
+	  return \"STD	%1,140(,13)\;LM	%0,%N0,140(13)\";
+	}
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 4, 0);
+	  return \"LR	%0,%1\;LR	%N0,%N1\";
+	}
+      if (operands[1] == const0_rtx)
+	{
+	  CC_STATUS_INIT;
+	  mvs_check_page (0, 4, 0);
+	  return \"SLR	%0,%0\;SLR	%N0,%N0\";
+	}
+      if (GET_CODE (operands[1]) == CONST_INT
+  	  && (unsigned) INTVAL (operands[1]) < 4096)
+	{
+	  CC_STATUS_INIT;
+	  mvs_check_page (0, 6, 0);
+	  return \"SLR	%0,%0\;LA	%N0,%c1(0,0)\";
+	}
+      if (GET_CODE (operands[1]) == CONST_INT)
+	{
+	  CC_STATUS_SET (operands[0], operands[1]);
+	  mvs_check_page (0, 8, 0);
+	  return \"L	%0,%1\;SRDA	%0,32\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"LM	%0,%N0,%1\";
+    }
+  else if (FP_REG_P (operands[1]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"STD	%1,%0\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"STM	%1,%N1,%0\";
+}"
+   [(set_attr "length" "8")]
+)
+
+;; we have got to provide a movdi alternative that will go from 
+;; register to memory & back in its full glory.  However, we try to 
+;; discourage its use by listing this alternative last.
+;; The problem is that the instructions above only provide 
+;; S-form style (base + displacement) mem access, while the
+;; below provvides the full (base+index+displacement) RX-form.
+;; These are rarely needed, but when needed they're needed.
+
+(define_insn ""
+  [(set (match_operand:DI 0 "general_operand" "=d,???m")
+        (match_operand:DI 1 "general_operand" "???m,d"))]
+
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      mvs_check_page (0, 8, 0);
+      return \"LM	%0,%N0,%1\";
+    }
+  else if (REG_P (operands[1]))
+    {
+      mvs_check_page (0, 8, 0);
+      return \"STM	%1,%N1,%0\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"MVC	%O0(8,%R0),%1\";
+}"
+   [(set_attr "length" "8")]
+)
+
+;
+; movsi instruction pattern(s).
+;
+
+(define_insn ""
+;;  [(set (match_operand:SI 0 "r_or_s_operand" "=dm,d,dm")
+;;        (match_operand:SI 1 "r_or_s_operand" "diR,dim,*fF"))]
+  [(set (match_operand:SI 0 "r_or_s_operand" "=d,dS,dm")
+        (match_operand:SI 1 "general_operand" "dim,diS,di*fF"))]
+
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      if (FP_REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 8, 0);
+	  return \"STE	%1,140(,13)\;L	%0,140(,13)\";
+	}
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 2, 0);
+	  return \"LR	%0,%1\";
+	}
+      if (operands[1] == const0_rtx)
+	{
+	  CC_STATUS_INIT;
+	  mvs_check_page (0, 2, 0);
+	  return \"SLR	%0,%0\";
+	}
+      if (GET_CODE (operands[1]) == CONST_INT
+ 	  && (unsigned) INTVAL (operands[1]) < 4096)
+	{
+	  mvs_check_page (0, 4, 0);
+	  return \"LA	%0,%c1(0,0)\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"L	%0,%1\";
+    }
+  else if (FP_REG_P (operands[1]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"STE	%1,%0\";
+    }
+  else if (REG_P (operands[1]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"ST	%1,%0\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"MVC	%O0(4,%R0),%1\";
+}"
+   [(set_attr "length" "8")]
+)
+
+(define_insn "movsi"
+  [(set (match_operand:SI 0 "general_operand" "=d,dm")
+	(match_operand:SI 1 "general_operand" "dimF,*fd"))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      if (FP_REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 8, 0);
+	  return \"STE	%1,140(,13)\;L	%0,140(,13)\";
+	}
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 2, 0);
+	  return \"LR	%0,%1\";
+	}
+      if (operands[1] == const0_rtx)
+	{
+	  CC_STATUS_INIT;
+	  mvs_check_page (0, 2, 0);
+	  return \"SLR	%0,%0\";
+	}
+      if (GET_CODE (operands[1]) == CONST_INT
+	  && (unsigned) INTVAL (operands[1]) < 4096)
+	{
+	  mvs_check_page (0, 4, 0);
+	  return \"LA	%0,%c1(0,0)\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"L	%0,%1\";
+    }
+  else if (FP_REG_P (operands[1]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"STE	%1,%0\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"ST	%1,%0\";
+}"
+   [(set_attr "length" "8")]
+)
+
+;(define_expand "movsi"
+;  [(set (match_operand:SI 0 "general_operand" "=d,dm")
+;	(match_operand:SI 1 "general_operand" "dimF,*fd"))]
+;  ""
+;  "
+;{
+;  rtx op0, op1;
+;
+;  op0 = operands[0];
+;  if (GET_CODE (op0) == CONST
+;      && GET_CODE (XEXP (XEXP (op0, 0), 0)) == SYMBOL_REF
+;      && SYMBOL_REF_EXTERNAL_P (XEXP (XEXP (op0, 0), 0)))
+;    {
+;      op0 = gen_rtx_MEM (SImode, copy_to_mode_reg (SImode, XEXP (op0, 0)));
+;    }
+;
+;  op1 = operands[1];
+;  if (GET_CODE (op1) == CONST
+;      && GET_CODE (XEXP (XEXP (op1, 0), 0)) == SYMBOL_REF
+;      && SYMBOL_REF_EXTERNAL_P (XEXP (XEXP (op1, 0), 0)))
+;    {
+;      op1 = gen_rtx_MEM (SImode, copy_to_mode_reg (SImode, XEXP (op1, 0)));
+;    }
+;
+;  emit_insn (gen_rtx_SET (VOIDmode, op0, op1));
+;  DONE;
+;}")
+
+;
+; movhi instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (match_operand:HI 0 "r_or_s_operand" "=g")
+        (match_operand:HI 1 "r_or_s_operand" "g"))]
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 2, 0);
+	  return \"LR	%0,%1\";
+	}
+      if (operands[1] == const0_rtx)
+	{
+	  CC_STATUS_INIT;
+	  mvs_check_page (0, 2, 0);
+	  return \"SLR	%0,%0\";
+	}
+      if (GET_CODE (operands[1]) == CONST_INT
+	  && (unsigned) INTVAL (operands[1]) < 4096)
+	{
+	  mvs_check_page (0, 4, 0);
+	  return \"LA	%0,%c1(0,0)\";
+	}
+      if (GET_CODE (operands[1]) == CONST_INT)
+	{
+	  mvs_check_page (0, 4, 0);
+	  return \"LH	%0,%H1\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"LH	%0,%1\";
+    }
+  else if (REG_P (operands[1]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"STH	%1,%0\";
+    }
+  if (GET_CODE (operands[1]) == CONST_INT)
+    {
+      mvs_check_page (0, 6, 0);
+      return \"MVC	%O0(2,%R0),%H1\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"MVC	%O0(2,%R0),%1\";
+}"
+   [(set_attr "length" "6")]
+)
+
+(define_insn "movhi"
+  [(set (match_operand:HI 0 "general_operand" "=d,m")
+	(match_operand:HI 1 "general_operand" "g,d"))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 2, 0);
+	  return \"LR	%0,%1\";
+	}
+      if (operands[1] == const0_rtx)
+	{
+	  CC_STATUS_INIT;
+	  mvs_check_page (0, 2, 0);
+	  return \"SLR	%0,%0\";
+	}
+      if (GET_CODE (operands[1]) == CONST_INT
+	  && (unsigned) INTVAL (operands[1]) < 4096)
+	{
+	  mvs_check_page (0, 4, 0);
+	  return \"LA	%0,%c1(0,0)\";
+	}
+      if (GET_CODE (operands[1]) == CONST_INT)
+	{
+	  mvs_check_page (0, 4, 0);
+	  return \"LH	%0,%H1\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"LH	%0,%1\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"STH	%1,%0\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; movqi instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (match_operand:QI 0 "r_or_s_operand" "=g")
+	(match_operand:QI 1 "r_or_s_operand" "g"))]
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 2, 0);
+	  return \"LR	%0,%1\";
+	}
+      if (operands[1] == const0_rtx)
+	{
+	  CC_STATUS_INIT;
+	  mvs_check_page (0, 2, 0);
+	  return \"SLR	%0,%0\";
+	}
+      if (GET_CODE (operands[1]) == CONST_INT)
+	{
+	  if ((INTVAL (operands[1]) >= 0)
+  	      && (unsigned) INTVAL (operands[1]) < 4096)
+	    {
+	      mvs_check_page (0, 4, 0);
+	      return \"LA	%0,%c1(0,0)\";
+	    }
+	  mvs_check_page (0, 4, 0);
+	  return \"L	%0,=F'%c1'\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"IC	%0,%1\";
+    }
+  else if (REG_P (operands[1]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"STC	%1,%0\";
+    }
+  else if (GET_CODE (operands[1]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 0);
+      return \"MVI	%0,%B1\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"MVC	%O0(1,%R0),%1\";
+}"
+   [(set_attr "length" "6")]
+)
+
+(define_insn "movqi"
+  [(set (match_operand:QI 0 "general_operand" "=d,m")
+	(match_operand:QI 1 "general_operand" "g,d"))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 2, 0);
+	  return \"LR	%0,%1\";
+	}
+      if (operands[1] == const0_rtx)
+	{
+	  CC_STATUS_INIT;
+	  mvs_check_page (0, 2, 0);
+	  return \"SLR	%0,%0\";
+	}
+      if (GET_CODE (operands[1]) == CONST_INT)
+	{
+	  if ((INTVAL (operands[1]) >= 0)
+  	      && (unsigned) INTVAL (operands[1]) < 4096)
+	    {
+	      mvs_check_page (0, 4, 0);
+	      return \"LA	%0,%c1(0,0)\";
+	    }
+	  mvs_check_page (0, 4, 0);
+	  return \"L	%0,=F'%c1'\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"IC	%0,%1\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"STC	%1,%0\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; movstrictqi instruction pattern(s).
+;
+
+(define_insn "movstrictqi"
+  [(set (strict_low_part (match_operand:QI 0 "general_operand" "+d"))
+	(match_operand:QI 1 "general_operand" "g"))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[1]))
+    {
+      mvs_check_page (0, 8, 0);
+      return \"STC	%1,140(,13)\;IC	%0,140(,13)\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"IC	%0,%1\";
+}"
+   [(set_attr "length" "8")]
+)
+
+;
+; movstricthi instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (strict_low_part (match_operand:HI 0 "register_operand" "+d"))
+	(match_operand:HI 1 "r_or_s_operand" "g"))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[1]))
+    {
+      mvs_check_page (0, 8, 0);
+      return \"STH	%1,140(,13)\;ICM	%0,3,140(13)\";
+    }
+  else if (GET_CODE (operands[1]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 0);
+      return \"ICM	%0,3,%H1\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"ICM	%0,3,%1\";
+}"
+   [(set_attr "length" "8")]
+)
+
+(define_insn "movstricthi"
+  [(set (strict_low_part (match_operand:HI 0 "general_operand" "+dm"))
+	(match_operand:HI 1 "general_operand" "d"))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      mvs_check_page (0, 8, 0);
+      return \"STH	%1,140(,13)\;ICM	%0,3,140(13)\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"STH	%1,%0\";
+}"
+   [(set_attr "length" "8")]
+)
+
+;
+; movdf instruction pattern(s).
+;
+
+(define_insn ""
+;;  [(set (match_operand:DF 0 "r_or_s_operand" "=fm,fm,*dm")
+;;        (match_operand:DF 1 "r_or_s_operand" "fmF,*dm,fmF"))]
+  [(set (match_operand:DF 0 "general_operand" "=f,m,fS,*dS,???d")
+      (match_operand:DF 1 "general_operand" "fmF,fF,*dS,fSF,???d"))]
+
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  if (FP_REG_P (operands[0]))
+    {
+      if (FP_REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 2, 0);
+	  return \"LDR	%0,%1\";
+	}
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 8, 0);
+	  return \"STM	%1,%N1,140(13)\;LD	%0,140(,13)\";
+	}
+      if (operands[1] == const0_rtx)
+	{
+	  CC_STATUS_SET (operands[0], operands[1]);
+	  mvs_check_page (0, 2, 0);
+	  return \"SDR	%0,%0\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"LD	%0,%1\";
+    }
+  if (REG_P (operands[0]))
+    {
+      if (FP_REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 12, 0);
+	  return \"STD	%1,140(,13)\;LM	%0,%N0,140(13)\";
+	}
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 4, 0);
+	  return \"LR	%0,%1\;LR	%N0,%N1\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"LM	%0,%N0,%1\";
+    }
+  else if (FP_REG_P (operands[1]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"STD	%1,%0\";
+    }
+  else if (REG_P (operands[1]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"STM	%1,%N1,%0\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"MVC	%O0(8,%R0),%1\";
+}"
+   [(set_attr "length" "12")]
+)
+
+(define_insn "movdf"
+;;  [(set (match_operand:DF 0 "general_operand" "=f,fm,m,*d")
+;;	(match_operand:DF 1 "general_operand" "fmF,*d,f,fmF"))]
+  [(set (match_operand:DF 0 "general_operand" "=f,m,fS,*d,???d")
+      (match_operand:DF 1 "general_operand" "fmF,f,*d,SfF,???d"))]
+
+  ""
+  "*
+{
+  check_label_emit ();
+  if (FP_REG_P (operands[0]))
+    {
+      if (FP_REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 2, 0);
+	  return \"LDR	%0,%1\";
+	}
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 8, 0);
+	  return \"STM	%1,%N1,140(13)\;LD	%0,140(,13)\";
+	}
+      if (operands[1] == const0_rtx)
+	{
+	  CC_STATUS_SET (operands[0], operands[1]);
+	  mvs_check_page (0, 2, 0);
+	  return \"SDR	%0,%0\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"LD	%0,%1\";
+    }
+  else if (REG_P (operands[0]))
+    {
+      if (FP_REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 12, 0);
+	  return \"STD	%1,140(,13)\;LM	%0,%N0,140(13)\";
+	}
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 4, 0);
+	  return \"LR	%0,%1\;LR	%N0,%N1\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"LM	%0,%N0,%1\";
+    }
+  else if (FP_REG_P (operands[1]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"STD	%1,%0\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"STM	%1,%N1,%0\";
+}"
+   [(set_attr "length" "12")]
+)
+
+;
+; movsf instruction pattern(s).
+;
+
+(define_insn ""
+;;  [(set (match_operand:SF 0 "r_or_s_operand" "=fm,fm,*dm")
+;;        (match_operand:SF 1 "r_or_s_operand" "fmF,*dm,fmF"))]
+;;  [(set (match_operand:SF 0 "general_operand" "=f,m,fm,*d,S")
+;;         (match_operand:SF 1 "general_operand" "fmF,fF,*d,fmF,S"))]
+  [(set (match_operand:SF 0 "general_operand" "=f*d,fm,S,???d")
+        (match_operand:SF 1 "general_operand" "fmF,fF*d,S,???d"))]
+
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  if (FP_REG_P (operands[0]))
+    {
+      if (FP_REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 2, 0);
+	  return \"LER	%0,%1\";
+	}
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 8, 0);
+	  return \"ST	%1,140(,13)\;LE	%0,140(,13)\";
+	}
+      if (operands[1] == const0_rtx)
+	{
+	  CC_STATUS_SET (operands[0], operands[1]);
+	  mvs_check_page (0, 2, 0);
+	  return \"SER	%0,%0\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"LE	%0,%1\";
+    }
+  else if (REG_P (operands[0]))
+    {
+      if (FP_REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 8, 0);
+	  return \"STE	%1,140(,13)\;L	%0,140(,13)\";
+	}
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 2, 0);
+	  return \"LR	%0,%1\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"L	%0,%1\";
+    }
+  else if (FP_REG_P (operands[1]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"STE	%1,%0\";
+    }
+  else if (REG_P (operands[1]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"ST	%1,%0\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"MVC	%O0(4,%R0),%1\";
+}"
+   [(set_attr "length" "8")]
+)
+
+(define_insn "movsf"
+  [(set (match_operand:SF 0 "general_operand" "=f,fm,m,*d")
+	(match_operand:SF 1 "general_operand" "fmF,*d,f,fmF"))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (FP_REG_P (operands[0]))
+    {
+      if (FP_REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 2, 0);
+	  return \"LER	%0,%1\";
+	}
+      if (REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 8, 0);
+	  return \"ST	%1,140(,13)\;LE	%0,140(,13)\";
+	}
+      if (operands[1] == const0_rtx)
+	{
+	  CC_STATUS_SET (operands[0], operands[1]);
+	  mvs_check_page (0, 2, 0);
+	  return \"SER	%0,%0\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"LE	%0,%1\";
+    }
+  else if (REG_P (operands[0]))
+    {
+      if (FP_REG_P (operands[1]))
+	{
+	  mvs_check_page (0, 8, 0);
+	  return \"STE	%1,140(,13)\;L	%0,140(,13)\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"L	%0,%1\";
+    }
+  else if (FP_REG_P (operands[1]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"STE	%1,%0\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"ST	%1,%0\";
+}"
+   [(set_attr "length" "8")]
+)
+
+;
+; clrstrsi instruction pattern(s).
+; memset a block of bytes to zero.
+; block must be less than 16M (24 bits) in length
+;
+(define_expand "clrstrsi"
+  [(set (match_operand:BLK 0 "general_operand" "g")
+        (const_int 0)) 
+   (use (match_operand:SI  1 "general_operand" ""))
+   (match_operand 2 "" "")]
+   ""
+   "
+{
+  {
+        /* implementation suggested by  Richard Henderson <rth@cygnus.com> */
+        rtx reg1 = gen_reg_rtx (DImode);
+        rtx reg2 = gen_reg_rtx (DImode);
+        rtx mem1 = operands[0];
+        rtx zippo = gen_rtx_CONST_INT (SImode, 0);
+        rtx len = operands[1];
+        if (!CONSTANT_P (len))
+          len = force_reg (SImode, len);
+
+        /* Load up the address+length pairs.  */
+        emit_insn (gen_rtx_CLOBBER (VOIDmode, reg1));
+        emit_move_insn (gen_rtx_SUBREG (SImode, reg1, 0),
+                        force_operand (XEXP (mem1, 0), NULL_RTX));
+        emit_move_insn (gen_rtx_SUBREG (SImode, reg1, GET_MODE_SIZE (SImode)), len);
+
+        emit_insn (gen_rtx_CLOBBER (VOIDmode, reg2));
+        emit_move_insn (gen_rtx_SUBREG (SImode, reg2, 0), zippo);
+        emit_move_insn (gen_rtx_SUBREG (SImode, reg2, GET_MODE_SIZE (SImode)), zippo);
+
+        /* Copy! */
+        emit_insn (gen_movstrsi_1 (reg1, reg2));
+  }
+  DONE;
+}")
+
+;
+; movstrsi instruction pattern(s).
+; block must be less than 16M (24 bits) in length
+
+(define_expand "movstrsi"
+  [(set (match_operand:BLK 0 "general_operand" "")
+        (match_operand:BLK 1 "general_operand" ""))
+   (use (match_operand:SI  2 "general_operand" ""))
+   (match_operand 3 "" "")]
+   ""
+   "
+{
+  rtx op0, op1;
+
+  op0 = XEXP (operands[0], 0);
+  if (GET_CODE (op0) == REG
+      || (GET_CODE (op0) == PLUS && GET_CODE (XEXP (op0, 0)) == REG
+	  && GET_CODE (XEXP (op0, 1)) == CONST_INT
+	  && (unsigned) INTVAL (XEXP (op0, 1)) < 4096))
+    op0 = operands[0];
+  else
+    op0 = replace_equiv_address (operands[0], copy_to_mode_reg (SImode, op0));
+
+  op1 = XEXP (operands[1], 0);
+  if (GET_CODE (op1) == REG
+      || (GET_CODE (op1) == PLUS && GET_CODE (XEXP (op1, 0)) == REG
+	  && GET_CODE (XEXP (op1, 1)) == CONST_INT
+	  && (unsigned) INTVAL (XEXP (op1, 1)) < 4096))
+    op1 = operands[1];
+  else
+    op1 = replace_equiv_address (operands[1], copy_to_mode_reg (SImode, op1));
+
+  if (GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) < 256)
+    emit_insn (gen_rtx_PARALLEL (VOIDmode,
+			gen_rtvec (2,
+				   gen_rtx_SET (VOIDmode, op0, op1),
+				   gen_rtx_USE (VOIDmode, operands[2]))));
+
+  else
+    {
+        /* implementation provided by  Richard Henderson <rth@cygnus.com> */
+        rtx reg1 = gen_reg_rtx (DImode);
+        rtx reg2 = gen_reg_rtx (DImode);
+        rtx mem1 = operands[0];
+        rtx mem2 = operands[1];
+        rtx len = operands[2];
+        if (!CONSTANT_P (len))
+          len = force_reg (SImode, len);
+
+        /* Load up the address+length pairs.  */
+        emit_insn (gen_rtx_CLOBBER (VOIDmode, reg1));
+        emit_move_insn (gen_rtx_SUBREG (SImode, reg1, 0),
+                        force_operand (XEXP (mem1, 0), NULL_RTX));
+        emit_move_insn (gen_rtx_SUBREG (SImode, reg1, GET_MODE_SIZE (SImode)), len);
+
+        emit_insn (gen_rtx_CLOBBER (VOIDmode, reg2));
+        emit_move_insn (gen_rtx_SUBREG (SImode, reg2, 0),
+                        force_operand (XEXP (mem2, 0), NULL_RTX));
+        emit_move_insn (gen_rtx_SUBREG (SImode, reg2, GET_MODE_SIZE (SImode)), len);
+
+        /* Copy! */
+        emit_insn (gen_movstrsi_1 (reg1, reg2));
+    }
+  DONE;
+}")
+
+; Move a block that is less than 256 bytes in length.
+
+(define_insn ""
+  [(set (match_operand:BLK 0 "s_operand" "=m")
+	(match_operand:BLK 1 "s_operand" "m"))
+   (use (match_operand 2 "immediate_operand" "I"))]
+  "((unsigned) INTVAL (operands[2]) < 256)"
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 6, 0);
+  return \"MVC	%O0(%c2,%R0),%1\";
+}"
+   [(set_attr "length" "6")]
+)
+
+; Move a block that is larger than 255 bytes in length.
+
+(define_insn "movstrsi_1"
+  [(set (mem:BLK (subreg:SI (match_operand:DI 0 "register_operand" "+d") 0))
+        (mem:BLK (subreg:SI (match_operand:DI 1 "register_operand" "+d") 0)))
+   (use (match_dup 0))
+   (use (match_dup 1))
+   (clobber (match_dup 0))
+   (clobber (match_dup 1))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 2, 0);
+  return \"MVCL	%0,%1\";
+}"
+   [(set_attr "length" "2")]
+)
+
+;;
+;;- Conversion instructions.
+;;
+
+;
+; extendsidi2 instruction pattern(s).
+;
+
+(define_expand "extendsidi2"
+  [(set (match_operand:DI 0 "register_operand" "=d")
+        (sign_extend:DI (match_operand:SI 1 "general_operand" "")))]
+  ""
+  "
+{
+  if (GET_CODE (operands[1]) != CONST_INT)
+    {
+      emit_insn (gen_rtx_SET (VOIDmode,
+		  operand_subword (operands[0], 0, 1, DImode), operands[1]));
+      emit_insn (gen_rtx_SET (VOIDmode, operands[0],
+			gen_rtx_ASHIFTRT (DImode, operands[0],
+				gen_rtx_CONST_INT (SImode, 32))));
+    }
+  else
+    {
+      if (INTVAL (operands[1]) < 0)
+	{
+	  emit_insn (gen_rtx_SET (VOIDmode,
+				  operand_subword (operands[0], 0, 1, DImode),
+			       gen_rtx_CONST_INT (SImode, -1)));
+        }
+      else
+	{
+	  emit_insn (gen_rtx_SET (VOIDmode,
+				operand_subword (operands[0], 0, 1, DImode),
+			       gen_rtx_CONST_INT (SImode, 0)));
+        }
+      emit_insn (gen_rtx_SET (VOIDmode, gen_lowpart (SImode, operands[0]),
+			   operands[1]));
+    }
+  DONE;
+}")
+
+;
+; extendhisi2 instruction pattern(s).
+;
+
+(define_insn "extendhisi2"
+  [(set (match_operand:SI 0 "general_operand" "=d,m")
+	(sign_extend:SI (match_operand:HI 1 "general_operand" "g,d")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      if (REG_P (operands[1]))
+      {
+        if (REGNO (operands[0]) != REGNO (operands[1]))
+	  {
+	    mvs_check_page (0, 10, 0);
+            return \"LR	%0,%1\;SLL	%0,16\;SRA	%0,16\";
+	  }
+        else
+          return \"\"; /* Should be empty.  16-bits regs are always 32-bits.  */
+      }
+      if (operands[1] == const0_rtx)
+	{
+	  CC_STATUS_INIT;
+	  mvs_check_page (0, 2, 0);
+	  return \"SLR	%0,%0\";
+	}
+      if (GET_CODE (operands[1]) == CONST_INT
+ 	  && (unsigned) INTVAL (operands[1]) < 4096)
+	{
+	  mvs_check_page (0, 4, 0);
+	  return \"LA	%0,%c1(0,0)\";
+	}
+      if (GET_CODE (operands[1]) == CONST_INT)
+	{
+	  mvs_check_page (0, 4, 0);
+	  return \"LH	%0,%H1\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"LH	%0,%1\";
+    }
+  mvs_check_page (0, 12, 0);
+  return \"SLL	%1,16\;SRA	%1,16\;ST	%1,%0\";
+}"
+   [(set_attr "length" "12")]
+)
+
+;
+; extendqisi2 instruction pattern(s).
+;
+
+(define_insn "extendqisi2"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(sign_extend:SI (match_operand:QI 1 "general_operand" "0mi")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_SET (operands[0], operands[1]);
+  if (REG_P (operands[1]))
+    {
+      mvs_check_page (0, 8, 0);
+      return \"SLL	%0,24\;SRA	%0,24\";
+    }
+  if (s_operand (operands[1], GET_MODE (operands[1])))
+    {
+      mvs_check_page (0, 8, 0);
+      return \"ICM	%0,8,%1\;SRA	%0,24\";
+    }
+  mvs_check_page (0, 12, 0);
+  return \"IC	%0,%1\;SLL	%0,24\;SRA	%0,24\";
+}"
+   [(set_attr "length" "12")]
+)
+
+;
+; extendqihi2 instruction pattern(s).
+;
+
+(define_insn "extendqihi2"
+  [(set (match_operand:HI 0 "general_operand" "=d")
+	(sign_extend:HI (match_operand:QI 1 "general_operand" "0m")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_SET (operands[0], operands[1]);
+  if (REG_P (operands[1]))
+    {
+      mvs_check_page (0, 8, 0);
+      return \"SLL	%0,24\;SRA	%0,24\";
+    }
+  if (s_operand (operands[1], GET_MODE (operands[1])))
+    {
+      mvs_check_page (0, 8, 0);
+      return \"ICM	%0,8,%1\;SRA	%0,24\";
+    }
+  mvs_check_page (0, 12, 0);
+  return \"IC	%0,%1\;SLL	%0,24\;SRA	%0,24\";
+}"
+   [(set_attr "length" "12")]
+)
+
+;
+; zero_extendsidi2 instruction pattern(s).
+;
+
+(define_expand "zero_extendsidi2"
+  [(set (match_operand:DI 0 "register_operand" "=d")
+        (zero_extend:DI (match_operand:SI 1 "general_operand" "")))]
+  ""
+  "
+{
+      emit_insn (gen_rtx_SET (VOIDmode,
+		  operand_subword (operands[0], 0, 1, DImode), operands[1]));
+      emit_insn (gen_rtx_SET (VOIDmode, operands[0],
+			gen_rtx_LSHIFTRT (DImode, operands[0],
+				gen_rtx_CONST_INT (SImode, 32))));
+  DONE;
+}")
+
+;
+; zero_extendhisi2 instruction pattern(s).
+;
+
+(define_insn "zero_extendhisi2"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(zero_extend:SI (match_operand:HI 1 "general_operand" "0")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  /* AND only sets zero/not-zero bits not the arithmetic bits ...  */
+  CC_STATUS_INIT;
+  mvs_check_page (0, 4, 4);
+  return \"N	%1,=XL4'0000FFFF'\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; zero_extendqisi2 instruction pattern(s).
+;
+
+(define_insn "zero_extendqisi2"
+  [(set (match_operand:SI 0 "general_operand" "=d,&d")
+	(zero_extend:SI (match_operand:QI 1 "general_operand" "0i,m")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[1]))
+    {
+      /* AND only sets zero/not-zero bits not the arithmetic bits ...  */
+      CC_STATUS_INIT;
+      mvs_check_page (0, 4, 4);
+      return \"N	%0,=XL4'000000FF'\";
+    }
+  if (GET_CODE (operands[1]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 0);
+      return \"LA	%0,%c1(0,0)\";
+    }
+  CC_STATUS_INIT;
+  mvs_check_page (0, 8, 0);
+  return \"SLR	%0,%0\;IC	%0,%1\";
+}"
+   [(set_attr "length" "8")]
+)
+
+;
+; zero_extendqihi2 instruction pattern(s).
+;
+
+(define_insn "zero_extendqihi2"
+  [(set (match_operand:HI 0 "general_operand" "=d,&d")
+	(zero_extend:HI (match_operand:QI 1 "general_operand" "0i,m")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[1]))
+    {
+      /* AND only sets zero/not-zero bits not the arithmetic bits ...  */
+      CC_STATUS_INIT;
+      mvs_check_page (0, 4, 4);
+      return \"N	%0,=XL4'000000FF'\";
+    }
+  if (GET_CODE (operands[1]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 0);
+      return \"LA	%0,%c1(0,0)\";
+    }
+  CC_STATUS_INIT;
+  mvs_check_page (0, 8, 0);
+  return \"SLR	%0,%0\;IC	%0,%1\";
+}"
+   [(set_attr "length" "8")]
+)
+
+;
+; truncsihi2 instruction pattern(s).
+;
+
+(define_insn "truncsihi2"
+  [(set (match_operand:HI 0 "general_operand" "=d,m")
+	(truncate:HI (match_operand:SI 1 "general_operand" "0,d")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      CC_STATUS_SET (operands[0], operands[1]);
+      mvs_check_page (0, 8, 0);
+      return \"SLL	%0,16\;SRA	%0,16\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"STH	%1,%0\";
+}"
+   [(set_attr "length" "8")]
+)
+
+;
+; fix_truncdfsi2 instruction pattern(s).
+;
+
+(define_insn "fix_truncdfsi2"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+        (fix:SI (truncate:DF (match_operand:DF 1 "general_operand" "+f"))))
+	(clobber (reg:DF 16))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;
+  if (REGNO (operands[1]) == 16)
+    {
+      mvs_check_page (0, 12, 8);
+      return \"AD	0,=XL8'4F08000000000000'\;STD	0,140(,13)\;L	%0,144(,13)\";
+    }
+  mvs_check_page (0, 14, 8);
+  return \"LDR	0,%1\;AD	0,=XL8'4F08000000000000'\;STD	0,140(,13)\;L	%0,144(,13)\";
+}"
+   [(set_attr "length" "14")]
+)
+
+;
+; floatsidf2 instruction pattern(s).
+;
+; LE/370 mode uses the float field of the TCA.
+;
+
+(define_insn "floatsidf2"
+  [(set (match_operand:DF 0 "general_operand" "=f")
+        (float:DF (match_operand:SI 1 "general_operand" "d")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;
+#ifdef TARGET_ELF_ABI
+  mvs_check_page (0, 22, 12);
+  return \"MVC  140(4,13),=XL4'4E000000'\;ST	%1,144(,13)\;XI	144(13),128\;LD	%0,140(,13)\;SD	%0,=XL8'4E00000080000000'\";
+#else
+  mvs_check_page (0, 16, 8);
+  return \"ST	%1,508(,12)\;XI	508(12),128\;LD	%0,504(,12)\;SD	%0,=XL8'4E00000080000000'\";
+#endif
+}"
+   [(set_attr "length" "22")]
+)
+
+;
+; truncdfsf2 instruction pattern(s).
+;
+
+(define_insn "truncdfsf2"
+  [(set (match_operand:SF 0 "general_operand" "=f")
+        (float_truncate:SF (match_operand:DF 1 "general_operand" "f")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 2, 0);
+  return \"LRER	%0,%1\";
+}"
+   [(set_attr "length" "2")]
+)
+
+;
+; extendsfdf2 instruction pattern(s).
+; 
+
+(define_insn "extendsfdf2"
+  [(set (match_operand:DF 0 "general_operand" "=f")
+        (float_extend:DF (match_operand:SF 1 "general_operand" "fmF")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_SET (0, const0_rtx);
+  if (FP_REG_P (operands[1]))
+    {
+      if (REGNO (operands[0]) == REGNO (operands[1]))
+	{
+	  mvs_check_page (0, 10, 0);
+	  return \"STE	%1,140(,13)\;SDR	%0,%0\;LE	%0,140(,13)\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"SDR	%0,%0\;LER	%0,%1\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"SDR	%0,%0\;LE	%0,%1\";
+}"
+   [(set_attr "length" "10")]
+)
+
+;;
+;;- Add instructions.
+;;
+
+;
+; adddi3 instruction pattern(s).
+;
+;
+;(define_expand "adddi3"
+;  [(set (match_operand:DI 0 "general_operand" "")
+;	(plus:DI (match_operand:DI 1 "general_operand" "")
+;		 (match_operand:DI 2 "general_operand" "")))]
+;  ""
+;  "
+;{
+;  rtx label = gen_label_rtx ();
+;  rtx op0_high = operand_subword (operands[0], 0, 1, DImode);
+;  rtx op0_low = gen_lowpart (SImode, operands[0]);
+;	
+;  emit_insn (gen_rtx_SET (VOIDmode, op0_high,
+;		    gen_rtx_PLUS (SImode,
+;			    operand_subword (operands[1], 0, 1, DImode),
+;			    operand_subword (operands[2], 0, 1, DImode))));
+;  emit_jump_insn (gen_rtx_PARALLEL (VOIDmode, gen_rtvec (2,
+;	      gen_rtx_SET (VOIDmode, op0_low,
+;		      gen_rtx_PLUS (SImode, gen_lowpart (SImode, operands[1]),
+;			      gen_lowpart (SImode, operands[2]))),
+;	      gen_rtx_USE (VOIDmode, gen_rtx_LABEL_REF (VOIDmode, label)))));
+;  emit_insn (gen_rtx_SET (VOIDmode, op0_high,
+;		    gen_rtx_PLUS (SImode, op0_high,
+;			    gen_rtx_CONST_INT (SImode, 1))));
+;  emit_label (label);
+;  DONE;
+;}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(plus:SI (match_operand:SI 1 "general_operand" "%0")
+		 (match_operand:SI 2 "general_operand" "g")))
+   (use (label_ref (match_operand 3 "" "")))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  int onpage;
+
+  check_label_emit ();
+  onpage = mvs_check_label (CODE_LABEL_NUMBER (operands[3]));
+  if (REG_P (operands[2]))
+    {
+      if (!onpage)
+	{
+	  mvs_check_page (0, 8, 4);
+	  return \"ALR	%0,%2\;L	14,=A(%l3)\;BCR	12,14\";
+	}
+      if (mvs_check_page (0, 6, 0))
+	{
+	  mvs_check_page (0, 2, 4);
+	  return \"ALR	%0,%2\;L	14,=A(%l3)\;BCR	12,14\";
+	}
+      return \"ALR	%0,%2\;BC	12,%l3\";
+    }
+  if (!onpage)
+    {
+      mvs_check_page (0, 10, 4);
+      return \"AL	%0,%2\;L	14,=A(%l3)\;BCR	12,14\";
+    }
+  if (mvs_check_page (0, 8 ,0))
+    {
+      mvs_check_page (0, 2, 4);
+      return \"AL	%0,%2\;L	14,=A(%l3)\;BCR	12,14\";
+    }
+  return \"AL	%0,%2\;BC	12,%l3\";
+}"
+   [(set_attr "length" "10")]
+)
+
+;
+; addsi3 instruction pattern(s).
+;
+; The following insn is used when it is known that operand one is an address,
+; frame, stack or argument pointer, and operand two is a constant that is
+; small enough to fit in the displacement field.
+; Notice that we can't allow the frame pointer to used as a normal register
+; because of this insn.
+;
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(plus:SI (match_operand:SI 1 "general_operand" "%a")
+		 (match_operand:SI 2 "immediate_operand" "J")))]
+  "((REGNO (operands[1]) == FRAME_POINTER_REGNUM || REGNO (operands[1]) == ARG_POINTER_REGNUM || REGNO (operands[1]) == STACK_POINTER_REGNUM) && (unsigned) INTVAL (operands[2]) < 4096)"
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* add assumes CC but LA doesn't set CC */
+  mvs_check_page (0, 4, 0);
+  return \"LA	%0,%c2(,%1)\";
+}"
+   [(set_attr "length" "4")]
+)
+
+; This insn handles additions that are relative to the frame pointer.
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+         (plus:SI (match_operand:SI 1 "register_operand" "%a")
+                  (match_operand:SI 2 "immediate_operand" "i")))]
+  "REGNO (operands[1]) == FRAME_POINTER_REGNUM"
+  "*
+{
+  check_label_emit ();
+  if ((unsigned) INTVAL (operands[2]) < 4096)
+    {
+      CC_STATUS_INIT;  /* add assumes CC but LA doesn't set CC */
+      mvs_check_page (0, 4, 0);
+      return \"LA	%0,%c2(,%1)\";
+    }
+  if (REGNO (operands[1]) == REGNO (operands[0]))
+    {
+      CC_STATUS_INIT;
+      mvs_check_page (0, 4, 0);
+      return \"A	%0,%2\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"L	%0,%2\;AR	%0,%1\";
+}"
+   [(set_attr "length" "6")]
+)
+
+;;
+;; The CC status bits for the arithmetic instructions are handled
+;; in the NOTICE_UPDATE_CC macro (yeah???) and so they do not need
+;; to be set below.  They only need to be invalidated if *not* set 
+;; (e.g. by BCTR) ... yeah I think that's right ...
+;; 
+
+(define_insn "addsi3"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(plus:SI (match_operand:SI 1 "general_operand" "%0")
+		 (match_operand:SI 2 "general_operand" "g")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"AR	%0,%2\";
+    }
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      if (INTVAL (operands[2]) == -1)
+	{
+          CC_STATUS_INIT;  /* add assumes CC but BCTR doesn't set CC */
+	  mvs_check_page (0, 2, 0);
+	  return \"BCTR	%0,0\";
+	}
+    }
+  mvs_check_page (0, 4, 0);
+  return \"A	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; addhi3 instruction pattern(s).
+;
+
+(define_insn "addhi3"
+  [(set (match_operand:HI 0 "general_operand" "=d")
+	(plus:HI (match_operand:HI 1 "general_operand" "%0")
+		 (match_operand:HI 2 "general_operand" "dmi")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 8, 0);
+      return \"STH	%2,140(,13)\;AH	%0,140(,13)\";
+    }
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      if (INTVAL (operands[2]) == -1)
+	{
+          CC_STATUS_INIT;  /* add assumes CC but BCTR doesn't set CC */
+	  mvs_check_page (0, 2, 0);
+	  return \"BCTR	%0,0\";
+	}
+      mvs_check_page (0, 4, 0);
+      return \"AH	%0,%H2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"AH	%0,%2\";
+}"
+   [(set_attr "length" "8")]
+)
+
+;
+; addqi3 instruction pattern(s).
+;
+
+(define_insn "addqi3"
+  [(set (match_operand:QI 0 "general_operand" "=d")
+	(plus:QI (match_operand:QI 1 "general_operand" "%a")
+		 (match_operand:QI 2 "general_operand" "ai")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* add assumes CC but LA doesn't set CC */
+  mvs_check_page (0, 4, 0);
+  if (REG_P (operands[2]))
+    return \"LA	%0,0(%1,%2)\";
+  return \"LA	%0,%B2(,%1)\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; adddf3 instruction pattern(s).
+;
+
+(define_insn "adddf3"
+  [(set (match_operand:DF 0 "general_operand" "=f")
+	(plus:DF (match_operand:DF 1 "general_operand" "%0")
+		 (match_operand:DF 2 "general_operand" "fmF")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (FP_REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"ADR	%0,%2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"AD	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; addsf3 instruction pattern(s).
+;
+
+(define_insn "addsf3"
+  [(set (match_operand:SF 0 "general_operand" "=f")
+	(plus:SF (match_operand:SF 1 "general_operand" "%0")
+		 (match_operand:SF 2 "general_operand" "fmF")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (FP_REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"AER	%0,%2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"AE	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;;
+;;- Subtract instructions.
+;;
+
+;
+; subdi3 instruction pattern(s).
+;
+;
+;(define_expand "subdi3"
+;  [(set (match_operand:DI 0 "general_operand" "")
+;	(minus:DI (match_operand:DI 1 "general_operand" "")
+;		  (match_operand:DI 2 "general_operand" "")))]
+;  ""
+;  "
+;{
+;  rtx label = gen_label_rtx ();
+;  rtx op0_high = operand_subword (operands[0], 0, 1, DImode);
+;  rtx op0_low = gen_lowpart (SImode, operands[0]);
+;	
+;  emit_insn (gen_rtx_SET (VOIDmode, op0_high,
+;		    gen_rtx_MINUS (SImode,
+;			      operand_subword (operands[1], 0, 1, DImode),
+;			      operand_subword (operands[2], 0, 1, DImode))));
+;  emit_jump_insn (gen_rtx_PARALLEL (VOIDmode, gen_rtvec (2,
+;		    gen_rtx_SET (VOIDmode, op0_low,
+;			      gen_rtx_MINUS (SImode,
+;				      gen_lowpart (SImode, operands[1]),
+;				      gen_lowpart (SImode, operands[2]))),
+;		    gen_rtx_USE (VOIDmode,
+;			      gen_rtx_LABEL_REF (VOIDmode, label)))));
+;  emit_insn (gen_rtx_SET (VOIDmode, op0_high,
+;		      gen_rtx_MINUS (SImode, op0_high,
+;			      gen_rtx_CONST_INT (SImode, 1))));
+;  emit_label (label);
+;  DONE;
+;}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(minus:SI (match_operand:SI 1 "general_operand" "0")
+		  (match_operand:SI 2 "general_operand" "g")))
+   (use (label_ref (match_operand 3 "" "")))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  int onpage;
+
+  check_label_emit ();
+  CC_STATUS_INIT;
+  onpage = mvs_check_label (CODE_LABEL_NUMBER (operands[3]));
+  if (REG_P (operands[2]))
+    {
+      if (!onpage)
+	{
+	  mvs_check_page (0, 8, 4);
+	  return \"SLR	%0,%2\;L	14,=A(%l3)\;BCR	12,14\";
+	}
+      if (mvs_check_page (0, 6, 0))
+	{
+	  mvs_check_page (0, 2, 4);
+	  return \"SLR	%0,%2\;L	14,=A(%l3)\;BCR	12,14\";
+	}
+      return \"SLR	%0,%2\;BC	12,%l3\";
+    }
+  if (!onpage)
+    {
+      mvs_check_page (0, 10, 4);
+      return \"SL	%0,%2\;L	14,=A(%l3)\;BCR	12,14\";
+    }
+  if (mvs_check_page (0, 8, 0))
+    {
+      mvs_check_page (0, 2, 4);
+      return \"SL	%0,%2\;L	14,=A(%l3)\;BCR	12,14\";
+    }
+  return \"SL	%0,%2\;BC	12,%l3\";
+}"
+   [(set_attr "length" "10")]
+)
+
+;
+; subsi3 instruction pattern(s).
+;
+
+(define_insn "subsi3"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(minus:SI (match_operand:SI 1 "general_operand" "0")
+		  (match_operand:SI 2 "general_operand" "g")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"SR	%0,%2\";
+    }
+  if (operands[2] == const1_rtx)
+    {
+      CC_STATUS_INIT;  /* subtract assumes CC but BCTR doesn't set CC */
+      mvs_check_page (0, 2, 0);
+      return \"BCTR	%0,0\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"S	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; subhi3 instruction pattern(s).
+;
+
+(define_insn "subhi3"
+  [(set (match_operand:HI 0 "general_operand" "=d")
+	(minus:HI (match_operand:HI 1 "general_operand" "0")
+		  (match_operand:HI 2 "general_operand" "g")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 8, 0);
+      return \"STH	%2,140(,13)\;SH	%0,140(,13)\";
+    }
+  if (operands[2] == const1_rtx)
+    {
+      CC_STATUS_INIT;  /* subtract assumes CC but BCTR doesn't set CC */
+      mvs_check_page (0, 2, 0);
+      return \"BCTR	%0,0\";
+    }
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 0);
+      return \"SH	%0,%H2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"SH	%0,%2\";
+}"
+   [(set_attr "length" "8")]
+)
+
+;
+; subqi3 instruction pattern(s).
+;
+
+(define_expand "subqi3"
+  [(set (match_operand:QI 0 "general_operand" "=d")
+	(minus:QI (match_operand:QI 1 "general_operand" "0")
+		  (match_operand:QI 2 "general_operand" "di")))]
+  ""
+  "
+{
+  if (REG_P (operands[2]))
+    {
+      emit_insn (gen_rtx_SET (VOIDmode, operands[0],
+			gen_rtx_MINUS (QImode, operands[1], operands[2])));
+    }
+  else
+    {
+      emit_insn (gen_rtx_SET (VOIDmode, operands[0],
+			gen_rtx_PLUS (QImode, operands[1],
+				 negate_rtx (QImode, operands[2]))));
+    }
+  DONE;
+}")
+
+(define_insn ""
+  [(set (match_operand:QI 0 "register_operand" "=d")
+	(minus:QI (match_operand:QI 1 "register_operand" "0")
+		 (match_operand:QI 2 "register_operand" "d")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 2, 0);
+  return \"SR	%0,%2\";
+}"
+   [(set_attr "length" "2")]
+)
+
+;
+; subdf3 instruction pattern(s).
+;
+
+(define_insn "subdf3"
+  [(set (match_operand:DF 0 "general_operand" "=f")
+	(minus:DF (match_operand:DF 1 "general_operand" "0")
+		  (match_operand:DF 2 "general_operand" "fmF")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (FP_REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"SDR	%0,%2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"SD	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; subsf3 instruction pattern(s).
+;
+
+(define_insn "subsf3"
+  [(set (match_operand:SF 0 "general_operand" "=f")
+	(minus:SF (match_operand:SF 1 "general_operand" "0")
+		  (match_operand:SF 2 "general_operand" "fmF")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (FP_REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"SER	%0,%2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"SE	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;;
+;;- Multiply instructions.
+;;
+
+;
+; mulsi3 instruction pattern(s).
+;
+
+(define_expand "mulsi3"
+  [(set (match_operand:SI 0 "general_operand" "")
+	(mult:SI (match_operand:SI 1 "general_operand" "")
+		 (match_operand:SI 2 "general_operand" "")))]
+  ""
+  "
+{
+  if (GET_CODE (operands[1]) == CONST_INT
+      && CONST_OK_FOR_LETTER_P (INTVAL (operands[1]), 'K'))
+    {
+      emit_insn (gen_rtx_SET (VOIDmode, operands[0],
+			  gen_rtx_MULT (SImode, operands[2], operands[1])));
+    }
+  else if (GET_CODE (operands[2]) == CONST_INT
+	   && CONST_OK_FOR_LETTER_P (INTVAL (operands[2]), 'K'))
+    {
+      emit_insn (gen_rtx_SET (VOIDmode, operands[0],
+			  gen_rtx_MULT (SImode, operands[1], operands[2])));
+    }
+  else
+    {
+      rtx r = gen_reg_rtx (DImode);
+
+      /* XXX trouble.  Below we generate some rtx's that model what
+       * is really supposed to happen with multiply on the 370/390
+       * hardware, and that is all well & good.  However, during optimization
+       * it can happen that the two operands are exchanged (after all, 
+       * multiplication is commutitive), in which case the doubleword
+       * ends up in memory and everything is hosed.  The gen_reg_rtx
+       * should have kept it in a reg ...  We hack around this
+       * below, in the M/MR isntruction pattern, and constrain it to
+       * \"di\" instead of \"g\".  But this still ends up with lots & lots of
+       * movement between registers & memory and is an awful waste.
+       * Dunno how to untwist it elegantly; but it seems to work for now.
+       */
+      emit_insn (gen_rtx_SET (VOIDmode,
+			  gen_rtx_SUBREG (SImode, r, GET_MODE_SIZE (SImode)),
+					  operands[1]));
+      emit_insn (gen_rtx_SET (VOIDmode, r,
+			  gen_rtx_MULT (DImode, r, operands[2])));
+      emit_insn (gen_rtx_SET (VOIDmode, operands[0],
+			  gen_rtx_SUBREG (SImode, r, GET_MODE_SIZE (SImode))));
+    }
+  DONE;
+}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(mult:SI (match_operand:SI 1 "general_operand" "%0")
+		 (match_operand:SI 2 "immediate_operand" "K")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  return \"MH	%0,%H2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+(define_insn ""
+  [(set (match_operand:DI 0 "register_operand" "=d")
+	(mult:DI (match_operand:DI 1 "general_operand" "%0")
+		 (match_operand:SI 2 "general_operand" "di")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"MR	%0,%2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"M	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; muldf3 instruction pattern(s).
+;
+
+(define_insn "muldf3"
+  [(set (match_operand:DF 0 "general_operand" "=f")
+	(mult:DF (match_operand:DF 1 "general_operand" "%0")
+		 (match_operand:DF 2 "general_operand" "fmF")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (FP_REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"MDR	%0,%2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"MD	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; mulsf3 instruction pattern(s).
+;
+
+(define_insn "mulsf3"
+  [(set (match_operand:SF 0 "general_operand" "=f")
+	(mult:SF (match_operand:SF 1 "general_operand" "%0")
+		 (match_operand:SF 2 "general_operand" "fmF")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (FP_REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"MER	%0,%2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"ME	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;;
+;;- Divide instructions.
+;;
+
+;
+; divsi3 instruction pattern(s).
+;
+
+(define_expand "divsi3"
+  [(set (match_operand:SI 0 "general_operand" "")
+	(div:SI (match_operand:SI 1 "general_operand" "")
+		(match_operand:SI 2 "general_operand" "")))]
+  ""
+  "
+{
+  rtx r = gen_reg_rtx (DImode);
+
+  emit_insn (gen_extendsidi2 (r, operands[1]));
+  emit_insn (gen_rtx_SET (VOIDmode, r,
+			gen_rtx_DIV (DImode, r, operands[2])));
+  emit_insn (gen_rtx_SET (VOIDmode, operands[0],
+			gen_rtx_SUBREG (SImode, r, GET_MODE_SIZE (SImode))));
+  DONE;
+}")
+
+
+;
+; udivsi3 instruction pattern(s).
+;
+
+(define_expand "udivsi3"
+  [(set (match_operand:SI 0 "general_operand" "")
+	(udiv:SI (match_operand:SI 1 "general_operand" "")
+		 (match_operand:SI 2 "general_operand" "")))]
+  ""
+  "
+{
+  rtx dr = gen_reg_rtx (DImode);
+  rtx dr_0 = gen_rtx_SUBREG (SImode, dr, 0);
+  rtx dr_1 = gen_rtx_SUBREG (SImode, dr, GET_MODE_SIZE (SImode));
+
+
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      if (INTVAL (operands[2]) > 0)
+	{
+	  emit_insn (gen_zero_extendsidi2 (dr, operands[1]));
+	  emit_insn (gen_rtx_SET (VOIDmode, dr,
+			gen_rtx_DIV (DImode, dr, operands[2])));
+	}
+      else
+	{
+	  rtx label1 = gen_label_rtx ();
+
+	  emit_insn (gen_rtx_SET (VOIDmode, dr_0, operands[1]));
+	  emit_insn (gen_rtx_SET (VOIDmode, dr_1, const0_rtx));
+	  emit_insn (gen_cmpsi (dr_0, operands[2]));
+	  emit_jump_insn (gen_bltu (label1));
+	  emit_insn (gen_rtx_SET (VOIDmode, dr_1, const1_rtx));
+	  emit_label (label1);
+	}
+    }
+  else
+    {
+      rtx label1 = gen_label_rtx ();
+      rtx label2 = gen_label_rtx ();
+      rtx label3 = gen_label_rtx ();
+      rtx sr = gen_reg_rtx (SImode);
+
+      emit_insn (gen_rtx_SET (VOIDmode, dr_0, operands[1]));
+      emit_insn (gen_rtx_SET (VOIDmode, sr, operands[2]));
+      emit_insn (gen_rtx_SET (VOIDmode, dr_1, const0_rtx));
+      emit_insn (gen_cmpsi (sr, dr_0));
+      emit_jump_insn (gen_bgtu (label3));
+      emit_insn (gen_cmpsi (sr, const1_rtx));
+      emit_jump_insn (gen_blt (label2));
+      emit_insn (gen_cmpsi (sr, const1_rtx));
+      emit_jump_insn (gen_beq (label1));
+      emit_insn (gen_rtx_SET (VOIDmode, dr,
+			  gen_rtx_LSHIFTRT (DImode, dr,
+				    gen_rtx_CONST_INT (SImode, 32))));
+      emit_insn (gen_rtx_SET (VOIDmode, dr,
+		    gen_rtx_DIV (DImode, dr, sr)));
+      emit_jump_insn (gen_jump (label3));
+      emit_label (label1);
+      emit_insn (gen_rtx_SET (VOIDmode, dr_1, dr_0));
+      emit_jump_insn (gen_jump (label3));
+      emit_label (label2);
+      emit_insn (gen_rtx_SET (VOIDmode, dr_1, const1_rtx));
+      emit_label (label3);
+    }
+  emit_insn (gen_rtx_SET (VOIDmode, operands[0], dr_1));
+
+  DONE;
+}")
+
+; This is used by divsi3 & udivsi3.
+
+(define_insn ""
+  [(set (match_operand:DI 0 "register_operand" "=d")
+	(div:DI (match_operand:DI 1 "register_operand" "0")
+		(match_operand:SI 2 "general_operand" "dm")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"DR	%0,%2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"D	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; divdf3 instruction pattern(s).
+;
+
+(define_insn "divdf3"
+  [(set (match_operand:DF 0 "general_operand" "=f")
+        (div:DF (match_operand:DF 1 "general_operand" "0")
+                (match_operand:DF 2 "general_operand" "fmF")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (FP_REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"DDR	%0,%2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"DD	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; divsf3 instruction pattern(s).
+;
+
+(define_insn "divsf3"
+  [(set (match_operand:SF 0 "general_operand" "=f")
+        (div:SF (match_operand:SF 1 "general_operand" "0")
+                (match_operand:SF 2 "general_operand" "fmF")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (FP_REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"DER	%0,%2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"DE	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;;
+;;- Modulo instructions.
+;;
+
+;
+; modsi3 instruction pattern(s).
+;
+
+(define_expand "modsi3"
+  [(set (match_operand:SI 0 "general_operand" "")
+	(mod:SI (match_operand:SI 1 "general_operand" "")
+		(match_operand:SI 2 "general_operand" "")))]
+  ""
+  "
+{
+  rtx r = gen_reg_rtx (DImode);
+
+  emit_insn (gen_extendsidi2 (r, operands[1]));
+  emit_insn (gen_rtx_SET (VOIDmode, r,
+			gen_rtx_MOD (DImode, r, operands[2])));
+  emit_insn (gen_rtx_SET (VOIDmode, operands[0],
+			gen_rtx_SUBREG (SImode, r, 0)));
+  DONE;
+}")
+
+;
+; umodsi3 instruction pattern(s).
+;
+
+(define_expand "umodsi3"
+  [(set (match_operand:SI 0 "general_operand" "")
+	(umod:SI (match_operand:SI 1 "general_operand" "")
+		 (match_operand:SI 2 "general_operand" "")))]
+  ""
+  "
+{
+  rtx dr = gen_reg_rtx (DImode);
+  rtx dr_0 = gen_rtx_SUBREG (SImode, dr, 0);
+
+  emit_insn (gen_rtx_SET (VOIDmode, dr_0, operands[1]));
+
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      if (INTVAL (operands[2]) > 0)
+	{
+	  emit_insn (gen_rtx_SET (VOIDmode, dr,
+			      gen_rtx_LSHIFTRT (DImode, dr,
+					gen_rtx_CONST_INT (SImode, 32))));
+	  emit_insn (gen_rtx_SET (VOIDmode, dr,
+			gen_rtx_MOD (DImode, dr, operands[2])));
+	}
+      else
+	{
+	  rtx label1 = gen_label_rtx ();
+	  rtx sr = gen_reg_rtx (SImode);
+
+	  emit_insn (gen_rtx_SET (VOIDmode, sr, operands[2]));
+	  emit_insn (gen_cmpsi (dr_0, sr));
+	  emit_jump_insn (gen_bltu (label1));
+	  emit_insn (gen_rtx_SET (VOIDmode, sr, gen_rtx_ABS (SImode, sr)));
+	  emit_insn (gen_rtx_SET (VOIDmode, dr_0,
+			      gen_rtx_PLUS (SImode, dr_0, sr)));
+	  emit_label (label1);
+	}
+    }
+  else
+    {
+      rtx label1 = gen_label_rtx ();
+      rtx label2 = gen_label_rtx ();
+      rtx label3 = gen_label_rtx ();
+      rtx sr = gen_reg_rtx (SImode);
+
+      emit_insn (gen_rtx_SET (VOIDmode, dr_0, operands[1]));
+      emit_insn (gen_rtx_SET (VOIDmode, sr, operands[2]));
+      emit_insn (gen_cmpsi (sr, dr_0));
+      emit_jump_insn (gen_bgtu (label3));
+      emit_insn (gen_cmpsi (sr, const1_rtx));
+      emit_jump_insn (gen_blt (label2));
+      emit_jump_insn (gen_beq (label1));
+      emit_insn (gen_rtx_SET (VOIDmode, dr,
+			  gen_rtx_LSHIFTRT (DImode, dr,
+				    gen_rtx_CONST_INT (SImode, 32))));
+      emit_insn (gen_rtx_SET (VOIDmode, dr, gen_rtx_MOD (DImode, dr, sr)));
+      emit_jump_insn (gen_jump (label3));
+      emit_label (label1);
+      emit_insn (gen_rtx_SET (VOIDmode, dr_0, const0_rtx));
+      emit_jump_insn (gen_jump (label3));
+      emit_label (label2);
+      emit_insn (gen_rtx_SET (VOIDmode, dr_0,
+			  gen_rtx_MINUS (SImode, dr_0, sr)));
+      emit_label (label3);
+
+    }
+  emit_insn (gen_rtx_SET (VOIDmode, operands[0], dr_0));
+
+  DONE;
+}")
+
+; This is used by modsi3 & umodsi3.
+
+(define_insn ""
+  [(set (match_operand:DI 0 "register_operand" "=d")
+	(mod:DI (match_operand:DI 1 "register_operand" "0")
+		(match_operand:SI 2 "general_operand" "dm")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"DR	%0,%2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"D	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;;
+;;- And instructions.
+;;
+
+;
+; anddi3 instruction pattern(s).
+;
+
+;(define_expand "anddi3"
+;  [(set (match_operand:DI 0 "general_operand" "")
+;	(and:DI (match_operand:DI 1 "general_operand" "")
+;		(match_operand:DI 2 "general_operand" "")))]
+;  ""
+;  "
+;{
+;  rtx gen_andsi3();
+;
+;  emit_insn (gen_andsi3 (operand_subword (operands[0], 0, 1, DImode),
+;			 operand_subword (operands[1], 0, 1, DImode),
+;			 operand_subword (operands[2], 0, 1, DImode)));
+;  emit_insn (gen_andsi3 (gen_lowpart (SImode, operands[0]),
+;			 gen_lowpart (SImode, operands[1]),
+;			 gen_lowpart (SImode, operands[2])));
+;  DONE;
+;}")
+
+;
+; andsi3 instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (match_operand:SI 0 "r_or_s_operand" "=d,m")
+	(and:SI (match_operand:SI 1 "r_or_s_operand" "%0,0")
+		(match_operand:SI 2 "r_or_s_operand" "g,mi")))]
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* and sets CC but not how we want it */
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"NR	%0,%2\";
+    }
+  if (REG_P (operands[0]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"N	%0,%2\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"NC	%O0(4,%R0),%2\";
+}"
+   [(set_attr "length" "6")]
+)
+
+(define_insn "andsi3"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(and:SI (match_operand:SI 1 "general_operand" "%0")
+		(match_operand:SI 2 "general_operand" "g")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* and sets CC but not how we want it */
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"NR	%0,%2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"N	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; andhi3 instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (match_operand:HI 0 "r_or_s_operand" "=d,m")
+	(and:HI (match_operand:HI 1 "r_or_s_operand" "%0,0")
+		(match_operand:HI 2 "r_or_s_operand" "di,mi")))]
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* and sets CC but not how we want it */
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"NR	%0,%2\";
+    }
+  if (REG_P (operands[0]))
+    {
+      /* %K2 == sign extend operand to 32 bits so that CH works */
+      mvs_check_page (0, 4, 0);
+      if (GET_CODE (operands[2]) == CONST_INT)
+         return \"N	%0,%K2\";
+      return \"N	%0,%2\";
+    }
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      mvs_check_page (0, 6, 0);
+      return \"NC	%O0(2,%R0),%H2\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"NC	%O0(2,%R0),%2\";
+}"
+   [(set_attr "length" "6")]
+)
+
+(define_insn "andhi3"
+  [(set (match_operand:HI 0 "general_operand" "=d")
+	(and:HI (match_operand:HI 1 "general_operand" "%0")
+		(match_operand:HI 2 "general_operand" "di")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* and sets CC but not how we want it */
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      /* %K2 == sign extend operand to 32 bits so that CH works */
+      mvs_check_page (0, 4, 0);
+      return \"N	%0,%K2\";
+    }
+  mvs_check_page (0, 2, 0);
+  return \"NR	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; andqi3 instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (match_operand:QI 0 "r_or_s_operand" "=d,m")
+	(and:QI (match_operand:QI 1 "r_or_s_operand" "%0,0")
+		(match_operand:QI 2 "r_or_s_operand" "di,mi")))]
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* and sets CC but not how we want it */
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"NR	%0,%2\";
+    }
+  if (REG_P (operands[0]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"N	%0,%2\";
+    }
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 0);
+      return \"NI	%0,%B2\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"NC	%O0(1,%R0),%2\";
+}"
+   [(set_attr "length" "6")]
+)
+
+(define_insn "andqi3"
+  [(set (match_operand:QI 0 "general_operand" "=d")
+	(and:QI (match_operand:QI 1 "general_operand" "%0")
+		(match_operand:QI 2 "general_operand" "di")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* and sets CC but not how we want it */
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 0);
+      return \"N	%0,%2\";
+    }
+  mvs_check_page (0, 2, 0);
+  return \"NR	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;;
+;;- Bit set (inclusive or) instructions.
+;;
+
+;
+; iordi3 instruction pattern(s).
+;
+
+;(define_expand "iordi3"
+;  [(set (match_operand:DI 0 "general_operand" "")
+;	(ior:DI (match_operand:DI 1 "general_operand" "")
+;		(match_operand:DI 2 "general_operand" "")))]
+;  ""
+;  "
+;{
+;  rtx gen_iorsi3();
+;
+;  emit_insn (gen_iorsi3 (operand_subword (operands[0], 0, 1, DImode),
+;			 operand_subword (operands[1], 0, 1, DImode),
+;			 operand_subword (operands[2], 0, 1, DImode)));
+;  emit_insn (gen_iorsi3 (gen_lowpart (SImode, operands[0]),
+;			 gen_lowpart (SImode, operands[1]),
+;			 gen_lowpart (SImode, operands[2])));
+;  DONE;
+;}")
+
+;
+; iorsi3 instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (match_operand:SI 0 "r_or_s_operand" "=d,m")
+	(ior:SI (match_operand:SI 1 "r_or_s_operand" "%0,0")
+		(match_operand:SI 2 "r_or_s_operand" "g,Si")))]
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* OR sets CC but not how we want it */
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"OR	%0,%2\";
+    }
+  if (REG_P (operands[0]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"O	%0,%2\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"OC	%O0(4,%R0),%2\";
+}"
+  [(set_attr "length" "6")]
+)
+
+(define_insn "iorsi3"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(ior:SI (match_operand:SI 1 "general_operand" "%0")
+		(match_operand:SI 2 "general_operand" "g")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* OR sets CC but not how we want it */
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"OR	%0,%2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"O	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; iorhi3 instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (match_operand:HI 0 "r_or_s_operand" "=d,m")
+	(ior:HI (match_operand:HI 1 "r_or_s_operand" "%0,0")
+		(match_operand:HI 2 "r_or_s_operand" "di,mi")))]
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* OR sets CC but not how we want it */
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"OR	%0,%2\";
+    }
+  if (REG_P (operands[0]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"O	%0,%2\";
+    }
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      mvs_check_page (0, 6, 2);
+      return \"OC	%O0(2,%R0),%H2\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"OC	%O0(2,%R0),%2\";
+}"
+   [(set_attr "length" "6")]
+)
+
+(define_insn "iorhi3"
+  [(set (match_operand:HI 0 "general_operand" "=d")
+	(ior:HI (match_operand:HI 1 "general_operand" "%0")
+		(match_operand:HI 2 "general_operand" "di")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* OR sets CC but not how we want it */
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 0);
+      return \"O	%0,%2\";
+    }
+  mvs_check_page (0, 2, 0);
+  return \"OR	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;
+; iorqi3 instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (match_operand:QI 0 "r_or_s_operand" "=d,m")
+	(ior:QI (match_operand:QI 1 "r_or_s_operand" "%0,0")
+		(match_operand:QI 2 "r_or_s_operand" "di,mi")))]
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* OR sets CC but not how we want it */
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"OR	%0,%2\";
+    }
+  if (REG_P (operands[0]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"O	%0,%2\";
+    }
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 0);
+      return \"OI	%0,%B2\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"OC	%O0(1,%R0),%2\";
+}"
+   [(set_attr "length" "6")]
+)
+
+(define_insn "iorqi3"
+  [(set (match_operand:QI 0 "general_operand" "=d")
+	(ior:QI (match_operand:QI 1 "general_operand" "%0")
+		(match_operand:QI 2 "general_operand" "di")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* OR sets CC but not how we want it */
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 0);
+      return \"O	%0,%2\";
+    }
+  mvs_check_page (0, 2, 0);
+  return \"OR	%0,%2\";
+}"
+   [(set_attr "length" "4")]
+)
+
+;;
+;;- Xor instructions.
+;;
+
+;
+; xordi3 instruction pattern(s).
+;
+
+;(define_expand "xordi3"
+;  [(set (match_operand:DI 0 "general_operand" "")
+;	(xor:DI (match_operand:DI 1 "general_operand" "")
+;		(match_operand:DI 2 "general_operand" "")))]
+;  ""
+;  "
+;{
+;  rtx gen_xorsi3();
+;
+;  emit_insn (gen_xorsi3 (operand_subword (operands[0], 0, 1, DImode),
+;			 operand_subword (operands[1], 0, 1, DImode),
+;			 operand_subword (operands[2], 0, 1, DImode)));
+;  emit_insn (gen_xorsi3 (gen_lowpart (SImode, operands[0]),
+;			 gen_lowpart (SImode, operands[1]),
+;			 gen_lowpart (SImode, operands[2])));
+;  DONE;
+;}")
+
+;
+; xorsi3 instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (match_operand:SI 0 "r_or_s_operand" "=d,m")
+	(xor:SI (match_operand:SI 1 "r_or_s_operand" "%0,0")
+		(match_operand:SI 2 "r_or_s_operand" "g,mi")))]
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* XOR sets CC but not how we want it */
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"XR	%0,%2\";
+    }
+  if (REG_P (operands[0]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"X	%0,%2\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"XC	%O0(4,%R0),%2\";
+}"
+   [(set_attr "length" "6")]
+)
+
+(define_insn "xorsi3"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(xor:SI (match_operand:SI 1 "general_operand" "%0")
+		(match_operand:SI 2 "general_operand" "g")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* XOR sets CC but not how we want it */
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"XR	%0,%2\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"X	%0,%2\";
+}"
+  [(set_attr "length" "4")]
+)
+
+;
+; xorhi3 instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (match_operand:HI 0 "r_or_s_operand" "=d,m")
+	(xor:HI (match_operand:HI 1 "r_or_s_operand" "%0,0")
+		(match_operand:HI 2 "r_or_s_operand" "di,mi")))]
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* XOR sets CC but not how we want it */
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"XR	%0,%2\";
+    }
+  if (REG_P (operands[0]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"X	%0,%H2\";
+    }
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      mvs_check_page (0, 6, 0);
+      return \"XC	%O0(2,%R0),%H2\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"XC	%O0(2,%R0),%2\";
+}"
+  [(set_attr "length" "6")]
+)
+
+(define_insn "xorhi3"
+  [(set (match_operand:HI 0 "general_operand" "=d")
+	(xor:HI (match_operand:HI 1 "general_operand" "%0")
+		(match_operand:HI 2 "general_operand" "di")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* XOR sets CC but not how we want it */
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 0);
+      return \"X	%0,%H2\";
+    }
+  mvs_check_page (0, 2, 0);
+  return \"XR	%0,%2\";
+}"
+  [(set_attr "length" "4")]
+)
+
+;
+; xorqi3 instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (match_operand:QI 0 "r_or_s_operand" "=d,m")
+	(xor:QI (match_operand:QI 1 "r_or_s_operand" "%0,0")
+		(match_operand:QI 2 "r_or_s_operand" "di,mi")))]
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* XOR sets CC but not how we want it */
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"XR	%0,%2\";
+    }
+  if (REG_P (operands[0]))
+    {
+      mvs_check_page (0, 4, 0);
+      return \"X	%0,%2\";
+    }
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 0);
+      return \"XI	%0,%B2\";
+    }
+  mvs_check_page (0, 6, 0);
+  return \"XC	%O0(1,%R0),%2\";
+}"
+  [(set_attr "length" "6")]
+)
+
+(define_insn "xorqi3"
+  [(set (match_operand:QI 0 "general_operand" "=d")
+	(xor:QI (match_operand:QI 1 "general_operand" "%0")
+		(match_operand:QI 2 "general_operand" "di")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* XOR sets CC but not how we want it */
+  if (GET_CODE (operands[2]) == CONST_INT)
+    {
+      mvs_check_page (0, 4, 0);
+      return \"X	%0,%2\";
+    }
+  mvs_check_page (0, 2, 0);
+  return \"XR	%0,%2\";
+}"
+  [(set_attr "length" "4")]
+)
+
+;;
+;;- Negate instructions.
+;;
+
+;
+; negsi2 instruction pattern(s).
+;
+
+(define_insn "negsi2"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(neg:SI (match_operand:SI 1 "general_operand" "d")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 2, 0);
+  return \"LCR	%0,%1\";
+}"
+  [(set_attr "length" "2")]
+)
+
+;
+; neghi2 instruction pattern(s).
+;
+
+(define_insn "neghi2"
+  [(set (match_operand:HI 0 "general_operand" "=d")
+	(neg:HI (match_operand:HI 1 "general_operand" "d")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 10, 0);
+  return \"SLL	%1,16\;SRA	%1,16\;LCR	%0,%1\";
+}"
+  [(set_attr "length" "10")]
+)
+
+;
+; negdf2 instruction pattern(s).
+;
+
+(define_insn "negdf2"
+  [(set (match_operand:DF 0 "general_operand" "=f")
+	(neg:DF (match_operand:DF 1 "general_operand" "f")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 2, 0);
+  return \"LCDR	%0,%1\";
+}"
+  [(set_attr "length" "2")]
+)
+
+;
+; negsf2 instruction pattern(s).
+;
+
+(define_insn "negsf2"
+  [(set (match_operand:SF 0 "general_operand" "=f")
+	(neg:SF (match_operand:SF 1 "general_operand" "f")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 2, 0);
+  return \"LCER	%0,%1\";
+}"
+  [(set_attr "length" "2")]
+)
+
+;;
+;;- Absolute value instructions.
+;;
+
+;
+; abssi2 instruction pattern(s).
+;
+
+(define_insn "abssi2"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(abs:SI (match_operand:SI 1 "general_operand" "d")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 2, 0);
+  return \"LPR	%0,%1\";
+}"
+  [(set_attr "length" "2")]
+)
+
+;
+; abshi2 instruction pattern(s).
+;
+
+(define_insn "abshi2"
+  [(set (match_operand:HI 0 "general_operand" "=d")
+	(abs:HI (match_operand:HI 1 "general_operand" "d")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 10, 0);
+  return \"SLL	%1,16\;SRA	%1,16\;LPR	%0,%1\";
+}"
+  [(set_attr "length" "10")]
+)
+
+;
+; absdf2 instruction pattern(s).
+;
+
+(define_insn "absdf2"
+  [(set (match_operand:DF 0 "general_operand" "=f")
+	(abs:DF (match_operand:DF 1 "general_operand" "f")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 2, 0);
+  return \"LPDR	%0,%1\";
+}"
+  [(set_attr "length" "2")]
+)
+
+;
+; abssf2 instruction pattern(s).
+;
+
+(define_insn "abssf2"
+  [(set (match_operand:SF 0 "general_operand" "=f")
+	(abs:SF (match_operand:SF 1 "general_operand" "f")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 2, 0);
+  return \"LPER	%0,%1\";
+}"
+  [(set_attr "length" "2")]
+)
+
+;;
+;;- One complement instructions.
+;;
+
+;
+; one_cmpldi2 instruction pattern(s).
+;
+
+;(define_expand "one_cmpldi2"
+;  [(set (match_operand:DI 0 "general_operand" "")
+;	(not:DI (match_operand:DI 1 "general_operand" "")))]
+;  ""
+;  "
+;{
+;  rtx gen_one_cmplsi2();
+;
+;  emit_insn (gen_one_cmplsi2 (operand_subword (operands[0], 0, 1, DImode),
+;			      operand_subword (operands[1], 0, 1, DImode)));
+;  emit_insn (gen_one_cmplsi2 (gen_lowpart (SImode, operands[0]),
+;			      gen_lowpart (SImode, operands[1])));
+;  DONE;
+;}")
+
+;
+; one_cmplsi2 instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (match_operand:SI 0 "r_or_s_operand" "=dm")
+	(not:SI (match_operand:SI 1 "r_or_s_operand" "0")))]
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* XOR sets CC but not how we want it */
+  if (REG_P (operands[0]))
+    {
+      mvs_check_page (0, 4, 4);
+      return \"X	%0,=F'-1'\";
+    }
+  CC_STATUS_INIT;
+  mvs_check_page (0, 6, 4);
+  return \"XC	%O0(4,%R0),=F'-1'\";
+}"
+  [(set_attr "length" "6")]
+)
+
+(define_insn "one_cmplsi2"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(not:SI (match_operand:SI 1 "general_operand" "0")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* XOR sets CC but not how we want it */
+  mvs_check_page (0, 4, 4);
+  return \"X	%0,=F'-1'\";
+}"
+  [(set_attr "length" "4")]
+)
+
+;
+; one_cmplhi2 instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (match_operand:HI 0 "r_or_s_operand" "=dm")
+	(not:HI (match_operand:HI 1 "r_or_s_operand" "0")))]
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* XOR sets CC but not how we want it */
+  if (REG_P (operands[0]))
+    {
+      mvs_check_page (0, 4, 4);
+      return \"X	%0,=F'-1'\";
+    }
+  mvs_check_page (0, 6, 4);
+  return \"XC	%O0(2,%R0),=XL4'FFFF'\";
+}"
+  [(set_attr "length" "6")]
+)
+
+(define_insn "one_cmplhi2"
+  [(set (match_operand:HI 0 "general_operand" "=d")
+	(not:HI (match_operand:HI 1 "general_operand" "0")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* XOR sets CC but not how we want it */
+  mvs_check_page (0, 4, 4);
+  return \"X	%0,=F'-1'\";
+}"
+  [(set_attr "length" "4")]
+)
+
+;
+; one_cmplqi2 instruction pattern(s).
+;
+
+(define_insn ""
+  [(set (match_operand:QI 0 "r_or_s_operand" "=dm")
+	(not:QI (match_operand:QI 1 "r_or_s_operand" "0")))]
+  "TARGET_CHAR_INSTRUCTIONS"
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* XOR sets CC but not how we want it */
+  if (REG_P (operands[0]))
+    {
+      mvs_check_page (0, 4, 4);
+      return \"X	%0,=F'-1'\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"XI	%0,255\";
+}"
+  [(set_attr "length" "4")]
+)
+
+(define_insn "one_cmplqi2"
+  [(set (match_operand:QI 0 "general_operand" "=d")
+	(not:QI (match_operand:QI 1 "general_operand" "0")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT;  /* XOR sets CC but not how we want it */
+  mvs_check_page (0, 4, 4);
+  return \"X	%0,=F'-1'\";
+}"
+  [(set_attr "length" "4")]
+)
+
+;;
+;;- Arithmetic shift instructions.
+;;
+
+;
+; ashldi3 instruction pattern(s).
+;
+
+(define_insn "ashldi3"
+  [(set (match_operand:DI 0 "general_operand" "=d")
+	(ashift:DI (match_operand:DI 1 "general_operand" "0")
+		   (match_operand:SI 2 "general_operand" "Ja")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  /* this status set seems not have the desired effect,
+   * proably because the 64-bit long-long test is emulated ?! */
+  CC_STATUS_SET (operands[0], operands[1]);
+  mvs_check_page (0, 4, 0);
+  if (REG_P (operands[2]))
+    return \"SLDA	%0,0(%2)\";
+  return \"SLDA	%0,%c2\";
+}"
+  [(set_attr "length" "4")]
+)
+
+;
+; ashrdi3 instruction pattern(s).
+;
+
+(define_insn "ashrdi3"
+  [(set (match_operand:DI 0 "register_operand" "=d")
+	(ashiftrt:DI (match_operand:DI 1 "general_operand" "0")
+		     (match_operand:SI 2 "general_operand" "Ja")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  /* this status set seems not have the desired effect,
+   * proably because the 64-bit long-long test is emulated ?! */
+  CC_STATUS_SET (operands[0], operands[1]);
+  mvs_check_page (0, 4, 0);
+  if (REG_P (operands[2])) 
+    return \"SRDA	%0,0(%2)\";
+  return \"SRDA	%0,%c2\";
+}"
+  [(set_attr "length" "4")]
+)
+
+;
+; ashlsi3 instruction pattern(s).
+;
+
+(define_insn "ashlsi3"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(ashift:SI (match_operand:SI 1 "general_operand" "0")
+		   (match_operand:SI 2 "general_operand" "Ja")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (REG_P (operands[2])) 
+    return \"SLL	%0,0(%2)\";
+  return \"SLL	%0,%c2\";
+}"
+  [(set_attr "length" "4")]
+)
+
+;
+; ashrsi3 instruction pattern(s).
+;
+
+(define_insn "ashrsi3"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(ashiftrt:SI (match_operand:SI 1 "general_operand" "0")
+		     (match_operand:SI 2 "general_operand" "Ja")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_SET (operands[0], operands[1]);
+  mvs_check_page (0, 4, 0);
+  if (REG_P (operands[2])) 
+    return \"SRA	%0,0(%2)\";
+  return \"SRA	%0,%c2\";
+}"
+  [(set_attr "length" "4")]
+)
+
+;
+; ashlhi3 instruction pattern(s).
+;
+
+(define_insn "ashlhi3"
+  [(set (match_operand:HI 0 "general_operand" "=d")
+	(ashift:HI (match_operand:HI 1 "general_operand" "0")
+		   (match_operand:SI 2 "general_operand" "Ja")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 8, 0);
+  if (REG_P (operands[2])) 
+    return \"SLL	%0,16(%2)\;SRA	%0,16\";
+  return \"SLL	%0,16+%c2\;SRA	%0,16\";
+}"
+  [(set_attr "length" "8")]
+)
+
+;
+; ashrhi3 instruction pattern(s).
+;
+
+(define_insn "ashrhi3"
+  [(set (match_operand:HI 0 "general_operand" "=d")
+	(ashiftrt:HI (match_operand:HI 1 "general_operand" "0")
+		     (match_operand:SI 2 "general_operand" "Ja")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 8, 0);
+  if (REG_P (operands[2])) 
+    return \"SLL	%0,16\;SRA	%0,16(%2)\";
+  return \"SLL	%0,16\;SRA	%0,16+%c2\";
+}"
+  [(set_attr "length" "8")]
+)
+
+;
+; ashlqi3 instruction pattern(s).
+;
+
+(define_insn "ashlqi3"
+  [(set (match_operand:QI 0 "general_operand" "=d")
+	(ashift:QI (match_operand:QI 1 "general_operand" "0")
+		   (match_operand:SI 2 "general_operand" "Ja")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (REG_P (operands[2])) 
+    return \"SLL	%0,0(%2)\";
+  return \"SLL	%0,%c2\";
+}"
+  [(set_attr "length" "4")]
+)
+
+;
+; ashrqi3 instruction pattern(s).
+;
+
+(define_insn "ashrqi3"
+  [(set (match_operand:QI 0 "general_operand" "=d")
+	(ashiftrt:QI (match_operand:QI 1 "general_operand" "0")
+		     (match_operand:SI 2 "general_operand" "Ja")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 8, 0);
+  if (REG_P (operands[2])) 
+    return \"SLL	%0,24\;SRA	%0,24(%2)\";
+  return \"SLL	%0,24\;SRA	%0,24+%c2\";
+}"
+  [(set_attr "length" "8")]
+)
+
+;;
+;;- Logical shift instructions.
+;;
+
+;
+; lshrdi3 instruction pattern(s).
+;
+
+(define_insn "lshrdi3"
+  [(set (match_operand:DI 0 "general_operand" "=d")
+	(lshiftrt:DI (match_operand:DI 1 "general_operand" "0")
+		     (match_operand:SI 2 "general_operand" "Ja")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (REG_P (operands[2])) 
+    return \"SRDL	%0,0(%2)\";
+  return \"SRDL	%0,%c2\";
+}"
+  [(set_attr "length" "4")]
+)
+
+
+;
+; lshrsi3 instruction pattern(s).
+;
+
+(define_insn "lshrsi3"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(lshiftrt:SI (match_operand:SI 1 "general_operand" "0")
+		     (match_operand:SI 2 "general_operand" "Ja")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (REG_P (operands[2])) 
+    return \"SRL	%0,0(%2)\";
+  return \"SRL	%0,%c2\";
+}"
+  [(set_attr "length" "4")]
+)
+
+;
+; lshrhi3 instruction pattern(s).
+;
+
+(define_insn "lshrhi3"
+  [(set (match_operand:HI 0 "general_operand" "=d")
+	(lshiftrt:HI (match_operand:HI 1 "general_operand" "0")
+		     (match_operand:SI 2 "general_operand" "Ja")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT; /* AND sets the CC but not how we want it */
+  if (REG_P (operands[2]))
+    {
+      mvs_check_page (0, 8, 4);
+      return \"N	%0,=XL4'0000FFFF'\;SRL	%0,0(%2)\";
+    }
+  mvs_check_page (0, 8, 4);
+  return \"N	%0,=XL4'0000FFFF'\;SRL	%0,%c2\";
+}"
+  [(set_attr "length" "8")]
+)
+
+;
+; lshrqi3 instruction pattern(s).
+;
+
+(define_insn "lshrqi3"
+  [(set (match_operand:QI 0 "general_operand" "=d")
+	(lshiftrt:QI (match_operand:QI 1 "general_operand" "0")
+		     (match_operand:SI 2 "general_operand" "Ja")))]
+  ""
+  "*
+{
+  check_label_emit ();
+  CC_STATUS_INIT; /* AND sets the CC but not how we want it */
+  mvs_check_page (0, 8, 4);
+  if (REG_P (operands[2])) 
+    return \"N	%0,=XL4'000000FF'\;SRL	%0,0(%2)\";
+  return \"N	%0,=XL4'000000FF'\;SRL	%0,%c2\";
+}"
+  [(set_attr "length" "8")]
+)
+
+;; =======================================================================
+;;- Conditional jump instructions.
+;; =======================================================================
+
+;
+; beq instruction pattern(s).
+;
+
+(define_insn "beq"
+  [(set (pc)
+	(if_then_else (eq (cc0)
+			  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BE	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BER	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+;
+; bne instruction pattern(s).
+;
+
+(define_insn "bne"
+  [(set (pc)
+	(if_then_else (ne (cc0)
+			  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BNE	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BNER	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+;
+; bgt instruction pattern(s).
+;
+
+(define_insn "bgt"
+  [(set (pc)
+	(if_then_else (gt (cc0)
+			  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BH	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BHR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+;
+; bgtu instruction pattern(s).
+;
+
+(define_insn "bgtu"
+  [(set (pc)
+	(if_then_else (gtu (cc0)
+			   (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BH	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BHR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+;
+; blt instruction pattern(s).
+;
+
+(define_insn "blt"
+  [(set (pc)
+	(if_then_else (lt (cc0)
+			  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BL	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BLR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+;
+; bltu instruction pattern(s).
+;
+
+(define_insn "bltu"
+  [(set (pc)
+	(if_then_else (ltu (cc0)
+			   (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BL	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BLR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+;
+; bge instruction pattern(s).
+;
+
+(define_insn "bge"
+  [(set (pc)
+	(if_then_else (ge (cc0)
+			  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BNL	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BNLR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+;
+; bgeu instruction pattern(s).
+;
+
+(define_insn "bgeu"
+  [(set (pc)
+	(if_then_else (geu (cc0)
+			   (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BNL	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BNLR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+;
+; ble instruction pattern(s).
+;
+
+(define_insn "ble"
+  [(set (pc)
+	(if_then_else (le (cc0)
+			  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BNH	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BNHR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+;
+; bleu instruction pattern(s).
+;
+
+(define_insn "bleu"
+  [(set (pc)
+	(if_then_else (leu (cc0)
+			   (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BNH	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BNHR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+;;
+;;- Negated conditional jump instructions.
+;;
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (eq (cc0)
+			  (const_int 0))
+		      (pc)
+		      (label_ref (match_operand 0 "" ""))))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BNE	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BNER	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (ne (cc0)
+			  (const_int 0))
+		      (pc)
+		      (label_ref (match_operand 0 "" ""))))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BE	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BER	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (gt (cc0)
+			  (const_int 0))
+		      (pc)
+		      (label_ref (match_operand 0 "" ""))))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BNH	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BNHR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (gtu (cc0)
+			   (const_int 0))
+		      (pc)
+		      (label_ref (match_operand 0 "" ""))))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BNH	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BNHR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (lt (cc0)
+			  (const_int 0))
+		      (pc)
+		      (label_ref (match_operand 0 "" ""))))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BNL	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BNLR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (ltu (cc0)
+			   (const_int 0))
+		      (pc)
+		      (label_ref (match_operand 0 "" ""))))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BNL	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BNLR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (ge (cc0)
+			  (const_int 0))
+		      (pc)
+		      (label_ref (match_operand 0 "" ""))))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BL	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BLR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (geu (cc0)
+			   (const_int 0))
+		      (pc)
+		      (label_ref (match_operand 0 "" ""))))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BL	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BLR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (le (cc0)
+			  (const_int 0))
+		      (pc)
+		      (label_ref (match_operand 0 "" ""))))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BH	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BHR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (leu (cc0)
+			   (const_int 0))
+		      (pc)
+		      (label_ref (match_operand 0 "" ""))))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    { 
+      return \"BH	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BHR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+;; ==============================================================
+;;- Subtract one and jump if not zero.
+;; These insns seem to not be getting matched ...
+;; XXX should fix this, as it would improve for loops
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else
+	 (ne (plus:SI (match_operand:SI 0 "register_operand" "+d")
+		      (const_int -1))
+	     (const_int 0))
+	 (label_ref (match_operand 1 "" ""))
+	 (pc)))
+   (set (match_dup 0)
+	(plus:SI (match_dup 0)
+		 (const_int -1)))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (mvs_check_label (CODE_LABEL_NUMBER (operands[1])))
+    {
+      return \"BCT	%0,%l1\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l1)\;BCTR	%0,14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else
+	 (eq (plus:SI (match_operand:SI 0 "register_operand" "+d")
+		      (const_int -1))
+	     (const_int 0))
+	 (pc)
+	 (label_ref (match_operand 1 "" ""))))
+   (set (match_dup 0)
+	(plus:SI (match_dup 0)
+		 (const_int -1)))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (mvs_check_label (CODE_LABEL_NUMBER (operands[1])))
+    {
+      return \"BCT	%0,%l1\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l1)\;BCTR	%0,14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+;; =============================================================
+;;- Unconditional jump instructions.
+;;
+
+;
+; jump instruction pattern(s).
+;
+
+(define_insn "jump"
+  [(set (pc)
+	(label_ref (match_operand 0 "" "")))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 4, 0);
+  if (i370_short_branch(insn) || mvs_check_label (CODE_LABEL_NUMBER (operands[0])))
+    {
+      return \"B	%l0\";
+    }
+  mvs_check_page (0, 2, 4);
+  return \"L	14,=A(%l0)\;BR	14\";
+}"
+  [(set_attr "length" "6")]
+)
+
+;
+; indirect-jump instruction pattern(s).
+; hack alert -- should check that displacement is < 4096
+
+(define_insn "indirect_jump"
+  [(set (pc) (match_operand:SI 0 "general_operand" "rm"))]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      mvs_check_page (0, 2, 0);
+      return \"BR	%0\";
+    }
+  mvs_check_page (0, 4, 0);
+  return \"B	%0\";
+}"
+  [(set_attr "length" "4")]
+)
+
+;
+; tablejump instruction pattern(s).
+;
+
+(define_insn "tablejump"
+  [(set (pc)
+	(match_operand:SI 0 "general_operand" "am"))
+   (use (label_ref (match_operand 1 "" "")))
+;   (clobber (reg:SI 14))
+   ]
+  ""
+  "*
+{
+  check_label_emit ();
+  if (REG_P (operands[0]))
+    {
+      mvs_check_page (0, 6, 0);
+      return \"BR	%0\;DS	0F\";
+    }
+  mvs_check_page (0, 10, 0);
+  return \"L	14,%0\;BR	14\;DS	0F\";
+}"
+  [(set_attr "length" "10")]
+)
+
+;;
+;;- Jump to subroutine.
+;;
+;; For the C/370 environment the internal functions, ie. sqrt, are called with
+;; a non-standard form.  So, we must fix it here.  There's no BM like IBM.
+;;
+;; The ELF ABI is different from the C/370 ABI because we have a simpler,
+;; more powerful way of dealing with structure-value returns.  Basically, 
+;; we use R1 to point at structure returns (64-bit and larger returns)
+;; and R11 to point at the args.  Note that this handles double-precision
+;; (64-bit) values just fine, in a less-kludged manner than the C/370 ABI.
+;; Since R1 is used, we use R2 to pass the argument pointer to the routine.
+
+;
+; call instruction pattern(s).
+;
+; We define four call instruction patterns below. The first two patterns,
+; although general, end up matching (only?) calls through function pointers.  
+; The last two, which require a symbol-ref to match, get used for all
+; ordinary subroutine calls.
+
+(define_insn "call"
+  [(call (match_operand:QI 0 "memory_operand" "m")
+	 (match_operand:SI 1 "immediate_operand" "i"))
+   (clobber (reg:SI 2))
+   ]
+  ""
+  "*
+{
+  static char temp[128];
+  int i = STACK_POINTER_OFFSET;
+  CC_STATUS_INIT;
+
+  check_label_emit ();
+#ifdef TARGET_ELF_ABI
+  mvs_check_page (0, 10, 4);
+  sprintf ( temp, \"LA	r2,%d(,sp)\;LA	15,%%0\;BASR	14,15\", i );
+  return temp;
+#else
+  if (mvs_function_check (XSTR (operands[0], 0)))
+    {
+      mvs_check_page (0, 22, 4);
+      sprintf ( temp, \"LA	1,136(,13)\;ST	1,%d(,13)\;LA 1,%d(,13)\;LA	15,%%0\;BALR	14,15\;LD	0,136(,13)\",
+	     i - 4, i - 4 );
+    }
+  else
+    {
+      mvs_check_page (0, 10, 4);
+      sprintf ( temp, \"LA	1,%d(,13)\;LA	15,%%0\;BALR	14,15\", i );
+    }
+  return temp;
+#endif
+}"
+  [(set_attr "length" "22")]
+)
+
+;
+; call_value instruction pattern(s).
+;
+
+(define_insn "call_value"
+  [(set (match_operand 0 "" "=rf")
+ 	(call (match_operand:QI 1 "memory_operand" "m")
+ 	      (match_operand:SI 2 "general_operand" "i")))
+   (clobber (reg:SI 2))
+   ]
+  ""
+  "*
+{
+  static char temp[128];
+  int i = STACK_POINTER_OFFSET;
+  CC_STATUS_INIT;
+
+  check_label_emit ();
+#ifdef TARGET_ELF_ABI
+  mvs_check_page (0, 10, 4);
+  sprintf ( temp, \"LA	r2,%d(,sp)\;LA	15,%%1\;BASR	14,15\", i );
+  return temp;
+#else
+  if (mvs_function_check (XSTR (operands[1], 0)))
+    {
+      mvs_check_page (0, 22, 4);
+      sprintf ( temp, \"LA	1,136(,13)\;ST	1,%d(,13)\;LA 1,%d(,13)\;LA	15,%%1\;BALR	14,15\;LD	0,136(,13)\",
+	   i - 4, i - 4 );
+    }
+  else
+    {
+      mvs_check_page (0, 10, 4);
+      sprintf ( temp, \"LA	1,%d(,13)\;LA	15,%%1\;BALR	14,15\", i );
+    }
+  return temp;
+#endif
+}"
+  [(set_attr "length" "22")]
+)
+
+(define_insn ""
+  [(call (mem:QI (match_operand:SI 0 "" "i"))
+	 (match_operand:SI 1 "general_operand" "g"))
+   (clobber (reg:SI 2))
+   ]
+  "GET_CODE (operands[0]) == SYMBOL_REF"
+  "*
+{
+  static char temp[128];
+  int i = STACK_POINTER_OFFSET;
+  CC_STATUS_INIT;
+
+  check_label_emit ();
+#ifdef TARGET_ELF_ABI
+  mvs_check_page (0, 10, 4);
+  sprintf ( temp, \"LA	r2,%d(,sp)\;L	15,%%0\;BASR	14,15\", i );
+  return temp;
+#else
+  if (mvs_function_check (XSTR (operands[0], 0)))
+    {
+      mvs_check_page (0, 22, 4);
+      sprintf ( temp, \"LA	1,136(,13)\;ST	1,%d(,13)\;LA	1,%d(,13)\;L	15,%%0\;BALR	14,15\;LD	0,136(,13)\",
+	   i - 4, i - 4 );
+    }
+  else
+    {
+      mvs_check_page (0, 10, 4);
+      sprintf ( temp, \"LA	1,%d(,13)\;L	15,%%0\;BALR	14,15\", i );
+    }
+  return temp;
+#endif
+}"
+  [(set_attr "length" "22")]
+)
+
+(define_insn ""
+  [(set (match_operand 0 "" "=rf")
+	(call (mem:QI (match_operand:SI 1 "" "i"))
+	      (match_operand:SI 2 "general_operand" "g")))
+   (clobber (reg:SI 2))
+   ]
+  "GET_CODE (operands[1]) == SYMBOL_REF"
+  "*
+{
+  static char temp[128];
+  int i = STACK_POINTER_OFFSET;
+  CC_STATUS_INIT;
+
+  check_label_emit ();
+#ifdef TARGET_ELF_ABI
+  mvs_check_page (0, 10, 4);
+  sprintf ( temp, \"LA	r2,%d(,sp)\;L	15,%%1\;BASR	14,15\", i );
+  return temp;
+#else
+  if (mvs_function_check (XSTR (operands[1], 0)))
+    {
+      mvs_check_page (0, 22, 4);
+      sprintf ( temp, \"LA	1,136(,13)\;ST	1,%d(,13)\;LA	1,%d(,13)\;L	15,%%1\;BALR	14,15\;LD	0,136(,13)\",
+	   i - 4, i - 4 );
+    }
+  else
+    {
+      mvs_check_page (0, 10, 4);
+      sprintf ( temp, \"LA	1,%d(,13)\;L	15,%%1\;BALR	14,15\", i );
+    }
+  return temp;
+#endif
+}"
+  [(set_attr "length" "22")]
+)
+
+;;
+;; Call subroutine returning any type.
+;; This instruction pattern appears to be used only by the
+;; expand_builtin_apply definition for __builtin_apply.  It is needed
+;; since call_value might return an int in r15 or a float in fpr0 (r16)
+;; and the builtin code calls abort since the reg is ambiguous. Well,
+;; the below is probably broken anyway, we just want to go for now.
+;;
+(define_expand "untyped_call"
+[(parallel [(call (match_operand 0 "" "")
+                  (const_int 0))
+              (match_operand 1 "" "")
+              (match_operand 2 "" "")])]
+  ""
+  "
+{
+  int i;
+
+  emit_call_insn (GEN_CALL (operands[0], const0_rtx, const0_rtx, const0_rtx));
+
+  for (i = 0; i < XVECLEN (operands[2], 0); i++)
+    {
+      rtx set = XVECEXP (operands[2], 0, i);
+      emit_move_insn (SET_DEST (set), SET_SRC (set));
+    }
+
+  /* The optimizer does not know that the call sets the function value
+     registers we stored in the result block.  We avoid problems by
+     claiming that all hard registers are used and clobbered at this
+     point.  */
+  /* emit_insn (gen_blockage ()); */
+
+  DONE;
+}")
+
+
+;;
+;;- Miscellaneous instructions.
+;;
+
+;
+; nop instruction pattern(s).
+;
+
+(define_insn "nop"
+  [(const_int 0)]
+  ""
+  "*
+{
+  check_label_emit ();
+  mvs_check_page (0, 2, 0);
+  return \"LR	0,0\";
+}"
+  [(set_attr "length" "2")]
+)
diff --git a/gcc/config/i370/linux.h b/gcc/config/i370/linux.h
new file mode 100644
index 00000000000..f402fbde9f3
--- /dev/null
+++ b/gcc/config/i370/linux.h
@@ -0,0 +1,113 @@
+/* Definitions of target machine for GNU compiler.  System/370 version.
+   Copyright (C) 1989, 1993, 1995, 1996, 1997, 2003
+   Free Software Foundation, Inc.
+   Contributed by Jan Stein (jan@cd.chalmers.se).
+   Modified for Linux/390 by Linas Vepstas (linas@linas.org)
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+
+#define TARGET_VERSION fprintf (stderr, " (i370 GNU/Linux with ELF)");
+
+/* Specify that we're generating code for a Linux port to 370 */
+
+#define TARGET_ELF_ABI
+
+/* Target OS preprocessor built-ins.  */
+#define TARGET_OS_CPP_BUILTINS() LINUX_TARGET_OS_CPP_BUILTINS()
+
+/* Options for this target machine.  */
+
+#define LIBGCC_SPEC "libgcc.a%s"
+
+#ifdef SOME_FUTURE_DAY
+ 
+#define CPP_SPEC "%{posix: -D_POSIX_SOURCE} %(cpp_sysv) %(cpp_endian_big) \
+%{mcall-linux: %(cpp_os_linux) } \
+%{!mcall-linux: %(cpp_os_default) }"
+
+#define LIB_SPEC "\
+%{mcall-linux: %(lib_linux) } \
+%{!mcall-linux:%(lib_default) }"
+
+#define STARTFILE_SPEC "\
+%{mcall-linux: %(startfile_linux) } \
+%{!mcall-linux: %(startfile_default) }"
+
+#define ENDFILE_SPEC "\
+%{mcall-linux: %(endfile_linux) } \
+%{!mcall-linux: %(endfile_default) }"
+
+/* GNU/Linux support.  */
+#ifndef LIB_LINUX_SPEC
+#define LIB_LINUX_SPEC "%{mnewlib: --start-group -llinux -lc --end-group } %{!mnewlib: -lc }"
+#endif
+
+#ifndef STARTFILE_LINUX_SPEC
+#define STARTFILE_LINUX_SPEC "\
+%{!shared: %{pg:gcrt1.o%s} %{!pg:%{p:gcrt1.o%s} %{!p:crt1.o%s}}} \
+%{mnewlib: ecrti.o%s} \
+%{!mnewlib: crti.o%s %{!shared:crtbegin.o%s} %{shared:crtbeginS.o%s}}"
+#endif
+
+#ifndef ENDFILE_LINUX_SPEC
+#define ENDFILE_LINUX_SPEC "\
+%{mnewlib: ecrtn.o%s} \
+%{!mnewlib: %{!shared:crtend.o%s} %{shared:crtendS.o%s} crtn.o%s}"
+#endif
+
+#ifndef LINK_START_LINUX_SPEC
+#define LINK_START_LINUX_SPEC "-Ttext 0x10000"
+#endif
+
+#ifndef LINK_OS_LINUX_SPEC
+#define LINK_OS_LINUX_SPEC ""
+#endif
+
+#ifndef CPP_OS_LINUX_SPEC
+#define CPP_OS_LINUX_SPEC "-D__unix__ -D__gnu_linux__ -D__linux__ \
+%{!ansi: -Dunix -Dlinux } \
+-Asystem=unix -Asystem=linux"
+#endif
+
+#ifndef CPP_OS_LINUX_SPEC
+#define CPP_OS_LINUX_SPEC ""
+#endif
+
+
+/* Define any extra SPECS that the compiler needs to generate.  */
+#undef  SUBTARGET_EXTRA_SPECS
+#define SUBTARGET_EXTRA_SPECS                                           \
+  { "lib_linux",                LIB_LINUX_SPEC },                       \
+  { "lib_default",              LIB_DEFAULT_SPEC },                     \
+  { "startfile_linux",          STARTFILE_LINUX_SPEC },                 \
+  { "startfile_default",        STARTFILE_DEFAULT_SPEC },               \
+  { "endfile_linux",            ENDFILE_LINUX_SPEC },                   \
+  { "endfile_default",          ENDFILE_DEFAULT_SPEC },                 \
+  { "link_shlib",               LINK_SHLIB_SPEC },                      \
+  { "link_target",              LINK_TARGET_SPEC },                     \
+  { "link_start",               LINK_START_SPEC },                      \
+  { "link_start_linux",         LINK_START_LINUX_SPEC },                \
+  { "link_os",                  LINK_OS_SPEC },                         \
+  { "link_os_linux",            LINK_OS_LINUX_SPEC },                   \
+  { "link_os_default",          LINK_OS_DEFAULT_SPEC },                 \
+  { "cpp_endian_big",           CPP_ENDIAN_BIG_SPEC },                  \
+  { "cpp_os_linux",             CPP_OS_LINUX_SPEC },                    \
+  { "cpp_os_default",           CPP_OS_DEFAULT_SPEC },
+
+#endif /* SOME_FUTURE_DAY */
diff --git a/gcc/config/i370/mvs.h b/gcc/config/i370/mvs.h
new file mode 100644
index 00000000000..dfb4cba188a
--- /dev/null
+++ b/gcc/config/i370/mvs.h
@@ -0,0 +1,49 @@
+/* Definitions of target machine for GNU compiler.  System/370 version.
+   Copyright (C) 1989, 1993, 1995, 1996, 1997, 2003
+   Free Software Foundation, Inc.
+   Contributed by Jan Stein (jan@cd.chalmers.se).
+   Modified for OS/390 LanguageEnvironment C by Dave Pitts (dpitts@cozx.com)
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#define TARGET_VERSION printf (" (370/MVS)");
+
+/* Specify that we're generating code for the Language Environment */
+
+#define LE370 1
+#define TARGET_EBCDIC 1
+#define TARGET_HLASM 1
+
+/* Options for the preprocessor for this target machine.  */
+
+#define CPP_SPEC "-trigraphs"
+
+/* Target OS preprocessor built-ins.  */
+#define TARGET_OS_CPP_BUILTINS()		\
+    do {					\
+	builtin_define_std ("MVS");		\
+	builtin_define_std ("mvs");		\
+	MAYBE_LE370_MACROS();			\
+	builtin_assert ("system=mvs");		\
+    } while (0)
+
+#if defined(LE370)
+# define MAYBE_LE370_MACROS() do {builtin_define_std ("LE370");} while (0)
+#else
+# define MAYBE_LE370_MACROS()
+#endif
diff --git a/gcc/config/i370/oe.h b/gcc/config/i370/oe.h
new file mode 100644
index 00000000000..088c043530e
--- /dev/null
+++ b/gcc/config/i370/oe.h
@@ -0,0 +1,53 @@
+/* Definitions of target machine for GNU compiler.  System/370 version.
+   Copyright (C) 1989, 1993, 1995, 1996, 1997, 2003
+   Free Software Foundation, Inc.
+   Contributed by Jan Stein (jan@cd.chalmers.se).
+   Modified for OS/390 OpenEdition by Dave Pitts (dpitts@cozx.com)
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#define TARGET_VERSION printf (" (370/OpenEdition)");
+
+/* Specify that we're generating code for the Language Environment */
+
+#define LE370 1
+#define LONGEXTERNAL 1
+#define TARGET_EBCDIC 1
+#define TARGET_HLASM 1
+
+/* Options for the preprocessor for this target machine.  */
+
+#define CPP_SPEC "-trigraphs"
+
+/* Options for this target machine.  */
+
+#define LIB_SPEC ""
+#define LIBGCC_SPEC ""
+#define STARTFILE_SPEC "/usr/local/lib/gccmain.o"
+
+/* Target OS preprocessor built-ins.  */
+#define TARGET_OS_CPP_BUILTINS()		\
+    do {					\
+	builtin_define_std ("unix");		\
+	builtin_define_std ("UNIX");		\
+	builtin_define_std ("openedition");	\
+	builtin_define ("__i370__");		\
+	builtin_assert ("system=openedition");	\
+	builtin_assert ("system=unix");		\
+    } while (0)
+
diff --git a/gcc/config/i370/t-i370 b/gcc/config/i370/t-i370
new file mode 100644
index 00000000000..fccd1632fde
--- /dev/null
+++ b/gcc/config/i370/t-i370
@@ -0,0 +1,3 @@
+i370-c.o: $(srcdir)/config/i370/i370-c.c $(CONFIG_H) $(SYSTEM_H) coretypes.h \
+  $(TM_H) $(TREE_H) toplev.h $(CPPLIB_H) c-pragma.h $(TM_P_H)
+	$(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) $(srcdir)/config/i370/i370-c.c
diff --git a/gcc/config/i960/i960-c.c b/gcc/config/i960/i960-c.c
new file mode 100644
index 00000000000..6c1199e352e
--- /dev/null
+++ b/gcc/config/i960/i960-c.c
@@ -0,0 +1,117 @@
+/* Intel 80960 specific, C compiler specific functions.
+   Copyright (C) 1992, 1995, 1996, 1997, 1998, 1999, 2000
+   Free Software Foundation, Inc.
+   Contributed by Steven McGeady, Intel Corp.
+   Additional Work by Glenn Colon-Bonet, Jonathan Shapiro, Andy Wilson
+   Converted to GCC 2.0 by Jim Wilson and Michael Tiemann, Cygnus Support.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "cpplib.h"
+#include "tree.h"
+#include "c-pragma.h"
+#include "toplev.h"
+#include "ggc.h"
+#include "tm_p.h"
+
+/* Handle pragmas for compatibility with Intel's compilers.  */
+
+/* NOTE: ic960 R3.0 pragma align definition:
+
+   #pragma align [(size)] | (identifier=size[,...])
+   #pragma noalign [(identifier)[,...]]
+     
+   (all parens are optional)
+     
+   - size is [1,2,4,8,16]
+   - noalign means size==1
+   - applies only to component elements of a struct (and union?)
+   - identifier applies to structure tag (only)
+   - missing identifier means next struct
+     
+   - alignment rules for bitfields need more investigation.
+
+   This implementation only handles the case of no identifiers.  */
+
+void
+i960_pr_align (pfile)
+     cpp_reader *pfile ATTRIBUTE_UNUSED;
+{
+  tree number;
+  enum cpp_ttype type;
+  int align;
+
+  type = c_lex (&number);
+  if (type == CPP_OPEN_PAREN)
+    type = c_lex (&number);
+  if (type == CPP_NAME)
+    {
+      warning ("sorry, not implemented: #pragma align NAME=SIZE");
+      return;
+    }
+  if (type != CPP_NUMBER)
+    {
+      warning ("malformed #pragma align - ignored");
+      return;
+    }
+
+  align = TREE_INT_CST_LOW (number);
+  switch (align)
+    {
+    case 0:
+      /* Return to last alignment.  */
+      align = i960_last_maxbitalignment / 8;
+      /* Fall through.  */
+    case 16:
+    case 8:
+    case 4:
+    case 2:
+    case 1:
+      i960_last_maxbitalignment = i960_maxbitalignment;
+      i960_maxbitalignment = align * 8;
+      break;
+      
+    default:
+      /* Silently ignore bad values.  */
+      break;
+    }
+}
+
+void
+i960_pr_noalign (pfile)
+     cpp_reader *pfile ATTRIBUTE_UNUSED;
+{
+  enum cpp_ttype type;
+  tree number;
+
+  type = c_lex (&number);
+  if (type == CPP_OPEN_PAREN)
+    type = c_lex (&number);
+  if (type == CPP_NAME)
+    {
+      warning ("sorry, not implemented: #pragma noalign NAME");
+      return;
+    }
+
+  i960_last_maxbitalignment = i960_maxbitalignment;
+  i960_maxbitalignment = 8;
+}
diff --git a/gcc/config/i960/i960-coff.h b/gcc/config/i960/i960-coff.h
new file mode 100644
index 00000000000..465ea33cc3e
--- /dev/null
+++ b/gcc/config/i960/i960-coff.h
@@ -0,0 +1,43 @@
+/* Definitions of target machine for GNU compiler, for "naked" Intel
+   80960 using coff object format and coff debugging symbols.
+   Copyright (C) 1988, 1989, 1991, 1996, 2000 Free Software Foundation.
+   Contributed by Steven McGeady (mcg@omepd.intel.com)
+   Additional work by Glenn Colon-Bonet, Jonathan Shapiro, Andy Wilson
+   Converted to GCC 2.0 by Michael Tiemann, Cygnus Support.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Support -gstabs using stabs in COFF sections.  */
+
+/* Generate SDB_DEBUGGING_INFO by default.  */
+#undef PREFERRED_DEBUGGING_TYPE
+#define PREFERRED_DEBUGGING_TYPE SDB_DEBUG
+
+/* This is intended to be used with Cygnus's newlib library, so we want to
+   use the standard definition of LIB_SPEC.  */
+#undef LIB_SPEC
+
+/* Emit a .file directive.  */
+#define TARGET_ASM_FILE_START_FILE_DIRECTIVE true
+
+/* Support the ctors and dtors sections for g++.  */
+
+#define CTORS_SECTION_ASM_OP	"\t.section\t.ctors,\"x\""
+#define DTORS_SECTION_ASM_OP	"\t.section\t.dtors,\"x\""
+
+/* end of i960-coff.h */
diff --git a/gcc/config/i960/i960-modes.def b/gcc/config/i960/i960-modes.def
new file mode 100644
index 00000000000..e99939049c6
--- /dev/null
+++ b/gcc/config/i960/i960-modes.def
@@ -0,0 +1,33 @@
+/* Definitions of target machine for GNU compiler, for Intel 80960
+   Copyright (C) 2002 Free Software Foundation, Inc.
+   Contributed by Steven McGeady, Intel Corp.
+   Additional Work by Glenn Colon-Bonet, Jonathan Shapiro, Andy Wilson
+   Converted to GCC 2.0 by Jim Wilson and Michael Tiemann, Cygnus Support.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* long double */
+FLOAT_MODE (TF, 16, ieee_extended_intel_128_format);
+
+/* Add any extra modes needed to represent the condition code.
+
+   Also, signed and unsigned comparisons are distinguished, as
+   are operations which are compatible with chkbit insns.  */
+
+CC_MODE (CC_UNS);
+CC_MODE (CC_CHK);
diff --git a/gcc/config/i960/i960-protos.h b/gcc/config/i960/i960-protos.h
new file mode 100644
index 00000000000..269a40be19c
--- /dev/null
+++ b/gcc/config/i960/i960-protos.h
@@ -0,0 +1,102 @@
+/* Definitions of target machine for GNU compiler, for Intel 80960
+   Copyright (C) 2000
+   Free Software Foundation, Inc.
+   Contributed by Steven McGeady, Intel Corp.
+   Additional Work by Glenn Colon-Bonet, Jonathan Shapiro, Andy Wilson
+   Converted to GCC 2.0 by Jim Wilson and Michael Tiemann, Cygnus Support.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#ifndef GCC_I960_PROTOS_H
+#define GCC_I960_PROTOS_H
+
+#ifdef RTX_CODE
+extern struct rtx_def *legitimize_address (rtx, rtx, enum machine_mode);
+/* Define the function that build the compare insn for scc and bcc.  */
+
+extern struct rtx_def *gen_compare_reg (enum rtx_code, rtx, rtx);
+
+/* Define functions in i960.c and used in insn-output.c.  */
+
+extern const char *i960_output_ldconst (rtx, rtx);
+extern const char *i960_output_call_insn (rtx, rtx, rtx, rtx);
+extern const char *i960_output_ret_insn (rtx);
+extern const char *i960_output_move_double (rtx, rtx);
+extern const char *i960_output_move_double_zero (rtx);
+extern const char *i960_output_move_quad (rtx, rtx);
+extern const char *i960_output_move_quad_zero (rtx);
+
+extern int literal (rtx, enum machine_mode);
+extern int hard_regno_mode_ok (int, enum machine_mode);
+extern int fp_literal (rtx, enum machine_mode);
+extern int signed_literal (rtx, enum machine_mode);
+extern int legitimate_address_p (enum machine_mode, rtx, int);
+extern void i960_print_operand (FILE *, rtx, int);
+extern int fpmove_src_operand (rtx, enum machine_mode);
+extern int arith_operand (rtx, enum machine_mode);
+extern int logic_operand (rtx, enum machine_mode);
+extern int fp_arith_operand (rtx, enum machine_mode);
+extern int signed_arith_operand (rtx, enum machine_mode);
+extern int fp_literal_one (rtx, enum machine_mode);
+extern int fp_literal_zero (rtx, enum machine_mode);
+extern int symbolic_memory_operand (rtx, enum machine_mode);
+extern int eq_or_neq (rtx, enum machine_mode);
+extern int arith32_operand (rtx, enum machine_mode);
+extern int power2_operand (rtx, enum machine_mode);
+extern int cmplpower2_operand (rtx, enum machine_mode);
+extern enum machine_mode select_cc_mode (RTX_CODE, rtx);
+extern int emit_move_sequence (rtx *, enum machine_mode);
+extern int i960_bypass (rtx, rtx, rtx, int);
+extern void i960_print_operand_addr (FILE *, rtx);
+extern int i960_expr_alignment (rtx, int);
+extern int i960_improve_align (rtx, rtx, int);
+extern int i960_si_ti (rtx, rtx);
+extern int i960_si_di (rtx, rtx);
+#ifdef TREE_CODE
+extern struct rtx_def *i960_function_arg (CUMULATIVE_ARGS *,
+					  enum machine_mode,
+					  tree, int);
+extern rtx i960_va_arg (tree, tree);
+extern void i960_va_start (tree, rtx);
+#endif /* TREE_CODE */
+extern enum reg_class secondary_reload_class (enum reg_class, enum machine_mode, rtx);
+#endif /* RTX_CODE */
+
+#ifdef TREE_CODE
+extern void i960_function_name_declare (FILE *, const char *, tree);
+extern void i960_function_arg_advance (CUMULATIVE_ARGS *, enum machine_mode, tree, int);
+extern int i960_round_align (int, tree);
+extern void i960_setup_incoming_varargs (CUMULATIVE_ARGS *, enum machine_mode, tree, int *, int);
+extern int i960_final_reg_parm_stack_space (int, tree);
+extern int i960_reg_parm_stack_space (tree);
+#endif /* TREE_CODE */
+
+extern int process_pragma (int(*)(void), void(*)(int), const char *);
+extern int i960_object_bytes_bitalign (int);
+extern void i960_initialize (void);
+extern int bitpos (unsigned int);
+extern int is_mask (unsigned int);
+extern int bitstr (unsigned int, int *, int *);
+extern int compute_frame_size (int);
+extern void output_function_profiler (FILE *, int);
+extern void i960_scan_opcode (const char *);
+
+extern void i960_pr_align (struct cpp_reader *);
+extern void i960_pr_noalign (struct cpp_reader *);
+
+#endif /* ! GCC_I960_PROTOS_H  */
diff --git a/gcc/config/i960/i960.c b/gcc/config/i960/i960.c
new file mode 100644
index 00000000000..3d976b65fd4
--- /dev/null
+++ b/gcc/config/i960/i960.c
@@ -0,0 +1,2917 @@
+/* Subroutines used for code generation on intel 80960.
+   Copyright (C) 1992, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+   Free Software Foundation, Inc.
+   Contributed by Steven McGeady, Intel Corp.
+   Additional Work by Glenn Colon-Bonet, Jonathan Shapiro, Andy Wilson
+   Converted to GCC 2.0 by Jim Wilson and Michael Tiemann, Cygnus Support.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include <math.h>
+#include "rtl.h"
+#include "regs.h"
+#include "hard-reg-set.h"
+#include "real.h"
+#include "insn-config.h"
+#include "conditions.h"
+#include "output.h"
+#include "insn-attr.h"
+#include "flags.h"
+#include "tree.h"
+#include "expr.h"
+#include "except.h"
+#include "function.h"
+#include "recog.h"
+#include "toplev.h"
+#include "tm_p.h"
+#include "target.h"
+#include "target-def.h"
+
+static void i960_output_function_prologue (FILE *, HOST_WIDE_INT);
+static void i960_output_function_epilogue (FILE *, HOST_WIDE_INT);
+static void i960_output_mi_thunk (FILE *, tree, HOST_WIDE_INT,
+				  HOST_WIDE_INT, tree);
+static bool i960_rtx_costs (rtx, int, int, int *);
+static int i960_address_cost (rtx);
+static tree i960_build_builtin_va_list (void);
+
+/* Save the operands last given to a compare for use when we
+   generate a scc or bcc insn.  */
+
+rtx i960_compare_op0, i960_compare_op1;
+
+/* Used to implement #pragma align/noalign.  Initialized by OVERRIDE_OPTIONS
+   macro in i960.h.  */
+
+int i960_maxbitalignment;
+int i960_last_maxbitalignment;
+
+/* Used to implement switching between MEM and ALU insn types, for better
+   C series performance.  */
+
+enum insn_types i960_last_insn_type;
+
+/* The leaf-procedure return register.  Set only if this is a leaf routine.  */
+
+static int i960_leaf_ret_reg;
+
+/* True if replacing tail calls with jumps is OK.  */
+
+static int tail_call_ok;
+
+/* A string containing a list of insns to emit in the epilogue so as to
+   restore all registers saved by the prologue.  Created by the prologue
+   code as it saves registers away.  */
+
+char epilogue_string[1000];
+
+/* A unique number (per function) for return labels.  */
+
+static int ret_label = 0;
+
+/* This is true if FNDECL is either a varargs or a stdarg function.
+   This is used to help identify functions that use an argument block.  */
+
+#define VARARGS_STDARG_FUNCTION(FNDECL)	\
+(TYPE_ARG_TYPES (TREE_TYPE (FNDECL)) != 0				\
+  && (TREE_VALUE (tree_last (TYPE_ARG_TYPES (TREE_TYPE (FNDECL)))))	\
+      != void_type_node)
+
+/* Initialize the GCC target structure.  */
+#undef TARGET_ASM_ALIGNED_SI_OP
+#define TARGET_ASM_ALIGNED_SI_OP "\t.word\t"
+
+#undef TARGET_ASM_FUNCTION_PROLOGUE
+#define TARGET_ASM_FUNCTION_PROLOGUE i960_output_function_prologue
+#undef TARGET_ASM_FUNCTION_EPILOGUE
+#define TARGET_ASM_FUNCTION_EPILOGUE i960_output_function_epilogue
+
+#undef TARGET_ASM_OUTPUT_MI_THUNK
+#define TARGET_ASM_OUTPUT_MI_THUNK i960_output_mi_thunk
+#undef TARGET_CAN_ASM_OUTPUT_MI_THUNK
+#define TARGET_CAN_ASM_OUTPUT_MI_THUNK default_can_output_mi_thunk_no_vcall
+
+#undef TARGET_RTX_COSTS
+#define TARGET_RTX_COSTS i960_rtx_costs
+#undef TARGET_ADDRESS_COST
+#define TARGET_ADDRESS_COST i960_address_cost
+
+#undef TARGET_BUILD_BUILTIN_VA_LIST
+#define TARGET_BUILD_BUILTIN_VA_LIST i960_build_builtin_va_list
+
+struct gcc_target targetm = TARGET_INITIALIZER;
+
+/* Override conflicting target switch options.
+   Doesn't actually detect if more than one -mARCH option is given, but
+   does handle the case of two blatantly conflicting -mARCH options.
+
+   Also initialize variables before compiling any files.  */
+
+void
+i960_initialize ()
+{
+  if (TARGET_K_SERIES && TARGET_C_SERIES)
+    {
+      warning ("conflicting architectures defined - using C series");
+      target_flags &= ~TARGET_FLAG_K_SERIES;
+    }
+  if (TARGET_K_SERIES && TARGET_MC)
+    {
+      warning ("conflicting architectures defined - using K series");
+      target_flags &= ~TARGET_FLAG_MC;
+    }
+  if (TARGET_C_SERIES && TARGET_MC)
+    {
+      warning ("conflicting architectures defined - using C series");
+      target_flags &= ~TARGET_FLAG_MC;
+    }
+  if (TARGET_IC_COMPAT3_0)
+    {
+      flag_short_enums = 1;
+      flag_signed_char = 1;
+      target_flags |= TARGET_FLAG_CLEAN_LINKAGE;
+      if (TARGET_IC_COMPAT2_0)
+	{
+	  warning ("iC2.0 and iC3.0 are incompatible - using iC3.0");
+	  target_flags &= ~TARGET_FLAG_IC_COMPAT2_0;
+	}
+    }
+  if (TARGET_IC_COMPAT2_0)
+    {
+      flag_signed_char = 1;
+      target_flags |= TARGET_FLAG_CLEAN_LINKAGE;
+    }
+
+  if (TARGET_IC_COMPAT2_0)
+    {
+      i960_maxbitalignment = 8;
+      i960_last_maxbitalignment = 128;
+    }
+  else
+    {
+      i960_maxbitalignment = 128;
+      i960_last_maxbitalignment = 8;
+    }
+}
+
+/* Return true if OP can be used as the source of an fp move insn.  */
+
+int
+fpmove_src_operand (op, mode)
+     rtx op;
+     enum machine_mode mode;
+{
+  return (GET_CODE (op) == CONST_DOUBLE || general_operand (op, mode));
+}
+
+#if 0
+/* Return true if OP is a register or zero.  */
+
+int
+reg_or_zero_operand (op, mode)
+     rtx op;
+     enum machine_mode mode;
+{
+  return register_operand (op, mode) || op == const0_rtx;
+}
+#endif
+
+/* Return truth value of whether OP can be used as an operands in a three
+   address arithmetic insn (such as add %o1,7,%l2) of mode MODE.  */
+
+int
+arith_operand (op, mode)
+     rtx op;
+     enum machine_mode mode;
+{
+  return (register_operand (op, mode) || literal (op, mode));
+}
+
+/* Return truth value of whether OP can be used as an operands in a three
+   address logic insn, possibly complementing OP, of mode MODE.  */
+
+int
+logic_operand (op, mode)
+     rtx op;
+     enum machine_mode mode;
+{
+  return (register_operand (op, mode)
+	  || (GET_CODE (op) == CONST_INT
+	      && INTVAL(op) >= -32 && INTVAL(op) < 32));
+}
+
+/* Return true if OP is a register or a valid floating point literal.  */
+
+int
+fp_arith_operand (op, mode)
+     rtx op;
+     enum machine_mode mode;
+{
+  return (register_operand (op, mode) || fp_literal (op, mode));
+}
+
+/* Return true if OP is a register or a valid signed integer literal.  */
+
+int
+signed_arith_operand (op, mode)
+     rtx op;
+     enum machine_mode mode;
+{
+  return (register_operand (op, mode) || signed_literal (op, mode));
+}
+
+/* Return truth value of whether OP is an integer which fits the
+   range constraining immediate operands in three-address insns.  */
+
+int
+literal (op, mode)
+     rtx op;
+     enum machine_mode mode ATTRIBUTE_UNUSED;
+{
+  return ((GET_CODE (op) == CONST_INT) && INTVAL(op) >= 0 && INTVAL(op) < 32);
+}
+
+/* Return true if OP is a float constant of 1.  */
+
+int
+fp_literal_one (op, mode)
+     rtx op;
+     enum machine_mode mode;
+{
+  return (TARGET_NUMERICS && mode == GET_MODE (op) && op == CONST1_RTX (mode));
+}
+
+/* Return true if OP is a float constant of 0.  */
+
+int
+fp_literal_zero (op, mode)
+     rtx op;
+     enum machine_mode mode;
+{
+  return (TARGET_NUMERICS && mode == GET_MODE (op) && op == CONST0_RTX (mode));
+}
+
+/* Return true if OP is a valid floating point literal.  */
+
+int
+fp_literal(op, mode)
+     rtx op;
+     enum machine_mode mode;
+{
+  return fp_literal_zero (op, mode) || fp_literal_one (op, mode);
+}
+
+/* Return true if OP is a valid signed immediate constant.  */
+
+int
+signed_literal(op, mode)
+     rtx op;
+     enum machine_mode mode ATTRIBUTE_UNUSED;
+{
+  return ((GET_CODE (op) == CONST_INT) && INTVAL(op) > -32 && INTVAL(op) < 32);
+}
+
+/* Return truth value of statement that OP is a symbolic memory
+   operand of mode MODE.  */
+
+int
+symbolic_memory_operand (op, mode)
+     rtx op;
+     enum machine_mode mode ATTRIBUTE_UNUSED;
+{
+  if (GET_CODE (op) == SUBREG)
+    op = SUBREG_REG (op);
+  if (GET_CODE (op) != MEM)
+    return 0;
+  op = XEXP (op, 0);
+  return (GET_CODE (op) == SYMBOL_REF || GET_CODE (op) == CONST
+	  || GET_CODE (op) == HIGH || GET_CODE (op) == LABEL_REF);
+}
+
+/* Return truth value of whether OP is EQ or NE.  */
+
+int
+eq_or_neq (op, mode)
+     rtx op;
+     enum machine_mode mode ATTRIBUTE_UNUSED;
+{
+  return (GET_CODE (op) == EQ || GET_CODE (op) == NE);
+}
+
+/* OP is an integer register or a constant.  */
+
+int
+arith32_operand (op, mode)
+     rtx op;
+     enum machine_mode mode;
+{
+  if (register_operand (op, mode))
+    return 1;
+  return (CONSTANT_P (op));
+}
+
+/* Return true if OP is an integer constant which is a power of 2.  */
+
+int
+power2_operand (op,mode)
+     rtx op;
+     enum machine_mode mode ATTRIBUTE_UNUSED;
+{
+  if (GET_CODE (op) != CONST_INT)
+    return 0;
+
+  return exact_log2 (INTVAL (op)) >= 0;
+}
+
+/* Return true if OP is an integer constant which is the complement of a
+   power of 2.  */
+
+int
+cmplpower2_operand (op, mode)
+     rtx op;
+     enum machine_mode mode ATTRIBUTE_UNUSED;
+{
+  if (GET_CODE (op) != CONST_INT)
+    return 0;
+
+  return exact_log2 (~ INTVAL (op)) >= 0;
+}
+
+/* If VAL has only one bit set, return the index of that bit.  Otherwise
+   return -1.  */
+
+int
+bitpos (val)
+     unsigned int val;
+{
+  register int i;
+
+  for (i = 0; val != 0; i++, val >>= 1)
+    {
+      if (val & 1)
+	{
+	  if (val != 1)
+	    return -1;
+	  return i;
+	}
+    }
+  return -1;
+}
+
+/* Return nonzero if OP is a mask, i.e. all one bits are consecutive.
+   The return value indicates how many consecutive nonzero bits exist
+   if this is a mask.  This is the same as the next function, except that
+   it does not indicate what the start and stop bit positions are.  */
+
+int
+is_mask (val)
+     unsigned int val;
+{
+  register int start, end = 0, i;
+
+  start = -1;
+  for (i = 0; val != 0; val >>= 1, i++)
+    {
+      if (val & 1)
+	{
+	  if (start < 0)
+	    start = i;
+
+	  end = i;
+	  continue;
+	}
+      /* Still looking for the first bit.  */
+      if (start < 0)
+	continue;
+
+      /* We've seen the start of a bit sequence, and now a zero.  There
+	 must be more one bits, otherwise we would have exited the loop.
+	 Therefore, it is not a mask.  */
+      if (val)
+	return 0;
+    }
+
+  /* The bit string has ones from START to END bit positions only.  */
+  return end - start + 1;
+}
+
+/* If VAL is a mask, then return nonzero, with S set to the starting bit
+   position and E set to the ending bit position of the mask.  The return
+   value indicates how many consecutive bits exist in the mask.  This is
+   the same as the previous function, except that it also indicates the
+   start and end bit positions of the mask.  */
+
+int
+bitstr (val, s, e)
+     unsigned int val;
+     int *s, *e;
+{
+  register int start, end, i;
+
+  start = -1;
+  end = -1;
+  for (i = 0; val != 0; val >>= 1, i++)
+    {
+      if (val & 1)
+	{
+	  if (start < 0)
+	    start = i;
+
+	  end = i;
+	  continue;
+	}
+
+      /* Still looking for the first bit.  */
+      if (start < 0)
+	continue;
+
+      /* We've seen the start of a bit sequence, and now a zero.  There
+	 must be more one bits, otherwise we would have exited the loop.
+	 Therefor, it is not a mask.  */
+      if (val)
+	{
+	  start = -1;
+	  end = -1;
+	  break;
+	}
+    }
+
+  /* The bit string has ones from START to END bit positions only.  */
+  *s = start;
+  *e = end;
+  return ((start < 0) ? 0 : end - start + 1);
+}
+
+/* Return the machine mode to use for a comparison.  */
+
+enum machine_mode
+select_cc_mode (op, x)
+     RTX_CODE op;
+     rtx x ATTRIBUTE_UNUSED;
+{
+  if (op == GTU || op == LTU || op == GEU || op == LEU)
+    return CC_UNSmode;
+  return CCmode;
+}
+
+/* X and Y are two things to compare using CODE.  Emit the compare insn and
+   return the rtx for register 36 in the proper mode.  */
+
+rtx
+gen_compare_reg (code, x, y)
+     enum rtx_code code;
+     rtx x, y;
+{
+  rtx cc_reg;
+  enum machine_mode ccmode = SELECT_CC_MODE (code, x, y);
+  enum machine_mode mode
+    = GET_MODE (x) == VOIDmode ? GET_MODE (y) : GET_MODE (x);
+
+  if (mode == SImode)
+    {
+      if (! arith_operand (x, mode))
+	x = force_reg (SImode, x);
+      if (! arith_operand (y, mode))
+	y = force_reg (SImode, y);
+    }
+
+  cc_reg = gen_rtx_REG (ccmode, 36);
+  emit_insn (gen_rtx_SET (VOIDmode, cc_reg,
+			  gen_rtx_COMPARE (ccmode, x, y)));
+
+  return cc_reg;
+}
+
+/* For the i960, REG is cost 1, REG+immed CONST is cost 2, REG+REG is cost 2,
+   REG+nonimmed CONST is cost 4.  REG+SYMBOL_REF, SYMBOL_REF, and similar
+   are 4.  Indexed addresses are cost 6.  */
+
+/* ??? Try using just RTX_COST, i.e. not defining ADDRESS_COST.  */
+
+static int
+i960_address_cost (x)
+     rtx x;
+{
+  if (GET_CODE (x) == REG)
+    return 1;
+
+  /* This is a MEMA operand -- it's free.  */
+  if (GET_CODE (x) == CONST_INT
+      && INTVAL (x) >= 0
+      && INTVAL (x) < 4096)
+    return 0;
+
+  if (GET_CODE (x) == PLUS)
+    {
+      rtx base = XEXP (x, 0);
+      rtx offset = XEXP (x, 1);
+
+      if (GET_CODE (base) == SUBREG)
+	base = SUBREG_REG (base);
+      if (GET_CODE (offset) == SUBREG)
+	offset = SUBREG_REG (offset);
+
+      if (GET_CODE (base) == REG)
+	{
+	  if (GET_CODE (offset) == REG)
+	    return 2;
+	  if (GET_CODE (offset) == CONST_INT)
+	    {
+	      if ((unsigned)INTVAL (offset) < 2047)
+		return 2;
+	      return 4;
+	    }
+	  if (CONSTANT_P (offset))
+	    return 4;
+	}
+      if (GET_CODE (base) == PLUS || GET_CODE (base) == MULT)
+	return 6;
+
+      /* This is an invalid address.  The return value doesn't matter, but
+	 for convenience we make this more expensive than anything else.  */
+      return 12;
+    }
+  if (GET_CODE (x) == MULT)
+    return 6;
+
+  /* Symbol_refs and other unrecognized addresses are cost 4.  */
+  return 4;
+}
+
+/* Emit insns to move operands[1] into operands[0].
+
+   Return 1 if we have written out everything that needs to be done to
+   do the move.  Otherwise, return 0 and the caller will emit the move
+   normally.  */
+
+int
+emit_move_sequence (operands, mode)
+     rtx *operands;
+     enum machine_mode mode;
+{
+  /* We can only store registers to memory.  */
+  
+  if (GET_CODE (operands[0]) == MEM && GET_CODE (operands[1]) != REG
+      && (operands[1] != const0_rtx || current_function_args_size
+	  || current_function_stdarg
+	  || rtx_equal_function_value_matters))
+    /* Here we use the same test as movsi+1 pattern -- see i960.md.  */
+    operands[1] = force_reg (mode, operands[1]);
+
+  /* Storing multi-word values in unaligned hard registers to memory may
+     require a scratch since we have to store them a register at a time and
+     adding 4 to the memory address may not yield a valid insn.  */
+  /* ??? We don't always need the scratch, but that would complicate things.
+     Maybe later.  */
+  /* ??? We must also handle stores to pseudos here, because the pseudo may be
+     replaced with a MEM later.  This would be cleaner if we didn't have
+     a separate pattern for unaligned DImode/TImode stores.  */
+  if (GET_MODE_SIZE (mode) > UNITS_PER_WORD
+      && (GET_CODE (operands[0]) == MEM
+	  || (GET_CODE (operands[0]) == REG
+	      && REGNO (operands[0]) >= FIRST_PSEUDO_REGISTER))
+      && GET_CODE (operands[1]) == REG
+      && REGNO (operands[1]) < FIRST_PSEUDO_REGISTER
+      && ! HARD_REGNO_MODE_OK (REGNO (operands[1]), mode))
+    {
+      emit_insn (gen_rtx_PARALLEL
+		 (VOIDmode,
+		  gen_rtvec (2,
+			     gen_rtx_SET (VOIDmode, operands[0], operands[1]),
+			     gen_rtx_CLOBBER (VOIDmode,
+					      gen_rtx_SCRATCH (Pmode)))));
+      return 1;
+    }
+
+  return 0;
+}
+
+/* Output assembler to move a double word value.  */
+
+const char *
+i960_output_move_double (dst, src)
+     rtx dst, src;
+{
+  rtx operands[5];
+
+  if (GET_CODE (dst) == REG
+      && GET_CODE (src) == REG)
+    {
+      if ((REGNO (src) & 1)
+	  || (REGNO (dst) & 1))
+	{
+	  /* We normally copy the low-numbered register first.  However, if
+	     the second source register is the same as the first destination
+	     register, we must copy in the opposite order.  */
+	  if (REGNO (src) + 1 == REGNO (dst))
+	    return "mov	%D1,%D0\n\tmov	%1,%0";
+	  else
+	    return "mov	%1,%0\n\tmov	%D1,%D0";
+	}
+      else
+	return "movl	%1,%0";
+    }
+  else if (GET_CODE (dst) == REG
+	   && GET_CODE (src) == CONST_INT
+	   && CONST_OK_FOR_LETTER_P (INTVAL (src), 'I'))
+    {
+      if (REGNO (dst) & 1)
+	return "mov	%1,%0\n\tmov	0,%D0";
+      else
+	return "movl	%1,%0";
+    }
+  else if (GET_CODE (dst) == REG
+	   && GET_CODE (src) == MEM)
+    {
+      if (REGNO (dst) & 1)
+	{
+	  /* One can optimize a few cases here, but you have to be
+	     careful of clobbering registers used in the address and
+	     edge conditions.  */
+	  operands[0] = dst;
+	  operands[1] = src;
+	  operands[2] = gen_rtx_REG (Pmode, REGNO (dst) + 1);
+	  operands[3] = gen_rtx_MEM (word_mode, operands[2]);
+	  operands[4] = adjust_address (operands[3], word_mode,
+					UNITS_PER_WORD);
+	  output_asm_insn
+	    ("lda	%1,%2\n\tld	%3,%0\n\tld	%4,%D0", operands);
+	  return "";
+	}
+      else
+	return "ldl	%1,%0";
+    }
+  else if (GET_CODE (dst) == MEM
+	   && GET_CODE (src) == REG)
+    {
+      if (REGNO (src) & 1)
+	{
+	  operands[0] = dst;
+	  operands[1] = adjust_address (dst, word_mode, UNITS_PER_WORD);
+	  if (! memory_address_p (word_mode, XEXP (operands[1], 0)))
+	    abort ();
+	  operands[2] = src;
+	  output_asm_insn ("st	%2,%0\n\tst	%D2,%1", operands);
+	  return "";
+	}
+      return "stl	%1,%0";
+    }
+  else
+    abort ();
+}
+
+/* Output assembler to move a double word zero.  */
+
+const char *
+i960_output_move_double_zero (dst)
+     rtx dst;
+{
+  rtx operands[2];
+
+  operands[0] = dst;
+    {
+      operands[1] = adjust_address (dst, word_mode, 4);
+      output_asm_insn ("st	g14,%0\n\tst	g14,%1", operands);
+    }
+  return "";
+}
+
+/* Output assembler to move a quad word value.  */
+
+const char *
+i960_output_move_quad (dst, src)
+     rtx dst, src;
+{
+  rtx operands[7];
+
+  if (GET_CODE (dst) == REG
+      && GET_CODE (src) == REG)
+    {
+      if ((REGNO (src) & 3)
+	  || (REGNO (dst) & 3))
+	{
+	  /* We normally copy starting with the low numbered register.
+	     However, if there is an overlap such that the first dest reg
+	     is <= the last source reg but not < the first source reg, we
+	     must copy in the opposite order.  */
+	  if (REGNO (dst) <= REGNO (src) + 3
+	      && REGNO (dst) >= REGNO (src))
+	    return "mov	%F1,%F0\n\tmov	%E1,%E0\n\tmov	%D1,%D0\n\tmov	%1,%0";
+	  else
+	    return "mov	%1,%0\n\tmov	%D1,%D0\n\tmov	%E1,%E0\n\tmov	%F1,%F0";
+	}
+      else
+	return "movq	%1,%0";
+    }
+  else if (GET_CODE (dst) == REG
+	   && GET_CODE (src) == CONST_INT
+	   && CONST_OK_FOR_LETTER_P (INTVAL (src), 'I'))
+    {
+      if (REGNO (dst) & 3)
+	return "mov	%1,%0\n\tmov	0,%D0\n\tmov	0,%E0\n\tmov	0,%F0";
+      else
+	return "movq	%1,%0";
+    }
+  else if (GET_CODE (dst) == REG
+	   && GET_CODE (src) == MEM)
+    {
+      if (REGNO (dst) & 3)
+	{
+	  /* One can optimize a few cases here, but you have to be
+	     careful of clobbering registers used in the address and
+	     edge conditions.  */
+	  operands[0] = dst;
+	  operands[1] = src;
+	  operands[2] = gen_rtx_REG (Pmode, REGNO (dst) + 3);
+	  operands[3] = gen_rtx_MEM (word_mode, operands[2]);
+	  operands[4]
+	    = adjust_address (operands[3], word_mode, UNITS_PER_WORD);
+	  operands[5]
+	    = adjust_address (operands[4], word_mode, UNITS_PER_WORD);
+	  operands[6]
+	    = adjust_address (operands[5], word_mode, UNITS_PER_WORD);
+	  output_asm_insn ("lda	%1,%2\n\tld	%3,%0\n\tld	%4,%D0\n\tld	%5,%E0\n\tld	%6,%F0", operands);
+	  return "";
+	}
+      else
+	return "ldq	%1,%0";
+    }
+  else if (GET_CODE (dst) == MEM
+	   && GET_CODE (src) == REG)
+    {
+      if (REGNO (src) & 3)
+	{
+	  operands[0] = dst;
+	  operands[1] = adjust_address (dst, word_mode, UNITS_PER_WORD);
+	  operands[2] = adjust_address (dst, word_mode, 2 * UNITS_PER_WORD);
+	  operands[3] = adjust_address (dst, word_mode, 3 * UNITS_PER_WORD);
+	  if (! memory_address_p (word_mode, XEXP (operands[3], 0)))
+	    abort ();
+	  operands[4] = src;
+	  output_asm_insn ("st	%4,%0\n\tst	%D4,%1\n\tst	%E4,%2\n\tst	%F4,%3", operands);
+	  return "";
+	}
+      return "stq	%1,%0";
+    }
+  else
+    abort ();
+}
+
+/* Output assembler to move a quad word zero.  */
+
+const char *
+i960_output_move_quad_zero (dst)
+     rtx dst;
+{
+  rtx operands[4];
+
+  operands[0] = dst;
+    {
+      operands[1] = adjust_address (dst, word_mode, 4);
+      operands[2] = adjust_address (dst, word_mode, 8);
+      operands[3] = adjust_address (dst, word_mode, 12);
+      output_asm_insn ("st	g14,%0\n\tst	g14,%1\n\tst	g14,%2\n\tst	g14,%3", operands);
+    }
+  return "";
+}
+
+
+/* Emit insns to load a constant to non-floating point registers.
+   Uses several strategies to try to use as few insns as possible.  */
+
+const char *
+i960_output_ldconst (dst, src)
+     register rtx dst, src;
+{
+  register int rsrc1;
+  register unsigned rsrc2;
+  enum machine_mode mode = GET_MODE (dst);
+  rtx operands[4];
+
+  operands[0] = operands[2] = dst;
+  operands[1] = operands[3] = src;
+
+  /* Anything that isn't a compile time constant, such as a SYMBOL_REF,
+     must be a ldconst insn.  */
+
+  if (GET_CODE (src) != CONST_INT && GET_CODE (src) != CONST_DOUBLE)
+    {
+      output_asm_insn ("ldconst	%1,%0", operands);
+      return "";
+    }
+  else if (mode == TFmode)
+    {
+      REAL_VALUE_TYPE d;
+      long value_long[3];
+      int i;
+
+      if (fp_literal_zero (src, TFmode))
+	return "movt	0,%0";
+
+      REAL_VALUE_FROM_CONST_DOUBLE (d, src);
+      REAL_VALUE_TO_TARGET_LONG_DOUBLE (d, value_long);
+
+      output_asm_insn ("# ldconst	%1,%0",operands);
+
+      for (i = 0; i < 3; i++)
+	{
+	  operands[0] = gen_rtx_REG (SImode, REGNO (dst) + i);
+	  operands[1] = GEN_INT (value_long[i]);
+	  output_asm_insn (i960_output_ldconst (operands[0], operands[1]),
+			   operands);
+	}
+
+      return ""; 
+   }
+  else if (mode == DFmode)
+    {
+      rtx first, second;
+
+      if (fp_literal_zero (src, DFmode))
+	return "movl	0,%0";
+
+      split_double (src, &first, &second);
+
+      output_asm_insn ("# ldconst	%1,%0",operands);
+
+      operands[0] = gen_rtx_REG (SImode, REGNO (dst));
+      operands[1] = first;
+      output_asm_insn (i960_output_ldconst (operands[0], operands[1]),
+		      operands);
+      operands[0] = gen_rtx_REG (SImode, REGNO (dst) + 1);
+      operands[1] = second;
+      output_asm_insn (i960_output_ldconst (operands[0], operands[1]),
+		      operands);
+      return "";
+    }
+  else if (mode == SFmode)
+    {
+      REAL_VALUE_TYPE d;
+      long value;
+
+      REAL_VALUE_FROM_CONST_DOUBLE (d, src);
+      REAL_VALUE_TO_TARGET_SINGLE (d, value);
+
+      output_asm_insn ("# ldconst	%1,%0",operands);
+      operands[0] = gen_rtx_REG (SImode, REGNO (dst));
+      operands[1] = GEN_INT (value);
+      output_asm_insn (i960_output_ldconst (operands[0], operands[1]),
+		      operands);
+      return "";
+    }
+  else if (mode == TImode)
+    {
+      /* ??? This is currently not handled at all.  */
+      abort ();
+
+      /* Note: lowest order word goes in lowest numbered reg.  */
+      rsrc1 = INTVAL (src);
+      if (rsrc1 >= 0 && rsrc1 < 32)
+	return "movq	%1,%0";
+      else
+	output_asm_insn ("movq\t0,%0\t# ldconstq %1,%0",operands);
+      /* Go pick up the low-order word.  */
+    }
+  else if (mode == DImode)
+    {
+      rtx upperhalf, lowerhalf, xoperands[2];
+
+      if (GET_CODE (src) == CONST_DOUBLE || GET_CODE (src) == CONST_INT)
+ 	split_double (src, &lowerhalf, &upperhalf);
+
+      else
+	abort ();
+
+      /* Note: lowest order word goes in lowest numbered reg.  */
+      /* Numbers from 0 to 31 can be handled with a single insn.  */
+      rsrc1 = INTVAL (lowerhalf);
+      if (upperhalf == const0_rtx && rsrc1 >= 0 && rsrc1 < 32)
+	return "movl	%1,%0";
+
+      /* Output the upper half with a recursive call.  */
+      xoperands[0] = gen_rtx_REG (SImode, REGNO (dst) + 1);
+      xoperands[1] = upperhalf;
+      output_asm_insn (i960_output_ldconst (xoperands[0], xoperands[1]),
+		       xoperands);
+      /* The lower word is emitted as normally.  */
+    }
+  else
+    {
+      rsrc1 = INTVAL (src);
+      if (mode == QImode)
+	{
+	  if (rsrc1 > 0xff)
+	    rsrc1 &= 0xff;
+	}
+      else if (mode == HImode)
+	{
+	  if (rsrc1 > 0xffff)
+	    rsrc1 &= 0xffff;
+	}
+    }
+
+  if (rsrc1 >= 0)
+    {
+      /* ldconst	0..31,X		-> 	mov	0..31,X  */
+      if (rsrc1 < 32)
+	{
+	  if (i960_last_insn_type == I_TYPE_REG && TARGET_C_SERIES)
+	    return "lda	%1,%0";
+	  return "mov	%1,%0";
+	}
+
+      /* ldconst	32..63,X	->	add	31,nn,X  */
+      if (rsrc1 < 63)
+	{
+	  if (i960_last_insn_type == I_TYPE_REG && TARGET_C_SERIES)
+	    return "lda	%1,%0";
+	  operands[1] = GEN_INT (rsrc1 - 31);
+	  output_asm_insn ("addo\t31,%1,%0\t# ldconst %3,%0", operands);
+	  return "";
+	}
+    }
+  else if (rsrc1 < 0)
+    {
+      /* ldconst	-1..-31		->	sub	0,0..31,X  */
+      if (rsrc1 >= -31)
+	{
+	  /* return 'sub -(%1),0,%0' */
+	  operands[1] = GEN_INT (- rsrc1);
+	  output_asm_insn ("subo\t%1,0,%0\t# ldconst %3,%0", operands);
+	  return "";
+	}
+      
+      /* ldconst	-32		->	not	31,X  */
+      if (rsrc1 == -32)
+	{
+	  operands[1] = GEN_INT (~rsrc1);
+	  output_asm_insn ("not\t%1,%0	# ldconst %3,%0", operands);
+	  return "";
+	}
+    }
+
+  /* If const is a single bit.  */
+  if (bitpos (rsrc1) >= 0)
+    {
+      operands[1] = GEN_INT (bitpos (rsrc1));
+      output_asm_insn ("setbit\t%1,0,%0\t# ldconst %3,%0", operands);
+      return "";
+    }
+
+  /* If const is a bit string of less than 6 bits (1..31 shifted).  */
+  if (is_mask (rsrc1))
+    {
+      int s, e;
+
+      if (bitstr (rsrc1, &s, &e) < 6)
+	{
+	  rsrc2 = ((unsigned int) rsrc1) >> s;
+	  operands[1] = GEN_INT (rsrc2);
+	  operands[2] = GEN_INT (s);
+	  output_asm_insn ("shlo\t%2,%1,%0\t# ldconst %3,%0", operands);
+	  return "";
+	}
+    }
+
+  /* Unimplemented cases:
+     const is in range 0..31 but rotated around end of word:
+     ror	31,3,g0	-> ldconst 0xe0000003,g0
+   
+     and any 2 instruction cases that might be worthwhile  */
+  
+  output_asm_insn ("ldconst	%1,%0", operands);
+  return "";
+}
+
+/* Determine if there is an opportunity for a bypass optimization.
+   Bypass succeeds on the 960K* if the destination of the previous
+   instruction is the second operand of the current instruction.
+   Bypass always succeeds on the C*.
+ 
+   Return 1 if the pattern should interchange the operands.
+
+   CMPBR_FLAG is true if this is for a compare-and-branch insn.
+   OP1 and OP2 are the two source operands of a 3 operand insn.  */
+
+int
+i960_bypass (insn, op1, op2, cmpbr_flag)
+     register rtx insn, op1, op2;
+     int cmpbr_flag;
+{
+  register rtx prev_insn, prev_dest;
+
+  if (TARGET_C_SERIES)
+    return 0;
+
+  /* Can't do this if op1 isn't a register.  */
+  if (! REG_P (op1))
+    return 0;
+
+  /* Can't do this for a compare-and-branch if both ops aren't regs.  */
+  if (cmpbr_flag && ! REG_P (op2))
+    return 0;
+
+  prev_insn = prev_real_insn (insn);
+
+  if (prev_insn && GET_CODE (prev_insn) == INSN
+      && GET_CODE (PATTERN (prev_insn)) == SET)
+    {
+      prev_dest = SET_DEST (PATTERN (prev_insn));
+      if ((GET_CODE (prev_dest) == REG && REGNO (prev_dest) == REGNO (op1))
+	  || (GET_CODE (prev_dest) == SUBREG
+	      && GET_CODE (SUBREG_REG (prev_dest)) == REG
+	      && REGNO (SUBREG_REG (prev_dest)) == REGNO (op1)))
+	return 1;
+    }
+  return 0;
+}
+
+/* Output the code which declares the function name.  This also handles
+   leaf routines, which have special requirements, and initializes some
+   global variables.  */
+
+void
+i960_function_name_declare (file, name, fndecl)
+     FILE *file;
+     const char *name;
+     tree fndecl;
+{
+  register int i, j;
+  int leaf_proc_ok;
+  rtx insn;
+
+  /* Increment global return label.  */
+
+  ret_label++;
+
+  /* Compute whether tail calls and leaf routine optimizations can be performed
+     for this function.  */
+
+  if (TARGET_TAILCALL)
+    tail_call_ok = 1;
+  else
+    tail_call_ok = 0;
+
+  if (TARGET_LEAFPROC)
+    leaf_proc_ok = 1;
+  else
+    leaf_proc_ok = 0;
+
+  /* Even if nobody uses extra parms, can't have leafproc or tail calls if
+     argblock, because argblock uses g14 implicitly.  */
+
+  if (current_function_args_size != 0 || VARARGS_STDARG_FUNCTION (fndecl))
+    {
+      tail_call_ok = 0;
+      leaf_proc_ok = 0;
+    }
+      
+  /* See if caller passes in an address to return value.  */
+
+  if (aggregate_value_p (DECL_RESULT (fndecl), fndecl))
+    {
+      tail_call_ok = 0;
+      leaf_proc_ok = 0;
+    }
+
+  /* Can not use tail calls or make this a leaf routine if there is a non
+     zero frame size.  */
+
+  if (get_frame_size () != 0)
+    leaf_proc_ok = 0;
+
+  /* I don't understand this condition, and do not think that it is correct.
+     Apparently this is just checking whether the frame pointer is used, and
+     we can't trust regs_ever_live[fp] since it is (almost?) always set.  */
+
+  if (tail_call_ok)
+    for (insn = get_insns (); insn; insn = NEXT_INSN (insn))
+      if (GET_CODE (insn) == INSN
+	  && reg_mentioned_p (frame_pointer_rtx, insn))
+	{
+	  tail_call_ok = 0;
+	  break;
+	}
+
+  /* Check for CALL insns.  Can not be a leaf routine if there are any.  */
+
+  if (leaf_proc_ok)
+    for (insn = get_insns (); insn; insn = NEXT_INSN (insn))
+      if (GET_CODE (insn) == CALL_INSN)
+	{
+	  leaf_proc_ok = 0;
+	  break;
+	}
+
+  /* Can not be a leaf routine if any non-call clobbered registers are
+     used in this function.  */
+
+  if (leaf_proc_ok)
+    for (i = 0, j = 0; i < FIRST_PSEUDO_REGISTER; i++)
+      if (regs_ever_live[i]
+	  && ((! call_used_regs[i]) || (i > 7 && i < 12)))
+	{
+	  /* Global registers.  */
+	  if (i < 16 && i > 7 && i != 13)
+	    leaf_proc_ok = 0;
+	  /* Local registers.  */
+	  else if (i < 32)
+	    leaf_proc_ok = 0;
+	}
+
+  /* Now choose a leaf return register, if we can find one, and if it is
+     OK for this to be a leaf routine.  */
+
+  i960_leaf_ret_reg = -1;
+
+  if (optimize && leaf_proc_ok)
+    {
+      for (i960_leaf_ret_reg = -1, i = 0; i < 8; i++)
+	if (regs_ever_live[i] == 0)
+	  {
+	    i960_leaf_ret_reg = i;
+	    regs_ever_live[i] = 1;
+	    break;
+	  }
+    }
+
+  /* Do this after choosing the leaf return register, so it will be listed
+     if one was chosen.  */
+
+  fprintf (file, "\t#  Function '%s'\n", (name[0] == '*' ? &name[1] : name));
+  fprintf (file, "\t#  Registers used: ");
+
+  for (i = 0, j = 0; i < FIRST_PSEUDO_REGISTER; i++)
+    {
+      if (regs_ever_live[i])
+	{
+	  fprintf (file, "%s%s ", reg_names[i], call_used_regs[i] ? "" : "*");
+
+	  if (i > 15 && j == 0)
+	    {
+	      fprintf (file,"\n\t#\t\t   ");
+	      j++;
+            }
+        }
+    }
+
+  fprintf (file, "\n");
+
+  if (i960_leaf_ret_reg >= 0)
+    {
+      /* Make it a leaf procedure.  */
+
+      if (TREE_PUBLIC (fndecl))
+	fprintf (file,"\t.globl\t%s.lf\n", (name[0] == '*' ? &name[1] : name));
+
+      fprintf (file, "\t.leafproc\t");
+      assemble_name (file, name);
+      fprintf (file, ",%s.lf\n", (name[0] == '*' ? &name[1] : name));
+      ASM_OUTPUT_LABEL (file, name);
+      fprintf (file, "\tlda    Li960R%d,g14\n", ret_label);
+      fprintf (file, "%s.lf:\n", (name[0] == '*' ? &name[1] : name));
+      fprintf (file, "\tmov    g14,g%d\n", i960_leaf_ret_reg);
+
+      if (TARGET_C_SERIES)
+	{
+	  fprintf (file, "\tlda    0,g14\n");
+	  i960_last_insn_type = I_TYPE_MEM;
+	}
+      else
+	{
+	  fprintf (file, "\tmov    0,g14\n");
+	  i960_last_insn_type = I_TYPE_REG;
+	}
+    }
+  else
+    {
+      ASM_OUTPUT_LABEL (file, name);
+      i960_last_insn_type = I_TYPE_CTRL; 
+    }
+}
+
+/* Compute and return the frame size.  */
+
+int
+compute_frame_size (size)
+     int size;
+{
+  int actual_fsize;
+  int outgoing_args_size = current_function_outgoing_args_size;
+
+  /* The STARTING_FRAME_OFFSET is totally hidden to us as far
+     as size is concerned.  */
+  actual_fsize = (size + 15) & -16;
+  actual_fsize += (outgoing_args_size + 15) & -16;
+
+  return actual_fsize;
+}
+
+/* Here register group is range of registers which can be moved by
+   one i960 instruction.  */
+
+struct reg_group
+{
+  char start_reg;
+  char length;
+};
+
+static int i960_form_reg_groups (int, int, int *, int, struct reg_group *);
+static int i960_reg_group_compare (const void *, const void *);
+static int i960_split_reg_group (struct reg_group *, int, int);
+static void i960_arg_size_and_align (enum machine_mode, tree, int *, int *);
+
+/* The following functions forms the biggest as possible register
+   groups with registers in STATE.  REGS contain states of the
+   registers in range [start, finish_reg).  The function returns the
+   number of groups formed.  */
+static int
+i960_form_reg_groups (start_reg, finish_reg, regs, state, reg_groups)
+     int start_reg;
+     int finish_reg;
+     int *regs;
+     int state;
+     struct reg_group *reg_groups;
+{
+  int i;
+  int nw = 0;
+
+  for (i = start_reg; i < finish_reg; )
+    {
+      if (regs [i] != state)
+	{
+	  i++;
+	  continue;
+	}
+      else if (i % 2 != 0 || regs [i + 1] != state)
+	reg_groups [nw].length = 1;
+      else if (i % 4 != 0 || regs [i + 2] != state)
+	reg_groups [nw].length = 2;
+      else if (regs [i + 3] != state)
+	reg_groups [nw].length = 3;
+      else
+	reg_groups [nw].length = 4;
+      reg_groups [nw].start_reg = i;
+      i += reg_groups [nw].length;
+      nw++;
+    }
+  return nw;
+}
+
+/* We sort register winodws in descending order by length.  */
+static int
+i960_reg_group_compare (group1, group2)
+     const void *group1;
+     const void *group2;
+{
+  const struct reg_group *w1 = group1;
+  const struct reg_group *w2 = group2;
+
+  if (w1->length > w2->length)
+    return -1;
+  else if (w1->length < w2->length)
+    return 1;
+  else
+    return 0;
+}
+
+/* Split the first register group in REG_GROUPS on subgroups one of
+   which will contain SUBGROUP_LENGTH registers.  The function
+   returns new number of winodws.  */
+static int
+i960_split_reg_group (reg_groups, nw, subgroup_length)
+     struct reg_group *reg_groups;
+     int nw;
+     int subgroup_length;
+{
+  if (subgroup_length < reg_groups->length - subgroup_length)
+    /* This guarantees correct alignments of the two subgroups for
+       i960 (see spliting for the group length 2, 3, 4).  More
+       generalized algorithm would require splitting the group more
+       two subgroups.  */
+    subgroup_length = reg_groups->length - subgroup_length;
+  /* More generalized algorithm would require to try merging
+     subgroups here.  But in case i960 it always results in failure
+     because of register group alignment.  */
+  reg_groups[nw].length = reg_groups->length - subgroup_length;
+  reg_groups[nw].start_reg = reg_groups->start_reg + subgroup_length;
+  nw++;
+  reg_groups->length = subgroup_length;
+  qsort (reg_groups, nw, sizeof (struct reg_group), i960_reg_group_compare);
+  return nw;
+}
+
+/* Output code for the function prologue.  */
+
+static void
+i960_output_function_prologue (file, size)
+     FILE *file;
+     HOST_WIDE_INT size;
+{
+  register int i, j, nr;
+  int n_saved_regs = 0;
+  int n_remaining_saved_regs;
+  HOST_WIDE_INT lvar_size;
+  HOST_WIDE_INT actual_fsize, offset;
+  int gnw, lnw;
+  struct reg_group *g, *l;
+  char tmpstr[1000];
+  /* -1 if reg must be saved on proc entry, 0 if available, 1 if saved
+     somewhere.  */
+  int regs[FIRST_PSEUDO_REGISTER];
+  /* All global registers (which must be saved) divided by groups.  */
+  struct reg_group global_reg_groups [16];
+  /* All local registers (which are available) divided by groups.  */
+  struct reg_group local_reg_groups [16];
+
+
+  for (i = 0; i < FIRST_PSEUDO_REGISTER; i++)
+    if (regs_ever_live[i]
+	&& ((! call_used_regs[i]) || (i > 7 && i < 12))
+	/* No need to save the static chain pointer.  */
+	&& ! (i == STATIC_CHAIN_REGNUM && current_function_needs_context))
+      {
+	regs[i] = -1;
+        /* Count global registers that need saving.  */
+	if (i < 16)
+	  n_saved_regs++;
+      }
+    else
+      regs[i] = 0;
+
+  n_remaining_saved_regs = n_saved_regs;
+
+  epilogue_string[0] = '\0';
+
+  if (current_function_profile)
+    {
+      /* When profiling, we may use registers 20 to 27 to save arguments, so
+	 they can't be used here for saving globals.  J is the number of
+	 argument registers the mcount call will save.  */
+      for (j = 7; j >= 0 && ! regs_ever_live[j]; j--)
+	;
+
+      for (i = 20; i <= j + 20; i++)
+	regs[i] = -1;
+    }
+
+  gnw = i960_form_reg_groups (0, 16, regs, -1, global_reg_groups);
+  lnw = i960_form_reg_groups (19, 32, regs, 0, local_reg_groups);
+  qsort (global_reg_groups, gnw, sizeof (struct reg_group),
+	 i960_reg_group_compare);
+  qsort (local_reg_groups, lnw, sizeof (struct reg_group),
+	 i960_reg_group_compare);
+  for (g = global_reg_groups, l = local_reg_groups; lnw != 0 && gnw != 0;)
+    {
+      if (g->length == l->length)
+	{
+	  fprintf (file, "\tmov%s	%s,%s\n",
+		   ((g->length == 4) ? "q" :
+		    (g->length == 3) ? "t" :
+		    (g->length == 2) ? "l" : ""),
+		   reg_names[(unsigned char) g->start_reg],
+		   reg_names[(unsigned char) l->start_reg]);
+	  sprintf (tmpstr, "\tmov%s	%s,%s\n",
+		   ((g->length == 4) ? "q" :
+		    (g->length == 3) ? "t" :
+		    (g->length == 2) ? "l" : ""),
+		   reg_names[(unsigned char) l->start_reg],
+		   reg_names[(unsigned char) g->start_reg]);
+	  strcat (epilogue_string, tmpstr);
+	  n_remaining_saved_regs -= g->length;
+	  for (i = 0; i < g->length; i++)
+	    {
+	      regs [i + g->start_reg] = 1;
+	      regs [i + l->start_reg] = -1;
+	      regs_ever_live [i + l->start_reg] = 1;
+	    }
+	  g++;
+	  l++;
+	  gnw--;
+	  lnw--;
+	}
+      else if (g->length > l->length)
+	gnw = i960_split_reg_group (g, gnw, l->length);
+      else
+	lnw = i960_split_reg_group (l, lnw, g->length);
+    }
+
+  actual_fsize = compute_frame_size (size) + 4 * n_remaining_saved_regs;
+#if 0
+  /* ??? The 1.2.1 compiler does this also.  This is meant to round the frame
+     size up to the nearest multiple of 16.  I don't know whether this is
+     necessary, or even desirable.
+
+     The frame pointer must be aligned, but the call instruction takes care of
+     that.  If we leave the stack pointer unaligned, we may save a little on
+     dynamic stack allocation.  And we don't lose, at least according to the
+     i960CA manual.  */
+  actual_fsize = (actual_fsize + 15) & ~0xF;
+#endif
+
+  /* Check stack limit if necessary.  */
+  if (current_function_limit_stack)
+    {
+      rtx min_stack = stack_limit_rtx;
+      if (actual_fsize != 0)
+	min_stack = plus_constant (stack_limit_rtx, -actual_fsize);
+
+      /* Now, emulate a little bit of reload.  We want to turn 'min_stack'
+	 into an arith_operand.  Use register 20 as the temporary.  */
+      if (legitimate_address_p (Pmode, min_stack, 1) 
+	  && !arith_operand (min_stack, Pmode))
+	{
+	  rtx tmp = gen_rtx_MEM (Pmode, min_stack);
+	  fputs ("\tlda\t", file);
+	  i960_print_operand (file, tmp, 0);
+	  fputs (",r4\n", file);
+	  min_stack = gen_rtx_REG (Pmode, 20);
+	}
+      if (arith_operand (min_stack, Pmode))
+	{
+	  fputs ("\tcmpo\tsp,", file);
+	  i960_print_operand (file, min_stack, 0);
+	  fputs ("\n\tfaultge.f\n", file);
+	}
+      else
+	warning ("stack limit expression is not supported");
+    }
+
+  /* Allocate space for register save and locals.  */
+  if (actual_fsize > 0)
+    {
+      if (actual_fsize < 32)
+	fprintf (file, "\taddo	" HOST_WIDE_INT_PRINT_DEC ",sp,sp\n",
+		 actual_fsize);
+      else
+	fprintf (file, "\tlda\t" HOST_WIDE_INT_PRINT_DEC "(sp),sp\n",
+		 actual_fsize);
+    }
+
+  /* Take hardware register save area created by the call instruction
+     into account, but store them before the argument block area.  */
+  lvar_size = actual_fsize - compute_frame_size (0) - n_remaining_saved_regs * 4;
+  offset = STARTING_FRAME_OFFSET + lvar_size;
+  /* Save registers on stack if needed.  */
+  /* ??? Is it worth to use the same algorithm as one for saving
+     global registers in local registers? */
+  for (i = 0, j = n_remaining_saved_regs; j > 0 && i < 16; i++)
+    {
+      if (regs[i] != -1)
+	continue;
+
+      nr = 1;
+
+      if (i <= 14 && i % 2 == 0 && regs[i+1] == -1 && offset % 2 == 0)
+	nr = 2;
+
+      if (nr == 2 && i <= 12 && i % 4 == 0 && regs[i+2] == -1
+	  && offset % 4 == 0)
+	nr = 3;
+
+      if (nr == 3 && regs[i+3] == -1)
+	nr = 4;
+
+      fprintf (file,"\tst%s	%s," HOST_WIDE_INT_PRINT_DEC "(fp)\n",
+	       ((nr == 4) ? "q" :
+		(nr == 3) ? "t" :
+		(nr == 2) ? "l" : ""),
+	       reg_names[i], offset);
+      sprintf (tmpstr,"\tld%s	" HOST_WIDE_INT_PRINT_DEC "(fp),%s\n",
+	       ((nr == 4) ? "q" :
+		(nr == 3) ? "t" :
+		(nr == 2) ? "l" : ""),
+	       offset, reg_names[i]);
+      strcat (epilogue_string, tmpstr);
+      i += nr-1;
+      j -= nr;
+      offset += nr * 4;
+    }
+
+  if (actual_fsize == 0)
+    return;
+
+  fprintf (file, "\t#Prologue stats:\n");
+  fprintf (file, "\t#  Total Frame Size: " HOST_WIDE_INT_PRINT_DEC " bytes\n",
+	   actual_fsize);
+
+  if (lvar_size)
+    fprintf (file, "\t#  Local Variable Size: " HOST_WIDE_INT_PRINT_DEC
+	     " bytes\n", lvar_size);
+  if (n_saved_regs)
+    fprintf (file, "\t#  Register Save Size: %d regs, %d bytes\n",
+	     n_saved_regs, n_saved_regs * 4);
+  fprintf (file, "\t#End Prologue#\n");
+}
+
+/* Output code for the function profiler.  */
+
+void
+output_function_profiler (file, labelno)
+     FILE *file;
+     int labelno;
+{
+  /* The last used parameter register.  */
+  int last_parm_reg;
+  int i, j, increment;
+  int varargs_stdarg_function
+    = VARARGS_STDARG_FUNCTION (current_function_decl);
+
+  /* Figure out the last used parameter register.  The proper thing to do
+     is to walk incoming args of the function.  A function might have live
+     parameter registers even if it has no incoming args.  Note that we
+     don't have to save parameter registers g8 to g11 because they are
+     call preserved.  */
+
+  /* See also output_function_prologue, which tries to use local registers
+     for preserved call-saved global registers.  */
+
+  for (last_parm_reg = 7;
+       last_parm_reg >= 0 && ! regs_ever_live[last_parm_reg];
+       last_parm_reg--)
+    ;
+
+  /* Save parameter registers in regs r4 (20) to r11 (27).  */
+
+  for (i = 0, j = 4; i <= last_parm_reg; i += increment, j += increment)
+    {
+      if (i % 4 == 0 && (last_parm_reg - i) >= 3)
+	increment = 4;
+      else if (i % 4 == 0 && (last_parm_reg - i) >= 2)
+	increment = 3;
+      else if (i % 2 == 0 && (last_parm_reg - i) >= 1)
+	increment = 2;
+      else
+	increment = 1;
+
+      fprintf (file, "\tmov%s	g%d,r%d\n",
+	       (increment == 4 ? "q" : increment == 3 ? "t"
+		: increment == 2 ? "l": ""), i, j);
+      }
+
+  /* If this function uses the arg pointer, then save it in r3 and then
+     set it to zero.  */
+
+  if (current_function_args_size != 0 || varargs_stdarg_function)
+    fprintf (file, "\tmov	g14,r3\n\tmov	0,g14\n");
+
+  /* Load location address into g0 and call mcount.  */
+
+  fprintf (file, "\tlda\tLP%d,g0\n\tcallx\tmcount\n", labelno);
+
+  /* If this function uses the arg pointer, restore it.  */
+
+  if (current_function_args_size != 0 || varargs_stdarg_function)
+    fprintf (file, "\tmov	r3,g14\n");
+
+  /* Restore parameter registers.  */
+
+  for (i = 0, j = 4; i <= last_parm_reg; i += increment, j += increment)
+    {
+      if (i % 4 == 0 && (last_parm_reg - i) >= 3)
+	increment = 4;
+      else if (i % 4 == 0 && (last_parm_reg - i) >= 2)
+	increment = 3;
+      else if (i % 2 == 0 && (last_parm_reg - i) >= 1)
+	increment = 2;
+      else
+	increment = 1;
+
+      fprintf (file, "\tmov%s	r%d,g%d\n",
+	       (increment == 4 ? "q" : increment == 3 ? "t"
+		: increment == 2 ? "l": ""), j, i);
+    }
+}
+
+/* Output code for the function epilogue.  */
+
+static void
+i960_output_function_epilogue (file, size)
+     FILE *file;
+     HOST_WIDE_INT size ATTRIBUTE_UNUSED;
+{
+  if (i960_leaf_ret_reg >= 0)
+    {
+      fprintf (file, "Li960R%d:	ret\n", ret_label);
+      return;
+    }
+
+  if (*epilogue_string == 0)
+    {
+      register rtx tmp;
+	
+      /* Emit a return insn, but only if control can fall through to here.  */
+
+      tmp = get_last_insn ();
+      while (tmp)
+	{
+	  if (GET_CODE (tmp) == BARRIER)
+	    return;
+	  if (GET_CODE (tmp) == CODE_LABEL)
+	    break;
+	  if (GET_CODE (tmp) == JUMP_INSN)
+	    {
+	      if (GET_CODE (PATTERN (tmp)) == RETURN)
+		return;
+	      break;
+	    }
+	  if (GET_CODE (tmp) == NOTE)
+	    {
+	      tmp = PREV_INSN (tmp);
+	      continue;
+	    }
+	  break;
+	}
+      fprintf (file, "Li960R%d:	ret\n", ret_label);
+      return;
+    }
+
+  fprintf (file, "Li960R%d:\n", ret_label);
+
+  fprintf (file, "\t#EPILOGUE#\n");
+
+  /* Output the string created by the prologue which will restore all
+     registers saved by the prologue.  */
+
+  if (epilogue_string[0] != '\0')
+    fprintf (file, "%s", epilogue_string);
+
+  /* Must clear g14 on return if this function set it.
+     Only varargs/stdarg functions modify g14.  */
+
+  if (VARARGS_STDARG_FUNCTION (current_function_decl))
+    fprintf (file, "\tmov	0,g14\n");
+
+  fprintf (file, "\tret\n");
+  fprintf (file, "\t#End Epilogue#\n");
+}
+
+/* Output code for a call insn.  */
+
+const char *
+i960_output_call_insn (target, argsize_rtx, arg_pointer, insn)
+     register rtx target, argsize_rtx, arg_pointer, insn;
+{
+  int argsize = INTVAL (argsize_rtx);
+  rtx nexti = next_real_insn (insn);
+  rtx operands[2];
+  int varargs_stdarg_function
+    = VARARGS_STDARG_FUNCTION (current_function_decl);
+
+  operands[0] = target;
+  operands[1] = arg_pointer;
+
+  if (current_function_args_size != 0 || varargs_stdarg_function)
+    output_asm_insn ("mov	g14,r3", operands);
+
+  if (argsize > 48)
+    output_asm_insn ("lda	%a1,g14", operands);
+  else if (current_function_args_size != 0 || varargs_stdarg_function)
+    output_asm_insn ("mov	0,g14", operands);
+
+  /* The code used to assume that calls to SYMBOL_REFs could not be more
+     than 24 bits away (b vs bx, callj vs callx).  This is not true.  This
+     feature is now implemented by relaxing in the GNU linker.  It can convert
+     bx to b if in range, and callx to calls/call/balx/bal as appropriate.  */
+
+  /* Nexti could be zero if the called routine is volatile.  */
+  if (optimize && (*epilogue_string == 0) && argsize == 0 && tail_call_ok 
+      && (nexti == 0 || GET_CODE (PATTERN (nexti)) == RETURN))
+    {
+      /* Delete following return insn.  */
+      if (nexti && no_labels_between_p (insn, nexti))
+	delete_insn (nexti);
+      output_asm_insn ("bx	%0", operands);
+      return "# notreached";
+    }
+
+  output_asm_insn ("callx	%0", operands);
+
+  /* If the caller sets g14 to the address of the argblock, then the caller
+     must clear it after the return.  */
+
+  if (current_function_args_size != 0 || varargs_stdarg_function)
+    output_asm_insn ("mov	r3,g14", operands);
+  else if (argsize > 48)
+    output_asm_insn ("mov	0,g14", operands);
+
+  return "";
+}
+
+/* Output code for a return insn.  */
+
+const char *
+i960_output_ret_insn (insn)
+     register rtx insn;
+{
+  static char lbuf[20];
+  
+  if (*epilogue_string != 0)
+    {
+      if (! TARGET_CODE_ALIGN && next_real_insn (insn) == 0)
+	return "";
+
+      sprintf (lbuf, "b	Li960R%d", ret_label);
+      return lbuf;
+    }
+
+  /* Must clear g14 on return if this function set it.
+     Only varargs/stdarg functions modify g14.  */
+
+  if (VARARGS_STDARG_FUNCTION (current_function_decl))
+    output_asm_insn ("mov	0,g14", 0);
+
+  if (i960_leaf_ret_reg >= 0)
+    {
+      sprintf (lbuf, "bx	(%s)", reg_names[i960_leaf_ret_reg]);
+      return lbuf;
+    }
+  return "ret";
+}
+
+/* Print the operand represented by rtx X formatted by code CODE.  */
+
+void
+i960_print_operand (file, x, code)
+     FILE *file;
+     rtx x;
+     int code;
+{
+  enum rtx_code rtxcode = x ? GET_CODE (x) : NIL;
+
+  if (rtxcode == REG)
+    {
+      switch (code)
+	{
+	case 'D':
+	  /* Second reg of a double or quad.  */
+	  fprintf (file, "%s", reg_names[REGNO (x)+1]);
+	  break;
+
+	case 'E':
+	  /* Third reg of a quad.  */
+	  fprintf (file, "%s", reg_names[REGNO (x)+2]);
+	  break;
+
+	case 'F':
+	  /* Fourth reg of a quad.  */
+	  fprintf (file, "%s", reg_names[REGNO (x)+3]);
+	  break;
+
+	case 0:
+	  fprintf (file, "%s", reg_names[REGNO (x)]);
+	  break;
+
+	default:
+	  abort ();
+	}
+      return;
+    }
+  else if (rtxcode == MEM)
+    {
+      output_address (XEXP (x, 0));
+      return;
+    }
+  else if (rtxcode == CONST_INT)
+    {
+      HOST_WIDE_INT val = INTVAL (x);
+      if (code == 'C')
+	val = ~val;
+      if (val > 9999 || val < -999)
+	fprintf (file, HOST_WIDE_INT_PRINT_HEX, val);
+      else
+	fprintf (file, HOST_WIDE_INT_PRINT_DEC, val);
+      return;
+    }
+  else if (rtxcode == CONST_DOUBLE)
+    {
+      char dstr[30];
+
+      if (x == CONST0_RTX (GET_MODE (x)))
+	{
+	  fprintf (file, "0f0.0");
+	  return;
+	}
+      else if (x == CONST1_RTX (GET_MODE (x)))
+	{
+	  fprintf (file, "0f1.0");
+	  return;
+	}
+
+      real_to_decimal (dstr, CONST_DOUBLE_REAL_VALUE (x), sizeof (dstr), 0, 1);
+      fprintf (file, "0f%s", dstr);
+      return;
+    }
+
+  switch(code)
+    {
+    case 'B':
+      /* Branch or jump, depending on assembler.  */
+      if (TARGET_ASM_COMPAT)
+	fputs ("j", file);
+      else
+	fputs ("b", file);
+      break;
+
+    case 'S':
+      /* Sign of condition.  */
+      if ((rtxcode == EQ) || (rtxcode == NE) || (rtxcode == GTU)
+	  || (rtxcode == LTU) || (rtxcode == GEU) || (rtxcode == LEU))
+	fputs ("o", file);
+      else if ((rtxcode == GT) || (rtxcode == LT)
+	  || (rtxcode == GE) || (rtxcode == LE))
+	fputs ("i", file);
+      else
+	abort();
+      break;
+
+    case 'I':
+      /* Inverted condition.  */
+      rtxcode = reverse_condition (rtxcode);
+      goto normal;
+
+    case 'X':
+      /* Inverted condition w/ reversed operands.  */
+      rtxcode = reverse_condition (rtxcode);
+      /* Fallthrough.  */
+
+    case 'R':
+      /* Reversed operand condition.  */
+      rtxcode = swap_condition (rtxcode);
+      /* Fallthrough.  */
+
+    case 'C':
+      /* Normal condition.  */
+    normal:
+      if (rtxcode == EQ)  { fputs ("e", file); return; }
+      else if (rtxcode == NE)  { fputs ("ne", file); return; }
+      else if (rtxcode == GT)  { fputs ("g", file); return; }
+      else if (rtxcode == GTU) { fputs ("g", file); return; }
+      else if (rtxcode == LT)  { fputs ("l", file); return; }
+      else if (rtxcode == LTU) { fputs ("l", file); return; }
+      else if (rtxcode == GE)  { fputs ("ge", file); return; }
+      else if (rtxcode == GEU) { fputs ("ge", file); return; }
+      else if (rtxcode == LE)  { fputs ("le", file); return; }
+      else if (rtxcode == LEU) { fputs ("le", file); return; }
+      else abort ();
+      break;
+
+    case '+':
+      /* For conditional branches, substitute ".t" or ".f".  */
+      if (TARGET_BRANCH_PREDICT)
+	{
+	  x = find_reg_note (current_output_insn, REG_BR_PROB, 0);
+	  if (x)
+	    {
+	      int pred_val = INTVAL (XEXP (x, 0));
+	      fputs ((pred_val < REG_BR_PROB_BASE / 2 ? ".f" : ".t"), file);
+	    }
+	}
+      break;
+
+    case 0:
+      output_addr_const (file, x);
+      break;
+
+    default:
+      abort ();
+    }
+
+  return;
+}
+
+/* Print a memory address as an operand to reference that memory location.
+
+   This is exactly the same as legitimate_address_p, except that it the prints
+   addresses instead of recognizing them.  */
+
+void
+i960_print_operand_addr (file, addr)
+     FILE *file;
+     register rtx addr;
+{
+  rtx breg, ireg;
+  rtx scale, offset;
+
+  ireg = 0;
+  breg = 0;
+  offset = 0;
+  scale = const1_rtx;
+
+  if (GET_CODE (addr) == REG)
+    breg = addr;
+  else if (CONSTANT_P (addr))
+    offset = addr;
+  else if (GET_CODE (addr) == PLUS)
+    {
+      rtx op0, op1;
+
+      op0 = XEXP (addr, 0);
+      op1 = XEXP (addr, 1);
+
+      if (GET_CODE (op0) == REG)
+	{
+	  breg = op0;
+	  if (GET_CODE (op1) == REG)
+	    ireg = op1;
+	  else if (CONSTANT_P (op1))
+	    offset = op1;
+	  else
+	    abort ();
+	}
+      else if (GET_CODE (op0) == PLUS)
+	{
+	  if (GET_CODE (XEXP (op0, 0)) == MULT)
+	    {
+	      ireg = XEXP (XEXP (op0, 0), 0);
+	      scale = XEXP (XEXP (op0, 0), 1);
+	      if (GET_CODE (XEXP (op0, 1)) == REG)
+		{
+		  breg = XEXP (op0, 1);
+		  offset = op1;
+		}
+	      else
+		abort ();
+	    }
+	  else if (GET_CODE (XEXP (op0, 0)) == REG)
+	    {
+	      breg = XEXP (op0, 0);
+	      if (GET_CODE (XEXP (op0, 1)) == REG)
+		{
+		  ireg = XEXP (op0, 1);
+		  offset = op1;
+		}
+	      else
+		abort ();
+	    }
+	  else
+	    abort ();
+	}
+      else if (GET_CODE (op0) == MULT)
+	{
+	  ireg = XEXP (op0, 0);
+	  scale = XEXP (op0, 1);
+	  if (GET_CODE (op1) == REG)
+	    breg = op1;
+	  else if (CONSTANT_P (op1))
+	    offset = op1;
+	  else
+	    abort ();
+	}
+      else
+	abort ();
+    }
+  else if (GET_CODE (addr) == MULT)
+    {
+      ireg = XEXP (addr, 0);
+      scale = XEXP (addr, 1);
+    }
+  else
+    abort ();
+
+  if (offset)
+    output_addr_const (file, offset);
+  if (breg)
+    fprintf (file, "(%s)", reg_names[REGNO (breg)]);
+  if (ireg)
+    fprintf (file, "[%s*" HOST_WIDE_INT_PRINT_DEC "]",
+	     reg_names[REGNO (ireg)], INTVAL (scale));
+}
+
+/* GO_IF_LEGITIMATE_ADDRESS recognizes an RTL expression
+   that is a valid memory address for an instruction.
+   The MODE argument is the machine mode for the MEM expression
+   that wants to use this address.
+
+	On 80960, legitimate addresses are:
+		base				ld	(g0),r0
+		disp	(12 or 32 bit)		ld	foo,r0
+		base + index			ld	(g0)[g1*1],r0
+		base + displ			ld	0xf00(g0),r0
+		base + index*scale + displ	ld	0xf00(g0)[g1*4],r0
+		index*scale + base		ld	(g0)[g1*4],r0
+		index*scale + displ		ld	0xf00[g1*4],r0
+		index*scale			ld	[g1*4],r0
+		index + base + displ		ld	0xf00(g0)[g1*1],r0
+
+	In each case, scale can be 1, 2, 4, 8, or 16.  */
+
+/* This is exactly the same as i960_print_operand_addr, except that
+   it recognizes addresses instead of printing them.
+
+   It only recognizes address in canonical form.  LEGITIMIZE_ADDRESS should
+   convert common non-canonical forms to canonical form so that they will
+   be recognized.  */
+
+/* These two macros allow us to accept either a REG or a SUBREG anyplace
+   where a register is valid.  */
+
+#define RTX_OK_FOR_BASE_P(X, STRICT)					\
+  ((GET_CODE (X) == REG							\
+    && (STRICT ? REG_OK_FOR_BASE_P_STRICT (X) : REG_OK_FOR_BASE_P (X)))	\
+   || (GET_CODE (X) == SUBREG						\
+       && GET_CODE (SUBREG_REG (X)) == REG				\
+       && (STRICT ? REG_OK_FOR_BASE_P_STRICT (SUBREG_REG (X))		\
+	   : REG_OK_FOR_BASE_P (SUBREG_REG (X)))))
+
+#define RTX_OK_FOR_INDEX_P(X, STRICT)					\
+  ((GET_CODE (X) == REG							\
+    && (STRICT ? REG_OK_FOR_INDEX_P_STRICT (X) : REG_OK_FOR_INDEX_P (X)))\
+   || (GET_CODE (X) == SUBREG						\
+       && GET_CODE (SUBREG_REG (X)) == REG				\
+       && (STRICT ? REG_OK_FOR_INDEX_P_STRICT (SUBREG_REG (X))		\
+	   : REG_OK_FOR_INDEX_P (SUBREG_REG (X)))))
+
+int
+legitimate_address_p (mode, addr, strict)
+     enum machine_mode mode ATTRIBUTE_UNUSED;
+     register rtx addr;
+     int strict;
+{
+  if (RTX_OK_FOR_BASE_P (addr, strict))
+    return 1;
+  else if (CONSTANT_P (addr))
+    return 1;
+  else if (GET_CODE (addr) == PLUS)
+    {
+      rtx op0, op1;
+
+      if (! TARGET_COMPLEX_ADDR && ! reload_completed)
+	return 0;
+
+      op0 = XEXP (addr, 0);
+      op1 = XEXP (addr, 1);
+
+      if (RTX_OK_FOR_BASE_P (op0, strict))
+	{
+	  if (RTX_OK_FOR_INDEX_P (op1, strict))
+	    return 1;
+	  else if (CONSTANT_P (op1))
+	    return 1;
+	  else
+	    return 0;
+	}
+      else if (GET_CODE (op0) == PLUS)
+	{
+	  if (GET_CODE (XEXP (op0, 0)) == MULT)
+	    {
+	      if (! (RTX_OK_FOR_INDEX_P (XEXP (XEXP (op0, 0), 0), strict)
+		     && SCALE_TERM_P (XEXP (XEXP (op0, 0), 1))))
+		return 0;
+
+	      if (RTX_OK_FOR_BASE_P (XEXP (op0, 1), strict)
+		  && CONSTANT_P (op1))
+		return 1;
+	      else
+		return 0;
+	    }
+	  else if (RTX_OK_FOR_BASE_P (XEXP (op0, 0), strict))
+	    {
+	      if (RTX_OK_FOR_INDEX_P (XEXP (op0, 1), strict)
+		  && CONSTANT_P (op1))
+		return 1;
+	      else
+		return 0;
+	    }
+	  else
+	    return 0;
+	}
+      else if (GET_CODE (op0) == MULT)
+	{
+	  if (! (RTX_OK_FOR_INDEX_P (XEXP (op0, 0), strict)
+		 && SCALE_TERM_P (XEXP (op0, 1))))
+	    return 0;
+
+	  if (RTX_OK_FOR_BASE_P (op1, strict))
+	    return 1;
+	  else if (CONSTANT_P (op1))
+	    return 1;
+	  else
+	    return 0;
+	}
+      else
+	return 0;
+    }
+  else if (GET_CODE (addr) == MULT)
+    {
+      if (! TARGET_COMPLEX_ADDR && ! reload_completed)
+	return 0;
+
+      return (RTX_OK_FOR_INDEX_P (XEXP (addr, 0), strict)
+	      && SCALE_TERM_P (XEXP (addr, 1)));
+    }
+  else
+    return 0;
+}
+
+/* Try machine-dependent ways of modifying an illegitimate address
+   to be legitimate.  If we find one, return the new, valid address.
+   This macro is used in only one place: `memory_address' in explow.c.
+
+   This converts some non-canonical addresses to canonical form so they
+   can be recognized.  */
+
+rtx
+legitimize_address (x, oldx, mode)
+     register rtx x;
+     register rtx oldx ATTRIBUTE_UNUSED;
+     enum machine_mode mode ATTRIBUTE_UNUSED;
+{ 
+  if (GET_CODE (x) == SYMBOL_REF)
+    {
+      abort ();
+      x = copy_to_reg (x);
+    }
+
+  if (! TARGET_COMPLEX_ADDR && ! reload_completed)
+    return x;
+
+  /* Canonicalize (plus (mult (reg) (const)) (plus (reg) (const)))
+     into (plus (plus (mult (reg) (const)) (reg)) (const)).  This can be
+     created by virtual register instantiation, register elimination, and
+     similar optimizations.  */
+  if (GET_CODE (x) == PLUS && GET_CODE (XEXP (x, 0)) == MULT
+      && GET_CODE (XEXP (x, 1)) == PLUS)
+    x = gen_rtx_PLUS (Pmode,
+		      gen_rtx_PLUS (Pmode, XEXP (x, 0), XEXP (XEXP (x, 1), 0)),
+		      XEXP (XEXP (x, 1), 1));
+
+  /* Canonicalize (plus (plus (mult (reg) (const)) (plus (reg) (const))) const)
+     into (plus (plus (mult (reg) (const)) (reg)) (const)).  */
+  else if (GET_CODE (x) == PLUS && GET_CODE (XEXP (x, 0)) == PLUS
+	   && GET_CODE (XEXP (XEXP (x, 0), 0)) == MULT
+	   && GET_CODE (XEXP (XEXP (x, 0), 1)) == PLUS
+	   && CONSTANT_P (XEXP (x, 1)))
+    {
+      rtx constant, other;
+
+      if (GET_CODE (XEXP (x, 1)) == CONST_INT)
+	{
+	  constant = XEXP (x, 1);
+	  other = XEXP (XEXP (XEXP (x, 0), 1), 1);
+	}
+      else if (GET_CODE (XEXP (XEXP (XEXP (x, 0), 1), 1)) == CONST_INT)
+	{
+	  constant = XEXP (XEXP (XEXP (x, 0), 1), 1);
+	  other = XEXP (x, 1);
+	}
+      else
+	constant = 0, other = 0;
+
+      if (constant)
+	x = gen_rtx_PLUS (Pmode,
+			  gen_rtx_PLUS (Pmode, XEXP (XEXP (x, 0), 0),
+					XEXP (XEXP (XEXP (x, 0), 1), 0)),
+			  plus_constant (other, INTVAL (constant)));
+    }
+
+  return x;
+}
+
+#if 0
+/* Return the most stringent alignment that we are willing to consider
+   objects of size SIZE and known alignment ALIGN as having.  */
+   
+int
+i960_alignment (size, align)
+     int size;
+     int align;
+{
+  int i;
+
+  if (! TARGET_STRICT_ALIGN)
+    if (TARGET_IC_COMPAT2_0 || align >= 4)
+      {
+	i = i960_object_bytes_bitalign (size) / BITS_PER_UNIT;
+	if (i > align)
+	  align = i;
+      }
+
+  return align;
+}
+#endif
+
+
+int
+hard_regno_mode_ok (regno, mode)
+     int regno;
+     enum machine_mode mode;
+{
+  if (regno < 32)
+    {
+      switch (mode)
+	{
+	case CCmode: case CC_UNSmode: case CC_CHKmode:
+	  return 0;
+
+	case DImode: case DFmode:
+	  return (regno & 1) == 0;
+
+	case TImode: case TFmode:
+	  return (regno & 3) == 0;
+
+	default:
+	  return 1;
+	}
+    }
+  else if (regno >= 32 && regno < 36)
+    {
+      switch (mode)
+	{
+	case SFmode: case DFmode: case TFmode:
+	case SCmode: case DCmode:
+	  return 1;
+
+	default:
+	  return 0;
+	}
+    }
+  else if (regno == 36)
+    {
+      switch (mode)
+	{
+	case CCmode: case CC_UNSmode: case CC_CHKmode:
+	  return 1;
+
+	default:
+	  return 0;
+	}
+    }
+  else if (regno == 37)
+    return 0;
+
+  abort ();
+}
+
+
+/* Return the minimum alignment of an expression rtx X in bytes.  This takes
+   advantage of machine specific facts, such as knowing that the frame pointer
+   is always 16 byte aligned.  */
+
+int
+i960_expr_alignment (x, size)
+     rtx x;
+     int size;
+{
+  int align = 1;
+
+  if (x == 0)
+    return 1;
+
+  switch (GET_CODE(x))
+    {
+    case CONST_INT:
+      align = INTVAL(x);
+
+      if ((align & 0xf) == 0)
+	align = 16;
+      else if ((align & 0x7) == 0)
+	align = 8;
+      else if ((align & 0x3) == 0)
+	align = 4;
+      else if ((align & 0x1) == 0)
+	align = 2;
+      else
+	align = 1;
+      break;
+
+    case PLUS:
+      align = MIN (i960_expr_alignment (XEXP (x, 0), size),
+		   i960_expr_alignment (XEXP (x, 1), size));
+      break;
+
+    case SYMBOL_REF:
+      /* If this is a valid program, objects are guaranteed to be
+	 correctly aligned for whatever size the reference actually is.  */
+      align = i960_object_bytes_bitalign (size) / BITS_PER_UNIT;
+      break;
+
+    case REG:
+      if (REGNO (x) == FRAME_POINTER_REGNUM)
+	align = 16;
+      break;
+
+    case ASHIFT:
+      align = i960_expr_alignment (XEXP (x, 0), size);
+
+      if (GET_CODE (XEXP (x, 1)) == CONST_INT)
+	{
+	  align = align << INTVAL (XEXP (x, 1));
+	  align = MIN (align, 16);
+	}
+      break;
+
+    case MULT:
+      align = (i960_expr_alignment (XEXP (x, 0), size) *
+	       i960_expr_alignment (XEXP (x, 1), size));
+
+      align = MIN (align, 16);
+      break;
+    default:
+      break;
+    }
+
+  return align;
+}
+
+/* Return true if it is possible to reference both BASE and OFFSET, which
+   have alignment at least as great as 4 byte, as if they had alignment valid
+   for an object of size SIZE.  */
+
+int
+i960_improve_align (base, offset, size)
+     rtx base;
+     rtx offset;
+     int size;
+{
+  int i, j;
+
+  /* We have at least a word reference to the object, so we know it has to
+     be aligned at least to 4 bytes.  */
+
+  i = MIN (i960_expr_alignment (base, 4),
+	   i960_expr_alignment (offset, 4));
+
+  i = MAX (i, 4);
+
+  /* We know the size of the request.  If strict align is not enabled, we
+     can guess that the alignment is OK for the requested size.  */
+
+  if (! TARGET_STRICT_ALIGN)
+    if ((j = (i960_object_bytes_bitalign (size) / BITS_PER_UNIT)) > i)
+      i = j;
+
+  return (i >= size);
+}
+
+/* Return true if it is possible to access BASE and OFFSET, which have 4 byte
+   (SImode) alignment as if they had 16 byte (TImode) alignment.  */
+
+int
+i960_si_ti (base, offset)
+     rtx base;
+     rtx offset;
+{
+  return i960_improve_align (base, offset, 16);
+}
+
+/* Return true if it is possible to access BASE and OFFSET, which have 4 byte
+   (SImode) alignment as if they had 8 byte (DImode) alignment.  */
+
+int
+i960_si_di (base, offset)
+     rtx base;
+     rtx offset;
+{
+  return i960_improve_align (base, offset, 8);
+}
+
+/* Return raw values of size and alignment (in words) for the data
+   type being accessed.  These values will be rounded by the caller.  */
+
+static void 
+i960_arg_size_and_align (mode, type, size_out, align_out)
+     enum machine_mode mode;
+     tree type;
+     int *size_out;
+     int *align_out;
+{
+  int size, align;
+
+  /* Use formal alignment requirements of type being passed, except make
+     it at least a word.  If we don't have a type, this is a library call,
+     and the parm has to be of scalar type.  In this case, consider its
+     formal alignment requirement to be its size in words.  */
+
+  if (mode == BLKmode)
+    size = (int_size_in_bytes (type) + UNITS_PER_WORD - 1) / UNITS_PER_WORD;
+  else if (mode == VOIDmode)
+    {
+      /* End of parm list.  */
+      if (type == 0 || TYPE_MODE (type) != VOIDmode)
+	abort ();
+      size = 1;
+    }
+  else
+    size = (GET_MODE_SIZE (mode) + UNITS_PER_WORD - 1) / UNITS_PER_WORD;
+
+  if (type == 0)
+    align = size;
+  else if (TYPE_ALIGN (type) >= BITS_PER_WORD)
+    align = TYPE_ALIGN (type) / BITS_PER_WORD;
+  else
+    align = 1;
+
+  *size_out  = size;
+  *align_out = align;
+}
+
+/* On the 80960 the first 12 args are in registers and the rest are pushed.
+   Any arg that is bigger than 4 words is placed on the stack and all
+   subsequent arguments are placed on the stack.
+
+   Additionally, parameters with an alignment requirement stronger than
+   a word must be aligned appropriately.  Note that this means that a
+   64 bit object with a 32 bit alignment is not 64 bit aligned and may be
+   passed in an odd/even register pair.  */
+
+/* Update CUM to advance past an argument described by MODE and TYPE.  */
+
+void
+i960_function_arg_advance (cum, mode, type, named)
+     CUMULATIVE_ARGS *cum;
+     enum machine_mode mode;
+     tree type;
+     int named ATTRIBUTE_UNUSED;
+{
+  int size, align;
+
+  i960_arg_size_and_align (mode, type, &size, &align);
+
+  if (size > 4 || cum->ca_nstackparms != 0
+      || (size + ROUND_PARM (cum->ca_nregparms, align)) > NPARM_REGS
+      || MUST_PASS_IN_STACK (mode, type))
+    {
+      /* Indicate that all the registers are in use, even if all are not,
+	 so va_start will compute the right value.  */
+      cum->ca_nregparms = NPARM_REGS;
+      cum->ca_nstackparms = ROUND_PARM (cum->ca_nstackparms, align) + size;
+    }
+  else
+    cum->ca_nregparms = ROUND_PARM (cum->ca_nregparms, align) + size;
+}
+
+/* Return the register that the argument described by MODE and TYPE is
+   passed in, or else return 0 if it is passed on the stack.  */
+
+rtx
+i960_function_arg (cum, mode, type, named)
+     CUMULATIVE_ARGS *cum;
+     enum machine_mode mode;
+     tree type;
+     int named ATTRIBUTE_UNUSED;
+{
+  rtx ret;
+  int size, align;
+
+  if (mode == VOIDmode)
+    return 0;
+
+  i960_arg_size_and_align (mode, type, &size, &align);
+
+  if (size > 4 || cum->ca_nstackparms != 0
+      || (size + ROUND_PARM (cum->ca_nregparms, align)) > NPARM_REGS
+      || MUST_PASS_IN_STACK (mode, type))
+    {
+      cum->ca_nstackparms = ROUND_PARM (cum->ca_nstackparms, align);
+      ret = 0;
+    }
+  else
+    {
+      cum->ca_nregparms = ROUND_PARM (cum->ca_nregparms, align);
+      ret = gen_rtx_REG (mode, cum->ca_nregparms);
+    }
+
+  return ret;
+}
+
+/* Return the number of bits that an object of size N bytes is aligned to.  */
+
+int
+i960_object_bytes_bitalign (n)
+     int n;
+{
+  if (n > 8)      n = 128;
+  else if (n > 4) n = 64;
+  else if (n > 2) n = 32;
+  else if (n > 1) n = 16;
+  else            n = 8;
+
+  return n;
+}
+
+/* Compute the alignment for an aggregate type TSIZE.
+   Alignment is MAX (greatest member alignment,
+                     MIN (pragma align, structure size alignment)).  */
+
+int
+i960_round_align (align, type)
+     int align;
+     tree type;
+{
+  int new_align;
+  tree tsize;
+
+  if (TARGET_OLD_ALIGN || TYPE_PACKED (type))
+    return align;
+  if (TREE_CODE (type) != RECORD_TYPE)
+    return align;
+  tsize = TYPE_SIZE (type);
+
+  if (! tsize || TREE_CODE (tsize) != INTEGER_CST)
+    return align;
+
+  new_align = i960_object_bytes_bitalign (TREE_INT_CST_LOW (tsize)
+					  / BITS_PER_UNIT);
+  /* Handle #pragma align.  */
+  if (new_align > i960_maxbitalignment)
+    new_align = i960_maxbitalignment;
+
+  if (align < new_align)
+    align = new_align;
+
+  return align;
+}
+
+/* Do any needed setup for a varargs function.  For the i960, we must
+   create a register parameter block if one doesn't exist, and then copy
+   all register parameters to memory.  */
+
+void
+i960_setup_incoming_varargs (cum, mode, type, pretend_size, no_rtl)
+     CUMULATIVE_ARGS *cum;
+     enum machine_mode mode ATTRIBUTE_UNUSED;
+     tree type ATTRIBUTE_UNUSED;
+     int *pretend_size ATTRIBUTE_UNUSED;
+     int no_rtl;
+{
+  /* Note: for a varargs fn with only a va_alist argument, this is 0.  */
+  int first_reg = cum->ca_nregparms;
+
+  /* Copy only unnamed register arguments to memory.  If there are
+     any stack parms, there are no unnamed arguments in registers, and
+     an argument block was already allocated by the caller.
+     Remember that any arg bigger than 4 words is passed on the stack as
+     are all subsequent args.
+
+     If there are no stack arguments but there are exactly NPARM_REGS
+     registers, either there were no extra arguments or the caller
+     allocated an argument block.  */
+
+  if (cum->ca_nstackparms == 0 && first_reg < NPARM_REGS && !no_rtl)
+    {
+      rtx label = gen_label_rtx ();
+      rtx regblock, fake_arg_pointer_rtx;
+
+      /* Use a different rtx than arg_pointer_rtx so that cse and friends
+	 can go on believing that the argument pointer can never be zero.  */
+      fake_arg_pointer_rtx = gen_raw_REG (Pmode, ARG_POINTER_REGNUM);
+
+      /* If the argument pointer is 0, no arguments were passed on the stack
+	 and we need to allocate a chunk to save the registers (if any
+	 arguments were passed on the stack the caller would allocate the
+	 48 bytes as well).  We must allocate all 48 bytes (12*4) because
+	 va_start assumes it.  */
+      emit_insn (gen_cmpsi (fake_arg_pointer_rtx, const0_rtx));
+      emit_jump_insn (gen_bne (label));
+      emit_insn (gen_rtx_SET (VOIDmode, fake_arg_pointer_rtx,
+			      stack_pointer_rtx));
+      emit_insn (gen_rtx_SET (VOIDmode, stack_pointer_rtx,
+			      memory_address (SImode,
+					      plus_constant (stack_pointer_rtx,
+							     48))));
+      emit_label (label);
+
+      /* ??? Note that we unnecessarily store one extra register for stdarg
+	 fns.  We could optimize this, but it's kept as for now.  */
+      regblock = gen_rtx_MEM (BLKmode,
+			      plus_constant (arg_pointer_rtx, first_reg * 4));
+      set_mem_alias_set (regblock, get_varargs_alias_set ());
+      set_mem_align (regblock, BITS_PER_WORD);
+      move_block_from_reg (first_reg, regblock,
+			   NPARM_REGS - first_reg);
+    }
+}
+
+/* Define the `__builtin_va_list' type for the ABI.  */
+
+static tree
+i960_build_builtin_va_list ()
+{
+  return build_array_type (unsigned_type_node,
+			   build_index_type (size_one_node));
+}
+
+/* Implement `va_start' for varargs and stdarg.  */
+
+void
+i960_va_start (valist, nextarg)
+     tree valist;
+     rtx nextarg ATTRIBUTE_UNUSED;
+{
+  tree s, t, base, num;
+  rtx fake_arg_pointer_rtx;
+
+  /* The array type always decays to a pointer before we get here, so we
+     can't use ARRAY_REF.  */
+  base = build1 (INDIRECT_REF, unsigned_type_node, valist);
+  num = build1 (INDIRECT_REF, unsigned_type_node,
+		build (PLUS_EXPR, unsigned_type_node, valist,
+		       TYPE_SIZE_UNIT (TREE_TYPE (valist))));
+
+  /* Use a different rtx than arg_pointer_rtx so that cse and friends
+     can go on believing that the argument pointer can never be zero.  */
+  fake_arg_pointer_rtx = gen_raw_REG (Pmode, ARG_POINTER_REGNUM);
+  s = make_tree (unsigned_type_node, fake_arg_pointer_rtx);
+  t = build (MODIFY_EXPR, unsigned_type_node, base, s);
+  TREE_SIDE_EFFECTS (t) = 1;
+  expand_expr (t, const0_rtx, VOIDmode, EXPAND_NORMAL);
+
+  s = build_int_2 ((current_function_args_info.ca_nregparms
+		    + current_function_args_info.ca_nstackparms) * 4, 0);
+  t = build (MODIFY_EXPR, unsigned_type_node, num, s);
+  TREE_SIDE_EFFECTS (t) = 1;
+  expand_expr (t, const0_rtx, VOIDmode, EXPAND_NORMAL);
+}
+
+/* Implement `va_arg'.  */
+
+rtx
+i960_va_arg (valist, type)
+     tree valist, type;
+{
+  HOST_WIDE_INT siz, ali;
+  tree base, num, pad, next, this, t1, t2, int48;
+  rtx addr_rtx;
+
+  /* The array type always decays to a pointer before we get here, so we
+     can't use ARRAY_REF.  */
+  base = build1 (INDIRECT_REF, unsigned_type_node, valist);
+  num = build1 (INDIRECT_REF, unsigned_type_node,
+		build (PLUS_EXPR, unsigned_type_node, valist,
+		       TYPE_SIZE_UNIT (TREE_TYPE (valist))));
+
+  /* Round up sizeof(type) to a word.  */
+  siz = (int_size_in_bytes (type) + UNITS_PER_WORD - 1) & -UNITS_PER_WORD;
+
+  /* Round up alignment to a word.  */
+  ali = TYPE_ALIGN (type);
+  if (ali < BITS_PER_WORD)
+    ali = BITS_PER_WORD;
+  ali /= BITS_PER_UNIT;
+
+  /* Align NUM appropriate for the argument.  */
+  pad = fold (build (PLUS_EXPR, unsigned_type_node, num, 
+		      build_int_2 (ali - 1, 0)));
+  pad = fold (build (BIT_AND_EXPR, unsigned_type_node, pad,
+		      build_int_2 (-ali, -1)));
+  pad = save_expr (pad);
+
+  /* Increment VPAD past this argument.  */
+  next = fold (build (PLUS_EXPR, unsigned_type_node, pad,
+		      build_int_2 (siz, 0)));
+  next = save_expr (next);
+
+  /* Find the offset for the current argument.  Mind peculiar overflow
+     from registers to stack.  */
+  int48 = build_int_2 (48, 0);
+  if (siz > 16)
+    t2 = integer_one_node;
+  else
+    t2 = fold (build (GT_EXPR, integer_type_node, next, int48));
+  t1 = fold (build (LE_EXPR, integer_type_node, num, int48));
+  t1 = fold (build (TRUTH_AND_EXPR, integer_type_node, t1, t2));
+  this = fold (build (COND_EXPR, unsigned_type_node, t1, int48, pad));
+
+  /* Find the address for the current argument.  */
+  t1 = fold (build (PLUS_EXPR, unsigned_type_node, base, this));
+  t1 = build1 (NOP_EXPR, ptr_type_node, t1);
+  addr_rtx = expand_expr (t1, NULL_RTX, Pmode, EXPAND_NORMAL);
+
+  /* Increment NUM.  */
+  t1 = build (MODIFY_EXPR, unsigned_type_node, num, next);
+  TREE_SIDE_EFFECTS (t1) = 1;
+  expand_expr (t1, const0_rtx, VOIDmode, EXPAND_NORMAL);
+  
+  return addr_rtx;
+}
+
+/* Calculate the final size of the reg parm stack space for the current
+   function, based on how many bytes would be allocated on the stack.  */
+
+int
+i960_final_reg_parm_stack_space (const_size, var_size)
+     int const_size;
+     tree var_size;
+{
+  if (var_size || const_size > 48)
+    return 48;
+  else
+    return 0;
+}
+
+/* Calculate the size of the reg parm stack space.  This is a bit complicated
+   on the i960.  */
+
+int
+i960_reg_parm_stack_space (fndecl)
+     tree fndecl;
+{
+  /* In this case, we are called from emit_library_call, and we don't need
+     to pretend we have more space for parameters than what's apparent.  */
+  if (fndecl == 0)
+    return 0;
+
+  /* In this case, we are called from locate_and_pad_parms when we're
+     not IN_REGS, so we have an arg block.  */
+  if (fndecl != current_function_decl)
+    return 48;
+
+  /* Otherwise, we have an arg block if the current function has more than
+     48 bytes of parameters.  */
+  if (current_function_args_size != 0 || VARARGS_STDARG_FUNCTION (fndecl))
+    return 48;
+  else
+    return 0;
+}
+
+/* Return the register class of a scratch register needed to copy IN into
+   or out of a register in CLASS in MODE.  If it can be done directly,
+   NO_REGS is returned.  */
+
+enum reg_class
+secondary_reload_class (class, mode, in)
+     enum reg_class class;
+     enum machine_mode mode;
+     rtx in;
+{
+  int regno = -1;
+
+  if (GET_CODE (in) == REG || GET_CODE (in) == SUBREG)
+    regno = true_regnum (in);
+
+  /* We can place anything into LOCAL_OR_GLOBAL_REGS and can put
+     LOCAL_OR_GLOBAL_REGS into anything.  */
+  if (class == LOCAL_OR_GLOBAL_REGS || class == LOCAL_REGS
+      || class == GLOBAL_REGS || (regno >= 0 && regno < 32))
+    return NO_REGS;
+
+  /* We can place any hard register, 0.0, and 1.0 into FP_REGS.  */
+  if (class == FP_REGS
+      && ((regno >= 0 && regno < FIRST_PSEUDO_REGISTER)
+	  || in == CONST0_RTX (mode) || in == CONST1_RTX (mode)))
+    return NO_REGS;
+
+  return LOCAL_OR_GLOBAL_REGS;
+}
+
+/* Look at the opcode P, and set i96_last_insn_type to indicate which
+   function unit it executed on.  */
+
+/* ??? This would make more sense as an attribute.  */
+
+void
+i960_scan_opcode (p)
+     const char *p;
+{
+  switch (*p)
+    {
+    case 'a':
+    case 'd':
+    case 'e':
+    case 'm':
+    case 'n':
+    case 'o':
+    case 'r':
+      /* Ret is not actually of type REG, but it won't matter, because no
+	 insn will ever follow it.  */
+    case 'u':
+    case 'x':
+      i960_last_insn_type = I_TYPE_REG;
+      break;
+
+    case 'b':
+      if (p[1] == 'x' || p[3] == 'x')
+        i960_last_insn_type = I_TYPE_MEM;
+      i960_last_insn_type = I_TYPE_CTRL;
+      break;
+
+    case 'f':
+    case 't':
+      i960_last_insn_type = I_TYPE_CTRL;
+      break;
+
+    case 'c':
+      if (p[1] == 'a')
+	{
+	  if (p[4] == 'x')
+	    i960_last_insn_type = I_TYPE_MEM;
+	  else
+	    i960_last_insn_type = I_TYPE_CTRL;
+	}
+      else if (p[1] == 'm')
+	{
+	  if (p[3] == 'd')
+	    i960_last_insn_type = I_TYPE_REG;
+	  else if (p[4] == 'b' || p[4] == 'j')
+	    i960_last_insn_type = I_TYPE_CTRL;
+	  else
+	    i960_last_insn_type = I_TYPE_REG;
+	}
+      else
+        i960_last_insn_type = I_TYPE_REG;
+      break;
+
+    case 'l':
+      i960_last_insn_type = I_TYPE_MEM;
+      break;
+
+    case 's':
+      if (p[1] == 't')
+        i960_last_insn_type = I_TYPE_MEM;
+      else
+        i960_last_insn_type = I_TYPE_REG;
+      break;
+    }
+}
+
+static void
+i960_output_mi_thunk (file, thunk, delta, vcall_offset, function)
+     FILE *file;
+     tree thunk ATTRIBUTE_UNUSED;
+     HOST_WIDE_INT delta;
+     HOST_WIDE_INT vcall_offset ATTRIBUTE_UNUSED;
+     tree function;
+{
+  int d = delta;
+  if (d < 0 && d > -32)							
+    fprintf (file, "\tsubo %d,g0,g0\n", -d);				
+  else if (d > 0 && d < 32)						
+    fprintf (file, "\taddo %d,g0,g0\n", d);				
+  else									
+    {									
+      fprintf (file, "\tldconst %d,r5\n", d);				
+      fprintf (file, "\taddo r5,g0,g0\n");				
+    }									
+  fprintf (file, "\tbx ");						
+  assemble_name (file, XSTR (XEXP (DECL_RTL (function), 0), 0));	
+  fprintf (file, "\n");							
+}
+
+static bool
+i960_rtx_costs (x, code, outer_code, total)
+     rtx x;
+     int code, outer_code;
+     int *total;
+{
+  switch (code)
+    {
+      /* Constants that can be (non-ldconst) insn operands are cost 0.
+	 Constants that can be non-ldconst operands in rare cases are cost 1.
+         Other constants have higher costs.
+
+         Must check for OUTER_CODE of SET for power2_operand, because
+         reload_cse_move2add calls us with OUTER_CODE of PLUS to decide
+	 when to replace set with add.  */
+
+    case CONST_INT:
+      if ((INTVAL (x) >= 0 && INTVAL (x) < 32)
+	  || (outer_code == SET && power2_operand (x, VOIDmode)))
+	{
+	  *total = 0;
+	  return true;
+	}
+      else if (INTVAL (x) >= -31 && INTVAL (x) < 0)
+	{
+	  *total = 1;
+	  return true;
+	}
+      /* FALLTHRU */
+
+    case CONST:
+    case LABEL_REF:
+    case SYMBOL_REF:
+      *total = (TARGET_C_SERIES ? 6 : 8);
+      return true;
+
+    case CONST_DOUBLE:
+      if (x == CONST0_RTX (DFmode) || x == CONST0_RTX (SFmode)
+	  || x == CONST1_RTX (DFmode) || x == CONST1_RTX (SFmode))
+	*total = 1;
+      else
+	*total = 12;
+      return true;
+
+    default:
+      return false;
+    }
+}
diff --git a/gcc/config/i960/i960.h b/gcc/config/i960/i960.h
new file mode 100644
index 00000000000..67c34e25031
--- /dev/null
+++ b/gcc/config/i960/i960.h
@@ -0,0 +1,1404 @@
+/* Definitions of target machine for GNU compiler, for Intel 80960
+   Copyright (C) 1992, 1993, 1995, 1996, 1998, 1999, 2000, 2001, 2002
+   Free Software Foundation, Inc.
+   Contributed by Steven McGeady, Intel Corp.
+   Additional Work by Glenn Colon-Bonet, Jonathan Shapiro, Andy Wilson
+   Converted to GCC 2.0 by Jim Wilson and Michael Tiemann, Cygnus Support.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Note that some other tm.h files may include this one and then override
+   many of the definitions that relate to assembler syntax.  */
+
+/* Target CPU builtins.  */
+#define TARGET_CPU_CPP_BUILTINS()		\
+  do						\
+    {						\
+	builtin_define_std ("i960");		\
+	builtin_define_std ("I960");		\
+	builtin_define_std ("i80960");		\
+	builtin_define_std ("I80960");		\
+	builtin_assert ("cpu=i960");		\
+	builtin_assert ("machine=i960");	\
+    }						\
+  while (0)
+
+#define MULTILIB_DEFAULTS { "mnumerics" }
+
+/* Name to predefine in the preprocessor for processor variations.
+   -mic* options make characters signed by default.  */
+#define	CPP_SPEC "%{mic*:-D__i960 -fsigned-char\
+			%{mka:-D__i960KA}%{mkb:-D__i960KB}\
+			%{mja:-D__i960JA}%{mjd:-D__i960JD}%{mjf:-D__i960JF}\
+			%{mrp:-D__i960RP}\
+			%{msa:-D__i960SA}%{msb:-D__i960SB}\
+			%{mmc:-D__i960MC}\
+			%{mca:-D__i960CA}%{mcc:-D__i960CC}\
+			%{mcf:-D__i960CF}}\
+	%{msoft-float:-D_SOFT_FLOAT}\
+	%{mka:-D__i960KA__ -D__i960_KA__}\
+	%{mkb:-D__i960KB__ -D__i960_KB__}\
+	%{msa:-D__i960SA__ -D__i960_SA__}\
+	%{msb:-D__i960SB__ -D__i960_SB__}\
+	%{mmc:-D__i960MC__ -D__i960_MC__}\
+	%{mca:-D__i960CA__ -D__i960_CA__}\
+	%{mcc:-D__i960CC__ -D__i960_CC__}\
+	%{mcf:-D__i960CF__ -D__i960_CF__}\
+	%{!mka:%{!mkb:%{!msa:%{!msb:%{!mmc:%{!mca:\
+		%{!mcc:%{!mcf:-D__i960_KB -D__i960KB__ %{mic*:-D__i960KB}}}}}}}}}\
+	%{mlong-double-64:-D__LONG_DOUBLE_64__}"
+
+/* Specs for the compiler, to handle processor variations. 
+   If the user gives an explicit -gstabs or -gcoff option, then do not
+   try to add an implicit one, as this will fail. 
+   -mic* options make characters signed by default.  */
+#define CC1_SPEC \
+	"%{mic*:-fsigned-char}\
+%{!mka:%{!mkb:%{!msa:%{!msb:%{!mmc:%{!mca:%{!mcc:%{!mcf:%{!mja:%{!mjd:%{!mjf:%{!mrp:-mka}}}}}}}}}}}}\
+	 %{!gs*:%{!gc*:%{mbout:%{g*:-gstabs}}\
+		       %{mcoff:%{g*:-gcoff}}\
+		       %{!mbout:%{!mcoff:%{g*:-gstabs}}}}}"
+
+/* Specs for the assembler, to handle processor variations.
+   For compatibility with Intel's gnu960 tool chain, pass -A options to
+   the assembler.  */
+#define ASM_SPEC \
+	"%{mka:-AKA}%{mkb:-AKB}%{msa:-ASA}%{msb:-ASB}\
+	%{mmc:-AMC}%{mca:-ACA}%{mcc:-ACC}%{mcf:-ACF}\
+        %{mja:-AJX}%{mjd:-AJX}%{mjf:-AJX}%{mrp:-AJX}\
+	%{!mka:%{!mkb:%{!msa:%{!msb:%{!mmc:%{!mca:%{!mcc:%{!mcf:%{!mja:%{!mjd:%{!mjf:%{!mrp:-AKB}}}}}}}}}}}}\
+	%{mlink-relax:-linkrelax}"
+
+/* Specs for the linker, to handle processor variations.
+   For compatibility with Intel's gnu960 tool chain, pass -F and -A options
+   to the linker.  */
+#define LINK_SPEC \
+	"%{mka:-AKA}%{mkb:-AKB}%{msa:-ASA}%{msb:-ASB}\
+	%{mmc:-AMC}%{mca:-ACA}%{mcc:-ACC}%{mcf:-ACF}\
+        %{mja:-AJX}%{mjd:-AJX}%{mjf:-AJX}%{mrp:-AJX}\
+	%{mbout:-Fbout}%{mcoff:-Fcoff}\
+	%{mlink-relax:-relax}"
+
+/* Specs for the libraries to link with, to handle processor variations.
+   Compatible with Intel's gnu960 tool chain.  */
+#define LIB_SPEC "%{!nostdlib:-lcg %{p:-lprof}%{pg:-lgprof}\
+	  %{mka:-lfpg}%{msa:-lfpg}%{mca:-lfpg}%{mcf:-lfpg} -lgnu}"
+
+/* Defining the macro shows we can debug even without a frame pointer.
+   Actually, we can debug without FP.  But defining the macro results in
+   that -O means FP elimination.  Addressing through sp requires
+   negative offset and more one word addressing in the most cases
+   (offsets except for 0-4095 require one more word).  Therefore we've
+   not defined the macro.  */
+/*#define CAN_DEBUG_WITHOUT_FP*/
+
+/* Do leaf procedure and tail call optimizations for -O2 and higher.  */
+#define OPTIMIZATION_OPTIONS(LEVEL,SIZE)	\
+{						\
+  if ((LEVEL) >= 2)				\
+    {						\
+      target_flags |= TARGET_FLAG_LEAFPROC;	\
+      target_flags |= TARGET_FLAG_TAILCALL;	\
+    }						\
+}
+
+/* Print subsidiary information on the compiler version in use.  */
+#define TARGET_VERSION fprintf (stderr," (intel 80960)");
+
+/* Generate DBX debugging information.  */
+#define DBX_DEBUGGING_INFO 1
+
+/* Generate SDB style debugging information.  */
+#define SDB_DEBUGGING_INFO 1
+#define EXTENDED_SDB_BASIC_TYPES
+
+/* Generate DBX_DEBUGGING_INFO by default.  */
+#define PREFERRED_DEBUGGING_TYPE DBX_DEBUG
+
+/* Redefine this to print in hex.  No value adjustment is necessary
+   anymore.  */
+#define PUT_SDB_TYPE(A) \
+  fprintf (asm_out_file, "\t.type\t0x%x;", A)
+
+/* Handle pragmas for compatibility with Intel's compilers.  */
+
+extern int i960_maxbitalignment;
+extern int i960_last_maxbitalignment;
+
+#define REGISTER_TARGET_PRAGMAS() do {			\
+  c_register_pragma (0, "align", i960_pr_align);	\
+  c_register_pragma (0, "noalign", i960_pr_noalign);	\
+} while (0)
+
+/* Run-time compilation parameters selecting different hardware subsets.  */
+
+/* 960 architecture with floating-point.  */
+#define TARGET_FLAG_NUMERICS	0x01
+#define TARGET_NUMERICS		(target_flags & TARGET_FLAG_NUMERICS)
+
+/* 960 architecture with memory management.  */
+/* ??? Not used currently.  */
+#define	TARGET_FLAG_PROTECTED	0x02
+#define	TARGET_PROTECTED	(target_flags & TARGET_FLAG_PROTECTED)
+
+/* The following three are mainly used to provide a little sanity checking
+   against the -mARCH flags given. The Jx series, for the purposes of
+   gcc, is a Kx with a data cache.  */
+
+/* Nonzero if we should generate code for the KA and similar processors.
+   No FPU, no microcode instructions.  */
+#define TARGET_FLAG_K_SERIES	0x04
+#define TARGET_K_SERIES		(target_flags & TARGET_FLAG_K_SERIES)
+
+/* Nonzero if we should generate code for the MC processor.
+   Not really different from KB for our purposes.  */
+#define	TARGET_FLAG_MC		0x08
+#define TARGET_MC 		(target_flags & TARGET_FLAG_MC)
+
+/* Nonzero if we should generate code for the CA processor.
+   Enables different optimization strategies.  */
+#define	TARGET_FLAG_C_SERIES	0x10
+#define	TARGET_C_SERIES 	(target_flags & TARGET_FLAG_C_SERIES)
+
+/* Nonzero if we should generate leaf-procedures when we find them.
+   You may not want to do this because leaf-proc entries are
+   slower when not entered via BAL - this would be true when
+   a linker not supporting the optimization is used.  */
+#define	TARGET_FLAG_LEAFPROC	0x20
+#define	TARGET_LEAFPROC		(target_flags & TARGET_FLAG_LEAFPROC)
+
+/* Nonzero if we should perform tail-call optimizations when we find them.
+   You may not want to do this because the detection of cases where
+   this is not valid is not totally complete.  */
+#define	TARGET_FLAG_TAILCALL	0x40
+#define	TARGET_TAILCALL		(target_flags & TARGET_FLAG_TAILCALL)
+
+/* Nonzero if use of a complex addressing mode is a win on this implementation.
+   Complex addressing modes are probably not worthwhile on the K-series,
+   but they definitely are on the C-series.  */
+#define	TARGET_FLAG_COMPLEX_ADDR 0x80
+#define	TARGET_COMPLEX_ADDR	(target_flags & TARGET_FLAG_COMPLEX_ADDR)
+
+/* Align code to 8 byte boundaries for faster fetching.  */
+#define	TARGET_FLAG_CODE_ALIGN	0x100
+#define	TARGET_CODE_ALIGN	(target_flags  & TARGET_FLAG_CODE_ALIGN)
+
+/* Append branch prediction suffixes to branch opcodes.  */
+/* ??? Not used currently.  */
+#define	TARGET_FLAG_BRANCH_PREDICT 0x200
+#define	TARGET_BRANCH_PREDICT	(target_flags  & TARGET_FLAG_BRANCH_PREDICT)
+
+/* Forces prototype and return promotions.  */
+/* ??? This does not work.  */
+#define	TARGET_FLAG_CLEAN_LINKAGE 0x400
+#define	TARGET_CLEAN_LINKAGE	(target_flags & TARGET_FLAG_CLEAN_LINKAGE)
+
+/* For compatibility with iC960 v3.0.  */
+#define	TARGET_FLAG_IC_COMPAT3_0 0x800 
+#define	TARGET_IC_COMPAT3_0	(target_flags & TARGET_FLAG_IC_COMPAT3_0)
+
+/* For compatibility with iC960 v2.0.  */
+#define	TARGET_FLAG_IC_COMPAT2_0 0x1000
+#define	TARGET_IC_COMPAT2_0	(target_flags & TARGET_FLAG_IC_COMPAT2_0)
+
+/* If no unaligned accesses are to be permitted.  */
+#define	TARGET_FLAG_STRICT_ALIGN 0x2000
+#define	TARGET_STRICT_ALIGN	(target_flags & TARGET_FLAG_STRICT_ALIGN)
+
+/* For compatibility with iC960 assembler.  */
+#define	TARGET_FLAG_ASM_COMPAT	0x4000
+#define	TARGET_ASM_COMPAT	(target_flags & TARGET_FLAG_ASM_COMPAT)
+
+/* For compatibility with the gcc960 v1.2 compiler.  Use the old structure
+   alignment rules.  Also, turns on STRICT_ALIGNMENT.  */
+#define TARGET_FLAG_OLD_ALIGN	0x8000
+#define TARGET_OLD_ALIGN	(target_flags & TARGET_FLAG_OLD_ALIGN)
+
+/* Nonzero if long doubles are to be 64 bits.  Useful for soft-float targets
+   if 80 bit long double support is missing.  */
+#define TARGET_FLAG_LONG_DOUBLE_64	0x10000
+#define TARGET_LONG_DOUBLE_64	(target_flags & TARGET_FLAG_LONG_DOUBLE_64)
+
+extern int target_flags;
+
+/* Macro to define tables used to set the flags.
+   This is a list in braces of pairs in braces,
+   each pair being { "NAME", VALUE }
+   where VALUE is the bits to set or minus the bits to clear.
+   An empty string NAME is used to identify the default VALUE.  */
+
+/* ??? Not all ten of these architecture variations actually exist, but I
+   am not sure which are real and which aren't.  */
+
+#define TARGET_SWITCHES  \
+  { {"sa", (TARGET_FLAG_K_SERIES|TARGET_FLAG_COMPLEX_ADDR),		\
+       N_("Generate SA code")},						\
+    {"sb", (TARGET_FLAG_NUMERICS|TARGET_FLAG_K_SERIES|			\
+			TARGET_FLAG_COMPLEX_ADDR),			\
+       N_("Generate SB code")},						\
+/*  {"sc", (TARGET_FLAG_NUMERICS|TARGET_FLAG_PROTECTED|			\
+			TARGET_FLAG_MC|TARGET_FLAG_COMPLEX_ADDR),	\
+       N_("Generate SC code")}, */					\
+    {"ka", (TARGET_FLAG_K_SERIES|TARGET_FLAG_COMPLEX_ADDR),		\
+       N_("Generate KA code")},						\
+    {"kb", (TARGET_FLAG_NUMERICS|TARGET_FLAG_K_SERIES|			\
+			TARGET_FLAG_COMPLEX_ADDR),			\
+       N_("Generate KB code")},						\
+/*  {"kc", (TARGET_FLAG_NUMERICS|TARGET_FLAG_PROTECTED|			\
+			TARGET_FLAG_MC|TARGET_FLAG_COMPLEX_ADDR),	\
+       N_("Generate KC code")}, */					\
+    {"ja", (TARGET_FLAG_K_SERIES|TARGET_FLAG_COMPLEX_ADDR),		\
+       N_("Generate JA code")},						\
+    {"jd", (TARGET_FLAG_K_SERIES|TARGET_FLAG_COMPLEX_ADDR),		\
+       N_("Generate JD code")},						\
+    {"jf", (TARGET_FLAG_NUMERICS|TARGET_FLAG_K_SERIES|			\
+			TARGET_FLAG_COMPLEX_ADDR),			\
+       N_("Generate JF code")},						\
+    {"rp", (TARGET_FLAG_K_SERIES|TARGET_FLAG_COMPLEX_ADDR),		\
+       N_("generate RP code")},						\
+    {"mc", (TARGET_FLAG_NUMERICS|TARGET_FLAG_PROTECTED|			\
+			TARGET_FLAG_MC|TARGET_FLAG_COMPLEX_ADDR),	\
+       N_("Generate MC code")},						\
+    {"ca", (TARGET_FLAG_C_SERIES|TARGET_FLAG_BRANCH_PREDICT|		\
+			TARGET_FLAG_CODE_ALIGN|TARGET_FLAG_COMPLEX_ADDR),\
+       N_("Generate CA code")},						\
+/*  {"cb", (TARGET_FLAG_NUMERICS|TARGET_FLAG_C_SERIES|			\
+			TARGET_FLAG_BRANCH_PREDICT|TARGET_FLAG_CODE_ALIGN),\
+       N_("Generate CB code")},						\
+    {"cc", (TARGET_FLAG_NUMERICS|TARGET_FLAG_PROTECTED|			\
+			TARGET_FLAG_C_SERIES|TARGET_FLAG_BRANCH_PREDICT|\
+			TARGET_FLAG_CODE_ALIGN),			\
+       N_("Generate CC code")}, */					\
+    {"cf", (TARGET_FLAG_C_SERIES|TARGET_FLAG_BRANCH_PREDICT|		\
+			TARGET_FLAG_CODE_ALIGN|TARGET_FLAG_COMPLEX_ADDR),\
+       N_("Generate CF code")},						\
+    {"numerics", (TARGET_FLAG_NUMERICS),				\
+       N_("Use hardware floating point instructions")},			\
+    {"soft-float", -(TARGET_FLAG_NUMERICS),				\
+       N_("Use software floating point")},				\
+    {"leaf-procedures", TARGET_FLAG_LEAFPROC,				\
+       N_("Use alternate leaf function entries")},			\
+    {"no-leaf-procedures", -(TARGET_FLAG_LEAFPROC),			\
+       N_("Do not use alternate leaf function entries")},		\
+    {"tail-call", TARGET_FLAG_TAILCALL,					\
+       N_("Perform tail call optimization")},				\
+    {"no-tail-call", -(TARGET_FLAG_TAILCALL),				\
+       N_("Do not perform tail call optimization")},			\
+    {"complex-addr", TARGET_FLAG_COMPLEX_ADDR, 				\
+       N_("Use complex addressing modes")},				\
+    {"no-complex-addr", -(TARGET_FLAG_COMPLEX_ADDR),			\
+       N_("Do not use complex addressing modes")},			\
+    {"code-align", TARGET_FLAG_CODE_ALIGN,				\
+       N_("Align code to 8 byte boundary")},				\
+    {"no-code-align", -(TARGET_FLAG_CODE_ALIGN),			\
+       N_("Do not align code to 8 byte boundary")},			\
+/*  {"clean-linkage", (TARGET_FLAG_CLEAN_LINKAGE),			\
+       N_("Force use of prototypes")},					\
+    {"no-clean-linkage", -(TARGET_FLAG_CLEAN_LINKAGE),			\
+       N_("Do not force use of prototypes")}, */			\
+    {"ic-compat", TARGET_FLAG_IC_COMPAT2_0,				\
+       N_("Enable compatibility with iC960 v2.0")},			\
+    {"ic2.0-compat", TARGET_FLAG_IC_COMPAT2_0,				\
+       N_("Enable compatibility with iC960 v2.0")},			\
+    {"ic3.0-compat", TARGET_FLAG_IC_COMPAT3_0,				\
+       N_("Enable compatibility with iC960 v3.0")},			\
+    {"asm-compat", TARGET_FLAG_ASM_COMPAT,				\
+       N_("Enable compatibility with ic960 assembler")},		\
+    {"intel-asm", TARGET_FLAG_ASM_COMPAT,				\
+       N_("Enable compatibility with ic960 assembler")},		\
+    {"strict-align", TARGET_FLAG_STRICT_ALIGN,				\
+       N_("Do not permit unaligned accesses")},				\
+    {"no-strict-align", -(TARGET_FLAG_STRICT_ALIGN),			\
+       N_("Permit unaligned accesses")},				\
+    {"old-align", (TARGET_FLAG_OLD_ALIGN|TARGET_FLAG_STRICT_ALIGN),	\
+       N_("Layout types like Intel's v1.3 gcc")},			\
+    {"no-old-align", -(TARGET_FLAG_OLD_ALIGN|TARGET_FLAG_STRICT_ALIGN),	\
+       N_("Do not layout types like Intel's v1.3 gcc")},		\
+    {"long-double-64", TARGET_FLAG_LONG_DOUBLE_64,			\
+       N_("Use 64 bit long doubles")},					\
+    {"link-relax", 0,							\
+       N_("Enable linker relaxation")},					\
+    {"no-link-relax", 0,						\
+       N_("Do not enable linker relaxation")},				\
+    SUBTARGET_SWITCHES                                                  \
+    { "", TARGET_DEFAULT,						\
+	NULL}}
+
+/* This are meant to be redefined in the host dependent files */
+#define SUBTARGET_SWITCHES
+
+/* Override conflicting target switch options.
+   Doesn't actually detect if more than one -mARCH option is given, but
+   does handle the case of two blatantly conflicting -mARCH options.  */
+#define OVERRIDE_OPTIONS  i960_initialize ()
+
+/* Don't enable anything by default.  The user is expected to supply a -mARCH
+   option.  If none is given, then -mka is added by CC1_SPEC.  */
+#define TARGET_DEFAULT 0
+
+/* Target machine storage layout.  */
+
+/* Define this if most significant bit is lowest numbered
+   in instructions that operate on numbered bit-fields.  */
+#define BITS_BIG_ENDIAN 0
+
+/* Define this if most significant byte of a word is the lowest numbered.
+   The i960 case be either big endian or little endian.  We only support
+   little endian, which is the most common.  */
+#define BYTES_BIG_ENDIAN 0
+
+/* Define this if most significant word of a multiword number is lowest
+   numbered.  */
+#define WORDS_BIG_ENDIAN 0
+
+/* Bitfields cannot cross word boundaries.  */
+#define BITFIELD_NBYTES_LIMITED 1
+
+/* Width of a word, in units (bytes).  */
+#define UNITS_PER_WORD 4
+
+/* Width in bits of a long double.  */
+#define	LONG_DOUBLE_TYPE_SIZE (TARGET_LONG_DOUBLE_64 ? 64 : 128)
+#define MAX_LONG_DOUBLE_TYPE_SIZE 128
+
+/* Define this to set long double type size to use in libgcc2.c, which can
+   not depend on target_flags.  */
+#if defined(__LONG_DOUBLE_64__)
+#define LIBGCC2_LONG_DOUBLE_TYPE_SIZE 64
+#else
+#define LIBGCC2_LONG_DOUBLE_TYPE_SIZE 128
+#endif
+
+/* Allocation boundary (in *bits*) for storing pointers in memory.  */
+#define POINTER_BOUNDARY 32
+
+/* Allocation boundary (in *bits*) for storing arguments in argument list.  */
+#define PARM_BOUNDARY 32
+
+/* Boundary (in *bits*) on which stack pointer should be aligned.  */
+#define STACK_BOUNDARY 128
+
+/* Allocation boundary (in *bits*) for the code of a function.  */
+#define FUNCTION_BOUNDARY 128
+
+/* Alignment of field after `int : 0' in a structure.  */
+#define EMPTY_FIELD_BOUNDARY 32
+
+/* This makes zero-length anonymous fields lay the next field
+   at a word boundary.  It also makes the whole struct have
+   at least word alignment if there are any bitfields at all.  */
+#define PCC_BITFIELD_TYPE_MATTERS 1
+
+/* Every structure's size must be a multiple of this.  */
+#define STRUCTURE_SIZE_BOUNDARY 8
+
+/* No data type wants to be aligned rounder than this.
+   Extended precision floats gets 4-word alignment.  */
+#define BIGGEST_ALIGNMENT 128
+
+/* Define this if move instructions will actually fail to work
+   when given unaligned data.
+   80960 will work even with unaligned data, but it is slow.  */
+#define STRICT_ALIGNMENT TARGET_STRICT_ALIGN
+
+/* Specify alignment for string literals (which might be higher than the
+   base type's minimal alignment requirement.  This allows strings to be
+   aligned on word boundaries, and optimizes calls to the str* and mem*
+   library functions.  */
+#define CONSTANT_ALIGNMENT(EXP, ALIGN) \
+  (TREE_CODE (EXP) == STRING_CST	\
+   && i960_object_bytes_bitalign (int_size_in_bytes (TREE_TYPE (EXP))) > (int)(ALIGN) \
+   ? i960_object_bytes_bitalign (int_size_in_bytes (TREE_TYPE (EXP)))	    \
+   : (int)(ALIGN))
+
+/* Macros to determine size of aggregates (structures and unions
+   in C).  Normally, these may be defined to simply return the maximum
+   alignment and simple rounded-up size, but on some machines (like
+   the i960), the total size of a structure is based on a non-trivial
+   rounding method.  */
+
+#define ROUND_TYPE_ALIGN(TYPE, COMPUTED, SPECIFIED) \
+  i960_round_align (MAX ((COMPUTED), (SPECIFIED)), TYPE)
+
+/* Standard register usage.  */
+
+/* Number of actual hardware registers.
+   The hardware registers are assigned numbers for the compiler
+   from 0 to just below FIRST_PSEUDO_REGISTER.
+   All registers that the compiler knows about must be given numbers,
+   even those that are not normally considered general registers.
+
+   Registers 0-15 are the global registers (g0-g15).
+   Registers 16-31 are the local registers (r0-r15).
+   Register 32-35 are the fp registers (fp0-fp3).
+   Register 36 is the condition code register.
+   Register 37 is unused.  */
+
+#define FIRST_PSEUDO_REGISTER 38
+
+/* 1 for registers that have pervasive standard uses and are not available
+   for the register allocator.  On 80960, this includes the frame pointer
+   (g15), the previous FP (r0), the stack pointer (r1), the return
+   instruction pointer (r2), and the argument pointer (g14).  */
+#define FIXED_REGISTERS  \
+ {0, 0, 0, 0, 0, 0, 0, 0,	\
+  0, 0, 0, 0, 0, 0, 1, 1,	\
+  1, 1, 1, 0, 0, 0, 0, 0,	\
+  0, 0, 0, 0, 0, 0, 0, 0,	\
+  0, 0, 0, 0, 1, 1}
+
+/* 1 for registers not available across function calls.
+   These must include the FIXED_REGISTERS and also any
+   registers that can be used without being saved.
+   The latter must include the registers where values are returned
+   and the register where structure-value addresses are passed.
+   Aside from that, you can include as many other registers as you like.  */
+
+/* On the 80960, note that:
+	g0..g3 are used for return values,
+	g0..g7 may always be used for parameters,
+	g8..g11 may be used for parameters, but are preserved if they aren't,
+	g12 is the static chain if needed, otherwise is preserved
+	g13 is the struct return ptr if used, or temp, but may be trashed,
+	g14 is the leaf return ptr or the arg block ptr otherwise zero,
+		must be reset to zero before returning if it was used,
+	g15 is the frame pointer,
+	r0 is the previous FP,
+	r1 is the stack pointer,
+	r2 is the return instruction pointer,
+	r3-r15 are always available,
+	r3 is clobbered by calls in functions that use the arg pointer
+	r4-r11 may be clobbered by the mcount call when profiling
+	r4-r15 if otherwise unused may be used for preserving global registers
+	fp0..fp3 are never available.  */
+#define CALL_USED_REGISTERS  \
+ {1, 1, 1, 1, 1, 1, 1, 1,	\
+  0, 0, 0, 0, 0, 1, 1, 1,	\
+  1, 1, 1, 0, 0, 0, 0, 0,	\
+  0, 0, 0, 0, 0, 0, 0, 0,	\
+  1, 1, 1, 1, 1, 1}
+
+/* If no fp unit, make all of the fp registers fixed so that they can't
+   be used.  */
+#define	CONDITIONAL_REGISTER_USAGE	\
+  if (! TARGET_NUMERICS) {						\
+     fixed_regs[32] = fixed_regs[33] = fixed_regs[34] = fixed_regs[35] = 1;\
+  }									\
+
+/* Return number of consecutive hard regs needed starting at reg REGNO
+   to hold something of mode MODE.
+   This is ordinarily the length in words of a value of mode MODE
+   but can be less for certain modes in special long registers.
+
+   On 80960, ordinary registers hold 32 bits worth, but can be ganged
+   together to hold double or extended precision floating point numbers,
+   and the floating point registers hold any size floating point number */
+#define HARD_REGNO_NREGS(REGNO, MODE)   \
+  ((REGNO) < 32							\
+   ? (((MODE) == VOIDmode)					\
+      ? 1 : ((GET_MODE_SIZE (MODE) + UNITS_PER_WORD - 1) / UNITS_PER_WORD)) \
+   : ((REGNO) < FIRST_PSEUDO_REGISTER) ? 1 : 0)
+
+/* Value is 1 if hard register REGNO can hold a value of machine-mode MODE.
+   On 80960, the cpu registers can hold any mode but the float registers
+   can only hold SFmode, DFmode, or TFmode.  */
+#define HARD_REGNO_MODE_OK(REGNO, MODE) hard_regno_mode_ok ((REGNO), (MODE))
+
+/* Value is 1 if it is a good idea to tie two pseudo registers
+   when one has mode MODE1 and one has mode MODE2.
+   If HARD_REGNO_MODE_OK could produce different values for MODE1 and MODE2,
+   for any hard reg, then this must be 0 for correct output.  */
+
+#define MODES_TIEABLE_P(MODE1, MODE2) \
+  ((MODE1) == (MODE2) || GET_MODE_CLASS (MODE1) == GET_MODE_CLASS (MODE2))
+
+/* Specify the registers used for certain standard purposes.
+   The values of these macros are register numbers.  */
+
+/* 80960 pc isn't overloaded on a register that the compiler knows about.  */
+/* #define PC_REGNUM  */
+
+/* Register to use for pushing function arguments.  */
+#define STACK_POINTER_REGNUM 17
+
+/* Actual top-of-stack address is same as
+   the contents of the stack pointer register.  */
+#define STACK_POINTER_OFFSET (-current_function_outgoing_args_size)
+
+/* Base register for access to local variables of the function.  */
+#define FRAME_POINTER_REGNUM 15
+
+/* Value should be nonzero if functions must have frame pointers.
+   Zero means the frame pointer need not be set up (and parms
+   may be accessed via the stack pointer) in functions that seem suitable.
+   This is computed in `reload', in reload1.c.  */
+/* ??? It isn't clear to me why this is here.  Perhaps because of a bug (since
+   fixed) in the definition of INITIAL_FRAME_POINTER_OFFSET which would have
+   caused this to fail.  */
+/* ??? Must check current_function_has_nonlocal_goto, otherwise frame pointer
+  elimination messes up nonlocal goto sequences.  I think this works for other
+  targets because they use indirect jumps for the return which disables fp
+  elimination.  */
+#define FRAME_POINTER_REQUIRED \
+  (! leaf_function_p () || current_function_has_nonlocal_goto)
+
+/* Definitions for register eliminations.
+
+   This is an array of structures.  Each structure initializes one pair
+   of eliminable registers.  The "from" register number is given first,
+   followed by "to".  Eliminations of the same "from" register are listed
+   in order of preference..  */
+
+#define ELIMINABLE_REGS	 {{FRAME_POINTER_REGNUM, STACK_POINTER_REGNUM}}
+
+/* Given FROM and TO register numbers, say whether this elimination is allowed.
+   Frame pointer elimination is automatically handled.  */
+#define CAN_ELIMINATE(FROM, TO) 1
+
+/* Define the offset between two registers, one to be eliminated, and
+   the other its replacement, at the start of a routine.
+
+   Since the stack grows upward on the i960, this must be a negative number.
+   This includes the 64 byte hardware register save area and the size of
+   the frame.  */
+
+#define INITIAL_ELIMINATION_OFFSET(FROM, TO, OFFSET)			\
+  do { (OFFSET) = - (64 + compute_frame_size (get_frame_size ())); } while (0)
+
+/* Base register for access to arguments of the function.  */
+#define ARG_POINTER_REGNUM 14
+
+/* Register in which static-chain is passed to a function.
+   On i960, we use g12.  We can't use any local register, because we need
+   a register that can be set before a call or before a jump.  */
+#define STATIC_CHAIN_REGNUM 12
+ 
+/* Functions which return large structures get the address
+   to place the wanted value at in g13.  */
+
+#define STRUCT_VALUE_REGNUM 13 
+
+/* The order in which to allocate registers.  */
+
+#define	REG_ALLOC_ORDER	\
+{  4, 5, 6, 7, 0, 1, 2, 3, 13,	 /* g4, g5, g6, g7, g0, g1, g2, g3, g13  */ \
+  20, 21, 22, 23, 24, 25, 26, 27,/* r4, r5, r6, r7, r8, r9, r10, r11  */    \
+  28, 29, 30, 31, 19, 8, 9, 10,	 /* r12, r13, r14, r15, r3, g8, g9, g10  */ \
+  11, 12,			 /* g11, g12  */			    \
+  32, 33, 34, 35,		 /* fp0, fp1, fp2, fp3  */		    \
+  /* We can't actually allocate these.  */				    \
+  16, 17, 18, 14, 15, 36, 37}	 /* r0, r1, r2, g14, g15, cc  */
+
+/* Define the classes of registers for register constraints in the
+   machine description.  Also define ranges of constants.
+
+   One of the classes must always be named ALL_REGS and include all hard regs.
+   If there is more than one class, another class must be named NO_REGS
+   and contain no registers.
+
+   The name GENERAL_REGS must be the name of a class (or an alias for
+   another name such as ALL_REGS).  This is the class of registers
+   that is allowed by "g" or "r" in a register constraint.
+   Also, registers outside this class are allocated only when
+   instructions express preferences for them.
+
+   The classes must be numbered in nondecreasing order; that is,
+   a larger-numbered class must never be contained completely
+   in a smaller-numbered class.
+
+   For any two classes, it is very desirable that there be another
+   class that represents their union.  */
+   
+/* The 80960 has four kinds of registers, global, local, floating point,
+   and condition code.  The cc register is never allocated, so no class
+   needs to be defined for it.  */
+
+enum reg_class { NO_REGS, GLOBAL_REGS, LOCAL_REGS, LOCAL_OR_GLOBAL_REGS,
+  FP_REGS, ALL_REGS, LIM_REG_CLASSES };
+
+/* 'r' includes floating point registers if TARGET_NUMERICS.  'd' never
+   does.  */
+#define	GENERAL_REGS	((TARGET_NUMERICS) ? ALL_REGS : LOCAL_OR_GLOBAL_REGS)
+
+#define N_REG_CLASSES (int) LIM_REG_CLASSES
+
+/* Give names of register classes as strings for dump file.  */
+
+#define REG_CLASS_NAMES							\
+{ "NO_REGS", "GLOBAL_REGS", "LOCAL_REGS", "LOCAL_OR_GLOBAL_REGS",	\
+  "FP_REGS", "ALL_REGS" }
+
+/* Define which registers fit in which classes.
+   This is an initializer for a vector of HARD_REG_SET
+   of length N_REG_CLASSES.  */
+
+#define REG_CLASS_CONTENTS	\
+{ {0, 0}, {0x0ffff, 0}, {0xffff0000, 0}, {-1,0}, {0, -1}, {-1,-1}}
+
+/* The same information, inverted:
+   Return the class number of the smallest class containing
+   reg number REGNO.  This could be a conditional expression
+   or could index an array.  */
+
+#define REGNO_REG_CLASS(REGNO)	\
+  ((REGNO) < 16 ? GLOBAL_REGS	\
+   : (REGNO) < 32 ? LOCAL_REGS	\
+   : (REGNO) < 36 ? FP_REGS	\
+   : NO_REGS)
+
+/* The class value for index registers, and the one for base regs.
+   There is currently no difference between base and index registers on the
+   i960, but this distinction may one day be useful.  */
+#define INDEX_REG_CLASS LOCAL_OR_GLOBAL_REGS
+#define BASE_REG_CLASS LOCAL_OR_GLOBAL_REGS
+
+/* Get reg_class from a letter such as appears in the machine description.
+   'f' is a floating point register (fp0..fp3)
+   'l' is a local register (r0-r15)
+   'b' is a global register (g0-g15)
+   'd' is any local or global register
+   'r' or 'g' are pre-defined to the class GENERAL_REGS.  */
+/* 'l' and 'b' are probably never used.  Note that 'd' and 'r' are *not*
+   the same thing, since 'r' may include the fp registers.  */
+#define REG_CLASS_FROM_LETTER(C) \
+  (((C) == 'f') && (TARGET_NUMERICS) ? FP_REGS : ((C) == 'l' ? LOCAL_REGS : \
+    (C) == 'b' ? GLOBAL_REGS : ((C) == 'd' ? LOCAL_OR_GLOBAL_REGS : NO_REGS)))
+
+/* The letters I, J, K, L and M in a register constraint string
+   can be used to stand for particular ranges of immediate operands.
+   This macro defines what the ranges are.
+   C is the letter, and VALUE is a constant value.
+   Return 1 if VALUE is in the range specified by C.
+
+   For 80960:
+	'I' is used for literal values 0..31
+   	'J' means literal 0
+	'K' means 0..-31.  */
+
+#define CONST_OK_FOR_LETTER_P(VALUE, C)  				\
+  ((C) == 'I' ? (((unsigned) (VALUE)) <= 31)				\
+   : (C) == 'J' ? ((VALUE) == 0)					\
+   : (C) == 'K' ? ((VALUE) >= -31 && (VALUE) <= 0)			\
+   : (C) == 'M' ? ((VALUE) >= -32 && (VALUE) <= 0)			\
+   : 0)
+
+/* Similar, but for floating constants, and defining letters G and H.
+   Here VALUE is the CONST_DOUBLE rtx itself.
+   For the 80960, G is 0.0 and H is 1.0.  */
+
+#define CONST_DOUBLE_OK_FOR_LETTER_P(VALUE, C)				\
+  ((TARGET_NUMERICS) &&							\
+   (((C) == 'G' && (VALUE) == CONST0_RTX (GET_MODE (VALUE)))		\
+    || ((C) == 'H' && ((VALUE) == CONST1_RTX (GET_MODE (VALUE))))))
+
+/* Given an rtx X being reloaded into a reg required to be
+   in class CLASS, return the class of reg to actually use.
+   In general this is just CLASS; but on some machines
+   in some cases it is preferable to use a more restrictive class.  */
+
+/* On 960, can't load constant into floating-point reg except
+   0.0 or 1.0.
+
+   Any hard reg is ok as a src operand of a reload insn.  */
+
+#define PREFERRED_RELOAD_CLASS(X,CLASS)			\
+  (GET_CODE (X) == REG && REGNO (X) < FIRST_PSEUDO_REGISTER	\
+   ? (CLASS)							\
+   : ((CLASS) == FP_REGS && CONSTANT_P (X)			\
+      && (X) != CONST0_RTX (DFmode) && (X) != CONST1_RTX (DFmode)\
+      && (X) != CONST0_RTX (SFmode) && (X) != CONST1_RTX (SFmode)\
+      ? NO_REGS							\
+      : (CLASS) == ALL_REGS ? LOCAL_OR_GLOBAL_REGS : (CLASS)))
+
+#define SECONDARY_RELOAD_CLASS(CLASS,MODE,IN) \
+  secondary_reload_class (CLASS, MODE, IN)
+
+/* Return the maximum number of consecutive registers
+   needed to represent mode MODE in a register of class CLASS.  */
+/* On 80960, this is the size of MODE in words,
+   except in the FP regs, where a single reg is always enough.  */
+#define CLASS_MAX_NREGS(CLASS, MODE)					\
+  ((CLASS) == FP_REGS ? 1 : HARD_REGNO_NREGS (0, (MODE)))
+
+/* Stack layout; function entry, exit and calling.  */
+
+/* Define this if pushing a word on the stack
+   makes the stack pointer a smaller address.  */
+/* #define STACK_GROWS_DOWNWARD */
+
+/* Define this if the nominal address of the stack frame
+   is at the high-address end of the local variables;
+   that is, each additional local variable allocated
+   goes at a more negative offset in the frame.  */
+/* #define FRAME_GROWS_DOWNWARD */
+
+/* Offset within stack frame to start allocating local variables at.
+   If FRAME_GROWS_DOWNWARD, this is the offset to the END of the
+   first local allocated.  Otherwise, it is the offset to the BEGINNING
+   of the first local allocated.
+
+   The i960 has a 64 byte register save area, plus possibly some extra
+   bytes allocated for varargs functions.  */
+#define STARTING_FRAME_OFFSET 64
+
+/* If we generate an insn to push BYTES bytes,
+   this says how many the stack pointer really advances by.
+   On 80960, don't define this because there are no push insns.  */
+/* #define PUSH_ROUNDING(BYTES) BYTES */
+
+/* Offset of first parameter from the argument pointer register value.  */
+#define FIRST_PARM_OFFSET(FNDECL) 0
+
+/* When a parameter is passed in a register, no stack space is
+   allocated for it.  However, when args are passed in the
+   stack, space is allocated for every register parameter.  */
+#define MAYBE_REG_PARM_STACK_SPACE 48
+#define FINAL_REG_PARM_STACK_SPACE(CONST_SIZE, VAR_SIZE)	\
+  i960_final_reg_parm_stack_space (CONST_SIZE, VAR_SIZE);
+#define REG_PARM_STACK_SPACE(DECL) i960_reg_parm_stack_space (DECL)
+#define OUTGOING_REG_PARM_STACK_SPACE
+
+/* Keep the stack pointer constant throughout the function.  */
+#define ACCUMULATE_OUTGOING_ARGS 1
+
+/* Value is 1 if returning from a function call automatically
+   pops the arguments described by the number-of-args field in the call.
+   FUNDECL is the declaration node of the function (as a tree),
+   FUNTYPE is the data type of the function (as a tree),
+   or for a library call it is an identifier node for the subroutine name.  */
+
+#define RETURN_POPS_ARGS(FUNDECL,FUNTYPE,SIZE) 0
+
+/* Define how to find the value returned by a library function
+   assuming the value has mode MODE.  */
+
+#define LIBCALL_VALUE(MODE) gen_rtx_REG ((MODE), 0)
+
+/* 1 if N is a possible register number for a function value
+   as seen by the caller.
+   On 80960, returns are in g0..g3 */
+
+#define FUNCTION_VALUE_REGNO_P(N) ((N) == 0)
+
+/* 1 if N is a possible register number for function argument passing.
+   On 80960, parameters are passed in g0..g11 */
+
+#define FUNCTION_ARG_REGNO_P(N) ((N) < 12)
+
+/* Perform any needed actions needed for a function that is receiving a
+   variable number of arguments. 
+
+   CUM is as above.
+
+   MODE and TYPE are the mode and type of the current parameter.
+
+   PRETEND_SIZE is a variable that should be set to the amount of stack
+   that must be pushed by the prolog to pretend that our caller pushed
+   it.
+
+   Normally, this macro will push all remaining incoming registers on the
+   stack and set PRETEND_SIZE to the length of the registers pushed.  */
+
+#define SETUP_INCOMING_VARARGS(CUM,MODE,TYPE,PRETEND_SIZE,NO_RTL) \
+  i960_setup_incoming_varargs(&CUM,MODE,TYPE,&PRETEND_SIZE,NO_RTL)
+
+/* Implement `va_start' for varargs and stdarg.  */
+#define EXPAND_BUILTIN_VA_START(valist, nextarg) \
+  i960_va_start (valist, nextarg)
+
+/* Implement `va_arg'.  */
+#define EXPAND_BUILTIN_VA_ARG(valist, type) \
+  i960_va_arg (valist, type)
+
+/* Define a data type for recording info about an argument list
+   during the scan of that argument list.  This data type should
+   hold all necessary information about the function itself
+   and about the args processed so far, enough to enable macros
+   such as FUNCTION_ARG to determine where the next arg should go.
+
+   On 80960, this is two integers, which count the number of register
+   parameters and the number of stack parameters seen so far.  */
+
+struct cum_args { int ca_nregparms; int ca_nstackparms; };
+
+#define CUMULATIVE_ARGS struct cum_args
+
+/* Define the number of registers that can hold parameters.
+   This macro is used only in macro definitions below and/or i960.c.  */
+#define NPARM_REGS 12
+
+/* Define how to round to the next parameter boundary.
+   This macro is used only in macro definitions below and/or i960.c.  */
+#define ROUND_PARM(X, MULTIPLE_OF)	\
+  ((((X) + (MULTIPLE_OF) - 1) / (MULTIPLE_OF)) * MULTIPLE_OF)
+
+/* Initialize a variable CUM of type CUMULATIVE_ARGS
+   for a call to a function whose data type is FNTYPE.
+   For a library call, FNTYPE is 0.
+
+   On 80960, the offset always starts at 0; the first parm reg is g0.  */
+
+#define INIT_CUMULATIVE_ARGS(CUM, FNTYPE, LIBNAME, INDIRECT, N_NAMED_ARGS) \
+  ((CUM).ca_nregparms = 0, (CUM).ca_nstackparms = 0)
+
+/* Update the data in CUM to advance over an argument
+   of mode MODE and data type TYPE.
+   CUM should be advanced to align with the data type accessed and
+   also the size of that data type in # of regs.
+   (TYPE is null for libcalls where that information may not be available.)  */
+
+#define FUNCTION_ARG_ADVANCE(CUM, MODE, TYPE, NAMED)	\
+  i960_function_arg_advance(&CUM, MODE, TYPE, NAMED)
+
+/* Indicate the alignment boundary for an argument of the specified mode and
+   type.  */
+#define FUNCTION_ARG_BOUNDARY(MODE, TYPE)				\
+  (((TYPE) != 0)							\
+   ? ((TYPE_ALIGN (TYPE) <= PARM_BOUNDARY)				\
+      ? PARM_BOUNDARY							\
+      : TYPE_ALIGN (TYPE))						\
+   : ((GET_MODE_ALIGNMENT (MODE) <= PARM_BOUNDARY)			\
+      ? PARM_BOUNDARY							\
+      : GET_MODE_ALIGNMENT (MODE)))
+
+/* Determine where to put an argument to a function.
+   Value is zero to push the argument on the stack,
+   or a hard register in which to store the argument.
+
+   MODE is the argument's machine mode.
+   TYPE is the data type of the argument (as a tree).
+    This is null for libcalls where that information may
+    not be available.
+   CUM is a variable of type CUMULATIVE_ARGS which gives info about
+    the preceding args and about the function being called.
+   NAMED is nonzero if this argument is a named parameter
+    (otherwise it is an extra parameter matching an ellipsis).  */
+
+#define FUNCTION_ARG(CUM, MODE, TYPE, NAMED)	\
+  i960_function_arg(&CUM, MODE, TYPE, NAMED)
+
+/* Define how to find the value returned by a function.
+   VALTYPE is the data type of the value (as a tree).
+   If the precise function being called is known, FUNC is its FUNCTION_DECL;
+   otherwise, FUNC is 0.  */
+
+#define FUNCTION_VALUE(TYPE, FUNC) \
+  gen_rtx_REG (TYPE_MODE (TYPE), 0)
+
+/* Force aggregates and objects larger than 16 bytes to be returned in memory,
+   since we only have 4 registers available for return values.  */
+
+#define RETURN_IN_MEMORY(TYPE) \
+  (TYPE_MODE (TYPE) == BLKmode || int_size_in_bytes (TYPE) > 16)
+
+/* Don't default to pcc-struct-return, because we have already specified
+   exactly how to return structures in the RETURN_IN_MEMORY macro.  */
+#define DEFAULT_PCC_STRUCT_RETURN 0
+
+/* For an arg passed partly in registers and partly in memory,
+   this is the number of registers used.
+   This never happens on 80960.  */
+
+#define FUNCTION_ARG_PARTIAL_NREGS(CUM, MODE, TYPE, NAMED) 0
+
+/* Output the label for a function definition.
+  This handles leaf functions and a few other things for the i960.  */
+
+#define ASM_DECLARE_FUNCTION_NAME(FILE, NAME, DECL)	\
+  i960_function_name_declare (FILE, NAME, DECL)
+
+/* Output assembler code to FILE to increment profiler label # LABELNO
+   for profiling a function entry.  */
+
+#define FUNCTION_PROFILER(FILE, LABELNO)	\
+  output_function_profiler ((FILE), (LABELNO));
+
+/* EXIT_IGNORE_STACK should be nonzero if, when returning from a function,
+   the stack pointer does not matter.  The value is tested only in
+   functions that have frame pointers.
+   No definition is equivalent to always zero.  */
+
+#define	EXIT_IGNORE_STACK 1
+
+/* Addressing modes, and classification of registers for them.  */
+
+/* Macros to check register numbers against specific register classes.  */
+
+/* These assume that REGNO is a hard or pseudo reg number.
+   They give nonzero only if REGNO is a hard reg of the suitable class
+   or a pseudo reg currently allocated to a suitable hard reg.
+   Since they use reg_renumber, they are safe only once reg_renumber
+   has been allocated, which happens in local-alloc.c.  */
+
+#define REGNO_OK_FOR_INDEX_P(REGNO) \
+  ((REGNO) < 32 || (unsigned) reg_renumber[REGNO] < 32)
+#define REGNO_OK_FOR_BASE_P(REGNO) \
+  ((REGNO) < 32 || (unsigned) reg_renumber[REGNO] < 32)
+#define REGNO_OK_FOR_FP_P(REGNO) \
+  ((REGNO) < 36 || (unsigned) reg_renumber[REGNO] < 36)
+
+/* Now macros that check whether X is a register and also,
+   strictly, whether it is in a specified class.
+
+   These macros are specific to the 960, and may be used only
+   in code for printing assembler insns and in conditions for
+   define_optimization.  */
+
+/* 1 if X is an fp register.  */
+
+#define FP_REG_P(X) (REGNO (X) >= 32 && REGNO (X) < 36)
+
+/* Maximum number of registers that can appear in a valid memory address.  */
+#define	MAX_REGS_PER_ADDRESS 2
+
+#define CONSTANT_ADDRESS_P(X)   \
+  (GET_CODE (X) == LABEL_REF || GET_CODE (X) == SYMBOL_REF		\
+   || GET_CODE (X) == CONST_INT || GET_CODE (X) == CONST		\
+   || GET_CODE (X) == HIGH)
+
+/* LEGITIMATE_CONSTANT_P is nonzero if the constant value X
+   is a legitimate general operand.
+   It is given that X satisfies CONSTANT_P.
+
+   Anything but a CONST_DOUBLE can be made to work, excepting 0.0 and 1.0.
+
+   ??? This probably should be defined to 1.  */
+
+#define LEGITIMATE_CONSTANT_P(X) \
+  ((GET_CODE (X) != CONST_DOUBLE) || fp_literal ((X), GET_MODE (X)))
+
+/* The macros REG_OK_FOR..._P assume that the arg is a REG rtx
+   and check its validity for a certain class.
+   We have two alternate definitions for each of them.
+   The usual definition accepts all pseudo regs; the other rejects
+   them unless they have been allocated suitable hard regs.
+   The symbol REG_OK_STRICT causes the latter definition to be used.
+
+   Most source files want to accept pseudo regs in the hope that
+   they will get allocated to the class that the insn wants them to be in.
+   Source files for reload pass need to be strict.
+   After reload, it makes no difference, since pseudo regs have
+   been eliminated by then.  */
+
+#ifndef REG_OK_STRICT
+
+/* Nonzero if X is a hard reg that can be used as an index
+   or if it is a pseudo reg.  */
+#define REG_OK_FOR_INDEX_P(X) \
+  (REGNO (X) < 32 || REGNO (X) >= FIRST_PSEUDO_REGISTER)
+/* Nonzero if X is a hard reg that can be used as a base reg
+   or if it is a pseudo reg.  */
+#define REG_OK_FOR_BASE_P(X) \
+  (REGNO (X) < 32 || REGNO (X) >= FIRST_PSEUDO_REGISTER)
+
+#define REG_OK_FOR_INDEX_P_STRICT(X) REGNO_OK_FOR_INDEX_P (REGNO (X))
+#define REG_OK_FOR_BASE_P_STRICT(X) REGNO_OK_FOR_BASE_P (REGNO (X))
+
+#else
+
+/* Nonzero if X is a hard reg that can be used as an index.  */
+#define REG_OK_FOR_INDEX_P(X) REGNO_OK_FOR_INDEX_P (REGNO (X))
+/* Nonzero if X is a hard reg that can be used as a base reg.  */
+#define REG_OK_FOR_BASE_P(X) REGNO_OK_FOR_BASE_P (REGNO (X))
+
+#endif
+
+/* GO_IF_LEGITIMATE_ADDRESS recognizes an RTL expression
+   that is a valid memory address for an instruction.
+   The MODE argument is the machine mode for the MEM expression
+   that wants to use this address.
+
+	On 80960, legitimate addresses are:
+		base				ld	(g0),r0
+		disp	(12 or 32 bit)		ld	foo,r0
+		base + index			ld	(g0)[g1*1],r0
+		base + displ			ld	0xf00(g0),r0
+		base + index*scale + displ	ld	0xf00(g0)[g1*4],r0
+		index*scale + base		ld	(g0)[g1*4],r0
+		index*scale + displ		ld	0xf00[g1*4],r0
+		index*scale			ld	[g1*4],r0
+		index + base + displ		ld	0xf00(g0)[g1*1],r0
+
+	In each case, scale can be 1, 2, 4, 8, or 16.  */
+
+/* Returns 1 if the scale factor of an index term is valid.  */
+#define SCALE_TERM_P(X)							\
+  (GET_CODE (X) == CONST_INT						\
+   && (INTVAL (X) == 1 || INTVAL (X) == 2 || INTVAL (X) == 4 		\
+       || INTVAL(X) == 8 || INTVAL (X) == 16))
+
+
+#ifdef REG_OK_STRICT
+#define GO_IF_LEGITIMATE_ADDRESS(MODE, X, ADDR) \
+  { if (legitimate_address_p (MODE, X, 1)) goto ADDR; }
+#else
+#define GO_IF_LEGITIMATE_ADDRESS(MODE, X, ADDR) \
+  { if (legitimate_address_p (MODE, X, 0)) goto ADDR; }
+#endif
+
+/* Try machine-dependent ways of modifying an illegitimate address
+   to be legitimate.  If we find one, return the new, valid address.
+   This macro is used in only one place: `memory_address' in explow.c.
+
+   OLDX is the address as it was before break_out_memory_refs was called.
+   In some cases it is useful to look at this to decide what needs to be done.
+
+   MODE and WIN are passed so that this macro can use
+   GO_IF_LEGITIMATE_ADDRESS.
+
+   It is always safe for this macro to do nothing.  It exists to recognize
+   opportunities to optimize the output.  */
+
+/* On 80960, convert non-canonical addresses to canonical form.  */
+
+#define LEGITIMIZE_ADDRESS(X, OLDX, MODE, WIN)	\
+{ rtx orig_x = (X);				\
+  (X) = legitimize_address (X, OLDX, MODE);	\
+  if ((X) != orig_x && memory_address_p (MODE, X)) \
+    goto WIN; }
+
+/* Go to LABEL if ADDR (a legitimate address expression)
+   has an effect that depends on the machine mode it is used for.
+   On the 960 this is never true.  */
+
+#define GO_IF_MODE_DEPENDENT_ADDRESS(ADDR,LABEL)
+
+/* Specify the machine mode that this machine uses
+   for the index in the tablejump instruction.  */
+#define CASE_VECTOR_MODE SImode
+
+/* Define as C expression which evaluates to nonzero if the tablejump
+   instruction expects the table to contain offsets from the address of the
+   table.
+   Do not define this if the table should contain absolute addresses.  */
+/* #define CASE_VECTOR_PC_RELATIVE 1 */
+
+/* Define this as 1 if `char' should by default be signed; else as 0.  */
+#define DEFAULT_SIGNED_CHAR 0
+
+/* Max number of bytes we can move from memory to memory
+   in one reasonably fast instruction.  */
+#define MOVE_MAX 16
+
+/* Define if operations between registers always perform the operation
+   on the full register even if a narrower mode is specified.  */
+#define WORD_REGISTER_OPERATIONS
+
+/* Define if loading in MODE, an integral mode narrower than BITS_PER_WORD
+   will either zero-extend or sign-extend.  The value of this macro should
+   be the code that says which one of the two operations is implicitly
+   done, NIL if none.  */
+#define LOAD_EXTEND_OP(MODE) ZERO_EXTEND
+
+/* Nonzero if access to memory by bytes is no faster than for words.
+   Value changed to 1 after reports of poor bit-field code with g++.
+   Indications are that code is usually as good, sometimes better.  */   
+
+#define SLOW_BYTE_ACCESS 1
+
+/* Define this to be nonzero if shift instructions ignore all but the low-order
+   few bits.  */
+#define SHIFT_COUNT_TRUNCATED 0
+
+/* Value is 1 if truncating an integer of INPREC bits to OUTPREC bits
+   is done just by pretending it is already truncated.  */
+#define TRULY_NOOP_TRUNCATION(OUTPREC, INPREC) 1
+
+/* Specify the machine mode that pointers have.
+   After generation of rtl, the compiler makes no further distinction
+   between pointers and any other objects of this machine mode.  */
+#define Pmode SImode
+
+/* Specify the widest mode that BLKmode objects can be promoted to */
+#define	MAX_FIXED_MODE_SIZE GET_MODE_BITSIZE (TImode)
+
+/* These global variables are used to pass information between
+   cc setter and cc user at insn emit time.  */
+
+extern struct rtx_def *i960_compare_op0, *i960_compare_op1;
+
+/* Given a comparison code (EQ, NE, etc.) and the first operand of a COMPARE,
+   return the mode to be used for the comparison.  For floating-point, CCFPmode
+   should be used.  CC_NOOVmode should be used when the first operand is a
+   PLUS, MINUS, or NEG.  CCmode should be used when no special processing is
+   needed.  */
+#define SELECT_CC_MODE(OP,X,Y) select_cc_mode (OP, X)
+
+/* A function address in a call instruction is a byte address
+   (for indexing purposes) so give the MEM rtx a byte's mode.  */
+#define FUNCTION_MODE SImode
+
+/* Define this if addresses of constant functions
+   shouldn't be put through pseudo regs where they can be cse'd.
+   Desirable on machines where ordinary constants are expensive
+   but a CALL with constant address is cheap.  */
+#define NO_FUNCTION_CSE
+
+/* Use memcpy, etc. instead of bcopy.  */
+
+#ifndef WIND_RIVER
+#define	TARGET_MEM_FUNCTIONS	1
+#endif
+
+/* Control the assembler format that we output.  */
+
+/* Output to assembler file text saying following lines
+   may contain character constants, extra white space, comments, etc.  */
+
+#define ASM_APP_ON ""
+
+/* Output to assembler file text saying following lines
+   no longer contain unusual constructs.  */
+
+#define ASM_APP_OFF ""
+
+/* Output before read-only data.  */
+
+#define TEXT_SECTION_ASM_OP "\t.text"
+
+/* Output before writable data.  */
+
+#define DATA_SECTION_ASM_OP "\t.data"
+
+/* How to refer to registers in assembler output.
+   This sequence is indexed by compiler's hard-register-number (see above).  */
+
+#define REGISTER_NAMES {						\
+	"g0", "g1", "g2",  "g3",  "g4",  "g5",  "g6",  "g7",		\
+	"g8", "g9", "g10", "g11", "g12", "g13", "g14", "fp",		\
+	"pfp","sp", "rip", "r3",  "r4",  "r5",  "r6",  "r7",		\
+	"r8", "r9", "r10", "r11", "r12", "r13", "r14", "r15",		\
+	"fp0","fp1","fp2", "fp3", "cc", "fake" }
+
+/* How to renumber registers for dbx and gdb.
+   In the 960 encoding, g0..g15 are registers 16..31.  */
+
+#define DBX_REGISTER_NUMBER(REGNO)					\
+  (((REGNO) < 16) ? (REGNO) + 16					\
+   : (((REGNO) > 31) ? (REGNO) : (REGNO) - 16))
+
+/* Don't emit dbx records longer than this.  This is an arbitrary value.  */
+#define DBX_CONTIN_LENGTH 1500
+
+/* This is how to output a note to DBX telling it the line number
+   to which the following sequence of instructions corresponds.  */
+
+#define ASM_OUTPUT_SOURCE_LINE(FILE, LINE, COUNTER)		\
+{ if (write_symbols == SDB_DEBUG) {				\
+    fprintf ((FILE), "\t.ln	%d\n",				\
+	     (sdb_begin_function_line				\
+	      ? (LINE) - sdb_begin_function_line : 1));		\
+  } else if (write_symbols == DBX_DEBUG) {			\
+	fprintf((FILE),"\t.stabd	68,0,%d\n",(LINE));	\
+  } }
+
+/* Globalizing directive for a label.  */
+#define GLOBAL_ASM_OP "\t.globl "
+
+/* The prefix to add to user-visible assembler symbols.  */
+
+#define USER_LABEL_PREFIX "_"
+
+/* This is how to store into the string LABEL
+   the symbol_ref name of an internal numbered label where
+   PREFIX is the class of label and NUM is the number within the class.
+   This is suitable for output with `assemble_name'.  */
+
+#define ASM_GENERATE_INTERNAL_LABEL(LABEL,PREFIX,NUM)	\
+  sprintf (LABEL, "*%s%lu", PREFIX, (unsigned long)(NUM))
+
+#define ASM_OUTPUT_REG_PUSH(FILE,REGNO)  \
+  fprintf (FILE, "\tst\t%s,(sp)\n\taddo\t4,sp,sp\n", reg_names[REGNO])
+
+/* This is how to output an insn to pop a register from the stack.
+   It need not be very fast code.  */
+
+#define ASM_OUTPUT_REG_POP(FILE,REGNO)  \
+  fprintf (FILE, "\tsubo\t4,sp,sp\n\tld\t(sp),%s\n", reg_names[REGNO])
+
+/* This is how to output an element of a case-vector that is absolute.  */
+
+#define ASM_OUTPUT_ADDR_VEC_ELT(FILE, VALUE)  \
+  fprintf (FILE, "\t.word L%d\n", VALUE)
+
+/* This is how to output an element of a case-vector that is relative.  */
+
+#define ASM_OUTPUT_ADDR_DIFF_ELT(FILE, BODY, VALUE, REL)  \
+  fprintf (FILE, "\t.word L%d-L%d\n", VALUE, REL)
+
+/* This is how to output an assembler line that says to advance the
+   location counter to a multiple of 2**LOG bytes.  */
+
+#define ASM_OUTPUT_ALIGN(FILE,LOG)	\
+  fprintf (FILE, "\t.align %d\n", (LOG))
+
+#define ASM_OUTPUT_SKIP(FILE,SIZE)  \
+  fprintf (FILE, "\t.space %d\n", (int)(SIZE))
+
+/* This says how to output an assembler line
+   to define a global common symbol.  */
+
+/* For common objects, output unpadded size... gld960 & lnk960 both
+   have code to align each common object at link time.  Also, if size
+   is 0, treat this as a declaration, not a definition - i.e.,
+   do nothing at all.  */
+
+#define ASM_OUTPUT_COMMON(FILE, NAME, SIZE, ROUNDED)	\
+{ if ((SIZE) != 0)					\
+    {							\
+      fputs (".globl ", (FILE)),			\
+      assemble_name ((FILE), (NAME)),			\
+      fputs ("\n.comm ", (FILE)),			\
+      assemble_name ((FILE), (NAME)),			\
+      fprintf ((FILE), ",%d\n", (int)(SIZE));		\
+    }							\
+}
+
+/* This says how to output an assembler line to define a local common symbol.
+   Output unpadded size, with request to linker to align as requested.
+   0 size should not be possible here.  */
+
+#define ASM_OUTPUT_ALIGNED_LOCAL(FILE, NAME, SIZE, ALIGN)  \
+( fputs (".bss\t", (FILE)),			\
+  assemble_name ((FILE), (NAME)),		\
+  fprintf ((FILE), ",%d,%d\n", (int)(SIZE),	\
+	   (floor_log2 ((ALIGN) / BITS_PER_UNIT))))
+
+/* A C statement (sans semicolon) to output to the stdio stream
+   FILE the assembler definition of uninitialized global DECL named
+   NAME whose size is SIZE bytes and alignment is ALIGN bytes.
+   Try to use asm_output_aligned_bss to implement this macro.  */
+
+#define ASM_OUTPUT_ALIGNED_BSS(FILE, DECL, NAME, SIZE, ALIGN)	\
+  do {								\
+    ASM_OUTPUT_ALIGNED_LOCAL (FILE, NAME, SIZE, ALIGN);		\
+  } while (0)
+
+/* Output text for an #ident directive.  */
+#define	ASM_OUTPUT_IDENT(FILE, STR)  fprintf(FILE, "\t# %s\n", STR);
+
+/* Align code to 8 byte boundary if TARGET_CODE_ALIGN is true.  */
+
+#define	LABEL_ALIGN_AFTER_BARRIER(LABEL) (TARGET_CODE_ALIGN ? 3 : 0)
+
+
+/* Print operand X (an rtx) in assembler syntax to file FILE.
+   CODE is a letter or dot (`z' in `%z0') or 0 if no letter was specified.
+   For `%' followed by punctuation, CODE is the punctuation and X is null.  */
+
+#define PRINT_OPERAND(FILE, X, CODE)  \
+  i960_print_operand (FILE, X, CODE);
+
+/* Print a memory address as an operand to reference that memory location.  */
+
+#define PRINT_OPERAND_ADDRESS(FILE, ADDR)	\
+  i960_print_operand_addr (FILE, ADDR)
+
+/* Determine which codes are valid without a following integer.  These must
+   not be alphabetic (the characters are chosen so that
+   PRINT_OPERAND_PUNCT_VALID_P translates into a simple range change when
+   using ASCII).  */
+
+#define PRINT_OPERAND_PUNCT_VALID_P(CODE)   ((CODE) == '+')
+
+/* Output assembler code for a block containing the constant parts
+   of a trampoline, leaving space for the variable parts.  */
+
+/* On the i960, the trampoline contains three instructions:
+     ldconst _function, r4
+     ldconst static addr, g12
+     jump (r4)  */
+
+#define TRAMPOLINE_TEMPLATE(FILE)					\
+{									\
+  assemble_aligned_integer (UNITS_PER_WORD, GEN_INT (0x8C203000));	\
+  assemble_aligned_integer (UNITS_PER_WORD, GEN_INT (0x00000000));	\
+  assemble_aligned_integer (UNITS_PER_WORD, GEN_INT (0x8CE03000));	\
+  assemble_aligned_integer (UNITS_PER_WORD, GEN_INT (0x00000000));	\
+  assemble_aligned_integer (UNITS_PER_WORD, GEN_INT (0x84212000));	\
+}
+
+/* Length in units of the trampoline for entering a nested function.  */
+
+#define TRAMPOLINE_SIZE 20
+
+/* Emit RTL insns to initialize the variable parts of a trampoline.
+   FNADDR is an RTX for the address of the function's pure code.
+   CXT is an RTX for the static chain value for the function.  */
+
+#define INITIALIZE_TRAMPOLINE(TRAMP, FNADDR, CXT)			\
+{									\
+  emit_move_insn (gen_rtx_MEM (SImode, plus_constant (TRAMP, 4)), FNADDR); \
+  emit_move_insn (gen_rtx_MEM (SImode, plus_constant (TRAMP, 12)), CXT); \
+}
+
+/* Generate RTL to flush the register windows so as to make arbitrary frames
+   available.  */
+#define SETUP_FRAME_ADDRESSES()		\
+  emit_insn (gen_flush_register_windows ())
+
+#define BUILTIN_SETJMP_FRAME_VALUE hard_frame_pointer_rtx
+
+#if 0
+/* Promote char and short arguments to ints, when want compatibility with
+   the iC960 compilers.  */
+
+/* ??? In order for this to work, all users would need to be changed
+   to test the value of the macro at run time.  */
+#define PROMOTE_PROTOTYPES	TARGET_CLEAN_LINKAGE
+/* ??? This does not exist.  */
+#define PROMOTE_RETURN		TARGET_CLEAN_LINKAGE
+#endif
+
+/* Instruction type definitions.  Used to alternate instructions types for
+   better performance on the C series chips.  */
+
+enum insn_types { I_TYPE_REG, I_TYPE_MEM, I_TYPE_CTRL };
+
+/* Holds the insn type of the last insn output to the assembly file.  */
+
+extern enum insn_types i960_last_insn_type;
+
+/* Parse opcodes, and set the insn last insn type based on them.  */
+
+#define ASM_OUTPUT_OPCODE(FILE, INSN)	i960_scan_opcode (INSN)
+
+/* Table listing what rtl codes each predicate in i960.c will accept.  */
+
+#define PREDICATE_CODES \
+  {"fpmove_src_operand", {CONST_INT, CONST_DOUBLE, CONST, SYMBOL_REF,	\
+			  LABEL_REF, SUBREG, REG, MEM}},		\
+  {"arith_operand", {SUBREG, REG, CONST_INT}},				\
+  {"logic_operand", {SUBREG, REG, CONST_INT}},				\
+  {"fp_arith_operand", {SUBREG, REG, CONST_DOUBLE}},			\
+  {"signed_arith_operand", {SUBREG, REG, CONST_INT}},			\
+  {"literal", {CONST_INT}},						\
+  {"fp_literal_one", {CONST_DOUBLE}},					\
+  {"fp_literal_double", {CONST_DOUBLE}},				\
+  {"fp_literal", {CONST_DOUBLE}},					\
+  {"signed_literal", {CONST_INT}},					\
+  {"symbolic_memory_operand", {SUBREG, MEM}},				\
+  {"eq_or_neq", {EQ, NE}},						\
+  {"arith32_operand", {SUBREG, REG, LABEL_REF, SYMBOL_REF, CONST_INT,	\
+		       CONST_DOUBLE, CONST}},				\
+  {"power2_operand", {CONST_INT}},					\
+  {"cmplpower2_operand", {CONST_INT}},
+
+/* Defined in reload.c, and used in insn-recog.c.  */
+
+extern int rtx_equal_function_value_matters;
diff --git a/gcc/config/i960/i960.md b/gcc/config/i960/i960.md
new file mode 100644
index 00000000000..ad1678a7077
--- /dev/null
+++ b/gcc/config/i960/i960.md
@@ -0,0 +1,2818 @@
+;;- Machine description for Intel 80960 chip for GNU C compiler
+;;   Copyright (C) 1992, 1995, 1998, 2001 Free Software Foundation, Inc.
+;;   Contributed by Steven McGeady, Intel Corp.
+;;   Additional work by Glenn Colon-Bonet, Jonathan Shapiro, Andy Wilson
+;;   Converted to GCC 2.0 by Jim Wilson and Michael Tiemann, Cygnus Support.
+
+;; This file is part of GCC.
+
+;; GCC is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GCC is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GCC; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;- See file "rtl.def" for documentation on define_insn, match_*, et. al.
+
+;; There are very few (4) 'f' registers, they can't be loaded/stored from/to
+;; memory, and some instructions explicitly require them, so we get better
+;; code by discouraging pseudo-registers from being allocated to them.
+;; However, we do want to allow all patterns which can store to them to
+;; include them in their constraints, so we always use '*f' in a destination
+;; constraint except when 'f' is the only alternative.
+
+;; Insn attributes which describe the i960.
+
+;; Modscan is not used, since the compiler never emits any of these insns.
+(define_attr "type"
+  "move,arith,alu2,mult,div,modscan,load,store,branch,call,address,compare,fpload,fpstore,fpmove,fpcvt,fpcc,fpadd,fpmul,fpdiv,multi,misc"
+  (const_string "arith"))
+
+;; Length (in # of insns).
+(define_attr "length" ""
+  (cond [(eq_attr "type" "load,fpload")
+	      (if_then_else (match_operand 1 "symbolic_memory_operand" "")
+			    (const_int 2)
+			    (const_int 1))
+	 (eq_attr "type" "store,fpstore")
+	      (if_then_else (match_operand 0 "symbolic_memory_operand" "")
+			    (const_int 2)
+			    (const_int 1))
+	 (eq_attr "type" "address")
+	      (const_int 2)]
+	(const_int 1)))
+
+(define_asm_attributes
+  [(set_attr "length" "1")
+   (set_attr "type" "multi")])
+
+;; (define_function_unit {name} {num-units} {n-users} {test}
+;;                       {ready-delay} {issue-delay} [{conflict-list}])
+
+;; The integer ALU
+(define_function_unit "alu" 2 0 (eq_attr "type" "arith,compare,move,address") 1 0)
+(define_function_unit "alu" 2 0 (eq_attr "type" "alu2") 2 0)
+(define_function_unit "alu" 2 0 (eq_attr "type" "mult") 5 0)
+(define_function_unit "alu" 2 0 (eq_attr "type" "div") 35 0)
+(define_function_unit "alu" 2 0 (eq_attr "type" "modscan") 3 0)
+
+;; Memory with load-delay of 1 (i.e., 2 cycle load).
+(define_function_unit "memory" 1 0 (eq_attr "type" "load,fpload") 2 0)
+
+;; Floating point operations.
+(define_function_unit "fp" 1 2 (eq_attr "type" "fpmove") 5 0)
+(define_function_unit "fp" 1 2 (eq_attr "type" "fpcvt") 35 0)
+(define_function_unit "fp" 1 2 (eq_attr "type" "fpcc") 10 0)
+(define_function_unit "fp" 1 2 (eq_attr "type" "fpadd") 10 0)
+(define_function_unit "fp" 1 2 (eq_attr "type" "fpmul") 20 0)
+(define_function_unit "fp" 1 2 (eq_attr "type" "fpdiv") 35 0)
+
+;; Compare instructions.
+;; This controls RTL generation and register allocation.
+
+;; We generate RTL for comparisons and branches by having the cmpxx 
+;; patterns store away the operands.  Then, the scc and bcc patterns
+;; emit RTL for both the compare and the branch.
+;;
+;; We start with the DEFINE_EXPANDs, then DEFINE_INSNs to match
+;; the patterns.  Finally, we have the DEFINE_SPLITs for some of the scc
+;; insns that actually require more than one machine instruction.
+
+;; Put cmpsi first because it is expected to be the most common.
+
+(define_expand "cmpsi"
+  [(set (reg:CC 36)
+	(compare:CC (match_operand:SI 0 "nonimmediate_operand" "")
+		    (match_operand:SI 1 "general_operand" "")))]
+  ""
+  "
+{
+  i960_compare_op0 = operands[0];
+  i960_compare_op1 = operands[1];
+  DONE;
+}")
+
+(define_expand "cmpdf"
+  [(set (reg:CC 36)
+	(compare:CC (match_operand:DF 0 "register_operand" "r")
+		    (match_operand:DF 1 "nonmemory_operand" "rGH")))]
+  "TARGET_NUMERICS"
+  "
+{
+  i960_compare_op0 = operands[0];
+  i960_compare_op1 = operands[1];
+  DONE;
+}")
+
+(define_expand "cmpsf"
+  [(set (reg:CC 36)
+	(compare:CC (match_operand:SF 0 "register_operand" "r")
+		    (match_operand:SF 1 "nonmemory_operand" "rGH")))]
+  "TARGET_NUMERICS"
+  "
+{
+  i960_compare_op0 = operands[0];
+  i960_compare_op1 = operands[1];
+  DONE;
+}")
+
+;; Now the DEFINE_INSNs for the compare and scc cases.  First the compares.
+
+(define_insn ""
+  [(set (reg:CC 36)
+	(compare:CC (match_operand:SI 0 "register_operand" "d")
+		    (match_operand:SI 1 "arith_operand" "dI")))]
+  ""
+  "cmpi	%0,%1"
+  [(set_attr "type" "compare")])
+
+(define_insn ""
+  [(set (reg:CC_UNS 36)
+	(compare:CC_UNS (match_operand:SI 0 "register_operand" "d")
+			(match_operand:SI 1 "arith_operand" "dI")))]
+  ""
+  "cmpo	%0,%1"
+  [(set_attr "type" "compare")])
+
+(define_insn ""
+  [(set (reg:CC 36)
+	(compare:CC (match_operand:DF 0 "register_operand" "r")
+		    (match_operand:DF 1 "nonmemory_operand" "rGH")))]
+  "TARGET_NUMERICS"
+  "cmprl %0,%1"
+  [(set_attr "type" "fpcc")])
+
+(define_insn ""
+  [(set (reg:CC 36)
+	(compare:CC (match_operand:SF 0 "register_operand" "r")
+		    (match_operand:SF 1 "nonmemory_operand" "rGH")))]
+  "TARGET_NUMERICS"
+  "cmpr %0,%1"
+  [(set_attr "type" "fpcc")])
+
+;; Instruction definitions for branch-on-bit-set and clear insns.
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else
+	 (ne (sign_extract:SI (match_operand:SI 0 "register_operand" "d")
+			      (const_int 1)
+			      (match_operand:SI 1 "arith_operand" "dI"))
+	     (const_int 0))
+	 (label_ref (match_operand 2 "" ""))
+	 (pc)))]
+  ""
+  "bbs%+	%1,%0,%l2"
+  [(set_attr "type" "branch")])
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else
+	 (eq (sign_extract:SI (match_operand:SI 0 "register_operand" "d")
+			      (const_int 1)
+			      (match_operand:SI 1 "arith_operand" "dI"))
+	     (const_int 0))
+	 (label_ref (match_operand 2 "" ""))
+	 (pc)))]
+  ""
+  "bbc%+	%1,%0,%l2"
+  [(set_attr "type" "branch")])
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else
+	 (ne (zero_extract:SI (match_operand:SI 0 "register_operand" "d")
+			      (const_int 1)
+			      (match_operand:SI 1 "arith_operand" "dI"))
+	     (const_int 0))
+	 (label_ref (match_operand 2 "" ""))
+	 (pc)))]
+  ""
+  "bbs%+	%1,%0,%l2"
+  [(set_attr "type" "branch")])
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else
+	 (eq (zero_extract:SI (match_operand:SI 0 "register_operand" "d")
+			      (const_int 1)
+			      (match_operand:SI 1 "arith_operand" "dI"))
+	     (const_int 0))
+	 (label_ref (match_operand 2 "" ""))
+	 (pc)))]
+  ""
+  "bbc%+	%1,%0,%l2"
+  [(set_attr "type" "branch")])
+
+;; ??? These will never match.  The LOG_LINKs necessary to make these match
+;; are not created by flow.  These remain as a reminder to make this work
+;; some day.
+
+(define_insn ""
+  [(set (reg:CC 36)
+	(compare (match_operand:SI 0 "arith_operand" "d")
+		 (match_operand:SI 1 "arith_operand" "+d")))
+   (set (match_dup 1) (plus:SI (match_dup 1) (const_int 1)))]
+  "0"
+  "cmpinci	%0,%1"
+  [(set_attr "type" "compare")])
+
+(define_insn ""
+  [(set (reg:CC_UNS 36)
+	(compare (match_operand:SI 0 "arith_operand" "d")
+		 (match_operand:SI 1 "arith_operand" "+d")))
+   (set (match_dup 1) (plus:SI (match_dup 1) (const_int 1)))]
+  "0"
+  "cmpinco	%0,%1"
+  [(set_attr "type" "compare")])
+
+(define_insn ""
+  [(set (reg:CC 36)
+	(compare (match_operand:SI 0 "arith_operand" "d")
+		 (match_operand:SI 1 "arith_operand" "+d")))
+   (set (match_dup 1) (minus:SI (match_dup 1) (const_int 1)))]
+  "0"
+  "cmpdeci	%0,%1"
+  [(set_attr "type" "compare")])
+
+(define_insn ""
+  [(set (reg:CC_UNS 36)
+	(compare (match_operand:SI 0 "arith_operand" "d")
+		 (match_operand:SI 1 "arith_operand" "+d")))
+   (set (match_dup 1) (minus:SI (match_dup 1) (const_int 1)))]
+  "0"
+  "cmpdeco	%0,%1"
+  [(set_attr "type" "compare")])
+
+;; Templates to store result of condition.
+;; '1' is stored if condition is true.
+;; '0' is stored if condition is false.
+;; These should use predicate "general_operand", since
+;; gcc seems to be creating mem references which use these
+;; templates.
+
+(define_expand "seq"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(eq:SI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{
+  operands[1] = gen_compare_reg (EQ, i960_compare_op0, i960_compare_op1);
+}")
+
+(define_expand "sne"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(ne:SI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{
+  operands[1] = gen_compare_reg (NE, i960_compare_op0, i960_compare_op1);
+}")
+
+(define_expand "sgt"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(gt:SI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{
+  operands[1] = gen_compare_reg (GT, i960_compare_op0, i960_compare_op1);
+}")
+
+(define_expand "sgtu"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(gtu:SI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{
+  operands[1] = gen_compare_reg (GTU, i960_compare_op0, i960_compare_op1);
+}")
+
+(define_expand "slt"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(lt:SI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{
+  operands[1] = gen_compare_reg (LT, i960_compare_op0, i960_compare_op1);
+}")
+
+(define_expand "sltu"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(ltu:SI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{
+  operands[1] = gen_compare_reg (LTU, i960_compare_op0, i960_compare_op1);
+}")
+
+(define_expand "sge"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(ge:SI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{
+  operands[1] = gen_compare_reg (GE, i960_compare_op0, i960_compare_op1);
+}")
+
+(define_expand "sgeu"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(geu:SI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{
+  operands[1] = gen_compare_reg (GEU, i960_compare_op0, i960_compare_op1);
+}")
+
+(define_expand "sle"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(le:SI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{
+  operands[1] = gen_compare_reg (LE, i960_compare_op0, i960_compare_op1);
+}")
+
+(define_expand "sleu"
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(leu:SI (match_dup 1) (const_int 0)))]
+  ""
+  "
+{
+  operands[1] = gen_compare_reg (LEU, i960_compare_op0, i960_compare_op1);
+}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(eq:SI (match_operand:SI 1 "register_operand" "d") (const_int 0)))]
+  ""
+  "shro	%1,1,%0"
+  [(set_attr "type" "alu2")])
+
+(define_insn ""
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(match_operator:SI 1 "comparison_operator" [(reg:CC 36) (const_int 0)]))]
+  ""
+  "test%C1	%0"
+  [(set_attr "type" "compare")])
+
+(define_insn ""
+  [(set (match_operand:SI 0 "general_operand" "=d")
+	(match_operator:SI 1 "comparison_operator" [(reg:CC_UNS 36) (const_int 0)]))]
+  ""
+  "test%C1	%0"
+  [(set_attr "type" "compare")])
+
+;; These control RTL generation for conditional jump insns
+;; and match them for register allocation.
+
+(define_expand "beq"
+  [(set (pc)
+	(if_then_else (eq (match_dup 1)
+			  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ operands[1] = gen_compare_reg (EQ, i960_compare_op0, i960_compare_op1); }")
+
+(define_expand "bne"
+  [(set (pc)
+	(if_then_else (ne (match_dup 1)
+			  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ operands[1] = gen_compare_reg (NE, i960_compare_op0, i960_compare_op1); }")
+
+(define_expand "bgt"
+  [(set (pc)
+	(if_then_else (gt (match_dup 1)
+			  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ operands[1] = gen_compare_reg (GT, i960_compare_op0, i960_compare_op1); }")
+
+(define_expand "bgtu"
+  [(set (pc)
+	(if_then_else (gtu (match_dup 1)
+			   (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ operands[1] = gen_compare_reg (GTU, i960_compare_op0, i960_compare_op1); }")
+
+(define_expand "blt"
+  [(set (pc)
+	(if_then_else (lt (match_dup 1)
+			  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ operands[1] = gen_compare_reg (LT, i960_compare_op0, i960_compare_op1); }")
+
+(define_expand "bltu"
+  [(set (pc)
+	(if_then_else (ltu (match_dup 1)
+			   (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ operands[1] = gen_compare_reg (LTU, i960_compare_op0, i960_compare_op1); }")
+
+(define_expand "bge"
+  [(set (pc)
+	(if_then_else (ge (match_dup 1)
+			  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ operands[1] = gen_compare_reg (GE, i960_compare_op0, i960_compare_op1); }")
+
+(define_expand "bgeu"
+  [(set (pc)
+	(if_then_else (geu (match_dup 1)
+			   (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ operands[1] = gen_compare_reg (GEU, i960_compare_op0, i960_compare_op1); }")
+
+(define_expand "ble"
+  [(set (pc)
+	(if_then_else (le (match_dup 1)
+			  (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ operands[1] = gen_compare_reg (LE, i960_compare_op0, i960_compare_op1); }")
+
+(define_expand "bleu"
+  [(set (pc)
+	(if_then_else (leu (match_dup 1)
+			   (const_int 0))
+		      (label_ref (match_operand 0 "" ""))
+		      (pc)))]
+  ""
+  "
+{ operands[1] = gen_compare_reg (LEU, i960_compare_op0, i960_compare_op1); }")
+
+;; Now the normal branch insns (forward and reverse).
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (match_operator 0 "comparison_operator"
+				      [(reg:CC 36) (const_int 0)])
+		      (label_ref (match_operand 1 "" ""))
+		      (pc)))]
+  ""
+  "b%C0%+ %l1"
+  [(set_attr "type" "branch")])
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (match_operator 0 "comparison_operator"
+				      [(reg:CC 36) (const_int 0)])
+		      (pc)
+		      (label_ref (match_operand 1 "" ""))))]
+  ""
+  "b%I0%+ %l1"
+  [(set_attr "type" "branch")])
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (match_operator 0 "comparison_operator"
+				      [(reg:CC_UNS 36) (const_int 0)])
+		      (label_ref (match_operand 1 "" ""))
+		      (pc)))]
+  ""
+  "b%C0%+ %l1"
+  [(set_attr "type" "branch")])
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else (match_operator 0 "comparison_operator"
+				      [(reg:CC_UNS 36) (const_int 0)])
+		      (pc)
+		      (label_ref (match_operand 1 "" ""))))]
+  ""
+  "b%I0%+ %l1"
+  [(set_attr "type" "branch")])
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else
+	 (match_operator 0 "comparison_operator"
+			 [(match_operand:SI 1 "arith_operand" "d")
+			  (match_operand:SI 2 "arith_operand" "dI")])
+	 (label_ref (match_operand 3 "" ""))
+	 (pc)))]
+  ""
+  "cmp%S0%B0%R0%+	%2,%1,%l3"
+  [(set_attr "type" "branch")])
+
+(define_insn ""
+  [(set (pc)
+	(if_then_else
+	 (match_operator 0 "comparison_operator"
+			 [(match_operand:SI 1 "arith_operand" "d")
+			  (match_operand:SI 2 "arith_operand" "dI")])
+	 (pc)
+	 (label_ref (match_operand 3 "" ""))))]
+  ""
+  "cmp%S0%B0%X0%+	%2,%1,%l3"
+  [(set_attr "type" "branch")])
+
+;; Now the trap instructions.  The i960 appears to only have conditional
+;; traps...
+
+(define_insn ("trap")
+  [(trap_if (const_int 1) (const_int 0))]
+  ""
+  "cmpo g0,g0 ; faulte.t")
+
+(define_expand "conditional_trap"
+  [(trap_if (match_operator 0 "comparison_operator"
+	     [(match_dup 2) (const_int 0)]) 
+	    (match_operand 1 "const_int_operand" "i"))]
+  ""
+  "
+{
+  operands[2] = gen_compare_reg (GET_CODE (operands[0]), 
+				 i960_compare_op0, i960_compare_op1);
+}")
+
+(define_insn ""
+  [(trap_if (match_operator 0 "comparison_operator"
+	     [(reg:CC 36) (const_int 0)]) 
+	    (match_operand 1 "const_int_operand" "i"))]
+  ""
+  "fault%C0.f")
+
+(define_insn ""
+  [(trap_if (match_operator 0 "comparison_operator"
+	     [(reg:CC_UNS 36) (const_int 0)]) 
+	    (match_operand 1 "const_int_operand" "i"))]
+  ""
+  "fault%C0.f")
+
+;; Normal move instructions.
+;; This code is based on the sparc machine description.
+
+(define_expand "movsi"
+  [(set (match_operand:SI 0 "general_operand" "")
+	(match_operand:SI 1 "general_operand" ""))]
+  ""
+  "
+{
+  if (emit_move_sequence (operands, SImode))
+    DONE;
+}")
+
+;; The store case can not be separate, because reload may convert a register
+;; to register move insn to a store (or load) insn without rerecognizing
+;; the insn.
+
+;; The i960 does not have any store constant to memory instruction.  However,
+;; the calling convention is defined so that the arg pointer when it is not
+;; overwise being used is zero.  Thus, we can handle store zero to memory
+;; by storing an unused arg pointer.  The arg pointer will be unused if
+;; current_function_args_size is zero and this is not a stdarg
+;; function.  This value of the former variable is not valid until after
+;; all rtl generation is complete, including function inlining (because a
+;; function that doesn't need an arg pointer may be inlined into a function
+;; that does need an arg pointer), so we must also check that
+;; rtx_equal_function_value_matters is zero.
+
+(define_insn ""
+  [(set (match_operand:SI 0 "general_operand" "=d,d,d,m")
+	(match_operand:SI 1 "general_operand" "dI,i,m,dJ"))]
+  "(current_function_args_size == 0
+    && current_function_stdarg == 0
+    && rtx_equal_function_value_matters == 0)
+   && (register_operand (operands[0], SImode)
+       || register_operand (operands[1], SImode)
+       || operands[1] == const0_rtx)"
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+      if (i960_last_insn_type == I_TYPE_REG && TARGET_C_SERIES)
+	{
+	  if (GET_CODE (operands[1]) == REG)
+	    return \"lda	(%1),%0\";
+	  else
+	    return \"lda	%1,%0\";
+	}
+      return \"mov	%1,%0\";
+    case 1:
+      return i960_output_ldconst (operands[0], operands[1]);
+    case 2:
+      return \"ld	%1,%0\";
+    case 3:
+      if (operands[1] == const0_rtx)
+	return \"st	g14,%0\";
+      return \"st	%1,%0\";      
+    default:
+      abort();
+    }
+}"
+  [(set_attr "type" "move,address,load,store")
+   (set_attr "length" "*,3,*,*")])
+
+(define_insn ""
+  [(set (match_operand:SI 0 "general_operand" "=d,d,d,m")
+	(match_operand:SI 1 "general_operand" "dI,i,m,d"))]
+  "(current_function_args_size != 0
+    || current_function_stdarg != 0
+    || rtx_equal_function_value_matters != 0)
+   && (register_operand (operands[0], SImode)
+       || register_operand (operands[1], SImode))"
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+      if (i960_last_insn_type == I_TYPE_REG && TARGET_C_SERIES)
+	{
+	  if (GET_CODE (operands[1]) == REG)
+	    return \"lda	(%1),%0\";
+	  else
+	    return \"lda	%1,%0\";
+	}
+      return \"mov	%1,%0\";
+    case 1:
+      return i960_output_ldconst (operands[0], operands[1]);
+    case 2:
+      return \"ld	%1,%0\";
+    case 3:
+      return \"st	%1,%0\";      
+    default:
+      abort();
+    }
+}"
+  [(set_attr "type" "move,address,load,store")
+   (set_attr "length" "*,3,*,*")])
+
+(define_expand "movhi"
+  [(set (match_operand:HI 0 "general_operand" "")
+	(match_operand:HI 1 "general_operand" ""))]
+  ""
+  "
+{
+  if (emit_move_sequence (operands, HImode))
+    DONE;
+}")
+
+;; Special pattern for zero stores to memory for functions which don't use
+;; the arg pointer.
+
+;; The store case can not be separate.  See above.
+(define_insn ""
+  [(set (match_operand:HI 0 "general_operand" "=d,d,d,m")
+	(match_operand:HI 1 "general_operand" "dI,i,m,dJ"))]
+  "(current_function_args_size == 0
+    && current_function_stdarg == 0
+    && rtx_equal_function_value_matters == 0)
+   && (register_operand (operands[0], HImode)
+       || register_operand (operands[1], HImode)
+       || operands[1] == const0_rtx)"
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+      if (i960_last_insn_type == I_TYPE_REG && TARGET_C_SERIES)
+	{
+	  if (GET_CODE (operands[1]) == REG)
+	    return \"lda	(%1),%0\";
+	  else
+	    return \"lda	%1,%0\";
+	}
+      return \"mov	%1,%0\";
+    case 1:
+      return i960_output_ldconst (operands[0], operands[1]);
+    case 2:
+      return \"ldos	%1,%0\";
+    case 3:
+      if (operands[1] == const0_rtx)
+	return \"stos	g14,%0\";
+      return \"stos	%1,%0\";
+    default:
+      abort();
+    }
+}"
+  [(set_attr "type" "move,misc,load,store")
+   (set_attr "length" "*,3,*,*")])
+
+;; The store case can not be separate.  See above.
+(define_insn ""
+  [(set (match_operand:HI 0 "general_operand" "=d,d,d,m")
+	(match_operand:HI 1 "general_operand" "dI,i,m,d"))]
+  "(current_function_args_size != 0
+    || current_function_stdarg != 0
+    || rtx_equal_function_value_matters != 0)
+   && (register_operand (operands[0], HImode)
+       || register_operand (operands[1], HImode))"
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+      if (i960_last_insn_type == I_TYPE_REG && TARGET_C_SERIES)
+	{
+	  if (GET_CODE (operands[1]) == REG)
+	    return \"lda	(%1),%0\";
+	  else
+	    return \"lda	%1,%0\";
+	}
+      return \"mov	%1,%0\";
+    case 1:
+      return i960_output_ldconst (operands[0], operands[1]);
+    case 2:
+      return \"ldos	%1,%0\";
+    case 3:
+      return \"stos	%1,%0\";
+    default:
+      abort();
+    }
+}"
+  [(set_attr "type" "move,misc,load,store")
+   (set_attr "length" "*,3,*,*")])
+
+(define_expand "movqi"
+  [(set (match_operand:QI 0 "general_operand" "")
+	(match_operand:QI 1 "general_operand" ""))]
+  ""
+  "
+{
+  if (emit_move_sequence (operands, QImode))
+    DONE;
+}")
+
+;; The store case can not be separate.  See comment above.
+(define_insn ""
+  [(set (match_operand:QI 0 "general_operand" "=d,d,d,m")
+	(match_operand:QI 1 "general_operand" "dI,i,m,dJ"))]
+  "(current_function_args_size == 0
+    && current_function_stdarg == 0
+    && rtx_equal_function_value_matters == 0)
+   && (register_operand (operands[0], QImode)
+       || register_operand (operands[1], QImode)
+       || operands[1] == const0_rtx)"
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+      if (i960_last_insn_type == I_TYPE_REG && TARGET_C_SERIES)
+	{
+	  if (GET_CODE (operands[1]) == REG)
+	    return \"lda	(%1),%0\";
+	  else
+	    return \"lda	%1,%0\";
+	}
+      return \"mov	%1,%0\";
+    case 1:
+      return i960_output_ldconst (operands[0], operands[1]);
+    case 2:
+      return \"ldob	%1,%0\";
+    case 3:
+      if (operands[1] == const0_rtx)
+	return \"stob	g14,%0\";
+      return \"stob	%1,%0\";
+    default:
+      abort();
+    }
+}"
+  [(set_attr "type" "move,misc,load,store")
+   (set_attr "length" "*,3,*,*")])
+
+;; The store case can not be separate.  See comment above.
+(define_insn ""
+  [(set (match_operand:QI 0 "general_operand" "=d,d,d,m")
+	(match_operand:QI 1 "general_operand" "dI,i,m,d"))]
+  "(current_function_args_size != 0
+    || current_function_stdarg != 0
+    || rtx_equal_function_value_matters != 0)
+   && (register_operand (operands[0], QImode)
+       || register_operand (operands[1], QImode))"
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+      if (i960_last_insn_type == I_TYPE_REG && TARGET_C_SERIES)
+	{
+	  if (GET_CODE (operands[1]) == REG)
+	    return \"lda	(%1),%0\";
+	  else
+	    return \"lda	%1,%0\";
+	}
+      return \"mov	%1,%0\";
+    case 1:
+      return i960_output_ldconst (operands[0], operands[1]);
+    case 2:
+      return \"ldob	%1,%0\";
+    case 3:
+      return \"stob	%1,%0\";
+    default:
+      abort();
+    }
+}"
+  [(set_attr "type" "move,misc,load,store")
+   (set_attr "length" "*,3,*,*")])
+
+(define_expand "movdi"
+  [(set (match_operand:DI 0 "general_operand" "")
+	(match_operand:DI 1 "general_operand" ""))]
+  ""
+  "
+{
+  if (emit_move_sequence (operands, DImode))
+    DONE;
+}")
+
+;; The store case can not be separate.  See comment above.
+(define_insn ""
+  [(set (match_operand:DI 0 "general_operand" "=d,d,d,d,m,o")
+	(match_operand:DI 1 "general_operand" "d,I,i,m,d,J"))]
+  "(current_function_args_size == 0
+    && current_function_stdarg == 0
+    && rtx_equal_function_value_matters == 0)
+   && (register_operand (operands[0], DImode)
+       || register_operand (operands[1], DImode)
+       || operands[1] == const0_rtx)"
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+    case 1:
+    case 3:
+    case 4:
+      return i960_output_move_double (operands[0], operands[1]);
+    case 2:
+      return i960_output_ldconst (operands[0], operands[1]);
+    case 5:
+       return i960_output_move_double_zero (operands[0]);
+    default:
+      abort();
+    }
+}"
+  [(set_attr "type" "move,move,load,load,store,store")])
+
+;; The store case can not be separate.  See comment above.
+(define_insn ""
+  [(set (match_operand:DI 0 "general_operand" "=d,d,d,d,m")
+	(match_operand:DI 1 "general_operand" "d,I,i,m,d"))]
+  "(current_function_args_size != 0
+    || current_function_stdarg != 0
+    || rtx_equal_function_value_matters != 0)
+   && (register_operand (operands[0], DImode)
+       || register_operand (operands[1], DImode))"
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+    case 1:
+    case 3:
+    case 4:
+      return i960_output_move_double (operands[0], operands[1]);
+    case 2:
+      return i960_output_ldconst (operands[0], operands[1]);
+    default:
+      abort();
+    }
+}"
+  [(set_attr "type" "move,move,load,load,store")])
+
+(define_insn "*store_unaligned_di_reg"
+  [(set (match_operand:DI 0 "general_operand" "=d,m")
+	(match_operand:DI 1 "register_operand" "d,d"))
+   (clobber (match_scratch:SI 2 "=X,&d"))]
+  ""
+  "*
+{
+  if (which_alternative == 0)
+    return i960_output_move_double (operands[0], operands[1]);
+    
+  operands[3] = gen_rtx_MEM (word_mode, operands[2]);
+  operands[4] = adjust_address (operands[3], word_mode, UNITS_PER_WORD);
+  return \"lda	%0,%2\;st	%1,%3\;st	%D1,%4\";
+}"
+  [(set_attr "type" "move,store")])
+
+(define_expand "movti"
+  [(set (match_operand:TI 0 "general_operand" "")
+	(match_operand:TI 1 "general_operand" ""))]
+  ""
+  "
+{
+  if (emit_move_sequence (operands, TImode))
+    DONE;
+}")
+
+;; The store case can not be separate.  See comment above.
+(define_insn ""
+  [(set (match_operand:TI 0 "general_operand" "=d,d,d,d,m,o")
+	(match_operand:TI 1 "general_operand" "d,I,i,m,d,J"))]
+  "(current_function_args_size == 0
+    && current_function_stdarg == 0
+    && rtx_equal_function_value_matters == 0)
+   && (register_operand (operands[0], TImode)
+       || register_operand (operands[1], TImode)
+       || operands[1] == const0_rtx)"
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+    case 1:
+    case 3:
+    case 4:
+      return i960_output_move_quad (operands[0], operands[1]);
+    case 2:
+      return i960_output_ldconst (operands[0], operands[1]);
+    case 5:
+      return i960_output_move_quad_zero (operands[0]);
+    default:
+      abort();
+    }
+}"
+  [(set_attr "type" "move,move,load,load,store,store")])
+
+;; The store case can not be separate.  See comment above.
+(define_insn ""
+  [(set (match_operand:TI 0 "general_operand" "=d,d,d,d,m")
+	(match_operand:TI 1 "general_operand" "d,I,i,m,d"))]
+  "(current_function_args_size != 0
+    || current_function_stdarg != 0
+    || rtx_equal_function_value_matters != 0)
+   && (register_operand (operands[0], TImode)
+       || register_operand (operands[1], TImode))"
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+    case 1:
+    case 3:
+    case 4:
+      return i960_output_move_quad (operands[0], operands[1]);
+    case 2:
+      return i960_output_ldconst (operands[0], operands[1]);
+    default:
+      abort();
+    }
+}"
+  [(set_attr "type" "move,move,load,load,store")])
+
+(define_insn "*store_unaligned_ti_reg"
+  [(set (match_operand:TI 0 "general_operand" "=d,m")
+	(match_operand:TI 1 "register_operand" "d,d"))
+   (clobber (match_scratch:SI 2 "=X,&d"))]
+  ""
+  "*
+{
+  if (which_alternative == 0)
+    return i960_output_move_quad (operands[0], operands[1]);
+
+  operands[3] = gen_rtx_MEM (word_mode, operands[2]);
+  operands[4] = adjust_address (operands[3], word_mode, UNITS_PER_WORD);
+  operands[5] = adjust_address (operands[4], word_mode, UNITS_PER_WORD);
+  operands[6] = adjust_address (operands[5], word_mode, UNITS_PER_WORD);
+  return \"lda	%0,%2\;st	%1,%3\;st	%D1,%4\;st	%E1,%5\;st	%F1,%6\";
+}"
+  [(set_attr "type" "move,store")])
+
+(define_expand "store_multiple"
+  [(set (match_operand:SI 0 "" "")	;;- dest
+	(match_operand:SI 1 "" ""))	;;- src
+   (use (match_operand:SI 2 "" ""))]	;;- nregs
+  ""
+  "
+{
+  int regno;
+  int count;
+  int offset = 0;
+
+  if (GET_CODE (operands[0]) != MEM
+      || GET_CODE (operands[1]) != REG
+      || GET_CODE (operands[2]) != CONST_INT)
+    FAIL;
+
+  count = INTVAL (operands[2]);
+  if (count > 12)
+    FAIL;
+
+  regno = REGNO (operands[1]);
+  while (count >= 4 && ((regno & 3) == 0))
+    {
+      emit_move_insn (adjust_address (operands[0], TImode, offset),
+		      gen_rtx_REG (TImode, regno));
+      count -= 4;
+      regno += 4;
+      offset += 16;
+    }
+  while (count >= 2 && ((regno & 1) == 0))
+    {
+      emit_move_insn (adjust_address (operands[0], DImode, offset),
+		      gen_rtx_REG (DImode, regno));
+      count -= 2;
+      regno += 2;
+      offset += 8;
+    }
+  while (count > 0)
+    {
+      emit_move_insn (adjust_address (operands[0], SImode, offset),
+		      gen_rtx_REG (SImode, regno));
+      count -= 1;
+      regno += 1;
+      offset += 4;
+    }
+  DONE;
+}")
+
+;; Floating point move insns
+
+(define_expand "movdf"
+  [(set (match_operand:DF 0 "general_operand" "")
+	(match_operand:DF 1 "fpmove_src_operand" ""))]
+  ""
+  "
+{
+  if (emit_move_sequence (operands, DFmode))
+    DONE;
+}")
+
+(define_insn ""
+  [(set (match_operand:DF 0 "general_operand" "=r,*f,d,d,m,o")
+	(match_operand:DF 1 "fpmove_src_operand" "r,GH,F,m,d,G"))]
+  "(current_function_args_size == 0
+    && current_function_stdarg == 0
+    && rtx_equal_function_value_matters == 0)
+   && (register_operand (operands[0], DFmode)
+       || register_operand (operands[1], DFmode)
+       || operands[1] == CONST0_RTX (DFmode))"
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+      if (FP_REG_P (operands[0]) || FP_REG_P (operands[1]))
+	return \"movrl	%1,%0\";
+      else
+	return \"movl	%1,%0\";
+    case 1:
+      return \"movrl	%1,%0\";
+    case 2:
+      return i960_output_ldconst (operands[0], operands[1]);
+    case 3:
+      return \"ldl	%1,%0\";
+    case 4:
+      return \"stl	%1,%0\";
+    case 5:
+      operands[1] = adjust_address (operands[0], VOIDmode, 4);
+      return \"st	g14,%0\;st	g14,%1\";
+    default:
+      abort();
+    }
+}"
+  [(set_attr "type" "move,move,load,fpload,fpstore,fpstore")])
+
+(define_insn ""
+  [(set (match_operand:DF 0 "general_operand" "=r,*f,d,d,m")
+	(match_operand:DF 1 "fpmove_src_operand" "r,GH,F,m,d"))]
+  "(current_function_args_size != 0
+    || current_function_stdarg != 0
+    || rtx_equal_function_value_matters != 0)
+   && (register_operand (operands[0], DFmode)
+       || register_operand (operands[1], DFmode))"
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+      if (FP_REG_P (operands[0]) || FP_REG_P (operands[1]))
+	return \"movrl	%1,%0\";
+      else
+	return \"movl	%1,%0\";
+    case 1:
+      return \"movrl	%1,%0\";
+    case 2:
+      return i960_output_ldconst (operands[0], operands[1]);
+    case 3:
+      return \"ldl	%1,%0\";
+    case 4:
+      return \"stl	%1,%0\";
+    default:
+      abort();
+    }
+}"
+  [(set_attr "type" "move,move,load,fpload,fpstore")])
+
+(define_expand "movsf"
+  [(set (match_operand:SF 0 "general_operand" "")
+	(match_operand:SF 1 "fpmove_src_operand" ""))]
+  ""
+  "
+{
+  if (emit_move_sequence (operands, SFmode))
+    DONE;
+}")
+
+(define_insn ""
+  [(set (match_operand:SF 0 "general_operand" "=r,*f,d,d,m")
+	(match_operand:SF 1 "fpmove_src_operand" "r,GH,F,m,dG"))]
+  "(current_function_args_size == 0
+    && current_function_stdarg == 0
+    && rtx_equal_function_value_matters == 0)
+   && (register_operand (operands[0], SFmode)
+       || register_operand (operands[1], SFmode)
+       || operands[1] == CONST0_RTX (SFmode))"
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+      if (FP_REG_P (operands[0]) || FP_REG_P (operands[1]))
+	return \"movr	%1,%0\";
+      else
+	return \"mov	%1,%0\";
+    case 1:
+      return \"movr	%1,%0\";
+    case 2:
+      return i960_output_ldconst (operands[0], operands[1]);
+    case 3:
+      return \"ld	%1,%0\";
+    case 4:
+      if (operands[1] == CONST0_RTX (SFmode))
+	return \"st	g14,%0\";
+      return \"st	%1,%0\";
+    default:
+      abort();
+    }
+}"
+  [(set_attr "type" "move,move,load,fpload,fpstore")])
+
+(define_insn ""
+  [(set (match_operand:SF 0 "general_operand" "=r,*f,d,d,m")
+	(match_operand:SF 1 "fpmove_src_operand" "r,GH,F,m,d"))]
+  "(current_function_args_size != 0
+    || current_function_stdarg != 0
+    || rtx_equal_function_value_matters != 0)
+   && (register_operand (operands[0], SFmode)
+       || register_operand (operands[1], SFmode))"
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+      if (FP_REG_P (operands[0]) || FP_REG_P (operands[1]))
+	return \"movr	%1,%0\";
+      else
+	return \"mov	%1,%0\";
+    case 1:
+      return \"movr	%1,%0\";
+    case 2:
+      return i960_output_ldconst (operands[0], operands[1]);
+    case 3:
+      return \"ld	%1,%0\";
+    case 4:
+      return \"st	%1,%0\";
+    default:
+      abort();
+    }
+}"
+  [(set_attr "type" "move,move,load,fpload,fpstore")])
+
+;; Mixed-mode moves with sign and zero-extension.
+
+;; Note that the one starting from HImode comes before those for QImode
+;; so that a constant operand will match HImode, not QImode.
+
+(define_expand "extendhisi2"
+  [(set (match_operand:SI 0 "register_operand" "")
+	(sign_extend:SI
+	 (match_operand:HI 1 "nonimmediate_operand" "")))]
+ ""
+ "
+{
+  if (GET_CODE (operand1) == REG
+      || (GET_CODE (operand1) == SUBREG
+	  && GET_CODE (XEXP (operand1, 0)) == REG))
+    {
+      rtx temp = gen_reg_rtx (SImode);
+      rtx shift_16 = GEN_INT (16);
+      int op1_subreg_byte = 0;
+
+      if (GET_CODE (operand1) == SUBREG)
+	{
+	  op1_subreg_byte = SUBREG_BYTE (operand1);
+	  op1_subreg_byte /= GET_MODE_SIZE (SImode);
+	  op1_subreg_byte *= GET_MODE_SIZE (SImode);
+	  operand1 = SUBREG_REG (operand1);
+	}
+      if (GET_MODE (operand1) != SImode)
+	operand1 = gen_rtx (SUBREG, SImode, operand1, op1_subreg_byte);
+
+      emit_insn (gen_ashlsi3 (temp, operand1, shift_16));
+      emit_insn (gen_ashrsi3 (operand0, temp, shift_16));
+      DONE;
+    }
+}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(sign_extend:SI (match_operand:HI 1 "memory_operand" "m")))]
+  ""
+  "ldis	%1,%0"
+  [(set_attr "type" "load")])
+
+(define_expand "extendqisi2"
+  [(set (match_operand:SI 0 "register_operand" "")
+	(sign_extend:SI (match_operand:QI 1 "nonimmediate_operand" "")))]
+  ""
+  "
+{
+  if (GET_CODE (operand1) == REG
+      || (GET_CODE (operand1) == SUBREG
+	  && GET_CODE (XEXP (operand1, 0)) == REG))
+    {
+      rtx temp = gen_reg_rtx (SImode);
+      rtx shift_24 = GEN_INT (24);
+      int op1_subreg_byte = 0;
+
+      if (GET_CODE (operand1) == SUBREG)
+	{
+	  op1_subreg_byte = SUBREG_BYTE (operand1);
+	  op1_subreg_byte /= GET_MODE_SIZE (SImode);
+	  op1_subreg_byte *= GET_MODE_SIZE (SImode);
+	  operand1 = SUBREG_REG (operand1);
+	}
+      if (GET_MODE (operand1) != SImode)
+	operand1 = gen_rtx (SUBREG, SImode, operand1, op1_subreg_byte);
+
+      emit_insn (gen_ashlsi3 (temp, operand1, shift_24));
+      emit_insn (gen_ashrsi3 (operand0, temp, shift_24));
+      DONE;
+    }
+}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(sign_extend:SI (match_operand:QI 1 "memory_operand" "m")))]
+  ""
+  "ldib	%1,%0"
+  [(set_attr "type" "load")])
+
+(define_expand "extendqihi2"
+  [(set (match_operand:HI 0 "register_operand" "")
+	(sign_extend:HI
+	 (match_operand:QI 1 "nonimmediate_operand" "")))]
+  ""
+  "
+{
+  if (GET_CODE (operand1) == REG
+      || (GET_CODE (operand1) == SUBREG
+	  && GET_CODE (XEXP (operand1, 0)) == REG))
+    {
+      rtx temp = gen_reg_rtx (SImode);
+      rtx shift_24 = GEN_INT (24);
+      int op0_subreg_byte = 0;
+      int op1_subreg_byte = 0;
+
+      if (GET_CODE (operand1) == SUBREG)
+	{
+	  op1_subreg_byte = SUBREG_BYTE (operand1);
+	  op1_subreg_byte /= GET_MODE_SIZE (SImode);
+	  op1_subreg_byte *= GET_MODE_SIZE (SImode);
+	  operand1 = SUBREG_REG (operand1);
+	}
+      if (GET_MODE (operand1) != SImode)
+	operand1 = gen_rtx (SUBREG, SImode, operand1, op1_subreg_byte);
+
+      if (GET_CODE (operand0) == SUBREG)
+	{
+	  op0_subreg_byte = SUBREG_BYTE (operand0);
+	  op0_subreg_byte /= GET_MODE_SIZE (SImode);
+	  op0_subreg_byte *= GET_MODE_SIZE (SImode);
+	  operand0 = SUBREG_REG (operand0);
+	}
+      if (GET_MODE (operand0) != SImode)
+	operand0 = gen_rtx_SUBREG (SImode, operand0, op0_subreg_byte);
+
+      emit_insn (gen_ashlsi3 (temp, operand1, shift_24));
+      emit_insn (gen_ashrsi3 (operand0, temp, shift_24));
+      DONE;
+    }
+}")
+
+(define_insn ""
+  [(set (match_operand:HI 0 "register_operand" "=d")
+	(sign_extend:HI (match_operand:QI 1 "memory_operand" "m")))]
+  ""
+  "ldib	%1,%0"
+  [(set_attr "type" "load")])
+
+(define_expand "zero_extendhisi2"
+  [(set (match_operand:SI 0 "register_operand" "")
+	(zero_extend:SI
+	 (match_operand:HI 1 "nonimmediate_operand" "")))]
+ ""
+ "
+{
+  if (GET_CODE (operand1) == REG
+      || (GET_CODE (operand1) == SUBREG
+	  && GET_CODE (XEXP (operand1, 0)) == REG))
+    {
+      rtx temp = gen_reg_rtx (SImode);
+      rtx shift_16 = GEN_INT (16);
+      int op1_subreg_byte = 0;
+
+      if (GET_CODE (operand1) == SUBREG)
+	{
+	  op1_subreg_byte = SUBREG_BYTE (operand1);
+	  op1_subreg_byte /= GET_MODE_SIZE (SImode);
+	  op1_subreg_byte *= GET_MODE_SIZE (SImode);
+	  operand1 = SUBREG_REG (operand1);
+	}
+      if (GET_MODE (operand1) != SImode)
+	operand1 = gen_rtx (SUBREG, SImode, operand1, op1_subreg_byte);
+
+      emit_insn (gen_ashlsi3 (temp, operand1, shift_16));
+      emit_insn (gen_lshrsi3 (operand0, temp, shift_16));
+      DONE;
+    }
+}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(zero_extend:SI (match_operand:HI 1 "memory_operand" "m")))]
+  ""
+  "ldos	%1,%0"
+  [(set_attr "type" "load")])
+
+;; Using shifts here generates much better code than doing an `and 255'.
+;; This is mainly because the `and' requires loading the constant separately,
+;; the constant is likely to get optimized, and then the compiler can't
+;; optimize the `and' because it doesn't know that one operand is a constant.
+
+(define_expand "zero_extendqisi2"
+  [(set (match_operand:SI 0 "register_operand" "")
+	(zero_extend:SI (match_operand:QI 1 "nonimmediate_operand" "")))]
+  ""
+  "
+{
+  if (GET_CODE (operand1) == REG
+      || (GET_CODE (operand1) == SUBREG
+	  && GET_CODE (XEXP (operand1, 0)) == REG))
+    {
+      rtx temp = gen_reg_rtx (SImode);
+      rtx shift_24 = GEN_INT (24);
+      int op1_subreg_byte = 0;
+
+      if (GET_CODE (operand1) == SUBREG)
+	{
+          op1_subreg_byte = SUBREG_BYTE (operand1);
+          op1_subreg_byte /= GET_MODE_SIZE (SImode);
+          op1_subreg_byte *= GET_MODE_SIZE (SImode);
+          operand1 = SUBREG_REG (operand1);
+	}
+      if (GET_MODE (operand1) != SImode)
+	operand1 = gen_rtx (SUBREG, SImode, operand1, op1_subreg_byte);
+
+      emit_insn (gen_ashlsi3 (temp, operand1, shift_24));
+      emit_insn (gen_lshrsi3 (operand0, temp, shift_24));
+      DONE;
+    }
+}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(zero_extend:SI (match_operand:QI 1 "memory_operand" "m")))]
+  ""
+  "ldob	%1,%0"
+  [(set_attr "type" "load")])
+
+(define_expand "zero_extendqihi2"
+  [(set (match_operand:HI 0 "register_operand" "")
+	(zero_extend:HI
+	 (match_operand:QI 1 "nonimmediate_operand" "")))]
+  ""
+  "
+{
+  if (GET_CODE (operand1) == REG
+      || (GET_CODE (operand1) == SUBREG
+	  && GET_CODE (XEXP (operand1, 0)) == REG))
+    {
+      rtx temp = gen_reg_rtx (SImode);
+      rtx shift_24 = GEN_INT (24);
+      int op0_subreg_byte = 0;
+      int op1_subreg_byte = 0;
+
+      if (GET_CODE (operand1) == SUBREG)
+	{
+	  op1_subreg_byte = SUBREG_BYTE (operand1);
+	  operand1 = SUBREG_REG (operand1);
+	}
+      if (GET_MODE (operand1) != SImode)
+	operand1 = gen_rtx (SUBREG, SImode, operand1, op1_subreg_byte);
+
+      if (GET_CODE (operand0) == SUBREG)
+	{
+	  op0_subreg_byte = SUBREG_BYTE (operand0);
+	  operand0 = SUBREG_REG (operand0);
+	}
+      if (GET_MODE (operand0) != SImode)
+	operand0 = gen_rtx_SUBREG (SImode, operand0, op0_subreg_byte);
+
+      emit_insn (gen_ashlsi3 (temp, operand1, shift_24));
+      emit_insn (gen_lshrsi3 (operand0, temp, shift_24));
+      DONE;
+    }
+}")
+
+(define_insn ""
+  [(set (match_operand:HI 0 "register_operand" "=d")
+	(zero_extend:HI (match_operand:QI 1 "memory_operand" "m")))]
+  ""
+  "ldob	%1,%0"
+  [(set_attr "type" "load")])
+
+;; Conversions between float and double.
+
+(define_insn "extendsfdf2"
+  [(set (match_operand:DF 0 "register_operand" "=*f,d")
+	(float_extend:DF (match_operand:SF 1 "fp_arith_operand" "dGH,fGH")))]
+  "TARGET_NUMERICS"
+  "@
+  movr	%1,%0
+  movrl	%1,%0"
+  [(set_attr "type" "fpmove")])
+
+(define_insn "truncdfsf2"
+  [(set (match_operand:SF 0 "register_operand" "=d")
+	(float_truncate:SF
+	 (match_operand:DF 1 "fp_arith_operand" "fGH")))]
+  "TARGET_NUMERICS"
+  "movr	%1,%0"
+  [(set_attr "type" "fpmove")])
+
+;; Conversion between fixed point and floating point.
+
+(define_insn "floatsidf2"
+  [(set (match_operand:DF 0 "register_operand" "=f")
+	(float:DF (match_operand:SI 1 "register_operand" "d")))]
+  "TARGET_NUMERICS"
+  "cvtir	%1,%0"
+  [(set_attr "type" "fpcvt")])
+
+(define_insn "floatsisf2"
+  [(set (match_operand:SF 0 "register_operand" "=d*f")
+	(float:SF (match_operand:SI 1 "register_operand" "d")))]
+  "TARGET_NUMERICS"
+  "cvtir	%1,%0"
+  [(set_attr "type" "fpcvt")])
+
+;; Convert a float to an actual integer.
+;; Truncation is performed as part of the conversion.
+;; The i960 requires conversion from DFmode to DImode to make
+;; unsigned conversions work properly.
+
+(define_insn "fixuns_truncdfdi2"
+  [(set (match_operand:DI 0 "register_operand" "=d")
+	(unsigned_fix:DI (fix:DF (match_operand:DF 1 "fp_arith_operand" "fGH"))))]
+  "TARGET_NUMERICS"
+  "cvtzril	%1,%0"
+  [(set_attr "type" "fpcvt")])
+
+(define_insn "fixuns_truncsfdi2"
+  [(set (match_operand:DI 0 "register_operand" "=d")
+	(unsigned_fix:DI (fix:SF (match_operand:SF 1 "fp_arith_operand" "fGH"))))]
+  "TARGET_NUMERICS"
+  "cvtzril	%1,%0"
+  [(set_attr "type" "fpcvt")])
+
+(define_insn "fix_truncdfsi2"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(fix:SI (fix:DF (match_operand:DF 1 "fp_arith_operand" "fGH"))))]
+  "TARGET_NUMERICS"
+  "cvtzri	%1,%0"
+  [(set_attr "type" "fpcvt")])
+
+(define_expand "fixuns_truncdfsi2"
+  [(set (match_operand:SI 0 "register_operand" "")
+	(unsigned_fix:SI (fix:DF (match_operand:DF 1 "fp_arith_operand" ""))))]
+  "TARGET_NUMERICS"
+  "
+{
+  rtx temp = gen_reg_rtx (DImode);
+  emit_insn (gen_rtx_SET (VOIDmode, temp,
+			  gen_rtx_UNSIGNED_FIX (DImode,
+						gen_rtx_FIX (DFmode,
+							     operands[1]))));
+  emit_insn (gen_rtx_SET (VOIDmode, operands[0],
+			  gen_rtx_SUBREG (SImode, temp, 0)));
+  DONE;
+}")
+
+(define_insn "fix_truncsfsi2"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(fix:SI (fix:SF (match_operand:SF 1 "fp_arith_operand" "dfGH"))))]
+  "TARGET_NUMERICS"
+  "cvtzri	%1,%0"
+  [(set_attr "type" "fpcvt")])
+
+(define_expand "fixuns_truncsfsi2"
+  [(set (match_operand:SI 0 "register_operand" "")
+	(unsigned_fix:SI (fix:SF (match_operand:SF 1 "fp_arith_operand" ""))))]
+  "TARGET_NUMERICS"
+  "
+{
+  rtx temp = gen_reg_rtx (DImode);
+  emit_insn (gen_rtx_SET (VOIDmode, temp,
+			  gen_rtx_UNSIGNED_FIX (DImode,
+						gen_rtx_FIX (SFmode,
+							     operands[1]))));
+  emit_insn (gen_rtx_SET (VOIDmode, operands[0],
+			  gen_rtx_SUBREG (SImode, temp, 0)));
+  DONE;
+}")
+
+;; Arithmetic instructions.
+
+(define_insn "subsi3"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(minus:SI (match_operand:SI 1 "arith_operand" "dI")
+		  (match_operand:SI 2 "arith_operand" "dI")))]
+  ""
+  "subo	%2,%1,%0")
+
+;; Try to generate an lda instruction when it would be faster than an
+;; add instruction.
+;; Some assemblers apparently won't accept two addresses added together.
+
+;; ??? The condition should be improved to reject the case of two
+;; symbolic constants.
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d,d,d")
+	(plus:SI (match_operand:SI 1 "arith32_operand" "%dn,i,dn")
+		 (match_operand:SI 2 "arith32_operand" "dn,dn,i")))]
+  "(TARGET_C_SERIES) && (CONSTANT_P (operands[1]) || CONSTANT_P (operands[2]))"
+  "*
+{
+  if (GET_CODE (operands[1]) == CONST_INT)
+    {
+      rtx tmp = operands[1];
+      operands[1] = operands[2];
+      operands[2] = tmp;
+    }
+  if (GET_CODE (operands[2]) == CONST_INT
+      && GET_CODE (operands[1]) == REG
+      && i960_last_insn_type != I_TYPE_REG)
+    {
+      if (INTVAL (operands[2]) < 0 && INTVAL (operands[2]) > -32)
+	return \"subo	%n2,%1,%0\";
+      else if (INTVAL (operands[2]) >= 0 && INTVAL (operands[2]) < 32)
+	return \"addo	%1,%2,%0\";
+    }
+  /* Non-canonical results (op1 == const, op2 != const) have been seen
+     in reload output when both operands were symbols before reload, so
+     we deal with it here.  This may be a fault of the constraints above.  */
+  if (CONSTANT_P (operands[1]))
+    {
+      if (CONSTANT_P (operands[2]))
+	return \"lda	%1+%2,%0\";
+      else
+	return \"lda	%1(%2),%0\";
+    }
+  return \"lda	%2(%1),%0\";
+}")
+
+(define_insn "addsi3"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(plus:SI (match_operand:SI 1 "signed_arith_operand" "%dI")
+		 (match_operand:SI 2 "signed_arith_operand" "dIK")))]
+  ""
+  "*
+{
+  if (GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) < 0)
+    return \"subo	%n2,%1,%0\";
+  if (i960_bypass (insn, operands[1], operands[2], 0))
+    return \"addo	%2,%1,%0\";
+  return \"addo	%1,%2,%0\";
+}")
+
+(define_insn "mulsi3"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(mult:SI (match_operand:SI 1 "arith_operand" "%dI")
+		 (match_operand:SI 2 "arith_operand" "dI")))]
+  ""
+  "*
+{
+  if (i960_bypass (insn, operands[1], operands[2], 0))
+    return \"mulo	%2,%1,%0\";
+  return \"mulo	%1,%2,%0\";
+}"
+  [(set_attr "type" "mult")])
+
+(define_insn "umulsidi3"
+  [(set (match_operand:DI 0 "register_operand" "=d")
+	(mult:DI (zero_extend:DI (match_operand:SI 1 "register_operand" "d"))
+		 (zero_extend:DI (match_operand:SI 2 "register_operand" "d"))))]
+  ""
+  "*
+{
+  if (i960_bypass (insn, operands[1], operands[2], 0))
+    return \"emul	%2,%1,%0\";
+  return \"emul	%1,%2,%0\";
+}"
+  [(set_attr "type" "mult")])
+
+(define_insn ""
+  [(set (match_operand:DI 0 "register_operand" "=d")
+	(mult:DI (zero_extend:DI (match_operand:SI 1 "register_operand" "%d"))
+		 (match_operand:SI 2 "literal" "I")))]
+  ""
+  "*
+{
+  if (i960_bypass (insn, operands[1], operands[2], 0))
+    return \"emul	%2,%1,%0\";
+  return \"emul	%1,%2,%0\";
+}"
+  [(set_attr "type" "mult")])
+
+;; This goes after the move/add/sub/mul instructions  
+;; because those instructions are better when they apply.
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(match_operand:SI 1 "address_operand" "p"))]
+  ""
+  "lda	%a1,%0"
+  [(set_attr "type" "load")])
+
+;; This will never be selected because of an "optimization" that GCC does.
+;; It always converts divides by a power of 2 into a sequence of instructions
+;; that does a right shift, and then corrects the result if it was negative.
+
+;; (define_insn ""
+;;   [(set (match_operand:SI 0 "register_operand" "=d")
+;;         (div:SI (match_operand:SI 1 "arith_operand" "dI")
+;;                 (match_operand:SI 2 "power2_operand" "nI")))]
+;;   ""
+;;   "*{
+;; 	operands[2] = GEN_INT (bitpos (INTVAL (operands[2])));
+;; 	return \"shrdi	%2,%1,%0\";
+;;   }"
+
+(define_insn "divsi3"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+        (div:SI (match_operand:SI 1 "arith_operand" "dI")
+                (match_operand:SI 2 "arith_operand" "dI")))]
+  ""
+  "divi	%2,%1,%0"
+  [(set_attr "type" "div")])
+
+(define_insn "udivsi3"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+        (udiv:SI (match_operand:SI 1 "arith_operand" "dI")
+		 (match_operand:SI 2 "arith_operand" "dI")))]
+  ""
+  "divo	%2,%1,%0"
+  [(set_attr "type" "div")])
+
+;; We must use `remi' not `modi' here, to ensure that `%' has the effects
+;; specified by the ANSI C standard.
+
+(define_insn "modsi3"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+        (mod:SI (match_operand:SI 1 "arith_operand" "dI")
+                (match_operand:SI 2 "arith_operand" "dI")))]
+  ""
+  "remi	%2,%1,%0"
+  [(set_attr "type" "div")])
+
+(define_insn "umodsi3"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+        (umod:SI (match_operand:SI 1 "arith_operand" "dI")
+		 (match_operand:SI 2 "arith_operand" "dI")))]
+  ""
+  "remo	%2,%1,%0"
+  [(set_attr "type" "div")])
+
+;; And instructions (with complement also).
+
+(define_insn "andsi3"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(and:SI (match_operand:SI 1 "register_operand" "%d")
+		(match_operand:SI 2 "logic_operand" "dIM")))]
+  ""
+  "*
+{
+  if (GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) < 0)
+    return \"andnot	%C2,%1,%0\";
+  if (i960_bypass (insn, operands[1], operands[2], 0))
+    return \"and	%2,%1,%0\";
+  return \"and	%1,%2,%0\";
+}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(and:SI (match_operand:SI 1 "arith_operand" "dI")
+		(match_operand:SI 2 "cmplpower2_operand" "n")))]
+  ""
+  "*
+{
+  operands[2] = GEN_INT (bitpos (~INTVAL (operands[2])));
+  return \"clrbit	%2,%1,%0\";
+}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(and:SI (not:SI (match_operand:SI 1 "register_operand" "d"))
+		(match_operand:SI 2 "logic_operand" "dIM")))]
+  ""
+  "*
+{
+  if (GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) < 0)
+    return \"nor	%C2,%1,%0\";
+  if (i960_bypass (insn, operands[1], operands[2], 0))
+    return \"notand	%2,%1,%0\";
+  return \"andnot	%1,%2,%0\";
+}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(ior:SI (not:SI (match_operand:SI 1 "register_operand" "%d"))
+		(not:SI (match_operand:SI 2 "register_operand" "d"))))]
+  ""
+  "*
+{
+  if (i960_bypass (insn, operands[1], operands[2], 0))
+    return \"nand	%2,%1,%0\";
+  return \"nand	%1,%2,%0\";
+}")
+
+(define_insn "iorsi3"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(ior:SI (match_operand:SI 1 "register_operand" "%d")
+		(match_operand:SI 2 "logic_operand" "dIM")))]
+  ""
+  "*
+{
+  if (GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) < 0)
+    return \"ornot	%C2,%1,%0\";
+  if (i960_bypass (insn, operands[1], operands[2], 0))
+    return \"or	%2,%1,%0\";
+  return \"or	%1,%2,%0\";
+}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(ior:SI (match_operand:SI 1 "register_operand" "d")
+		(match_operand:SI 2 "power2_operand" "n")))]
+  ""
+  "*
+{
+  operands[2] = GEN_INT (bitpos (INTVAL (operands[2])));
+  return \"setbit	%2,%1,%0\";
+}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(ior:SI (not:SI (match_operand:SI 1 "register_operand" "d"))
+		(match_operand:SI 2 "logic_operand" "dIM")))]
+  ""
+  "*
+{
+  if (GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) < 0)
+    return \"nand	%C2,%1,%0\";
+  if (i960_bypass (insn, operands[1], operands[2], 0))
+    return \"notor	%2,%1,%0\";
+  return \"ornot	%1,%2,%0\";
+}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(and:SI (not:SI (match_operand:SI 1 "register_operand" "%d"))
+		(not:SI (match_operand:SI 2 "register_operand" "d"))))]
+  ""
+  "*
+{
+  if (i960_bypass (insn, operands[1], operands[2], 0))
+    return \"nor	%2,%1,%0\";
+  return \"nor	%1,%2,%0\";
+}")
+
+(define_insn "xorsi3"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(xor:SI (match_operand:SI 1 "register_operand" "%d")
+		(match_operand:SI 2 "logic_operand" "dIM")))]
+  ""
+  "*
+{
+  if (GET_CODE (operands[2]) == CONST_INT && INTVAL (operands[2]) < 0)
+    return \"xnor	%C2,%1,%0\";
+  if (i960_bypass (insn, operands[1], operands[2], 0))
+    return \"xor	%2,%1,%0\";
+  return \"xor	%1,%2,%0\";
+}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(xor:SI (match_operand:SI 1 "arith_operand" "dI")
+		(match_operand:SI 2 "power2_operand" "n")))]
+  ""
+  "*
+{
+  operands[2] = GEN_INT (bitpos (INTVAL (operands[2])));
+  return \"notbit	%2,%1,%0\";
+}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(not:SI (xor:SI (match_operand:SI 1 "register_operand" "%d")
+			(match_operand:SI 2 "register_operand" "d"))))]
+  ""
+  "*
+{
+  if (i960_bypass (insn, operands[1], operands[2], 0))
+    return \"xnor	%2,%1,%0\";
+  return \"xnor	%2,%1,%0\";
+}")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(ior:SI (ashift:SI (const_int 1)
+			   (match_operand:SI 1 "register_operand" "d"))
+		(match_operand:SI 2 "arith_operand" "dI")))]
+  ""
+  "setbit	%1,%2,%0")
+
+;; (not (ashift 1 reg)) canonicalizes to (rotate -2 reg)
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(and:SI (rotate:SI (const_int -2)
+			   (match_operand:SI 1 "register_operand" "d"))
+		(match_operand:SI 2 "register_operand" "d")))]
+  ""
+  "clrbit	%1,%2,%0")
+
+;; The above pattern canonicalizes to this when both the input and output
+;; are the same pseudo-register.
+(define_insn ""
+  [(set (zero_extract:SI (match_operand:SI 0 "register_operand" "+d")
+			 (const_int 1)
+			 (match_operand:SI 1 "register_operand" "d"))
+	(const_int 0))]
+  ""
+  "clrbit	%1,%0,%0")
+
+(define_insn ""
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(xor:SI (ashift:SI (const_int 1)
+			   (match_operand:SI 1 "register_operand" "d"))
+		(match_operand:SI 2 "arith_operand" "dI")))]
+  ""
+  "notbit	%1,%2,%0")
+
+(define_insn "negsi2"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(neg:SI (match_operand:SI 1 "arith_operand" "dI")))]
+  ""
+  "subo	%1,0,%0"
+  [(set_attr "length" "1")])
+
+(define_insn "one_cmplsi2"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(not:SI (match_operand:SI 1 "arith_operand" "dI")))]
+  ""
+  "not	%1,%0"
+  [(set_attr "length" "1")])
+
+;; Floating point arithmetic instructions.
+
+(define_insn "adddf3"
+  [(set (match_operand:DF 0 "register_operand" "=d*f")
+	(plus:DF (match_operand:DF 1 "fp_arith_operand" "%rGH")
+		 (match_operand:DF 2 "fp_arith_operand" "rGH")))]
+  "TARGET_NUMERICS"
+  "addrl	%1,%2,%0"
+  [(set_attr "type" "fpadd")])
+
+(define_insn "addsf3"
+  [(set (match_operand:SF 0 "register_operand" "=d*f")
+	(plus:SF (match_operand:SF 1 "fp_arith_operand" "%rGH")
+		 (match_operand:SF 2 "fp_arith_operand" "rGH")))]
+  "TARGET_NUMERICS"
+  "addr	%1,%2,%0"
+  [(set_attr "type" "fpadd")])
+
+
+(define_insn "subdf3"
+  [(set (match_operand:DF 0 "register_operand" "=d*f")
+	(minus:DF (match_operand:DF 1 "fp_arith_operand" "rGH")
+		  (match_operand:DF 2 "fp_arith_operand" "rGH")))]
+  "TARGET_NUMERICS"
+  "subrl	%2,%1,%0"
+  [(set_attr "type" "fpadd")])
+
+(define_insn "subsf3"
+  [(set (match_operand:SF 0 "register_operand" "=d*f")
+	(minus:SF (match_operand:SF 1 "fp_arith_operand" "rGH")
+		  (match_operand:SF 2 "fp_arith_operand" "rGH")))]
+  "TARGET_NUMERICS"
+  "subr	%2,%1,%0"
+  [(set_attr "type" "fpadd")])
+
+
+(define_insn "muldf3"
+  [(set (match_operand:DF 0 "register_operand" "=d*f")
+	(mult:DF (match_operand:DF 1 "fp_arith_operand" "%rGH")
+		 (match_operand:DF 2 "fp_arith_operand" "rGH")))]
+  "TARGET_NUMERICS"
+  "mulrl	%1,%2,%0"
+  [(set_attr "type" "fpmul")])
+
+(define_insn "mulsf3"
+  [(set (match_operand:SF 0 "register_operand" "=d*f")
+	(mult:SF (match_operand:SF 1 "fp_arith_operand" "%rGH")
+		 (match_operand:SF 2 "fp_arith_operand" "rGH")))]
+  "TARGET_NUMERICS"
+  "mulr	%1,%2,%0"
+  [(set_attr "type" "fpmul")])
+
+
+(define_insn "divdf3"
+  [(set (match_operand:DF 0 "register_operand" "=d*f")
+	(div:DF (match_operand:DF 1 "fp_arith_operand" "rGH")
+		(match_operand:DF 2 "fp_arith_operand" "rGH")))]
+  "TARGET_NUMERICS"
+  "divrl	%2,%1,%0"
+  [(set_attr "type" "fpdiv")])
+
+(define_insn "divsf3"
+  [(set (match_operand:SF 0 "register_operand" "=d*f")
+	(div:SF (match_operand:SF 1 "fp_arith_operand" "rGH")
+		(match_operand:SF 2 "fp_arith_operand" "rGH")))]
+  "TARGET_NUMERICS"
+  "divr	%2,%1,%0"
+  [(set_attr "type" "fpdiv")])
+
+(define_insn "negdf2"
+  [(set (match_operand:DF 0 "register_operand" "=d,d*f")
+	(neg:DF (match_operand:DF 1 "register_operand" "d,r")))]
+  ""
+  "*
+{
+  if (which_alternative == 0)
+    {
+      if (REGNO (operands[0]) == REGNO (operands[1]))
+	return \"notbit	31,%D1,%D0\";
+      return \"mov	%1,%0\;notbit	31,%D1,%D0\";
+    }
+  return \"subrl	%1,0f0.0,%0\";
+}"
+  [(set_attr "type" "fpadd")])
+
+(define_insn "negsf2"
+  [(set (match_operand:SF 0 "register_operand" "=d,d*f")
+	(neg:SF (match_operand:SF 1 "register_operand" "d,r")))]
+  ""
+  "@
+  notbit	31,%1,%0
+  subr	%1,0f0.0,%0"
+  [(set_attr "type" "fpadd")])
+
+;;; The abs patterns also work even if the target machine doesn't have
+;;; floating point, because in that case dstreg and srcreg will always be
+;;; less than 32.
+
+(define_insn "absdf2"
+  [(set (match_operand:DF 0 "register_operand" "=d*f")
+	(abs:DF (match_operand:DF 1 "register_operand" "df")))]
+  ""
+  "*
+{
+  int dstreg = REGNO (operands[0]);
+  int srcreg = REGNO (operands[1]);
+
+  if (dstreg < 32)
+    {
+      if (srcreg < 32)
+	{
+	  if (dstreg != srcreg)
+	    output_asm_insn (\"mov	%1,%0\", operands);
+	  return \"clrbit	31,%D1,%D0\";
+	}
+      /* Src is an fp reg.  */
+      return \"movrl	%1,%0\;clrbit	31,%D1,%D0\";
+    }
+  if (srcreg >= 32)
+    return \"cpysre	%1,0f0.0,%0\";
+  return \"movrl	%1,%0\;cpysre	%0,0f0.0,%0\";
+}"
+  [(set_attr "type" "multi")])
+
+(define_insn "abssf2"
+  [(set (match_operand:SF 0 "register_operand" "=d*f")
+	(abs:SF (match_operand:SF 1 "register_operand" "df")))]
+  ""
+  "*
+{
+  int dstreg = REGNO (operands[0]);
+  int srcreg = REGNO (operands[1]);
+
+  if (dstreg < 32 && srcreg < 32)
+    return \"clrbit	31,%1,%0\";
+
+  if (dstreg >= 32 && srcreg >= 32)
+    return \"cpysre	%1,0f0.0,%0\";
+
+  if (dstreg < 32)
+    return \"movr	%1,%0\;clrbit	31,%0,%0\";
+
+  return \"movr	%1,%0\;cpysre	%0,0f0.0,%0\";
+}"
+  [(set_attr "type" "multi")])
+
+;; Tetra (16 byte) float support.
+
+(define_expand "cmptf"
+  [(set (reg:CC 36)
+	(compare:CC (match_operand:TF 0 "register_operand" "")
+		    (match_operand:TF 1 "nonmemory_operand" "")))]
+  "TARGET_NUMERICS"
+  "
+{
+  i960_compare_op0 = operands[0];
+  i960_compare_op1 = operands[1];
+  DONE;
+}")
+
+(define_insn ""
+  [(set (reg:CC 36)
+	(compare:CC (match_operand:TF 0 "register_operand" "f")
+		    (match_operand:TF 1 "nonmemory_operand" "fGH")))]
+  "TARGET_NUMERICS"
+  "cmpr %0,%1"
+  [(set_attr "type" "fpcc")])
+
+(define_expand "movtf"
+  [(set (match_operand:TF 0 "general_operand" "")
+	(match_operand:TF 1 "fpmove_src_operand" ""))]
+  ""
+  "
+{
+  if (emit_move_sequence (operands, TFmode))
+    DONE;
+}")
+
+(define_insn ""
+  [(set (match_operand:TF 0 "general_operand" "=r,f,d,d,m")
+	(match_operand:TF 1 "fpmove_src_operand" "r,GH,F,m,d"))]
+  "register_operand (operands[0], TFmode)
+   || register_operand (operands[1], TFmode)"
+  "*
+{
+  switch (which_alternative)
+    {
+    case 0:
+      if (FP_REG_P (operands[0]) || FP_REG_P (operands[1]))
+	return \"movre	%1,%0\";
+      else
+	return \"movq	%1,%0\";
+    case 1:
+      return \"movre	%1,%0\";
+    case 2:
+      return i960_output_ldconst (operands[0], operands[1]);
+    case 3:
+      return \"ldt	%1,%0\";
+    case 4:
+      return \"stt	%1,%0\";
+    default:
+      abort();
+    }
+}"
+  [(set_attr "type" "move,move,load,fpload,fpstore")])
+
+(define_insn "extendsftf2"
+  [(set (match_operand:TF 0 "register_operand" "=f,d")
+	(float_extend:TF
+	 (match_operand:SF 1 "register_operand" "d,f")))]
+  "TARGET_NUMERICS"
+  "@
+  movr	%1,%0
+  movre	%1,%0"
+  [(set_attr "type" "fpmove")])
+
+(define_insn "extenddftf2"
+  [(set (match_operand:TF 0 "register_operand" "=f,d")
+	(float_extend:TF
+	 (match_operand:DF 1 "register_operand" "d,f")))]
+  "TARGET_NUMERICS"
+  "@
+  movrl	%1,%0
+  movre	%1,%0"
+  [(set_attr "type" "fpmove")])
+
+(define_insn "trunctfdf2"
+  [(set (match_operand:DF 0 "register_operand" "=d")
+	(float_truncate:DF
+	 (match_operand:TF 1 "register_operand" "f")))]
+  "TARGET_NUMERICS"
+  "movrl	%1,%0"
+  [(set_attr "type" "fpmove")])
+
+(define_insn "trunctfsf2"
+  [(set (match_operand:SF 0 "register_operand" "=d")
+	(float_truncate:SF
+	 (match_operand:TF 1 "register_operand" "f")))]
+  "TARGET_NUMERICS"
+  "movr	%1,%0"
+  [(set_attr "type" "fpmove")])
+
+(define_insn "floatsitf2"
+  [(set (match_operand:TF 0 "register_operand" "=f")
+	(float:TF (match_operand:SI 1 "register_operand" "d")))]
+  "TARGET_NUMERICS"
+  "cvtir	%1,%0"
+  [(set_attr "type" "fpcvt")])
+
+(define_insn "fix_trunctfsi2"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(fix:SI (fix:TF (match_operand:TF 1 "register_operand" "f"))))]
+  "TARGET_NUMERICS"
+  "cvtzri	%1,%0"
+  [(set_attr "type" "fpcvt")])
+
+(define_insn "fixuns_trunctfsi2"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(unsigned_fix:SI (fix:TF (match_operand:TF 1 "register_operand" "f"))))]
+  "TARGET_NUMERICS"
+  "cvtzri	%1,%0"
+  [(set_attr "type" "fpcvt")])
+
+(define_insn "addtf3"
+  [(set (match_operand:TF 0 "register_operand" "=f")
+	(plus:TF (match_operand:TF 1 "nonmemory_operand" "%fGH")
+		 (match_operand:TF 2 "nonmemory_operand" "fGH")))]
+  "TARGET_NUMERICS"
+  "addr	%1,%2,%0"
+  [(set_attr "type" "fpadd")])
+
+(define_insn "subtf3"
+  [(set (match_operand:TF 0 "register_operand" "=f")
+	(minus:TF (match_operand:TF 1 "nonmemory_operand" "fGH")
+		  (match_operand:TF 2 "nonmemory_operand" "fGH")))]
+  "TARGET_NUMERICS"
+  "subr	%2,%1,%0"
+  [(set_attr "type" "fpadd")])
+
+(define_insn "multf3"
+  [(set (match_operand:TF 0 "register_operand" "=f")
+	(mult:TF (match_operand:TF 1 "nonmemory_operand" "%fGH")
+		 (match_operand:TF 2 "nonmemory_operand" "fGH")))]
+  "TARGET_NUMERICS"
+  "mulr	%1,%2,%0"
+  [(set_attr "type" "fpmul")])
+
+(define_insn "divtf3"
+  [(set (match_operand:TF 0 "register_operand" "=f")
+	(div:TF (match_operand:TF 1 "nonmemory_operand" "fGH")
+		(match_operand:TF 2 "nonmemory_operand" "fGH")))]
+  "TARGET_NUMERICS"
+  "divr	%2,%1,%0"
+  [(set_attr "type" "fpdiv")])
+
+(define_insn "negtf2"
+  [(set (match_operand:TF 0 "register_operand" "=f")
+	(neg:TF (match_operand:TF 1 "register_operand" "f")))]
+  "TARGET_NUMERICS"
+  "subr	%1,0f0.0,%0"
+  [(set_attr "type" "fpadd")])
+
+(define_insn "abstf2"
+  [(set (match_operand:TF 0 "register_operand" "=f")
+	(abs:TF (match_operand:TF 1 "register_operand" "f")))]
+  "(TARGET_NUMERICS)"
+  "cpysre	%1,0f0.0,%0"
+  [(set_attr "type" "fpmove")])
+
+;; Arithmetic shift instructions.
+
+;; The shli instruction generates an overflow fault if the sign changes.
+;; In the case of overflow, it does not give the natural result, it instead
+;; gives the last shift value before the overflow.  We can not use this
+;; instruction because gcc thinks that arithmetic left shift and logical
+;; left shift are identical, and sometimes canonicalizes the logical left
+;; shift to an arithmetic left shift.  Therefore we must always use the
+;; logical left shift instruction.
+
+(define_insn "ashlsi3"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(ashift:SI (match_operand:SI 1 "arith_operand" "dI")
+		   (match_operand:SI 2 "arith_operand" "dI")))]
+  ""
+  "shlo	%2,%1,%0"
+  [(set_attr "type" "alu2")])
+
+(define_insn "ashrsi3"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(ashiftrt:SI (match_operand:SI 1 "arith_operand" "dI")
+		     (match_operand:SI 2 "arith_operand" "dI")))]
+  ""
+  "shri	%2,%1,%0"
+  [(set_attr "type" "alu2")])
+
+(define_insn "lshrsi3"
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(lshiftrt:SI (match_operand:SI 1 "arith_operand" "dI")
+		   (match_operand:SI 2 "arith_operand" "dI")))]
+  ""
+  "shro	%2,%1,%0"
+  [(set_attr "type" "alu2")])
+
+;; Unconditional and other jump instructions.
+
+(define_insn "jump"
+  [(set (pc)
+	(label_ref (match_operand 0 "" "")))]
+  ""
+  "b	%l0"
+  [(set_attr "type" "branch")])
+
+(define_insn "indirect_jump"
+  [(set (pc) (match_operand:SI 0 "address_operand" "p"))]
+  ""
+  "bx	%a0"
+  [(set_attr "type" "branch")])
+
+(define_insn "tablejump"
+  [(set (pc) (match_operand:SI 0 "register_operand" "d"))
+   (use (label_ref (match_operand 1 "" "")))]
+  ""
+  "*
+{
+  if (flag_pic)
+    return \"bx	%l1(%0)\";
+  else
+    return \"bx	(%0)\";
+}"
+  [(set_attr "type" "branch")])
+
+;;- jump to subroutine
+
+(define_expand "call"
+  [(call (match_operand:SI 0 "memory_operand" "m")
+	 (match_operand:SI 1 "immediate_operand" "i"))]
+  ""
+  "
+{
+  emit_call_insn (gen_call_internal (operands[0], operands[1],
+				     virtual_outgoing_args_rtx));
+  DONE;
+}")
+
+;; We need a call saved register allocated for the match_scratch, so we use
+;; 'l' because all local registers are call saved.
+
+;; ??? I would prefer to use a match_scratch here, but match_scratch allocated
+;; registers can't be used for spills.  In a function with lots of calls,
+;; local-alloc may allocate all local registers to a match_scratch, leaving
+;; no local registers available for spills.
+
+(define_insn "call_internal"
+  [(call (match_operand:SI 0 "memory_operand" "m")
+	 (match_operand:SI 1 "immediate_operand" "i"))
+   (use (match_operand:SI 2 "address_operand" "p"))
+   (clobber (reg:SI 19))]
+  ""
+  "* return i960_output_call_insn (operands[0], operands[1], operands[2],
+				   insn);"
+  [(set_attr "type" "call")])
+
+(define_expand "call_value"
+  [(set (match_operand 0 "register_operand" "=d")
+	(call (match_operand:SI 1 "memory_operand" "m")
+	      (match_operand:SI 2 "immediate_operand" "i")))]
+  ""
+  "
+{
+  emit_call_insn (gen_call_value_internal (operands[0], operands[1],
+					   operands[2],
+				           virtual_outgoing_args_rtx));
+  DONE;
+}")
+
+;; We need a call saved register allocated for the match_scratch, so we use
+;; 'l' because all local registers are call saved.
+
+(define_insn "call_value_internal"
+  [(set (match_operand 0 "register_operand" "=d")
+	(call (match_operand:SI 1 "memory_operand" "m")
+	      (match_operand:SI 2 "immediate_operand" "i")))
+   (use (match_operand:SI 3 "address_operand" "p"))
+   (clobber (reg:SI 19))]
+  ""
+  "* return i960_output_call_insn (operands[1], operands[2], operands[3],
+				   insn);"
+  [(set_attr "type" "call")])
+
+(define_insn "return"
+  [(return)]
+  ""
+  "* return i960_output_ret_insn (insn);"
+  [(set_attr "type" "branch")])
+
+;; A return instruction.  Used only by nonlocal_goto to change the
+;; stack pointer, frame pointer, previous frame pointer and the return
+;; instruction pointer.
+(define_insn "ret"
+  [(set (pc) (unspec_volatile [(reg:SI 16)] 3))]
+  ""
+  "ret"
+  [(set_attr "type" "branch")
+   (set_attr "length" "1")])
+
+(define_expand "nonlocal_goto"
+  [(match_operand:SI 0 "" "")
+   (match_operand:SI 1 "general_operand" "")
+   (match_operand:SI 2 "general_operand" "")
+   (match_operand:SI 3 "general_operand" "")]
+  ""
+  "
+{
+  rtx chain = operands[0];
+  rtx handler = operands[1];
+  rtx stack = operands[2];
+
+  /* We must restore the stack pointer, frame pointer, previous frame
+     pointer and the return instruction pointer.  Since the ret
+     instruction does all this for us with one instruction, we arrange
+     everything so that ret will do everything we need done.  */
+
+  /* First, we must flush the register windows, so that we can modify
+     the saved local registers on the stack directly and because we
+     are going to change the previous frame pointer.  */
+
+  emit_insn (gen_flush_register_windows ());
+
+  /* Load the static chain value for the containing fn into fp.  This is needed
+     because STACK refers to fp.  */
+  emit_move_insn (hard_frame_pointer_rtx, chain);
+
+  /* Now move the adjusted value into the pfp register for the following return
+     instruction.  */
+  emit_move_insn (gen_rtx (REG, SImode, 16),
+		  plus_constant (hard_frame_pointer_rtx, -64));
+
+  /* Next, we put the address that we want to transfer to, into the
+     saved $rip value in the frame.  Once we ret below, that value
+     will be loaded into the pc (IP).  */
+
+  emit_move_insn (gen_rtx (MEM, SImode,
+			   plus_constant (hard_frame_pointer_rtx, -56)),
+		  handler);
+
+  /* Next, we put stack into the saved $sp value in the frame.  */
+  emit_move_insn (gen_rtx (MEM, SImode,
+			   plus_constant (hard_frame_pointer_rtx, -60)),
+		  stack);
+
+  /* And finally, we can now just ret to get all the values saved
+     above into all the right registers, and also, all the local
+     register that were in use in the function, are restored from
+     their saved values (from the call instruction) on the stack
+     because we are very careful to ret from the exact save area in
+     use during the original call.  */
+
+  emit_jump_insn (gen_ret ());
+  emit_barrier ();
+  DONE;
+}")
+
+;; Special insn to flush register windows.
+(define_insn "flush_register_windows"
+  [(unspec_volatile [(const_int 0)] 1)]
+  ""
+  "flushreg"
+  [(set_attr "type" "misc")
+   (set_attr "length" "1")])
+
+(define_insn "nop"
+  [(const_int 0)]
+  ""
+  "")
+
+;; Various peephole optimizations for multiple-word moves, loads, and stores.
+;; Multiple register moves.
+
+;; Matched 5/28/91
+(define_peephole
+  [(set (match_operand:SI 0 "register_operand" "=r")
+	(match_operand:SI 1 "register_operand" "r"))
+   (set (match_operand:SI 2 "register_operand" "=r")
+	(match_operand:SI 3 "register_operand" "r"))
+   (set (match_operand:SI 4 "register_operand" "=r")
+	(match_operand:SI 5 "register_operand" "r"))
+   (set (match_operand:SI 6 "register_operand" "=r")
+	(match_operand:SI 7 "register_operand" "r"))]
+  "((REGNO (operands[0]) & 3) == 0)
+   && ((REGNO (operands[1]) & 3) == 0)
+   && (REGNO (operands[0]) + 1 == REGNO (operands[2]))
+   && (REGNO (operands[1]) + 1 == REGNO (operands[3]))
+   && (REGNO (operands[0]) + 2 == REGNO (operands[4]))
+   && (REGNO (operands[1]) + 2 == REGNO (operands[5]))
+   && (REGNO (operands[0]) + 3 == REGNO (operands[6]))
+   && (REGNO (operands[1]) + 3 == REGNO (operands[7]))"
+  "movq	%1,%0")
+
+;; Matched 4/17/92
+(define_peephole
+  [(set (match_operand:DI 0 "register_operand" "=r")
+	(match_operand:DI 1 "register_operand" "r"))
+   (set (match_operand:DI 2 "register_operand" "=r")
+	(match_operand:DI 3 "register_operand" "r"))]
+  "((REGNO (operands[0]) & 3) == 0)
+   && ((REGNO (operands[1]) & 3) == 0)
+   && (REGNO (operands[0]) + 2 == REGNO (operands[2]))
+   && (REGNO (operands[1]) + 2 == REGNO (operands[3]))"
+  "movq	%1,%0")
+
+;; Matched 4/17/92
+(define_peephole
+  [(set (match_operand:DI 0 "register_operand" "=r")
+	(match_operand:DI 1 "register_operand" "r"))
+   (set (match_operand:SI 2 "register_operand" "=r")
+	(match_operand:SI 3 "register_operand" "r"))
+   (set (match_operand:SI 4 "register_operand" "=r")
+	(match_operand:SI 5 "register_operand" "r"))]
+  "((REGNO (operands[0]) & 3) == 0)
+   && ((REGNO (operands[1]) & 3) == 0)
+   && (REGNO (operands[0]) + 2 == REGNO (operands[2]))
+   && (REGNO (operands[1]) + 2 == REGNO (operands[3]))
+   && (REGNO (operands[0]) + 3 == REGNO (operands[4]))
+   && (REGNO (operands[1]) + 3 == REGNO (operands[5]))"
+  "movq	%1,%0")
+
+;; Matched 4/17/92
+(define_peephole
+  [(set (match_operand:SI 0 "register_operand" "=r")
+	(match_operand:SI 1 "register_operand" "r"))
+   (set (match_operand:SI 2 "register_operand" "=r")
+	(match_operand:SI 3 "register_operand" "r"))
+   (set (match_operand:DI 4 "register_operand" "=r")
+	(match_operand:DI 5 "register_operand" "r"))]
+  "((REGNO (operands[0]) & 3) == 0)
+   && ((REGNO (operands[1]) & 3) == 0)
+   && (REGNO (operands[0]) + 1 == REGNO (operands[2]))
+   && (REGNO (operands[1]) + 1 == REGNO (operands[3]))
+   && (REGNO (operands[0]) + 2 == REGNO (operands[4]))
+   && (REGNO (operands[1]) + 2 == REGNO (operands[5]))"
+  "movq	%1,%0")
+
+;; Matched 4/17/92
+(define_peephole
+  [(set (match_operand:DI 0 "register_operand" "=r")
+	(match_operand:DI 1 "register_operand" "r"))
+   (set (match_operand:SI 2 "register_operand" "=r")
+	(match_operand:SI 3 "register_operand" "r"))]
+  "((REGNO (operands[0]) & 3) == 0)
+   && ((REGNO (operands[1]) & 3) == 0)
+   && (REGNO (operands[0]) + 2 == REGNO (operands[2]))
+   && (REGNO (operands[1]) + 2 == REGNO (operands[3]))"
+  "movt	%1,%0")
+
+;; Matched 5/28/91
+(define_peephole
+  [(set (match_operand:SI 0 "register_operand" "=r")
+	(match_operand:SI 1 "register_operand" "r"))
+   (set (match_operand:SI 2 "register_operand" "=r")
+	(match_operand:SI 3 "register_operand" "r"))
+   (set (match_operand:SI 4 "register_operand" "=r")
+	(match_operand:SI 5 "register_operand" "r"))]
+  "((REGNO (operands[0]) & 3) == 0)
+   && ((REGNO (operands[1]) & 3) == 0)
+   && (REGNO (operands[0]) + 1 == REGNO (operands[2]))
+   && (REGNO (operands[1]) + 1 == REGNO (operands[3]))
+   && (REGNO (operands[0]) + 2 == REGNO (operands[4]))
+   && (REGNO (operands[1]) + 2 == REGNO (operands[5]))"
+  "movt	%1,%0")
+
+;; Matched 5/28/91
+(define_peephole
+  [(set (match_operand:SI 0 "register_operand" "=r")
+	(match_operand:SI 1 "register_operand" "r"))
+   (set (match_operand:SI 2 "register_operand" "=r")
+	(match_operand:SI 3 "register_operand" "r"))]
+  "((REGNO (operands[0]) & 1) == 0)
+   && ((REGNO (operands[1]) & 1) == 0)
+   && (REGNO (operands[0]) + 1 == REGNO (operands[2]))
+   && (REGNO (operands[1]) + 1 == REGNO (operands[3]))"
+  "movl	%1,%0")
+
+; Multiple register loads.
+
+;; Matched 6/15/91
+(define_peephole
+  [(set (match_operand:SI 0 "register_operand" "=r")
+	(mem:SI (plus:SI (match_operand:SI 1 "register_operand" "r")
+			 (match_operand:SI 2 "immediate_operand" "n"))))
+   (set (match_operand:SI 3 "register_operand" "=r")
+	(mem:SI (plus:SI (match_dup 1)
+			 (match_operand:SI 4 "immediate_operand" "n"))))
+   (set (match_operand:SI 5 "register_operand" "=r")
+	(mem:SI (plus:SI (match_dup 1)
+			 (match_operand:SI 6 "immediate_operand" "n"))))
+   (set (match_operand:SI 7 "register_operand" "=r")
+	(mem:SI (plus:SI (match_dup 1)
+			 (match_operand:SI 8 "immediate_operand" "n"))))]
+  "(i960_si_ti (operands[1], operands[2]) && ((REGNO (operands[0]) & 3) == 0)
+   && (REGNO (operands[1]) != REGNO (operands[0]))
+   && (REGNO (operands[0]) + 1 == REGNO (operands[3]))
+   && (REGNO (operands[1]) != REGNO (operands[3]))
+   && (REGNO (operands[0]) + 2 == REGNO (operands[5]))
+   && (REGNO (operands[1]) != REGNO (operands[5]))
+   && (REGNO (operands[0]) + 3 == REGNO (operands[7]))
+   && (INTVAL (operands[2]) + 4 == INTVAL (operands[4]))
+   && (INTVAL (operands[2]) + 8 == INTVAL (operands[6]))
+   && (INTVAL (operands[2]) + 12 == INTVAL (operands[8])))"
+  "ldq	%2(%1),%0")
+
+;; Matched 5/28/91
+(define_peephole
+  [(set (match_operand:DF 0 "register_operand" "=d")
+	(mem:DF (plus:SI (match_operand:SI 1 "register_operand" "d")
+			 (match_operand:SI 2 "immediate_operand" "n"))))
+   (set (match_operand:DF 3 "register_operand" "=d")
+	(mem:DF (plus:SI (match_dup 1)
+			 (match_operand:SI 4 "immediate_operand" "n"))))]
+  "(i960_si_ti (operands[1], operands[2]) && ((REGNO (operands[0]) & 3) == 0)
+   && (REGNO (operands[1]) != REGNO (operands[0]))
+   && (REGNO (operands[0]) + 2 == REGNO (operands[3]))
+   && (REGNO (operands[1]) != REGNO (operands[3]))
+   && (INTVAL (operands[2]) + 8 == INTVAL (operands[4])))"
+  "ldq	%2(%1),%0")
+
+;; Matched 1/24/92
+(define_peephole
+  [(set (match_operand:DI 0 "register_operand" "=d")
+	(mem:DI (plus:SI (match_operand:SI 1 "register_operand" "d")
+			 (match_operand:SI 2 "immediate_operand" "n"))))
+   (set (match_operand:DI 3 "register_operand" "=d")
+	(mem:DI (plus:SI (match_dup 1)
+			 (match_operand:SI 4 "immediate_operand" "n"))))]
+  "(i960_si_ti (operands[1], operands[2]) && ((REGNO (operands[0]) & 3) == 0)
+   && (REGNO (operands[1]) != REGNO (operands[0]))
+   && (REGNO (operands[0]) + 2 == REGNO (operands[3]))
+   && (REGNO (operands[1]) != REGNO (operands[3]))
+   && (INTVAL (operands[2]) + 8 == INTVAL (operands[4])))"
+  "ldq	%2(%1),%0")
+
+;; Matched 4/17/92
+(define_peephole
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(mem:SI (match_operand:SI 1 "register_operand" "d")))
+   (set (match_operand:SI 2 "register_operand" "=d")
+	(mem:SI (plus:SI (match_dup 1)
+			 (match_operand:SI 3 "immediate_operand" "n"))))
+   (set (match_operand:SI 4 "register_operand" "=d")
+	(mem:SI (plus:SI (match_dup 1)
+			 (match_operand:SI 5 "immediate_operand" "n"))))
+   (set (match_operand:SI 6 "register_operand" "=d")
+	(mem:SI (plus:SI (match_dup 1)
+			 (match_operand:SI 7 "immediate_operand" "n"))))]
+  "(i960_si_ti (operands[1], 0) && ((REGNO (operands[0]) & 3) == 0)
+   && (REGNO (operands[1]) != REGNO (operands[0]))
+   && (REGNO (operands[0]) + 1 == REGNO (operands[2]))
+   && (REGNO (operands[1]) != REGNO (operands[2]))
+   && (REGNO (operands[0]) + 2 == REGNO (operands[4]))
+   && (REGNO (operands[1]) != REGNO (operands[4]))
+   && (REGNO (operands[0]) + 3 == REGNO (operands[6]))
+   && (INTVAL (operands[3]) == 4)
+   && (INTVAL (operands[5]) == 8)
+   && (INTVAL (operands[7]) == 12))"
+  "ldq	(%1),%0")
+
+;; Matched 5/28/91
+(define_peephole
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(mem:SI (plus:SI (match_operand:SI 1 "register_operand" "d")
+			 (match_operand:SI 2 "immediate_operand" "n"))))
+   (set (match_operand:SI 3 "register_operand" "=d")
+	(mem:SI (plus:SI (match_dup 1)
+			 (match_operand:SI 4 "immediate_operand" "n"))))
+   (set (match_operand:SI 5 "register_operand" "=d")
+	(mem:SI (plus:SI (match_dup 1)
+			 (match_operand:SI 6 "immediate_operand" "n"))))]
+  "(i960_si_ti (operands[1], operands[2]) && ((REGNO (operands[0]) & 3) == 0)
+   && (REGNO (operands[1]) != REGNO (operands[0]))
+   && (REGNO (operands[0]) + 1 == REGNO (operands[3]))
+   && (REGNO (operands[1]) != REGNO (operands[3]))
+   && (REGNO (operands[0]) + 2 == REGNO (operands[5]))
+   && (INTVAL (operands[2]) + 4 == INTVAL (operands[4]))
+   && (INTVAL (operands[2]) + 8 == INTVAL (operands[6])))"
+  "ldt	%2(%1),%0")
+
+;; Matched 6/15/91
+(define_peephole
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(mem:SI (match_operand:SI 1 "register_operand" "d")))
+   (set (match_operand:SI 2 "register_operand" "=d")
+	(mem:SI (plus:SI (match_dup 1)
+			 (match_operand:SI 3 "immediate_operand" "n"))))
+   (set (match_operand:SI 4 "register_operand" "=d")
+	(mem:SI (plus:SI (match_dup 1)
+			 (match_operand:SI 5 "immediate_operand" "n"))))]
+  "(i960_si_ti (operands[1], 0) && ((REGNO (operands[0]) & 3) == 0)
+   && (REGNO (operands[1]) != REGNO (operands[0]))
+   && (REGNO (operands[0]) + 1 == REGNO (operands[2]))
+   && (REGNO (operands[1]) != REGNO (operands[2]))
+   && (REGNO (operands[0]) + 2 == REGNO (operands[4]))
+   && (INTVAL (operands[3]) == 4)
+   && (INTVAL (operands[5]) == 8))"
+  "ldt	(%1),%0")
+
+;; Matched 5/28/91
+(define_peephole
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(mem:SI (plus:SI (match_operand:SI 1 "register_operand" "d")
+			 (match_operand:SI 2 "immediate_operand" "n"))))
+   (set (match_operand:SI 3 "register_operand" "=d")
+	(mem:SI (plus:SI (match_dup 1)
+			 (match_operand:SI 4 "immediate_operand" "n"))))]
+  "(i960_si_di (operands[1], operands[2]) && ((REGNO (operands[0]) & 1) == 0)
+   && (REGNO (operands[1]) != REGNO (operands[0]))
+   && (REGNO (operands[0]) + 1 == REGNO (operands[3]))
+   && (INTVAL (operands[2]) + 4 == INTVAL (operands[4])))"
+  "ldl	%2(%1),%0")
+
+;; Matched 5/28/91
+(define_peephole
+  [(set (match_operand:SI 0 "register_operand" "=d")
+	(mem:SI (match_operand:SI 1 "register_operand" "d")))
+   (set (match_operand:SI 2 "register_operand" "=d")
+	(mem:SI (plus:SI (match_dup 1)
+			 (match_operand:SI 3 "immediate_operand" "n"))))]
+  "(i960_si_di (operands[1], 0) && ((REGNO (operands[0]) & 1) == 0)
+   && (REGNO (operands[1]) != REGNO (operands[0]))
+   && (REGNO (operands[0]) + 1 == REGNO (operands[2]))
+   && (INTVAL (operands[3]) == 4))"
+  "ldl	(%1),%0")
+
+; Multiple register stores.
+
+;; Matched 5/28/91
+(define_peephole
+  [(set (mem:SI (plus:SI (match_operand:SI 0 "register_operand" "d")
+			 (match_operand:SI 1 "immediate_operand" "n")))
+	(match_operand:SI 2 "register_operand" "d"))
+   (set (mem:SI (plus:SI (match_dup 0)
+			 (match_operand:SI 3 "immediate_operand" "n")))
+	(match_operand:SI 4 "register_operand" "d"))
+   (set (mem:SI (plus:SI (match_dup 0)
+			 (match_operand:SI 5 "immediate_operand" "n")))
+	(match_operand:SI 6 "register_operand" "d"))
+   (set (mem:SI (plus:SI (match_dup 0)
+			 (match_operand:SI 7 "immediate_operand" "n")))
+	(match_operand:SI 8 "register_operand" "d"))]
+  "(i960_si_ti (operands[0], operands[1]) && ((REGNO (operands[2]) & 3) == 0)
+   && (REGNO (operands[2]) + 1 == REGNO (operands[4]))
+   && (REGNO (operands[2]) + 2 == REGNO (operands[6]))
+   && (REGNO (operands[2]) + 3 == REGNO (operands[8]))
+   && (INTVAL (operands[1]) + 4 == INTVAL (operands[3]))
+   && (INTVAL (operands[1]) + 8 == INTVAL (operands[5]))
+   && (INTVAL (operands[1]) + 12 == INTVAL (operands[7])))"
+  "stq	%2,%1(%0)")
+
+;; Matched 6/16/91
+(define_peephole
+  [(set (mem:DF (plus:SI (match_operand:SI 0 "register_operand" "d")
+			 (match_operand:SI 1 "immediate_operand" "n")))
+	(match_operand:DF 2 "register_operand" "d"))
+   (set (mem:DF (plus:SI (match_dup 0)
+			 (match_operand:SI 3 "immediate_operand" "n")))
+	(match_operand:DF 4 "register_operand" "d"))]
+  "(i960_si_ti (operands[0], operands[1]) && ((REGNO (operands[2]) & 3) == 0)
+   && (REGNO (operands[2]) + 2 == REGNO (operands[4]))
+   && (INTVAL (operands[1]) + 8 == INTVAL (operands[3])))"
+  "stq	%2,%1(%0)")
+
+;; Matched 4/17/92
+(define_peephole
+  [(set (mem:DI (plus:SI (match_operand:SI 0 "register_operand" "d")
+			 (match_operand:SI 1 "immediate_operand" "n")))
+	(match_operand:DI 2 "register_operand" "d"))
+   (set (mem:DI (plus:SI (match_dup 0)
+			 (match_operand:SI 3 "immediate_operand" "n")))
+	(match_operand:DI 4 "register_operand" "d"))]
+  "(i960_si_ti (operands[0], operands[1]) && ((REGNO (operands[2]) & 3) == 0)
+   && (REGNO (operands[2]) + 2 == REGNO (operands[4]))
+   && (INTVAL (operands[1]) + 8 == INTVAL (operands[3])))"
+  "stq	%2,%1(%0)")
+
+;; Matched 1/23/92
+(define_peephole
+  [(set (mem:SI (match_operand:SI 0 "register_operand" "d"))
+	(match_operand:SI 1 "register_operand" "d"))
+   (set (mem:SI (plus:SI (match_dup 0)
+			 (match_operand:SI 2 "immediate_operand" "n")))
+	(match_operand:SI 3 "register_operand" "d"))
+   (set (mem:SI (plus:SI (match_dup 0)
+			 (match_operand:SI 4 "immediate_operand" "n")))
+	(match_operand:SI 5 "register_operand" "d"))
+   (set (mem:SI (plus:SI (match_dup 0)
+			 (match_operand:SI 6 "immediate_operand" "n")))
+	(match_operand:SI 7 "register_operand" "d"))]
+  "(i960_si_ti (operands[0], 0) && ((REGNO (operands[1]) & 3) == 0)
+   && (REGNO (operands[1]) + 1 == REGNO (operands[3]))
+   && (REGNO (operands[1]) + 2 == REGNO (operands[5]))
+   && (REGNO (operands[1]) + 3 == REGNO (operands[7]))
+   && (INTVAL (operands[2]) == 4)
+   && (INTVAL (operands[4]) == 8)
+   && (INTVAL (operands[6]) == 12))"
+  "stq	%1,(%0)")
+
+;; Matched 5/29/91
+(define_peephole
+  [(set (mem:SI (plus:SI (match_operand:SI 0 "register_operand" "d")
+			 (match_operand:SI 1 "immediate_operand" "n")))
+	(match_operand:SI 2 "register_operand" "d"))
+   (set (mem:SI (plus:SI (match_dup 0)
+			 (match_operand:SI 3 "immediate_operand" "n")))
+	(match_operand:SI 4 "register_operand" "d"))
+   (set (mem:SI (plus:SI (match_dup 0)
+			 (match_operand:SI 5 "immediate_operand" "n")))
+	(match_operand:SI 6 "register_operand" "d"))]
+  "(i960_si_ti (operands[0], operands[1]) && ((REGNO (operands[2]) & 3) == 0)
+   && (REGNO (operands[2]) + 1 == REGNO (operands[4]))
+   && (REGNO (operands[2]) + 2 == REGNO (operands[6]))
+   && (INTVAL (operands[1]) + 4 == INTVAL (operands[3]))
+   && (INTVAL (operands[1]) + 8 == INTVAL (operands[5])))"
+  "stt	%2,%1(%0)")
+
+;; Matched 5/29/91
+(define_peephole
+  [(set (mem:SI (match_operand:SI 0 "register_operand" "d"))
+	(match_operand:SI 1 "register_operand" "d"))
+   (set (mem:SI (plus:SI (match_dup 0)
+			 (match_operand:SI 2 "immediate_operand" "n")))
+	(match_operand:SI 3 "register_operand" "d"))
+   (set (mem:SI (plus:SI (match_dup 0)
+			 (match_operand:SI 4 "immediate_operand" "n")))
+	(match_operand:SI 5 "register_operand" "d"))]
+  "(i960_si_ti (operands[0], 0) && ((REGNO (operands[1]) & 3) == 0)
+   && (REGNO (operands[1]) + 1 == REGNO (operands[3]))
+   && (REGNO (operands[1]) + 2 == REGNO (operands[5]))
+   && (INTVAL (operands[2]) == 4)
+   && (INTVAL (operands[4]) == 8))"
+  "stt	%1,(%0)")
+
+;; Matched 5/28/91
+(define_peephole
+  [(set (mem:SI (plus:SI (match_operand:SI 0 "register_operand" "d")
+			 (match_operand:SI 1 "immediate_operand" "n")))
+	(match_operand:SI 2 "register_operand" "d"))
+   (set (mem:SI (plus:SI (match_dup 0)
+			 (match_operand:SI 3 "immediate_operand" "n")))
+	(match_operand:SI 4 "register_operand" "d"))]
+  "(i960_si_di (operands[0], operands[1]) && ((REGNO (operands[2]) & 1) == 0)
+   && (REGNO (operands[2]) + 1 == REGNO (operands[4]))
+   && (INTVAL (operands[1]) + 4 == INTVAL (operands[3])))"
+  "stl	%2,%1(%0)")
+
+;; Matched 5/28/91
+(define_peephole
+  [(set (mem:SI (match_operand:SI 0 "register_operand" "d"))
+	(match_operand:SI 1 "register_operand" "d"))
+   (set (mem:SI (plus:SI (match_dup 0)
+			 (match_operand:SI 2 "immediate_operand" "n")))
+	(match_operand:SI 3 "register_operand" "d"))]
+  "(i960_si_di (operands[0], 0) && ((REGNO (operands[1]) & 1) == 0)
+   && (REGNO (operands[1]) + 1 == REGNO (operands[3]))
+   && (INTVAL (operands[2]) == 4))"
+  "stl	%1,(%0)")
diff --git a/gcc/config/i960/rtems.h b/gcc/config/i960/rtems.h
new file mode 100644
index 00000000000..092b7920abf
--- /dev/null
+++ b/gcc/config/i960/rtems.h
@@ -0,0 +1,29 @@
+/* Definitions for rtems targeting an Intel i960.
+   Copyright (C) 1996, 1997, 2000, 2002 Free Software Foundation, Inc.
+   Contributed by Joel Sherrill (joel@OARcorp.com).
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Target OS builtins.  */
+#define TARGET_OS_CPP_BUILTINS()		\
+  do						\
+    {						\
+	builtin_define ("__rtems__");		\
+	builtin_assert ("system=rtems");	\
+    }						\
+  while (0)
diff --git a/gcc/config/i960/t-960bare b/gcc/config/i960/t-960bare
new file mode 100644
index 00000000000..9cbaa9f9065
--- /dev/null
+++ b/gcc/config/i960/t-960bare
@@ -0,0 +1,30 @@
+LIB2FUNCS_EXTRA = xp-bit.c
+
+# We want fine grained libraries, so use the new code to build the
+# floating point emulation libraries.
+FPBIT = fp-bit.c
+DPBIT = dp-bit.c
+
+dp-bit.c: $(srcdir)/config/fp-bit.c
+	echo '#define FLOAT_BIT_ORDER_MISMATCH' > dp-bit.c
+	cat $(srcdir)/config/fp-bit.c >> dp-bit.c
+
+fp-bit.c: $(srcdir)/config/fp-bit.c
+	echo '#define FLOAT' > fp-bit.c
+	echo '#define FLOAT_BIT_ORDER_MISMATCH' >> fp-bit.c
+	cat $(srcdir)/config/fp-bit.c >> fp-bit.c
+
+xp-bit.c: $(srcdir)/config/fp-bit.c
+	echo '#define EXTENDED_FLOAT_STUBS' > xp-bit.c
+	cat $(srcdir)/config/fp-bit.c >> xp-bit.c
+
+i960-c.o: $(srcdir)/config/i960/i960-c.c $(CONFIG_H) $(SYSTEM_H) \
+  coretypes.h $(TM_H) $(CPPLIB_H) $(TREE_H) c-pragma.h toplev.h $(GGC_H) $(TM_P_H)
+	$(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) $(srcdir)/config/i960/i960-c.c
+
+MULTILIB_OPTIONS=mnumerics/msoft-float mlong-double-64
+MULTILIB_DIRNAMES=float soft-float ld64
+MULTILIB_MATCHES=mnumerics=msb mnumerics=msc mnumerics=mkb mnumerics=mkc mnumerics=mmc mnumerics=mcb mnumerics=mcc mnumerics=mjf msoft-float=msa msoft-float=mka msoft-float=mca msoft-float=mcf
+
+LIBGCC = stmp-multilib
+INSTALL_LIBGCC = install-multilib
diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog
new file mode 100644
index 00000000000..c93c5fe7ea0
--- /dev/null
+++ b/gcc/f/ChangeLog
@@ -0,0 +1,7315 @@
+2004-09-06  Release Manager
+
+	* GCC 3.4.2 released.
+
+2004-09-02  Eric Botcazou  <ebotcazou@libertysurf.fr>
+
+	PR fortran/17180
+	* malloc.c (MALLOC_ALIGNMENT): Rename into MAX_ALIGNMENT
+	and use a host-based heuristics to determine it.
+	(ROUNDED_AREA_SIZE): Adjust.
+
+2004-09-01  Eric Botcazou  <ebotcazou@libertysurf.fr>
+
+	PR fortran/17180
+	* malloc.c (MALLOC_ALIGNMENT): New constant.
+	(ROUNDED_AREA_SIZE): Likewise.
+	(malloc_kill_area_): Use ROUNDED_AREA_SIZE.
+	(malloc_find_inpool_): Likewise.
+	(malloc_new_inpool_): Likewise.
+	(malloc_resize_inpool_): Likewise.
+
+2004-07-12  Bud Davis  <bdavis9659@comcast.net>
+
+	* bld.c (ffebld_constant_new_character1, ffebld_constant_new_complex{1,2},
+	ffebld_constant_new_hollerith, ffebld_constant_new_integer1,
+	ffebld_constant_new_integer{1,2,3,4}_val, ffebld_constant_new_logical1,
+	ffebld_constant_new_logical{1,2,3,4}_val, ffebld_constant_new_real{1,2},
+	ffebld_constant_new_typeless_ov):
+	Fill and use `rlink' and `llink' pointers in _ffebld_ struct.
+	* bld.h (struct _ffebld_): remove 'next' pointer, add
+	`rlink, llink' pointers; remove `negate' entry.
+	* malloc.c (malloc_kill_area_): Adapt for new `mallocArea' pointer.
+	(malloc_display_): Adapt.
+	(malloc_new_inpool_): Set it.
+	(malloc_resize_inpool_): Ditto.
+
+2004-07-01  Release Manager
+
+	* GCC 3.4.1 released.
+
+2004-06-17  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Note that GCC 3.4.x is the last version
+	of GCC to contain g77.
+
+2004-05-18  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* bugs.texi, news.texi: Don't reference mainline versions.
+
+2004-05-16  Gerald Pfeifer  <gerald@pfeifer.com>
+
+	* g77.texi (Floating-point Errors): Fix typo.
+
+2004-05-07  Gerald Pfeifer  <gerald@pfeifer.com>
+
+	* g77.texi (Floating-point Errors): Avoid referencing 
+	http://www.linuxsupportline.com/~billm/ which as has been hijacked;
+	add a reference to the official IEEE 754 site.
+
+2004-04-18  Release Manager
+
+	* GCC 3.4.0 released.
+
+2004-03-21  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* g77.texi: Update link to "G++ and GCC".
+
+2004-03-14  Gerald Pfeifer  <gerald@pfeifer.com>
+
+	* g77.texi (Aligned Data): Remove obsolete paragraph including a
+	broken link.
+	(Floating-point Errors): Remove links to http://www.validgh.com/
+	which was "hijacked".
+	(Language): Fix link to Fortran books.
+	(Projects): Remove obsolete paragraph including a broken link to
+	ftp://alpha.gnu.org/gnu/g77/projects/.
+	(Trouble): Remove obsolete paragraph including a broken link to
+	ftp://alpha.gnu.org/g77.plan.
+
+	* invoke.texi (Overall Options): Remove broken reference to
+	rat7.uue (which was of dubious copyright status anyways).
+
+	* root.texi (www-burley): Fix URL.
+
+2004-03-06  Roger Sayle  <roger@eyesopen.com>
+
+	* parse.c (ffe_parse_file): Handle the case that main_input_filename
+	is NULL.
+
+2004-02-24  Michael Matz  <matz@suse.de>
+
+	* Make-lang.in (sta.o-warn): Delete.
+	* sta.c (ffesta_save_): Don't break aliasing rules.
+
+2004-02-20  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* Make-lang.in (g77spec.o): Depend on intl.h.
+	* g77spec.c: Include intl.h.
+	(lang_specific_driver): Allow translation of the copyright
+	symbol but not the rest of the copyright message.  Allow
+	translation of the message about warranty.
+
+2004-02-15  Roger Sayle  <roger@eyesopen.com>
+
+	PR fortran/14129
+	* lex.c (ffelex_cfelex_): Avoid calling xrealloc on a local stack
+	allocated array.
+
+2004-01-30  Kelley Cook  <kcook@gcc.gnu.org>
+
+	* Make-lang.in (doc/g77.dvi): Use $(abs_docdir). 
+
+2004-01-20  Kelley Cook  <kcook@gcc.gnu.org>
+
+	* Make-lang.in: Replace $(docdir) with doc.
+	(TEXI_G77_FILES): Define.
+	(f77.rebuilt): Delete.
+	(f77.srcextra): Add dependencies on f/BUGS and f/NEWS.
+	(f77.srcman, f77.srcinfo, f77.man, f77.info): New rules.
+	(doc/g77.info, doc/g77.dvi): Depend on TEXI_G77_FILES.  Always build in
+	doc directory.  Use $(MAKEINFOFLAGS).
+	(info, dvi, generated_manpages): Update to look in doc directory.
+	(f/BUGS, f/NEWS): Generate in build directory.
+	(f77.mostlyclean): Delete BUGS and NEWS from build directory.
+	(f77.maintainer-clean): Adjust to delete from source directory.
+	(f77.install-man): Revamp rule.
+
+2004-01-19  Kelley Cook  <kcook@gcc.gnu.org>
+
+	* Make-lang.in (G77_INSTALL_NAME): Define via a immediate $(shell)
+	instead of deferred backquote.
+
+2004-01-15  Kelley Cook  <kcook@gcc.gnu.org>
+
+	* Make-lang.in (f77.srcextra): Dummy entry.
+
+2004-01-13  Ian Lance Taylor  <ian@wasabisystems.com>
+
+	PR fortran/6491
+	* expr.c (ffeexpr_reduce_): When handling AND, OR, and XOR, and
+	when using -fugly-logint, if both operands are logical, convert
+	the result back to logical.
+	(ffeexpr_reduced_ugly2log_): Add bothlogical parameter.  Change
+	all callers.  Convert logical operands to integer.
+
+2004-01-12  Ian Lance Taylor  <ian@wasabisystems.com>
+
+	* README: Remove.
+
+2004-01-07  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* com.h (ffecom_gfrt_basictype): Correct return type.
+
+2003-12-29  Roger Sayle  <roger@eyesopen.com>
+
+	PR fortran/12632
+	* com.c (ffecom_subscript_check_): Take as an extra argument the
+	(possibly NULL) decl of the array.  Don't create unnecessary tree
+	nodes if the array index is known to be safe at compile-time.
+	If the array index is unsafe, force the array decl into memory to
+	avoid RTL expansion problems.
+	(ffecom_array_ref_): Update calls to ffecom_subscript_check_.
+	(ffecom_char_args_x_): Likewise.
+
+2003-12-06  Kelley Cook  <kcook@gcc.gnu.org>
+
+	* Make-lang.in (G77_CROSS_NAME): Delete.
+	(g77.install_common, g77.install-man, g77.uninstall): Adjust for above.
+
+2003-11-30  Andreas Jaeger  <aj@suse.de>
+
+	* Make-lang.in (f77.rebuilt): Fix dependency on g77.info.
+
+2003-11-24  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	PR fortran/12633
+	* expr.c (ffeexpr_reduced_ugly2log_): Revert
+	change allowing logical .and. logical to be
+	integer in expressions when -fugly-logint.
+
+2003-11-21  Kelley Cook  <kcook@gcc.gnu.org>
+
+	* .cvsignore: Delete.
+
+2003-11-20  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* Make-lang.in (f77.extraclean): Delete.
+
+2003-11-20  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* Make-lang.in (check-f77, lang_checks): Add.
+
+2003-11-16  Jason Merrill  <jason@redhat.com>
+
+	* Make-lang.in (f77.tags): Create TAGS.sub files in each directory
+	and TAGS files that include them for each front end.
+
+2003-11-12  Andreas Jaeger  <aj@suse.de>
+
+	* intdoc.in (Signal Intrinsic (subroutine)): Fix texinfo warning
+	using @code.
+	* intdoc.texi: Regenerated.
+
+2003-11-03  Kelley Cook  <kcook@gcc.gnu.org>
+
+	* Make-lang.in (dvi): Move targets to $(docobjdir).
+	(g77.dvi): Simplify rule.
+	(g77.info): Sinplify rule.
+	(g77.1): Delete.
+	(g77.pod): New intermediate rule.
+
+2003-10-31  Jakub Jelinek  <jakub@redhat.com>
+
+	* com.c (ffecom_sym_transform_): Set tree type of offset
+	to ssizetype.
+
+2003-10-21  Kelley Cook  <kcook@gcc.gnu.org>
+
+	* Make-lang.in (f/g77.1): Honor $(docobjdir).
+	($(docobjdir)/g77.info): Replace $(srcdir)/doc with $(docdir).
+	(f/g77.dvi): Likewise.
+
+2003-10-21  Jan Hubicka  <jh@suse.cz>
+
+	* lex.c (ffelex_cfelex_): Initialize d.
+
+Mon Oct 20 23:15:46 2003  Mark Mitchell  <mark@codesourcery.com>
+
+	* Make-lang.in ($(docobjdir)/g77.info): Add dependency on
+	stmp-docobjdir.
+
+Mon Oct 20 13:49:43 2003  Mark Mitchell  <mark@codesourcery.com>
+
+	* Make-lang.in (.PHONY): Remove f77.info, f77.install-info.
+	(info): Update dependencies.
+	($(srcdir)/f/g77.info): Replace with ...
+	($(docobjdir)/g77.info): ... this.
+	(f77.install-info): Remove.
+	(install-info): New target.
+
+2003-10-06  Mark Mitchell  <mark@codesourcery.com>
+
+	* Make-lang.in (f77.info): Replace with ...
+	(info): ... this.
+	(f77.dvi): Replace with ...
+	(dvi): ... this.
+	(f77.generated-manpages): Replace with ...
+	(generated-manpages): ... this.
+
+2003-09-29  Zack Weinberg  <zack@codesourcery.com>
+
+	* target.c (FFETARGET_ATOF_): Delete.
+	(ffetarget_real1, ffetarget_real2): Use real_from_string directly.
+	* target.h (FFETARGET_REAL_VALUE_FROM_INT_,
+	FFETARGET_REAL_VALUE_FROM_LONGLONG_): Use mode_for_size,
+	don't refer to SFmode or DFmode directly.
+
+2003-09-28  Richard Henderson  <rth@redhat.com>
+
+	* com.c (duplicate_decls): Copy DECL_SOURCE_LOCATION, not
+	file and line separately.
+
+2003-09-21  Richard Henderson  <rth@redhat.com>
+
+	* com.c, ste.c: Revert.
+
+2003-09-21  Richard Henderson  <rth@redhat.com>
+
+	* com.c, ste.c: Update for DECL_SOURCE_LOCATION rename and
+	change to const.
+
+2003-09-21  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Update with fixed PR's.
+
+2003-09-21  George Helffrich  <bugzilla@w170.uklinux.net>
+
+	* g77.texi: Remove ancient part about debugging COMMON
+	and EQUIVALENCE not correctly.
+
+2003-09-18  Roger Sayle  <roger@eyesopen.com>
+
+	* com.c (ffecom_overlap_): Remove FFS_EXPR case.
+	(ffecom_tree_canonize_ref_): Likewise.
+	(ffe_truthvalue_conversion): Likewise.
+
+2003-09-01  Josef Zlomek  <zlomekj@suse.cz>
+
+	* com.c (ffecom_overlap_): Kill BIT_ANDTC_EXPR.
+	(ffecom_tree_canonize_ref_): Kill BIT_ANDTC_EXPR.
+
+Thu Jul 31 01:47:27 2003  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (ffecom_init_0): Use `dconsthalf'.
+
+Sat Jul 19 12:03:03 2003  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c data.c expr.c fini.c g77spec.c global.c lab.c lex.c name.c
+	sta.c stc.c std.c storag.c stt.c stw.c symbol.c target.c type.c:
+	Remove unnecessary casts.
+
+Thu Jul 17 06:34:41 2003  Neil Booth  <neil@daikokuya.co.uk>
+
+	* lang-options.h: Remove.
+	* lang.opt: Document most options.
+
+2003-07-14  Geoffrey Keating  <geoffk@apple.com>
+
+	* lang-specs.h (f77-cpp-input): Use -o to specify the CPP output file.
+
+2003-07-10  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* ffe.texi: Correctly use @var{srcdir}.
+
+2003-07-09  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	PR Fortran/11301
+	* com.c (ffecom_sym_transform_): finish_decl should have
+	the same last argument as start_decl.
+
+2003-07-08  Rainer Orth  <ro@TechFak.Uni-Bielefeld.DE>
+
+	* Make-lang.in (f/g77.dvi): Use PWD_COMMAND.
+
+2003-07-08  Zack Weinberg  <zack@codesourcery.com>
+
+	* lex.c: Remove error block #ifdef MAP_CHARACTER.
+
+Mon Jul  7 18:13:22 2003  Nathan Sidwell  <nathan@codesourcery.com>
+
+	* com.c (bison_rule_pushlevel_, bison_rule_compstmt_): Adjust
+	emit_line_note calls.
+	* ste.c (ffeste_emit_line_note_): Likewise.
+
+2003-07-06  Andreas Jaeger  <aj@suse.de>
+
+	* bad.c: Convert () to (void) in function definitions.
+	* bld.c: Likewise.
+	* data.c: Likewise.
+	* equiv.c: Likewise.
+	* expr.c: Likewise.
+	* global.c: Likewise.
+	* implic.c: Likewise.
+	* info.c: Likewise.
+	* intdoc.c: Likewise.
+	* intrin.c: Likewise.
+	* lab.c: Likewise.
+	* lex.c: Likewise.
+	* malloc.c: Likewise.
+	* src.c: Likewise.
+	* st.c: Likewise.
+	* sta.c: Likewise.
+	* stb.c: Likewise.
+	* stc.c: Likewise.
+	* std.c: Likewise.
+	* ste.c: Likewise.
+	* storag.c: Likewise.
+	* stt.c: Likewise.
+	* stw.c: Likewise.
+	* symbol.c: Likewise.
+	* top.c: Likewise.
+	* where.c: Likewise.
+
+	* com.c: Convert prototypes to ISO C90.
+	* com.h: Likewise.
+	* g77spec.c: Likewise.
+
+Sun Jul  6 20:01:29 2003  Neil Booth  <neil@daikokuya.co.uk>
+
+	* top.c (ffe_handle_option): Don't handle filenames.
+
+2003-07-05  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	PR Fortran/11301
+	* com.c (ffecom_sym_transform_): Only install
+	FFEINFO_whereGLOBAL symbols in the global binding
+	level if not -fno-globals.
+
+Wed Jul  2 21:16:02 2003  Neil Booth  <neil@daikokuya.co.uk>
+
+	* top.c (ffe_init_options): Update prototype.
+	* top.h (ffe_init_options): Update prototype.
+
+2003-06-27  Zack Weinberg  <zack@codesourcery.com>
+
+	* com.c (input_file_stack_tick): Delete redundant declaration.
+
+Thu Jun 26 07:06:29 2003  Neil Booth  <neil@daikokuya.co.uk>
+
+	* top.c (ffe_handle_option): Don't check for missing arguments.
+
+Wed Jun 25 06:52:12 2003  Neil Booth  <neil@daikokuya.co.uk>
+
+	* top.c (ffe_handle_option): Add missing break;.
+
+2003-06-24  Scott Snyder  <snyder@fnal.gov>
+
+	PR fortran/11299
+	* com.c (ffe_init): Call push_srcloc() to ensure that
+	input_file_stack is initialized.
+
+Sat Jun 21 21:29:38 2003  Neil Booth  <neil@daikokuya.co.uk>
+
+	* lang.opt: Add -fpreprocessed.
+	* top.c (ffe_handle_option): Handle it.
+
+Fri Jun 20 10:00:31 2003  Nathan Sidwell  <nathan@codesourcery.com>
+
+	* com.c (finish_function): Adjust expand_function_end call.
+
+2003-06-17  Nathanael Nerode  <neroden@gcc.gnu.org>
+
+	* Make-lang.in: Replace BUILD_CC references with CC_FOR_BUILD.
+
+Sun Jun 15 15:56:51 2003  Neil Booth  <neil@daikokuya.co.uk>
+
+	* lang.opt: Declare F77.
+
+Sat Jun 14 18:13:00 2003  Nathan Sidwell  <nathan@codesourcery.com>
+
+	* com.c (stor_parm_decls): Adjust init_function_start call.
+
+Sat Jun 14 13:25:00 2003  Neil Booth  <neil@daikokuya.co.uk>
+
+	* Make-lang.in: Update to use options.c and options.h.
+	* top.c: Include options.h not f-options.h.
+	(ffe_init_options): From com.c.  Request F77 options.
+	(ffe_handle_options): Abort on unrecognized switch.
+	* com.c (ffe_init_options): Move to top.c.
+	* top.h (fee_init_options): New.
+
+2003-06-13  Richard Henderson  <rth@redhat.com>
+
+	PR debug/9864
+	* com.c (ffecom_sym_transform_): Install FFEINFO_whereGLOBAL
+	symbols in the global binding level.
+
+Sun Jun  8 15:42:09 2003  Neil Booth  <neil@daikokuya.co.uk>
+
+	* Make-lang.in (F77_OBJS, f77.mostlyclean, f/com.o): Update.
+	(f/f-options.c, f/f-options.h): New.
+	* com.c: Include opts.h and f-options.h.
+	(ffecom_decode_include_option_): Remove.
+	(LANG_HOOKS_HANDLE_OPTION): New.
+	(LANG_HOOKS_DECODE_OPTION): Drop.
+	(struct file_name_list, ffecom_decode_include_option,
+	ffecom_open_include_): Constify.
+	* com.h (ffecom_decode_include_option): Update.
+	* lang.opt: New.
+	* top.c: Include f-options.h, opts.h.
+	(ffe_is_digit_string_): Constify.
+	(ffe_decode_option): Transform to ffe_handle_option.
+	* top.h (ffe_decode_option): Replace with ffe_handle_option.
+
+2003-06-08  Andreas Jaeger  <aj@suse.de>
+
+	* std.c: Remove #if 0'ed functions.
+
+	* sta.c: Remove usage of HARD_F90, FFESTR_F90 and FFESTR_VXT.
+	* stb.c: Likewise.
+	* stb.h: Likewise.
+	* stc.c: Likewise.
+	* stc.h: Likewise.
+	* std.c: Likewise.
+	* std.h: Likewise.
+	* ste.c: Likewise.
+	* ste.h: Likewise.
+
+	* str.h (FFESTR_F90): Remove macro.
+	(FFESTR_VXT): Remove macro.
+
+	* bld.c: Remove usage of FFETARGET_okCHARACTER2,
+	FFETARGET_okCHARACTER3, FFETARGET_okCHARACTER4,
+	FFETARGET_okCHARACTER5, FFETARGET_okCHARACTER6,
+	FFETARGET_okCHARACTER7, FFETARGET_okCHARACTER8,
+	FFETARGET_okCOMPLEX4, FFETARGET_okCOMPLEX5, FFETARGET_okCOMPLEX6,
+	FFETARGET_okCOMPLEX7, FFETARGET_okCOMPLEX8, FFETARGET_okINTEGER5,
+	FFETARGET_okINTEGER6, FFETARGET_okINTEGER7, FFETARGET_okINTEGER8,
+	FFETARGET_okLOGICAL5, FFETARGET_okLOGICAL6, FFETARGET_okLOGICAL7,
+	FFETARGET_okLOGICAL8, FFETARGET_okREAL4, FFETARGET_okREAL5,
+	FFETARGET_okREAL6, FFETARGET_okREAL7 and FFETARGET_okREAL8.
+	* bld.h: Likewise.
+	* expr.c: Likewise.
+	* target.h: Likewise.
+	* com.c: Likewise.
+
+Sun Jun  8 12:28:14 2003  Neil Booth  <neil@daikokuya.co.uk>
+
+	* Make-lang.in: Update.
+	* top.c: Include opts.h. Define cl_options_count and cl_options.
+
+2003-06-07  Andreas Jaeger  <aj@suse.de>
+
+	* symbol.c (ffesymbol_new_): Remove tests for macro
+	FFECOM_symbolHOOK.
+	* symbol.h: Likewise.
+
+	* storag.c (ffestorag_new): Remove tests for macro
+	FFECOM_storageHOOK.
+	* storag.h: Likewise.
+
+	* lab.c (ffelab_new): Remove tests for macro FFECOM_labelHOOK.
+	* lab.h: Likewise.
+
+	* global.c: Remove tests for macro FFECOM_globalHOOK.
+	* global.h (struct _ffeglobal_): Likewise.
+
+	* bld.h: Remove tests for macros FFECOM_constantHOOK,
+	FFECOM_nonterHOOK, FFECOM_globalHOOK, FFECOM_labelHOOK,
+	FFECOM_storageHOOK, FFECOM_symbolHOOK.
+	Remove code dependend on FFECOM_itemHOOK.
+	* bld.c: Likewise.
+
+	* com.h (FFECOM_constantHOOK): Remove define.
+	(FFECOM_nonterHOOK): Remove.
+	(FFECOM_globalHOOK): Remove.
+	(FFECOM_labelHOOK): Remove.
+	(FFECOM_storageHOOK): Remove.
+	(FFECOM_symbolHOOK): Remove.
+
+	* com.c (ffecom_get_external_identifier_): Remove usage of
+	FFETARGET_isENFORCED_MAIN_NAME.
+
+	* bld.c: Remove code dependend on FFEBLD_BLANK_, FFECOM_itemHOOK.
+	(ffebld_new_accter): Likewise.
+	(ffebld_new_arrter): Likewise.
+	(ffebld_new_conter_with_orig): Likewise.
+	(ffebld_new_item): Likewise.
+	(ffebld_new_labter): Likewise.
+	(ffebld_new_labtok): Likewise.
+	(ffebld_new_none): Likewise.
+	(ffebld_new_one): Likewise.
+	(ffebld_new_symter): Likewise.
+	(ffebld_new_two): Likewise.
+
+Sat Jun  7 12:10:41 2003  Neil Booth  <neil@daikokuya.co.uk>
+
+	* com.c (ffe_init_options): Update.
+
+Thu Jun  5 18:33:40 CEST 2003  Jan Hubicka  <jh@suse.cz>
+
+	* Make-lang.in:  Add support for stageprofile and stagefeedback
+
+2003-06-04  Andreas Jaeger  <aj@suse.de>
+
+	* g77spec.c (lang_specific_driver): Remove ALT_LIBM usage.
+
+2003-06-01  Bud Davis  <bdavis9659@comcast.net>
+
+	* ste.c (ffeste_R838): Handle ERROR_MARK.
+	(ffeste_R839): Ditto.
+
+2003-06-01  Andreas Jaeger  <aj@suse.de>
+
+	* lex.c (ffelex_file_fixed): Remove usage of
+	REDUCE_CARD_SIZE_AFTER_BIGGY.
+
+	* expr.c (ffeexpr_exprstack_push_operand_): Remove code depenend
+	on WEIRD_NONFORTRAN_RULES.
+
+	* com.c (ffecom_arg_ptr_to_expr): Remove
+	PASS_HOLLERITH_BY_DESCRIPTOR dependend code.
+	(ffecom_const_expr): Remove usage of NEWCOMMON.
+	(ffecom_expand_let_stmt): Remove MOVE_EXPR.
+
+2003-05-31  Bud Davis  <bdavis9659@comcast.net>
+
+	PR fortran/10843
+	* sta.c (ffesta_second_): Parse GO TO correctly,
+	even in free source format.
+
+2003-05-31  Andreas Jaeger  <aj@suse.de>
+
+	* lex.c (ffelex_hash_): Remove HANDLE_PRAGMA and
+	HANDLE_GENERIC_PRAGMA dependend code, remove #if 0 code.
+	(pragma_getc): Removed.
+	(pragma_ungetc): Removed.
+
+2003-05-30  Roger Sayle  <roger@eyesopen.com>
+
+	* com.c (ffecom_init_0): Define built-in functions for tan and atan.
+	* com-rt.def: Use then to implement g77's tan and atan intrinsics.
+
+2003-05-22  Bud Davis  <bdavis9659@comcast.net>
+
+	* com.c (ffecom_sym_transform_): Error out on unallocatable
+	storage after type is set.
+
+2003-05-18  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* intdoc.in: Fix documentation of IDATE.
+	* intdoc.texi: Regenerate.
+	* news.texi: Update due to also fixing it in 3.3.1.
+
+2003-05-16  Wolfgang Bangerth <bangerth@dealii.org>
+
+	* g77.texi: Remove most of the of the preface of the
+	bugs section.
+
+2003-05-15  Wolfgang Bangerth <bangerth@dealii.org>
+
+	* g77.texi: Remove most of the bug reporting instructions and
+	merge them into bugs.html.
+
+2003-05-13  Zack Weinberg  <zack@codesourcery.com>
+
+	* com.c: Replace all calls to fatal_io_error with calls to
+	fatal_error; add ": %m" to the end of all the affected error
+	messages.
+
+2003-05-12  Zack Weinberg  <zack@codesourcery.com>
+
+	* bad.c: Don't call diagnostic_count_diagnostic.
+
+2003-05-12  Roger Sayle  <roger@eyesopen.com>
+
+	* com.c (ffecom_init_0): Define built-in functions for atan2,
+	exp, floor, fmod, log and pow.
+	(duplicate_decls): Preserve assembler name when redeclaring a
+	built-in.
+	* com-rt.def: Implement using the built-in forms of the above
+	functions rather than calling the standard C library directly.
+	Correct some of the run-time prototype "codes".
+
+2003-05-11  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	PR fortran/10726
+	* intdoc.in: Fix documentation of IDATE.
+	* intdoc.texi: Regenerate.
+	* g77.texi: Document completion of INTEGER*n support.
+	* news.texi: Update due to the above.
+
+2003-05-08  Roger Sayle  <roger@eyesopen.com>
+
+	PR fortran/8485
+	* target.h (FFETARGET_REAL_VALUE_FROM_INT_): Cast to
+	HOST_WIDE_INT instead of long.
+	(FFETARGET_REAL_VALUE_FROM_LONGLONG_): New macro.
+	(FFETARGET_LONGLONG_FROM_INTS_): New macro.
+	(ffetarget_convert_complex1_integer4): Implement.
+	(ffetarget_convert_complex2_integer4): Implement.
+	(ffetarget_convert_integer4_complex1): Implement.
+	(ffetarget_convert_integer4_complex2): Implement.
+	(ffetarget_convert_integer4_real1): Implement.
+	(ffetarget_convert_integer4_real2): Implement.
+	(ffetarget_convert_real1_integer4): Implement.
+	(ffetarget_convert_real2_integer4): Implement.
+	* com.c (ffecom_constantunion): Handle INTEGER*8.
+	(ffecom_constantunion_with_type): Likewise.
+
+2003-05-03  Nathan Sidwell  <nathan@codesourcery.com>
+
+	* com.c (ffecom_do_entry_): Use location_t and input_location
+	directly.
+	(ffecom_gen_sfuncdef_): Likewise.
+	(ffecom_start_progunit_): Likewise.
+	(ffecom_sym_transform_): Likewise.
+	(ffecom_sym_transform_assign_): Likewise.
+	* lex.c (ffelex_hash_): Likewise.
+	(ffelex_include_): Likewise.
+	* std.c (ffestd_exec_begin): Likewise.
+	(ffestd_exec_end): Likewise.
+	* ste.c (struct gbe_block): Likewise.
+	(ffeste_start_block_): Likewise.
+	(ffeste_start_stmt_): Likewise.
+
+2003-05-03  Nathan Sidwell  <nathan@codesourcery.com>
+
+	* ansify.c (die_unless): Revert lineno change here.
+
+2003-05-02  Nathan Sidwell  <nathan@codesourcery.com>
+
+	* lex.c (ffelex_file_pop_): Adjust file_stack member use.
+	(ffelex_file_push_): Likewise.
+	(ffelex_hash_): Likewise.
+
+2003-05-01  Nathan Sidwell  <nathan@codesourcery.com>
+
+	* ansify.c (die_unless): Rename lineno to input_line.
+	* com.c (ffecom_subscript_check_, ffecom_do_entry_,
+	ffecom_gen_sfuncdef_, ffecom_start_progunit_,
+	ffecom_sym_transform_, ffecom_sym_transform_assign_,
+	bison_rule_pushlevel_, bison_rule_compstmt_, finish_function,
+	store_parm_decls): Likewise.
+	* intrin.c (ffeintrin_fulfill_generic): Likewise.
+	* lex.c (ffelex_hash_, ffelex_include_, ffelex_next_line_,
+	ffelex_file_fixed, ffelex_file_free): Likewise.
+	* std.c (ffestd_exec_end): Likewise.
+	* ste.c (ffeste_emit_line_note_, ffeste_start_block_,
+	ffeste_start_stmt_): Likewise.
+	* ste.h (ffeste_filelinenum, ffeste_set_line): Likewise.
+
+	* lex.c (ffelex_file_pop_): Rename parameter from input_filename.
+	(ffelex_file_push_): Likewise.
+
+	* ste.c (struct gbe_block): Rename field from input_filename.
+	(ffeste_start_block_, ffeste_start_stmt_): Likewise.
+
+2003-04-17  Roger Sayle  <roger@eyesopen.com>
+
+	PR c/10375
+	* com.c (duplicate_decls): Preserve "const" and "noreturn"
+	function attributes.
+
+2003-04-13  Roger Sayle  <roger@eyesopen.com>
+
+	* com.c (duplicate_decls): Preserve pure and malloc attributes.
+
+2003-04-12  Zack Weinberg  <zack@codesourcery.com>
+
+	* com.c (ffecom_build_complex_constant_, ffecom_expr_)
+	(ffecom_init_zero_, ffecom_transform_namelist_, ffecom_vardesc_)
+	(ffecom_vardesc_array_, ffecom_vardesc_dims_, ffecom_2)
+	* ste.c (ffeste_io_ialist_, ffeste_io_cilist_, ffeste_io_cllist_)
+	(ffeste_io_icilist_, ffeste_io_inlist_, ffeste_io_olist_):
+	Use build_constructor.
+
+2003-04-11  Bud Davis <bdavis9659@comcast.net>
+
+	PR Fortran/9263
+	* gcc/f/data.c (ffedata_advance_): Check initial, final and
+	increment values for INTEGER typeness.
+	* gcc/f/news.texi: Document these fixes.
+
+2003-03-27  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* ffe.texi: Don't mention dead file proj.c.
+
+2003-03-26  Roger Sayle  <roger@eyesopen.com>
+
+	PR fortran/9793
+	* target.h (ffetarget_divide_integer1): Perform division by -1
+	using negation to prevent possible overflow trap on the host.
+
+2003-03-25  Marcelo Abreu  <mmabreu@inf.ufrgs.br>
+
+	PR fortran/10204
+	* ffe.texi: Reference the GCC web site in the URL.
+
+2003-03-24  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	PR fortran/10197
+	* news.texi: Document PR fortran/10197 fixed.
+
+Sun Mar 23 23:43:45 2003  Mark Mitchell  <mark@codesourcery.com>
+
+	PR c++/7086
+	* com.c (ffecom_sym_transform_): Adjust calls to
+	put_var_into_stack.
+	(ffe_mark_addressable): Likewise.
+
+2003-03-22  Bud Davis  <bdavis9659@comcast.net>
+
+	* com.c (ffecom_constantunion_with_type): New function.
+	* com.h (ffecom_constantunion_with_type): Declare.
+	* stc.c (ffestc_R810): Check for kind type.
+	* ste.c (ffeste_R810): Use ffecom_constantunion_with_type
+	to discern SELECT CASE variables.
+
+2003-03-15  Roger Sayle  <roger@eyesopen.com>
+
+	* stb.c (ffestb_R100110_): Allow the number before the X format
+	to be optional when not -fpedantic.
+	* std.c (ffestd_R1001dump_1010_3_): Delete unused static function.
+	(ffestd_R1001dump_): For the FFESTP_formattypeX case, call
+	ffestd_R1001dump_1010_2_ instead of ffestd_R1001dump_1010_3_.
+
+2003-03-15  Roger Sayle  <roger@eyesopen.com>
+
+	* f/ste.c (ffeste_R810): Fix whitespace.
+
+2003-03-15  Andreas Jaeger  <aj@suse.de>
+
+	* g77spec.c (DEFAULT_SWITCH_TAKES_ARG): Remove.
+	(DEFAULT_WORD_SWITCH_TAKES_ARG): Remove.
+
+2003-03-12  Nathanael Nerode  <neroden@gcc.gnu.org>
+
+	* g77.texi, invoke.texi, g77spec.c, lang-specs.h: GCC, not
+	GNU CC.  Especially here.
+
+2003-03-10  Roger Sayle  <roger@eyesopen.com>
+
+	* com.c (duplicate_decls): Synchronize with C's duplicate_decls.
+
+Sat Mar  8 21:11:40 2003  Neil Booth  <neil@daikokuya.co.uk>
+
+	* com.c (ffe_init): Update prototype; move code to ffe_post_options.
+	(ffe_post_options): New.
+
+2003-03-04  Tom Tromey  <tromey@redhat.com>
+
+	* Make-lang.in (f77.tags): New target.
+
+2003-02-20  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Document fixing PR fortran/9038.
+
+2003-02-04  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* g77.texi, invoke.texi: Update to GFDL 1.2.
+
+2003-01-31  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Document fixing PR fortran/7681
+	and optimization/9258.
+
+2003-01-26  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* lang-specs.h: Revoke change to (incorrectly) prohibit
+	passing -f options to cc1 when preprocessing.
+	* news.texi: Document this.
+
+Tue Jan 21 08:42:12 2003  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	Make-lang.in (f/sta.o-warn): Add -Wno-error.
+
+Thu Jan 16 10:53:16 2003  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in (f/target.o): Depend on toplev.h.
+	* target.c: Include toplev.h.
+
+Sat Jan 11 21:31:10 2003  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (ffecom_convert_narrow_, ffecom_convert_widen_,
+	pushdecl_top_level, storedecls, convert, delete_block,
+	insert_block, ffe_init, ffe_mark_addressable, poplevel,
+	ffe_print_identifier, pushdecl, pushlevel, set_block,
+	ffe_signed_or_unsigned_type, ffe_signed_type,
+	ffe_truthvalue_conversion, ffe_type_for_mode, ffe_type_for_size,
+	ffe_unsigned_type, append_include_chain, open_include_file,
+	read_filename_string, read_name_map): Convert to ISO C style function
+	definitions.
+	* parse.c (ffe_parse_file): Likewise.
+	* top.c (ffe_is_digit_string_): Likewise.
+
+2003-01-09  Christian Cornelssen  <ccorn@cs.tu-berlin.de>
+
+	* Make-lang.in (f77.install-common, f77.install-info,
+	f77.install-man, f77.uninstall): Prepend $(DESTDIR) to
+	destination paths in all (un)installation commands.
+
+2003-01-05  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Revise history again:
+	PR Fortran/9038 will be fixed in 3.4.
+
+2003-01-05  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Update news to reflect reality:
+	PR Fortran/9038 won't be fixed until 3.4.
+
+2003-01-04  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	PR Fortran/9038
+	* lang-specs.h: Remove -f options before preprocessing.
+	* news.texi: Document fixing of PR Fortran/9038.
+
+2003-01-03  Bud Davis <bdavis11@directvinternet.com>
+
+	* stc.c (ffestc_R810): Allow any kind integer in
+	case statements.
+	* ste.c (ffeste_R810): Give error message when
+	case selector exceeds its valid values.
+
+2003-01-01  Andreas Jaeger  <aj@suse.de>
+
+	* f/Make-lang.in ($(srcdir)/f/BUGS): Add include path for
+	gcc-common.texi.
+	($(srcdir)/f/NEWS): Likewise.
+
+2002-12-28  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* g77.texi: Use @copying.
+
+2002-12-23  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* root.texi: Include gcc-common.texi.
+	* bugs.texi, news.texi: Don't include root.texi as part of full
+	manual.
+	* g77.texi: Update for use of gcc-common.texi.
+	* Make-lang.in ($(srcdir)/f/g77.info, f/g77.dvi): Depend on
+	$(srcdir)/doc/include/gcc-common.texi.
+
+2002-12-19  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* intdoc.in: Fix typos.
+
+2002-12-18  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* g77.texi: Fix typos.
+	* intdoc.texi: Likewise.
+	* news.texi: Follow spelling conventions.
+
+Mon Dec 16 13:53:18 2002  Mark Mitchell  <mark@codesourcery.com>
+
+	* root.texi: Change version number to 3.4.
+
+2002-12-15  Zack Weinberg  <zack@codesourcery.com>
+
+	* target.h: Don't define HOST_WIDE_INT.
+
+2002-12-02  Nathanael Nerode  <neroden@gcc.gnu.org>
+
+	* Make-lang.in, ansify.c, intdoc.c, proj.h: Replace hconfig.h with
+	bconfig.h.
+	* fini.c, proj.h: Replace USE_HCONFIG with USE_BCONFIG
+
+2002-11-30  Zack Weinberg  <zack@codesourcery.com>
+
+	* proj.h, ansify.c, g77spec.c, intdoc.c:
+	Include coretypes.h and tm.h.
+	* Make-lang.in: Update dependencies.
+
+2002-11-20  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* invoke.texi: Explain the purpose of -fmove-all-movables,
+	-freduce-all-givs and -frerun-loop-opts better.
+
+2002-11-19  Nathanael Nerode  <neroden@gcc.gnu.org>
+
+	* Make-lang.in: Correct BUILD/HOST confusion.
+
+2002-11-19  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	PR fortran/8587
+	* news.texi: Show PR fortran/8587 fixed.
+
+2002-11-19  Jason Thorpe  <thorpej@wasabisystems.com>
+
+	* g77spec.c (lang_specific_spec_functions): New.
+
+2002-11-02  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77.texi: Correct documentation on generating C++ prototypes
+	of Fortran routines with f2c.
+	* news.texi: Document fixes in GCC-3.3, 3.2 and 3.1.
+
+2002-10-30  Roger Sayle  <roger@eyesopen.com>
+
+	* com.c (ffecom_subscript_check_): Cast the failure branch
+	of the bounds check COND_EXPR to void, to indicate noreturn.
+	(ffe_truthvalue_conversion): Only apply truth value conversion
+	to the non-void branches of a COND_EXPR.
+
+2002-10-26  Andris Pavenis  <pavenis@latnet.lv>
+
+	* lang-specs.h: Fix ratfor specs.
+
+2002-10-15  Richard Henderson  <rth@redhat.com>
+
+	* target.h (ffetarget_print_real1, ffetarget_print_real2): Use
+	real_to_decimal directly, and with the new arguments.
+
+2002-09-23  Zack Weinberg  <zack@codesourcery.com>
+
+	* Make-lang.in (g77spec.o): Don't depend on f/version.h.
+	(f/parse.o): Depend on version.h not f/version.h.
+	(g77version.o, f/version.o): Delete all references.
+
+	* com.c (ffecom_init_0): Fix transposed array indices in bsearch test.
+	* g77spec.c: Don't include f/version.h or refer to ffe_version_string.
+	* parse.c: Use version_string, not ffe_version_string.
+	* version.c, version.h: Delete files.
+
+2002-09-23  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* ChangeLog: Follow spelling conventions.
+	* ChangeLog.0: Likewise.
+	* com.c: Likewise.
+	* ffe.texi: Likewise.
+	* g77.texi: Likewise.
+	* intdoc.in: Likewise.
+	* invoke.texi: Likewise.
+	* news.texi: Likewise.
+	* intdoc.texi: Regenerate.
+
+2002-09-16  Geoffrey Keating  <geoffk@apple.com>
+
+	* com.c (union lang_tree_node): Add chain_next option.
+
+2002-09-16  Richard Henderson  <rth@redhat.com>
+
+	* target.c (ffetarget_real1): Don't pass FFETARGET_ATOF_
+	directly to ffetarget_make_real1.
+	(ffetarget_real2): Similarly.
+	* target.h (ffetarget_cvt_r1_to_rv_, ffetarget_cvt_rv_to_r2_,
+	ffetarget_cvt_r2_to_rv_): Use new real.h interface and simplify.
+
+2002-09-15  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* intdoc.texi: Regenerate.
+
+2002-09-15  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* ChangeLog: Follow spelling conventions.
+	* intdoc.in: Likewise.
+
+2002-09-09  Gerald Pfeifer  <pfeifer@dbai.tuwien.ac.at>
+
+	Fix PR web/7596:
+	* ffe.texi (Front End): Fix broken links.
+	* bugs.texi (Known Bugs): Refer to gcc.gnu.org instead of
+	www.gnu.org for onlinedocs.
+	* news.texi (News): Ditto.
+
+2002-09-07  Jan Hubicka  <jh@suse.cz>
+
+	* com.c (ffe_type_for_mode): Handle long double.
+
+2002-09-04  Richard Henderson  <rth@redhat.com>
+
+	* target.h (ffetarget_print_real1, ffetarget_print_real2): Update
+	call to REAL_VALUE_TO_DECIMAL.
+
+2002-08-31  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c: Don't set flag_finite_math_only by default.
+	* invoke.texi: Reverse the documentation of option
+	-ffinite-math-only to reflect the new default.
+
+2002-08-30  Hans-Peter Nilsson  <hp@bitrange.com>
+
+	* target.c (ffetarget_memcpy_): Don't test nonexistent
+	HOST_BYTES_BIG_ENDIAN, HOST_BITS_BIG_ENDIAN.  Check
+	HOST_WORDS_BIG_ENDIAN against both WORDS_BIG_ENDIAN and
+	BYTES_BIG_ENDIAN.
+
+2002-08-30  Alan Modra  <amodra@bigpond.net.au>
+
+	* target.h (FFETARGET_32bit_longs): Don't define for powerpc64 or
+	mmix.
+
+2002-08-28  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* bugs.texi, news.texi: Update URLs for online news and bugs
+	lists.
+
+2002-08-22  Hans-Peter Nilsson  <hp@bitrange.com>
+
+	* where.h (struct _ffewhere_file_): Mark GTY.
+	(ffewhere_file_kill): Remove prototype.
+	* where.c: Include ggc.h.
+	(struct _ffewhere_ll_, struct _ffewhere_root_ll_): Mark GTY.
+	(ffewhere_root_ll_): Ditto.  Change type from struct
+	_ffewhere_root_ll_ to struct _ffewhere_root_ll_*.  All uses
+	changed.
+	(ffewhere_file_kill): Remove.
+	(ffewhere_file_new): Use GC to allocate ffewhereFile objects.
+	(ffewhere_file_set): Use GC to allocate ffewhereLL_ objects.
+	(ffewhere_init_1): Use GC to allocate ffewhere_root_ll_ sentinel.
+	Include gt-f-where.h.
+	* lex.c (ffelex_current_wf_, ffelex_include_wherefile_): Mark GTY.
+	Include gt-f-lex.h.
+	* std.c (ffestd_S3P4): Don't call ffewhere_file_kill.
+	* config-lang.in (gtfiles): Add f/where.h f/where.c and f/lex.c.
+	* Make-lang.in (gt-f-lex.h gt-f-where.h): Add to dependents of
+	s-gtype.
+	(f/lex.o): Depend on gt-f-lex.h.
+	(f/where.o): Depend on gt-f-where.h.
+
+Tue Aug 20 16:49:40 2002  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* where.c (ffewhere_track): Remove impossible if-then clause.
+
+Thu Aug  8 10:06:14 2002  Nathan Sidwell  <nathan@codesourcery.com>
+
+	* f/Make-lang.in (f.mostlyclean): Remove coverage files.
+
+2002-08-06  Gerald Pfeifer  <pfeifer@dbai.tuwien.ac.at>
+
+	* g77.texi (Top): Rename Index to Keyword Index.
+
+2002-08-05  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* invoke.texi: Improve description of
+	-fno-finite-math-only flag.
+
+Sun Aug  4 16:45:49 2002  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* root.texi (version-gcc): Increase to 3.3.
+
+2002-07-30  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffe_init_options): Set
+	flag_finite_math_only.
+	* invoke.texi: Document -fno-finite-math-only.
+
+Mon Jul 29 22:05:35 2002  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (read_name_map): Use concat in lieu of xmalloc/strcpy.
+
+2002-07-25  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Document better handling of (no-)alias
+	information of dummy arguments and induction variables
+	on loop unrolling.
+
+2002-07-01  Roger Sayle  <roger@eyesopen.com>
+
+	* f/com.c (builtin_function): Accept additional parameter.
+	(ffe_com_init_0): Pass an additional NULL_TREE argument to
+	builtin_function.
+
+2002-06-28  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Mention 2 Gbyte limit on 32-bit targets
+	for arrays explicitly in news on g77-3.1.
+
+Thu Jun 20 21:56:34 2002  Neil Booth  <neil@daikokuya.co.uk>
+
+	* lang-specs.h: Use cc1 for traditional preprocessing.
+
+2002-06-20  Andreas Jaeger  <aj@suse.de>
+
+	* com.c (ffecom_prepare_expr_,ffecom_expr_power_integer_):
+	Remove #ifdefed HAHA sections.
+
+2002-06-20  Nathanael Nerode  <neroden@twcny.rr.com>
+
+	* com.c: Remove #ifdef HOHO sections.
+
+2002-06-17  Jason Thorpe  <thorpej@wasabisystems.com>
+
+	* bit.c: Don't include glimits.h.
+	* target.c: Likewise.
+	* where.h: Likewise.
+
+2002-06-12  Gabriel Dos Reis  <gdr@codesourcery.com>
+
+	* bad.c (ffebad_start_): Adjust calls to diagnostic_count_error.
+
+2002-06-04  Gabriel Dos Reis  <gdr@codesourcery.com>
+
+	* bad.c (ffebad_start_): Adjust call to count_error.
+	* Make-lang.in (f/bad.o): Depend on diagnostic.h
+	* bad.c: #include diagnostic.h
+
+2002-06-03  Geoffrey Keating  <geoffk@redhat.com>
+
+	* Make-lang.in (f/com.o): Depend on debug.h.
+	* com.c: Include debug.h.
+	(LANG_HOOKS_MARK_TREE): Delete.
+	(struct lang_identifier): Use gengtype.
+	(union lang_tree_node): New.
+	(struct lang_decl): New dummy definition.
+	(struct lang_type): New dummy definition.
+	(ffe_mark_tree): Delete.
+
+	* com.c (struct language_function): New dummy structure.
+
+	* Make-lang.in: Add rules to generate gt-f-ste.h gtype-f.h; allow
+	for filename changes.
+	(com.o): Allow for filename changes; add gtype-f.h as dependency.
+	(ste.o): Add gt-f-ste.h as dependency.
+	* config-lang.in (gtfiles): Add com.h, ste.c.
+	* com.c: Replace uses of ggc_add_* with GTY markers.  Include
+	gtype-f.h.
+	(mark_binding_level): Delete.
+	* com.h: Replace uses of ggc_add_* with GTY markers.
+	* ste.c: Replace uses of ggc_add_* with GTY markers.  Include
+	gt-f-ste.h.
+
+	* Make-lang.in (f/gt-com.h): Build using gengtype.
+	(com.o): Depend on f/gt-com.h.
+	* com.c: Rename struct binding_level to f_binding_level.
+	(struct f_binding_level): Use gengtype.
+	(struct tree_ggc_tracker): Use gengtype.
+	(mark_tracker_head): Use gt_ggc_m_tree_ggc_tracker.
+	(make_binding_level): Use GGC.
+	(mark_binding_level): Use gt_ggc_m_f_binding_level.
+	(ffecom_init_decl_processing): Change free_binding_level
+	to a deletable root.
+	* config-lang.in (gtfiles): Define.
+	* where.c: Strings need no longer be allocated in GCable memory;
+	remove my change of 30 Dec 1999.
+
+2002-05-31  Matthew Woodcraft  <mattheww@chiark.greenend.org.uk>
+
+	* lang-specs.h: Use cpp_debug_options.
+
+2002-05-28  Zack Weinberg  <zack@codesourcery.com>
+
+	* bld.c, com.c, expr.c, target.c: Include real.h.
+	* Make-lang.in: Update dependency lists.
+
+2002-05-16  Rainer Orth  <ro@TechFak.Uni-Bielefeld.DE>
+
+	* Make-lang.in: Allow for PWDCMD to override hardcoded pwd.
+
+2002-05-09  Hassan Aurag  <aurag@cae.com>
+
+	* expr.c (ffeexpr_reduced_ugly2log_): Allow logicals-as-integers
+	under -fugly-logint as arguments of .and., .or., .xor.
+
+2002-05-07  Jan Hubicka  <jh@suse.cz>
+
+	* target.h (FFETARGET_32bit_longs): Undefine for x86-64.
+
+2002-04-29  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* invoke.texi: Use @gol at ends of lines inside @gccoptlist.
+	* g77.texi: Update last update date.
+
+Thu Apr 25 07:44:44 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.h (ffe_parse_file): Update.
+	* lex.c (ffe_parse_file): Update.
+
+2002-04-20  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* root.texi: Remove variable version-g77.
+	* g77.texi: Remove the single use of that variable.
+
+Thu Apr 18 19:10:44 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (incomplete_type_error): Remove.
+
+Tue Apr 16 14:55:47 2002  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (ffecom_expr_power_integer): Add has_scope argument to
+	call to expand_start_stmt_expr.
+
+Mon Apr 15 10:59:14 2002  Mark Mitchell  <mark@codesourcery.com>
+
+	* g77.texi: Remove Chill reference.
+
+2002-04-13  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Deprecate frontend version number;
+	update list of fixed bugs.
+
+2002-04-08  Hans-Peter Nilsson  <hp@bitrange.com>
+
+	* Make-lang.in (f/target.o): Depend on diagnostic.h.
+	* target.c: Include diagnostic.h.
+	(ffetarget_memcpy_): Call sorry if host and target endians are
+	not matching.
+
+Thu Apr  4 23:29:48 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (LANG_HOOKS_TRUTHVALUE_CONVERSION): Redefine.
+	(truthvalue_conversion): Rename.  Update.  Make static.
+	(ffecom_truth_value): Update.
+
+Mon Apr  1 21:39:36 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (LANG_HOOKS_MARK_ADDRESSABLE): Redefine.
+	(mark_addressable): Rename.
+	(ffecom_arrayref_, ffecom_1): Update.
+
+Mon Apr  1 09:59:53 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (LANG_HOOKS_SIGNED_TYPE, LANG_HOOKS_UNSIGNED_TYPE,
+	LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE): New.
+	(unsigned_type, signed_type, signed_or_unsigned_type): Rename.
+
+Sun Mar 31 23:50:22 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (lang_print_error_function): Rename.
+	(LANG_HOOKS_PRINT_ERROR_FUNCTION): Redefine.
+	(ffe_init): Don't set hook.
+
+Fri Mar 29 21:59:15 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (LANG_HOOKS_TYPE_FOR_MODE, LANG_HOOKS_TYPE_FOR_SIZE):
+	Redefine.
+	(type_for_mode, type_for_size): Rename.
+	(signed_or_unsigned_type, signed_type, truthvalue_conversion,
+	unsigned_type):	Use new hooks.
+
+Tue Mar 26 10:30:05 2002  Andrew Cagney  <ac131313@redhat.com>
+
+	* invoke.texi (Warning Options): Mention -Wswitch-enum.
+	Fix PR c/5044.
+
+Tue Mar 26 07:30:51 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (LANG_HOOKS_MARK_TREE): Redefine.
+	(lang_mark_tree): Rename ffe_mark_tree, make static.
+
+Mon Mar 25 19:27:11 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (maybe_build_cleanup): Remove.
+
+2002-03-23  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffecom_check_size_overflow_): Add a test
+	so that arrays too large for 32-bit byte-offset
+	addressing get caught.
+	* news.texi: Document the fixing of this problem.
+
+Sat Mar 23 11:18:17 2002  Andrew Cagney  <ac131313@redhat.com>
+
+	* invoke.texi (Warning Options): Mention -Wswitch-default.
+
+Thu Mar 21 18:55:41 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* cp-tree.h (pushdecl, pushlevel, poplevel, set_block,
+	insert_block, getdecls, global_bindings_p): New.
+
+Wed Mar 20 08:03:42 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (lang_printable_name): Rename.
+	(LANG_HOOKS_DECL_PRINTABLE_NAME): Redefine.
+	(ffe_init): Don't use old hook.
+
+Sun Mar 17 18:50:15 2002  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.h (ffe_parse_file): Prototype.
+
+Sun Mar 17 20:57:30 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (LANG_HOOKS_PARSE_FILE): Redefine.
+	* com.h (ffe_parse_file): New.
+	* parse.c (NAME_OF_STDIN): Remove.
+	(yyparse): Rename ffe_parse_file.
+
+Tue Mar 12 20:23:18 2002  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (tree_code_type, tree_code_length, tree_code_name):
+	Define.
+
+Sun Mar 10 12:37:42 2002  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* target.c (ffetarget_print_hex): Const-ify.
+
+2002-03-06  Phil Edwards  <pme@gcc.gnu.org>
+
+	* version.c:  Fix misplaced leading blanks on first line.
+
+2002-03-03  Zack Weinberg  <zack@codesourcery.com>
+
+	* com.c, target.h: Remove all #ifndef REAL_ARITHMETIC
+	blocks, make all #ifdef REAL_ARITHMETIC blocks unconditional.
+	Delete some further #ifdef blocks predicated on REAL_ARITHMETIC.
+
+Thu Feb 28 07:53:46 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (copy_lang_decl): Delete.
+
+2002-02-27  Zack Weinberg  <zack@codesourcery.com>
+
+	* com.c, lex.c, top.c: Delete traditional-mode-related code
+	copied from the C front end but not used, or used only to
+	permit the compiler to link.
+
+2002-02-13  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: List Problem Reports fixed in 3.1.
+
+2002-02-13  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* data.c (ffedata_eval_offset_): Only convert index,
+	low and high bound in data statements to default integer
+	if they are constants.  Use a copy of the data structure.
+
+2002-02-09  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* data.c (ffedata_eval_offset_): Convert non-default integer
+	constants to default integer kind if necessary.
+
+2002-02-09  Toon Moene  <toon@moene.indiv.nlug.nl>
+
+	* invoke.texi: Add a short debugging session
+	as an example to the documentation of -g.
+
+2002-02-06  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	PR fortran/4730 fortran/5473
+	* com.c (ffecom_expr_): Deal with %VAL constructs.
+	* intrin.c (ffeintrin_check_): Handle 'N' constraints for intrinsics,
+	to indicate "no larger than default kind" integers and logicals.
+	* intrin.def: Use 'N' constraints in table of intrinsics.
+	* intdoc.c: Document this constraint.
+	* intdoc.texi: Regenerated.
+
+2002-02-04  Philipp Thomas  <pthomas@suse.de>
+
+	* implic.c lex.c stb.c ste.c stu.c: Update copyright dates.
+
+2002-02-04  Philipp Thomas  <pthomas@suse.de>
+
+	* bad.def com.c expr.c implic.c lex.c stb.c ste.c stu.c:
+	Insert comments to mark messages as not being printf style
+	where appropriate.
+
+2002-02-03  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* expr.c (ffeexpr_sym_impdoitem_): Allow other than
+	default INTEGER implied-do loop counts.
+
+2002-02-01  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* bad.def: Remove non-historical reference to version 0.6.
+	* bugs.texi: Ditto.
+	* com.c: Ditto.
+	* ffe.texi: Ditto.
+	* proj.h: Ditto.
+	* g77.texi: Ditto.
+
+2002-01-31  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77spec.c (lang_specific_driver): Follow GNU Coding Standards
+	for --version.
+
+2002-01-30  Richard Henderson  <rth@redhat.com>
+
+	* ste.c (ffeste_begin_iterdo_): Use expand_exit_loop_top_cond.
+	(ffeste_R819B): Likewise.
+
+2002-01-30  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* intrin.c (upcasecmp_): New function.
+	(ffeintrin_cmp_name_): Use it to correctly compare name
+	and table entry for bsearch.
+
+2002-01-26  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* intrin.c (ffeintrin_cmp_name_): Correct comparison
+	for intrinsics in intrinsic table (intrin.def).
+
+2002-01-22  Zack Weinberg  <zack@codesourcery.com>
+
+	* bad.c: Include intl.h.
+	(FFEBAD_MSGS1, FFEBAD_MSGS2): Replace by FFEBAD_MSG, SHORT,
+	LONG.  Adjust definitions to work with exgettext.
+	(ffebad_start_): Translate all error messages.
+	(ffebad_finish): Mark constant strings for translation.
+	* bad.h: Use FFEBAD_MSG.  Adjust prototype of ffebad_start_
+	and definitions of ffebad_start_msg, ffebad_start_msg_lex to
+	work with exgettext.
+	* bad.def: Use FFEBAD_MSG, SHORT, LONG throughout.
+
+	* com.c: Include intl.h.
+	(lang_print_error_function): Always use ffeinfo_kind_message
+	to get the kind label for a non-nested construct.  Translate
+	it.  Translate constant strings.
+	* info.c (FFEINFO_KIND): Adjust definition to work with exgettext.
+	* info-k.def: Block xgettext from slurping copyright notice
+	into gcc.pot.  Adjust strings for their sole use, in com.c.
+
+	* Make-lang.in (f/bad.o, f/com.o): Depend on intl.h.
+
+2002-01-14  David Billinghurst <David.Billinghurst@riotinto.com>
+
+	PR fortran/3807
+	* f/intrin.c (ffeintrin_check_):  Allow for case of intrinsic
+	control string have COL-spec an integer > 0.
+
+2002-01-08  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77spec.c (lookup_option): Handle -fversion.
+	(lang_specific_driver): Update copyright date in --version output.
+
+Mon Jan  7 00:03:42 2002  Gerald Pfeifer  <pfeifer@dbai.tuwien.ac.at>
+
+	* invoke.texi: Markup g77 as @command.  Remove reference to
+	http://gcc.gnu.org/thanks.html.
+
+Wed Jan  2 18:13:11 2002  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (clear_binding_level): Const-ify.
+	(ffecom_arglist_expr_): Likewise.
+	* info.c (ffeinfo_types_): Don't needlessly zero init.
+	* lex.c (ffelex_hash_kludge): Const-ify.
+
+Sun Dec 23 10:45:09 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (ffecom_gfrt_volatile_, ffecom_gfrt_complex_,
+	ffecom_gfrt_const_, ffecom_gfrt_type_): Const-ify.
+
+Sat Dec 22 16:01:51 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bld.c (ffebld_arity_op_): Declare array size explicitly.
+	* bld.h (ffebld_arity_op_): Likewise.
+
+2001-12-20  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* config-lang.in (diff_excludes): Remove.
+
+2001-12-17  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77.texi, invoke.texi: Update links to GCC manual.
+
+Sun Dec 16 16:08:57 2001  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* news.texi: Fix spelling errors.
+
+Sun Dec 16 10:36:51 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in (f/version.o): Depend on f/version.h.
+	* version.c: Include ansidecl.h and f/version.h.
+
+Sun Dec 16 08:52:48 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* lex.c (ffelex_backslash_, ffelex_cfebackslash_): Use hex_value.
+	* target.c (ffetarget_integerhex, ffetarget_typeless_hex): Use
+	hex_p/hex_value.
+
+2001-12-14  Roger Sayle <roger@eyesopen.com>
+
+	* com-rt.def: Use __builtin_sqrt instead of __builtin_fsqrt.
+	* com.c (ffecom_init_0): Same, and fixed enumeration usage.
+
+2001-12-10  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77.texi: Don't condition menus on @ifinfo.
+
+Wed Dec  5 06:49:21 2001  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (ffecom_1): Properly handle TREE_READONLY for INDIRECT_REF.
+
+Mon Dec  3 18:56:04 2001  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c: Remove leading capital from diagnostic messages, as
+	per GNU coding standards.
+	* g77spec.c: Similarly.
+	* lex.c: Similarly.
+
+2001-12-01  Zack Weinberg  <zack@codesourcery.com>
+
+	* f/fini.c: Use xmalloc.
+
+Fri Nov 30 20:54:02 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in: Delete references to proj.[co], proj-h.[co].
+	* proj.c: Delete file.
+
+2001-11-29  Zack Weinberg  <zack@codesourcery.com>
+
+	* Make-lang.in (f/fini, f/intdoc): Depend on $(HOST_LIBDEPS)
+	and link with $(HOST_LIBS), not safe-ctype.o.
+
+2001-11-29  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* Make-lang.in (f77.generated-manpages): New target.
+	($(srcdir)/f/g77.1): Don't check $(GENERATED_MANPAGES).  Allow
+	manpage generation to fail.
+	(f77.info): Don't depend on $(srcdir)/f/g77.1.
+	(f77.install-man): Depend on $(GENERATED_MANPAGES) rather than
+	directly on $(srcdir)/g77.1.
+
+2001-11-24  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	PR fortran/3957
+	* lang-specs.h: Correct !pipe conditional in tradcpp0 invocation.
+
+2001-11-21  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77.texi: egcs was not a `@command'.
+	* invoke.texi: Ditto.
+	* news.texi: Substitute `@command' for `@code'
+	and `@option' for `@samp' where appropriate.
+
+2001-11-19  Loren J. Rittle  <ljrittle@acm.org>
+
+	* Make-lang.in: Complete ``Build g77.1 in $(srcdir)''.
+
+2001-11-19  Geoffrey Keating  <geoffk@redhat.com>
+
+	* g77spec.c (lang_specific_driver) [ENABLE_SHARED_LIBGCC]: Add
+	libgcc_s.so if libf2c is used.
+	* Make-lang.in (g77spec.o): Use DRIVER_DEFINES.
+
+2001-11-19  Toon Moene <toon@moene.indiv.nluug.nl>
+
+	* .cvsignore: Ignore g77.1
+	* g77.texi: Substitute `@command' for `@code'
+	where appropriate.
+	* invoke.texi: Ditto.
+
+2001-11-18  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* Make-lang.in: Remove all references to LANGUAGES
+	and the stamp files that depend on its value.
+
+Sun Nov 18 11:13:04 2001  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (finish_parse): Remove.
+	(ffe_finish): Move body of finish_parse.
+
+Thu Nov 15 10:06:38 2001  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (ffecom_init_decl_processing): Renamed from
+	init_decl_processing.
+	(init_parse): Move contents to ffe_init.
+	(ffe_init): Update prototype.
+
+2001-11-14  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77.texi: Update to use `@command', `@option.
+	* invoke.texi: Ditto
+
+2001-11-14  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* Make-lang.in: Change all uses of $(manext) to $(man1ext).
+
+2001-11-14  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77.1: Remove from CVS.
+	* Make-lang.in: Build g77.1 in $(srcdir).
+	Add --section=1 to POD2MAN command line.
+	* invoke.texi: Correct copyright years.
+	Add more sections to man page.  Add GFDL.
+
+Fri Nov  9 23:16:45 2001  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (ffe_print_identifier): Rename.
+	(LANG_HOOKS_PRINT_IDENTIFIER): Override.
+	(lang_print_xnode, print_lang_decl, print_lang_statistics,
+	print_lang_type, set_yydebug): Remove.
+
+2001-11-09  Zack Weinberg  <zack@codesourcery.com>
+
+	* g77spec.c (lang_specific_driver): Adjust behavior of -v and
+	--version for consistency with other front ends.  Remove large
+	#if 0 block.  Do not add libraries to argv if there are no
+	input files.
+	(add_version_magic): Delete all references and dependent code.
+	* lang-options.h: Delete -fnull-version.
+	* lang-specs.h: Delete f77-version spec.
+
+	* lex.c: Delete logic conditional on ffe_is_null_version() and
+	now-unused label.
+	* top.c: Delete ffe_is_null_version_ variable.
+	(ffe_decode_option): Delete -fnull-version case.
+	* top.h: Delete declaration of ffe_is_null_version_ and
+	ffe_is_null_version(), ffe_set_is_null_version() macros.
+
+Fri Nov  9 07:14:47 2001  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (language_string, lang_identify): Remove.
+	(struct lang_hooks): Constify.
+	(LANG_HOOKS_NAME): Override.
+	(init_parse): Update.
+
+2001-11-08  Andreas Franck  <afranck@gmx.de>
+
+	* Make-lang.in (G77_INSTALL_NAME, G77_CROSS_NAME): Handle
+	program_transform_name the way suggested by autoconf.
+
+2001-11-08  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* Make-lang.in: Add rules for building g77.1.
+	* invoke.texi: Add man page stuff.  Move indexing
+	from g77.texi to here.
+	* g77.texi: Remove indexing specific to invoke.texi.
+	* news.texi: Document that g77.1 is now a generated
+	file.
+
+Tue Nov  6 21:17:47 2001  Neil Booth  <neil@cat.daikokuya.demon.co.uk>
+
+	* com.c: Include langhooks-def.h.
+	* Make-lang.in: Update.
+
+2001-11-04  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77.texi: Split off invoke.texi (preliminary to using it
+	to generate a man page).
+	* Make-lang.in: Reflect in build rules.
+
+Fri Nov  2 10:51:34 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (ffecom_initialize_char_syntax_, U_CHAR, is_idchar,
+	is_idstart, is_hor_space, is_space, SKIP_WHITE_SPACE,
+	SKIP_ALL_WHITE_SPACE): Delete.
+	(read_filename_string, read_name_map): Don't use is_space or
+	is_hor_space.
+
+2001-10-29  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Document new ability to compile programs with
+	arrays larger than 512 Mbyte on 32-bit targets.
+
+2001-10-24  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffecom_check_size_overflow_): Only check for TREE_OVERFLOW.
+
+Tue Oct 23 14:01:27 2001  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (LANG_HOOKS_GET_ALIAS_SET): New macro.
+	(lang_get_alias_set): Delete.
+
+2001-10-23  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77.texi (Sending Patches): Remove.
+
+2001-10-22  Zack Weinberg  <zack@codesourcery.com>
+
+	* Make-lang.in (f/intdoc): Depend on safe-ctype.o.
+
+Sun Oct 21 17:28:17 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bad.c (ffebad_finish): Use safe-ctype macros and/or fold extra
+	calls into fewer ones.
+	* implic.c (ffeimplic_lookup_): Likewise.
+	* intdoc.c (dumpimp): Likewise.
+	* intrin.c (ffeintrin_init_0): Likewise.
+	* lex.c (ffelex_backslash_, ffelex_cfebackslash_, ffelex_hash_):
+	Likewise.
+	* lex.h (ffelex_is_firstnamechar): Likewise.
+	* target.c (ffetarget_integerhex): Likewise.
+
+2001-10-21  Craig Prescott  <prescott@phys.ufl.edu>
+
+	* target.h (FFETARGET_32bit_longs): Don't define
+	for 64-bit hppa.
+
+2001-10-17  Richard Henderson  <rth@redhat.com>
+
+	* std.c (ffestd_labeldef_format): Fix variable/stmt ordering.
+	(ffestd_R737A): Likewise.
+
+2001-10-17  Richard Henderson  <rth@redhat.com>
+
+	* com.h: Remove FFECOM_targetCURRENT, FFECOM_ONEPASS, BUILT_FOR_270,
+	BUILT_FOR_280, FFECOM_GCC_INCLUDE, all derivitive defines, and all
+	related conditional compilation directives.
+	* bad.c, bld.c, bld.h, com.c, equiv.c, equiv.h, global.h, intdoc.c,
+	intrin.c, intrin.h, lex.c, parse.c, sta.c, std.c, ste.c, ste.h, stt.c,
+	stt.h, stw.h, symbol.c, symbol.h, target.h, top.c: Likewise.
+
+2001-10-17  Richard Henderson  <rth@redhat.com>
+
+	* Make-lang.in (f/com.o): Depend on langhooks.h.
+	* com.c: Include it.
+	(LANG_HOOKS_INIT, LANG_HOOKS_FINISH): New.
+	(LANG_HOOKS_INIT_OPTIONS, LANG_HOOKS_DECODE_OPTION): New.
+	(lang_hooks): Use LANG_HOOKS_INITIALIZER.
+
+Sun Oct  7 12:27:54 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bad.c (_ffebad_message_, ffebad_messages_): Const-ify.
+	* bld.c (ffebld_arity_op_): Likewise.
+	* bld.h (ffebld_arity_op_): Likewise.
+	* com.c (ffecom_init_0): Likewise.
+	* intdoc.c (_ffeintrin_name_, _ffeintrin_gen_, _ffeintrin_spec_,
+	_ffeintrin_imp_, names, gens, imps, specs, cc_pair,
+	cc_descriptions, cc_summaries): Likewise.
+	* intrin.c (_ffeintrin_name_, _ffeintrin_gen_, _ffeintrin_spec_,
+	_ffeintrin_imp_, ffeintrin_names_, ffeintrin_gens_,
+	ffeintrin_imps_, ffeintrin_specs_): Likewise.
+
+2001-10-05  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Document libf2c being built as a shared library.
+	Use of array elements in bounds of adjustable arrays ditto.
+
+2001-10-03  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* Make-lang.in: Remove reference to FORTRAN_INIT.
+	* g77spec.c: Add reference to FORTRAN_INIT.
+
+2001-09-29  Juergen Pfeifer  <juergen.pfeifer@gmx.net>
+
+	Make libf2c a shared library.
+
+	* Make-lang.in: Pass define of frtbegin.o to compilation of g77spec.c.
+	* g77spec.c (lang_specific_driver): Treat linking in of frtbegin.o.
+
+2001-09-28  Robert Anderson  <rwa@alumni.princeton.edu>
+
+	* expr.c (ffeexpr_sym_rhs_dimlist_): Allow array elements
+	as bounds of adjustable arrays.
+
+Thu Sep 20 15:05:20 JST 2001  George Helffrich  <george@geo.titech.ac.jp>
+
+	* com.c (ffecom_subscript_check_): Loosen subscript checking rules
+	for character strings, to permit substring expressions like
+	string(1:0).
+	* news.texi: Document this as a new feature.
+
+Thu Sep 13 10:33:27 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bad.c (ffebad_finish): Const-ification and/or static-ization.
+	* intrin.c (ffeintrin_cmp_name_): Likewise.
+	* stc.c (ffestc_R904): Likewise.
+
+Wed Sep 12 12:09:04 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bld.c (ffebld_op_string_): Const-ification.
+	* com.c (ffecom_gfrt_name_, ffecom_gfrt_argstring_): Likewise.
+	* fini.c (xspaces): Likewise.
+	* global.c (ffeglobal_type_string_): Likewise.
+	* info.c (ffeinfo_basictype_string_, ffeinfo_kind_message_,
+	ffeinfo_kind_string_, ffeinfo_kindtype_string_,
+	ffeinfo_where_string_): Likewise.
+	* lex.c (ffelex_type_string_): Likewise.
+	* malloc.c (malloc_types_): Likewise.
+	* stc.c (ffestc_subr_binsrch_, ffestc_R904, ffestc_R904,
+	ffestc_R907): Likewise.
+	* symbol.c (ffesymbol_state_name_, ffesymbol_attr_name_):
+	Likewise.
+	* version.c (ffe_version_string): Likewise.
+	* version.h (ffe_version_string): Likewise.
+
+2001-09-11  Richard Henderson  <rth@redhat.com>
+
+	* parse.c (finput): Mark extern.
+
+2001-09-11  Jakub Jelinek  <jakub@redhat.com>
+
+	* com.c (ffe_init_options): Default to -fmerge-all-constants
+	if optimizing.
+
+2000-08-14  Ulrich Weigand  <uweigand@de.ibm.com>
+
+	* target.h (FFETARGET_32bit_longs): Don't define
+	for 64-bit S/390.
+
+2001-07-20  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffecom_expr_intrinsic_):
+	case FFEINTRIN_impIBITS: Remove TREE_SHIFT_FULLWIDTH define.
+	case FFEINTRIN_impISHFT: Ditto. Change LT_EXPR to NE_EXPR.
+	case FFEINTRIN_impISHFTC: Ditto.
+	case FFEINTRIN_impMVBITS: Ditto.
+
+2001-07-19  Jakub Jelinek  <jakub@redhat.com>
+
+	* top.c (ffe_decode_option): Disallow lang-independent processing
+	for -ffixed-form.
+
+2001-07-19  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* f/com.c (ffecom_expr_intrinsic_): Deal (correctly) with
+	{L|R}SHIFT_EXPR not working when shift > size of type.
+
+2001-07-17  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (lang_print_error_function): Argument context
+	is unused.
+
+2001-07-14  Tim Josling  <tej@melbpc.org.au>
+
+	* com.c (ffecom_overlap_): Remove references to EXPON_EXPR.
+	(ffecom_tree_canonize_ref_): Likewise.
+
+2001-07-10  James Smaby  <jsmaby@virgo.umeche.maine.edu>
+
+	* intdoc.in: Fix the definition of COMPLEX ABS.
+	Remove `the' where inappropriate.
+	* intdoc.texi: Rebuilt.
+
+2001-07-04  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77.texi: Use gpl.texi and funding.texi.  Remove Look and Feel
+	section.  Add Funding Free Software to invariant sections.
+	* Make-lang.in ($(srcdir)/f/g77.info, f/g77.dvi): Update
+	dependencies and use doc/include in search path.
+
+2001-06-28  Gabriel Dos Reis  <gdr@codesourcery.com>
+
+	* Make-lang.in (f/com.o): Depend on diagnostic.h
+	* com.c: #include diagnostic.h
+	(lang_print_error_function): Take a 'diagnostic_context *'.
+
+Wed Jun 13 11:22:39 2001  Mark Mitchell  <mark@codesourcery.com>
+
+	* BUGS: Remove.
+	* NEWS: Likewise.
+
+2001-06-10  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77install.texi: Remove.
+	* Make-lang.in: Remove all mention of g77install.texi.
+	* g77.texi: Add documentation on how to get output always
+	flushed and how to increase the maximum unit number.
+	Remove all mention of g77install.texi.
+	* bugs.texi: Add documentation on how to change the threshold
+	for putting local arrays on the stack.
+
+2001-06-03  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* root.texi: Fix typo in patches e-mail address.
+
+2001-06-03  Toon Moene  <toon@moene.indiv.nluug.nl>
+	    Jan van Male  <jan.vanmale@fenk.wau.nl>
+
+	* root.texi: Define `help' and `patches' mailing list
+	addresses.
+	* news.texi: Remove `prerelease' from 0.5.26
+	* g77.texi: Use two spaces between command options, eliminate
+	some 'overfull hboxes'.  Use help and patches mailing list
+	addresses where appropriate.
+
+2001-06-02  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77.texi: Move contents to just after title page.
+
+2001-06-02  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffecom_init_0): Make CHARACTER*1 unsigned.
+
+2001-05-23  Theodore Papadopoulo  <Theodore.Papadopoulo@sophia.inria.fr>
+
+	* Make-lang.in ($(srcdir)/f/g77.info): Added dependencies on
+	fdl.texi.
+	(f/g77.dvi): Use TEXI2DVI instead of custom tex calls.  Create the
+	dvi file in the f directory.
+
+2001-05-25  Sam TH  <sam@uchicago.edu>
+
+	* bad.h: Fix header include guards.
+	* bit.h bld.h com.h data.h equiv.h expr.h global.h
+	implic.h info.h intrin.h lab.h lex.h malloc.h name.h
+	proj.h src.h st.h sta.h stb.h stc.h std.h ste.h
+	storag.h stp.h str.h sts.h stt.h stu.h stv.h stw.h
+	symbol.h target.h top.h type.h version.h
+	where.h: Likewise.
+
+2001-05-22  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77.texi: Update last-changed date.
+	* news.texi: Update copyright years, last-changed date.
+	* bugs.texi: Update copyright years, last-changed date.
+
+2001-05-22  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77.texi: Update maintenance information for
+	GNU Fortran.  Remove all mention of -fdebug-kludge.
+	* news.texi: Make more news in 0.5.26 `user visible
+	changes'. Acknowledge work by important contributors.
+	* bugs.texi: Remove all mention of -fdebug-kludge.
+
+2001-05-20  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* Make-lang.in (f/g77.dvi): Include $(srcdir) in TEXINPUTS.
+
+2001-05-19  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* Make-lang.in: Have $(MAKEINFO) look into the parent
+	directory for includes.
+	* g77.texi: Use the GFDL.
+
+Sun May 13 12:25:06 2001  Mark Mitchell  <mark@codesourcery.com>
+
+	* Make-lang.in: Replace all uses of `touch' with $(STAMP).
+
+Wed May  2 10:20:08 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c: NULL_PTR -> NULL.
+
+Sun Apr 22 20:18:01 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (ffecom_subscript_check_): Use concat in lieu of
+	xmalloc/sprintf.
+
+2001-04-21  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Update release information for 0.5.27.
+
+Thu Apr 19 12:49:24 2001  Mark Mitchell  <mark@codesourcery.com>
+
+	* top.c (ffe_decode_option): Do not permit language-independent
+	processing for -ffixed-line-length.
+
+Thu Apr 12 17:57:55 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bad.c (inhibit_warnings): Delete redundant declaration.
+
+	* com.c (skip_redundant_dir_prefix): Likewise.
+
+	* com.h (mark_addressable): Likewise.
+
+2001-04-02  Jakub Jelinek  <jakub@redhat.com>
+
+	* lex.c (ffelex_hash_): Avoid eating one whole line after
+	#line.
+
+Mon Apr  2 22:38:09 2001  Toon Moene <toon@moene.indiv.nluug.nl>
+
+	* com.c (duplicate_decls): Fix thinko in lazy DECL_RTL patch
+	of 2001-03-04.
+
+Tue Mar 27 17:40:08 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in: Depend on $(SYSTEM_H), not system.h.
+
+Mon Mar 26 18:13:30 2001  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (duplicate_decls): Don't copy DECL_FRAME_SIZE.
+
+Mon Mar 19 15:05:39 2001  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (builtin_function): Use SET_DECL_ASSEMBLER_NAME.
+
+Wed Mar 14 09:29:27 2001  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (ffecom_member_phase_2): Use COPY_DECL_RTL,
+	DECL_RTL_SET_P, etc.
+	(duplicate_decls): Likewise.
+	(start_decl): Likewise.
+
+Fri Mar  9 22:52:55 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* fini.c (main): Use really_call_malloc, not malloc.
+
+Thu Mar  8 13:27:47 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c: Don't rely on the POSIX macro to define autoconf stuff.
+
+2001-03-07  Brad Lucier  <lucier@math.purdue.edu>
+
+	* g77.texi: Document new options -funsafe-math-optimizations
+	and -fno-trapping-math.  Revise documentation for -ffast-math.
+
+2001-03-01  Zack Weinberg  <zackw@stanford.edu>
+
+	* proj.h: Delete 'bool' type.  Don't include stddef.h here.
+	* com.c: Rename variables named 'true' and/or 'false'.
+	* intdoc.c: Delete 'bool' type.
+
+2001-03-01  Zack Weinberg  <zackw@stanford.edu>
+
+	* lang-specs.h: Add zero initializer for cpp_spec field to all
+	array elements.
+
+2001-02-24  Zack Weinberg  <zackw@stanford.edu>
+
+	* com.c: Don't define STDC_HEADERS, autoconf handles it.
+
+Fri Feb 23 15:28:39 2001  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (set_block): Set NAMES and BLOCKS from BLOCK.
+
+2001-02-19  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* version.c, root.texi: Update GCC version number to 3.1.  Update
+	G77 version number to 0.5.27.
+	* BUGS, NEWS: Regenerate.
+
+Sun Feb  4 15:52:44 2001  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (ffecom_init_0): Call fatal_error instead of fatal.
+	* com.c (init_parse): Call fatal_io_error instead of
+	pfatal_with_name.
+	(ffecom_decode_include_option_): Make errors non-fatal.
+	* lex.c (ffelex_cfelex_, ffelex_get_directive_line_): Likewise.
+	(ffelex_hash_): Likewise.
+
+Sat Jan 27 20:52:18 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in: Remove all dependencies on defaults.h.
+	* com.c: Don't include defaults.h.
+
+2001-01-23  Michael Sokolov  <msokolov@ivan.Harhan.ORG>
+
+	* com.c: Don't explicitly include any time headers, the right ones are
+	already included by proj.h.
+
+2001-01-15  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (ffecom_lookup_label): Set DECL_CONTEXT for FORMAT
+	label to current_function_decl.
+
+Fri Jan 12 17:21:33 2001  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77spec.c (lang_specific_driver): Update copyright year to 2001.
+
+Wed Jan 10 14:39:45 2001  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (ffecom_init_zero_):  Remove last argument in call to
+	make_decl_rtl; use make_function_rtl instead of make_decl_rtl.
+	(ffecom_lookup_label_): Likewise.
+	(builtin_function): Likewise.
+	(start_function): Likewise.
+
+Thu Dec 21 21:19:42 2000  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77install.texi, g77.texi: Update last-updated dates for
+	installation information and the manual as a whole.
+	* bugs.texi, news.texi: Update copyright years in the comments at
+	the top of the file.
+
+2000-12-21  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77install.texi: Adjust wording of an EGCS reference.
+
+Thu Dec 21 20:00:48 2000  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* BUGS, NEWS: Regenerate.
+
+2000-12-18  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* com.c [VMS]: Remove definition of BSTRING.
+
+2000-12-18  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77.texi: Update GPL copy not to refer to years 19@var{yy}.
+
+2000-12-18  Toon Moene <toon@moene.indiv.nluug.nl>
+
+	* bugs.texi: Correct copyright years.
+	* g77.texi: Likewise.
+	* news.texi: Likewise.
+
+2000-12-18  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77install.texi: Remove obsolete parts only used for INSTALL,
+	and DOC-G77 conditionals.  Update last-update-install date.
+
+Sat Dec  9 10:20:11 2000  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* .cvsignore: New file; add info files.
+
+2000-12-08  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* Make-lang.in (f77.info): Depend on info files in source
+	directory.
+	(f/g77.info): Build info files in source directory; don't build
+	them unless BUILD_INFO is "info".
+	(f77.install-info): Install info files from source directory.
+
+2000-12-07  Zack Weinberg  <zack@wolery.stanford.edu>
+
+	* Make-lang.in: Link f/fini with safe-ctype.o.
+	* bad.c: Don't test ISUPPER(c) || ISLOWER(c) before calling TOUPPER(c).
+	* com.c: Use TOUPPER, not ffesrc_toupper.
+	* fini.c: Don't test ISALPHA(c) before calling TOUPPER(c)/TOLOWER(c).
+	* intrin.c: Don't test IN_CTYPE_DOMAIN(c).
+	* src.c: Delete ffesrc_toupper_ and ffesrc_tolower_ and their
+	initializing code; use TOUPPER and TOLOWER instead of
+	ffesrc_toupper and ffesrc_tolower.
+	* src.h: Don't declare ffesrc_toupper_ or ffesrc_tolower_.
+	Don't define ffesrc_toupper or ffesrc_tolower.
+
+2000-11-28  Richard Henderson  <rth@redhat.com>
+
+	* com.c (ffecom_member_phase2_): Set TREE_USED on the debugging decl.
+
+2000-11-26  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* RELEASE-PREP: Remove obsolete EGCS reference.
+	* g77.texi: Adjust reference to EGCS as something current.
+	* lang-options.h (FTNOPT): Remove macro and obsolete comment.
+	Include doc strings directly in option listing instead of through
+	this macro.
+	* root.texi: Remove support for multiple different (FSF and EGCS)
+	distributions of g77.
+	* g77install.texi: Remove conditioned out instructions applying
+	only to obsolete distributions of g77 not as part of GCC.  Change
+	"superceded" to the correct spelling "superseded".
+
+Sun Nov 26 19:25:56 2000  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77spec.c (lang_specific_driver): Update copyright year to 2000.
+
+Thu Nov 23 02:18:57 2000  J"orn Rennecke <amylaar@redhat.com>
+
+	* Make-lang.in (g77spec.o): Depend on $(CONFIG_H).
+
+2000-11-21  David Billinghurst  <David.Billinghurst@riotinto.com)
+
+	* Make-lang.in:  Add $(build_exeext) to f/fini target
+
+2000-11-21  Andreas Jaeger  <aj@suse.de>
+
+	* g77.texi (Floating-point Exception Handling): Use feenableexcept
+	in example.
+	(Floating-point precision): Change to match above change.
+
+Sun Nov 19 17:29:22 2000  Matthias Klose  <doko@marvin.itso-berlin.de>
+
+	* g77.texi (Floating-point precision): Adjust example
+	to work with glibc (>= 2.1).
+
+Sat Nov 18 13:54:49 2000  Matthias Klose  <doko@cs.tu-berlin.de>
+
+	* g77.texi (Floating-point Exception Handling): Adjust
+	example to work with glibc (>= 2.1).
+
+2000-11-18  Alexandre Oliva  <aoliva@redhat.com>
+
+	* Make-lang.in (INTDOC_DEPS): New macro.
+	(f/intdoc.texi): Depend on $(INTDOC_DEPS).  Build f/intdoc.
+	(f/intdoc): Likewise.  Add $(build_exeext).
+
+2000-11-17  Zack Weinberg  <zack@wolery.stanford.edu>
+
+	* lex.c (ffelex_hash_): Change ggc_alloc_string (var, -1) to
+	ggc_strdup (var).
+
+Thu Nov 16 23:14:07 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* malloc.c (malloc_init): Call xmalloc, not malloc.
+
+2000-11-10  Rodney Brown  <RodneyBrown@mynd.com>
+
+	* Make-lang.in: Remove OUTPUT_OPTION from g77version.o target.
+
+2000-11-10  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* root.texi: Remove non-historical EGCS reference.
+	Set current g77 version to 0.5.26.
+
+2000-11-10  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffecom_stabilize_aggregate_) case RTL_EXPR: Abort.
+
+2000-11-10  Zack Weinberg  <zack@wolery.stanford.edu>
+
+	* Make-lang.in (f/fini.o, f/proj-h.o): Remove pointless sed
+	munging of source file name.
+	($(srcdir)/f/intdoc.texi): Break up into several rules each of
+	which builds just one thing.  Don't mess with $(LANGUAGES).
+	(f/ansify.o, f/intdoc.o): Remove unnecessary rules.
+
+2000-11-05  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* root.texi, news.texi, g77install.texi, g77.texi, bugs.texi:
+	Remove non-historical references to egcs/EGCS.
+
+2000-11-05  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* Make-lang.in: Remove f77.distdir and f/INSTALL.
+	* INSTALL, install0.texi: Remove.
+
+2000-11-02  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* com.c (open_include_file, ffecom_open_include_): Use strchr ()
+	and strrchr () instead of index () and rindex ().
+
+2000-10-27  Zack Weinberg  <zack@wolery.stanford.edu>
+
+	* Make-lang.in: Move all build rules here from Makefile.in,
+	adapt to new context.  Wrap all rules that change the current
+	directory in parentheses.  Expunge all references to $(P).
+	When one command depends on another and they're run all at
+	once, use && to separate them, not ;.  Add OUTPUT_OPTION to
+	all object-file generation rules.  Delete obsolete variables.
+
+	* Makefile.in: Delete.
+	* config-lang.in: Delete outputs= line.
+
+Sat Oct 21 18:07:48 2000  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* Makefile.in, g77spec.c: Remove EGCS references in comments.
+
+Thu Oct 12 22:28:51 2000  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (ffecom_do_entry_): Don't mess with obstacks.
+	(ffecom_finish_global_): Likewise.
+	(ffecom_finish_symbol_transform_): Likewise.
+	(ffecom_gen_sfuncdef_): Likewise.
+	(ffecom_init_zero_): Likewise.
+	(ffecom_start_progunit_): Likewise.
+	(ffecom_sym_transform_): Likewise.
+	(ffecom_sym_transform_assign_): Likewise.
+	(ffecom_transform_equiv_): Likewise.
+	(ffecom_transform_namelist_): Likewise.
+	(ffecom_vardesc_): Likewise.
+	(ffecom_vardesc_array_): Likewise.
+	(ffecom_vardesc_dims_): Likewise.
+	(ffecom_end_transition): Likewise.
+	(ffecom_make_tempvar): Likewise.
+	(bison_rule_pushlevel_): Likewise.
+	(bison_rule_compstmt_): Likewise.
+	(finish_decl): Likewise.
+	(finish_function): Likewise.
+	(push_parm_decl): Likewise.
+	(start_decl): Likewise.
+	(start_function): Likewise.
+	(ggc_p): Don't define.
+	* std.c (ffestd_stmt_pass_): Likewise.
+	* ste.c (ffeste_end_block_): Likewise.
+	(ffeste_end_stmt_): Likewise.
+	(ffeste_begin_iterdo_): Likewise.
+	(ffeste_io_ialist_): Likewise.
+	(ffeste_io_cilist_): Likewise.
+	(ffeste_io_inlist_): Likewise.
+	(ffeste_io_olist_): Likewise.
+	(ffeste_R810): Likewise.
+	(ffeste_R838): Likewise.
+	(ffeste_R839): Likewise.
+	(ffeste_R842): Likewise.
+	(ffeste_R843): Likewise.
+	(ffeste_R1001): Likewise.
+
+2000-10-05  Richard Henderson  <rth@cygnus.com>
+
+	* com.c (finish_function): Don't init can_reach_end.
+
+Sun Oct  1 11:43:44 2000  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (lang_mark_false_label_stack): Remove.
+
+2000-09-10  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* com.c: Include defaults.h.
+	* com.h: Don't define the *_TYPE_SIZE macros.
+	* Makefile.in: Update dependencies.
+
+2000-08-29  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* ansify.c: Use #line, not # <number>.
+
+2000-08-24  Greg McGary  <greg@mcgary.org>
+
+	* intdoc.c (ARRAY_SIZE): Remove macro.
+	* proj.h (ARRAY_SIZE): Remove macro.
+	* com.c (init_decl_processing): Use ARRAY_SIZE.
+
+2000-08-22  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com-rt.def: Adapt macro DEFGFRT to accept CONST boolean.
+	* com.c (macro DEFGFRT): Use CONST boolean.
+	(ffecom_call_binop_): Choose between call by value
+	and call by reference.
+	(ffecom_expr_): Use direct calls to (g)libc functions for
+	POW_DD, LOG10, (float) MOD.
+	(ffecom_make_gfrt_): Add const indication to table of
+	intrinsics.
+	* com.h (macro DEFGFRT): Use CONST boolean.
+	* intrin.def: Adjust DEFIMP definition of LOG10, (float) MOD.
+
+2000-08-21  Nix  <nix@esperi.demon.co.uk>
+
+	* lang-specs.h: Do not process -o or run the assembler if
+	-fsyntax-only.  Use %j instead of /dev/null.
+
+2000-08-21  Jakub Jelinek  <jakub@redhat.com>
+
+	* lang-specs.h: Pass -I* options to f771.
+
+2000-08-19  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* top.c (ffe_decode_option): Disable -fdebug-kludge
+	and warn about it.
+	* lang-options.h: Document the fact.
+	* g77.texi: Ditto.
+
+2000-08-13  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* bugs.texi: Describe new ability to emit debug info
+	for EQUIVALENCE members.
+	* news.texi: Ditto.
+
+2000-08-11  G. Helffrich  <george@gly.bris.ac.uk>
+	    Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffecom_transform_equiv_): Make EQUIVALENCEs addressable
+	so that debug info can be attached to their storage.
+	Unconditionally list the storage set aside for them.
+
+2000-08-07  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77spec.c (lang_specific_driver): Clearer g77 version message.
+
+2000-08-04  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* Make-lang.in (f771): Depend on $(BACKEND), not stamp-objlist.
+	* Makefile.in: Add BACKEND; delete OBJS, OBJDEPS.
+	(f771): Link with $(BACKEND).
+
+2000-08-02  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* g77spec.c: Adjust type of second argument to
+	lang_specific_driver, and update code as necessary.
+
+	* expr.c (ffeexpr_finished_): Cast signed side of ?:
+	expression to bool.
+
+2000-07-31  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* lang-specs.h: Rename cpp to cpp0 and/or tradcpp to tradcpp0.
+
+Thu Jul 27 11:50:08 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* fini.c (main): Avoid automatic aggregate initialization.
+
+	* proj.h: Indent #error directive.
+
+2000-07-26  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* lang-specs.h: Remove one /dev/null from tradcpp invocation.
+
+Sun Jul 23 15:47:30 2000  Billinghurst, David <David.Billinghurst@riotinto.com>
+
+	* Make-lang.in: Put $(build_exeext) suffix on programs which run
+	on the build machine.
+
+2000-07-22  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffecom_expr_intrinsic_): case FFEINTRIN_impFGETC_subr,
+	FFEINTRIN_impFPUTC_subr: Check for arg3 being NULL.
+
+2000-07-13  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* lang-specs.h: Use the new named specs.  Remove unnecessary braces.
+
+2000-07-02  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* version.c: Bump version number.
+
+2000-06-21  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* Make-lang.in (F77_SRCS): Remove all .j files.
+	* Makefile.in (ASSERT_H, CONFIG_H, CONVERT_H, FLAGS_H, GGC_H,
+	GLIMITS_H, HCONFIG_H, INPUT_H, OUTPUT_H, RTL_H, SYSTEM_H,
+	TOPLEV_H, TREE_H): Remove references to .j files.
+	(TCONFIG_H, TM_H): Remove entirely.
+	(deps-kinda): Delete rule.
+	Correct commentary.
+
+	* assert.j, config.j, convert.j. flags.j, ggc.j, glimits.j,
+	hconfig.j, input.j, output.j, rtl.j, system.j, toplev.j,
+	tree.j, tconfig.j, tree.j: Delete.
+
+	* ansify.c, bad.c, bit.c, com.c, com.h, intdoc.c, lex.c,
+	parse.c, proj.c, proj.h, ste.c, target.c, target.h, top.c,
+	where.c, where.h: Include parent-directory headers directly.
+	* lex.c: Don't include tree.h twice.
+
+2000-05-17  H.J. Lu  (hjl@gnu.org)
+
+	* Make-lang.in: Use a unique stamp for each target to support
+	parallel make.
+
+Thu Jun 15 14:03:14 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* ste.c (gbe_block): Constify.
+
+2000-06-13  Jakub Jelinek  <jakub@redhat.com>
+
+	* com.c (ffecom_transform_common_): Set DECL_USER_ALIGN.
+	(ffecom_transform_equiv_, ffecom_decl_field): Likewise.
+	(ffecom_init_0): Set DECL_USER_ALIGN resp. TYPE_USER_ALIGN.
+	(duplicate_decls): Set DECL_USER_ALIGN.
+
+Sun Jun 11 00:03:00 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (lang_get_alias_set): Mark parameter with ATTRIBUTE_UNUSED.
+
+2000-06-04  Philipp Thomas  <pthomas@suse.de>
+
+	* Makefile.in(INTLLIBS): New macro.
+	(LIBS): Add INTLLIBS.
+	(DEPLIBS): Likewise.
+
+2000-06-02  Richard Henderson  <rth@cygnus.com>
+
+	* com.c (lang_get_alias_set): New.
+
+2000-05-28  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* bugs.texi: Note that debugging information for
+	common block items is emitted now.
+	* news.texi: Ditto.
+
+2000-05-18  Chris Demetriou  <cgd@sibyte.com>
+
+	* com.h (FFECOM_f2cINTEGER, FFECOM_f2cLONGINT): Note that
+	these types correspond to built-in types now defined in
+	the C front end (for libf2c).
+
+Wed May 17 17:27:44 2000  Andrew Cagney  <cagney@b1.cygnus.com>
+
+	* top.c (ffe_decode_option): Update -Wall unused flags by calling
+	set_Wunused.
+
+2000-05-09  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* com.c (ffecom_subscript_check_): Constify array_name
+	parameter. Clean up string bashing.
+	(ffecom_arrayref_, ffecom_char_args_x_): Constify array_name
+	parameter.
+	(ffecom_do_entry_, ffecom_gen_sfuncdef_, ffecom_start_progunit_,
+	ffecom_sym_transform_, ffecom_sym_transform_assign_): Constify
+	local char *.
+	(init_parse): Constify parameter and return value.
+	* lex.c: Include dwarfout.h instead of prototyping dwarfout_*
+	functions here.
+	(ffelex_file_pop_, ffelex_file_push_): Constify filename parameter.
+	(ffelex_hash_, ffelex_include_): Constify local char *.
+	* std.c (ffestd_exec_end): Constify local char *.
+	* where.c (ffewhere_file_new): Constify filename parameter.
+	* where.h: Update prototypes.
+
+2000-05-06  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* com.c (ffecom_overlap_): Set source_offset to
+	bitsize_zero_node.
+	(ffecom_tree_canonize_ptr_): Use size_binop.  Convert to
+	bitsizetype before multiplying by TYPE_SIZE.
+	(ffecom_tree_canonize_ref_) [case ARRAY_REF]: Break up offset
+	calculation.  Convert to bitsizetype before multiplying by
+	TYPE_SIZE.
+
+2000-04-18  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* lex.c: Remove references to cccp.c.
+	* g77install.texi: Remove references to cexp.c/cexp.y.
+
+2000-04-15  David Edelsohn  <edelsohn@gnu.org>
+
+	* target.h (FFETARGET_32bit_longs): Define for 64-bit PowerPC
+	as well.
+
+Wed Apr 12 15:15:26 2000  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.h (FFECOM_f2cINTEGER): Avoid using LONG_TYPE_SIZE as a
+	preprocessor constant.
+	(FFECOM_f2cLOGICAL): Likewise.
+	(FFECOM_f2cLONGINT): Likewise.
+
+Wed Apr  5 17:46:39 2000  Mark Mitchell  <mark@codesourcery.com>
+
+	* Makefile.in (GGC_H): Add varray.h.
+
+2000-04-03  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* lang-specs.h: Pass -fno-show-column to the preprocessor.
+
+2000-03-28  Franz Sirl  <Franz.Sirl-kernel@lauterbach.com>
+
+	* com.c (ffecom_decl_field): Use DECL_ALIGN for a FIELD_DECL.
+	(ffecom_init_0): Likewise.
+
+Sat Mar 25 09:12:10 2000  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (ffecom_tree_canonize_ptr_): Use bitsize_zero_node.
+	(ffecom_tree_canonize_ref_): Likewise.
+
+Mon Mar 20 15:49:40 2000  Jim Wilson  <wilson@cygnus.com>
+
+	* f/target.h (FFETARGET_32bit_longs): New.  Define for alpha, sparc64,
+	and ia64.
+	(ffetargetInteger1, ffetargetLogical1, ffetargetReal1, ffetargetReal2,
+	ffetarget_integerdefault_is_magical): Use FFETARGET_32bit_longs.
+
+Fri Mar 10 00:43:55 2000  Jason Merrill  <jason@casey.cygnus.com>
+
+	* com.c (ffecom_stabilize_aggregate_): Don't refer to TREE_RAISES.
+
+Mon Mar  6 18:05:19 2000  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (ffecom_f2c_set_lio_code_): Use compare_tree_int.
+	(ffecom_sym_transform_, ffecom_transform_common_): Likewise.
+	(ffecom_transform_equiv_): Likewise.
+
+Mon Mar  6 13:01:19 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* ansify.c (die_unless): Don't use ANSI string concatenation.
+	(die): Mark with ATTRIBUTE_NORETURN.
+
+Wed Mar  1 00:31:44 2000  Martin von Loewis  <loewis@informatik.hu-berlin.de>
+
+	* com.c (current_function_decl): Move to toplev.c.
+
+Sun Feb 27 16:40:33 2000  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (ffecom_arrayref_): Convert args to size_binop to proper type.
+	(ffecom_tree_canonize_ptr_): Don't use size_binop for non-sizes.
+	(ffecom_tree_canonize_ref_): Likewise.
+	(type_for_mode): Handle TImode.
+	* ste.c (ffeste_io_dofio_, ffeste_io_douio_): Use TYPE_SIZE_UNIT.
+	(ffeste_io_ciclist_): Likewise.
+
+2000-02-23  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* com.c (ffecom_type_permanent_copy_): Delete unused function.
+	(finish_decl): Don't change TREE_PERMANENT (DECL_INITIAL (decl)).
+
+Sat Feb 19 18:43:13 2000  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (ffecom_sym_transform): Use DECL_SIZE_UNIT.
+	(ffecom_transform_common_, ffecom_transform_equiv_): Likewise.
+	(duplicate_decls): Likewise.
+	(ffecom_tree_canonize_ptr_): Delete extra arg to bitsize_int.
+	(finish_decl): Delete -Wlarger-than processing.
+
+Fri Feb 18 13:19:34 2000  Martin von Loewis  <loewis@informatik.hu-berlin.de>
+
+	* g77spec.c (lang_specific_driver): Use GCCBUGURL.
+
+2000-02-17  Andy Vaught  <andy@maxwell.la.asu.edu>
+
+	* com.c (ffecom_member_phase2_): Re-enable COMMON debug code.
+	(ffecom_finish_symbol_transform_): Likewise.
+	(ffecom_transform_common_): Call ffestorag_set_hook.
+
+Wed Feb 16 11:09:38 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in (g77spec.o): Depend on $(GCC_H), not gcc.h.
+
+2000-02-15  Jonathan Larmour  <jlarmour@redhat.co.uk>
+
+	* lang-specs.h: Add new __GNUC_PATCHLEVEL__ define to default spec.
+
+Tue Feb 15 11:14:17 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* g77spec.c: Don't declare `version_string'.
+
+Sat Feb  5 23:27:25 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (mark_tracker_head, mark_binding_level): Protoize.
+
+	* where.c (mark_ffewhere_head): Likewise.
+
+Wed Jan 12 09:32:59 2000  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* lang-specs.h: Pass -lang-fortran to preprocessor.
+
+Thu Dec 30 13:14:31 1999  Richard Henderson  <rth@cygnus.com>
+
+	* stw.h (struct _ffestw_): Change type of uses_ to int.
+
+Thu Dec 30 11:42:05 1999  Geoff Keating  <geoffk@cygnus.com>
+
+	* com.c (ffecom_init_0): Make double_ftype_double,
+	float_ftype_float, ldouble_ftype_ldouble,
+	ffecom_tree_ptr_to_fun_type_void local.
+	(tracker_head): New static variable.
+	(mark_tracker_head): New, marker procedure for tracker_head.
+	(ffecom_save_tree_forever): New procedure.
+	(ffecom_init_zero_): Remove obstack use.
+	(ffecom_make_gfrt_): Remove obstack use.
+	(ffecom_sym_transform_): Remove obstack use, save appropriate trees.
+	(ffecom_transform_common_): Remove obstack use, save appropriate
+	trees.
+	(ffecom_type_namelist_): Remove obstack use, save appropriate
+	trees.
+	(ffecom_type_vardesc_): Remove obstack use, save appropriate trees.
+	(ffecom_lookup_label): Remove obstack use, save appropriate trees.
+	(duplicate_decls): Remove obstack use.
+	(finish_function): push & pop ggc context around
+	rest_of_compilation when building nested function.
+	(mark_binding_level): New function.
+	(init_decl_processing): Mark all the GC roots.
+	(ggc_p): Set to 1.
+	(lang_mark_tree): New function.
+	(lang_mark_false_label_stack): New trivial function.
+	* com.h (ffecom_save_tree_forever): Declare as external.
+	* lex.c (ffelex_hash_): Use GC to allocate the filename string
+	even when ffelex_kludge_flag_.
+	* ste.c (ffeste_io_ialist_): Register a static root.
+	(ffeste_io_inlist_): Likewise.
+	(ffeste_io_icilist_): Likewise.
+	(ffeste_io_cllist_): Likewise.
+	(ffeste_io_cilist_): Likewise.
+	(ffeste_io_olist_): Likewise.
+	* Makefile.in (OBJS): Don't use ggc-callbacks.o.
+	(OBJDEPS): Likewise.
+	(GGC_H): New variable.
+	Update dependencies.
+	* where.c (ffewhere_head): New global.
+	(mark_ffewhere_head): New marker procedure for ffewhere_head.
+	(ffewhere_file_kill): Use GC to do memory management.
+	(ffewhere_file_new): Use GC to do memory management.
+	* ggc.j: New file.
+
+Wed Dec 29 19:29:26 1999  Gerald Pfeifer  <pfeifer@dbai.tuwien.ac.at>
+
+	* g77.texi (C Interfacing Tools): Fix an incorrect link.
+
+1999-12-13  Jakub Jelinek  <jakub@redhat.com>
+
+	* target.h: Handle sparc64 the same way as alpha.
+
+Sun Nov 28 21:39:05 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (ffecom_file_, ffecom_file, file_buf,
+	ffecom_open_include_): Constify a char*.
+	(ffecom_possible_partial_overlap_): Mark parameter `expr2' with
+	ATTRIBUTE_UNUSED.
+	(ffecom_init_0): Use a fully prototyped cast in call to bsearch.
+	(lang_print_error_function): ANSI-fy.
+
+	* com.h (ffecom_file): Constify a char*.
+
+	* fini.c (main): Call return, not exit.
+
+	* g77spec.c (lang_specific_driver): Use non-const *in_argv in
+	assignment.
+
+	* intrin.c (ffeintrin_cmp_name_): Don't needlessly cast away
+	const-ness.
+
+Sun Nov 28 21:15:29 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (ffecom_get_invented_identifier): Rewrite to take an ellipses.
+
+	(ffecom_char_enhance_arg_, ffecom_do_entry_,
+	ffecom_f2c_make_type_, ffecom_gen_sfuncdef_,
+	ffecom_start_progunit_, ffecom_start_progunit_,
+	ffecom_start_progunit_, ffecom_sym_transform_assign_,
+	ffecom_transform_equiv_, ffecom_transform_namelist_,
+	ffecom_vardesc_, ffecom_vardesc_array_, ffecom_vardesc_dims_,
+	ffecom_end_transition, ffecom_lookup_label, ffecom_temp_label):
+	Adjust accordingly.
+
+	* com.h (ffecom_get_invented_identifier): Likewise.
+
+	* sts.c (ffests_printf): New function taking ellipses.
+	(ffests_printf_1D, ffests_printf_1U, ffests_printf_1s,
+	ffests_printf_2Us): Delete.
+
+	* sts.h: Likewise.
+
+	* std.c (ffestd_R1001dump_, ffestd_R1001dump_1005_1_,
+	ffestd_R1001dump_1005_2_, ffestd_R1001dump_1005_3_,
+	ffestd_R1001dump_1005_4_, ffestd_R1001dump_1005_5_,
+	ffestd_R1001dump_1010_2_, ffestd_R1001dump_1010_3_,
+	ffestd_R1001dump_1010_4_, ffestd_R1001dump_1010_5_,
+	ffestd_R1001rtexpr_): Call `ffests_printf', not `ffests_printf_*'.
+
+	* ste.c (ffeste_io_ialist_, ffeste_io_cilist_, ffeste_io_cllist_,
+	ffeste_io_icilist_, ffeste_io_inlist_, ffeste_io_olist_): Likewise.
+
+Wed Nov 10 12:43:21 1999  Philippe De Muyter  <phdm@macqel.be>
+			  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* proj.h: Test `GCC_VERSION', not `HAVE_GCC_VERSION'.
+
+Tue Oct 26 01:32:19 1999  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (poplevel): Don't call remember_end_note.
+
+Fri Oct 15 15:18:12 1999  Greg McGary  <gkm@gnu.org>
+
+	* top.h (ffe_is_subscript_check_): Remove extern decl.
+	(ffe_is_subscript_check, ffe_set_is_subscript_check): Remove macros.
+	* top.c (ffe_is_subscript_check_): Remove global variable.
+	(ffe_decode_option): Remove "(no-)bounds-check" flag handling.
+	Set flag_bounds_check for "(no-)fortran-bounds-check".
+	* com.c
+	(ffecom_arrayref_): s/ffe_is_subscript_check ()/flag_bounds_check/
+	(ffecom_char_args_x_): Ditto.
+
+Sun Oct 10 08:40:18 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* proj.h: Use HAVE_GCC_VERSION instead of explicitly testing
+	__GNUC__ and __GNUC_MINOR__.  Don't define BUILT_WITH_270.  Define
+	macro UNUSED in terms of ATTRIBUTE_UNUSED.
+
+Fri Sep 24 10:48:10 1999  Bernd Schmidt  <bernds@cygnus.co.uk>
+
+	* com.c (duplicate_decls): Use DECL_BUILT_IN_CLASS rather than
+	DECL_BUILT_IN.
+	(builtin_function): No longer static.  New arg CLASS.  Arg
+	FUNCTION_CODE now of type int.  All callers changed.
+	Set the builtin's DECL_BUILT_IN_CLASS.
+
+Tue Sep 21 09:08:30 1999  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77spec.c (lang_specific_driver): Initialize return value.
+
+Thu Sep 16 18:07:11 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bad.c (ffebad_finish): Use uppercase ctype macro from system.h.
+
+	* fini.c (main): Likewise.
+
+	* intrin.c (ffeintrin_init_0): Likewise.
+
+	* lex.c (ffelex_hash_): Likewise.
+
+	* src.c (ffesrc_init_1): Likewise.
+
+Tue Sep 14 12:14:28 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* g77spec.c (lang_specific_driver): Remove unnecessary argument in
+	call to function `fatal'.
+
+Sun Sep 12 23:29:47 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in (g77spec.o): Depend on system.h and gcc.h.
+
+	* g77spec.c: Include gcc.h.
+	(g77_xargv): Constify.
+	(g77_fn): Add parameter prototypes.
+	(lookup_option, append_arg): Add static prototypes.
+	(g77_newargv): Constify.
+	(lookup_option, append_arg, lang_specific_driver): Constify a char*.
+	(lang_specific_driver): All calls to the function pointer
+	parameter now explicitly call `fatal'.
+
+Fri Sep 10 10:32:32 1999  Bernd Schmidt  <bernds@cygnus.co.uk>
+
+	* com.h: Delete declarations for all tree nodes now moved to
+	global_trees.
+	* com.c: Delete their definitions.
+	(ffecom_init_0): Call build_common_tree_nodes and
+	build_common_tree_nodes_2 instead of building their nodes here.
+	Override their decisions for complex nodes.
+
+Sat Sep  4 13:46:27 1999  Mark Mitchell  <mark@codesourcery.com>
+
+	* Make-lang.in (f771): Depend on ggc-callbacks.o.
+	* Makefile.in (OBJS): Add ggc-callbacks.o.
+	(OBJDEPS): Likewise.
+
+Mon Aug 30 22:05:53 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (language_string): Constify.
+
+Mon Aug 30 20:29:30 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Makefile.in (LIBS, LIBDEPS): Link with & depend on libiberty.a.
+	Remove hacks for stuff which now comes from libiberty.
+
+Sun Aug 29 09:47:45 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (lang_printable_name): Constify a char*.
+
+Wed Aug 25 01:21:06 1999  Rainer Orth  <ro@TechFak.Uni-Bielefeld.DE>
+
+	* lang-specs.h: Pass cc1 spec to f771.
+
+Mon Aug  9 19:44:08 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (lang_print_error_function): Constify a char*.
+	(init_parse): Remove redundant prototype for `print_error_function'.
+	(lang_identify): Constify a char*.
+
+Thu Aug  5 02:40:42 1999  Jeffrey A Law  (law@cygnus.com)
+
+	* g77spec.c: Update URLS and mail addresses.
+	* root.texi: Update URLS and mail addresses.
+
+1999-07-25  Richard Henderson  <rth@cygnus.com>
+
+	* com.c (ptr_type_node, va_list_type_node): New.
+	(ffecom_init_0): Init and use ptr_type_node.
+
+1999-07-17  Alexandre Oliva  <oliva@dcc.unicamp.br>
+
+	* root.texi: Update e-mail addresses to gcc.gnu.org.
+	* g77spec.c (lang_specific_driver): Updated URL with bug reporting
+	instructions to gcc.gnu.org.  Removed e-mail address.
+
+Sat Jul 17 11:28:43 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* root.texi, g77install.texi: Switchover to GCC terminology.
+	Also, FSF-G77 had been mistakenly set at some point.
+
+Thu Jul  8 15:38:50 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Describe DATE intrinsic fix.
+
+Mon Jun 28 21:44:19 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* version.c: Denote experimental version.
+
+Mon Jun 28 10:43:11 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* com.c (ffecom_prepare_expr_): A COMPLEX intrinsic needs
+	a temp even if -fno-f2c.
+
+	* version.c: Bump version.
+
+Mon Jun 28 21:31:35 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi, news.texi: Doc upgrade to netlib libf2c as of today.
+	Explain that this fixes the NAMELIST-read bug.
+
+Fri Jun 25 11:06:32 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi: Describe K(5)=10*3 NAMELIST-read bug.
+
+Mon Jun 21 12:40:17 1999  Gerald Pfeifer  <pfeifer@dbai.tuwien.ac.at>
+
+	* g77.texi: Update links.
+
+Mon Jun 21 05:33:51 1999  Jeffrey A Law  (law@cygnus.com)
+
+	* news.texi: Add missing @end ifclear.
+
+Fri Jun 18 11:43:46 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Doc TtyNam fix.
+
+Fri Jun 18 11:26:50 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: New heading for development version.
+	Doc upgrade to netlib libf2c as of today.
+
+Wed Jun 16 11:43:02 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Mention BACKSPACE fix to libg2c.
+
+Mon Jun  7 08:42:40 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* Make-lang.in: Any target using libsubdir must depend
+	on installdirs.
+
+Sat Jun  5 23:50:36 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Describe a few more missing features people
+	have emailed me about.
+
+Sat Jun  5 17:03:23 1999  Craig Burley  <craig@jcb-sc.com>
+
+	From Dave Love to egcs-patches on 20 May 1999 17:38:38 +0100:
+	* g77.texi: Clean up fossil text vis-a-vis Intel CPUs.
+
+Fri Jun  4 13:56:56 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* Make-lang.in: Use libsubdir, not prefix, to store
+	temporary lang-f77 `flag' file.
+
+Fri Jun  4 10:26:04 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi (News): Mention GCC 2.95 in favor of EGCS 1.2.
+	Mention that libg2c is multilibbed.
+
+Fri Jun  4 10:09:50 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi (Missing Features): Add `Better Warnings'
+	item.
+
+Fri May 28 16:51:41 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Fix thinko.
+
+Wed May 26 14:43:27 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Document Tue May 18 03:52:04 1999 patch.
+	Fix a grammo.
+
+Wed May 26 14:25:07 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi, news.texi, root.texi, version.c: Start renaming
+	EGCS 1.2 to GCC 2.95, and start using 0.5.25 to designate
+	the version of g77 within GCC 2.95.
+
+Wed May 26 11:45:21 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Rename -fsubscript-check to -fbounds-check and
+	-ff2c-subscript-check to -ffortran-bounds-check:
+	* g77.texi: Rename options in docs, clarify usage.
+	* lang-options.h: Rename options, clarify doclets.
+	* news.texi: Rename options, don't bother with fortran-specific
+	option.
+	* top.c (ffe_decode_option): Rename recognized strings.
+
+Tue May 25 18:21:09 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* com.c (FFECOM_FASTER_ARRAY_REFS): Delete this vestige,
+	now that -fflatten-arrays exists.
+
+Tue May 25 17:48:34 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Fix 19990525-0.f:
+	* com.c (ffecom_arg_ptr_to_expr): Strip off parens around
+	CHARACTER expression.
+	(ffecom_prepare_expr_): Ditto.
+
+Tue May 18 03:52:04 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Support use of back end's improved open-coding of complex divide:
+	* com.c (ffecom_tree_divide_): Use RDIV_EXPR for complex divide,
+	instead of run-time call to [cz]_div, if `-Os' option specified.
+	(lang_init_options): Tell back end we want support for wide range
+	of inputs to complex divide.
+
+	* Bump version.
+
+Tue May 18 00:21:34 1999  Zack Weinberg  <zack@rabi.phys.columbia.edu>
+
+	* lang-specs.h: Define __GNUC__ and __GNUC_MINOR__ only if -no-gcc
+	was not given.
+
+Thu May 13 12:23:20 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Fix INTEGER*8 subscripts in array references:
+	* com.c (ffecom_subscript_check_): Convert low, high, and
+	element as necessary to make comparison work.
+	(ffecom_arrayref_): Do more of the work.
+	Properly handle subscript expr that's wider than int,
+	if pointers are wider than int.
+	(ffecom_expr_): Leave more work to ffecom_arrayref_.
+	(ffecom_init_0): Record sizes of pointers and ints for
+	convenience.
+	Use set_sizetype etc. as done by gcc front end.
+	(ffecom_ptr_to_expr): Leave more work to ffecom_arrayref_.
+	* expr.c (ffeexpr_finished_): Don't convert INTEGER subscript
+	expressions in run-time contexts.
+	(ffeexpr_token_elements_, ffeexpr_token_substring_1_): Cope with
+	non-default INTEGER subscript expressions.
+	* news.texi: Announce.
+
+	Finish accepting -fflatten-arrays option:
+	* com.c (ffecom_arrayref_): Flatten references if requested.
+	* g77.texi: Describe.
+	* lang-options.h: Allow.
+	* news.texi: Announce.
+	* top.c, top.h: Recognize.
+
+	* version.c: Bump version.
+
+Wed May 12 07:30:05 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* com.c (lang_init_options): Disable back end's maintenance
+	of errno.
+	* news.texi: Document dropping of errno.
+
+1999-05-10 18:21 -0400  Zack Weinberg  <zack@rabi.phys.columbia.edu>
+
+	* lang-specs.h: Pass -$ to the preprocessor.
+
+Mon May 10 18:14:28 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Fix various @xref's per proper style.
+	Go ahead and use nested braces in @xref's, with care.
+	* g77install.texi: Fix @xref per proper style.
+
+Mon May 10 17:38:39 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Doc upgrade to netlib libf2c as of today.
+
+Sun May  9 18:52:13 1999  Hans-Peter Nilsson  <hp@bitrange.com>
+
+	* f/g77spec.c (lang_specific_driver): Correct bug-report address
+	and point to the FAQ.
+
+Thu May  6 12:40:21 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi (Arbitrary Concatenation): Put this under
+	"Missing Features" instead of "Projects".
+	(Internals Documentation): Point to new "Front End" chapter.
+
+Thu May  6 08:23:52 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi, news.texi: Automatic arrays reportedly working
+	on HP-UX systems.
+
+Thu May  6 08:19:31 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi (Advantages Over f2c): Expand on this topic.
+
+Mon May  3 19:41:48 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* com.c (ffecom_expr_intrinsic_): Fix test of CTIME_subr.
+
+Mon May  3 18:11:48 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Reverse order of two arguments to CTIME_subr, DTIME_subr,
+	ETIME_subr, and TTYNAM_subr:
+	* com.c (ffecom_expr_intrinsic_): Reverse the arguments.
+	While at it, set TREE_SIDE_EFFECTS for CTIME_subr and
+	TTYNAM_subr.
+	* intdoc.in: Document the new calling sequences.
+	* intrin.def: Reverse the arguments.
+	* news.texi: Document the fact that they changed.
+	* version.c: Bump version.
+
+Mon May  3 11:28:14 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Doc upgrade to netlib libf2c as of today.
+
+Sun May  2 17:04:28 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* version.c: Bump version.
+
+Sun May  2 16:53:01 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Fix compile/19990502-1.f:
+	* ste.c (ffeste_R819B): Don't overwrite tree for temp
+	variable when expanding the assignment into it.
+
+Sun Apr 25 20:55:10 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Fix 19990325-0.f and 19990325-1.f:
+	* com.c (ffecom_possible_partial_overlap_): New function.
+	(ffecom_expand_let_stmt): Use it to determine whether to assign
+	to a COMPLEX operand through a temp.
+	* news.texi: Document fix.
+
+	* version.c: Bump version.
+
+Sat Apr 24 12:19:53 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* expr.c (ffeexpr_finished_): Convert DATA implied-do
+	start/end/incr expressions to default INTEGER.
+	Fix some broken conditionals.
+	Clean up some code in the region.
+	* news.c: Document the fix.
+
+	* version.c: Bump version.
+
+Fri Apr 23 02:08:32 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi (Compiler Prototypes): Replace "missing" subscript-
+	checking option with something else.
+
+Fri Apr 23 01:48:28 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Support new -fsubscript-check and -ff2c-subscript-check options:
+	* com-rt.def (FFECOM_gfrtRANGE): Describe s_rnge, in libf2c/libF77.
+	* com.c (ffecom_subscript_check_, ffecom_arrayref_): New functions.
+	(ffecom_char_args_x_): Use new ffecom_arrayref_ function for
+	FFEBLD_opARRAYREF case.
+	Compute character name, array type, and	use new
+	ffecom_subscript_check_ function for FFEBLD_opSUBSTRING case.
+	(ffecom_expr_): Use new ffecom_arrayref_ function.
+	(ffecom_ptr_to_expr): Use new ffecom_arrayref_ function.
+	* g77.texi, news.texi: Document new options.
+	* top.c, top.h: Support new options.
+
+	* news.texi: Fix up some items to not be in "User-Visible Changes".
+
+	* ste.c (ffeste_R819B): Fix type for loop variable, to avoid
+	warnings.
+
+	* version.c: Bump version.
+
+Tue Apr 20 01:38:57 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi, news.texi: Clarify -malign-double situation.
+
+Tue Apr 20 01:15:25 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* stb.c (ffestb_R5282_): Convert DATA repeat count
+	to default INTEGER, to avoid problems downstream.
+
+	* version.c: Bump version.
+
+Mon Apr 19 21:36:48 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* ste.c (ffeste_R819B): Start the loop before expanding
+	the termination expression.
+
+	* version.c: Bump version.
+
+Sun Apr 18 21:53:58 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* com.c (ffecom_sym_transform_): COMMON and EQUIVALENCE
+	variables have constant addresses (EQUIVALENCE only if
+	containing aggregate is static).
+
+Sat Apr 17 16:55:59 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi, ffe.texi, g77.texi, g77install.texi, news.texi:
+	Clean up @code{} vs. @samp{}.
+	Clean up dashes (`--') vs. @minus{} vs. `---'.
+
+	* ffe.texi: Add copyright header.
+
+	* g77.texi, lang-options.h, news.texi, top.c (ffe_decode_option):
+	Remove support for -fugly option.
+	Clarify that -fugly-logint is needed instead of -fugly
+	to work around using .EQ./.NE. on LOGICAL operands.
+	Explain more about why -fugly-logint is bad juju.
+
+	* g77.texi (Missing Features): Describe READONLY as a missing
+	feature.  Describe AUTOMATIC better.
+
+	* news.texi: Mention libf2c upgrade.
+
+Sat Apr 17 14:05:53 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Make a place for front-end internals documentation:
+	* Make-lang.in (f/g77.info, f/g77.dvi): Depend on f/ffe.texi.
+	* ffe.texi: New file, containing docs on front-end internals.
+	* g77.texi: New chapter for, and inclusion of, ffe.texi.
+
+	* g77.texi: Fix an index entry.
+
+Sat Apr 17 13:53:43 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Rewrite to use block/scope structure of GBE and to ensure
+	variables (especially those going on stack/reg) are declared
+	before executable code generated:
+	* bld.c (ffebld_new_item, ffebld_new_one, ffebld_new_two):
+	Support new hooks.
+	* bld.h (ffebld_item_hook, ffebld_item_set_hook,
+	ffebld_nonter_hook, ffebld_nonter_set_hook): Ditto.
+	* bld.h (ffebld_basictype, ffebld_kind, ffebld_kindtype,
+	ffebld_rank, ffebld_where): New convenience macros (used
+	by rest of this patch).
+	* com.c, com.h (ffecom_push_calltemps, ffecom_pop_calltemps,
+	ffecom_push_tempvar, ffecom_pop_tempvar): Remove temp-var-
+	handling mechanism.
+	* com.c (ffecom_call_, ffecom_call_binop_, ffecom_tree_divide_,
+	ffecom_call_gfrt): Support passing hooks for temp-var info.
+	(ffecom_expr_power_integer_): Takes opPOWER expression, instead
+	of its left and right operands, so it can get at the hook.
+	(ffecom_prepare_let_char_, ffecom_prepare_arg_ptr_to_expr,
+	ffecom_prepare_end, ffecom_prepare_expr_, ffecom_prepare_expr_rw,
+	ffecom_prepare_expr_w, ffecom_prepare_return_expr,
+	ffecom_prepare_ptr_to_expr): New functions supporting expression
+	pre-scanning.
+	(bison_rule_compstmt_): Return the tree, as in the CFE.
+	(delete_block): New function, from CFE.
+	(kept_level_p): New function, from CFE, modified.
+	(ffecom_start_compstmt, ffecom_end_compstmt): New functions,
+	replacing ffecom_start_compstmt_ and ffecom_end_compstmt_ macros,
+	and they do real work.
+	(struct binding_level): Add prep_state member.  Initialize to 0.
+	(ffecom_get_invented_identifier): Now takes either or both a
+	string and an integer, using -1 to denote no integer.
+	(ffecom_do_entry_): Disallow temp-var generation via expressions
+	in body of function, since the exprs aren't prescanned.
+	(ffecom_expr_rw): Now takes destination tree.
+	(ffecom_expr_w): New function, now used in some places
+	ffecom_expr_rw had been used.
+	(ffecom_expr_intrinsic_): Move huge f2c-related comment to bottom
+	of source file, to avoid annoying problems editing com.c using
+	Emacs C-mode.
+	(ffecom_expr_power_integer_): Make a temp var for division, if
+	necessary.
+	Handle expanded statement expression as does CFE.
+	(ffecom_start_progunit_): Disallow temp-var generation in body
+	of function, since expressions are not prescanned at this level.
+	(ffecom_sym_transform_): Transform ASSIGN variables as well,
+	so these are all transformed up front, before code-generation
+	begins.
+	(ffecom_arg_ptr_to_const_expr, ffecom_const_expr,
+	ffecom_ptr_to_const_expr): New functions to transform expressions
+	only if the results will surely be constants.
+	(ffecom_arg_ptr_to_expr): Precompute size, for convenience
+	obtaining temp vars.
+	(ffecom_expand_let_stmt): Guess at usability of destination
+	pre-expansion, to provide better prescan preparation (fewer
+	spurious temp vars).
+	(ffecom_init_0): Disallow temp-var generation in global scope.
+	(ffecom_type_expr): New function, returns just the type tree
+	for the expression.
+	(start_function): Disallow temp-var generation in parm scope.
+	(incomplete_type_error): Fix introductory comment.
+	(poplevel): Update (somewhat) from CFE.
+	(pushlevel): Update (somewhat) from CFE.
+	* stc.c (ffestc_R838): Mark ASSIGNed variable as so.
+	* std.c (ffestd_stmt_pass_, ffestd_R803, ffestd_R804, ffestd_R805,
+	ffestd_R806): Remember and pass through the ffestw block info
+	for these (IFTHEN, ELSEIF, ELSE, and ENDIF) statements.
+	* ste.c (ffeste_end_iterdo_): Now takes ffestw block argument.
+	(ffeste_io_inlist_): Add prototype.
+	(ffeste_f2c_*): Macros rewritten, new ones added.
+	(ffeste_start_block_, ffeste_end_block_, ffeste_start_stmt_,
+	ffeste_end_stmt_): New macros/functions, depending on whether
+	checking is enabled, to keep track of symmetry of other ste.c code.
+	(ffeste_begin_iterdo_, ffeste_end_iterdo_, ffeste_io_impdo_,
+	ffeste_io_dofio_, ffeste_io_dolio_, ffeste_io_douio_,
+	ffeste_io_ialist_, ffeste_io_cilist_, ffeste_io_cllist_,
+	ffeste_icilist_, ffeste_io_inlist_, ffeste_io_olist_,
+	ffeste_subr_beru_, ffeste_do, ffeste_end_R807, ffeste_R737A,
+	ffeste_R803, ffeste_R804, ffeste_R805, ffeste_R806, ffeste_R807,
+	ffeste_R809, ffeste_R810, ffeste_R811, ffeste_R819A, ffeste_R819B,
+	ffeste_R837, ffeste_R838, ffeste_R839, ffeste_R840, ffeste_R904,
+	ffeste_R907, ffeste_R909_start, ffeste_R909_item, ffeste_R909_finish,
+	ffeste_R910_start, ffeste_R910_item, ffeste_R910_finish,
+	ffeste_R911_start, ffeste_R911_item, ffeste_R911_finish,
+	ffeste_R923A, ffeste_R1212, ffeste_R1227): Prescan/prepare
+	all pertinent expressions, update to new com.c interface, etc.
+	(ffeste_io_impdo_): Relocate.
+	(ffeste_R834, ffeste_R835, ffeste_R836, ffeste_R1226): Don't
+	bother calling clear_momentary, nothing was generated.
+	(ffeste_R842, ffeste_R843): Update to new com.c interface.
+	(ffeste_R1226): Don't try to stuff error_mark_node's DECL_INITIAL.
+	(ffeste_terminate_2): When checking enabled, make sure all blocks
+	and statements have been ended.
+	* ste.h (ffeste_R803, ffeste_R804, ffeste_R805, ffeste_R806):
+	These now take ffestw block argument.
+	(ffeste_terminate_2): When checking enabled, it's a function, not
+	a macro.
+	* stw.h (struct _ffestw_): New variable for IFTHEN.
+	(ffestw_ifthen_fake_else, ffestw_set_ifthen_fake_else): New
+	accessor macros.
+	* symbol.c, symbol.h: Support new ASSIGN'ed-to info.
+
+	* com.c: Clean up commentary per GNU coding standards.
+
+	* bld.h (ffebld_size, ffebld_size_known): Canonize.
+
+	* version.c: Bump version.
+
+Sun Apr 11 21:33:33 1999  Mumit Khan  <khan@xraylith.wisc.edu>
+
+	* g77spec.c (lang_specific_driver): Check whether MATH_LIBRARY is
+	null to decide whether to use it.
+
+Wed Apr  7 09:47:09 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* ansify.c (die): Specify void argument.
+
+	* intdoc.c (family_name, dumpgen, dumpspec, dumpimp,
+	argument_info_ptr, argument_info_string, argument_name_ptr,
+	argument_name_string, elaborate_if_complex,
+	elaborate_if_maybe_complex, elaborate_if_real, print_type_string):
+	Const-ify a char*.
+	(main): Mark parameter `argv' with ATTRIBUTE_UNUSED.
+	(_ffeintrin_name_, _ffeintrin_gen_, _ffeintrin_spec_,
+	_ffeintrin_imp_, cc_pair, descriptions, summaries): Const-ify a char*.
+
+Mon Apr  5 11:57:54 1999  Donn Terry (donn@interix.com)
+
+	* Make-lang.in (HOST_CFLAGS): compute dynamically.
+
+Mon Apr  5 02:11:23 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Fix bugs exposed by configuring with --enable-checking:
+	* com.c (ffecom_do_entry_, ffecom_expr_, ffecom_arg_ptr_to_expr,
+	ffecom_list_expr, ffecom_list_ptr_to_expr, finish_function,
+	pop_f_function_context, store_parm_decls, poplevel): Handle
+	error_mark_node properly.
+	* ste.c (ffeste_begin_iterdo_, ffeste_end_iterdo_): Ditto.
+	* version.c: Bump version.
+
+Sat Apr  3 23:57:56 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Fix up docs for -fset-g77-defaults, and
+	describe how internal consistency checking now happens.
+	(Should have been done for EGCS version 1.1.)
+
+Sat Apr  3 23:29:33 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi, g77.texi, lang-options.h, news.texi, top.c:
+	Make -fno-emulate-complex the default, as COMPLEX support
+	in the back end is now believed to be working.
+
+	* version.c: Bump version.
+
+Fri Apr  2 13:33:16 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: -malign-double now works.
+	Give URL for alignment-testing package.
+	* news.texi: -malign-double now works.
+
+Fri Apr  2 12:49:12 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi (Funding GNU Fortran): Dude's got a web page.
+	* root.texi: Ditto.
+
+Tue Mar 30 12:04:11 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* sta.c (ffesta_ffebad_1sp, ffesta_ffebad_1st, ffesta_ffebad_2st):
+	Const-ify a char*.
+
+	* sta.h (ffesta_ffebad_1sp, ffesta_ffebad_1st, ffesta_ffebad_2st):
+	Likewise.
+
+	* stb.c (ffestb_local_u_): Likewise.
+	(ffestb_do, ffestb_dowhile, ffestb_else, ffestb_elsexyz,
+	ffestb_else3_, ffestb_endxyz, ffestb_goto, ffestb_let,
+	ffestb_type, ffestb_type1_, ffestb_varlist, ffestb_R423B,
+	ffestb_R522, ffestb_R528, ffestb_R542, ffestb_R834, ffestb_R835,
+	ffestb_R838, ffestb_R841, ffestb_R1102, ffestb_blockdata,
+	ffestb_R1212, ffestb_R1228, ffestb_V009, ffestb_module,
+	ffestb_R809, ffestb_R810, ffestb_R10014_, ffestb_R10015_,
+	ffestb_R10018_, ffestb_R1107, ffestb_R1202, ffestb_R12026_,
+	ffestb_S3P4, ffestb_V012, ffestb_V014, ffestb_V025, ffestb_V0255_,
+	ffestb_V020, ffestb_dimlist, ffestb_dummy, ffestb_R524,
+	ffestb_R547, ffestb_decl_chartype, ffestb_decl_dbltype,
+	ffestb_decl_gentype, ffestb_decl_recursive, ffestb_decl_entsp_2_,
+	ffestb_decl_func_, ffestb_V003, ffestb_V016, ffestb_V027,
+	ffestb_decl_R539): Likewise.
+
+	* stb.h (_ffestb_args_): Likewise.
+
+	* stc.c (ffestc_subr_binsrch_, ffestc_subr_is_present_,
+	ffestc_subr_speccmp_, ffestc_R904, ffestc_R907): Likewise.
+
+	* std.c (ffestd_R1001dump_1005_1_, ffestd_R1001dump_1005_2_,
+	ffestd_R1001dump_1005_3_, ffestd_R1001dump_1005_4_,
+	ffestd_R1001dump_1005_5_, ffestd_R1001dump_1010_1_,
+	ffestd_R1001dump_1010_2_, ffestd_R1001dump_1010_3_,
+	ffestd_R1001dump_1010_4_, ffestd_R1001dump_1010_5_): Likewise.
+
+	* ste.c (ffeste_begin_iterdo_, ffeste_subr_file_): Likewise.
+
+	* sts.c (ffests_printf_1D, ffests_printf_1U, ffests_printf_1s,
+	ffests_printf_2Us, ffests_puts, ffests_puttext): Likewise.
+
+	* sts.h (ffests_printf_1D, ffests_printf_1U, ffests_printf_1s,
+	ffests_printf_2Us, ffests_puts, ffests_puttext): Likewise.
+
+	* stt.c (ffestt_exprlist_drive, ffestt_implist_drive,
+	ffestt_tokenlist_drive): Add prototype arguments.
+
+	* stt.h (ffestt_exprlist_drive, ffestt_implist_drive,
+	ffestt_tokenlist_drive): Likewise.
+
+	* stu.c (ffestu_dummies_transition_): Likewise.
+	(ffestu_sym_end_transition): Const-ify a char*.
+
+	* stw.c (ffestw_display_state, ffestw_new, ffestw_pop): Add
+	prototype arguments.
+
+	* stw.h (ffestw_display_state, ffestw_new, ffestw_pop): Likewise.
+
+	* version.c (ffe_version_string): Const-ify a char*.
+
+	* version.h (ffe_version_string): Likewise.
+
+Sat Mar 27 13:00:43 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bad.c (_ffebad_message_, ffebad_string_, ffebad_message_,
+	ffebad_bufputs_, ffebad_bufputs_, ffebad_start_, ffebad_string,
+	ffebad_finish): Const-ify a char*.
+
+	* bld.c (ffebld_op_string_, ffebld_op_string): Likewise.
+
+	* bld.h (ffebld_op_string): Likewise.
+
+	* com.c (ffecom_arglist_expr_, ffecom_build_f2c_string_,
+	ffecom_debug_kludge_, ffecom_f2c_make_type_,
+	ffecom_get_appended_identifier_, ffecom_get_identifier_,
+	ffecom_gfrt_args_): Likewise.
+	(ffecom_convert_narrow_, ffecom_convert_widen_): Add prototype.
+	(builtin_function, ffecom_gfrt_name_, ffecom_gfrt_argstring_,
+	ffecom_arglist_expr_, ffecom_build_f2c_string_,
+	ffecom_debug_kludge_, ffecom_f2c_make_type_,
+	ffecom_get_appended_identifier_, ffecom_get_external_identifier_,
+	ffecom_get_identifier_, ffecom_decl_field,
+	ffecom_get_invented_identifier, lang_print_error_function,
+	skip_redundant_dir_prefix, read_name_map, print_containing_files):
+	Const-ify a char*.
+	(savestring): Remove, use `xstrdup' instead.
+
+	* com.h (ffecom_decl_field, ffecom_get_invented_identifier):
+	Const-ify a char*.
+
+	* data.c (ffebld, ffedata_gather_): Make explicitly static.
+
+	* expr.c (ffeexpr_isdigits_, ffeexpr_percent_,
+	ffeexpr_reduced_concatenate_, ffeexpr_nil_real_,
+	ffeexpr_nil_number_, ffeexpr_nil_number_period_,
+	ffeexpr_nil_number_real_, ffeexpr_token_real_,
+	ffeexpr_token_number_, ffeexpr_token_number_period_,
+	ffeexpr_token_number_real_): Const-ify a char*.
+
+	* fini.c (xspaces): Likewise.
+
+	* global.c (ffeglobal_type_string_): Likewise.
+	(ffeglobal_drive): Protoize.
+	(ffeglobal_proc_def_arg): Const-ify a char*.
+
+	* global.h (ffeglobal_drive): Protoize.
+	(ffeglobal_proc_def_arg): Const-ify a char*.
+
+	* implic.c (ffeimplic_none, ffeimplic_peek_symbol_type):
+	Likewise.
+
+	* implic.h (ffeimplic_peek_symbol_type): Likewise.
+
+	* info.c (ffeinfo_basictype_string_, ffeinfo_kind_message_,
+	ffeinfo_kind_string_, ffeinfo_kindtype_string_,
+	ffeinfo_where_string_, ffeinfo_basictype_string,
+	ffeinfo_kind_message, ffeinfo_kind_string,
+	ffeinfo_kindtype_string, ffeinfo_where_string): Likewise.
+
+	* info.h (ffeinfo_basictype_string, ffeinfo_kind_message,
+	ffeinfo_kind_string, ffeinfo_kindtype_string,
+	ffeinfo_where_string): Likewise.
+
+	* intrin.c (_ffeintrin_name_, _ffeintrin_gen_, _ffeintrin_spec_,
+	_ffeintrin_imp_, ffeintrin_check_, ffeintrin_cmp_name_,
+	ffeintrin_fulfill_specific, ffeintrin_init_0,
+	ffeintrin_is_actualarg, ffeintrin_is_intrinsic,
+	ffeintrin_name_generic, ffeintrin_name_implementation,
+	ffeintrin_name_specific): Likewise.
+
+	* intrin.h (ffeintrin_is_intrinsic, ffeintrin_name_generic,
+	ffeintrin_name_implementation, ffeintrin_name_specific): Likewise.
+
+	* lex.c (ffelex_type_string_, ffelex_token_new_character,
+	ffelex_token_new_name, ffelex_token_new_names,
+	ffelex_token_new_number): Likewise.
+
+	* lex.h (ffelex_token_new_character, ffelex_token_new_name,
+	ffelex_token_new_names, ffelex_token_new_number): Likewise.
+
+	* malloc.c (malloc_types_, malloc_pool_new, malloc_new_inpool_,
+	malloc_new_zinpool_): Likewise.
+
+	* malloc.h (malloc_new_inpool_, malloc_new_zinpool_,
+	malloc_pool_new): Likewise.
+
+	* name.c (ffename_space_drive_global, ffename_space_drive_symbol):
+	Protoize.
+
+	* name.h (ffename_space_drive_global, ffename_space_drive_symbol):
+	Likewise.
+
+	* symbol.c (ffesymbol_state_name_, ffesymbol_attr_name_,
+	ffesymbol_attrs_string): Const-ify a char*.
+	(ffesymbol_drive, ffesymbol_drive_sfnames): Protoize.
+	(ffesymbol_state_string): Const-ify a char*.
+
+	* symbol.h (ffesymbol_attrs_string): Likewise.
+	(ffesymbol_drive, ffesymbol_drive_sfnames): Protoize.
+	(ffesymbol_state_string): Const-ify a char*.
+
+	* target.c (ffetarget_layout): Likewise.
+
+	* target.h (ffetarget_layout): Likewise.
+
+1999-03-25  Zack Weinberg  <zack@rabi.columbia.edu>
+
+	* Make-lang.in: Remove all references to g77.o/g77.c.
+	Link g77 from gcc.o.
+
+1999-03-21  Manfred Hollstein  <manfred@s-direktnet.de>
+
+	* Makefile.in (g77$(exeext)): Depend on intl.o.  Link in intl.o.
+
+Wed Mar 17 11:39:44 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Editorial fix.
+
+Mon Mar 15 17:12:07 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi, g77.texi, news.texi: Editorial fixes.
+
+Sat Mar 13 17:51:55 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Fix 19990313-0.f, 19990313-1.f, 19990313-2.f, 19990313-3.f:
+	* bad.def (FFEBAD_NOCANDO): New error code for internal use only.
+	* expr.c (ffeexpr_collapse_convert): If FFEBAD_NOCANDO returned
+	by convertor, just return original expr.
+	* target.h: Return FFEBAD_NOCANDO for (usually) 64-bit
+	conversions that aren't yet working properly.
+	* news.texi: Explain.
+
+	* version.c: Bump version.
+
+Sat Mar 13 14:26:55 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* RELEASE-PREP: New file, lists things to do for a release.
+
+	* Make-lang.in, bugs.texi, bugs0.texi, g77.texi, g77install.texi,
+	install0.texi, news.texi, news0.texi: Accommodate new doc
+	architecture.
+	Consolidate news items.  Don't describe old news items in
+	various generated docs.
+	Don't describe FSF-g77 installation stuff in various EGCS-g77
+	generated docs.
+	Move description of AUTOMATIC to more suitable location.
+	* root.texi: New file for new doc architecture.
+
+Thu Mar 11 17:32:55 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Add AUTOMATIC to list of unsupported extensions.
+
+Sat Mar  6 02:28:35 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Warn about non-Y2K-compliant intrinsics:
+	* bad.def (FFEBAD_INTRINSIC_Y2KBAD): New diagnostic.
+	* intrin.def (FFEINTRIN_impDATE, FFEINTRIN_impIDATE_vxt):
+	Use new DEFIMPY macro to flag these as non-Y2K-compliant.
+	* intdoc.c (DEFIMPY): Support new Y2K macro.
+	* intrin.h (DEFIMPY): Ditto.
+	* intrin.c (DEFIMPY): Ditto.
+	(ffeintrin_fulfill_generic, ffeintrin_fulfill_specific):
+	Warn about invocation of non-Y2K-compliant intrinsic.
+	* com-rt.def (FFECOM_gfrtDATE, FFECOM_gfrtVXTIDATE):
+	Rename external procedure names, to keep previously-
+	compiled (sans-new-warnings) code from linking to
+	new library.
+	* g77.texi: Document all this stuff.
+	* news.texi: Spread the joy.
+	* version.c: Bump version.
+
+Fri Mar  5 13:22:44 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Relocate IDATE (VXT) fix: we put it in 1.1.2
+	so describe it there, instead of under 1.2.
+
+Wed Mar  3 00:57:56 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: IDATE (VXT) fixed to return year as 0..99.
+
+Wed Mar  3 00:43:49 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Add remaining changes pending from Dave Love.
+
+Wed Mar  3 00:38:42 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi, news.texi: Conditionalize cross-references
+	on non-html processing, providing temporary HTML "links".
+
+	* g77.texi: Fix up a reference.
+
+Wed Mar  3 00:12:31 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi, bugs.texi: Delete fixed bugs, make one
+	of them into the appropriate news item.
+
+Wed Mar  3 00:05:52 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Copy over 1.1.2 news.
+
+1999-03-02  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi (Bug Reporting): Clarify whether to use -E.
+	Clarify other instructions.
+
+1999-02-27  Craig Burley  <craig@jcb-sc.com>
+
+	* lang-specs.h: Fix specs to pass `-ax' as well as `-a' option.
+
+1999-02-26  Craig Burley  <craig@jcb-sc.com>
+
+	* intdoc.in (STAT_func, STAT_subr,
+	FSTAT_func, FSTAT_subr, LSTAT_func, LSTAT_subr):
+	Properly order array elements.  Specify N/A return values.
+
+1999-02-26  Craig Burley  <craig@jcb-sc.com>
+
+	* intdoc.in (DATE_AND_TIME): Explain that VALUES(7) holds
+	seconds, and VALUES(8), therefore, milliseconds.
+
+1999-02-26  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Clarify IOSTAT= fix.
+
+1999-02-25  Richard Henderson  <rth@cygnus.com>
+
+	* lang-specs.h: Define __FAST_MATH__ when appropriate.
+
+1999-02-25  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Clarify/index lack of run-time allocation for
+	concatenation.
+
+1999-02-25  Andreas Jaeger  <aj@arthur.rhein-neckar.de>
+
+	* f/intdoc.in: Add missing `,' after cross references.
+
+1999-02-20  Craig Burley  <craig@jcb-sc.com>
+
+	* Make-lang.in (f77.install-common, f77.install-info,
+	f77.install-man, f77.uninstall): Use `$(prefix)/lang-f77'
+	instead of `lang-f77' for flag file, to be sure of a
+	writable directory, and remove the flag file after each
+	operation to keep things clean.
+
+1999-02-20  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Properly attribute Priest document; clarify
+	that it is in the .ps version of the Goldberg document.
+
+1999-02-19  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs0.texi, bugs.texi, install0.texi, g77install.texi,
+	news0.texi, news.texi: Update copyright dates.
+	Clarify which files are source, which are derived,
+	and remind maintainers where copyright dates are sourced.
+	* BUGS, INSTALL, NEWS: Regenerated.
+
+1999-02-19  Craig Burley  <craig@jcb-sc.com>
+
+	* global.c (ffeglobal_ref_progunit_): Warn about a function
+	definition that disagrees with the type of a previous reference.
+	Improve commentary.  Fix a couple of minor bugs.  Clean up
+	some code.
+	* news.texi: Spread the joy.
+
+1999-02-18  Craig Burley  <craig@jcb-sc.com>
+
+	* expr.c (ffeexpr_finished_): Disallow non-default INTEGER
+	as argument for FILEINT and FILEASSOC as lhs.
+	* news.texi: Document fix.
+	* version.c: Bump.
+
+1999-02-18  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Clarify -fno-globals vs. -Wno-globals.
+
+1999-02-18  Craig Burley  <craig@jcb-sc.com>
+
+	* intdoc.in (LOG10): Fix typo.
+
+1999-02-17  Ulrich Drepper  <drepper@cygnus.com>
+
+	* intdoc.in: Fix typo.
+
+1999-02-17  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi, intdoc.in: Document Y2K and some other known
+	limitations.
+	* intrin.def (DTIME, FDATE): Fix capitalization of
+	case-sensitive forms of these intrinsics' names.
+
+1999-02-17  Dave Love  <fx@gnu.org>
+
+	* intdoc.in: Say `common' logarithm for log10.
+
+1999-02-16  Ulrich Drepper  <drepper@cygnus.com>
+
+	* g77.texi: Add missing @ in email addresses.
+
+1999-02-15  Craig Burley  <craig@jcb-sc.com>
+
+	* *.*: Delete my (old) email address in most places, change it
+	in a few.
+
+1999-02-14  Craig Burley  <craig@jcb-sc.com>
+
+	* version.c: Bump.
+
+1999-02-14  Craig Burley  <craig@jcb-sc.com>
+
+	* version.c: Bump for 1998-10-02 change (forgot to do this
+	before).
+
+1999-02-14  Craig Burley  <craig@jcb-sc.com>
+
+	* lang-specs.h, g77.1, g77.texi, news.texi: Recognize `.FOR'
+	and `.FPP' as well as `.for' and `.fpp'.
+
+1999-02-14  Craig Burley  <craig@jcb-sc.com>
+
+	* intdoc.in (LOG10): Fix description.
+
+1999-02-14  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Mention fix for SIGNAL invocation circa egcs-1.1.
+
+1999-02-14  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi, g77install.texi, bugs.texi, g77install.texi: Clean
+	up and improve indexing, and some other areas of docs.
+
+1999-02-14  Craig Burley  <craig@jcb-sc.com>
+
+	* intdoc.in (MCLOCK8, TIME8): Warn about lower range on
+	32-bit systems.
+
+Sat Feb  6 18:02:17 1999  Jeffrey A Law  (law@cygnus.com)
+
+	* g77.texi: Update email addresses.
+
+Wed Feb  3 22:50:17 1999  Marc Espie <Marc.Espie@liafa.jussieu.fr>
+
+	* Make-lang.in (g77$(exeext)): Get choose-temp.o, pexecute.o and
+	mkstemp.o from libiberty.
+
+1999-02-01  Zack Weinberg  <zack@rabi.columbia.edu>
+
+	* top.c: Don't define ffe_is_ident_.  Don't process
+	-f(no-)ident here.
+	* top.h: Remove declaration of ffe_is_ident_ and macros
+	ffe_is_ident() and ffe_set_is_ident().
+	* lex.c: Use flag_no_ident instead of ffe_is_ident().
+
+Sun Jan 31 20:34:29 1999  Zack Weinberg  <zack@rabi.columbia.edu>
+
+	* lang-specs.h: Map -Qn to -fno-ident.
+
+Tue Jan  5 22:12:41 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in (g77.o): Depend on prefix.h.
+
+Fri Nov 27 13:10:32 1998  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* fini.c: Rename variable `spaces' to `xspaces' to avoid
+	conflicting with function `spaces' from libiberty.
+
+	* g77spec.c: Don't prototype libiberty functions.
+	* malloc.c: Likewise.
+
+1998-11-20  Dave Love  <d.love@dl.ac.uk>
+
+	* g77.texi: Assorted minor changes.
+
+1998-11-19  Dave Love  <d.love@dl.ac.uk>
+
+	* bugs.texi: Formatting changes from Craig.
+
+	* intdoc.in: Terminate some @xrefs with `,'.
+
+1998-11-19  Manfred Hollstein  <manfred@s-direktnet.de>
+
+	* Make-lang.in (mandir): Replace all uses of $(mandir) by $(man1dir).
+
+Mon Nov  9 23:15:39 1998  Jeffrey A Law  (law@cygnus.com)
+
+	* g77.texi, news.texi: Updates from Craig.
+
+Sun Nov  8 17:47:56 1998  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Makefile.in (INCLUDES): Add "-I$(srcdir)/../../include".
+
+Sat Nov  7 15:58:54 1998  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* g77spec.c: Don't include gansidecl.h.
+	* output.j: Likewise.
+
+1998-11-04  Dave Love  <d.love@dl.ac.uk>
+
+	* g77.texi: Small formatting/indexing fixes.
+
+Mon Oct 12 20:41:59 1998  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bad.c (ffebad_finish): Change type of variable `c' to unsigned
+	char, change type of variable `s' to unsigned char *.
+
+	* com.c (ffecom_symbol_null_): Add missing initializers.
+
+	* fini.c (MAXNAMELEN): Undef it before defining.
+
+	* implic.c (ffeimplic_lookup_): Change type of parameter `c' to
+	unsigned char.
+
+	* intrin.c (ffeintrin_init_0): Cast the argument of ctype macros
+	to (unsigned char).
+
+	* lex.c (ffelex_splice_tokens): Change type of variable `p' to
+	unsigned char *.
+	(ffelex_token_name_from_names): Cast the argument of
+	`ffelex_is_firstnamechar' to (unsigned char).
+	(ffelex_token_names_from_names): Likewise.
+	(ffelex_token_new_name): Likewise.
+	(ffelex_token_new_names): Likewise.
+
+	* malloc.c (malloc_root_): Add missing initializer.
+
+	* stb.c (ffestb_do): Change type of variable `p' to unsigned char *.
+	(ffestb_else) Likewise.
+	(ffestb_else3_) Likewise.
+	(ffestb_endxyz) Likewise.
+	(ffestb_goto) Likewise.
+	(ffestb_let) Likewise.
+	(ffestb_varlist) Likewise.
+	(ffestb_R522) Likewise.
+	(ffestb_R528) Likewise.
+	(ffestb_R834) Likewise.
+	(ffestb_R835) Likewise.
+	(ffestb_R838) Likewise.
+	(ffestb_R1102) Likewise.
+	(ffestb_blockdata) Likewise.
+	(ffestb_R1212) Likewise.
+	(ffestb_R810) Likewise.
+	(ffestb_R10014_): Cast the argument of `ffelex_is_firstnamechar'
+	to (unsigned char).
+	(ffestb_V014): Change type of variable `p' to unsigned char *.
+	(ffestb_dummy) Likewise.
+	(ffestb_R524) Likewise.
+	(ffestb_R547) Likewise.
+	(ffestb_decl_chartype) Likewise.
+	(ffestb_decl_dbltype) Likewise.
+	(ffestb_decl_gentype) Likewise.
+	(ffestb_decl_entsp_2_) Likewise.
+	(ffestb_V027) Likewise.
+	(ffestb_decl_R539) Likewise.
+
+	* top.c (ffe_decode_option): Mark parameter `argc' with
+	ATTRIBUTE_UNUSED.
+
+	* where.c (ffewhere_unknown_line_): Add missing initializers.
+
+1998-10-02  Dave Love  <d.love@dl.ac.uk>
+
+	* com.c (ffecom_expr_intrinsic_): Fix return type for RAND.
+
+Thu Oct  1 10:43:45 1998  Nick Clifton  <nickc@cygnus.com>
+
+	* lex.c: Replace occurances of HANDLE_SYSV_PRAGMA with
+	HANDLE_GENERIC_PRAGMAS.
+
+Mon Sep 28 04:22:00 1998  Jeffrey A Law  (law@cygnus.com)
+
+	* news.texi: Update from Craig.
+
+1998-09-23  Dave Love  <d.love@dl.ac.uk>
+
+	* g77.texi: Additions about `/*', trailing comments and cpp.
+
+1998-09-18  Dave Love  <d.love@dl.ac.uk>
+
+	* g77.texi: Various additions and some small fixes.
+
+Thu Sep 10 14:55:44 1998  Kamil Iskra  <iskra@student.uci.agh.edu.pl>
+
+	* Make-lang.in (f77.install-common): Add missing "else true;".
+
+1998-09-07  Dave Love  <d.love@dl.ac.uk>
+
+	* ChangeLog.egcs: Deleted.  Entries merged here.
+
+1998-09-05  Dave Love  <d.love@dl.ac.uk>
+
+	* Makefile.in (LDFLAGS): Set from BOOT_LDFLAGS.
+	(F771_LDFLAGS): Variable dispensed with.
+
+Fri Sep  4 19:53:34 1998  Craig Burley  <burley@gnu.org>
+
+	* intdoc.in: Minor editorial tweaks.
+
+Fri Sep  4 18:35:52 1998  Craig Burley  <burley@gnu.org>
+
+	* lang-options.h: Convert to wrap option and doc string
+	in a new macro invocation, FTNOPT, so the nearly identical
+	list can be used in FSF-g77.
+
+Fri Sep  4 18:35:52 1998  Craig Burley  <burley@gnu.org>
+
+	* Makefile.in (fini.o): Don't define USE_HCONFIG here.
+	* fini.c: Define USE_HCONFIG here instead, so deps-kinda
+	picks up correct dependency.
+
+	* Makefile.in (proj-h.o): Fix dependencies list.
+
+Wed Sep 02 09:25:29 1998  Nick Clifton  <nickc@cygnus.com>
+
+	* lex.c (ffe_lex_hash):  Change how HANDLE_PRAGMA and
+	HANDLE_SYSV_PRAGMA would be called if they pragma parsing was
+	enabled in this code.
+	Generate warning messages if unknown pragmas are encountered.
+	(pragma_getc): New function: retrieves characters from the
+	input stream.  Defined when HANDLE_PRAGMA is defined.
+	(pragma_ungetc): New function: replaces characters back into the
+	input stream.  Defined when HANDLE_PRAGMA is defined.
+
+Tue Sep  1 10:00:21 1998  Craig Burley  <burley@gnu.org>
+
+	* bugs.texi, g77.1, g77.texi, intdoc.in, news.texi: Doc updates
+	from Craig.
+
+1998-08-23  Dave Love  <d.love@dl.ac.uk>
+
+	* g77.texi: Increment `version-g77' and fix a few typos.
+
+Tue Aug 18 21:41:31 1998  Jeffrey A Law  (law@cygnus.com)
+
+	* Make-lang.in: Add several "else true" clauses to deal with lame
+	systems.
+
+Tue Aug 11 08:12:14 1998  H.J. Lu  (hjl@gnu.org)
+
+	* Make-lang.in (g77.o): Touch lang-f77 before checking it.
+
+1998-08-09  Dave Love  <d.love@dl.ac.uk>
+
+	* Make-lang.in (f/g77.dvi): Replace non-working use of texi2dvi
+	with explicit use of tex.
+	(f77.mostlyclean): Remove TeX index files.
+
+	* g77install.texi (Prerequisites): Kluge round TeX lossage with
+	hyphen in @value in @code.
+
+Tue Aug  4 16:59:39 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_convert_narrow_, ffecom_convert_widen_):
+	Allow conversion from pointer to same-sized integer,
+	to fix invoking SIGNAL as a function.
+
+1998-07-26  Dave Love  <d.love@dl.ac.uk>
+
+	* BUGS, INSTALL, NEWS: Rebuilt.
+
+Sat Jul 25 17:23:55 1998  Craig Burley  <burley@gnu.org>
+
+	Fix 980615-0.f:
+	* stc.c (ffestc_R1229_start): Set info to ANY as well.
+
+Tue Jul 21 04:33:37 1998  Craig Burley  <burley@gnu.org>
+
+	* g77spec.c (lang_specific_driver): Return unmolested
+	command line when --help seen.
+	Comment out code that printed g77-specific --help info.
+
+Sat Jul 18 19:16:48 1998  Craig Burley  <burley@gnu.org>
+
+	* lang-options.h: Fix up doc strings.
+	Remove the unimplemented -fdcp-intrinsics-* options.
+
+	* str-1t.fin: Change mixed-case spelling of `GoTo' from
+	`Goto'.
+
+Thu Jul 16 13:26:36 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_finish_symbol_transform_): Revert change
+	of 1998-05-23, as it was too aggressive, in that it
+	prevented transformation of (used) functions before
+	primary code generation.
+
+1998-07-15  Dave Love  <d.love@dl.ac.uk>
+
+	* intdoc.texi: Regenerated.
+
+Mon Jul 13 18:45:06 1998  Craig Burley  <burley@gnu.org>
+
+	* Make-lang.in (f77.rebuilt): Fix to depend on
+	build-dir-based, not source-based, g77.info.
+
+	* g77.texi: Merge docs with 0.5.24.
+	* g77install.texi: Ditto.
+
+Mon Jul 13 18:02:29 1998  Craig Burley  <burley@gnu.org>
+
+	Cleanups vis-a-vis g77-0.5.24:
+	* g77spec.c (lang_specific_driver): Tabify source.
+	* top.c (ffe_decode_option): Use fixed macro to set
+	internal-checking flag.
+	* top.h (ffe_set_is_do_internal_checks): Fix macro.
+
+Mon Jul 13 17:33:44 1998  Craig Burley  <burley@gnu.org>
+
+	Cleanups vis-a-vis system.h cutover and g77-0.5.24:
+	* Makefile.in (fini.o): Define USE_HCONFIG macro
+	so source code doesn't have to.
+	* fini.c: Don't define USE_HCONFIG here, since
+	source code usually shouldn't care about this.
+	* ansify.c: Include stddef.h only if we have it.
+	* intdoc.c: Ditto.
+	* proj.h: Ditto.
+
+Mon Jul 13 17:30:29 1998  Nick Clifton  <nickc@cygnus.com>
+
+	* lang-options.h: Format changed to work with --help support added
+	to gcc/toplev.c
+
+Mon Jul 13 11:54:03 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_push_tempvar): Replace kludge that
+	munged back-end globals directly with proper calls
+	to push_topmost_sequence and pop_topmost_sequence.
+
+1998-07-12  Dave Love  <d.love@dl.ac.uk>
+
+	* version.c: Bump version.
+
+Sat Jul 11 19:24:32 1998  Craig Burley  <burley@gnu.org>
+
+	Fix 980616-0.f:
+	* equiv.c (ffeequiv_offset_): Don't crash on various
+	possible ANY operands.
+
+Sat Jul 11 18:24:37 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_expr_) [FFEBLD_opCONTER]: Die if padding
+	for constant is nonzero.
+
+	* com.c (__eprintf): Delete this function, it is obsolete.
+
+1998-07-09  Dave Love  <d.love@dl.ac.uk>
+
+	* intdoc.in (HOSTNM_func, HOSTNM_subr): Update last change.
+
+Thu Jul  9 00:45:59 1998  Craig Burley  <burley@gnu.org>
+
+	Fix debugging of CHARACTER*(*), etc., which requires
+	emitting debug info on types like `ftnlen':
+	* com.c (ffecom_start_progunit_): Don't bother
+	resetting "invented" flag for identifier.
+	(ffecom_transform_equiv_): Don't bother zeroing
+	"ignored" flag for decl.
+	(pushdecl): No longer set "ignored", "used", or
+	"suppressed debug" flags for decls having "invented"
+	identifiers.
+
+1998-07-06  Mike Stump  <mrs@wrs.com>
+
+	* Make-lang.in (f77.stage?): Use mv -f instead of just mv so that
+	we can move g77.c.
+
+1998-07-06  Dave Love  <d.love@dl.ac.uk>
+
+	* intdoc.in (HOSTNM_func, HOSTNM_subr): Note possible need for
+	-lsocket.
+
+1998-07-05  Dave Love  <d.love@dl.ac.uk>
+
+	* intdoc.in: Add entry for DATE_AND_TIME.
+
+	* intrin.def: Add implementation for DATE_AND_TIME.  Make second
+	and third args of SYSTEM_CLOCK optional.
+
+	* com.c (ffecom_expr_intrinsic_): New case for DATE_AND_TIME.
+
+	* com-rt.def (FFECOM_gfrtSYSTEM_CLOCK): Call G77_system_clock_0,
+	not system_clock_.
+	(FFECOM_gfrtDATE_AND_TIME): New DEFGFRT.
+
+Wed Jul  1 11:19:13 1998  Craig Burley  <burley@gnu.org>
+
+	Fix 980701-1.f (which was producing "unaligned trap"
+	on an Alpha running GNU/Linux, as predicted):
+	* equiv.c (ffeequiv_layout_local_): Don't bother
+	coping with pre-padding of entire area while building
+	it; do that instead after the building is done, and
+	do it by modifying only the modulo field.  This covers
+	the case of alignment stringency being increased without
+	lowering the starting offset, unlike the previous changes,
+	and even more elegantly than those.
+
+	* target.c (ffetarget_align): Make sure alignments
+	are nonzero, just in case.
+
+See ChangeLog.0 for earlier changes.
+
+Local Variables:
+add-log-time-format: current-time-string
+End:
+2003-01-01  Andreas Jaeger  <aj@suse.de>
+
+	* f/Make-lang.in ($(srcdir)/f/BUGS): Add include path for
+	gcc-common.texi.
+	($(srcdir)/f/NEWS): Likewise.
+
+2002-12-28  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* g77.texi: Use @copying.
+
+2002-12-23  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* root.texi: Include gcc-common.texi.
+	* bugs.texi, news.texi: Don't include root.texi as part of full
+	manual.
+	* g77.texi: Update for use of gcc-common.texi.
+	* Make-lang.in ($(srcdir)/f/g77.info, f/g77.dvi): Depend on
+	$(srcdir)/doc/include/gcc-common.texi.
+
+2002-12-19  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* intdoc.in: Fix typos.
+
+2002-12-18  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* g77.texi: Fix typos.
+	* intdoc.texi: Likewise.
+	* news.texi: Follow spelling conventions.
+
+Mon Dec 16 13:53:18 2002  Mark Mitchell  <mark@codesourcery.com>
+
+	* root.texi: Change version number to 3.4.
+
+2002-12-15  Zack Weinberg  <zack@codesourcery.com>
+
+	* target.h: Don't define HOST_WIDE_INT.
+
+2002-12-02  Nathanael Nerode  <neroden@gcc.gnu.org>
+
+	* Make-lang.in, ansify.c, intdoc.c, proj.h: Replace hconfig.h with
+	bconfig.h.
+	* fini.c, proj.h: Replace USE_HCONFIG with USE_BCONFIG
+
+2002-11-30  Zack Weinberg  <zack@codesourcery.com>
+
+	* proj.h, ansify.c, g77spec.c, intdoc.c:
+	Include coretypes.h and tm.h.
+	* Make-lang.in: Update dependencies.
+
+2002-11-20  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* invoke.texi: Explain the purpose of -fmove-all-movables,
+	-freduce-all-givs and -frerun-loop-opts better.
+
+2002-11-19  Nathanael Nerode  <neroden@gcc.gnu.org>
+
+	* Make-lang.in: Correct BUILD/HOST confusion.
+
+2002-11-19  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	PR fortran/8587
+	* news.texi: Show PR fortran/8587 fixed.
+
+2002-11-19  Jason Thorpe  <thorpej@wasabisystems.com>
+
+	* g77spec.c (lang_specific_spec_functions): New.
+
+2002-11-02  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77.texi: Correct documentation on generating C++ prototypes
+	of Fortran routines with f2c.
+	* news.texi: Document fixes in GCC-3.3, 3.2 and 3.1.
+
+2002-10-30  Roger Sayle  <roger@eyesopen.com>
+
+	* com.c (ffecom_subscript_check_): Cast the failure branch
+	of the bounds check COND_EXPR to void, to indicate noreturn.
+	(ffe_truthvalue_conversion): Only apply truth value conversion
+	to the non-void branches of a COND_EXPR.
+
+2002-10-26  Andris Pavenis  <pavenis@latnet.lv>
+
+	* lang-specs.h: Fix ratfor specs.
+
+2002-10-15  Richard Henderson  <rth@redhat.com>
+
+	* target.h (ffetarget_print_real1, ffetarget_print_real2): Use
+	real_to_decimal directly, and with the new arguments.
+
+2002-09-23  Zack Weinberg  <zack@codesourcery.com>
+
+	* Make-lang.in (g77spec.o): Don't depend on f/version.h.
+	(f/parse.o): Depend on version.h not f/version.h.
+	(g77version.o, f/version.o): Delete all references.
+
+	* com.c (ffecom_init_0): Fix transposed array indices in bsearch test.
+	* g77spec.c: Don't include f/version.h or refer to ffe_version_string.
+	* parse.c: Use version_string, not ffe_version_string.
+	* version.c, version.h: Delete files.
+
+2002-09-23  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* ChangeLog: Follow spelling conventions.
+	* ChangeLog.0: Likewise.
+	* com.c: Likewise.
+	* ffe.texi: Likewise.
+	* g77.texi: Likewise.
+	* intdoc.in: Likewise.
+	* invoke.texi: Likewise.
+	* news.texi: Likewise.
+	* intdoc.texi: Regenerate.
+
+2002-09-16  Geoffrey Keating  <geoffk@apple.com>
+
+	* com.c (union lang_tree_node): Add chain_next option.
+
+2002-09-16  Richard Henderson  <rth@redhat.com>
+
+	* target.c (ffetarget_real1): Don't pass FFETARGET_ATOF_
+	directly to ffetarget_make_real1.
+	(ffetarget_real2): Similarly.
+	* target.h (ffetarget_cvt_r1_to_rv_, ffetarget_cvt_rv_to_r2_,
+	ffetarget_cvt_r2_to_rv_): Use new real.h interface and simplify.
+
+2002-09-15  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* intdoc.texi: Regenerate.
+
+2002-09-15  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* ChangeLog: Follow spelling conventions.
+	* intdoc.in: Likewise.
+
+2002-09-09  Gerald Pfeifer  <pfeifer@dbai.tuwien.ac.at>
+
+	Fix PR web/7596:
+	* ffe.texi (Front End): Fix broken links.
+	* bugs.texi (Known Bugs): Refer to gcc.gnu.org instead of
+	www.gnu.org for onlinedocs.
+	* news.texi (News): Ditto.
+
+2002-09-07  Jan Hubicka  <jh@suse.cz>
+
+	* com.c (ffe_type_for_mode): Handle long double.
+
+2002-09-04  Richard Henderson  <rth@redhat.com>
+
+	* target.h (ffetarget_print_real1, ffetarget_print_real2): Update
+	call to REAL_VALUE_TO_DECIMAL.
+
+2002-08-31  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c: Don't set flag_finite_math_only by default.
+	* invoke.texi: Reverse the documentation of option
+	-ffinite-math-only to reflect the new default.
+
+2002-08-30  Hans-Peter Nilsson  <hp@bitrange.com>
+
+	* target.c (ffetarget_memcpy_): Don't test nonexistent
+	HOST_BYTES_BIG_ENDIAN, HOST_BITS_BIG_ENDIAN.  Check
+	HOST_WORDS_BIG_ENDIAN against both WORDS_BIG_ENDIAN and
+	BYTES_BIG_ENDIAN.
+
+2002-08-30  Alan Modra  <amodra@bigpond.net.au>
+
+	* target.h (FFETARGET_32bit_longs): Don't define for powerpc64 or
+	mmix.
+
+2002-08-28  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* bugs.texi, news.texi: Update URLs for online news and bugs
+	lists.
+
+2002-08-22  Hans-Peter Nilsson  <hp@bitrange.com>
+
+	* where.h (struct _ffewhere_file_): Mark GTY.
+	(ffewhere_file_kill): Remove prototype.
+	* where.c: Include ggc.h.
+	(struct _ffewhere_ll_, struct _ffewhere_root_ll_): Mark GTY.
+	(ffewhere_root_ll_): Ditto.  Change type from struct
+	_ffewhere_root_ll_ to struct _ffewhere_root_ll_*.  All uses
+	changed.
+	(ffewhere_file_kill): Remove.
+	(ffewhere_file_new): Use GC to allocate ffewhereFile objects.
+	(ffewhere_file_set): Use GC to allocate ffewhereLL_ objects.
+	(ffewhere_init_1): Use GC to allocate ffewhere_root_ll_ sentinel.
+	Include gt-f-where.h.
+	* lex.c (ffelex_current_wf_, ffelex_include_wherefile_): Mark GTY.
+	Include gt-f-lex.h.
+	* std.c (ffestd_S3P4): Don't call ffewhere_file_kill.
+	* config-lang.in (gtfiles): Add f/where.h f/where.c and f/lex.c.
+	* Make-lang.in (gt-f-lex.h gt-f-where.h): Add to dependents of
+	s-gtype.
+	(f/lex.o): Depend on gt-f-lex.h.
+	(f/where.o): Depend on gt-f-where.h.
+
+Tue Aug 20 16:49:40 2002  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* where.c (ffewhere_track): Remove impossible if-then clause.
+
+Thu Aug  8 10:06:14 2002  Nathan Sidwell  <nathan@codesourcery.com>
+
+	* f/Make-lang.in (f.mostlyclean): Remove coverage files.
+
+2002-08-06  Gerald Pfeifer  <pfeifer@dbai.tuwien.ac.at>
+
+	* g77.texi (Top): Rename Index to Keyword Index.
+
+2002-08-05  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* invoke.texi: Improve description of
+	-fno-finite-math-only flag.
+
+Sun Aug  4 16:45:49 2002  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* root.texi (version-gcc): Increase to 3.3.
+
+2002-07-30  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffe_init_options): Set
+	flag_finite_math_only.
+	* invoke.texi: Document -fno-finite-math-only.
+
+Mon Jul 29 22:05:35 2002  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (read_name_map): Use concat in lieu of xmalloc/strcpy.
+
+2002-07-25  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Document better handling of (no-)alias
+	information of dummy arguments and induction variables
+	on loop unrolling.
+
+2002-07-01  Roger Sayle  <roger@eyesopen.com>
+
+	* f/com.c (builtin_function): Accept additional parameter.
+	(ffe_com_init_0): Pass an additional NULL_TREE argument to
+	builtin_function.
+
+2002-06-28  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Mention 2 Gbyte limit on 32-bit targets
+	for arrays explicitly in news on g77-3.1.
+
+Thu Jun 20 21:56:34 2002  Neil Booth  <neil@daikokuya.co.uk>
+
+	* lang-specs.h: Use cc1 for traditional preprocessing.
+
+2002-06-20  Andreas Jaeger  <aj@suse.de>
+
+	* com.c (ffecom_prepare_expr_,ffecom_expr_power_integer_):
+	Remove #ifdefed HAHA sections.
+
+2002-06-20  Nathanael Nerode  <neroden@twcny.rr.com>
+
+	* com.c: Remove #ifdef HOHO sections.
+
+2002-06-17  Jason Thorpe  <thorpej@wasabisystems.com>
+
+	* bit.c: Don't include glimits.h.
+	* target.c: Likewise.
+	* where.h: Likewise.
+
+2002-06-12  Gabriel Dos Reis  <gdr@codesourcery.com>
+
+	* bad.c (ffebad_start_): Adjust calls to diagnostic_count_error.
+
+2002-06-04  Gabriel Dos Reis  <gdr@codesourcery.com>
+
+	* bad.c (ffebad_start_): Adjust call to count_error.
+	* Make-lang.in (f/bad.o): Depend on diagnostic.h
+	* bad.c: #include diagnostic.h
+
+2002-06-03  Geoffrey Keating  <geoffk@redhat.com>
+
+	* Make-lang.in (f/com.o): Depend on debug.h.
+	* com.c: Include debug.h.
+	(LANG_HOOKS_MARK_TREE): Delete.
+	(struct lang_identifier): Use gengtype.
+	(union lang_tree_node): New.
+	(struct lang_decl): New dummy definition.
+	(struct lang_type): New dummy definition.
+	(ffe_mark_tree): Delete.
+
+	* com.c (struct language_function): New dummy structure.
+
+	* Make-lang.in: Add rules to generate gt-f-ste.h gtype-f.h; allow
+	for filename changes.
+	(com.o): Allow for filename changes; add gtype-f.h as dependency.
+	(ste.o): Add gt-f-ste.h as dependency.
+	* config-lang.in (gtfiles): Add com.h, ste.c.
+	* com.c: Replace uses of ggc_add_* with GTY markers.  Include
+	gtype-f.h.
+	(mark_binding_level): Delete.
+	* com.h: Replace uses of ggc_add_* with GTY markers.
+	* ste.c: Replace uses of ggc_add_* with GTY markers.  Include
+	gt-f-ste.h.
+
+	* Make-lang.in (f/gt-com.h): Build using gengtype.
+	(com.o): Depend on f/gt-com.h.
+	* com.c: Rename struct binding_level to f_binding_level.
+	(struct f_binding_level): Use gengtype.
+	(struct tree_ggc_tracker): Use gengtype.
+	(mark_tracker_head): Use gt_ggc_m_tree_ggc_tracker.
+	(make_binding_level): Use GGC.
+	(mark_binding_level): Use gt_ggc_m_f_binding_level.
+	(ffecom_init_decl_processing): Change free_binding_level
+	to a deletable root.
+	* config-lang.in (gtfiles): Define.
+	* where.c: Strings need no longer be allocated in GCable memory;
+	remove my change of 30 Dec 1999.
+
+2002-05-31  Matthew Woodcraft  <mattheww@chiark.greenend.org.uk>
+
+	* lang-specs.h: Use cpp_debug_options.
+
+2002-05-28  Zack Weinberg  <zack@codesourcery.com>
+
+	* bld.c, com.c, expr.c, target.c: Include real.h.
+	* Make-lang.in: Update dependency lists.
+
+2002-05-16  Rainer Orth  <ro@TechFak.Uni-Bielefeld.DE>
+
+	* Make-lang.in: Allow for PWDCMD to override hardcoded pwd.
+
+2002-05-09  Hassan Aurag  <aurag@cae.com>
+
+	* expr.c (ffeexpr_reduced_ugly2log_): Allow logicals-as-integers
+	under -fugly-logint as arguments of .and., .or., .xor.
+
+2002-05-07  Jan Hubicka  <jh@suse.cz>
+
+	* target.h (FFETARGET_32bit_longs): Undefine for x86-64.
+
+2002-04-29  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* invoke.texi: Use @gol at ends of lines inside @gccoptlist.
+	* g77.texi: Update last update date.
+
+Thu Apr 25 07:44:44 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.h (ffe_parse_file): Update.
+	* lex.c (ffe_parse_file): Update.
+
+2002-04-20  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* root.texi: Remove variable version-g77.
+	* g77.texi: Remove the single use of that variable.
+
+Thu Apr 18 19:10:44 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (incomplete_type_error): Remove.
+
+Tue Apr 16 14:55:47 2002  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (ffecom_expr_power_integer): Add has_scope argument to
+	call to expand_start_stmt_expr.
+
+Mon Apr 15 10:59:14 2002  Mark Mitchell  <mark@codesourcery.com>
+
+	* g77.texi: Remove Chill reference.
+
+2002-04-13  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Deprecate frontend version number;
+	update list of fixed bugs.
+
+2002-04-08  Hans-Peter Nilsson  <hp@bitrange.com>
+
+	* Make-lang.in (f/target.o): Depend on diagnostic.h.
+	* target.c: Include diagnostic.h.
+	(ffetarget_memcpy_): Call sorry if host and target endians are
+	not matching.
+
+Thu Apr  4 23:29:48 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (LANG_HOOKS_TRUTHVALUE_CONVERSION): Redefine.
+	(truthvalue_conversion): Rename.  Update.  Make static.
+	(ffecom_truth_value): Update.
+
+Mon Apr  1 21:39:36 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (LANG_HOOKS_MARK_ADDRESSABLE): Redefine.
+	(mark_addressable): Rename.
+	(ffecom_arrayref_, ffecom_1): Update.
+
+Mon Apr  1 09:59:53 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (LANG_HOOKS_SIGNED_TYPE, LANG_HOOKS_UNSIGNED_TYPE,
+	LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE): New.
+	(unsigned_type, signed_type, signed_or_unsigned_type): Rename.
+
+Sun Mar 31 23:50:22 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (lang_print_error_function): Rename.
+	(LANG_HOOKS_PRINT_ERROR_FUNCTION): Redefine.
+	(ffe_init): Don't set hook.
+
+Fri Mar 29 21:59:15 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (LANG_HOOKS_TYPE_FOR_MODE, LANG_HOOKS_TYPE_FOR_SIZE):
+	Redefine.
+	(type_for_mode, type_for_size): Rename.
+	(signed_or_unsigned_type, signed_type, truthvalue_conversion,
+	unsigned_type):	Use new hooks.
+
+Tue Mar 26 10:30:05 2002  Andrew Cagney  <ac131313@redhat.com>
+
+	* invoke.texi (Warning Options): Mention -Wswitch-enum.
+	Fix PR c/5044.
+
+Tue Mar 26 07:30:51 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (LANG_HOOKS_MARK_TREE): Redefine.
+	(lang_mark_tree): Rename ffe_mark_tree, make static.
+
+Mon Mar 25 19:27:11 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (maybe_build_cleanup): Remove.
+
+2002-03-23  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffecom_check_size_overflow_): Add a test
+	so that arrays too large for 32-bit byte-offset
+	addressing get caught.
+	* news.texi: Document the fixing of this problem.
+
+Sat Mar 23 11:18:17 2002  Andrew Cagney  <ac131313@redhat.com>
+
+	* invoke.texi (Warning Options): Mention -Wswitch-default.
+
+Thu Mar 21 18:55:41 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* cp-tree.h (pushdecl, pushlevel, poplevel, set_block,
+	insert_block, getdecls, global_bindings_p): New.
+
+Wed Mar 20 08:03:42 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (lang_printable_name): Rename.
+	(LANG_HOOKS_DECL_PRINTABLE_NAME): Redefine.
+	(ffe_init): Don't use old hook.
+
+Sun Mar 17 18:50:15 2002  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.h (ffe_parse_file): Prototype.
+
+Sun Mar 17 20:57:30 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (LANG_HOOKS_PARSE_FILE): Redefine.
+	* com.h (ffe_parse_file): New.
+	* parse.c (NAME_OF_STDIN): Remove.
+	(yyparse): Rename ffe_parse_file.
+
+Tue Mar 12 20:23:18 2002  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (tree_code_type, tree_code_length, tree_code_name):
+	Define.
+
+Sun Mar 10 12:37:42 2002  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* target.c (ffetarget_print_hex): Const-ify.
+
+2002-03-06  Phil Edwards  <pme@gcc.gnu.org>
+
+	* version.c:  Fix misplaced leading blanks on first line.
+
+2002-03-03  Zack Weinberg  <zack@codesourcery.com>
+
+	* com.c, target.h: Remove all #ifndef REAL_ARITHMETIC
+	blocks, make all #ifdef REAL_ARITHMETIC blocks unconditional.
+	Delete some further #ifdef blocks predicated on REAL_ARITHMETIC.
+
+Thu Feb 28 07:53:46 2002  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (copy_lang_decl): Delete.
+
+2002-02-27  Zack Weinberg  <zack@codesourcery.com>
+
+	* com.c, lex.c, top.c: Delete traditional-mode-related code
+	copied from the C front end but not used, or used only to
+	permit the compiler to link.
+
+2002-02-13  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: List Problem Reports fixed in 3.1.
+
+2002-02-13  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* data.c (ffedata_eval_offset_): Only convert index,
+	low and high bound in data statements to default integer
+	if they are constants.  Use a copy of the data structure.
+
+2002-02-09  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* data.c (ffedata_eval_offset_): Convert non-default integer
+	constants to default integer kind if necessary.
+
+2002-02-09  Toon Moene  <toon@moene.indiv.nlug.nl>
+
+	* invoke.texi: Add a short debugging session
+	as an example to the documentation of -g.
+
+2002-02-06  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	PR fortran/4730 fortran/5473
+	* com.c (ffecom_expr_): Deal with %VAL constructs.
+	* intrin.c (ffeintrin_check_): Handle 'N' constraints for intrinsics,
+	to indicate "no larger than default kind" integers and logicals.
+	* intrin.def: Use 'N' constraints in table of intrinsics.
+	* intdoc.c: Document this constraint.
+	* intdoc.texi: Regenerated.
+
+2002-02-04  Philipp Thomas  <pthomas@suse.de>
+
+	* implic.c lex.c stb.c ste.c stu.c: Update copyright dates.
+
+2002-02-04  Philipp Thomas  <pthomas@suse.de>
+
+	* bad.def com.c expr.c implic.c lex.c stb.c ste.c stu.c:
+	Insert comments to mark messages as not being printf style
+	where appropriate.
+
+2002-02-03  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* expr.c (ffeexpr_sym_impdoitem_): Allow other than
+	default INTEGER implied-do loop counts.
+
+2002-02-01  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* bad.def: Remove non-historical reference to version 0.6.
+	* bugs.texi: Ditto.
+	* com.c: Ditto.
+	* ffe.texi: Ditto.
+	* proj.h: Ditto.
+	* g77.texi: Ditto.
+
+2002-01-31  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77spec.c (lang_specific_driver): Follow GNU Coding Standards
+	for --version.
+
+2002-01-30  Richard Henderson  <rth@redhat.com>
+
+	* ste.c (ffeste_begin_iterdo_): Use expand_exit_loop_top_cond.
+	(ffeste_R819B): Likewise.
+
+2002-01-30  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* intrin.c (upcasecmp_): New function.
+	(ffeintrin_cmp_name_): Use it to correctly compare name
+	and table entry for bsearch.
+
+2002-01-26  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* intrin.c (ffeintrin_cmp_name_): Correct comparison
+	for intrinsics in intrinsic table (intrin.def).
+
+2002-01-22  Zack Weinberg  <zack@codesourcery.com>
+
+	* bad.c: Include intl.h.
+	(FFEBAD_MSGS1, FFEBAD_MSGS2): Replace by FFEBAD_MSG, SHORT,
+	LONG.  Adjust definitions to work with exgettext.
+	(ffebad_start_): Translate all error messages.
+	(ffebad_finish): Mark constant strings for translation.
+	* bad.h: Use FFEBAD_MSG.  Adjust prototype of ffebad_start_
+	and definitions of ffebad_start_msg, ffebad_start_msg_lex to
+	work with exgettext.
+	* bad.def: Use FFEBAD_MSG, SHORT, LONG throughout.
+
+	* com.c: Include intl.h.
+	(lang_print_error_function): Always use ffeinfo_kind_message
+	to get the kind label for a non-nested construct.  Translate
+	it.  Translate constant strings.
+	* info.c (FFEINFO_KIND): Adjust definition to work with exgettext.
+	* info-k.def: Block xgettext from slurping copyright notice
+	into gcc.pot.  Adjust strings for their sole use, in com.c.
+
+	* Make-lang.in (f/bad.o, f/com.o): Depend on intl.h.
+
+2002-01-14  David Billinghurst <David.Billinghurst@riotinto.com>
+
+	PR fortran/3807
+	* f/intrin.c (ffeintrin_check_):  Allow for case of intrinsic
+	control string have COL-spec an integer > 0.
+
+2002-01-08  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77spec.c (lookup_option): Handle -fversion.
+	(lang_specific_driver): Update copyright date in --version output.
+
+Mon Jan  7 00:03:42 2002  Gerald Pfeifer  <pfeifer@dbai.tuwien.ac.at>
+
+	* invoke.texi: Markup g77 as @command.  Remove reference to
+	http://gcc.gnu.org/thanks.html.
+
+Wed Jan  2 18:13:11 2002  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (clear_binding_level): Const-ify.
+	(ffecom_arglist_expr_): Likewise.
+	* info.c (ffeinfo_types_): Don't needlessly zero init.
+	* lex.c (ffelex_hash_kludge): Const-ify.
+
+Sun Dec 23 10:45:09 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (ffecom_gfrt_volatile_, ffecom_gfrt_complex_,
+	ffecom_gfrt_const_, ffecom_gfrt_type_): Const-ify.
+
+Sat Dec 22 16:01:51 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bld.c (ffebld_arity_op_): Declare array size explicitly.
+	* bld.h (ffebld_arity_op_): Likewise.
+
+2001-12-20  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* config-lang.in (diff_excludes): Remove.
+
+2001-12-17  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77.texi, invoke.texi: Update links to GCC manual.
+
+Sun Dec 16 16:08:57 2001  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* news.texi: Fix spelling errors.
+
+Sun Dec 16 10:36:51 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in (f/version.o): Depend on f/version.h.
+	* version.c: Include ansidecl.h and f/version.h.
+
+Sun Dec 16 08:52:48 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* lex.c (ffelex_backslash_, ffelex_cfebackslash_): Use hex_value.
+	* target.c (ffetarget_integerhex, ffetarget_typeless_hex): Use
+	hex_p/hex_value.
+
+2001-12-14  Roger Sayle <roger@eyesopen.com>
+
+	* com-rt.def: Use __builtin_sqrt instead of __builtin_fsqrt.
+	* com.c (ffecom_init_0): Same, and fixed enumeration usage.
+
+2001-12-10  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77.texi: Don't condition menus on @ifinfo.
+
+Wed Dec  5 06:49:21 2001  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (ffecom_1): Properly handle TREE_READONLY for INDIRECT_REF.
+
+Mon Dec  3 18:56:04 2001  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c: Remove leading capital from diagnostic messages, as
+	per GNU coding standards.
+	* g77spec.c: Similarly.
+	* lex.c: Similarly.
+
+2001-12-01  Zack Weinberg  <zack@codesourcery.com>
+
+	* f/fini.c: Use xmalloc.
+
+Fri Nov 30 20:54:02 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in: Delete references to proj.[co], proj-h.[co].
+	* proj.c: Delete file.
+
+2001-11-29  Zack Weinberg  <zack@codesourcery.com>
+
+	* Make-lang.in (f/fini, f/intdoc): Depend on $(HOST_LIBDEPS)
+	and link with $(HOST_LIBS), not safe-ctype.o.
+
+2001-11-29  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* Make-lang.in (f77.generated-manpages): New target.
+	($(srcdir)/f/g77.1): Don't check $(GENERATED_MANPAGES).  Allow
+	manpage generation to fail.
+	(f77.info): Don't depend on $(srcdir)/f/g77.1.
+	(f77.install-man): Depend on $(GENERATED_MANPAGES) rather than
+	directly on $(srcdir)/g77.1.
+
+2001-11-24  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	PR fortran/3957
+	* lang-specs.h: Correct !pipe conditional in tradcpp0 invocation.
+
+2001-11-21  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77.texi: egcs was not a `@command'.
+	* invoke.texi: Ditto.
+	* news.texi: Substitute `@command' for `@code'
+	and `@option' for `@samp' where appropriate.
+
+2001-11-19  Loren J. Rittle  <ljrittle@acm.org>
+
+	* Make-lang.in: Complete ``Build g77.1 in $(srcdir)''.
+
+2001-11-19  Geoffrey Keating  <geoffk@redhat.com>
+
+	* g77spec.c (lang_specific_driver) [ENABLE_SHARED_LIBGCC]: Add
+	libgcc_s.so if libf2c is used.
+	* Make-lang.in (g77spec.o): Use DRIVER_DEFINES.
+
+2001-11-19  Toon Moene <toon@moene.indiv.nluug.nl>
+
+	* .cvsignore: Ignore g77.1
+	* g77.texi: Substitute `@command' for `@code'
+	where appropriate.
+	* invoke.texi: Ditto.
+
+2001-11-18  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* Make-lang.in: Remove all references to LANGUAGES
+	and the stamp files that depend on its value.
+
+Sun Nov 18 11:13:04 2001  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (finish_parse): Remove.
+	(ffe_finish): Move body of finish_parse.
+
+Thu Nov 15 10:06:38 2001  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (ffecom_init_decl_processing): Renamed from
+	init_decl_processing.
+	(init_parse): Move contents to ffe_init.
+	(ffe_init): Update prototype.
+
+2001-11-14  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77.texi: Update to use `@command', `@option.
+	* invoke.texi: Ditto
+
+2001-11-14  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* Make-lang.in: Change all uses of $(manext) to $(man1ext).
+
+2001-11-14  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77.1: Remove from CVS.
+	* Make-lang.in: Build g77.1 in $(srcdir).
+	Add --section=1 to POD2MAN command line.
+	* invoke.texi: Correct copyright years.
+	Add more sections to man page.  Add GFDL.
+
+Fri Nov  9 23:16:45 2001  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (ffe_print_identifier): Rename.
+	(LANG_HOOKS_PRINT_IDENTIFIER): Override.
+	(lang_print_xnode, print_lang_decl, print_lang_statistics,
+	print_lang_type, set_yydebug): Remove.
+
+2001-11-09  Zack Weinberg  <zack@codesourcery.com>
+
+	* g77spec.c (lang_specific_driver): Adjust behavior of -v and
+	--version for consistency with other front ends.  Remove large
+	#if 0 block.  Do not add libraries to argv if there are no
+	input files.
+	(add_version_magic): Delete all references and dependent code.
+	* lang-options.h: Delete -fnull-version.
+	* lang-specs.h: Delete f77-version spec.
+
+	* lex.c: Delete logic conditional on ffe_is_null_version() and
+	now-unused label.
+	* top.c: Delete ffe_is_null_version_ variable.
+	(ffe_decode_option): Delete -fnull-version case.
+	* top.h: Delete declaration of ffe_is_null_version_ and
+	ffe_is_null_version(), ffe_set_is_null_version() macros.
+
+Fri Nov  9 07:14:47 2001  Neil Booth  <neil@daikokuya.demon.co.uk>
+
+	* com.c (language_string, lang_identify): Remove.
+	(struct lang_hooks): Constify.
+	(LANG_HOOKS_NAME): Override.
+	(init_parse): Update.
+
+2001-11-08  Andreas Franck  <afranck@gmx.de>
+
+	* Make-lang.in (G77_INSTALL_NAME, G77_CROSS_NAME): Handle
+	program_transform_name the way suggested by autoconf.
+
+2001-11-08  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* Make-lang.in: Add rules for building g77.1.
+	* invoke.texi: Add man page stuff.  Move indexing
+	from g77.texi to here.
+	* g77.texi: Remove indexing specific to invoke.texi.
+	* news.texi: Document that g77.1 is now a generated
+	file.
+
+Tue Nov  6 21:17:47 2001  Neil Booth  <neil@cat.daikokuya.demon.co.uk>
+
+	* com.c: Include langhooks-def.h.
+	* Make-lang.in: Update.
+
+2001-11-04  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77.texi: Split off invoke.texi (preliminary to using it
+	to generate a man page).
+	* Make-lang.in: Reflect in build rules.
+
+Fri Nov  2 10:51:34 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (ffecom_initialize_char_syntax_, U_CHAR, is_idchar,
+	is_idstart, is_hor_space, is_space, SKIP_WHITE_SPACE,
+	SKIP_ALL_WHITE_SPACE): Delete.
+	(read_filename_string, read_name_map): Don't use is_space or
+	is_hor_space.
+
+2001-10-29  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Document new ability to compile programs with
+	arrays larger than 512 Mbyte on 32-bit targets.
+
+2001-10-24  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffecom_check_size_overflow_): Only check for TREE_OVERFLOW.
+
+Tue Oct 23 14:01:27 2001  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (LANG_HOOKS_GET_ALIAS_SET): New macro.
+	(lang_get_alias_set): Delete.
+
+2001-10-23  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77.texi (Sending Patches): Remove.
+
+2001-10-22  Zack Weinberg  <zack@codesourcery.com>
+
+	* Make-lang.in (f/intdoc): Depend on safe-ctype.o.
+
+Sun Oct 21 17:28:17 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bad.c (ffebad_finish): Use safe-ctype macros and/or fold extra
+	calls into fewer ones.
+	* implic.c (ffeimplic_lookup_): Likewise.
+	* intdoc.c (dumpimp): Likewise.
+	* intrin.c (ffeintrin_init_0): Likewise.
+	* lex.c (ffelex_backslash_, ffelex_cfebackslash_, ffelex_hash_):
+	Likewise.
+	* lex.h (ffelex_is_firstnamechar): Likewise.
+	* target.c (ffetarget_integerhex): Likewise.
+
+2001-10-21  Craig Prescott  <prescott@phys.ufl.edu>
+
+	* target.h (FFETARGET_32bit_longs): Don't define
+	for 64-bit hppa.
+
+2001-10-17  Richard Henderson  <rth@redhat.com>
+
+	* std.c (ffestd_labeldef_format): Fix variable/stmt ordering.
+	(ffestd_R737A): Likewise.
+
+2001-10-17  Richard Henderson  <rth@redhat.com>
+
+	* com.h: Remove FFECOM_targetCURRENT, FFECOM_ONEPASS, BUILT_FOR_270,
+	BUILT_FOR_280, FFECOM_GCC_INCLUDE, all derivitive defines, and all
+	related conditional compilation directives.
+	* bad.c, bld.c, bld.h, com.c, equiv.c, equiv.h, global.h, intdoc.c,
+	intrin.c, intrin.h, lex.c, parse.c, sta.c, std.c, ste.c, ste.h, stt.c,
+	stt.h, stw.h, symbol.c, symbol.h, target.h, top.c: Likewise.
+
+2001-10-17  Richard Henderson  <rth@redhat.com>
+
+	* Make-lang.in (f/com.o): Depend on langhooks.h.
+	* com.c: Include it.
+	(LANG_HOOKS_INIT, LANG_HOOKS_FINISH): New.
+	(LANG_HOOKS_INIT_OPTIONS, LANG_HOOKS_DECODE_OPTION): New.
+	(lang_hooks): Use LANG_HOOKS_INITIALIZER.
+
+Sun Oct  7 12:27:54 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bad.c (_ffebad_message_, ffebad_messages_): Const-ify.
+	* bld.c (ffebld_arity_op_): Likewise.
+	* bld.h (ffebld_arity_op_): Likewise.
+	* com.c (ffecom_init_0): Likewise.
+	* intdoc.c (_ffeintrin_name_, _ffeintrin_gen_, _ffeintrin_spec_,
+	_ffeintrin_imp_, names, gens, imps, specs, cc_pair,
+	cc_descriptions, cc_summaries): Likewise.
+	* intrin.c (_ffeintrin_name_, _ffeintrin_gen_, _ffeintrin_spec_,
+	_ffeintrin_imp_, ffeintrin_names_, ffeintrin_gens_,
+	ffeintrin_imps_, ffeintrin_specs_): Likewise.
+
+2001-10-05  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Document libf2c being built as a shared library.
+	Use of array elements in bounds of adjustable arrays ditto.
+
+2001-10-03  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* Make-lang.in: Remove reference to FORTRAN_INIT.
+	* g77spec.c: Add reference to FORTRAN_INIT.
+
+2001-09-29  Juergen Pfeifer  <juergen.pfeifer@gmx.net>
+
+	Make libf2c a shared library.
+
+	* Make-lang.in: Pass define of frtbegin.o to compilation of g77spec.c.
+	* g77spec.c (lang_specific_driver): Treat linking in of frtbegin.o.
+
+2001-09-28  Robert Anderson  <rwa@alumni.princeton.edu>
+
+	* expr.c (ffeexpr_sym_rhs_dimlist_): Allow array elements
+	as bounds of adjustable arrays.
+
+Thu Sep 20 15:05:20 JST 2001  George Helffrich  <george@geo.titech.ac.jp>
+
+	* com.c (ffecom_subscript_check_): Loosen subscript checking rules
+	for character strings, to permit substring expressions like
+	string(1:0).
+	* news.texi: Document this as a new feature.
+
+Thu Sep 13 10:33:27 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bad.c (ffebad_finish): Const-ification and/or static-ization.
+	* intrin.c (ffeintrin_cmp_name_): Likewise.
+	* stc.c (ffestc_R904): Likewise.
+
+Wed Sep 12 12:09:04 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bld.c (ffebld_op_string_): Const-ification.
+	* com.c (ffecom_gfrt_name_, ffecom_gfrt_argstring_): Likewise.
+	* fini.c (xspaces): Likewise.
+	* global.c (ffeglobal_type_string_): Likewise.
+	* info.c (ffeinfo_basictype_string_, ffeinfo_kind_message_,
+	ffeinfo_kind_string_, ffeinfo_kindtype_string_,
+	ffeinfo_where_string_): Likewise.
+	* lex.c (ffelex_type_string_): Likewise.
+	* malloc.c (malloc_types_): Likewise.
+	* stc.c (ffestc_subr_binsrch_, ffestc_R904, ffestc_R904,
+	ffestc_R907): Likewise.
+	* symbol.c (ffesymbol_state_name_, ffesymbol_attr_name_):
+	Likewise.
+	* version.c (ffe_version_string): Likewise.
+	* version.h (ffe_version_string): Likewise.
+
+2001-09-11  Richard Henderson  <rth@redhat.com>
+
+	* parse.c (finput): Mark extern.
+
+2001-09-11  Jakub Jelinek  <jakub@redhat.com>
+
+	* com.c (ffe_init_options): Default to -fmerge-all-constants
+	if optimizing.
+
+2000-08-14  Ulrich Weigand  <uweigand@de.ibm.com>
+
+	* target.h (FFETARGET_32bit_longs): Don't define
+	for 64-bit S/390.
+
+2001-07-20  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffecom_expr_intrinsic_):
+	case FFEINTRIN_impIBITS: Remove TREE_SHIFT_FULLWIDTH define.
+	case FFEINTRIN_impISHFT: Ditto. Change LT_EXPR to NE_EXPR.
+	case FFEINTRIN_impISHFTC: Ditto.
+	case FFEINTRIN_impMVBITS: Ditto.
+
+2001-07-19  Jakub Jelinek  <jakub@redhat.com>
+
+	* top.c (ffe_decode_option): Disallow lang-independent processing
+	for -ffixed-form.
+
+2001-07-19  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* f/com.c (ffecom_expr_intrinsic_): Deal (correctly) with
+	{L|R}SHIFT_EXPR not working when shift > size of type.
+
+2001-07-17  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (lang_print_error_function): Argument context
+	is unused.
+
+2001-07-14  Tim Josling  <tej@melbpc.org.au>
+
+	* com.c (ffecom_overlap_): Remove references to EXPON_EXPR.
+	(ffecom_tree_canonize_ref_): Likewise.
+
+2001-07-10  James Smaby  <jsmaby@virgo.umeche.maine.edu>
+
+	* intdoc.in: Fix the definition of COMPLEX ABS.
+	Remove `the' where inappropriate.
+	* intdoc.texi: Rebuilt.
+
+2001-07-04  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77.texi: Use gpl.texi and funding.texi.  Remove Look and Feel
+	section.  Add Funding Free Software to invariant sections.
+	* Make-lang.in ($(srcdir)/f/g77.info, f/g77.dvi): Update
+	dependencies and use doc/include in search path.
+
+2001-06-28  Gabriel Dos Reis  <gdr@codesourcery.com>
+
+	* Make-lang.in (f/com.o): Depend on diagnostic.h
+	* com.c: #include diagnostic.h
+	(lang_print_error_function): Take a 'diagnostic_context *'.
+
+Wed Jun 13 11:22:39 2001  Mark Mitchell  <mark@codesourcery.com>
+
+	* BUGS: Remove.
+	* NEWS: Likewise.
+
+2001-06-10  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77install.texi: Remove.
+	* Make-lang.in: Remove all mention of g77install.texi.
+	* g77.texi: Add documentation on how to get output always
+	flushed and how to increase the maximum unit number.
+	Remove all mention of g77install.texi.
+	* bugs.texi: Add documentation on how to change the threshold
+	for putting local arrays on the stack.
+
+2001-06-03  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* root.texi: Fix typo in patches e-mail address.
+
+2001-06-03  Toon Moene  <toon@moene.indiv.nluug.nl>
+	    Jan van Male  <jan.vanmale@fenk.wau.nl>
+
+	* root.texi: Define `help' and `patches' mailing list
+	addresses.
+	* news.texi: Remove `prerelease' from 0.5.26
+	* g77.texi: Use two spaces between command options, eliminate
+	some 'overfull hboxes'.  Use help and patches mailing list
+	addresses where appropriate.
+
+2001-06-02  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77.texi: Move contents to just after title page.
+
+2001-06-02  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffecom_init_0): Make CHARACTER*1 unsigned.
+
+2001-05-23  Theodore Papadopoulo  <Theodore.Papadopoulo@sophia.inria.fr>
+
+	* Make-lang.in ($(srcdir)/f/g77.info): Added dependencies on
+	fdl.texi.
+	(f/g77.dvi): Use TEXI2DVI instead of custom tex calls.  Create the
+	dvi file in the f directory.
+
+2001-05-25  Sam TH  <sam@uchicago.edu>
+
+	* bad.h: Fix header include guards.
+	* bit.h bld.h com.h data.h equiv.h expr.h global.h
+	implic.h info.h intrin.h lab.h lex.h malloc.h name.h
+	proj.h src.h st.h sta.h stb.h stc.h std.h ste.h
+	storag.h stp.h str.h sts.h stt.h stu.h stv.h stw.h
+	symbol.h target.h top.h type.h version.h
+	where.h: Likewise.
+
+2001-05-22  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77.texi: Update last-changed date.
+	* news.texi: Update copyright years, last-changed date.
+	* bugs.texi: Update copyright years, last-changed date.
+
+2001-05-22  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77.texi: Update maintenance information for
+	GNU Fortran.  Remove all mention of -fdebug-kludge.
+	* news.texi: Make more news in 0.5.26 `user visible
+	changes'. Acknowledge work by important contributors.
+	* bugs.texi: Remove all mention of -fdebug-kludge.
+
+2001-05-20  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* Make-lang.in (f/g77.dvi): Include $(srcdir) in TEXINPUTS.
+
+2001-05-19  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* Make-lang.in: Have $(MAKEINFO) look into the parent
+	directory for includes.
+	* g77.texi: Use the GFDL.
+
+Sun May 13 12:25:06 2001  Mark Mitchell  <mark@codesourcery.com>
+
+	* Make-lang.in: Replace all uses of `touch' with $(STAMP).
+
+Wed May  2 10:20:08 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c: NULL_PTR -> NULL.
+
+Sun Apr 22 20:18:01 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (ffecom_subscript_check_): Use concat in lieu of
+	xmalloc/sprintf.
+
+2001-04-21  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* news.texi: Update release information for 0.5.27.
+
+Thu Apr 19 12:49:24 2001  Mark Mitchell  <mark@codesourcery.com>
+
+	* top.c (ffe_decode_option): Do not permit language-independent
+	processing for -ffixed-line-length.
+
+Thu Apr 12 17:57:55 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bad.c (inhibit_warnings): Delete redundant declaration.
+
+	* com.c (skip_redundant_dir_prefix): Likewise.
+
+	* com.h (mark_addressable): Likewise.
+
+2001-04-02  Jakub Jelinek  <jakub@redhat.com>
+
+	* lex.c (ffelex_hash_): Avoid eating one whole line after
+	#line.
+
+Mon Apr  2 22:38:09 2001  Toon Moene <toon@moene.indiv.nluug.nl>
+
+	* com.c (duplicate_decls): Fix thinko in lazy DECL_RTL patch
+	of 2001-03-04.
+
+Tue Mar 27 17:40:08 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in: Depend on $(SYSTEM_H), not system.h.
+
+Mon Mar 26 18:13:30 2001  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (duplicate_decls): Don't copy DECL_FRAME_SIZE.
+
+Mon Mar 19 15:05:39 2001  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (builtin_function): Use SET_DECL_ASSEMBLER_NAME.
+
+Wed Mar 14 09:29:27 2001  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (ffecom_member_phase_2): Use COPY_DECL_RTL,
+	DECL_RTL_SET_P, etc.
+	(duplicate_decls): Likewise.
+	(start_decl): Likewise.
+
+Fri Mar  9 22:52:55 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* fini.c (main): Use really_call_malloc, not malloc.
+
+Thu Mar  8 13:27:47 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c: Don't rely on the POSIX macro to define autoconf stuff.
+
+2001-03-07  Brad Lucier  <lucier@math.purdue.edu>
+
+	* g77.texi: Document new options -funsafe-math-optimizations
+	and -fno-trapping-math.  Revise documentation for -ffast-math.
+
+2001-03-01  Zack Weinberg  <zackw@stanford.edu>
+
+	* proj.h: Delete 'bool' type.  Don't include stddef.h here.
+	* com.c: Rename variables named 'true' and/or 'false'.
+	* intdoc.c: Delete 'bool' type.
+
+2001-03-01  Zack Weinberg  <zackw@stanford.edu>
+
+	* lang-specs.h: Add zero initializer for cpp_spec field to all
+	array elements.
+
+2001-02-24  Zack Weinberg  <zackw@stanford.edu>
+
+	* com.c: Don't define STDC_HEADERS, autoconf handles it.
+
+Fri Feb 23 15:28:39 2001  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (set_block): Set NAMES and BLOCKS from BLOCK.
+
+2001-02-19  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* version.c, root.texi: Update GCC version number to 3.1.  Update
+	G77 version number to 0.5.27.
+	* BUGS, NEWS: Regenerate.
+
+Sun Feb  4 15:52:44 2001  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (ffecom_init_0): Call fatal_error instead of fatal.
+	* com.c (init_parse): Call fatal_io_error instead of
+	pfatal_with_name.
+	(ffecom_decode_include_option_): Make errors non-fatal.
+	* lex.c (ffelex_cfelex_, ffelex_get_directive_line_): Likewise.
+	(ffelex_hash_): Likewise.
+
+Sat Jan 27 20:52:18 2001  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in: Remove all dependencies on defaults.h.
+	* com.c: Don't include defaults.h.
+
+2001-01-23  Michael Sokolov  <msokolov@ivan.Harhan.ORG>
+
+	* com.c: Don't explicitly include any time headers, the right ones are
+	already included by proj.h.
+
+2001-01-15  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (ffecom_lookup_label): Set DECL_CONTEXT for FORMAT
+	label to current_function_decl.
+
+Fri Jan 12 17:21:33 2001  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77spec.c (lang_specific_driver): Update copyright year to 2001.
+
+Wed Jan 10 14:39:45 2001  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (ffecom_init_zero_):  Remove last argument in call to
+	make_decl_rtl; use make_function_rtl instead of make_decl_rtl.
+	(ffecom_lookup_label_): Likewise.
+	(builtin_function): Likewise.
+	(start_function): Likewise.
+
+Thu Dec 21 21:19:42 2000  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77install.texi, g77.texi: Update last-updated dates for
+	installation information and the manual as a whole.
+	* bugs.texi, news.texi: Update copyright years in the comments at
+	the top of the file.
+
+2000-12-21  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77install.texi: Adjust wording of an EGCS reference.
+
+Thu Dec 21 20:00:48 2000  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* BUGS, NEWS: Regenerate.
+
+2000-12-18  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* com.c [VMS]: Remove definition of BSTRING.
+
+2000-12-18  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77.texi: Update GPL copy not to refer to years 19@var{yy}.
+
+2000-12-18  Toon Moene <toon@moene.indiv.nluug.nl>
+
+	* bugs.texi: Correct copyright years.
+	* g77.texi: Likewise.
+	* news.texi: Likewise.
+
+2000-12-18  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77install.texi: Remove obsolete parts only used for INSTALL,
+	and DOC-G77 conditionals.  Update last-update-install date.
+
+Sat Dec  9 10:20:11 2000  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* .cvsignore: New file; add info files.
+
+2000-12-08  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* Make-lang.in (f77.info): Depend on info files in source
+	directory.
+	(f/g77.info): Build info files in source directory; don't build
+	them unless BUILD_INFO is "info".
+	(f77.install-info): Install info files from source directory.
+
+2000-12-07  Zack Weinberg  <zack@wolery.stanford.edu>
+
+	* Make-lang.in: Link f/fini with safe-ctype.o.
+	* bad.c: Don't test ISUPPER(c) || ISLOWER(c) before calling TOUPPER(c).
+	* com.c: Use TOUPPER, not ffesrc_toupper.
+	* fini.c: Don't test ISALPHA(c) before calling TOUPPER(c)/TOLOWER(c).
+	* intrin.c: Don't test IN_CTYPE_DOMAIN(c).
+	* src.c: Delete ffesrc_toupper_ and ffesrc_tolower_ and their
+	initializing code; use TOUPPER and TOLOWER instead of
+	ffesrc_toupper and ffesrc_tolower.
+	* src.h: Don't declare ffesrc_toupper_ or ffesrc_tolower_.
+	Don't define ffesrc_toupper or ffesrc_tolower.
+
+2000-11-28  Richard Henderson  <rth@redhat.com>
+
+	* com.c (ffecom_member_phase2_): Set TREE_USED on the debugging decl.
+
+2000-11-26  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* RELEASE-PREP: Remove obsolete EGCS reference.
+	* g77.texi: Adjust reference to EGCS as something current.
+	* lang-options.h (FTNOPT): Remove macro and obsolete comment.
+	Include doc strings directly in option listing instead of through
+	this macro.
+	* root.texi: Remove support for multiple different (FSF and EGCS)
+	distributions of g77.
+	* g77install.texi: Remove conditioned out instructions applying
+	only to obsolete distributions of g77 not as part of GCC.  Change
+	"superceded" to the correct spelling "superseded".
+
+Sun Nov 26 19:25:56 2000  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* g77spec.c (lang_specific_driver): Update copyright year to 2000.
+
+Thu Nov 23 02:18:57 2000  J"orn Rennecke <amylaar@redhat.com>
+
+	* Make-lang.in (g77spec.o): Depend on $(CONFIG_H).
+
+2000-11-21  David Billinghurst  <David.Billinghurst@riotinto.com)
+
+	* Make-lang.in:  Add $(build_exeext) to f/fini target
+
+2000-11-21  Andreas Jaeger  <aj@suse.de>
+
+	* g77.texi (Floating-point Exception Handling): Use feenableexcept
+	in example.
+	(Floating-point precision): Change to match above change.
+
+Sun Nov 19 17:29:22 2000  Matthias Klose  <doko@marvin.itso-berlin.de>
+
+	* g77.texi (Floating-point precision): Adjust example
+	to work with glibc (>= 2.1).
+
+Sat Nov 18 13:54:49 2000  Matthias Klose  <doko@cs.tu-berlin.de>
+
+	* g77.texi (Floating-point Exception Handling): Adjust
+	example to work with glibc (>= 2.1).
+
+2000-11-18  Alexandre Oliva  <aoliva@redhat.com>
+
+	* Make-lang.in (INTDOC_DEPS): New macro.
+	(f/intdoc.texi): Depend on $(INTDOC_DEPS).  Build f/intdoc.
+	(f/intdoc): Likewise.  Add $(build_exeext).
+
+2000-11-17  Zack Weinberg  <zack@wolery.stanford.edu>
+
+	* lex.c (ffelex_hash_): Change ggc_alloc_string (var, -1) to
+	ggc_strdup (var).
+
+Thu Nov 16 23:14:07 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* malloc.c (malloc_init): Call xmalloc, not malloc.
+
+2000-11-10  Rodney Brown  <RodneyBrown@mynd.com>
+
+	* Make-lang.in: Remove OUTPUT_OPTION from g77version.o target.
+
+2000-11-10  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* root.texi: Remove non-historical EGCS reference.
+	Set current g77 version to 0.5.26.
+
+2000-11-10  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffecom_stabilize_aggregate_) case RTL_EXPR: Abort.
+
+2000-11-10  Zack Weinberg  <zack@wolery.stanford.edu>
+
+	* Make-lang.in (f/fini.o, f/proj-h.o): Remove pointless sed
+	munging of source file name.
+	($(srcdir)/f/intdoc.texi): Break up into several rules each of
+	which builds just one thing.  Don't mess with $(LANGUAGES).
+	(f/ansify.o, f/intdoc.o): Remove unnecessary rules.
+
+2000-11-05  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* root.texi, news.texi, g77install.texi, g77.texi, bugs.texi:
+	Remove non-historical references to egcs/EGCS.
+
+2000-11-05  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* Make-lang.in: Remove f77.distdir and f/INSTALL.
+	* INSTALL, install0.texi: Remove.
+
+2000-11-02  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* com.c (open_include_file, ffecom_open_include_): Use strchr ()
+	and strrchr () instead of index () and rindex ().
+
+2000-10-27  Zack Weinberg  <zack@wolery.stanford.edu>
+
+	* Make-lang.in: Move all build rules here from Makefile.in,
+	adapt to new context.  Wrap all rules that change the current
+	directory in parentheses.  Expunge all references to $(P).
+	When one command depends on another and they're run all at
+	once, use && to separate them, not ;.  Add OUTPUT_OPTION to
+	all object-file generation rules.  Delete obsolete variables.
+
+	* Makefile.in: Delete.
+	* config-lang.in: Delete outputs= line.
+
+Sat Oct 21 18:07:48 2000  Joseph S. Myers  <jsm28@cam.ac.uk>
+
+	* Makefile.in, g77spec.c: Remove EGCS references in comments.
+
+Thu Oct 12 22:28:51 2000  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (ffecom_do_entry_): Don't mess with obstacks.
+	(ffecom_finish_global_): Likewise.
+	(ffecom_finish_symbol_transform_): Likewise.
+	(ffecom_gen_sfuncdef_): Likewise.
+	(ffecom_init_zero_): Likewise.
+	(ffecom_start_progunit_): Likewise.
+	(ffecom_sym_transform_): Likewise.
+	(ffecom_sym_transform_assign_): Likewise.
+	(ffecom_transform_equiv_): Likewise.
+	(ffecom_transform_namelist_): Likewise.
+	(ffecom_vardesc_): Likewise.
+	(ffecom_vardesc_array_): Likewise.
+	(ffecom_vardesc_dims_): Likewise.
+	(ffecom_end_transition): Likewise.
+	(ffecom_make_tempvar): Likewise.
+	(bison_rule_pushlevel_): Likewise.
+	(bison_rule_compstmt_): Likewise.
+	(finish_decl): Likewise.
+	(finish_function): Likewise.
+	(push_parm_decl): Likewise.
+	(start_decl): Likewise.
+	(start_function): Likewise.
+	(ggc_p): Don't define.
+	* std.c (ffestd_stmt_pass_): Likewise.
+	* ste.c (ffeste_end_block_): Likewise.
+	(ffeste_end_stmt_): Likewise.
+	(ffeste_begin_iterdo_): Likewise.
+	(ffeste_io_ialist_): Likewise.
+	(ffeste_io_cilist_): Likewise.
+	(ffeste_io_inlist_): Likewise.
+	(ffeste_io_olist_): Likewise.
+	(ffeste_R810): Likewise.
+	(ffeste_R838): Likewise.
+	(ffeste_R839): Likewise.
+	(ffeste_R842): Likewise.
+	(ffeste_R843): Likewise.
+	(ffeste_R1001): Likewise.
+
+2000-10-05  Richard Henderson  <rth@cygnus.com>
+
+	* com.c (finish_function): Don't init can_reach_end.
+
+Sun Oct  1 11:43:44 2000  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (lang_mark_false_label_stack): Remove.
+
+2000-09-10  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* com.c: Include defaults.h.
+	* com.h: Don't define the *_TYPE_SIZE macros.
+	* Makefile.in: Update dependencies.
+
+2000-08-29  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* ansify.c: Use #line, not # <number>.
+
+2000-08-24  Greg McGary  <greg@mcgary.org>
+
+	* intdoc.c (ARRAY_SIZE): Remove macro.
+	* proj.h (ARRAY_SIZE): Remove macro.
+	* com.c (init_decl_processing): Use ARRAY_SIZE.
+
+2000-08-22  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com-rt.def: Adapt macro DEFGFRT to accept CONST boolean.
+	* com.c (macro DEFGFRT): Use CONST boolean.
+	(ffecom_call_binop_): Choose between call by value
+	and call by reference.
+	(ffecom_expr_): Use direct calls to (g)libc functions for
+	POW_DD, LOG10, (float) MOD.
+	(ffecom_make_gfrt_): Add const indication to table of
+	intrinsics.
+	* com.h (macro DEFGFRT): Use CONST boolean.
+	* intrin.def: Adjust DEFIMP definition of LOG10, (float) MOD.
+
+2000-08-21  Nix  <nix@esperi.demon.co.uk>
+
+	* lang-specs.h: Do not process -o or run the assembler if
+	-fsyntax-only.  Use %j instead of /dev/null.
+
+2000-08-21  Jakub Jelinek  <jakub@redhat.com>
+
+	* lang-specs.h: Pass -I* options to f771.
+
+2000-08-19  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* top.c (ffe_decode_option): Disable -fdebug-kludge
+	and warn about it.
+	* lang-options.h: Document the fact.
+	* g77.texi: Ditto.
+
+2000-08-13  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* bugs.texi: Describe new ability to emit debug info
+	for EQUIVALENCE members.
+	* news.texi: Ditto.
+
+2000-08-11  G. Helffrich  <george@gly.bris.ac.uk>
+	    Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffecom_transform_equiv_): Make EQUIVALENCEs addressable
+	so that debug info can be attached to their storage.
+	Unconditionally list the storage set aside for them.
+
+2000-08-07  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77spec.c (lang_specific_driver): Clearer g77 version message.
+
+2000-08-04  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* Make-lang.in (f771): Depend on $(BACKEND), not stamp-objlist.
+	* Makefile.in: Add BACKEND; delete OBJS, OBJDEPS.
+	(f771): Link with $(BACKEND).
+
+2000-08-02  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* g77spec.c: Adjust type of second argument to
+	lang_specific_driver, and update code as necessary.
+
+	* expr.c (ffeexpr_finished_): Cast signed side of ?:
+	expression to bool.
+
+2000-07-31  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* lang-specs.h: Rename cpp to cpp0 and/or tradcpp to tradcpp0.
+
+Thu Jul 27 11:50:08 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* fini.c (main): Avoid automatic aggregate initialization.
+
+	* proj.h: Indent #error directive.
+
+2000-07-26  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* lang-specs.h: Remove one /dev/null from tradcpp invocation.
+
+Sun Jul 23 15:47:30 2000  Billinghurst, David <David.Billinghurst@riotinto.com>
+
+	* Make-lang.in: Put $(build_exeext) suffix on programs which run
+	on the build machine.
+
+2000-07-22  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com.c (ffecom_expr_intrinsic_): case FFEINTRIN_impFGETC_subr,
+	FFEINTRIN_impFPUTC_subr: Check for arg3 being NULL.
+
+2000-07-13  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* lang-specs.h: Use the new named specs.  Remove unnecessary braces.
+
+2000-07-02  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* version.c: Bump version number.
+
+2000-06-21  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* Make-lang.in (F77_SRCS): Remove all .j files.
+	* Makefile.in (ASSERT_H, CONFIG_H, CONVERT_H, FLAGS_H, GGC_H,
+	GLIMITS_H, HCONFIG_H, INPUT_H, OUTPUT_H, RTL_H, SYSTEM_H,
+	TOPLEV_H, TREE_H): Remove references to .j files.
+	(TCONFIG_H, TM_H): Remove entirely.
+	(deps-kinda): Delete rule.
+	Correct commentary.
+
+	* assert.j, config.j, convert.j. flags.j, ggc.j, glimits.j,
+	hconfig.j, input.j, output.j, rtl.j, system.j, toplev.j,
+	tree.j, tconfig.j, tree.j: Delete.
+
+	* ansify.c, bad.c, bit.c, com.c, com.h, intdoc.c, lex.c,
+	parse.c, proj.c, proj.h, ste.c, target.c, target.h, top.c,
+	where.c, where.h: Include parent-directory headers directly.
+	* lex.c: Don't include tree.h twice.
+
+2000-05-17  H.J. Lu  (hjl@gnu.org)
+
+	* Make-lang.in: Use a unique stamp for each target to support
+	parallel make.
+
+Thu Jun 15 14:03:14 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* ste.c (gbe_block): Constify.
+
+2000-06-13  Jakub Jelinek  <jakub@redhat.com>
+
+	* com.c (ffecom_transform_common_): Set DECL_USER_ALIGN.
+	(ffecom_transform_equiv_, ffecom_decl_field): Likewise.
+	(ffecom_init_0): Set DECL_USER_ALIGN resp. TYPE_USER_ALIGN.
+	(duplicate_decls): Set DECL_USER_ALIGN.
+
+Sun Jun 11 00:03:00 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (lang_get_alias_set): Mark parameter with ATTRIBUTE_UNUSED.
+
+2000-06-04  Philipp Thomas  <pthomas@suse.de>
+
+	* Makefile.in(INTLLIBS): New macro.
+	(LIBS): Add INTLLIBS.
+	(DEPLIBS): Likewise.
+
+2000-06-02  Richard Henderson  <rth@cygnus.com>
+
+	* com.c (lang_get_alias_set): New.
+
+2000-05-28  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* bugs.texi: Note that debugging information for
+	common block items is emitted now.
+	* news.texi: Ditto.
+
+2000-05-18  Chris Demetriou  <cgd@sibyte.com>
+
+	* com.h (FFECOM_f2cINTEGER, FFECOM_f2cLONGINT): Note that
+	these types correspond to built-in types now defined in
+	the C front end (for libf2c).
+
+Wed May 17 17:27:44 2000  Andrew Cagney  <cagney@b1.cygnus.com>
+
+	* top.c (ffe_decode_option): Update -Wall unused flags by calling
+	set_Wunused.
+
+2000-05-09  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* com.c (ffecom_subscript_check_): Constify array_name
+	parameter. Clean up string bashing.
+	(ffecom_arrayref_, ffecom_char_args_x_): Constify array_name
+	parameter.
+	(ffecom_do_entry_, ffecom_gen_sfuncdef_, ffecom_start_progunit_,
+	ffecom_sym_transform_, ffecom_sym_transform_assign_): Constify
+	local char *.
+	(init_parse): Constify parameter and return value.
+	* lex.c: Include dwarfout.h instead of prototyping dwarfout_*
+	functions here.
+	(ffelex_file_pop_, ffelex_file_push_): Constify filename parameter.
+	(ffelex_hash_, ffelex_include_): Constify local char *.
+	* std.c (ffestd_exec_end): Constify local char *.
+	* where.c (ffewhere_file_new): Constify filename parameter.
+	* where.h: Update prototypes.
+
+2000-05-06  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* com.c (ffecom_overlap_): Set source_offset to
+	bitsize_zero_node.
+	(ffecom_tree_canonize_ptr_): Use size_binop.  Convert to
+	bitsizetype before multiplying by TYPE_SIZE.
+	(ffecom_tree_canonize_ref_) [case ARRAY_REF]: Break up offset
+	calculation.  Convert to bitsizetype before multiplying by
+	TYPE_SIZE.
+
+2000-04-18  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* lex.c: Remove references to cccp.c.
+	* g77install.texi: Remove references to cexp.c/cexp.y.
+
+2000-04-15  David Edelsohn  <edelsohn@gnu.org>
+
+	* target.h (FFETARGET_32bit_longs): Define for 64-bit PowerPC
+	as well.
+
+Wed Apr 12 15:15:26 2000  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.h (FFECOM_f2cINTEGER): Avoid using LONG_TYPE_SIZE as a
+	preprocessor constant.
+	(FFECOM_f2cLOGICAL): Likewise.
+	(FFECOM_f2cLONGINT): Likewise.
+
+Wed Apr  5 17:46:39 2000  Mark Mitchell  <mark@codesourcery.com>
+
+	* Makefile.in (GGC_H): Add varray.h.
+
+2000-04-03  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* lang-specs.h: Pass -fno-show-column to the preprocessor.
+
+2000-03-28  Franz Sirl  <Franz.Sirl-kernel@lauterbach.com>
+
+	* com.c (ffecom_decl_field): Use DECL_ALIGN for a FIELD_DECL.
+	(ffecom_init_0): Likewise.
+
+Sat Mar 25 09:12:10 2000  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (ffecom_tree_canonize_ptr_): Use bitsize_zero_node.
+	(ffecom_tree_canonize_ref_): Likewise.
+
+Mon Mar 20 15:49:40 2000  Jim Wilson  <wilson@cygnus.com>
+
+	* f/target.h (FFETARGET_32bit_longs): New.  Define for alpha, sparc64,
+	and ia64.
+	(ffetargetInteger1, ffetargetLogical1, ffetargetReal1, ffetargetReal2,
+	ffetarget_integerdefault_is_magical): Use FFETARGET_32bit_longs.
+
+Fri Mar 10 00:43:55 2000  Jason Merrill  <jason@casey.cygnus.com>
+
+	* com.c (ffecom_stabilize_aggregate_): Don't refer to TREE_RAISES.
+
+Mon Mar  6 18:05:19 2000  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (ffecom_f2c_set_lio_code_): Use compare_tree_int.
+	(ffecom_sym_transform_, ffecom_transform_common_): Likewise.
+	(ffecom_transform_equiv_): Likewise.
+
+Mon Mar  6 13:01:19 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* ansify.c (die_unless): Don't use ANSI string concatenation.
+	(die): Mark with ATTRIBUTE_NORETURN.
+
+Wed Mar  1 00:31:44 2000  Martin von Loewis  <loewis@informatik.hu-berlin.de>
+
+	* com.c (current_function_decl): Move to toplev.c.
+
+Sun Feb 27 16:40:33 2000  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (ffecom_arrayref_): Convert args to size_binop to proper type.
+	(ffecom_tree_canonize_ptr_): Don't use size_binop for non-sizes.
+	(ffecom_tree_canonize_ref_): Likewise.
+	(type_for_mode): Handle TImode.
+	* ste.c (ffeste_io_dofio_, ffeste_io_douio_): Use TYPE_SIZE_UNIT.
+	(ffeste_io_ciclist_): Likewise.
+
+2000-02-23  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* com.c (ffecom_type_permanent_copy_): Delete unused function.
+	(finish_decl): Don't change TREE_PERMANENT (DECL_INITIAL (decl)).
+
+Sat Feb 19 18:43:13 2000  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* com.c (ffecom_sym_transform): Use DECL_SIZE_UNIT.
+	(ffecom_transform_common_, ffecom_transform_equiv_): Likewise.
+	(duplicate_decls): Likewise.
+	(ffecom_tree_canonize_ptr_): Delete extra arg to bitsize_int.
+	(finish_decl): Delete -Wlarger-than processing.
+
+Fri Feb 18 13:19:34 2000  Martin von Loewis  <loewis@informatik.hu-berlin.de>
+
+	* g77spec.c (lang_specific_driver): Use GCCBUGURL.
+
+2000-02-17  Andy Vaught  <andy@maxwell.la.asu.edu>
+
+	* com.c (ffecom_member_phase2_): Re-enable COMMON debug code.
+	(ffecom_finish_symbol_transform_): Likewise.
+	(ffecom_transform_common_): Call ffestorag_set_hook.
+
+Wed Feb 16 11:09:38 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in (g77spec.o): Depend on $(GCC_H), not gcc.h.
+
+2000-02-15  Jonathan Larmour  <jlarmour@redhat.co.uk>
+
+	* lang-specs.h: Add new __GNUC_PATCHLEVEL__ define to default spec.
+
+Tue Feb 15 11:14:17 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* g77spec.c: Don't declare `version_string'.
+
+Sat Feb  5 23:27:25 2000  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (mark_tracker_head, mark_binding_level): Protoize.
+
+	* where.c (mark_ffewhere_head): Likewise.
+
+Wed Jan 12 09:32:59 2000  Zack Weinberg  <zack@wolery.cumb.org>
+
+	* lang-specs.h: Pass -lang-fortran to preprocessor.
+
+Thu Dec 30 13:14:31 1999  Richard Henderson  <rth@cygnus.com>
+
+	* stw.h (struct _ffestw_): Change type of uses_ to int.
+
+Thu Dec 30 11:42:05 1999  Geoff Keating  <geoffk@cygnus.com>
+
+	* com.c (ffecom_init_0): Make double_ftype_double,
+	float_ftype_float, ldouble_ftype_ldouble,
+	ffecom_tree_ptr_to_fun_type_void local.
+	(tracker_head): New static variable.
+	(mark_tracker_head): New, marker procedure for tracker_head.
+	(ffecom_save_tree_forever): New procedure.
+	(ffecom_init_zero_): Remove obstack use.
+	(ffecom_make_gfrt_): Remove obstack use.
+	(ffecom_sym_transform_): Remove obstack use, save appropriate trees.
+	(ffecom_transform_common_): Remove obstack use, save appropriate
+	trees.
+	(ffecom_type_namelist_): Remove obstack use, save appropriate
+	trees.
+	(ffecom_type_vardesc_): Remove obstack use, save appropriate trees.
+	(ffecom_lookup_label): Remove obstack use, save appropriate trees.
+	(duplicate_decls): Remove obstack use.
+	(finish_function): push & pop ggc context around
+	rest_of_compilation when building nested function.
+	(mark_binding_level): New function.
+	(init_decl_processing): Mark all the GC roots.
+	(ggc_p): Set to 1.
+	(lang_mark_tree): New function.
+	(lang_mark_false_label_stack): New trivial function.
+	* com.h (ffecom_save_tree_forever): Declare as external.
+	* lex.c (ffelex_hash_): Use GC to allocate the filename string
+	even when ffelex_kludge_flag_.
+	* ste.c (ffeste_io_ialist_): Register a static root.
+	(ffeste_io_inlist_): Likewise.
+	(ffeste_io_icilist_): Likewise.
+	(ffeste_io_cllist_): Likewise.
+	(ffeste_io_cilist_): Likewise.
+	(ffeste_io_olist_): Likewise.
+	* Makefile.in (OBJS): Don't use ggc-callbacks.o.
+	(OBJDEPS): Likewise.
+	(GGC_H): New variable.
+	Update dependencies.
+	* where.c (ffewhere_head): New global.
+	(mark_ffewhere_head): New marker procedure for ffewhere_head.
+	(ffewhere_file_kill): Use GC to do memory management.
+	(ffewhere_file_new): Use GC to do memory management.
+	* ggc.j: New file.
+
+Wed Dec 29 19:29:26 1999  Gerald Pfeifer  <pfeifer@dbai.tuwien.ac.at>
+
+	* g77.texi (C Interfacing Tools): Fix an incorrect link.
+
+1999-12-13  Jakub Jelinek  <jakub@redhat.com>
+
+	* target.h: Handle sparc64 the same way as alpha.
+
+Sun Nov 28 21:39:05 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (ffecom_file_, ffecom_file, file_buf,
+	ffecom_open_include_): Constify a char*.
+	(ffecom_possible_partial_overlap_): Mark parameter `expr2' with
+	ATTRIBUTE_UNUSED.
+	(ffecom_init_0): Use a fully prototyped cast in call to bsearch.
+	(lang_print_error_function): ANSI-fy.
+
+	* com.h (ffecom_file): Constify a char*.
+
+	* fini.c (main): Call return, not exit.
+
+	* g77spec.c (lang_specific_driver): Use non-const *in_argv in
+	assignment.
+
+	* intrin.c (ffeintrin_cmp_name_): Don't needlessly cast away
+	const-ness.
+
+Sun Nov 28 21:15:29 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (ffecom_get_invented_identifier): Rewrite to take an ellipses.
+
+	(ffecom_char_enhance_arg_, ffecom_do_entry_,
+	ffecom_f2c_make_type_, ffecom_gen_sfuncdef_,
+	ffecom_start_progunit_, ffecom_start_progunit_,
+	ffecom_start_progunit_, ffecom_sym_transform_assign_,
+	ffecom_transform_equiv_, ffecom_transform_namelist_,
+	ffecom_vardesc_, ffecom_vardesc_array_, ffecom_vardesc_dims_,
+	ffecom_end_transition, ffecom_lookup_label, ffecom_temp_label):
+	Adjust accordingly.
+
+	* com.h (ffecom_get_invented_identifier): Likewise.
+
+	* sts.c (ffests_printf): New function taking ellipses.
+	(ffests_printf_1D, ffests_printf_1U, ffests_printf_1s,
+	ffests_printf_2Us): Delete.
+
+	* sts.h: Likewise.
+
+	* std.c (ffestd_R1001dump_, ffestd_R1001dump_1005_1_,
+	ffestd_R1001dump_1005_2_, ffestd_R1001dump_1005_3_,
+	ffestd_R1001dump_1005_4_, ffestd_R1001dump_1005_5_,
+	ffestd_R1001dump_1010_2_, ffestd_R1001dump_1010_3_,
+	ffestd_R1001dump_1010_4_, ffestd_R1001dump_1010_5_,
+	ffestd_R1001rtexpr_): Call `ffests_printf', not `ffests_printf_*'.
+
+	* ste.c (ffeste_io_ialist_, ffeste_io_cilist_, ffeste_io_cllist_,
+	ffeste_io_icilist_, ffeste_io_inlist_, ffeste_io_olist_): Likewise.
+
+Wed Nov 10 12:43:21 1999  Philippe De Muyter  <phdm@macqel.be>
+			  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* proj.h: Test `GCC_VERSION', not `HAVE_GCC_VERSION'.
+
+Tue Oct 26 01:32:19 1999  Mark Mitchell  <mark@codesourcery.com>
+
+	* com.c (poplevel): Don't call remember_end_note.
+
+Fri Oct 15 15:18:12 1999  Greg McGary  <gkm@gnu.org>
+
+	* top.h (ffe_is_subscript_check_): Remove extern decl.
+	(ffe_is_subscript_check, ffe_set_is_subscript_check): Remove macros.
+	* top.c (ffe_is_subscript_check_): Remove global variable.
+	(ffe_decode_option): Remove "(no-)bounds-check" flag handling.
+	Set flag_bounds_check for "(no-)fortran-bounds-check".
+	* com.c
+	(ffecom_arrayref_): s/ffe_is_subscript_check ()/flag_bounds_check/
+	(ffecom_char_args_x_): Ditto.
+
+Sun Oct 10 08:40:18 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* proj.h: Use HAVE_GCC_VERSION instead of explicitly testing
+	__GNUC__ and __GNUC_MINOR__.  Don't define BUILT_WITH_270.  Define
+	macro UNUSED in terms of ATTRIBUTE_UNUSED.
+
+Fri Sep 24 10:48:10 1999  Bernd Schmidt  <bernds@cygnus.co.uk>
+
+	* com.c (duplicate_decls): Use DECL_BUILT_IN_CLASS rather than
+	DECL_BUILT_IN.
+	(builtin_function): No longer static.  New arg CLASS.  Arg
+	FUNCTION_CODE now of type int.  All callers changed.
+	Set the builtin's DECL_BUILT_IN_CLASS.
+
+Tue Sep 21 09:08:30 1999  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g77spec.c (lang_specific_driver): Initialize return value.
+
+Thu Sep 16 18:07:11 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bad.c (ffebad_finish): Use uppercase ctype macro from system.h.
+
+	* fini.c (main): Likewise.
+
+	* intrin.c (ffeintrin_init_0): Likewise.
+
+	* lex.c (ffelex_hash_): Likewise.
+
+	* src.c (ffesrc_init_1): Likewise.
+
+Tue Sep 14 12:14:28 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* g77spec.c (lang_specific_driver): Remove unnecessary argument in
+	call to function `fatal'.
+
+Sun Sep 12 23:29:47 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in (g77spec.o): Depend on system.h and gcc.h.
+
+	* g77spec.c: Include gcc.h.
+	(g77_xargv): Constify.
+	(g77_fn): Add parameter prototypes.
+	(lookup_option, append_arg): Add static prototypes.
+	(g77_newargv): Constify.
+	(lookup_option, append_arg, lang_specific_driver): Constify a char*.
+	(lang_specific_driver): All calls to the function pointer
+	parameter now explicitly call `fatal'.
+
+Fri Sep 10 10:32:32 1999  Bernd Schmidt  <bernds@cygnus.co.uk>
+
+	* com.h: Delete declarations for all tree nodes now moved to
+	global_trees.
+	* com.c: Delete their definitions.
+	(ffecom_init_0): Call build_common_tree_nodes and
+	build_common_tree_nodes_2 instead of building their nodes here.
+	Override their decisions for complex nodes.
+
+Sat Sep  4 13:46:27 1999  Mark Mitchell  <mark@codesourcery.com>
+
+	* Make-lang.in (f771): Depend on ggc-callbacks.o.
+	* Makefile.in (OBJS): Add ggc-callbacks.o.
+	(OBJDEPS): Likewise.
+
+Mon Aug 30 22:05:53 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (language_string): Constify.
+
+Mon Aug 30 20:29:30 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Makefile.in (LIBS, LIBDEPS): Link with & depend on libiberty.a.
+	Remove hacks for stuff which now comes from libiberty.
+
+Sun Aug 29 09:47:45 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (lang_printable_name): Constify a char*.
+
+Wed Aug 25 01:21:06 1999  Rainer Orth  <ro@TechFak.Uni-Bielefeld.DE>
+
+	* lang-specs.h: Pass cc1 spec to f771.
+
+Mon Aug  9 19:44:08 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (lang_print_error_function): Constify a char*.
+	(init_parse): Remove redundant prototype for `print_error_function'.
+	(lang_identify): Constify a char*.
+
+Thu Aug  5 02:40:42 1999  Jeffrey A Law  (law@cygnus.com)
+
+	* g77spec.c: Update URLS and mail addresses.
+	* root.texi: Update URLS and mail addresses.
+
+1999-07-25  Richard Henderson  <rth@cygnus.com>
+
+	* com.c (ptr_type_node, va_list_type_node): New.
+	(ffecom_init_0): Init and use ptr_type_node.
+
+1999-07-17  Alexandre Oliva  <oliva@dcc.unicamp.br>
+
+	* root.texi: Update e-mail addresses to gcc.gnu.org.
+	* g77spec.c (lang_specific_driver): Updated URL with bug reporting
+	instructions to gcc.gnu.org.  Removed e-mail address.
+
+Sat Jul 17 11:28:43 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* root.texi, g77install.texi: Switchover to GCC terminology.
+	Also, FSF-G77 had been mistakenly set at some point.
+
+Thu Jul  8 15:38:50 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Describe DATE intrinsic fix.
+
+Mon Jun 28 21:44:19 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* version.c: Denote experimental version.
+
+Mon Jun 28 10:43:11 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* com.c (ffecom_prepare_expr_): A COMPLEX intrinsic needs
+	a temp even if -fno-f2c.
+
+	* version.c: Bump version.
+
+Mon Jun 28 21:31:35 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi, news.texi: Doc upgrade to netlib libf2c as of today.
+	Explain that this fixes the NAMELIST-read bug.
+
+Fri Jun 25 11:06:32 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi: Describe K(5)=10*3 NAMELIST-read bug.
+
+Mon Jun 21 12:40:17 1999  Gerald Pfeifer  <pfeifer@dbai.tuwien.ac.at>
+
+	* g77.texi: Update links.
+
+Mon Jun 21 05:33:51 1999  Jeffrey A Law  (law@cygnus.com)
+
+	* news.texi: Add missing @end ifclear.
+
+Fri Jun 18 11:43:46 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Doc TtyNam fix.
+
+Fri Jun 18 11:26:50 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: New heading for development version.
+	Doc upgrade to netlib libf2c as of today.
+
+Wed Jun 16 11:43:02 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Mention BACKSPACE fix to libg2c.
+
+Mon Jun  7 08:42:40 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* Make-lang.in: Any target using libsubdir must depend
+	on installdirs.
+
+Sat Jun  5 23:50:36 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Describe a few more missing features people
+	have emailed me about.
+
+Sat Jun  5 17:03:23 1999  Craig Burley  <craig@jcb-sc.com>
+
+	From Dave Love to egcs-patches on 20 May 1999 17:38:38 +0100:
+	* g77.texi: Clean up fossil text vis-a-vis Intel CPUs.
+
+Fri Jun  4 13:56:56 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* Make-lang.in: Use libsubdir, not prefix, to store
+	temporary lang-f77 `flag' file.
+
+Fri Jun  4 10:26:04 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi (News): Mention GCC 2.95 in favor of EGCS 1.2.
+	Mention that libg2c is multilibbed.
+
+Fri Jun  4 10:09:50 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi (Missing Features): Add `Better Warnings'
+	item.
+
+Fri May 28 16:51:41 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Fix thinko.
+
+Wed May 26 14:43:27 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Document Tue May 18 03:52:04 1999 patch.
+	Fix a grammo.
+
+Wed May 26 14:25:07 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi, news.texi, root.texi, version.c: Start renaming
+	EGCS 1.2 to GCC 2.95, and start using 0.5.25 to designate
+	the version of g77 within GCC 2.95.
+
+Wed May 26 11:45:21 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Rename -fsubscript-check to -fbounds-check and
+	-ff2c-subscript-check to -ffortran-bounds-check:
+	* g77.texi: Rename options in docs, clarify usage.
+	* lang-options.h: Rename options, clarify doclets.
+	* news.texi: Rename options, don't bother with fortran-specific
+	option.
+	* top.c (ffe_decode_option): Rename recognized strings.
+
+Tue May 25 18:21:09 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* com.c (FFECOM_FASTER_ARRAY_REFS): Delete this vestige,
+	now that -fflatten-arrays exists.
+
+Tue May 25 17:48:34 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Fix 19990525-0.f:
+	* com.c (ffecom_arg_ptr_to_expr): Strip off parens around
+	CHARACTER expression.
+	(ffecom_prepare_expr_): Ditto.
+
+Tue May 18 03:52:04 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Support use of back end's improved open-coding of complex divide:
+	* com.c (ffecom_tree_divide_): Use RDIV_EXPR for complex divide,
+	instead of run-time call to [cz]_div, if `-Os' option specified.
+	(lang_init_options): Tell back end we want support for wide range
+	of inputs to complex divide.
+
+	* Bump version.
+
+Tue May 18 00:21:34 1999  Zack Weinberg  <zack@rabi.phys.columbia.edu>
+
+	* lang-specs.h: Define __GNUC__ and __GNUC_MINOR__ only if -no-gcc
+	was not given.
+
+Thu May 13 12:23:20 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Fix INTEGER*8 subscripts in array references:
+	* com.c (ffecom_subscript_check_): Convert low, high, and
+	element as necessary to make comparison work.
+	(ffecom_arrayref_): Do more of the work.
+	Properly handle subscript expr that's wider than int,
+	if pointers are wider than int.
+	(ffecom_expr_): Leave more work to ffecom_arrayref_.
+	(ffecom_init_0): Record sizes of pointers and ints for
+	convenience.
+	Use set_sizetype etc. as done by gcc front end.
+	(ffecom_ptr_to_expr): Leave more work to ffecom_arrayref_.
+	* expr.c (ffeexpr_finished_): Don't convert INTEGER subscript
+	expressions in run-time contexts.
+	(ffeexpr_token_elements_, ffeexpr_token_substring_1_): Cope with
+	non-default INTEGER subscript expressions.
+	* news.texi: Announce.
+
+	Finish accepting -fflatten-arrays option:
+	* com.c (ffecom_arrayref_): Flatten references if requested.
+	* g77.texi: Describe.
+	* lang-options.h: Allow.
+	* news.texi: Announce.
+	* top.c, top.h: Recognize.
+
+	* version.c: Bump version.
+
+Wed May 12 07:30:05 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* com.c (lang_init_options): Disable back end's maintenance
+	of errno.
+	* news.texi: Document dropping of errno.
+
+1999-05-10 18:21 -0400  Zack Weinberg  <zack@rabi.phys.columbia.edu>
+
+	* lang-specs.h: Pass -$ to the preprocessor.
+
+Mon May 10 18:14:28 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Fix various @xref's per proper style.
+	Go ahead and use nested braces in @xref's, with care.
+	* g77install.texi: Fix @xref per proper style.
+
+Mon May 10 17:38:39 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Doc upgrade to netlib libf2c as of today.
+
+Sun May  9 18:52:13 1999  Hans-Peter Nilsson  <hp@bitrange.com>
+
+	* f/g77spec.c (lang_specific_driver): Correct bug-report address
+	and point to the FAQ.
+
+Thu May  6 12:40:21 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi (Arbitrary Concatenation): Put this under
+	"Missing Features" instead of "Projects".
+	(Internals Documentation): Point to new "Front End" chapter.
+
+Thu May  6 08:23:52 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi, news.texi: Automatic arrays reportedly working
+	on HP-UX systems.
+
+Thu May  6 08:19:31 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi (Advantages Over f2c): Expand on this topic.
+
+Mon May  3 19:41:48 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* com.c (ffecom_expr_intrinsic_): Fix test of CTIME_subr.
+
+Mon May  3 18:11:48 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Reverse order of two arguments to CTIME_subr, DTIME_subr,
+	ETIME_subr, and TTYNAM_subr:
+	* com.c (ffecom_expr_intrinsic_): Reverse the arguments.
+	While at it, set TREE_SIDE_EFFECTS for CTIME_subr and
+	TTYNAM_subr.
+	* intdoc.in: Document the new calling sequences.
+	* intrin.def: Reverse the arguments.
+	* news.texi: Document the fact that they changed.
+	* version.c: Bump version.
+
+Mon May  3 11:28:14 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Doc upgrade to netlib libf2c as of today.
+
+Sun May  2 17:04:28 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* version.c: Bump version.
+
+Sun May  2 16:53:01 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Fix compile/19990502-1.f:
+	* ste.c (ffeste_R819B): Don't overwrite tree for temp
+	variable when expanding the assignment into it.
+
+Sun Apr 25 20:55:10 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Fix 19990325-0.f and 19990325-1.f:
+	* com.c (ffecom_possible_partial_overlap_): New function.
+	(ffecom_expand_let_stmt): Use it to determine whether to assign
+	to a COMPLEX operand through a temp.
+	* news.texi: Document fix.
+
+	* version.c: Bump version.
+
+Sat Apr 24 12:19:53 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* expr.c (ffeexpr_finished_): Convert DATA implied-do
+	start/end/incr expressions to default INTEGER.
+	Fix some broken conditionals.
+	Clean up some code in the region.
+	* news.c: Document the fix.
+
+	* version.c: Bump version.
+
+Fri Apr 23 02:08:32 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi (Compiler Prototypes): Replace "missing" subscript-
+	checking option with something else.
+
+Fri Apr 23 01:48:28 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Support new -fsubscript-check and -ff2c-subscript-check options:
+	* com-rt.def (FFECOM_gfrtRANGE): Describe s_rnge, in libf2c/libF77.
+	* com.c (ffecom_subscript_check_, ffecom_arrayref_): New functions.
+	(ffecom_char_args_x_): Use new ffecom_arrayref_ function for
+	FFEBLD_opARRAYREF case.
+	Compute character name, array type, and	use new
+	ffecom_subscript_check_ function for FFEBLD_opSUBSTRING case.
+	(ffecom_expr_): Use new ffecom_arrayref_ function.
+	(ffecom_ptr_to_expr): Use new ffecom_arrayref_ function.
+	* g77.texi, news.texi: Document new options.
+	* top.c, top.h: Support new options.
+
+	* news.texi: Fix up some items to not be in "User-Visible Changes".
+
+	* ste.c (ffeste_R819B): Fix type for loop variable, to avoid
+	warnings.
+
+	* version.c: Bump version.
+
+Tue Apr 20 01:38:57 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi, news.texi: Clarify -malign-double situation.
+
+Tue Apr 20 01:15:25 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* stb.c (ffestb_R5282_): Convert DATA repeat count
+	to default INTEGER, to avoid problems downstream.
+
+	* version.c: Bump version.
+
+Mon Apr 19 21:36:48 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* ste.c (ffeste_R819B): Start the loop before expanding
+	the termination expression.
+
+	* version.c: Bump version.
+
+Sun Apr 18 21:53:58 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* com.c (ffecom_sym_transform_): COMMON and EQUIVALENCE
+	variables have constant addresses (EQUIVALENCE only if
+	containing aggregate is static).
+
+Sat Apr 17 16:55:59 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi, ffe.texi, g77.texi, g77install.texi, news.texi:
+	Clean up @code{} vs. @samp{}.
+	Clean up dashes (`--') vs. @minus{} vs. `---'.
+
+	* ffe.texi: Add copyright header.
+
+	* g77.texi, lang-options.h, news.texi, top.c (ffe_decode_option):
+	Remove support for -fugly option.
+	Clarify that -fugly-logint is needed instead of -fugly
+	to work around using .EQ./.NE. on LOGICAL operands.
+	Explain more about why -fugly-logint is bad juju.
+
+	* g77.texi (Missing Features): Describe READONLY as a missing
+	feature.  Describe AUTOMATIC better.
+
+	* news.texi: Mention libf2c upgrade.
+
+Sat Apr 17 14:05:53 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Make a place for front-end internals documentation:
+	* Make-lang.in (f/g77.info, f/g77.dvi): Depend on f/ffe.texi.
+	* ffe.texi: New file, containing docs on front-end internals.
+	* g77.texi: New chapter for, and inclusion of, ffe.texi.
+
+	* g77.texi: Fix an index entry.
+
+Sat Apr 17 13:53:43 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Rewrite to use block/scope structure of GBE and to ensure
+	variables (especially those going on stack/reg) are declared
+	before executable code generated:
+	* bld.c (ffebld_new_item, ffebld_new_one, ffebld_new_two):
+	Support new hooks.
+	* bld.h (ffebld_item_hook, ffebld_item_set_hook,
+	ffebld_nonter_hook, ffebld_nonter_set_hook): Ditto.
+	* bld.h (ffebld_basictype, ffebld_kind, ffebld_kindtype,
+	ffebld_rank, ffebld_where): New convenience macros (used
+	by rest of this patch).
+	* com.c, com.h (ffecom_push_calltemps, ffecom_pop_calltemps,
+	ffecom_push_tempvar, ffecom_pop_tempvar): Remove temp-var-
+	handling mechanism.
+	* com.c (ffecom_call_, ffecom_call_binop_, ffecom_tree_divide_,
+	ffecom_call_gfrt): Support passing hooks for temp-var info.
+	(ffecom_expr_power_integer_): Takes opPOWER expression, instead
+	of its left and right operands, so it can get at the hook.
+	(ffecom_prepare_let_char_, ffecom_prepare_arg_ptr_to_expr,
+	ffecom_prepare_end, ffecom_prepare_expr_, ffecom_prepare_expr_rw,
+	ffecom_prepare_expr_w, ffecom_prepare_return_expr,
+	ffecom_prepare_ptr_to_expr): New functions supporting expression
+	pre-scanning.
+	(bison_rule_compstmt_): Return the tree, as in the CFE.
+	(delete_block): New function, from CFE.
+	(kept_level_p): New function, from CFE, modified.
+	(ffecom_start_compstmt, ffecom_end_compstmt): New functions,
+	replacing ffecom_start_compstmt_ and ffecom_end_compstmt_ macros,
+	and they do real work.
+	(struct binding_level): Add prep_state member.  Initialize to 0.
+	(ffecom_get_invented_identifier): Now takes either or both a
+	string and an integer, using -1 to denote no integer.
+	(ffecom_do_entry_): Disallow temp-var generation via expressions
+	in body of function, since the exprs aren't prescanned.
+	(ffecom_expr_rw): Now takes destination tree.
+	(ffecom_expr_w): New function, now used in some places
+	ffecom_expr_rw had been used.
+	(ffecom_expr_intrinsic_): Move huge f2c-related comment to bottom
+	of source file, to avoid annoying problems editing com.c using
+	Emacs C-mode.
+	(ffecom_expr_power_integer_): Make a temp var for division, if
+	necessary.
+	Handle expanded statement expression as does CFE.
+	(ffecom_start_progunit_): Disallow temp-var generation in body
+	of function, since expressions are not prescanned at this level.
+	(ffecom_sym_transform_): Transform ASSIGN variables as well,
+	so these are all transformed up front, before code-generation
+	begins.
+	(ffecom_arg_ptr_to_const_expr, ffecom_const_expr,
+	ffecom_ptr_to_const_expr): New functions to transform expressions
+	only if the results will surely be constants.
+	(ffecom_arg_ptr_to_expr): Precompute size, for convenience
+	obtaining temp vars.
+	(ffecom_expand_let_stmt): Guess at usability of destination
+	pre-expansion, to provide better prescan preparation (fewer
+	spurious temp vars).
+	(ffecom_init_0): Disallow temp-var generation in global scope.
+	(ffecom_type_expr): New function, returns just the type tree
+	for the expression.
+	(start_function): Disallow temp-var generation in parm scope.
+	(incomplete_type_error): Fix introductory comment.
+	(poplevel): Update (somewhat) from CFE.
+	(pushlevel): Update (somewhat) from CFE.
+	* stc.c (ffestc_R838): Mark ASSIGNed variable as so.
+	* std.c (ffestd_stmt_pass_, ffestd_R803, ffestd_R804, ffestd_R805,
+	ffestd_R806): Remember and pass through the ffestw block info
+	for these (IFTHEN, ELSEIF, ELSE, and ENDIF) statements.
+	* ste.c (ffeste_end_iterdo_): Now takes ffestw block argument.
+	(ffeste_io_inlist_): Add prototype.
+	(ffeste_f2c_*): Macros rewritten, new ones added.
+	(ffeste_start_block_, ffeste_end_block_, ffeste_start_stmt_,
+	ffeste_end_stmt_): New macros/functions, depending on whether
+	checking is enabled, to keep track of symmetry of other ste.c code.
+	(ffeste_begin_iterdo_, ffeste_end_iterdo_, ffeste_io_impdo_,
+	ffeste_io_dofio_, ffeste_io_dolio_, ffeste_io_douio_,
+	ffeste_io_ialist_, ffeste_io_cilist_, ffeste_io_cllist_,
+	ffeste_icilist_, ffeste_io_inlist_, ffeste_io_olist_,
+	ffeste_subr_beru_, ffeste_do, ffeste_end_R807, ffeste_R737A,
+	ffeste_R803, ffeste_R804, ffeste_R805, ffeste_R806, ffeste_R807,
+	ffeste_R809, ffeste_R810, ffeste_R811, ffeste_R819A, ffeste_R819B,
+	ffeste_R837, ffeste_R838, ffeste_R839, ffeste_R840, ffeste_R904,
+	ffeste_R907, ffeste_R909_start, ffeste_R909_item, ffeste_R909_finish,
+	ffeste_R910_start, ffeste_R910_item, ffeste_R910_finish,
+	ffeste_R911_start, ffeste_R911_item, ffeste_R911_finish,
+	ffeste_R923A, ffeste_R1212, ffeste_R1227): Prescan/prepare
+	all pertinent expressions, update to new com.c interface, etc.
+	(ffeste_io_impdo_): Relocate.
+	(ffeste_R834, ffeste_R835, ffeste_R836, ffeste_R1226): Don't
+	bother calling clear_momentary, nothing was generated.
+	(ffeste_R842, ffeste_R843): Update to new com.c interface.
+	(ffeste_R1226): Don't try to stuff error_mark_node's DECL_INITIAL.
+	(ffeste_terminate_2): When checking enabled, make sure all blocks
+	and statements have been ended.
+	* ste.h (ffeste_R803, ffeste_R804, ffeste_R805, ffeste_R806):
+	These now take ffestw block argument.
+	(ffeste_terminate_2): When checking enabled, it's a function, not
+	a macro.
+	* stw.h (struct _ffestw_): New variable for IFTHEN.
+	(ffestw_ifthen_fake_else, ffestw_set_ifthen_fake_else): New
+	accessor macros.
+	* symbol.c, symbol.h: Support new ASSIGN'ed-to info.
+
+	* com.c: Clean up commentary per GNU coding standards.
+
+	* bld.h (ffebld_size, ffebld_size_known): Canonize.
+
+	* version.c: Bump version.
+
+Sun Apr 11 21:33:33 1999  Mumit Khan  <khan@xraylith.wisc.edu>
+
+	* g77spec.c (lang_specific_driver): Check whether MATH_LIBRARY is
+	null to decide whether to use it.
+
+Wed Apr  7 09:47:09 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* ansify.c (die): Specify void argument.
+
+	* intdoc.c (family_name, dumpgen, dumpspec, dumpimp,
+	argument_info_ptr, argument_info_string, argument_name_ptr,
+	argument_name_string, elaborate_if_complex,
+	elaborate_if_maybe_complex, elaborate_if_real, print_type_string):
+	Const-ify a char*.
+	(main): Mark parameter `argv' with ATTRIBUTE_UNUSED.
+	(_ffeintrin_name_, _ffeintrin_gen_, _ffeintrin_spec_,
+	_ffeintrin_imp_, cc_pair, descriptions, summaries): Const-ify a char*.
+
+Mon Apr  5 11:57:54 1999  Donn Terry (donn@interix.com)
+
+	* Make-lang.in (HOST_CFLAGS): compute dynamically.
+
+Mon Apr  5 02:11:23 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Fix bugs exposed by configuring with --enable-checking:
+	* com.c (ffecom_do_entry_, ffecom_expr_, ffecom_arg_ptr_to_expr,
+	ffecom_list_expr, ffecom_list_ptr_to_expr, finish_function,
+	pop_f_function_context, store_parm_decls, poplevel): Handle
+	error_mark_node properly.
+	* ste.c (ffeste_begin_iterdo_, ffeste_end_iterdo_): Ditto.
+	* version.c: Bump version.
+
+Sat Apr  3 23:57:56 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Fix up docs for -fset-g77-defaults, and
+	describe how internal consistency checking now happens.
+	(Should have been done for EGCS version 1.1.)
+
+Sat Apr  3 23:29:33 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi, g77.texi, lang-options.h, news.texi, top.c:
+	Make -fno-emulate-complex the default, as COMPLEX support
+	in the back end is now believed to be working.
+
+	* version.c: Bump version.
+
+Fri Apr  2 13:33:16 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: -malign-double now works.
+	Give URL for alignment-testing package.
+	* news.texi: -malign-double now works.
+
+Fri Apr  2 12:49:12 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi (Funding GNU Fortran): Dude's got a web page.
+	* root.texi: Ditto.
+
+Tue Mar 30 12:04:11 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* sta.c (ffesta_ffebad_1sp, ffesta_ffebad_1st, ffesta_ffebad_2st):
+	Const-ify a char*.
+
+	* sta.h (ffesta_ffebad_1sp, ffesta_ffebad_1st, ffesta_ffebad_2st):
+	Likewise.
+
+	* stb.c (ffestb_local_u_): Likewise.
+	(ffestb_do, ffestb_dowhile, ffestb_else, ffestb_elsexyz,
+	ffestb_else3_, ffestb_endxyz, ffestb_goto, ffestb_let,
+	ffestb_type, ffestb_type1_, ffestb_varlist, ffestb_R423B,
+	ffestb_R522, ffestb_R528, ffestb_R542, ffestb_R834, ffestb_R835,
+	ffestb_R838, ffestb_R841, ffestb_R1102, ffestb_blockdata,
+	ffestb_R1212, ffestb_R1228, ffestb_V009, ffestb_module,
+	ffestb_R809, ffestb_R810, ffestb_R10014_, ffestb_R10015_,
+	ffestb_R10018_, ffestb_R1107, ffestb_R1202, ffestb_R12026_,
+	ffestb_S3P4, ffestb_V012, ffestb_V014, ffestb_V025, ffestb_V0255_,
+	ffestb_V020, ffestb_dimlist, ffestb_dummy, ffestb_R524,
+	ffestb_R547, ffestb_decl_chartype, ffestb_decl_dbltype,
+	ffestb_decl_gentype, ffestb_decl_recursive, ffestb_decl_entsp_2_,
+	ffestb_decl_func_, ffestb_V003, ffestb_V016, ffestb_V027,
+	ffestb_decl_R539): Likewise.
+
+	* stb.h (_ffestb_args_): Likewise.
+
+	* stc.c (ffestc_subr_binsrch_, ffestc_subr_is_present_,
+	ffestc_subr_speccmp_, ffestc_R904, ffestc_R907): Likewise.
+
+	* std.c (ffestd_R1001dump_1005_1_, ffestd_R1001dump_1005_2_,
+	ffestd_R1001dump_1005_3_, ffestd_R1001dump_1005_4_,
+	ffestd_R1001dump_1005_5_, ffestd_R1001dump_1010_1_,
+	ffestd_R1001dump_1010_2_, ffestd_R1001dump_1010_3_,
+	ffestd_R1001dump_1010_4_, ffestd_R1001dump_1010_5_): Likewise.
+
+	* ste.c (ffeste_begin_iterdo_, ffeste_subr_file_): Likewise.
+
+	* sts.c (ffests_printf_1D, ffests_printf_1U, ffests_printf_1s,
+	ffests_printf_2Us, ffests_puts, ffests_puttext): Likewise.
+
+	* sts.h (ffests_printf_1D, ffests_printf_1U, ffests_printf_1s,
+	ffests_printf_2Us, ffests_puts, ffests_puttext): Likewise.
+
+	* stt.c (ffestt_exprlist_drive, ffestt_implist_drive,
+	ffestt_tokenlist_drive): Add prototype arguments.
+
+	* stt.h (ffestt_exprlist_drive, ffestt_implist_drive,
+	ffestt_tokenlist_drive): Likewise.
+
+	* stu.c (ffestu_dummies_transition_): Likewise.
+	(ffestu_sym_end_transition): Const-ify a char*.
+
+	* stw.c (ffestw_display_state, ffestw_new, ffestw_pop): Add
+	prototype arguments.
+
+	* stw.h (ffestw_display_state, ffestw_new, ffestw_pop): Likewise.
+
+	* version.c (ffe_version_string): Const-ify a char*.
+
+	* version.h (ffe_version_string): Likewise.
+
+Sat Mar 27 13:00:43 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bad.c (_ffebad_message_, ffebad_string_, ffebad_message_,
+	ffebad_bufputs_, ffebad_bufputs_, ffebad_start_, ffebad_string,
+	ffebad_finish): Const-ify a char*.
+
+	* bld.c (ffebld_op_string_, ffebld_op_string): Likewise.
+
+	* bld.h (ffebld_op_string): Likewise.
+
+	* com.c (ffecom_arglist_expr_, ffecom_build_f2c_string_,
+	ffecom_debug_kludge_, ffecom_f2c_make_type_,
+	ffecom_get_appended_identifier_, ffecom_get_identifier_,
+	ffecom_gfrt_args_): Likewise.
+	(ffecom_convert_narrow_, ffecom_convert_widen_): Add prototype.
+	(builtin_function, ffecom_gfrt_name_, ffecom_gfrt_argstring_,
+	ffecom_arglist_expr_, ffecom_build_f2c_string_,
+	ffecom_debug_kludge_, ffecom_f2c_make_type_,
+	ffecom_get_appended_identifier_, ffecom_get_external_identifier_,
+	ffecom_get_identifier_, ffecom_decl_field,
+	ffecom_get_invented_identifier, lang_print_error_function,
+	skip_redundant_dir_prefix, read_name_map, print_containing_files):
+	Const-ify a char*.
+	(savestring): Remove, use `xstrdup' instead.
+
+	* com.h (ffecom_decl_field, ffecom_get_invented_identifier):
+	Const-ify a char*.
+
+	* data.c (ffebld, ffedata_gather_): Make explicitly static.
+
+	* expr.c (ffeexpr_isdigits_, ffeexpr_percent_,
+	ffeexpr_reduced_concatenate_, ffeexpr_nil_real_,
+	ffeexpr_nil_number_, ffeexpr_nil_number_period_,
+	ffeexpr_nil_number_real_, ffeexpr_token_real_,
+	ffeexpr_token_number_, ffeexpr_token_number_period_,
+	ffeexpr_token_number_real_): Const-ify a char*.
+
+	* fini.c (xspaces): Likewise.
+
+	* global.c (ffeglobal_type_string_): Likewise.
+	(ffeglobal_drive): Protoize.
+	(ffeglobal_proc_def_arg): Const-ify a char*.
+
+	* global.h (ffeglobal_drive): Protoize.
+	(ffeglobal_proc_def_arg): Const-ify a char*.
+
+	* implic.c (ffeimplic_none, ffeimplic_peek_symbol_type):
+	Likewise.
+
+	* implic.h (ffeimplic_peek_symbol_type): Likewise.
+
+	* info.c (ffeinfo_basictype_string_, ffeinfo_kind_message_,
+	ffeinfo_kind_string_, ffeinfo_kindtype_string_,
+	ffeinfo_where_string_, ffeinfo_basictype_string,
+	ffeinfo_kind_message, ffeinfo_kind_string,
+	ffeinfo_kindtype_string, ffeinfo_where_string): Likewise.
+
+	* info.h (ffeinfo_basictype_string, ffeinfo_kind_message,
+	ffeinfo_kind_string, ffeinfo_kindtype_string,
+	ffeinfo_where_string): Likewise.
+
+	* intrin.c (_ffeintrin_name_, _ffeintrin_gen_, _ffeintrin_spec_,
+	_ffeintrin_imp_, ffeintrin_check_, ffeintrin_cmp_name_,
+	ffeintrin_fulfill_specific, ffeintrin_init_0,
+	ffeintrin_is_actualarg, ffeintrin_is_intrinsic,
+	ffeintrin_name_generic, ffeintrin_name_implementation,
+	ffeintrin_name_specific): Likewise.
+
+	* intrin.h (ffeintrin_is_intrinsic, ffeintrin_name_generic,
+	ffeintrin_name_implementation, ffeintrin_name_specific): Likewise.
+
+	* lex.c (ffelex_type_string_, ffelex_token_new_character,
+	ffelex_token_new_name, ffelex_token_new_names,
+	ffelex_token_new_number): Likewise.
+
+	* lex.h (ffelex_token_new_character, ffelex_token_new_name,
+	ffelex_token_new_names, ffelex_token_new_number): Likewise.
+
+	* malloc.c (malloc_types_, malloc_pool_new, malloc_new_inpool_,
+	malloc_new_zinpool_): Likewise.
+
+	* malloc.h (malloc_new_inpool_, malloc_new_zinpool_,
+	malloc_pool_new): Likewise.
+
+	* name.c (ffename_space_drive_global, ffename_space_drive_symbol):
+	Protoize.
+
+	* name.h (ffename_space_drive_global, ffename_space_drive_symbol):
+	Likewise.
+
+	* symbol.c (ffesymbol_state_name_, ffesymbol_attr_name_,
+	ffesymbol_attrs_string): Const-ify a char*.
+	(ffesymbol_drive, ffesymbol_drive_sfnames): Protoize.
+	(ffesymbol_state_string): Const-ify a char*.
+
+	* symbol.h (ffesymbol_attrs_string): Likewise.
+	(ffesymbol_drive, ffesymbol_drive_sfnames): Protoize.
+	(ffesymbol_state_string): Const-ify a char*.
+
+	* target.c (ffetarget_layout): Likewise.
+
+	* target.h (ffetarget_layout): Likewise.
+
+1999-03-25  Zack Weinberg  <zack@rabi.columbia.edu>
+
+	* Make-lang.in: Remove all references to g77.o/g77.c.
+	Link g77 from gcc.o.
+
+1999-03-21  Manfred Hollstein  <manfred@s-direktnet.de>
+
+	* Makefile.in (g77$(exeext)): Depend on intl.o.  Link in intl.o.
+
+Wed Mar 17 11:39:44 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Editorial fix.
+
+Mon Mar 15 17:12:07 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi, g77.texi, news.texi: Editorial fixes.
+
+Sat Mar 13 17:51:55 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Fix 19990313-0.f, 19990313-1.f, 19990313-2.f, 19990313-3.f:
+	* bad.def (FFEBAD_NOCANDO): New error code for internal use only.
+	* expr.c (ffeexpr_collapse_convert): If FFEBAD_NOCANDO returned
+	by convertor, just return original expr.
+	* target.h: Return FFEBAD_NOCANDO for (usually) 64-bit
+	conversions that aren't yet working properly.
+	* news.texi: Explain.
+
+	* version.c: Bump version.
+
+Sat Mar 13 14:26:55 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* RELEASE-PREP: New file, lists things to do for a release.
+
+	* Make-lang.in, bugs.texi, bugs0.texi, g77.texi, g77install.texi,
+	install0.texi, news.texi, news0.texi: Accommodate new doc
+	architecture.
+	Consolidate news items.  Don't describe old news items in
+	various generated docs.
+	Don't describe FSF-g77 installation stuff in various EGCS-g77
+	generated docs.
+	Move description of AUTOMATIC to more suitable location.
+	* root.texi: New file for new doc architecture.
+
+Thu Mar 11 17:32:55 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Add AUTOMATIC to list of unsupported extensions.
+
+Sat Mar  6 02:28:35 1999  Craig Burley  <craig@jcb-sc.com>
+
+	Warn about non-Y2K-compliant intrinsics:
+	* bad.def (FFEBAD_INTRINSIC_Y2KBAD): New diagnostic.
+	* intrin.def (FFEINTRIN_impDATE, FFEINTRIN_impIDATE_vxt):
+	Use new DEFIMPY macro to flag these as non-Y2K-compliant.
+	* intdoc.c (DEFIMPY): Support new Y2K macro.
+	* intrin.h (DEFIMPY): Ditto.
+	* intrin.c (DEFIMPY): Ditto.
+	(ffeintrin_fulfill_generic, ffeintrin_fulfill_specific):
+	Warn about invocation of non-Y2K-compliant intrinsic.
+	* com-rt.def (FFECOM_gfrtDATE, FFECOM_gfrtVXTIDATE):
+	Rename external procedure names, to keep previously-
+	compiled (sans-new-warnings) code from linking to
+	new library.
+	* g77.texi: Document all this stuff.
+	* news.texi: Spread the joy.
+	* version.c: Bump version.
+
+Fri Mar  5 13:22:44 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Relocate IDATE (VXT) fix: we put it in 1.1.2
+	so describe it there, instead of under 1.2.
+
+Wed Mar  3 00:57:56 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: IDATE (VXT) fixed to return year as 0..99.
+
+Wed Mar  3 00:43:49 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Add remaining changes pending from Dave Love.
+
+Wed Mar  3 00:38:42 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs.texi, news.texi: Conditionalize cross-references
+	on non-html processing, providing temporary HTML "links".
+
+	* g77.texi: Fix up a reference.
+
+Wed Mar  3 00:12:31 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi, bugs.texi: Delete fixed bugs, make one
+	of them into the appropriate news item.
+
+Wed Mar  3 00:05:52 1999  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Copy over 1.1.2 news.
+
+1999-03-02  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi (Bug Reporting): Clarify whether to use -E.
+	Clarify other instructions.
+
+1999-02-27  Craig Burley  <craig@jcb-sc.com>
+
+	* lang-specs.h: Fix specs to pass `-ax' as well as `-a' option.
+
+1999-02-26  Craig Burley  <craig@jcb-sc.com>
+
+	* intdoc.in (STAT_func, STAT_subr,
+	FSTAT_func, FSTAT_subr, LSTAT_func, LSTAT_subr):
+	Properly order array elements.  Specify N/A return values.
+
+1999-02-26  Craig Burley  <craig@jcb-sc.com>
+
+	* intdoc.in (DATE_AND_TIME): Explain that VALUES(7) holds
+	seconds, and VALUES(8), therefore, milliseconds.
+
+1999-02-26  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Clarify IOSTAT= fix.
+
+1999-02-25  Richard Henderson  <rth@cygnus.com>
+
+	* lang-specs.h: Define __FAST_MATH__ when appropriate.
+
+1999-02-25  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Clarify/index lack of run-time allocation for
+	concatenation.
+
+1999-02-25  Andreas Jaeger  <aj@arthur.rhein-neckar.de>
+
+	* f/intdoc.in: Add missing `,' after cross references.
+
+1999-02-20  Craig Burley  <craig@jcb-sc.com>
+
+	* Make-lang.in (f77.install-common, f77.install-info,
+	f77.install-man, f77.uninstall): Use `$(prefix)/lang-f77'
+	instead of `lang-f77' for flag file, to be sure of a
+	writable directory, and remove the flag file after each
+	operation to keep things clean.
+
+1999-02-20  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Properly attribute Priest document; clarify
+	that it is in the .ps version of the Goldberg document.
+
+1999-02-19  Craig Burley  <craig@jcb-sc.com>
+
+	* bugs0.texi, bugs.texi, install0.texi, g77install.texi,
+	news0.texi, news.texi: Update copyright dates.
+	Clarify which files are source, which are derived,
+	and remind maintainers where copyright dates are sourced.
+	* BUGS, INSTALL, NEWS: Regenerated.
+
+1999-02-19  Craig Burley  <craig@jcb-sc.com>
+
+	* global.c (ffeglobal_ref_progunit_): Warn about a function
+	definition that disagrees with the type of a previous reference.
+	Improve commentary.  Fix a couple of minor bugs.  Clean up
+	some code.
+	* news.texi: Spread the joy.
+
+1999-02-18  Craig Burley  <craig@jcb-sc.com>
+
+	* expr.c (ffeexpr_finished_): Disallow non-default INTEGER
+	as argument for FILEINT and FILEASSOC as lhs.
+	* news.texi: Document fix.
+	* version.c: Bump.
+
+1999-02-18  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi: Clarify -fno-globals vs. -Wno-globals.
+
+1999-02-18  Craig Burley  <craig@jcb-sc.com>
+
+	* intdoc.in (LOG10): Fix typo.
+
+1999-02-17  Ulrich Drepper  <drepper@cygnus.com>
+
+	* intdoc.in: Fix typo.
+
+1999-02-17  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi, intdoc.in: Document Y2K and some other known
+	limitations.
+	* intrin.def (DTIME, FDATE): Fix capitalization of
+	case-sensitive forms of these intrinsics' names.
+
+1999-02-17  Dave Love  <fx@gnu.org>
+
+	* intdoc.in: Say `common' logarithm for log10.
+
+1999-02-16  Ulrich Drepper  <drepper@cygnus.com>
+
+	* g77.texi: Add missing @ in email addresses.
+
+1999-02-15  Craig Burley  <craig@jcb-sc.com>
+
+	* *.*: Delete my (old) email address in most places, change it
+	in a few.
+
+1999-02-14  Craig Burley  <craig@jcb-sc.com>
+
+	* version.c: Bump.
+
+1999-02-14  Craig Burley  <craig@jcb-sc.com>
+
+	* version.c: Bump for 1998-10-02 change (forgot to do this
+	before).
+
+1999-02-14  Craig Burley  <craig@jcb-sc.com>
+
+	* lang-specs.h, g77.1, g77.texi, news.texi: Recognize `.FOR'
+	and `.FPP' as well as `.for' and `.fpp'.
+
+1999-02-14  Craig Burley  <craig@jcb-sc.com>
+
+	* intdoc.in (LOG10): Fix description.
+
+1999-02-14  Craig Burley  <craig@jcb-sc.com>
+
+	* news.texi: Mention fix for SIGNAL invocation circa egcs-1.1.
+
+1999-02-14  Craig Burley  <craig@jcb-sc.com>
+
+	* g77.texi, g77install.texi, bugs.texi, g77install.texi: Clean
+	up and improve indexing, and some other areas of docs.
+
+1999-02-14  Craig Burley  <craig@jcb-sc.com>
+
+	* intdoc.in (MCLOCK8, TIME8): Warn about lower range on
+	32-bit systems.
+
+Sat Feb  6 18:02:17 1999  Jeffrey A Law  (law@cygnus.com)
+
+	* g77.texi: Update email addresses.
+
+Wed Feb  3 22:50:17 1999  Marc Espie <Marc.Espie@liafa.jussieu.fr>
+
+	* Make-lang.in (g77$(exeext)): Get choose-temp.o, pexecute.o and
+	mkstemp.o from libiberty.
+
+1999-02-01  Zack Weinberg  <zack@rabi.columbia.edu>
+
+	* top.c: Don't define ffe_is_ident_.  Don't process
+	-f(no-)ident here.
+	* top.h: Remove declaration of ffe_is_ident_ and macros
+	ffe_is_ident() and ffe_set_is_ident().
+	* lex.c: Use flag_no_ident instead of ffe_is_ident().
+
+Sun Jan 31 20:34:29 1999  Zack Weinberg  <zack@rabi.columbia.edu>
+
+	* lang-specs.h: Map -Qn to -fno-ident.
+
+Tue Jan  5 22:12:41 1999  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in (g77.o): Depend on prefix.h.
+
+Fri Nov 27 13:10:32 1998  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* fini.c: Rename variable `spaces' to `xspaces' to avoid
+	conflicting with function `spaces' from libiberty.
+
+	* g77spec.c: Don't prototype libiberty functions.
+	* malloc.c: Likewise.
+
+1998-11-20  Dave Love  <d.love@dl.ac.uk>
+
+	* g77.texi: Assorted minor changes.
+
+1998-11-19  Dave Love  <d.love@dl.ac.uk>
+
+	* bugs.texi: Formatting changes from Craig.
+
+	* intdoc.in: Terminate some @xrefs with `,'.
+
+1998-11-19  Manfred Hollstein  <manfred@s-direktnet.de>
+
+	* Make-lang.in (mandir): Replace all uses of $(mandir) by $(man1dir).
+
+Mon Nov  9 23:15:39 1998  Jeffrey A Law  (law@cygnus.com)
+
+	* g77.texi, news.texi: Updates from Craig.
+
+Sun Nov  8 17:47:56 1998  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Makefile.in (INCLUDES): Add "-I$(srcdir)/../../include".
+
+Sat Nov  7 15:58:54 1998  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* g77spec.c: Don't include gansidecl.h.
+	* output.j: Likewise.
+
+1998-11-04  Dave Love  <d.love@dl.ac.uk>
+
+	* g77.texi: Small formatting/indexing fixes.
+
+Mon Oct 12 20:41:59 1998  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* bad.c (ffebad_finish): Change type of variable `c' to unsigned
+	char, change type of variable `s' to unsigned char *.
+
+	* com.c (ffecom_symbol_null_): Add missing initializers.
+
+	* fini.c (MAXNAMELEN): Undef it before defining.
+
+	* implic.c (ffeimplic_lookup_): Change type of parameter `c' to
+	unsigned char.
+
+	* intrin.c (ffeintrin_init_0): Cast the argument of ctype macros
+	to (unsigned char).
+
+	* lex.c (ffelex_splice_tokens): Change type of variable `p' to
+	unsigned char *.
+	(ffelex_token_name_from_names): Cast the argument of
+	`ffelex_is_firstnamechar' to (unsigned char).
+	(ffelex_token_names_from_names): Likewise.
+	(ffelex_token_new_name): Likewise.
+	(ffelex_token_new_names): Likewise.
+
+	* malloc.c (malloc_root_): Add missing initializer.
+
+	* stb.c (ffestb_do): Change type of variable `p' to unsigned char *.
+	(ffestb_else) Likewise.
+	(ffestb_else3_) Likewise.
+	(ffestb_endxyz) Likewise.
+	(ffestb_goto) Likewise.
+	(ffestb_let) Likewise.
+	(ffestb_varlist) Likewise.
+	(ffestb_R522) Likewise.
+	(ffestb_R528) Likewise.
+	(ffestb_R834) Likewise.
+	(ffestb_R835) Likewise.
+	(ffestb_R838) Likewise.
+	(ffestb_R1102) Likewise.
+	(ffestb_blockdata) Likewise.
+	(ffestb_R1212) Likewise.
+	(ffestb_R810) Likewise.
+	(ffestb_R10014_): Cast the argument of `ffelex_is_firstnamechar'
+	to (unsigned char).
+	(ffestb_V014): Change type of variable `p' to unsigned char *.
+	(ffestb_dummy) Likewise.
+	(ffestb_R524) Likewise.
+	(ffestb_R547) Likewise.
+	(ffestb_decl_chartype) Likewise.
+	(ffestb_decl_dbltype) Likewise.
+	(ffestb_decl_gentype) Likewise.
+	(ffestb_decl_entsp_2_) Likewise.
+	(ffestb_V027) Likewise.
+	(ffestb_decl_R539) Likewise.
+
+	* top.c (ffe_decode_option): Mark parameter `argc' with
+	ATTRIBUTE_UNUSED.
+
+	* where.c (ffewhere_unknown_line_): Add missing initializers.
+
+1998-10-02  Dave Love  <d.love@dl.ac.uk>
+
+	* com.c (ffecom_expr_intrinsic_): Fix return type for RAND.
+
+Thu Oct  1 10:43:45 1998  Nick Clifton  <nickc@cygnus.com>
+
+	* lex.c: Replace occurances of HANDLE_SYSV_PRAGMA with
+	HANDLE_GENERIC_PRAGMAS.
+
+Mon Sep 28 04:22:00 1998  Jeffrey A Law  (law@cygnus.com)
+
+	* news.texi: Update from Craig.
+
+1998-09-23  Dave Love  <d.love@dl.ac.uk>
+
+	* g77.texi: Additions about `/*', trailing comments and cpp.
+
+1998-09-18  Dave Love  <d.love@dl.ac.uk>
+
+	* g77.texi: Various additions and some small fixes.
+
+Thu Sep 10 14:55:44 1998  Kamil Iskra  <iskra@student.uci.agh.edu.pl>
+
+	* Make-lang.in (f77.install-common): Add missing "else true;".
+
+1998-09-07  Dave Love  <d.love@dl.ac.uk>
+
+	* ChangeLog.egcs: Deleted.  Entries merged here.
+
+1998-09-05  Dave Love  <d.love@dl.ac.uk>
+
+	* Makefile.in (LDFLAGS): Set from BOOT_LDFLAGS.
+	(F771_LDFLAGS): Variable dispensed with.
+
+Fri Sep  4 19:53:34 1998  Craig Burley  <burley@gnu.org>
+
+	* intdoc.in: Minor editorial tweaks.
+
+Fri Sep  4 18:35:52 1998  Craig Burley  <burley@gnu.org>
+
+	* lang-options.h: Convert to wrap option and doc string
+	in a new macro invocation, FTNOPT, so the nearly identical
+	list can be used in FSF-g77.
+
+Fri Sep  4 18:35:52 1998  Craig Burley  <burley@gnu.org>
+
+	* Makefile.in (fini.o): Don't define USE_HCONFIG here.
+	* fini.c: Define USE_HCONFIG here instead, so deps-kinda
+	picks up correct dependency.
+
+	* Makefile.in (proj-h.o): Fix dependencies list.
+
+Wed Sep 02 09:25:29 1998  Nick Clifton  <nickc@cygnus.com>
+
+	* lex.c (ffe_lex_hash):  Change how HANDLE_PRAGMA and
+	HANDLE_SYSV_PRAGMA would be called if they pragma parsing was
+	enabled in this code.
+	Generate warning messages if unknown pragmas are encountered.
+	(pragma_getc): New function: retrieves characters from the
+	input stream.  Defined when HANDLE_PRAGMA is defined.
+	(pragma_ungetc): New function: replaces characters back into the
+	input stream.  Defined when HANDLE_PRAGMA is defined.
+
+Tue Sep  1 10:00:21 1998  Craig Burley  <burley@gnu.org>
+
+	* bugs.texi, g77.1, g77.texi, intdoc.in, news.texi: Doc updates
+	from Craig.
+
+1998-08-23  Dave Love  <d.love@dl.ac.uk>
+
+	* g77.texi: Increment `version-g77' and fix a few typos.
+
+Tue Aug 18 21:41:31 1998  Jeffrey A Law  (law@cygnus.com)
+
+	* Make-lang.in: Add several "else true" clauses to deal with lame
+	systems.
+
+Tue Aug 11 08:12:14 1998  H.J. Lu  (hjl@gnu.org)
+
+	* Make-lang.in (g77.o): Touch lang-f77 before checking it.
+
+1998-08-09  Dave Love  <d.love@dl.ac.uk>
+
+	* Make-lang.in (f/g77.dvi): Replace non-working use of texi2dvi
+	with explicit use of tex.
+	(f77.mostlyclean): Remove TeX index files.
+
+	* g77install.texi (Prerequisites): Kluge round TeX lossage with
+	hyphen in @value in @code.
+
+Tue Aug  4 16:59:39 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_convert_narrow_, ffecom_convert_widen_):
+	Allow conversion from pointer to same-sized integer,
+	to fix invoking SIGNAL as a function.
+
+1998-07-26  Dave Love  <d.love@dl.ac.uk>
+
+	* BUGS, INSTALL, NEWS: Rebuilt.
+
+Sat Jul 25 17:23:55 1998  Craig Burley  <burley@gnu.org>
+
+	Fix 980615-0.f:
+	* stc.c (ffestc_R1229_start): Set info to ANY as well.
+
+Tue Jul 21 04:33:37 1998  Craig Burley  <burley@gnu.org>
+
+	* g77spec.c (lang_specific_driver): Return unmolested
+	command line when --help seen.
+	Comment out code that printed g77-specific --help info.
+
+Sat Jul 18 19:16:48 1998  Craig Burley  <burley@gnu.org>
+
+	* lang-options.h: Fix up doc strings.
+	Remove the unimplemented -fdcp-intrinsics-* options.
+
+	* str-1t.fin: Change mixed-case spelling of `GoTo' from
+	`Goto'.
+
+Thu Jul 16 13:26:36 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_finish_symbol_transform_): Revert change
+	of 1998-05-23, as it was too aggressive, in that it
+	prevented transformation of (used) functions before
+	primary code generation.
+
+1998-07-15  Dave Love  <d.love@dl.ac.uk>
+
+	* intdoc.texi: Regenerated.
+
+Mon Jul 13 18:45:06 1998  Craig Burley  <burley@gnu.org>
+
+	* Make-lang.in (f77.rebuilt): Fix to depend on
+	build-dir-based, not source-based, g77.info.
+
+	* g77.texi: Merge docs with 0.5.24.
+	* g77install.texi: Ditto.
+
+Mon Jul 13 18:02:29 1998  Craig Burley  <burley@gnu.org>
+
+	Cleanups vis-a-vis g77-0.5.24:
+	* g77spec.c (lang_specific_driver): Tabify source.
+	* top.c (ffe_decode_option): Use fixed macro to set
+	internal-checking flag.
+	* top.h (ffe_set_is_do_internal_checks): Fix macro.
+
+Mon Jul 13 17:33:44 1998  Craig Burley  <burley@gnu.org>
+
+	Cleanups vis-a-vis system.h cutover and g77-0.5.24:
+	* Makefile.in (fini.o): Define USE_HCONFIG macro
+	so source code doesn't have to.
+	* fini.c: Don't define USE_HCONFIG here, since
+	source code usually shouldn't care about this.
+	* ansify.c: Include stddef.h only if we have it.
+	* intdoc.c: Ditto.
+	* proj.h: Ditto.
+
+Mon Jul 13 17:30:29 1998  Nick Clifton  <nickc@cygnus.com>
+
+	* lang-options.h: Format changed to work with --help support added
+	to gcc/toplev.c
+
+Mon Jul 13 11:54:03 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_push_tempvar): Replace kludge that
+	munged back-end globals directly with proper calls
+	to push_topmost_sequence and pop_topmost_sequence.
+
+1998-07-12  Dave Love  <d.love@dl.ac.uk>
+
+	* version.c: Bump version.
+
+Sat Jul 11 19:24:32 1998  Craig Burley  <burley@gnu.org>
+
+	Fix 980616-0.f:
+	* equiv.c (ffeequiv_offset_): Don't crash on various
+	possible ANY operands.
+
+Sat Jul 11 18:24:37 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_expr_) [FFEBLD_opCONTER]: Die if padding
+	for constant is nonzero.
+
+	* com.c (__eprintf): Delete this function, it is obsolete.
+
+1998-07-09  Dave Love  <d.love@dl.ac.uk>
+
+	* intdoc.in (HOSTNM_func, HOSTNM_subr): Update last change.
+
+Thu Jul  9 00:45:59 1998  Craig Burley  <burley@gnu.org>
+
+	Fix debugging of CHARACTER*(*), etc., which requires
+	emitting debug info on types like `ftnlen':
+	* com.c (ffecom_start_progunit_): Don't bother
+	resetting "invented" flag for identifier.
+	(ffecom_transform_equiv_): Don't bother zeroing
+	"ignored" flag for decl.
+	(pushdecl): No longer set "ignored", "used", or
+	"suppressed debug" flags for decls having "invented"
+	identifiers.
+
+1998-07-06  Mike Stump  <mrs@wrs.com>
+
+	* Make-lang.in (f77.stage?): Use mv -f instead of just mv so that
+	we can move g77.c.
+
+1998-07-06  Dave Love  <d.love@dl.ac.uk>
+
+	* intdoc.in (HOSTNM_func, HOSTNM_subr): Note possible need for
+	-lsocket.
+
+1998-07-05  Dave Love  <d.love@dl.ac.uk>
+
+	* intdoc.in: Add entry for DATE_AND_TIME.
+
+	* intrin.def: Add implementation for DATE_AND_TIME.  Make second
+	and third args of SYSTEM_CLOCK optional.
+
+	* com.c (ffecom_expr_intrinsic_): New case for DATE_AND_TIME.
+
+	* com-rt.def (FFECOM_gfrtSYSTEM_CLOCK): Call G77_system_clock_0,
+	not system_clock_.
+	(FFECOM_gfrtDATE_AND_TIME): New DEFGFRT.
+
+Wed Jul  1 11:19:13 1998  Craig Burley  <burley@gnu.org>
+
+	Fix 980701-1.f (which was producing "unaligned trap"
+	on an Alpha running GNU/Linux, as predicted):
+	* equiv.c (ffeequiv_layout_local_): Don't bother
+	coping with pre-padding of entire area while building
+	it; do that instead after the building is done, and
+	do it by modifying only the modulo field.  This covers
+	the case of alignment stringency being increased without
+	lowering the starting offset, unlike the previous changes,
+	and even more elegantly than those.
+
+	* target.c (ffetarget_align): Make sure alignments
+	are nonzero, just in case.
+
+See ChangeLog.0 for earlier changes.
+
+Local Variables:
+add-log-time-format: current-time-string
+End:
diff --git a/gcc/f/ChangeLog.0 b/gcc/f/ChangeLog.0
new file mode 100644
index 00000000000..3d6675e5d37
--- /dev/null
+++ b/gcc/f/ChangeLog.0
@@ -0,0 +1,4806 @@
+Mon Jun 29 09:47:33 1998  Craig Burley  <burley@gnu.org>
+
+	Fix 980628-*.f:
+	* bld.h: New `pad' field and accessor macros for
+	ACCTER, ARRTER, and CONTER ops.
+	* bld.c (ffebld_new_accter, ffebld_new_arrter,
+	ffebld_new_conter_with_orig): Initialize `pad' field
+	to zero.
+	* com.c (ffecom_transform_common_): Include initial
+	padding (aka modulo aka offset) in size calculation.
+	Copy initial padding value into FFE initialization expression
+	so the GBE transformation of that expression includes it.
+	Make array low bound 0 instead of 1, for consistency.
+	(ffecom_transform_equiv_): Include initial
+	padding (aka modulo aka offset) in size calculation.
+	Copy initial padding value into FFE initialization expression
+	so the GBE transformation of that expression includes it.
+	Make array low bound 0 instead of 1, for consistency.
+	(ffecom_expr_, case FFEBLD_opACCTER): Delete unused `size'
+	variable.
+	Track destination offset separately, allowing for
+	initial padding.
+	Don't bother setting initial PURPOSE offset if zero.
+	Include initial padding in size calculation.
+	(ffecom_expr_, case FFEBLD_opARRTER): Allow for
+	initial padding.
+	Include initial padding in size calculation.
+	Make array low bound 0 instead of 1, for consistency.
+	(ffecom_finish_global_): Make array low bound 0 instead
+	of 1, for consistency.
+	(ffecom_notify_init_storage): Copy `pad' field from old
+	ACCTER to new ARRTER.
+	(ffecom_notify_init_symbol): Ditto.
+	* data.c (ffedata_gather_): Initialize `pad' field in new
+	ARRTER to 0.
+	(ffedata_value_): Ditto.
+	* equiv.c (ffeequiv_layout_local_): When lowering start
+	of equiv area, extend lowering to maintain needed alignment.
+	* target.c (ffetarget_align): Handle negative offset correctly.
+
+	* global.c (ffeglobal_pad_common): Warn about nonzero
+	padding only the first time its seen.
+	If new padding larger than old, update old.
+	(ffeglobal_save_common): Use correct type for size throughout.
+	* global.h: Use correct type for size throughout.
+	(ffeglobal_common_pad): New macro.
+	(ffeglobal_pad): Delete this unused and broken macro.
+
+Sat Jun 27 12:18:33 1998  Jeffrey A Law  (law@cygnus.com)
+
+	* Make-lang.in (g77): Depend on mkstemp.o.  Link in mkstemp.o.
+
+Fri Jun 26 11:54:19 1998  Craig Burley  <burley@gnu.org>
+
+	* g77spec.c (lang_specific_driver): Put `-lg2c' in
+	front of any `-lm' that is seen.
+
+Wed Jun 24 01:01:23 1998  Jeffrey A Law  (law@cygnus.com)
+
+	* g77spec.c (lang_specific_driver): Revert last change.
+
+Mon Jun 22 23:12:05 1998  H.J. Lu  (hjl@gnu.org)
+
+	* Make-lang.in (G77STAGESTUFF): Add g77.c.
+
+Fri Jun 19 07:54:40 1998  H.J. Lu  (hjl@gnu.org)
+
+	* g77spec.c (lang_specific_driver): Check n_infiles before
+	appending args.
+
+Mon Jun 15 23:39:24 1998  Craig Burley  <burley@gnu.org>
+
+	* Make-lang.in (f/g77.info): Use -f when removing
+	pre-existing Info files, if any.  (This rm command
+	can go away once makeinfo has been changed to delete
+	.info-N files beyond the last one it creates.)
+
+	* Make-lang.in ($(srcdir)/f/intdoc.texi): Compile
+	using $(INCLUDES) macro to get the new hconfig.h
+	and system.h headers.
+
+Mon Jun 15 22:21:57 1998  Craig Burley  <burley@gnu.org>
+
+	Cutover to system.h:
+	* Make-lang.in:
+	* Makefile.in:
+	* ansify.c:
+	* bad.c:
+	* bld.c:
+	* com.c:
+	* com.h:
+	* expr.c:
+	* fini.c:
+	* g77spec.c:
+	* implic.c:
+	* intdoc.c:
+	* intrin.c:
+	* lex.c:
+	* lex.h:
+	* parse.c:
+	* proj.c:
+	* proj.h:
+	* src.c:
+	* src.h:
+	* stb.c:
+	* ste.c:
+	* target.c:
+	* top.c:
+	* system.j: New file.
+
+	Use toplev.h where appropriate:
+	* Make-lang.in:
+	* Makefile.in:
+	* bad.c:
+	* bld.c:
+	* com.c:
+	* lex.c:
+	* ste.c:
+	* top.c:
+	* toplev.j: New file.
+
+	Conditionalize all dumping/reporting routines so they don't
+	get built for gcc/egcs:
+	* bld.c:
+	* bld.h:
+	* com.c:
+	* equiv.c:
+	* equiv.h:
+	* sta.c:
+	* stt.c:
+	* stt.h:
+	* symbol.c:
+	* symbol.h:
+
+	Use hconfig.h instead of config.h where appropriate:
+	* Makefile.in (proj-h.o): Compile with -DUSE_HCONFIG.
+	* fini.c: Define USE_HCONFIG before including proj.h.
+
+	* Makefile.in (deps-kinda): Redirect stderr to stdout,
+	to eliminate diagnostics vis-a-vis g77spec.c.
+
+	* Makefile.in: Regenerate dependencies via deps-kinda.
+
+	* lex.c (ffelex_file_fixed, ffelex_file_free): Eliminate
+	apparently spurious warnings about uninitialized variables
+	`c', `column', and so on.
+
+Sat Jun 13 03:13:18 1998  Craig Burley  <burley@gnu.org>
+
+	* g77spec.c (lang_specific_driver): Print out egcs
+	version info first, to be compatible with what some
+	test facilities expect.
+
+Wed Jun 10 13:17:32 1998  Dave Brolley  <brolley@cygnus.com>
+
+	* top.h (ffe_decode_option): New argc/argv interface.
+	* top.c (ffe_decode_option): New argc/argv interface.
+	* parse.c (yyparse): New argc/argv interface for ffe_decode_option.
+	* com.c (lang_decode_option): New argc/argv interface.
+
+Sun Jun  7 14:04:34 1998  Richard Henderson  <rth@cygnus.com>
+
+	* com.c (lang_init_options): New function.
+	* top.c (ffe_decode_option): Remove all trace of -fset-g77-defaults.
+	Set ffe_is_do_internal_checks_ with -version.
+	* lang-options.h: Likewise.
+	* lang-specs.h: Likewise.
+
+Fri Jun  5 15:53:17 1998  Per Bothner  <bothner@cygnus.com>
+
+	* g77spec.c (lang_specific_pre_link, lang_specific_extra_ofiles):
+	Define - update needed by gcc.c change.
+
+Mon Jun  1 19:37:42 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_init_0): Fix setup of INTEGER(KIND=7)
+	pointer type.
+	* info.c (ffeinfo_type): Don't crash on null type.
+	* expr.c (ffeexpr_fulfill_call_): Don't special-case
+	%LOC(expr) or LOC(expr).
+	Delete FFEGLOBAL_argsummaryPTR.
+	* global.c, global.h: Delete FFEGLOBAL_argsummaryPTR.
+
+Thu May 28 21:32:18 1998  Craig Burley  <burley@gnu.org>
+
+	Restore circa-0.5.22 capabilities of `g77' driver:
+	* Make-lang.in (g77spec.o): Depend on f/version.h.
+	(g77version.o): New rule to compile g77 version info.
+	(g77$(exeext)): Depend on and link in g77version.o.
+	* g77spec.c: Rewrite to be more like 0.5.22 version
+	of g77.c, making filtering of command line smarter
+	so mixed Fortran and C (etc.) can be compiled, verbose
+	version info can be obtained, etc.
+	* lang-specs.h (f77-version): New "language" to support
+	"g77 -v" command under new gcc 2.8 regime.
+	* lex.c (ffelex_file_fixed): If -fnull-version, just
+	substitute a "source file" that prints out version info.
+	* top.c, top.h: Support -fnull-version.
+
+	* lang-specs.h: Use "%O" instead of OO macro to specify
+	object extension.  Remove old stringizing cruft.
+
+	* Make-lang.in (g77.c, g77spec.o, g77.o, g77$(exeext),
+	g77-cross$(exeext), f771,
+	$(srcdir)/f/g77.info, $(srcdir)/f/g77.dvi,
+	$(srcdir)/f/intdoc.texi,
+	f77.install-common, f77.install-info, f77.install-man,
+	f77.uninstall, $(G77STAGESTUFF), f77.stage1, f77.stage2,
+	f77.stage3, f77.stage4, f77.distdir): Don't do anything
+	unless user specified "f77" or "F77" in $LANGUAGES either
+	during configuration or explicitly.  For convenience of
+	various tests and to work around lack of the assignment
+	"LANGUAGES=$(BOOT_LANGUAGES)" in the "make stage1" command
+	of "make bootstrap" in gcc, use a touch file named "lang-f77"
+	to communicate whether this is the case.
+
+	* Make-lang.in (F77_FLAGS_TO_PASS): Delete this macro,
+	replace with minimal expansion of its former self in
+	each of the two instances where it was used.
+
+	* Makefile.in (HOST_CC): Delete this definition.
+
+	* com.c (index, rindex): Delete these declarations.
+
+	* proj.h: (isascii): Delete this.
+
+	* Make-lang.in (f77.install-common): Warn if `f77-install-ok'
+	flag-file exists, since it no longer triggers any activity.
+
+	Rename libf2c.a and f2c.h to libg2c.a and g2c.h,
+	normalize and simplify g77/libg2c build process:
+	* Make-lang.in: Remove all support for overwriting
+	/usr/bin/f77 etc., or whatever the actual names are
+	via $(prefix) and $(local_prefix).  (g++ overwrites
+	/usr/bin/c++, but then it's often the only C++ compiler
+	on the system; f77 often exists on systems that are
+	installing g77.)
+	(f77.realclean): Remove obsolete target.
+	(g77.c, g77$(exeext)): Minor changes to look more like g++'s
+	stuff.
+	(f771): Now built with srcdir=gcc/f, not srcdir=gcc, to be
+	more like g++ and such.
+	(f/Makefile): Removed, as g++ doesn't need this rule.
+	(f77.install-common): No longer install f77, etc.
+	(f77.install-man): No longer install f77.1.
+	(f77.uninstall): No longer uninstall f77, f77.1, etc.
+	(f77.stage1, f77.stage2, f77.stage3, f77.stage4): Do work
+	only if "f77" appears in $(LANGUAGES).
+	(Note: gcc's Makefile.in's bootstrap target should set
+	LANGUAGES=$(BOOT_LANGUAGES) when making the stage1 target.)
+	* Makefile.in: Update vis-a-vis gcc/cp/Makefile.in.
+	(none): Remove.
+	(g77-only): Relocate.
+	(all.indirect, f771, *.o): Now assumes current directory
+	is this dir (gcc/f), not the parent directory.
+	(TAGS): Remove "echo 'parse.y,0'  >> TAGS ;" line.
+	* config-lang.in: Delete commented-out code.
+	Fix stagestuff definition.  Add more stuff to
+	diff_excludes definition.  Don't create any directories.
+	Set outputs to f/Makefile, to get variable substition
+	to happen (what does that really do, anyway?!).
+	* g77spec.c: Rename libf2c to libg2c.
+
+	* com.h: Remove all of the gcc back-end decls,
+	since egcs should have all of them correct.
+
+	* com.c: Include "proj.h" before anything else,
+	as that's how things are supposed to work.
+	* ste.c: Ditto.
+
+	* bad.c: Include "flags.j" here, since some diagnostics
+	check flag_pedantic_errors.
+
+	* Makefile.in (f/*.o): Rebuild dependencies via
+	deps-kinda.
+
+	* output.j: New source file.
+	* Make-lang.in (F77_SRCS): Update accordingly.
+	* Makefile.in (OUTPUT_H): Ditto.
+	(deps-kinda): Ditto.
+	* com.c: Include "output.j" here.
+	* lex.c: Ditto.
+
+Mon May 25 03:34:42 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_expr_): Fix D**I and Z**I cases to
+	not convert (DOUBLE PRECISION) D and (DOUBLE COMPLEX) Z
+	to INTEGER.  (This is dead code here anyway.)
+
+Sat May 23 06:32:52 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_finish_symbol_transform_): Don't transform
+	statement (nested) functions, to avoid gcc compiling them
+	and thus producing linker errors if they refer to undefined
+	external functions.  But warn if they're unused and -Wunused.
+	* bad.def (FFEBAD_SFUNC_UNUSED): New diagnostic.
+
+Wed May 20 12:12:55 1998  Craig Burley  <burley@gnu.org>
+
+	* Version 0.5.23 released.
+
+Tue May 19 14:52:41 1998  Craig Burley  <burley@gnu.org>
+
+	* bad.def (FFEBAD_OPEN_UNSUPPORTED, FFEBAD_INQUIRE_UNSUPPORTED,
+	FFEBAD_READ_UNSUPPORTED, FFEBAD_WRITE_UNSUPPORTED,
+	FFEBAD_QUAD_UNSUPPORTED, FFEBAD_BLOCKDATA_STMT,
+	FFEBAD_TRUNCATING_CHARACTER, FFEBAD_TRUNCATING_HOLLERITH,
+	FFEBAD_TRUNCATING_NUMERIC, FFEBAD_TRUNCATING_TYPELESS,
+	FFEBAD_TYPELESS_OVERFLOW): Change these from warnings
+	to errors.
+
+Tue May 19 14:51:59 1998  Craig Burley  <burley@gnu.org>
+
+	* Make-lang.in (f77.install-info, f77.uninstall):
+	Use install-info as appropriate.
+
+Tue May 19 12:56:54 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_init_0): Rename xargc to f__xargc,
+	in accord with same-dated change to f/runtime.
+
+Fri May 15 10:52:49 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_convert_narrow_, ffecom_convert_widen_):
+	Be even more persnickety in checking for internal bugs.
+	Also, if precision isn't changing, just return the expr.
+
+	* expr.c (ffeexpr_token_number_): Call
+	ffeexpr_make_float_const_ to make an integer.
+	(ffeexpr_make_float_const_): Handle making an integer.
+
+	* intrin.c (ffeintrin_init_0): Distinguish between
+	crashes on bad arg base and kind types.
+
+Fri May 15 01:44:22 1998  Mumit Khan <khan@xraylith.wisc.edu>
+
+	* Make-lang.in (f77.mostlyclean): Add missing exeext.
+
+Thu May 14 13:30:59 1998  Craig Burley  <burley@gnu.org>
+
+	* Make-lang.in (f/expr.c): Now depends on f/stamp-str.
+	* expr.c: Use ffestrOther in place of ffeexprDotdot_.
+	* str-ot.fin: Add more keywords for expr.c.
+
+	* intdoc.c (dumpimp): Trivial fix.
+
+	* com.c (ffecom_expr_): Add ltkt variable for clarity.
+
+Wed May 13 13:05:34 1998  Craig Burley  <burley@gnu.org>
+
+	* Make-lang.in (G77STAGESTUFF): Add g77.o, g77spec.o,
+	and g77version.o.
+	(f77.clean): Add removal of g77.c, g77.o, g77spec.o,
+	and g77version.o.
+	(f77.distclean): Delete removal of g77.c.
+
+Thu Apr 30 18:59:43 1998  Jim Wilson  <wilson@cygnus.com>
+
+	* Make-lang.in (g77.info, g77.dvi, BUGS, INSTALL, NEWS): Put -o
+	option before input file.
+
+Tue Apr 28 09:23:10 1998  Craig Burley  <burley@gnu.org>
+
+	Fix 980427-0.f:
+	* global.c (ffeglobal_ref_progunit_): When transitioning
+	from EXT to FUNC, discard hook, since the decl, if any, is
+	probably wrong.
+
+Sun Apr 26 09:05:50 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_char_enhance_arg_): Wrap the upper bound
+	(the PARM_DECL specifying the length of the CHARACTER*(*)
+	dummy arg) in a variable_size invocation, to prevent
+	dwarf2out.c crashing when compiling code with -g.
+
+Sat Apr 18 15:26:57 1998  Jim Wilson  <wilson@cygnus.com>
+
+	* g77spec.c (lang_specific_driver): New argument in_added_libraries.
+	New local added_libraries.  Increment count when add library to
+	arglist.
+
+Sat Apr 18 05:03:21 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_check_size_overflow_): Ignore overflow
+	as well if dummy argument.
+
+Fri Apr 17 17:18:04 1998  Craig Burley  <burley@gnu.org>
+
+	* version.h: Get rid of the overly large headers
+	here too, as done in version.c.
+
+Tue Apr 14 15:51:37 1998  Dave Brolley  <brolley@cygnus.com>
+
+	* com.c (init_parse): Now returns char* containing filename;
+
+Tue Apr 14 14:40:40 1998  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_start_progunit_): Mark function decl
+	as used, to avoid spurious warning (-Wunused) for ENTRY.
+
+Tue Apr 14 14:19:34 1998  Craig Burley  <burley@gnu.org>
+
+	* sta.c (ffesta_second_): Check for CASE DEFAULT
+	as well as CASE, or it won't be recognized.
+
+Thu Apr  9 00:18:44 1998  Dave Brolley  (brolley@cygnus.com)
+
+	* com.c (finput): New variable.
+	(init_parse): Handle !USE_CPPLIB.
+	(finish_parse): New function.
+	(lang_init): No longer declare finput.
+
+Sat Apr  4 17:45:01 1998  Richard Henderson  <rth@cygnus.com>
+
+	* com.c (ffecom_expr_): Revert Oct 22 change.  Instead take a WIDENP
+	argument so that we can respect the signedness of the original type.
+	(ffecom_init_0): Do sizetype initialization first.
+
+1998-03-28  Dave Love  <d.love@dl.ac.uk>
+
+	* Make-lang.in (f771$(exeext)): Fix typo.
+
+1998-03-24  Martin von Loewis  <loewis@informatik.hu-berlin.de>
+
+	* com.c (lang_print_xnode): New function.
+
+Mon Mar 23 21:20:35 1998  Craig Burley  <burley@gnu.org>
+
+	* version.c: Reduce to a one-line file, like
+	gcc's version.c, since there's really no content
+	there.
+
+Mon Mar 23 11:58:43 1998  Craig Burley  <burley@gnu.org>
+
+	* bugs.texi: Various updates.
+
+	* com.c (ffecom_tree_canonize_ptr_): Fix up spacing a bit.
+
+Sun Mar 22 00:50:42 1998  Nick Clifton  <nickc@cygnus.com>
+                          Geoff Noer    <noer@cygnus.com>
+
+	* Makefile.in: Various fixes for building cygwin32 native toolchains.
+	* Make-lang.in: Likewise.
+
+Mon Mar 16 21:20:35 1998  Craig Burley  <burley@gnu.org>
+
+	* expr.c (ffeexpr_sym_impdoitem_): Don't blindly
+	reset symbol info after calling ffesymbol_error,
+	to avoid crash.
+
+Mon Mar 16 15:38:50 1998  Craig Burley  <burley@gnu.org>
+
+	* Version 0.5.22 released.
+
+Mon Mar 16 14:36:02 1998  Craig Burley  <burley@gnu.org>
+
+	Make -g work better for ENTRY:
+	* com.c (ffecom_start_progunit_): Master function
+	for ENTRY-laden procedure is not really invented,
+	so it can be debugged.
+	(ffecom_do_entry_): Push/set/pop lineno for each
+	entry point.
+
+Sun Mar 15 05:48:49 1998  Craig Burley  <burley@gnu.org>
+
+	* intrin.def: Fix spelling of mixed-case form
+	of `CPU_Time' (was `Cpu_Time').
+
+Thu Mar 12 13:50:21 1998  Craig Burley  <burley@gnu.org>
+
+	* lang-options.h: Sort all -f*-intrinsics-* options,
+	for consistency with other g77 versions.
+
+Thu Mar 12 09:39:40 1998  Manfred Hollstein  <manfred@s-direktnet.de>
+
+	* lang-specs.h: Properly put brackets around array elements in initializer.
+
+1998-03-09  Dave Love  <d.love@dl.ac.uk>
+
+	* Make-lang.in: Set CONFIG_SITE to a non-existent file since
+	/dev/null loses with bash 2.0/autoconf 2.12.  Put
+	F77_FLAGS_TO_PASS before CC.
+
+Sun Mar  8 16:35:34 1998  Craig Burley  <burley@gnu.org>
+
+	* intrin.def: Use tabs instead of blanks more
+	consistently (excepting DEFGEN section for now).
+
+Wed Mar  4 17:38:21 1998  Jeffrey A Law  (law@cygnus.com)
+
+	* Make-lang.in: Remove more references to libf77.
+
+Tue Mar  3 10:52:35 1998  Manfred Hollstein  <manfred@s-direktnet.de>
+
+	* g77.texi: Use @url for citing URLs.
+
+Sat Feb 28 15:24:38 1998  Craig Burley  <burley@gnu.org>
+
+	* intrin.def: Make CPU_TIME's arg generic real to be just
+	like SECOND_subr.
+
+Fri Feb 20 12:45:53 1998  Craig Burley  <burley@gnu.org>
+
+	* expr.c (ffeexpr_token_arguments_): Make sure
+	outer exprstack isn't null.
+
+1998-02-16  Dave Love  <d.love@dl.ac.uk>
+
+	* Makefile.in (f/fini): Don't use -W -Wall with HOST_CC.
+
+Fri Feb 13 00:14:56 1998  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* com.c (type_for_mode): Add explicit braces to avoid ambiguous `else'.
+
+	* expr.c (ffeexpr_type_combine): Likewise.
+	(ffeexpr_reduce_): Likewise.
+	(ffeexpr_declare_parenthesized_): Likewise.
+
+	* src.c (ffesrc_strcmp_1ns2i): Likewise.
+	(ffesrc_strcmp_2c): Likewise.
+	(ffesrc_strncmp_2c): Likewise.
+
+	* stb.c (ffestb_halt1_): Likewise.
+	(ffestb_R90910_): Likewise.
+	(ffestb_R9109_): Likewise.
+
+	* stc.c (ffestc_R544_equiv_): Likewise.
+
+	* std.c (ffestd_subr_copy_easy_): Likewise.
+	(ffestd_R1001dump_): Likewise.
+	(ffestd_R1001dump_1005_1_): Likewise.
+	(ffestd_R1001dump_1005_2_): Likewise.
+	(ffestd_R1001dump_1005_3_): Likewise.
+	(ffestd_R1001dump_1005_4_): Likewise.
+	(ffestd_R1001dump_1005_5_): Likewise.
+	(ffestd_R1001dump_1010_2_): Likewise.
+
+	* ste.c (ffeste_R840): Likewise.
+
+	* sts.c (ffests_puttext): Likewise.
+
+	* symbol.c (ffesymbol_check_token_): Likewise.
+
+	* target.c (ffetarget_real1): Likewise.
+	(ffetarget_real2): Likewise.
+
+Wed Feb 11 01:44:48 1998  Richard Henderson  (rth@cygnus.com)
+
+	* com.c (ffecom_ptr_to_expr) [FFEBLD_opARRAYREF]:  Do upper - lower
+	in the native type, so as to properly handle negative indices.
+
+Tue Feb  3 20:13:05 1998  Richard Henderson  <rth@cygnus.com>
+
+	* config-lang.in: Remove references to runtime/.
+
+Sun Feb  1 12:43:49 1998  J"orn Rennecke <amylaar@cygnus.co.uk>
+
+	* com.c (ffecom_tree_canonize_ptr_): Place bitsizetype typed expr
+	as first agument in MULT_EXPR.
+	Use bitsize_int (0L, 0L) as zero for bitsizes.
+	(ffecom_tree_canonize_ref_):
+	Use bitsize_int (0L, 0L) as zero for bitsizes.
+	(ffecom_init_0): Use set_sizetype.
+
+Sun Feb  1 02:26:58 1998  Richard Henderson  <rth@cygnus.com>
+
+	* runtime directory -- moved into "libf2c" in the toplevel
+	directory.
+	* Make-lang.in: Remove all runtime related stuff.
+
+Sun Jan 25 12:32:15 1998  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in (f77.stage1): Depend on stage1-start so parallel
+ 	make works better.
+	* (f77.stage2): Likewise for stage2-start.
+	* (f77.stage3): Likewise for stage3-start.
+	* (f77.stage4): Likewise for stage4-start.
+
+Sat Jan 17 21:28:08 1998  Pieter Nagel <pnagel@epiuse.co.za>
+
+	* Makefile.in (FLAGS_TO_PASS): Pass down gcc_include_dir and
+	local_prefix to sub-make invocations.
+
+Tue Jan 13 22:07:54 1998  Jeffrey A Law  (law@cygnus.com)
+
+	* lang-options.h: Add missing options.
+
+Sun Jan 11 02:14:47 1998  Craig Burley  <burley@gnu.org>
+
+	Support FORMAT(I<1+2>) (constant variable-FORMAT
+	expressions):
+	* bad.def (FFEBAD_FORMAT_VARIABLE): New diagnostic.
+	* std.c (ffestd_R1001rtexpr_): New function.
+	(ffestd_R1001dump_, ffestd_R1001dump_1005_1_,
+	ffestd_R1001dump_1005_2_, ffestd_R1001dump_1005_3_,
+	ffestd_R1001dump_1005_4_, ffestd_R1001dump_1005_5_,
+	ffestd_R1001dump_1010_2_, ffestd_R1001dump_1010_3_,
+	ffestd_R1001dump_1010_4_, ffestd_R1001dump_1010_5_):
+	Use new function instead of ffestd_R1001error_.
+
+	* stb.c (ffestb_R10014_, ffestb_R10016_, ffestb_R10018_,
+	ffestb_R100110_): Restructure `for' loop for style.
+
+	Fix 970626-2.f by not doing most back-end processing
+	when current_function_decl is an ERROR_MARK, and by
+	making that the case when its type would be an ERROR_MARK:
+	* com.c (ffecom_start_progunit_, finish_function,
+	lang_printable_name, start_function,
+	ffecom_finish_symbol_transform_): Test for ERROR_MARK.
+	* std.c (ffestd_stmt_pass_): Don't do any downstream
+	processing if ERROR_MARK.
+
+	* Make-lang.in (f77.install-common): Don't install, and
+	don't uninstall existing, Info files if f/g77.info
+	doesn't exit.  (This is a somewhat modified version
+	of an egcs patch on 1998-01-07 12:05:51 by Bruno Haible
+	<bruno@linuix.mathematik.uni-karlsruhe.de>.)
+
+Fri Jan  9 19:09:07 1998  Craig Burley  <burley@gnu.org>
+
+	Fix -fpedantic combined with `F()' invocation,
+	also -fugly-comma combined with `IARGC()' invocation:
+	* bad.def (FFEBAD_NULL_ARGUMENT_W): New diagnostic.
+	* expr.c (ffeexpr_finished_): Don't reject null expressions
+	in the argument-expression context -- let outer context
+	handle that.
+	(ffeexpr_token_arguments_): Warn about null expressions
+	here if -fpedantic (as appropriate).
+	Obey -fugly-comma for only external-procedure invocations.
+	* intrin.c (ffeintrin_check_): No longer ignore explicit
+	omitted trailing args.
+
+Tue Dec 23 14:58:04 1997  Craig Burley  <burley@gnu.org>
+
+	* intrin.c (ffeintrin_fulfill_generic): Don't generate
+	FFEBAD_INTRINSIC_TYPE for CHARACTER*(*) intrinsic.
+
+	* com.c (ffecom_gfrt_basictype):
+	(ffecom_gfrt_kindtype):
+	(ffecom_make_gfrt_):
+	(FFECOM_rttypeVOIDSTAR_): New return type `void *', for
+	the SIGNAL intrinsic.
+	* com-rt.def (FFECOM_rttypeSIGNAL): Now returns `void *'.
+	* intdoc.c: Replace `p' kind specifier with `7'.
+	* intrin.c (ffeintrin_check_, ffeintrin_init_0): Replace
+	`p' kind specifier with `7'.
+	* intrin.def (FFEINTRIN_impLOC, FFEINTRIN_impSIGNAL_func,
+	FFEINTRIN_impSIGNAL_subr): Replace `p' specifier with `7'.
+	Also, SIGNAL now returns a `void *' status, not `int'.
+
+	Improve run-time diagnostic for "PRINT '(I1', 42":
+	* com.c (ffecom_char_args_x_): Renamed from ffecom_char_args_,
+	which is now a macro (to avoid lots of changes to other code)
+	with new arg, ffecom_char_args_with_null_ being another new
+	macro to call same function with different value for new arg.
+	This function now appends a null byte to opCONTER expression
+	if the new arg is TRUE.
+	(ffecom_arg_ptr_to_expr): Support NULL length pointer.
+	* ste.c (ffeste_io_cilist_):
+	(ffeste_io_icilist_): Pass NULL length ptr for
+	FORMAT expression, so null byte gets appended where
+	feasible.
+	* target.c (ffetarget_character1):
+	(ffetarget_concatenate_character1):
+	(ffetarget_substr_character1):
+	(ffetarget_convert_character1_character1):
+	(ffetarget_convert_character1_hollerith):
+	(ffetarget_convert_character1_integer4):
+	(ffetarget_convert_character1_logical4):
+	(ffetarget_convert_character1_typeless):
+	(ffetarget_hollerith): Append extra phantom null byte as
+	part of FFETARGET-NULL-BYTE kludge.
+
+	* intrin.def (FFEINTRIN_impCPU_TIME): Point to
+	FFECOM_gfrtSECOND as primary run-time routine.
+
+Mon Dec 22 12:41:07 1997  Craig Burley  <burley@gnu.org>
+
+	* intrin.c (ffeintrin_init_0): Remove duplicate
+	check for `!'.
+
+Fri Dec 19 00:12:01 1997  Richard Henderson  <rth@cygnus.com>
+
+	* com.c (ffecom_sym_transform_): Assumed arrays have no upper bound.
+
+Mon Dec 15 17:35:35 1997  Richard Henderson  <rth@cygnus.com>
+
+	* com.c (ffecom_type_vardesc_): Vardesc.dims is a `ftnlen*'.
+
+Sun Dec 14 02:49:58 1997  Craig Burley  <burley@gnu.org>
+
+	* intrin.c (ffeintrin_init_0): Fix up indentation a bit.
+	Fix bug that prevented checking of arguments other
+	than the first.
+
+	* intdoc.c: Fix up indentation a bit.
+
+Tue Dec  9 16:20:57 1997  Richard Henderson  <rth@cygnus.com>
+
+	* com.c (ffecom_type_vardesc_): Vardesc.dims is a `ftnlen*'.
+
+Tue Dec  2 09:57:16 1997  Jeffrey A Law  (law@cygnus.com)
+
+	* Make-lang.in (f77.clean): Remove g77.c.
+
+Mon Dec  1 19:12:36 1997  Craig Burley  <burley@gnu.org>
+
+	* intrin.c (ffeintrin_check_): Fix up indentation a bit more.
+
+Mon Dec  1 16:21:08 1997  Craig Burley  <burley@gnu.org>
+
+	* com.c (ffecom_arglist_expr_): Crash if non-supplied
+	optional arg isn't passed as an address.
+	Pass null pointer explicitly, instead of via ffecom routine.
+	If incoming argstring is NULL, substitute pointer to "0".
+	Recognize '0' as ending the usual arg stuff, just like '\0'.
+
+Sun Nov 30 22:22:22 1997  Craig Burley  <burley@gnu.org>
+
+	* intdoc.c: Minor fix-ups.
+
+	* intrin.c (ffeintrin_check_): Fix up indentation a bit.
+
+	* intrin.def: Fix up spacing a bit.
+
+Tue Nov 25 15:33:28 1997  Jeffrey A Law  (law@cygnus.com)
+
+	* Make-lang.in (f77.all.build): Add $(exeext) to binary files.
+	(f77.all.cross, f77.start.encap): Simliarly.
+
+Fri Nov 21 09:35:20 1997  Fred Fish  <fnf@cygnus.com>
+
+	* Make-lang.in (stmp-f2c.h): Move inclusion of F77_FLAGS_TO_PASS
+	to before override of CC so that the override works.
+
+Thu Nov 20 00:58:14 1997  H.J. Lu  (hjl@gnu.ai.mit.edu)
+
+	* Make-lang.in (f77.install-info): Depend on f77.info.
+
+1997-11-17  Dave Love  <d.love@dl.ac.uk>
+
+	* com.c (ffecom_arglist_expr_): Pass null pointers for optional
+	args which aren't supplied.
+
+Sun Nov 16 21:45:43 1997  H.J. Lu  (hjl@gnu.ai.mit.edu)
+
+	* Make-lang.in (f77.install-info): Depend on f77.info.
+
+1997-11-14  Dave Love  <d.love@dl.ac.uk>
+
+	* intrin.def: Supply gfrt for CPU_TIME.  Generalize arg types of
+	INT2, INT8, per doc.
+
+1997-11-06  Dave Love  <d.love@dl.ac.uk>
+
+	* intrin.def: Allow non-integer args for INT2 and INT8 (per
+	documentation).
+
+Sun Nov  2 19:49:51 1997  Richard Henderson  <rth@cygnus.com>
+
+	* com.c (ffecom_expr_): Only use TREE_TYPE argument for simple
+	arithmetic; convert types as necessary; recurse with target tree type.
+
+Tue Oct 28 02:21:25 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* lang-options.h: Add -fgnu-intrinsics-* and
+	-fbadu77-intrinsics-* options.
+
+Sun Oct 26 02:36:21 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (lang_print_error_function): Fix to more
+	reliably notice when the diagnosed region changes.
+
+Sat Oct 25 23:43:36 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Fix 950327-0.f:
+	* sta.c, sta.h (ffesta_outpooldisp): New function.
+	* std.c (ffestd_stmt_pass_): Don't kill NULL pool.
+	(ffestd_R842): If pool already preserved, save NULL
+	for pool, because it should be killed only once.
+
+	* malloc.c [MALLOC_DEBUG]: Put initializer for `name'
+	component in braces, to avoid compiler warning.
+
+Wed Oct 22 11:37:41 1997  Richard Henderson  <rth@cygnus.com>
+
+	* com.c (ffecom_expr_): Take an new arg TREE_TYPE that if non-null
+	specifies the type in which to do the calculation.  Change all callers.
+	[FFEBLD_opARRAYREF]: Force the index expr to use sizetype.
+
+Thu Oct 16 02:04:08 1997  Paul Koning <pkoning@xedia.com>
+
+	* Make-lang.in (stmp-f2c.h): Don't configure the runtime
+	directory if LANGUAGES does not include f77.
+
+Mon Oct 13 12:12:41 1997  Richard Henderson  <rth@cygnus.com>
+
+	* Make-lang.in (g77*): Copied from cp/Make-lang.in g++*.
+	* g77spec.c: New file, mostly copied from g++spec.c
+	* g77.c: Removed.
+
+Fri Oct 10 13:00:48 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* ste.c (ffeste_begin_iterdo_): Fix loop setup so iteration
+	variable is modified only after the #iterations is calculated;
+	otherwise if the iteration variable is aliased to any of the
+	operands in the start, end, or increment expressions, the
+	wrong #iterations might be calculated.
+
+	* com.c (ffecom_save_tree): Fix indentation.
+
+Mon Oct  6 14:15:03 1997  Jeffrey A Law  (law@cygnus.com)
+
+	* Make-lang.in (f77.mostlyclean): Clean up stuff in the
+	object tree too.
+	(f77.clean, f77.distclean, f77.maintainer-clean): Likewise.
+
+1997-10-05  Dave Love  <d.love@dl.ac.uk>
+
+	* intrin.def: Make SECOND_subr's arg generic real for people
+	porting from Cray and making everything double precision.
+
+Wed Oct  1 01:45:36 1997  Philippe De Muyter  <phdm@info.ucl.ac.be>
+
+	* g77.c (pexecute, main): Use unlink, not remove.
+
+Mon Sep 29 16:18:21 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* stu.c (ffestu_list_exec_transition_,
+	ffestu_dummies_transition_): Specify `bool' type for
+	`in_progress' variables.
+
+	* com.h (assemble_string): Declare this routine (instead
+	of #include'ing "output.h" from gcc) to eliminate warnings
+	from lex.c.
+
+Mon Sep 29 10:37:07 1997  Jeffrey A Law  (law@cygnus.com)
+
+	* intdoc.c (main): Remove unused attribute for main's arguments.
+
+Sun Sep 28 01:47:17 1997  Jeffrey A Law  (law@cygnus.com)
+
+	* Make-lang.in (G77_FLAGS_TO_PASS): Pass down RANLIB, RANLIB_TEST
+	and AR instead of the _FOR_TARGET versions.
+
+Tue Sep 23 00:39:57 1997  Alexandre Oliva <oliva@dcc.unicamp.br>
+
+	* Make-lang.in: install.texi was renamed to g77install.texi
+	* install0.texi: Likewise.
+
+Fri Sep 19 01:12:27 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* expr.c (ffeexpr_reduced_eqop2_):
+	(ffeexpr_reduced_relop2_): Minor fixes to diagnostic code.
+
+	* fini.c (main): Change return type to `int'.
+
+Thu Sep 18 17:31:38 1997  Jeffrey A Law  (law@cygnus.com)
+
+	* proj.h (FFEPROJ_BSEARCH): Delete all references.
+	(FFEPROJ_STRTOUL): Likewise.
+	* proj.c (bsearch): Compile this if no bsearch is provided by the
+	host system.
+	(strtoul): Similarly.
+
+	* g77install.texi: Renamed from install.texi
+	* g77.texi: Corresponding changes.
+
+	* fini.c (main): Return type is int.
+
+	* com.c (lang_printable_name): Use verbosity argument.
+
+Thu Sep 18 16:08:40 1997  Jeffrey A Law  (law@cygnus.com)
+
+	* Make-lang.in: Fix merge problems.
+
+Wed Sep 17 10:47:08 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com-rt.def (FFECOM_gfrtDSIGN, FFECOM_gfrtISIGN,
+	FFECOM_gfrtSIGN): Add second argument.
+
+	* expr.c (ffeexpr_cb_comma_c_): Trivial fixes.
+
+Sun Sep 14 21:01:23 1997  Jeffrey A Law  (law@cygnus.com)
+
+        * Make-lang.in: Various changes to build info files
+        in the object tree rather than the source tree.
+
+	* proj.h: Include ctype.h.
+
+Sun Sep 14 12:35:20 1997  Fred Fish (fnf@ninemoons.com)
+
+	* proj.h (isascii): Provide a default definition if none is available.
+
+Thu Sep 11 19:26:10 1997  Dave Love <d.love@dl.ac.uk>
+
+	* config-lang.in: Remove the messages about possible build problems.
+
+Wed Sep 10 16:39:47 1997  Jim Wilson  <wilson@cygnus.com>
+
+	* Make-lang.in (LN, LN_S): New macros, use where appropriate.
+
+Tue Sep  9 13:20:40 1997  Jim Wilson  <wilson@cygnus.com>
+
+	* g77.c (pexecute, doit): Add checks for __CYGWIN32__.
+
+Tue Sep  9 01:59:35 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Version 0.5.21 released.
+
+Tue Sep  9 00:31:01 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* intdoc.c (dumpem): Put appropriate commentary in
+	output file, so readers know it isn't source.
+
+Wed Aug 27 20:32:03 1997  Jeffrey A Law  (law@cygnus.com)
+
+	* top.c (ffe_decode_option): Turn on flag_move_all_moveables
+	and flag_reduce_all_givs.
+
+Wed Aug 27 08:08:25 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* proj.h: Always #include "config.j" first, to pick up
+	gcc's configuration.
+	* com.c: Change bcopy() and bzero() calls to memcpy()
+	and memset() calls, to make more of g77 ANSI C.
+
+1997-08-26  Dave Love  <d.love@dl.ac.uk>
+
+	* Make-lang.in ($(srcdir)/f/runtime/configure,
+ 	$(srcdir)/f/runtime/libU77/configure): Fix for when srcdir isn't
+ 	relative.
+
+Tue Aug 26 05:59:21 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* ansify.c (main): Make sure readers of stdout know
+	it's derived from stdin; omit comment text; get source
+	line numbers in future stderr output to be correct.
+
+Tue Aug 26 01:36:01 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Fix 970825-0.f:
+	* stb.c (ffestb_R5284_): Allow OPEN_PAREN after closing
+	SLASH as well as NAME.
+
+Mon Aug 25 23:48:17 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Changes to allow g77 docs to be built entirely from scratch
+	using any ANSI C compiler, not requiring GNU C:
+	* Make-lang.in ($(srcdir)/f/intdoc.texi): "Pipe" new
+	location of intrinsic documentation data base, f/intdoc.in,
+	through new `ansify' program to append `\n\' to quoted
+	newlines, into f/intdoc.h0.  Do appropriate cleanups.  Explain.
+	(f77.mostlyclean): Add f/ansify and f/intdoc.h0 to cleanups.
+	* f/ansify.c: New program.
+	* f/intdoc.c: Fix so it conforms to ANSI C.
+	#include f/intdoc.h0 instead of f/intdoc.h.
+	Avoid some warnings.
+	* f/intdoc.h, f/intdoc.in: Rename the former to the latter; no
+	changes made to the content in this patch!
+	* f/intrin.h (ffeintrinFamily): Fix to conform to ANSI C.
+
+Mon Aug 25 23:24:32 1997  H.J. Lu  (hjl@gnu.ai.mit.edu)
+
+	* Make-lang.in ($(srcdir)/f/runtime/configure,
+	$(srcdir)/f/runtime/libU77/configure, f77.mostlyclean,
+	f77.clean, f77.distclean, f77.maintainer-clean, f77.realclean):
+	Handle absolute pathname of $(srcdir).
+	(stmp-f2c.h): New.
+	(include/f2c.h, f/runtime/Makefile, f/runtime/libF77/Makefile,
+	f/runtime/libI77/Makefile, f/runtime/libU77/Makefile): Only
+	depend on stmp-f2c.h.
+	(f77.maintainer-clean): Don't make itself.
+
+Sun Aug 24 17:00:27 1997  Jim Wilson  <wilson@cygnus.com>
+
+	* Make-lang.in (f77.install-info): Don't cd into srcdir.  Add srcdir
+	to filenames.  Use sed to extract base filename for install.
+
+Sun Aug 24 06:52:48 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Fix up g77 compiler data base for libf2c routines:
+	* com-rt.def (FFECOM_gfrtSIGNAL): Change return type to
+	FTNINT to match actual code.
+
+	* com.c (ffecomRttype_): Replace FFECOM_rttypeINT_ with
+	FFECOM_rttypeFTNINT_.
+	Add and fix up comments.
+	(ffecom_make_gfrt_, ffecom_gfrt_basictype,
+	ffecom_gfrt_kindtype): Replace FFECOM_rttypeINT_ with
+	FFECOM_rttypeFTNINT_; add FFECOM_rttypeDOUBLEREAL_.
+
+Thu Aug 21 13:15:29 1997  Jim Wilson  <wilson@cygnus.com>
+
+	* Make-lang.in (f77): Delete f77-runtime.
+	(f77.all.build, f77.all.cross, f77.rest.encap): Add f77-runtime.
+
+Wed Aug 20 17:18:40 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* global.c (ffeglobal_ref_progunit_): It's okay to have
+	a different CHARACTER*n length for a reference if the
+	existing length is for another reference, not a definition.
+
+Wed Aug 20 16:36:59 1997  Jim Wilson  <wilson@cygnus.com>
+
+	* intdoc.texi: Readd generated file.
+
+Mon Aug 18 14:27:18 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Fix 970814-0.f:
+	* global.c (ffeglobal_new_progunit_): Distinguish
+	between previously defined, versus inferred, filewide
+	when it comes to diagnostics.
+
+	Fix 970816-1.f:
+	* global.c (ffeglobal_ref_progunit_): Change BDATA into EXT
+	right at the beginning, so EXTERNAL FOO followed later
+	by SUBROUTINE FOO is not diagnosed.
+
+	Fix 970813-0.f:
+	* com-rt.def (FFECOM_gfrtALARM): Returns `integer', not
+	`void'.
+
+Mon Aug 18 09:01:54 1997  Jeffrey A Law  (law@cygnus.com)
+
+	* Makefile.in (F77_OBJS): Re-alphabetize.
+	* Make-lang.in (F77_SRCS): Likewise.
+
+Sun Aug 17 08:35:11 1997  Jeffrey A Law  (law@cygnus.com)
+
+	* INSTALL: Rebuilt.
+	* install.texi: Remove "Object File Differences" section.  Remove
+	all references to zzz.o failing comparison tests.
+	* version.c, version.h: Renamed from zzz.c and zzz.h.  Remove
+	date and time stamps so a 3 stage build reports no differences.
+	* Make-lang.in: Corresponding changes.
+	* Makefile.in: Likewise.
+	* g77.c, parse.c: Likewise.
+
+	* intdoc.texi: Remove generated file from distribution.
+
+Sun Aug 17 03:32:44 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Fix up problems when virtual memory exhausted:
+	* malloc.c (malloc_new_): Use gcc's xmalloc(), so we
+	print a nicer message when malloc returns no memory.
+	(malloc_resize_): Ditto for xrealloc().
+
+	* Make-lang.in, Makefile.in: Comment out lines containing
+	just formfeeds.
+
+Sat Aug 16 19:41:33 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_make_gfrt_): For rttypeREAL_F2C_, return
+	double_type_node; for rttypeREAL_GNU_, return
+	_real_type_node.
+
+1997-08-13  Dave Love  <d.love@dl.ac.uk>
+
+	* config-lang.in (diff_excludes): Add some hints about known
+	problematic platforms.
+
+1997-08-13  Dave Love  <d.love@dl.ac.uk>
+
+	* intdoc.h: Document `alarm'.
+
+Tue Aug 12 10:23:02 1997  Jeffrey A Law  (law@cygnus.com)
+
+	* config-lang.in: Don't demand the backend patch.
+	* com.c (lang_printable_name): Second argument is now an int.  Don't
+	store into the value of the second argument.
+	* top.c (ffe_decode_option): Temporarily disable setting
+	of "Toon" loop options until we figure out how to address
+	them.
+
+Mon Aug 11 23:18:35 1997  Jeffrey A Law  (law@cygnus.com)
+
+	* g77-0.5.21-19970811 Imported.
+	This file describes changes to the front end necessary to make
+	it work with egcs.
+
+Mon Aug 11 21:19:22 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Make-lang.in ($(RUNTIMESTAGESTUFF)): Add
+	f/runtime/stamp-lib.
+
+Mon Aug 11 01:52:03 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_build_complex_constant_): Go with the
+	new build_complex() approach used in gcc-2.8.
+
+	* com.c (ffecom_sym_transform_): Don't set
+	DECL_IN_SYSTEM_HEADER for a tree node that isn't
+	a VAR_DECL, which happens when var is in common!
+
+	* com.c (ffecom_expr_intrinsic_) (case FFEINTRIN_impALARM):
+	No need to test codegen_imp -- there's only one valid here.
+
+	* intrin.def (FFEINTRIN_impALARM): Specify `Status' argument
+	as write-only.
+
+Fri Aug  8 05:40:23 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Substantial changes to accommodate distinctions among
+	run-time routines that support intrinsics, and between
+	routines that compute and return the same type vs. those
+	that compute one type and return another (or `void'):
+	* com-rt.def: Specify new return type REAL_F2C_ instead
+	of many DOUBLE_, COMPLEX_F2C_ instead of COMPLEX_, and
+	so on.
+	Clear up the *BES* routines "once and for all".
+	* com.c: New return types.
+	(ffecom_convert_narrow_, ffecom_convert_widen_):
+	New functions that are "safe" variants of convert(),
+	to catch errors that ffecom_expr_intrinsic_() now
+	no longer catches.
+	(ffecom_arglist_expr_): Ensure arguments are not
+	converted to narrower types.
+	(ffecom_call_): Ensure return value is not converted
+	to a wider type.
+	(ffecom_char_args_): Use new ffeintrin_gfrt_direct()
+	routine.
+	(ffecom_expr_intrinsic_): Simplify how run-time
+	routine is selected (via `gfrt' only now; lose the
+	redundant `ix' variable).
+	Eliminate the `library' label; any code that doesn't
+	return directly just `break's out now with `gfrt'
+	set appropriately.
+	Set `gfrt' to default choice initially, either a
+	fast direct form or, if not available, a slower
+	indirect-callable form.
+	(ffecom_make_gfrt_): No longer need to do special
+	check for complex; it's built into the new return-type
+	regime.
+	(ffecom_ptr_to_expr): Use new ffeintrin_gfrt_indirect()
+	routine.
+	* intrin.c, intrin.h: `gfrt' field replaced with three fields,
+	so it is easier to provide faster direct-callable and
+	GNU-convention indirect-callable routines in the future.
+	DEFIMP macro adjusted accordingly, along with all its uses.
+	(ffeintrin_gfrt_direct): New function.
+	(ffeintrin_gfrt_indirect): Ditto.
+	(ffeintrin_is_actualarg): If `-fno-f2c' is in effect,
+	require a GNU-callable version of intrinsic instead of
+	an f2c-callable version, so indirect calling is still checked.
+	* intrin.def: Replace one GFRT field with the three new fields,
+	as appropriate for each DEFIMP intrinsic.
+
+	* com.c (ffecom_stabilize_aggregate_,
+	ffecom_convert_to_complex_): Make these `static'.
+
+Thu Aug  7 11:24:34 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Provide means for front end to determine actual
+	"standard" return type for an intrinsic if it is
+	passed as an actual argument:
+	* com.h, com.c (ffecom_gfrt_basictype,
+	ffecom_gfrt_kindtype): New functions.
+	(ffecom_gfrt_kind_type_): Replaced with new function.
+	All callers updated.
+	(ffecom_make_gfrt_): No longer need do anything
+	with kind type.
+
+	* intrin.c (ffeintrin_basictype, ffeintrin_kindtype):
+	Now returns correct type info for specific intrinsic
+	(based on type of run-time-library implementation).
+
+Wed Aug  6 23:08:46 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* global.c (ffeglobal_ref_progunit_): Don't reset
+	number of arguments just due to new type info,
+	so useful warnings can be issued.
+
+1997-08-06  Dave Love  <d.love@dl.ac.uk>
+
+	* intrin.def: Fix IDATE_vxt argument order.
+	* intdoc.h: Likewise.
+
+Thu Jul 31 22:22:03 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* global.c (ffeglobal_proc_ref_arg): If REF/DESCR
+	disagreement, DESCR is CHARACTER, and types disagree,
+	pretend the argsummary agrees so the message ends up
+	being about type disagreement.
+	(ffeglobal_proc_def_arg): Ditto.
+
+	* expr.c (ffeexpr_token_first_rhs_3_): Set info for LABTOK
+	to NONE of everything, to avoid misdiagnosing filewide
+	usage of alternate returns.
+
+Sun Jul 20 23:07:47 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_sym_transform_): If type gets set
+	to error_mark_node, just return that for transformed symbol.
+	(ffecom_member_phase2_): If type gets set to error_mark_node,
+	just return.
+	(ffecom_check_size_overflow_): Add `dummy' argument to
+	flag that type is for a dummy, update all callers.
+
+Sun Jul 13 17:40:53 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Fix 970712-1.f:
+	* where.c (ffewhere_set_from_track): If start point
+	is too large, just use initial start point.  0.6 should
+	fix all this properly.
+
+	Fix 970712-2.f:
+	* com.c (ffecom_sym_transform_): Preserve error_mark_node for type.
+	(ffecom_type_localvar_): Ditto.
+	(ffecom_sym_transform_): If type is error_mark_node,
+	don't error-check decl size, because back end responds by
+	setting that to an integer 0 instead of error_mark_node.
+	(ffecom_transform_common_): Same as earlier fix to _transform_
+	in that size is checked by dividing BITS_PER_UNIT instead of
+	multiplying.
+	(ffecom_transform_equiv_): Ditto.
+
+	Fix 970712-3.f:
+	* stb.c (ffestb_R10014_): Fix flaky fall-through in error
+	test for FFELEX_typeCONCAT by just replicating the code,
+	and do FFELEX_typeCOLONCOLON while at it.
+
+1997-07-07  Dave Love  <d.love@dl.ac.uk>
+
+	* intdoc.h: Add various missing pieces; correct GMTIME, LTIME
+	result ordering.
+
+	* intrin.def, com-rt.def: Add alarm.
+
+	* com.c (ffecom_expr_intrinsic_): Add case for alarm.
+
+Thu Jun 26 04:19:40 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Fix 970302-3.f:
+	* com.c (ffecom_sym_transform_): For sanity-check compare
+	of gbe size of local variable to g77 expectation,
+	use varasm.c/assemble_variable technique of dividing
+	BITS_PER_UNIT out of gbe info instead of multiplying
+	g77 info up, to avoid crash when size in bytes is very
+	large, and overflows an `int' or similar when multiplied.
+
+	Fix 970626-2.f:
+	* com.c (ffecom_finish_symbol_transform_): Don't bother
+	transforming a dummy argument, to avoid a crash.
+	* ste.c (ffeste_R1227): Don't return a value if the
+	result decl, or its type, is error_mark_node.
+
+	Fix 970626-4.f:
+	* lex.c (ffelex_splice_tokens): `-fdollar-ok' is
+	irrelevant to whether a DOLLAR token should be made
+	from an initial character of `$'.
+
+	Fix 970626-6.f:
+	* stb.c (ffestb_do3_): DO iteration variable is an
+	lhs, not rhs, expression.
+
+	Fix 970626-7.f and 970626-8.f:
+	* expr.c (ffeexpr_cb_comma_i_1_): Set IMPDO expression
+	to have clean info, because undefined rank, for example,
+	caused crash on mangled source on UltraSPARC but not
+	on Alpha for a series of weird reasons.
+	(ffeexpr_cb_close_paren_): If not CLOSE_PAREN, push
+	opANY expression onto stack instead of attempting
+	to mimic what program might have wanted.
+	(ffeexpr_cb_close_paren_): Don't wrap opPAREN around
+	opIMPDO, just warn that it's gratuitous.
+	* bad.def (FFEBAD_IMPDO_PAREN): New warning.
+
+	Fix 970626-9.f:
+	* expr.c (ffeexpr_declare_parenthesized_): Must shut down
+	parsing in kindANY case, otherwise the parsing engine might
+	decide there's an ambiguity.
+	(ffeexpr_token_name_rhs_): Eliminate parentypeSUBROUTINE_
+	case, so we crash right away if it comes through.
+	* st.c, st.h, sta.c, sta.h (ffest_shutdown, ffesta_shutdown):
+	New functions.
+
+Tue Jun 24 19:47:29 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_check_size_overflow_): New function
+	catches some cases of the size of a type getting
+	too large.  varasm.c must catch the rest.
+	(ffecom_sym_transform_): Use new function.
+	(ffecom_type_localvar_): Ditto.
+
+Mon Jun 23 01:09:28 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* global.c (ffeglobal_proc_def_arg): Fix comparison
+	of argno to #args.
+	(ffeglobal_proc_ref_arg): Ditto.
+
+	* lang-options.h, top.c: Rename `-fdebug' to `-fxyzzy',
+	since it's an unsupported internals option and some
+	poor user might guess that it does something.
+
+	* bad.def: Make a warning for each filewide diagnostic.
+	Put all filewides together.
+	* com.c (ffecom_sym_transform_): Don't substitute
+	known global tree for global entities when `-fno-globals'.
+	* global.c (ffeglobal_new_progunit_): Don't produce
+	fatal diagnostics about globals when `-fno-globals'.
+	Instead, produce equivalent warning when `-Wglobals'.
+	(ffeglobal_proc_ref_arg): Ditto.
+	(ffeglobal_proc_ref_nargs): Ditto.
+	(ffeglobal_ref_progunit_): Ditto.
+	* lang-options.h, top.c, top.h: New `-fno-globals' option.
+
+Sat Jun 21 12:32:54 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* expr.c (ffeexpr_fulfill_call_): Set array variable
+	to avoid warning about uninitialized variable.
+
+	* Make-lang.in: Get rid of any setting of HOST_* macros,
+	since these will break gcc's build!
+	* makefile: New file to make building derived files
+	easier.
+
+Thu Jun 19 18:19:28 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* g77.c (main): Install Emilio Lopes' patch to support
+	Ratfor, and to fix the printing of the version string
+	to go to stderr, not stdout.
+	* lang-specs.h: Install Emilio Lopes' patch to support
+	Ratfor, and patch the result to support picking up
+	`*f771' from the `specs' file.
+
+Thu Jun 12 14:36:25 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* storag.c (ffestorag_update_init, ffestorag_update_save):
+	Also update parent, in case equivalence processing
+	has already eliminated pointers to it via the
+	local equivalence info.
+
+Tue Jun 10 14:08:26 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* intdoc.c: Add cross-reference to end of description
+	of any generic intrinsic pointing to other intrinsics
+	with the same name.
+
+	Warn about explicit type declaration for intrinsic
+	that disagrees with invocation:
+	* expr.c (ffeexpr_paren_rhs_let_): Preserve type info
+	for intrinsic functions.
+	(ffeexpr_token_funsubstr_): Ditto.
+	* intrin.c (ffeintrin_fulfill_generic): Warn if type
+	info of fulfilled intrinsic invocation disagrees with
+	explicit type info given symbol.
+	(ffeintrin_fulfill_specific): Ditto.
+	* stc.c (ffestc_R1208_item): Preserve type info
+	for intrinsics.
+	(ffestc_R501_item): Ditto.
+
+Mon Jun  9 17:45:44 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_expr_intrinsic_): Fix several of the
+	libU77/libF77-unix handlers to properly convert their
+	arguments.
+
+	* com-rt.def (FFECOM_gfrtFSTAT): Append missing "i" to
+	arg string.
+
+Fri Jun  6 14:37:30 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_expr_intrinsic_): Have a case statement
+	for every intrinsic implementation, so missing ones
+	are caught via gcc warnings.
+	Don't call ffeintrin_codegen_imp anymore.
+	* intrin.c (ffeintrin_fulfill_generic): Remove cg_imp
+	stuff from here.
+	(ffeintrin_codegen_imp): Delete this function.
+	* intrin.def, intrin.h: Remove DEFIMQ stuff from here
+	as well.
+
+Thu Jun  5 13:03:07 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* top.c (ffe_decode_option): New -fbadu77-intrinsics-*
+	options.
+	* top.h: Ditto.
+	* intrin.h: New BADU77 family.
+	* intrin.c (ffeintrin_state_family): Ditto.
+
+	Implement new scheme to track intrinsic names vs. forms:
+	* intrin.c (ffeintrin_fulfill_generic),
+	(ffeintrin_fulfill_specific), (ffeintrin_is_intrinsic),
+	intrin.def: The documented name is now either in the
+	generic info or, if no generic, in the specific info.
+	For a generic, the specific info contains merely the
+	distinguishing form (usually "function" or "subroutine"),
+	used for diagnostics about ambiguous references and
+	in the documentation.
+
+	* intrin.def: Clean up formatting of DEFNAME block.
+	Convert many libU77 intrinsics into generics that
+	support both subroutine and function forms.
+	Put the function forms of side-effect routines into
+	the new BADU77 family.
+	Make MCLOCK and TIME return INTEGER*4 again, and add
+	INTEGER*8 equivalents called MCLOCK8 and TIME8.
+	Fix up more status return values to be written and
+	insist on them being I1 as well.
+	* com.c (ffecom_expr_intrinsic_): Lots of changes to
+	support new libU77 intrinsic interfaces.
+
+Mon Jun  2 00:37:53 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_init_0): Pointer type is now INTEGER(KIND=7),
+	not INTEGER(KIND=0), since we want to reserve KIND=0 for
+	future use.
+
+Thu May 29 14:30:33 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Fix bugs preventing CTIME(I*4) from working correctly:
+	* com.c (ffecom_char_args_): For FUNCREF case, process
+	args to intrinsic just as they would be in
+	ffecom_expr_intrinsic_.
+	* com-rt.def (FFECOM_gfrtCTIME, FFECOM_gfrtTTYNAM): Fix
+	argument decls to specify `&'.
+
+Wed May 28 22:19:49 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Fix gratuitous warnings exposed by dophot aka 970528-1:
+	* global.c (ffeglobal_proc_def_arg, ffeglobal_proc_ref_arg):
+	Support distinct function/subroutine arguments instead of
+	just procedures.
+	* global.h: Ditto.
+	* expr.c (ffeexpr_fulfill_call_): A SYMTER with kindNONE
+	also is a procedure (either function or subroutine).
+
+Mon May 26 20:25:31 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* bad.def: Have several lexer diagnostics refer to
+	documentation for people who need more info on what Fortran
+	source code is supposed to look like.
+
+	* expr.c (ffeexpr_reduced_bool1_), bad.def: New diagnostics
+	specific to .NOT. now mention only one operand instead
+	of two.
+
+	* g77.c: Recognize -fsyntax-only, similar to -c etc.
+	(lookup_option): Fix bug that prevented non-`--' options
+	from being recognized.
+
+Sun May 25 04:29:04 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* intrin.def (FFEINTRIN_impCTIME): Accept `I*' expression
+	for STime instead of requiring `I2'.
+
+Tue May 20 16:14:40 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* symbol.c (ffesymbol_reference): All references to
+	standard intrinsics are considered explicit, so as
+	to avoid generating basically useless warnings.
+	* intrin.c, intrin.h (ffeintrin_is_standard): Returns TRUE
+	if intrinsic is standard.
+
+Sun May 18 21:14:59 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com-rt.def: Changed all external names of the
+	form `"\([a-z0-9]*\)_' to `"G77_\1_0"' so as to
+	allow any name valid as an intrinsic to be used
+	as such and as a user-defined external procedure
+	name or common block as well.
+
+Thu May  8 13:07:10 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* expr.c (ffeexpr_cb_end_notloc_): For %VAL, %REF, and
+	%DESCR, copy arg info into new node.
+
+Mon May  5 14:42:17 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	From Uwe F. Mayer <mayer@math.Vanderbilt.Edu>:
+	* Make-lang.in (g77-cross): Fix typo in g77.c path.
+
+	From Brian McIlwrath <bkm@star.rl.ac.uk>:
+	* lang-specs.h: Have g77 pick up options from a section
+	labeled `*f771' of the `specs' file.
+
+Sat May  3 02:46:08 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* intrin.def (FFEINTRIN_defSIGNAL): Add optional `Status'
+	argument that com.c already expects (per Dave Love).
+
+	More changes to support better tracking of (filewide)
+	globals, in particular, the arguments to procedures:
+	* bad.def (FFEBAD_FILEWIDE_NARGS, FFEBAD_FILEWIDE_NARGS_W,
+	FFEBAD_FILEWIDE_ARG, FFEBAD_FILEWIDE_ARG_W): New diagnostics.
+	* expr.c (ffebad_fulfill_call_): Provide info on each
+	argument to ffeglobal.
+	* global.c, global.h (ffeglobal_proc_def_arg,
+	ffeglobal_proc_def_nargs, ffeglobal_proc_ref_arg,
+	ffeglobal_proc_ref_args): New functions.
+	(ffeglobalArgSummary, ffeglobalArgInfo_): New types.
+
+Tue Apr 29 18:35:41 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	More changes to support better tracking of (filewide)
+	globals:
+	* expr.c (ffeexpr_fulfill_call_): New function.
+	(ffeexpr_token_name_lhs_): Call after building procedure
+	reference expression.  Also leave info field for ANY-ized
+	expression alone.
+	(ffeexpr_token_arguments_): Ditto.
+
+Mon Apr 28 20:04:18 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Changes to support better tracking of (filewide)
+	globals, mainly to avoid crashes due to inlining:
+	* bad.def: Go back to quoting intrinsic names,
+	(FFEBAD_FILEWIDE_DISAGREEMENT, FFEBAD_FILEWIDE_TIFF,
+	FFEBAD_FILEWIDE_TYPE_MISMATCH): New diagnostics.
+	(FFEBAD_INTRINSIC_EXPIMP, FFEBAD_INTRINSIC_GLOBAL): Reword
+	for clarity.
+	* com.c (ffecom_do_entry_, ffecom_start_progunit_,
+	ffecom_sym_transform_): Accommodate new FFEGLOBAL_typeEXT
+	possibility.
+	* expr.c (ffeexpr_sym_lhs_call_, ffeexpr_sym_lhs_extfunc_,
+	ffeexpr_sym_rhs_actualarg_, ffeexpr_declare_parenthesized_,
+	ffeexpr_paren_rhs_let_, ffeexpr_token_funsubstr_):
+	Fill in real kind info instead of leaving NONE where
+	appropriate.
+	Register references to intrinsics and globals with ffesymbol
+	using new ffesymbol_reference function instead of
+	ffesymbol_globalize.
+	* global.c (ffeglobal_type_string_): New array for
+	new diagnostics.
+	* global.h, global.c:
+	Replace ->init mechanism with ->tick mechanism.
+	Move other common-related members into a substructure of
+	a union, so the proc substructure can be introduced
+	to include members related to externals other than commons.
+	Don't complain about ANY-ized globals; ANY-ize globals
+	once they're complained about, in any case where code
+	generation could become a problem.
+	Handle global entries that have NONE type (seen as
+	intrinsics), EXT type (seen as EXTERNAL), and so on.
+	Keep track of kind and type of externals, both via
+	definition and via reference.
+	Diagnose disagreements about kind or type of externals
+	(such as functions).
+	(ffeglobal_ref_intrinsic, ffeglobal_ref_progunit_): New
+	functions.
+	* stc.c (ffestc_R1207_item, ffestc_R1208_item,
+	ffestc_R1219, ffestc_R1226):
+	Call ffesymbol_reference, not ffesymbol_globalize.
+	* stu.c (ffestu_sym_end_transition,
+	ffestu_sym_exec_transition):
+	Call ffesymbol_reference, not ffesymbol_globalize.
+	* symbol.c (ffesymbol_globalize): Removed...
+	(ffesymbol_reference): ...to this new function,
+	which more generally registers references to symbols,
+	globalizes globals, and calls on the ffeglobal module
+	to check globals filewide.
+
+	* global.h, global.c: Rename some macros and functions
+	to more clearly distinguish common from other globals.
+	All callers changed.
+
+	* com.c (ffecom_sym_transform_): Trees describing
+	filewide globals must be allocated on permanent obstack.
+
+	* expr.c (ffeexpr_token_name_lhs_): Don't generate
+	gratuitous diagnostics for FFEINFO_whereANY case.
+
+Thu Apr 17 03:27:18 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* global.c: Add support for flagging intrinsic/global
+	confusion via warnings.
+	* bad.def (FFEBAD_INTRINSIC_EXPIMP,
+	FFEBAD_INTRINSIC_GLOBAL): New diagnostics.
+	* expr.c (ffeexpr_token_funsubstr_): Ditto.
+	(ffeexpr_sym_lhs_call_): Ditto.
+	(ffeexpr_paren_rhs_let_): Ditto.
+	* stc.c (ffestc_R1208_item): Ditto.
+
+Wed Apr 16 22:40:56 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* expr.c (ffeexpr_declare_parenthesized_): INCLUDE
+	context can't be an intrinsic invocation either.
+
+Fri Mar 28 10:43:28 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* expr.c (ffeexpr_token_arguments_): Make sure top of
+	exprstack is operand before dereferencing operand field.
+
+	* lex.c (ffelex_prepare_eos_): Fill up truncated
+	hollerith token, so crash on null ->text field doesn't
+	happen later.
+
+	* stb.c (ffestb_R10014_): If NAMES isn't recognized (or
+	the recognized part is followed in the token by a
+	non-digit), don't try and collect digits, as there
+	might be more than FFEWHERE_indexMAX letters to skip
+	past to do so -- and the code is diagnosed anyway.
+
+Thu Mar 27 00:02:48 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_sym_transform_): Force local
+	adjustable array onto stack.
+
+	* stc.c (ffestc_R547_item_object): Don't actually put
+	the symbol in COMMON if the symbol has already been
+	EQUIVALENCE'd to a different COMMON area.
+
+	* equiv.c (ffeequiv_add): Don't actually do anything
+	if there's a disagreement over which COMMON area is
+	involved.
+
+Tue Mar 25 03:35:19 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_transform_common_): If no explicit init
+	of COMMON area, don't actually init it even though
+	storage area suggests it.
+
+Mon Mar 24 12:10:08 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* lex.c (ffelex_image_char_): Avoid overflowing the
+	column counter itself, as well as the card image.
+
+	* where.c (ffewhere_line_new): Cast ffelex_line_length()
+	to (size_t) so 255 doesn't overflow to 0!
+
+	* stc.c (ffestc_labeldef_notloop_begin_): Don't gratuitously
+	terminate loop before processing statement, so block
+	doesn't disappear out from under EXIT/CYCLE processing.
+	(ffestc_labeldef_notloop_): Has old code from above
+	function, instead of just calling it.
+
+	* expr.c (ffeexpr_cb_comma_i_4_): Don't skip over
+	arbitrary token (such as EOS).
+
+	* com.c (ffecom_init_zero_): Handle RECORD_TYPE and
+	UNION_TYPE so -fno-zeros works with -femulated-complex.
+
+1997-03-12  Dave Love  <d.love@dl.ac.uk>
+
+	* intrin.def: New intrinsics INT2, INT8, CPU_TIME.  Fix AND, OR,
+ 	XOR.  [Integrated by burley, AND/OR/XOR already fixed, INT8
+	implementation changed/fixed.]
+
+Wed Mar 12 10:40:08 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Make-lang.in ($(srcdir)/f/intdoc.texi): Simplify rules
+	so building f/intdoc is not always necessary; remove
+	f/intdoc after running it if it is built.
+
+Tue Mar 11 23:42:00 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* intrin.def (FFEINTRIN_impAND, FFEINTRIN_impOR,
+	FFEINTRIN_impXOR): Use the IAND, IOR, and IEOR implementations
+	of these, instead of crashing in ffecom_expr_intrinsic_
+	or adding case labels there.
+
+Mon Mar 10 22:51:23 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* intdoc.c: Fix so any C compiler can compile this.
+
+Fri Feb 28 13:16:50 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Version 0.5.20 released.
+
+Fri Feb 28 01:45:25 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Make-lang.in (RUNTIMESTAGESTUFF, LIBU77STAGESTUFF):
+	Move some files incorrectly in the former to the latter,
+	and add another file or two to the latter.
+
+	New meanings for (KIND=n), and new denotations in the
+	little language describing intrinsics:
+	* com.c (ffecom_init_0): Assign new meanings.
+	* intdoc.c: Document new meanings.
+	Support the new denotations.
+	* intrin.c: Employ new meanings, mapping them to internal
+	values (which are the same as they ever were for now).
+	Support the new denotations.
+	* intrin.def: Switch DEFIMP table to the new denotations.
+
+	* intrin.c (ffeintrin_check_): Fix bug that was leaving
+	LOC() and %LOC() returning INTEGER*4 on systems where
+	it should return INTEGER*8.
+
+	* type.c: Canonicalize function definitions, for etags
+	and such.
+
+Wed Feb 26 20:43:03 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_init_0): Choose INTEGER(KIND=n) types,
+	where n is 2, 3, and 4, according to the new docs
+	instead of according to the old C correspondences
+	(which seem less useful at this point).
+
+	* equiv.c (ffeequiv_destroy_): New function.
+	(ffeequiv_layout_local_): Use this new function
+	whenever the laying out of a local equivalence chain
+	is aborted for any reason.
+	Otherwise ensure that symbols no longer reference
+	the stale ffeequiv entries that result when they
+	are killed off in this procedure.
+	Also, the rooted symbol is one that has storage,
+	it really is irrelevant whether it has an equiv entry
+	at this point (though the code to remove the equiv
+	entry was put in at the end, just in case).
+	(ffeequiv_kill): When doing internal checks, make
+	sure the victim isn't named by any symbols it points
+	to.  Not as complete a check as looking through the
+	entire symbol table (which does matter, since some
+	code in equiv.c used to remove symbols from the lists
+	for an ffeequiv victim but not remove that victim as the
+	symbol's equiv info), but this check did find some
+	real bugs in the code (that were fixed).
+
+Mon Feb 24 16:42:13 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_expr_intrinsic_): Fix a couple of
+	warnings about uninitialized variables.
+	* intrin.c (ffeintrin_check_): Ditto, but there were
+	a couple of _real_ uninitialized-variable _bugs_ here!
+	(ffeintrin_fulfill_specific): Ditto, no real bug here.
+
+Sun Feb 23 15:01:20 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Clean up diagnostics (especially about intrinsics):
+	* bad.def (FFEBAD_UNIMPL_STMT): Remove.
+	(FFEBAD_INTRINSIC_*, FFEBAD_NEED_INTRINSIC): Clean these
+	up so they're friendlier.
+	(FFEBAD_INTRINSIC_CMPAMBIG): New.
+	* intrin.c (ffeintrin_fulfill_generic,
+	ffeintrin_fulfill_specific, ffeintrin_is_intrinsic):
+	Always choose
+	generic or specific name text (which is for doc purposes
+	anyway) over implementation name text (which is for
+	internal use).
+	* intrin.def: Use more descriptive name texts for generics
+	and specifics in cases where the names themselves are not
+	enough (e.g. IDATE, which has two forms).
+
+	Fix some intrinsic mappings:
+	* intrin.def (FFEINTRIN_specIDINT, FFEINTRIN_specAND,
+	FFEINTRIN_specDFLOAT, FFEINTRIN_specDREAL, FFEINTRIN_specOR,
+	FFEINTRIN_specXOR): Now have their own implementations,
+	instead of borrowing from others.
+	(FFEINTRIN_specAJMAX0, FFEINTRIN_specAJMIN0, FFEINTRIN_specBJTEST,
+	FFEINTRIN_specDFLOTJ, FFEINTRIN_specFLOATJ, FFEINTRIN_specJIABS,
+	FFEINTRIN_specJIAND, FFEINTRIN_specJIBCLR, FFEINTRIN_specJIBITS,
+	FFEINTRIN_specJIBSET, FFEINTRIN_specJIDIM, FFEINTRIN_specJIDINT,
+	FFEINTRIN_specJIDNNT, FFEINTRIN_specJIEOR, FFEINTRIN_specJIFIX,
+	FFEINTRIN_specJINT, FFEINTRIN_specJIOR, FFEINTRIN_specJISHFT,
+	FFEINTRIN_specJISHFTC, FFEINTRIN_specJISIN, FFEINTRIN_specJMAX0,
+	FFEINTRIN_specJMAX1, FFEINTRIN_specJMIN0, FFEINTRIN_specJMIN1,
+	FFEINTRIN_specJMOD, FFEINTRIN_specJNINT, FFEINTRIN_specJNOT,):
+	Turn these implementations off, since it's not clear
+	just what types they expect in the context of portable Fortran.
+	(DFLOAT): Now in FVZ family, since f2c supports them
+
+	Support intrinsic inquiry functions (BIT_SIZE, LEN):
+	* intrin.c: Allow `i' in <arg_extra>.
+	* intrin.def (FFEINTRIN_impBIT_SIZE, FFEINTRIN_impLEN):
+	Mark args with `i'.
+
+Sat Feb 22 13:34:09 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Only warn, don't error, for reference to unimplemented
+	intrinsic:
+	* bad.def (FFEBAD_INTRINSIC_UNIMPLW): Warning version
+	of _UNIMPL.
+	* intrin.c (ffeintrin_is_intrinsic): Use new warning
+	version of _UNIMPL (FFEBAD_INTRINSIC_UNIMPLW).
+
+	Complain about REAL(Z) and AIMAG(Z) (Z is DOUBLE COMPLEX):
+	* bad.def (FFEBAD_INTRINSIC_CMPAMBIG): New diagnostic.
+	* expr.c: Needed #include "intrin.h" anyway.
+	(ffeexpr_token_intrincheck_): New function handles delayed
+	diagnostic for "REAL(REAL(expr)" if next token isn't ")".
+	(ffeexpr_token_arguments_): Do most of the actual checking here.
+	* intrin.h, intrin.c (ffeintrin_fulfill_specific): New
+	argument, check_intrin, to tell caller that intrin is REAL(Z)
+	or AIMAG(Z).  All callers updated, mostly to pass NULL in
+	for this.
+	(ffeintrin_check_): Also has new arg check_intrin for same
+	purpose.  All callers updated the same way.
+	* intrin.def (FFEINTRIN_impAIMAG): Change return type
+	from "R0" to "RC", to accommodate f2c (and perhaps other
+	non-F90 F77 compilers).
+	* top.h, top.c: New option -fugly-complex.
+
+	New GNU intrinsics REALPART, IMAGPART, and COMPLEX:
+	* com.c (ffecom_expr_intrinsic_): Implement impCOMPLEX
+	and impREALPART here.  (specIMAGPART => specAIMAG.)
+	* intrin.def: Add the intrinsics here.
+
+	Rename implementations of VXTIDATE and VXTTIME to IDATEVXT
+	and TIMEVXT, so they sort more consistently:
+	* com.c (ffecom_expr_intrinsic_):
+	* intrin.def:
+
+	Delete intrinsic group `dcp', add `gnu', etc.:
+	* intrin.c (ffeintrin_state_family): FFEINTRIN_familyGNU
+	replaces FFEINTRIN_familyDCP, and gets state from `gnu'
+	group.
+	Get rid of FFEINTRIN_familyF2Z, nobody needs it.
+	Move FFEINTRIN_specDCMPLX from DCP family to FVZ family,
+	as f2c has it.
+	Move FFEINTRIN_specDFLOAT from F2C family to FVZ family.
+	(FFEINTRIN_specZABS, FFEINTRIN_specZCOS, FFEINTRIN_specZEXP,
+	FFEINTRIN_specZLOG, FFEINTRIN_specZSIN, FFEINTRIN_specZSQRT):
+	Move these from F2Z family to F2C family.
+	* intrin.h (FFEINTRIN_familyF2Z, FFEINTRIN_familyDCP): Remove.
+	(FFEINTRIN_familyGNU): Add.
+	* top.h, top.c: Replace `dcp' with `gnu'.
+
+	* com.c (ffecom_expr_intrinsic_): Clean up by collecting
+	simple conversions into one nice, conceptual place.
+	Fix up some intrinsic subroutines (MVBITS, KILL, UMASK) to
+	properly push and pop call temps, to avoid wasting temp
+	registers.
+
+	* g77.c (doit): Toon says variables should be defined
+	before being referenced.  Spoilsport.
+
+	* intrin.c (ffeintrin_check_): Now Dave's worried about
+	warnings about uninitialized variables.  Okay, so for
+	basic return values 'g' and 's', they _were_
+	uninitialized -- is determinism really _that_ useful?
+
+	* intrin.def (FFEINTRIN_impFGETC): Fix STATUS argument
+	so that it is INTENT(OUT) instead of INTENT(IN).
+
+1997-02-21  Dave Love  <d.love@dl.ac.uk>
+
+	* intrin.def, com.c: Support Sun-type `short' and `long'
+	intrinsics.  Perhaps should also do Microcruft-style `int2'.
+
+Thu Feb 20 15:16:53 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_expr_intrinsic_): Clean up indentation.
+	Support SECONDSUBR intrinsic implementation.
+	Rename SECOND to SECONDFUNC for direct support via library.
+
+	* g77.c: Fix to return proper status value to shell,
+	by obtaining it from processes it spawns.
+
+	* intdoc.c: Fix minor typo.
+
+	* intrin.def: Turn SECOND into generic that maps into
+	function and subroutine forms.
+
+	* intrin.def: Make FLOAT and SNGL into specific intrinsics.
+
+	* intrin.def, intrin.h: Change the way DEFGEN and DEFSPEC
+	macros work, to save on verbage.
+
+Mon Feb 17 02:08:04 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	New subsystem to automatically generate documentation
+	on intrinsics:
+	* Make-lang.in ($(srcdir)/f/g77.info,
+	$(srcdir)/f/g77.dvi): Move g77 doc rules around.
+	Add to g77 doc rules the new subsystem.
+	(f77.mostlyclean, f77.maintainer-clean): Also clean up
+	after new doc subsystem.
+	* intdoc.c, intdoc.h: New doc subsystem code.
+	* intrin.h [FFEINTRIN_DOC]: When 1, don't pull in
+	stuff not needed by doc subsystem.
+
+	Improve on intrinsics mechanism to both be more
+	self-documenting and to catch more user errors:
+	* intrin.c (ffeintrin_check_): Recognize new arg-len
+	and arg-rank information, and check it.
+	Move goto and signal indicators to the basic type.
+	Permit reference to arbitrary argument number, not
+	just first argument (for BESJN and BESYN).
+	(ffeintrin_init_0): Check and accept new notations.
+	* intrin.c, intrin.def: Value in COL now identifies
+	arguments starting with number 0 being the first.
+
+	Some minor intrinsics cleanups (resulting from doc work):
+	* com.c (ffecom_expr_intrinsic_): Implement FLUSH
+	directly once again, handle its optional argument,
+	so it need not be a generic (awkward to handle in docs).
+	* intrin.def (BESJ0, BESJ1, BESJN, BESY0, BESY1, BESYN,
+	CHDIR, CHMOD, CTIME, DBESJ0, DBESJ1, DBESJN, DBESY0,
+	DBESY1, DBESYN, DDIM, ETIME, FGETC, FNUM, FPUTC, FSTAT,
+	GERROR, GETCWD, GETGID, GETLOG, GETPID, GETUID, GMTIME,
+	HOSTNM, IDATE, IERRNO, IIDINT, IRAND, ISATTY, ITIME, JIDINT,
+	LNBLNK, LSTAT, LTIME, MCLOCK, PERROR, SRAND, SYMLNK, TTYNAM,
+	UMASK): Change capitalization of initcaps (official) name
+	to be consistent with Burley's somewhat arbitrary rules.
+	(BESJN, BESYN): These have return arguments of same type
+	as their _second_ argument.
+	(FLUSH): Now a specific, not generic, intrinsic, with one
+	optional argument.
+	(FLUSH1): Eliminated.
+	Add arg-len and arg-rank info to several intrinsics.
+	(ITIME): Change argument type from REAL to INTEGER.
+
+Tue Feb 11 14:04:42 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Make-lang.in (f771): Invocation of Makefile now done
+	with $(srcdir)=gcc to go along with $(VPATH)=gcc.
+	($(srcdir)/f/runtime/configure,
+	$(srcdir)/f/runtime/libU77/configure): Break these out
+	so spurious triggers of this rule don't happen (as when
+	configure.in is more recent than libU77/configure).
+	(f77.rebuilt): Distinguish source versus build files,
+	so this target can be invoked from build directory and
+	still work.
+	* Makefile.in: This now expects $(srcdir) to be the gcc
+	source directory, not gcc/f, to agree with $(VPATH).
+	Accordingly, $(INCLUDES) has been fixed, various cruft
+	removed, the removal of f771 has been fixed to remove
+	the _real_ f771 (not the one in gcc's parent directory),
+	and so on.
+
+	* lex.c: Part of ffelex_finish_statement_() now done
+	by new function ffelex_prepare_eos_(), so that, in one
+	popular case, the EOS can be prepared while the pointer
+	is at the end of the non-continued line instead of the
+	end of the line that marks no continuation.  This improves
+	the appearance of diagnostics substantially.
+
+Mon Feb 10 12:44:06 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Make-lang.in: runtime Makefile's, and include/f2c.h,
+	also depend on f/runtime/configure and f/runtime/libU77/configure.
+
+	Fix various libU77 routines:
+	* com-rt.def (FFECOM_gfrtCTIME, FFECOM_gfrtMCLOCK,
+	FFECOM_gfrtTIME): These now use INTEGER*8 for time values,
+	for compatibility with systems like Alpha.
+	(FFECOM_gfrtSYSTEM_CLOCK, FFECOM_gfrtTTYNAM): Delete incorrect
+	trailing underscore in routine names.
+	* intrin.c, intrin.def: Support INTEGER*8 return values and
+	arguments ('4').  Change FFEINTRIN_impCTIME, FFEINTRIN_impMCLOCK,
+	and FFEINTRIN_impTIME accordingly.
+	(ffeintrin_is_intrinsic): Don't give caller a clue about
+	form of intrinsic -- shouldn't be needed at this point.
+
+	Cope with generic intrinsics that are subroutines and functions:
+	* com.c (ffecom_finish_symbol_transform_, ffecom_expr_transform_):
+	Don't transform an intrinsic that is not known to be a subroutine
+	or a function.  (Maybe someday have to avoid transforming
+	any intrinsic with an undecided or unknown implementation.)
+	* expr.c (ffeexpr_declare_unadorned_,
+	ffeexpr_declare_parenthesized_): Ok to invoke generic
+	intrinsic that has at least one subroutine form as a
+	subroutine.
+	Ok to pass intrinsic as actual arg if it has a known specific
+	intrinsic form that is valid as actual arg.
+	(ffeexpr_declare_parenthesized_): An unknown kind of
+	intrinsic has a paren_type chosen based on context.
+	(ffeexpr_token_arguments_): Build funcref/subrref based
+	on context, not on kind of procedure being called.
+	* intrin.h, intrin.c (ffeintrin_is_intrinsic): Undo changes of
+	Tue Feb  4 23:12:04 1997 by me, change all callers to leave
+	intrinsics as FFEINFO_kindNONE at this point.  (Some callers
+	also had unused variables deleted as a result.)
+
+	Enable all intrinsic groups (especially f90 and vxt):
+	* target.h (FFETARGET_defaultSTATE_DCP, FFETARGET_defaultSTATE_F2C,
+	FFETARGET_defaultSTATE_F90, FFETARGET_defaultSTATE_MIL,
+	FFETARGET_defaultSTATE_UNIX, FFETARGET_defaultSTATE_VXT):
+	Delete these macros, let top.c set them directly.
+	* top.c (ffeintrinsic_state_dcp_, ffe_intrinsic_state_f2c_,
+	ffe_intrinsic_state_f90_, ffe_intrinsic_state_mil_,
+	ffe_intrinsic_state_unix_, ffe_intrinsic_state_vxt_):
+	Enable all these directly.
+
+Sat Feb  8 03:21:50 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* g77.c: Incorporate recent changes to ../gcc.c.
+	For version magic (e.g. `g77 -v'), instead of compiling
+	/dev/null, write, compile, run, and then delete a small
+	program that prints the version numbers of the three
+	components of libf2c (libF77, libI77, and libU77),
+	so we get this info with bug reports.
+	Also, this change reduces the chances of accidentally
+	linking to an old (complex-alias-problem) libf2c.
+	Fix `-L' so the argument is expected in `-Larg'.
+
+	* com.h (FFECOM_f2cLONGINT): For INTEGER*8 support in f2c.h,
+	dynamically determine proper type here, instead of
+	assuming `long long int' is correct.
+
+Tue Feb  4 23:12:04 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Add libU77 library from Dave Love <d.love@dl.ac.uk>:
+	* Make-lang.in (f77-runtime): Depend on new Makefile.
+	(f/runtime/libU77/Makefile): New rule.
+	Also configure libU77.
+	($(srcdir)/f/runtime/configure: Use Makefile.in,
+	so configuration doesn't have to have happened.
+	(f77.mostlyclean, f77.clean, f77.distclean,
+	f77.maintainer-clean): Some fixups here, but more work
+	needed.
+	(RUNTIMESTAGESTUFF): Add libU77's config.status.
+	(LIBU77STAGESTUFF, f77.stage1, f77.stage2, f77.stage3,
+	f77.stage4): New macro, appropriate uses added.
+	* com-rt.def: Add libU77 procedures.
+	* com.c (ffecom_f2c_ptr_to_integer_type_node,
+	ffecom_f2c_ptr_to_real_type_node): New type nodes.
+	(FFECOM_rttypeCHARACTER_): New type of run-time function.
+	(ffecom_char_args_): Handle CHARACTER*n intrinsics
+	where n != 1 here, instead of in ffecom_expr_intrinsic_.
+	(ffecom_expr_intrinsic_): New code to handle new
+	intrinsics.
+	In particular, change how FFEINTRIN_impFLUSH is handled.
+	(ffecom_make_gfrt_): Handle new type of run-time function.
+	(ffecom_init_0): Initialize new type nodes.
+	* config-lang.in: New libU77 directory.
+	* intrin.h, intrin.c (ffeintrin_is_intrinsic): Handle
+	potential generic for subroutine _and_ function
+	specifics via two new arguments.  All callers changed.
+	Properly ignore deleted/disabled intrinsics in resolving
+	generics.
+	(ffeintrin_check_, ffeintrin_init_0): Handle CHARACTER intrinsics of (*)
+	length.
+	* intrin.def: Permission granted by FSF to place this in
+	public domain, which will allow it to serve as source
+	for both g77 program and its documentation.
+	Add libU77 intrinsics.
+	(FLUSH): Now a generic, not specific, intrinsic.
+	(DEFIMP): Now support return modifier for CHARACTER intrinsics.
+
+	* com-rt.def (FFECOM_gfrtDIM, FFECOM_gfrtERF,
+	FFECOM_gfrtERFC, FFECOM_gfrtEXP, FFECOM_gfrtSIGN,
+	FFECOM_gfrtSIN, FFECOM_gfrtSINH, FFECOM_gfrtTAN,
+	FFECOM_gfrtTANH, FFECOM_gfrtPOW_RI): Change "&r" to "&f".
+
+Sat Feb  1 12:15:09 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Version 0.5.19.1 released.
+
+	* com.c (ffecom_expr_, ffecom_expr_intrinsic_,
+	ffecom_tree_divide_): FFECOM_gfrtPOW_ZI,
+	FFECOM_gfrtCONJG, FFECOM_gfrtDCONJG,
+	FFECOM_gfrtCCOS, FFECOM_gfrtCDCOS,
+	FFECOM_gfrtCLOG, FFECOM_gfrtCDLOG,
+	FFECOM_gfrtCSIN, FFECOM_gfrtCDSIN,
+	FFECOM_gfrtCSQRT, FFECOM_gfrtCDSQRT,
+	FFECOM_gfrtDIV_CC, FFECOM_gfrtDIV_ZZ: These all require
+	result to _not_ overlap one or more inputs.
+
+Sat Feb  1 00:25:55 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_init_0): Do internal checks only if
+	-fset-g77-defaults not specified.
+
+	Fix %LOC(), LOC() to return sufficiently wide type:
+	* com.h, com.c (ffecom_pointer_kind_, ffecom_label_kind_,
+	ffecom_pointer_kind(), ffecom_label_kind()): New globals
+	and accessor macros hold kind for integer pointers on target
+	machine.
+	(ffecom_init_0): Determine narrowest INTEGER type that
+	can hold a pointer (usually INTEGER*4 or INTEGER*8),
+	store it in ffecom_pointer_kind_, etc.
+	* expr.c (ffeexpr_cb_end_loc_): Use right type for %LOC().
+	* intrin.c (ffeintrin_check_, ffeintrin_init_0): Support
+	new 'p' kind for type of intrinsic.
+	* intrin.def (FFEINTRIN_impLOC): Returns "Ip" instead of "I1",
+	so LOC() type is correct for target machine.
+
+	Support -fugly-assign:
+	* lang-options.h, top.h, top.c (ffe_decode_option):
+	Accept -fugly-assign and -fno-ugly-assign.
+	* com.c (ffecom_expr_): Handle -fugly-assign.
+	* expr.c (ffeexpr_finished_): Check right type for ASSIGN
+	contexts.
+
+Fri Jan 31 14:30:00 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Remove last vestiges of -fvxt-not-f90:
+	* stb.c (ffestb_R10012_, ffestb_R10014_, ffestb_V0201_):
+	top.c, top.h:
+
+Fri Jan 31 02:13:54 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* top.c (ffe_decode_option): Warn if -fugly is specified,
+	it'll go away soon.
+
+	* symbol.h: No need to #include "bad.h".
+
+	Reorganize features from -fvxt-not-f90 to -fvxt:
+	* lang-options.h, top.h, top.c:
+	Accept -fvxt and -fno-vxt, but not -fvxt-not-f90 or -ff90-not-vxt.
+	Warn if the latter two are used.
+	* expr.c (ffeexpr_nil_rhs_): Double-quote means octal constant.
+	(ffeexpr_token_rhs_): Double-quote means octal constant.
+	* target.h (FFETARGET_defaultIS_VXT_NOT_90): Delete macro
+	definition, no longer needed.
+
+	Make some -ff90 features the default:
+	* data.c (ffedata_value): DATA implies SAVE.
+	* src.h (ffesrc_is_name_noninit): Underscores always okay.
+
+	Fix up some more #error directives by quoting their text:
+	* bld.c (ffebld_constant_is_zero):
+	* target.h:
+
+Sat Jan 18 18:22:09 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* g77.c (lookup_option, main): Recognize `-Xlinker',
+	`-Wl,', `-l', `-L', `--library-directory', `-o',
+	`--output'.
+	(lookup_option): Don't depend on SWITCH_TAKES_ARG
+	being correct, it might or might not have `-x' in
+	it depending on host.
+	Return NULL argument if it would be an empty string.
+	(main): If no input files (by gcc.c's definition)
+	but `-o' or `--output' specified, produce diagnostic
+	to avoid overwriting output via gcc.
+	Recognize C++ `+e' options.
+	Treat -L as another non-magical option (like -B).
+	Don't append_arg `-x' twice.
+
+Fri Jan 10 23:36:00 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* top.c [BUILT_FOR_270] (ffe_decode_option): Make
+	-fargument-noalias-global the default.
+
+Fri Jan 10 07:42:27 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Enable inlining of previously-compiled program units:
+	* com.c (ffecom_do_entry_, ffecom_start_progunit_):
+	Register new public function in ffeglobal database.
+	(ffecom_sym_transform_): Any GLOBAL or potentially GLOBAL
+	symbol should be looked up in ffeglobal database and
+	that tree node used, if found.  That way, gcc knows
+	the references are to those earlier definitions, so it
+	can emit shorter branches/calls, inline, etc.
+	(ffecom_transform_common_): Minor change for clarity.
+	* expr.c (ffeexpr_sym-lhs_call_, ffeexpr_sym_lhs_extfunc_,
+	ffeexpr_sym_rhs_actualarg_, ffeexpr_paren_rhs_let_,
+	ffeexpr_token_funsubstr_): Globalize symbol as needed.
+	* global.c (ffeglobal_promoted): New function to look up
+	existing local symbol in ffeglobal database.
+	* global.h: Declare new function.
+	* name.h (ffename_token): New macro, plus alphabetize.
+	* stc.c (ffestc_R1207_item): Globalize EXTERNAL symbol.
+	* stu.c (ffestu_sym_end_transition, ffestu_sym_exec_transition):
+	Globalize symbol as needed.
+	* symbol.h, symbol.c (ffesymbol_globalize): New function.
+
+Thu Jan  9 14:20:00 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* ste.c (ffeste_R809): Produce a diagnostic for SELECT CASE
+	on CHARACTER type, instead of crashing.
+
+Thu Jan  9 00:52:45 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* stc.c (ffestc_order_entry_, ffestc_order_format_,
+	ffestc_R1226): Allow ENTRY and FORMAT before IMPLICIT
+	NONE, by having them transition only to state 1 instead
+	of state 2 (which is disallowed by IMPLICIT NONE).
+
+Mon Jan  6 22:44:53 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Fix AXP bug found by Rick Niles (961201-1.f):
+	* com.c (ffecom_init_0): Undo my 1996-05-14 change, as
+	it is incorrect and prevented easily finding this bug.
+	* target.h [__alpha__] (ffetargetReal1, ffetargetReal2):
+	Use int	instead of long.
+	(ffetarget_cvt_r1_to_rv_, ffetarget_cvt_rv_to_r1_,
+	ffetarget_cvt_r2_to_rv_, ffetarget_cvt_rv_to_r2_):
+	New functions that intercede for callers of
+	REAL_VALUE_(TO|UNTO)_TARGET_(SINGLE|DOUBLE).
+	All callers changed, and damaging casts to (long *) removed.
+
+Sun Jan  5 03:26:11 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Make-lang.in (g77, g77-cross): Depend on both g77.c and
+	zzz.c, in $(srcdir)/f/.
+
+	Better design for -fugly-assumed:
+	* stc.c (ffestc_R501_item, ffestc_R524_item,
+	ffestc_R547_item_object): Pass new is_ugly_assumed flag.
+	* stt.c, stt.h (ffestt_dimlist_as_expr,
+	ffestt_dimlist_type): New is_ugly_assumed flag now
+	controls whether "1" is treated as "*".
+	Don't treat "2-1" or other collapsed constants as "*".
+
+Sat Jan  4 15:26:22 1997  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* stb.c (ffestb_R10012_): Don't confirm on FORMAT(A,)
+	or even FORMAT(A,,B), as R1229 only warns about the
+	former currently, and this seems reasonable.
+
+	Improvements to diagnostics:
+	* sta.c (ffesta_second_): Don't add any ffestb parsers
+	unless they're specifically called for.
+	Set up ffesta_tokens[0] before calling ffestc_exec_transition,
+	else stale info might get used.
+	(ffesta_save_): Do a better job picking which parser to run
+	after running all parsers with no confirmed possibles.
+	(FFESTA_maxPOSSIBLES_): Decrease from 100 now that so few
+	possibles are ever on the list at a given time.
+	(struct _ffesta_possible): Add named attribute.
+	(ffesta_add_possible_exec_, ffesta_add_possible_nonexec_):
+	Make these into macros that call a single function that now
+	sets the named attribute.
+	(ffesta_add_possible_unnamed_exec_,
+	ffeseta_add_possible_unnamed_nonexec_): New macros.
+	(ffesta_second_): Designate unnamed possibles as
+	appropriate.
+	* stb.c (ffestb_R1229, ffestb_R12291_): Use more general
+	diagnostic, so things like "POINTER (FOO, BAR)" are
+	diagnosed as unrecognized statements, not invalid statement
+	functions.
+	* stb.h, stb.c (ffestb_unimplemented): Remove function.
+
+1996-12-30  Dave Love  <d.love@dl.ac.uk>
+
+	* com.c: #include libU77/config.h
+	(ffecom_f2c_ptr_to_integer_type_node,
+ 	ffecom_f2c_ptr_to_integer_type_node): New variables.
+	(ffecom_init_0): Use them.
+	(ffecom_expr_intrinsic_): Many news cases for libU77 intrinsics.
+
+	* com-rt.def: New definitions for libU77.
+	* intrin.def: Likewise.  Also correct ftell arg spec.
+
+	* Makefile.in (f/runtime/libU77/config.h): New target for com.c
+ 	dependency.
+	* Make-lang.in (f771): Depend on f/runtime/Makefile for the above.
+
+Sat Dec 28 12:28:29 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* stt.c (ffestt_dimlist_type): 	Treat ([...,]1) in dimlist
+	as ([...,]*) if -fugly-assumed, so assumed-size array
+	detected early enough.
+
+Thu Dec 19 14:01:57 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* target.h (FFETARGET_REAL_VALUE_FROM_INT_): Conditionalize
+	definition on BUILT_FOR_280, not BUILT_WITH_280, since
+	the name of the macro was (properly) changed since 0.5.19.
+
+	Fix warnings/errors resulting from ffetargetOffset becoming
+	`long long int' instead of `unsigned long' as of 0.5.19,
+	while ffebitCount remains `unsigned long':
+	* bld.c (ffebld_constantarray_dump): Avoid warnings by
+	using loop var of appropriate type, and using casts.
+	* com.c (ffecom_expr_): Use right type for loop var.
+	(ffecom_sym_transform_, ffecom_transform_equiv_):
+	Cast to right type in assertions.
+	* data.c (ffedata_gather_, ffedata_value_): Cast to right
+	type in assertions and comparisons.
+
+Wed Dec 18 12:07:11 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Patch from Alexandre Oliva <oliva@dcc.unicamp.br>:
+	* Makefile.in (all.indirect): Don't pass -bbigtoc option
+	to GNU ld.
+
+	Cope with new versions of gcc:
+	* com.h (BUILT_FOR_280): New macro.
+	* com.c (ffecom_ptr_to_expr): Conditionalize test of
+	OFFSET_REF.
+	(ffecom_build_complex_constant_): Conditionalize calling
+	sequence for build_complex.
+
+Sat Dec  7 07:15:17 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Version 0.5.19 released.
+
+Fri Dec  6 12:23:55 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* g77.c: Default to assuming "f77" is in $LANGUAGES, since
+	the LANGUAGE_F77 macro isn't defined by anyone anymore (but
+	might as well leave the no-f77 code in just in case).
+	* Make-lang.in (g77, g77-cross): Don't define LANGUAGE_F77
+	anymore.
+
+1996-12-06  Dave Love  <d.love@dl.ac.uk>
+
+	* Make-lang.in (g77, g77-cross): Revert to building `g77' or not
+	conditional on `f77' in LANGUAGES.
+
+Wed Dec  4 13:08:44 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Make-lang.in (g77, g77-cross): No libs or lib dependencies
+	in case where "f77" is not in $LANGUAGES.
+
+	* lex.c (ffelex_image_char_, ffelex_file_fixed,
+	ffelex_file_free): Fixes to properly handle lines with
+	null character, and too-long lines as well.
+
+	* lex.c: Call ffebad_start_msg_lex instead of
+	ffebad_start_msg throughout.
+
+Sun Dec  1 21:19:55 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Fix-up for 1996-11-25 changes:
+	* com.c (ffecom_member_phase2_): Subtract out 0 offset for
+	elegance and consistency with EQUIVALENCE aggregates.
+	(ffecom_sym_transform_): Ditto for LOCAL/COMMON, and
+	ensure we get the same parent storage area.
+	* data.c (ffedata_gather_, ffedata_value_): Subtract out
+	aggregate offset.
+
+Wed Nov 27 13:55:57 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* proj.h: Quote the text of the #error message, to avoid
+	strange-looking diagnostics from non-gcc ANSI compilers.
+
+	* top.c: Make -fno-debug-kludge the default.
+
+Mon Nov 25 20:13:45 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Provide more info on EQUIVALENCE mismatches:
+	* bad.def (FFEBAD_EQUIV_MISMATCH): More detailed message.
+	* equiv.c (ffeequiv_layout_local_, ffeequiv_layout_cblock):
+	More details for FFEBAD_EQUIV_MISMATCH.
+
+	Fix problem with EQUIVALENCE handling:
+	* equiv.c (ffeequiv_layout_local_): Redesign algorithm --
+	old one was broken, resulting in rejection of good code.
+	(ffeequiv_offset_): Add argument, change callers.
+	Clean up the code, fix up the (probably unused) negative-value
+	case for SYMTER.
+	* com.c (ffecom_sym_transform_): For local EQUIVALENCE
+	member, subtract out aggregate offset (which is <= 0).
+
+Thu Nov 21 12:44:56 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Change type of ffetargetOffset from `unsigned long' to `long long':
+	* bld.c (ffebld_constantarray_dump): Change printf formats.
+	* storag.c (ffestorag_dump): Ditto.
+	* symbol.c (ffesymbol_report): Ditto.
+	* target.h (ffetargetOffset_f): Ditto and change type itself.
+
+	Handle situation where list of languages does not include f77:
+	* Make-lang.in: Define LANGUAGE_F77 to 1 only if `f77' is in
+	the $LANGUAGES macro for the build.
+	* g77.c: Compile to a (nearly) no-op program if LANGUAGE_F77
+	is not defined to 1.
+
+	Fixes to delay confirmation of READ, WRITE, and GOTO statements
+	so the corresponding assignments to same-named CHAR*(*) arrays
+	work:
+	* stb.c (ffestb_R90915_, ffestb_91014_): New functions.
+	(ffestb_goto3_, ffestb_goto5_): Move confirmation from 3 to 5
+	for the OPEN_PAREN case.
+	(ffestb_R9091_, ffestb_R9094_, ffestb_R90913_, ffestb_R90914_,
+	ffestb_R91012_, ffestb_R91013_): Use new functions, and confirm
+	except for the OPEN_PAREN case.
+
+	Fixes to not confirm declarations with an open paren where
+	an equal sign or other assignment-like token might be, so the
+	corresponding assignments to same-named CHAR*(*) arrays work:
+	(ffestb_decl_entsp_5_): Move assertion so we crash on that first,
+	if it turns out to be wrong, before the less-debuggable crash
+	on mistaken confirmation.
+	(ffestb_decl_entsp_6_, ffestb_decl_entsp_7_, ffestb_decl_entsp_8_):
+	Include OPEN_PAREN in list of assignment-only tokens.
+
+	Fix more diagnosed-crash bugs:
+	* stu.c (ffestu_sym_end_transition): ANY-ize an adjustable array
+	with bad dimension expressions even if still stateUNCERTAIN.
+	(ffestu_symter_end_transition_, ffestu_symter_exec_transition_):
+	Return TRUE for opANY as well.
+	For code elegance, move opSYMTER case into first switch.
+
+1996-11-17  Dave Love  <d.love@dl.ac.uk>
+
+	* lex.c: Fix last change.
+
+1996-11-14  Dave Love  <d.love@dl.ac.uk>
+
+	* Make-lang.in, config-lang.in: Remove the (broken) libU77 stuff,
+	pending 0.5.20.
+
+Thu Nov 14 15:40:59 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* bad.def (FFEBAD_UNIMPL_STMT): Explain that invalid
+	intrinsic references can trigger this message, too.
+
+1996-11-12  Dave Love  <d.love@dl.ac.uk>
+
+        * lex.c: Declare dwarfout routines.
+
+        * config-lang.in: Sink grep o/p.
+
+Mon Nov 11 14:21:13 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* g77.c (main): Might as well print version number
+	for --verbose as well.
+
+Thu Nov  7 18:41:41 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* expr.c, lang-options.h, target.h, top.c, top.h: Split out
+	remaining -fugly stuff into -fugly-logint and -fugly-comma,
+	leaving -fugly as simply a `macro' that expands into other
+	options, and eliminate defaults for some of the ugly stuff
+	in target.h.
+
+	* Make-lang.in (gcc-cross): Compile zzz.c, not version.o (!),
+	in to get version info for this target.
+
+	* config-lang.in: Test for GBE patch application based
+	on whether 2.6.x or 2.7.x GBE is detected.
+
+Wed Nov  6 14:19:45 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Make-lang.in (g77): Compile zzz.c in to get version info.
+	* g77.c: Add support for --help and --version.
+
+	* g77.c (lookup_option): Short-circuit long-winded tests
+	when second char is not hyphen, just to save a spot of time.
+
+Sat Nov  2 13:50:31 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* intrin.def: Add FTELL and FSEEK intrinsics, plus new
+	`g' codes for alternate-return (GOTO) arguments.
+	* intrin.c (ffeintrin_check_): Support `g' codes.
+	* com-rt.def: Add ftell_() and fseek_() to database.
+	* com.c (ffecom_expr_intrinsic_): Ditto.  Also, let each
+	subroutine intrinsic decide for itself what to do with
+	tree_type, the default being NULL_TREE once again (so
+	ffecom_call_ doesn't think it's supposed to cast the
+	function call to the type in the fall-through case).
+
+	* ste.c (ffeste_R909_finish): Don't special-case list-directed
+	I/O, now that libf2c can return nonzero status codes.
+	(ffeste_R910_finish): Ditto.
+	(ffeste_io_call_): Simplify logic.
+	(ffeste_io_impdo_):
+	(ffeste_subr_beru_):
+	(ffeste_R904):
+	(ffeste_R907):
+	(ffeste_R909_start):
+	(ffeste_R909_item):
+	(ffeste_R909_finish):
+	(ffeste_R910_start):
+	(ffeste_R910_item):
+	(ffeste_R910_finish):
+	(ffeste_R911_start):
+	(ffeste_R923A): Ditto all the above.
+
+Thu Oct 31 20:56:28 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* config-lang.in, Make-lang.in: Rename flag file
+	build-u77 to build-libu77, for consistency with
+	install-libf2c and such.
+
+	* config-lang.in: Don't complain about failure to patch
+	if pre-2.7.0 gcc is involved (since our patch for that
+	doesn't add support for tooning).
+
+Sat Oct 26 05:56:51 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* bad.def (FFEBAD_TYPELESS_TOO_LARGE): Remove this
+	unused and redundant diagnostic.
+
+Sat Oct 26 00:45:42 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* target.c (ffetarget_integerhex): Fix dumb bug.
+
+1996-10-20  Dave Love  <d.love@dl.ac.uk>
+
+	* gbe/2.7.2.1.diff: New file.
+
+	* Makefile.in (F771_LDFLAGS): Add -bbigtoc for AIX4.1 up, suggested by
+	endo@material.tohoku.ac.jp [among others!].
+
+Sat Oct 19 03:11:14 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* bad.def, bld.c, bld.h, expr.c, lang-options.h, target.c,
+	target.h, top.c, top.h (ffebld_constant_new_integerbinary,
+	ffebld_constant_new_integerhex, ffebld_constant_new_integeroctal,
+	ffeexpr_token_name_apos_name_, ffetarget_integerbinary,
+	ffetarget_integerhex, ffetarget_integeroctal): Support
+	new -fno-typeless-boz option with new functions, mods to
+	existing octal-handling functions, new macros, new error
+	messages, and so on.
+
+	* com.c, lang-options.h, top.c, top.h (ffecom_notify_primary_entry):
+	Print program unit name on stderr if -fno-silent (new option).
+
+	* lang-options.h, top.c, top.h, stt.c (ffestt_dimlist_as_expr):
+	Treat ([...,]1) in dimlist as ([...,]*) if -fugly-assumed
+	(new option).
+
+	* lang-options.h: Comment out options duplicated in gcc/toplev.c,
+	because, somehow, having them commented in and building on my
+	DEC Alpha results in a cc1 that always segfaults, and gdb that
+	also segfaults whenever it debugs it up to init_lex() calling
+	xmalloc() or so.
+
+Thu Oct 17 00:39:27 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* stb.c (ffestb_R10013_): Don't change meaning of .sign until
+	after previous meaning/value used to set sign of value
+	(960507-1.f).
+
+Sun Oct 13 22:15:23 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* top.c (ffe_decode_option): Don't set back-end flags
+	that are nonexistent prior to gcc 2.7.0.
+
+Sun Oct 13 12:48:45 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (convert): Don't convert emulated complex expr to
+	real (via REALPART_EXPR) if the target type is (emulated)
+	complex.
+
+Wed Oct  2 21:57:12 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_debug_kludge_): Set DECL_IN_SYSTEM_HEADER so
+	-Wunused doesn't complain about these manufactured decls.
+	(ffecom_expr_): Ditto, for original (non-ASSIGN'ed) variable.
+	(ffecom_transform_equiv_): Clear DECL_IGNORED_P for aggregate
+	area so it shows up as a debug-accessible symbol.
+	(pushdecl): Default for "invented" identifiers (a g77-specific
+	concept for now) is that they are artificial, in system header,
+	ignored for debugging purposes, used, and (for types) suppressed.
+	This ought to be overkill.
+
+Fri Sep 27 23:13:07 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* ste.c (ffeste_begin_iterdo_, ffeste_end_iterdo_): Support
+	one-trip DO loops (F66-style).
+	* lang-options.h, top.c, top.h (-fonetrip): New option.
+
+Thu Sep 26 00:18:40 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_debug_kludge_): New function.
+	(ffecom_sym_transform_): Use new function for COMMON and EQUIVALENCE
+	members.
+
+	* lang-options.h, top.c, top.h (-fno-debug-kludge):
+	New option.
+
+1996-09-24  Dave Love  <d.love@dl.ac.uk>
+
+	* Make-lang.in (include/f2c.h):
+	Remove dependencies on xmake_file and tmake_file.
+	They expand inconsistently in 2.8 c.f. 2.7; $(GCC_PARTS) depends on
+	them anyhow.
+
+1996-09-22  Dave Love  <d.love@dl.ac.uk>
+
+	* config-lang.in: Add --enable-libu77 option handling.
+
+	* Make-lang.in:
+	Conditionally add --enable-libu77 when running runtime configure.
+	Define LIBU77STAGESTUFF and use it in relevant rules.
+
+1996-08-21  Dave Love  <d.love@dl.ac.uk>
+
+	* Make-lang.in (f77-runtime):
+	`stmp-hdrs' should have been `stmp-headers'.
+
+1996-08-20  Dave Love  <d.love@dl.ac.uk>
+
+	* Make-lang.in (f77-runtime):
+	Depend on stmp-hdrs, not stmp-int-hdrs, since libF77
+	needs float.h.
+
+Sat Jun 22 18:17:11 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_tree_divide_): Fix RECORD_TYPE case to
+	look at type of first field, properly, to determine
+	whether to call c_div or z_div.
+
+Tue Jun  4 04:27:18 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_build_complex_constant_): Explicitly specify
+	TREE_PURPOSE.
+	(ffecom_expr_): Fix thinko.
+	(ffecom_2): For COMPLEX_EXPR, explicitly specify TREE_PURPOSE.
+
+Mon May 27 16:23:43 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Changes to optionally avoid gcc's back-end complex support:
+	* com.c (ffecom_stabilize_aggregate_): New function.
+	(ffecom_convert_to_complex_): New function.
+	(ffecom_make_complex_type_): New function.
+	(ffecom_build_complex_constant_): New function.
+	(ffecom_expr_): For opCONVERT of non-COMPLEX to COMPLEX,
+	don't bother explicitly converting to the subtype first,
+	because gcc does that anyway, and more code would have
+	to be added to find the subtype for the emulated-complex
+	case.
+	(ffecom_f2c_make_type_): Use ffecom_make_complex_type_
+	instead of make_node etc. to make a complex type.
+	(ffecom_1, ffecom_2): Translate operations on COMPLEX operands
+	to appropriate operations when emulating complex.
+	(ffecom_constantunion): Use ffecom_build_complex_constant_
+	instead of build_complex to build a complex constant.
+	(ffecom_init_0): Change point at which types are laid out
+	for improved consistency.
+	Use ffecom_make_complex_type_ instead of make_node etc.
+	to make a complex type.
+	Always calculate storage sizes from TYPE_SIZE, never TYPE_PRECISION.
+	(convert): Use e, not expr, since we've copied into that anyway.
+	For RECORD_TYPE cases, do emulated-complex conversions.
+	(ffecom_f2c_set_lio_code_): Always calculate storage sizes
+	from TYPE_SIZE, never TYPE_PRECISION.
+	(ffecom_tree_divide_): Allow RECORD_TYPE to also be handled
+	by run-time library.
+	(ffecom_expr_intrinsic_): Handle possible RECORD_TYPE as argument
+	to AIMAG intrinsic.
+
+	* top.h, top.c, lang-options.h: Support new -f(no-)emulate-complex option.
+
+	* com.c (ffecom_sym_transform_): Clarify and fix typos in comments.
+
+Mon May 20 02:06:27 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* target.h: Use new REAL_VALUE_UNTO_TARGET_* macros instead
+	of REAL_VALUE_FROM_TARGET_DOUBLE and _SINGLE.
+	Explicitly use long instead of HOST_WIDE_INT for emulation
+	of ffetargetReal1 and ffetargetReal2.
+
+1996-05-20  Dave Love  <d.love@dl.ac.uk>
+
+	* config-lang.in:
+	Test for patch being applied with flag_move_all_movables in toplev.c.
+
+	* install.texi (Patching GNU Fortran):
+	Mention overriding X_CFLAGS rather than
+	editing proj.h on SunOS4.
+
+	* Make-lang.in (F77_FLAGS_TO_PASS):
+	Add X_CFLAGS (convenient for SunOS4 kluge, in
+	particular).
+	(f77.{,mostly,dist}clean): Reorder things, in particular not to delete
+	Makefiles too early.
+
+	* g77.c (DEFAULT_SWITCH_TAKES_ARG): Define a la gcc.c in the
+	current GCC snapshot.
+
+Tue May 14 00:24:07 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	Changes for DEC Alpha AXP support:
+	* com.c (ffecom_init_0): REAL_ARITHMETIC means internal
+	REAL/DOUBLE PRECISION might well have a different size
+	than the compiled type, so don't crash if this is the
+	case.
+	* target.h: Use `int' for ffetargetInteger1,
+	ffetargetLogical1, and magical tests.  Set _f format
+	strings accordingly.
+
+Tue Apr 16 14:08:28 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* top.c (ffe_decode_option): -Wall no longer implies
+	-Wsurprising.
+
+Sat Apr 13 14:50:06 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_char_args_): If item is error_mark_node,
+	set *length that way, too.
+
+	* com.c (ffecom_expr_power_integer_): If either operand
+	is error_mark_node, return that.
+
+	* com.c (ffecom_intrinsic_len_): If item is error_mark_node,
+	return that for length.
+
+	* expr.c (ffeexpr_declare_unadorned_,
+	ffeexpr_declare_parenthesized_): Instead of crashing
+	on unexpected contexts, produce a diagnostic.
+
+	* intrin.c (ffeintrin_check_), intrin.def (impSIGNAL):
+	Allow procedure as second arg to SIGNAL intrinsic.
+
+	* stu.c (ffestu_symter_end_transition_): New function.
+	(ffestu_symter_exec_transition_): Return bool arg.
+	Always transition symbol (don't inhibit when !whereNONE).
+	(ffestu_sym_end_transition): If DUMMY/LOCAL arg has any
+	opANY exprs in its dimlist, diagnose it so it doesn't
+	make it through to later stages that try to deal with
+	dimlist stuff.
+	(ffestu_sym_exec_transition): If sym has any opANY exprs
+	in its dimlist, diagnose it so it becomes opANY itself.
+
+	* symbol.c (ffesymbol_error): If token arg is NULL,
+	just ANY-ize the symbol -- don't produce diagnostic.
+
+Mon Apr  1 10:14:02 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Version 0.5.18 released.
+
+Mon Mar 25 20:52:24 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_expr_power_integer_): Don't generate code
+	that compares COMPLEX (or, as it happens, REAL) via "LT_EXPR",
+	since the back end crashes on that.  (This code would never
+	be executed anyway, but the test that avoids it has now been
+	translated to control whether the code gets generated at all.)
+	Fixes 960323-3.f.
+
+	* com.c (ffecom_type_localvar_): Handle variable-sized
+	dimension bounds expressions here, so they get calculated
+	and saved on procedure entry.  Fixes 960323-4.f.
+
+	* com.c (ffecom_notify_init_symbol): Symbol has no init
+	info at all if only zeros have been used to initialize it.
+	Fixes 960324-0.f.
+
+	* expr.c, expr.h (ffeexpr_type_combine): Renamed from
+	ffeexpr_type_combine_ and now a public procedure; last arg now
+	a token, instead of an internal structure used to extract a token.
+	Now allows the outputs to be aliased with the inputs.
+	Now allows a NULL token to mean "don't report error".
+	(ffeexpr_reduced_bool2_, ffeexpr_reduced_eqop2_,
+	ffeexpr_reduced_math2_, ffeexpr_reduced_power_,
+	ffeexpr_reduced_relop2_): Handle new calling sequence for
+	ffeexpr_type_combine.
+	* (ffeexpr_convert): Don't put an opCONVERT node
+	in just because the size is unknown; all downstream code
+	should be able to deal without it being there anyway, and
+	getting rid of it allows new intrinsic code to more easily
+	combine types and such without generating bad code.
+	* info.c, info.h (ffeinfo_kindtype_max): Rewrite to do
+	proper comparison of size of types, not just comparison
+	of their internal kind numbers (so I2.eq.I1 doesn't promote
+	I1 to I2, rather the other way around).
+	* intrin.c (ffeintrin_check_): Combine types of arguments
+	in COL a la expression handling, for greater flexibility
+	and permissiveness (though, someday, -fpedantic should
+	report use of this kind of thing).
+	Make sure Hollerith/typeless where CHARACTER expected is
+	rejected.  This all fixes 960323-2.f.
+
+	* ste.c (ffeste_begin_iterdo_): Fix some more type conversions
+	so INTEGER*2-laden DO loops don't crash at compile time on
+	certain machines.  Believed to fix 960323-1.f.
+
+	* stu.c (ffestu_sym_end_transition): Certainly reject
+	whereDUMMY not in any dummy list, whether stateUNCERTAIN
+	or stateUNDERSTOOD.  Fixes 960323-0.f.
+
+Tue Mar 19 13:12:40 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* data.c (ffedata_value): Fix crash on opANY, and simplify
+	the code at the same time.
+
+	* Make-lang.in (f77-runtime): Also depends on lib[FI]77/Makefile...
+	(include/f2c.h...): ...which in turn depend on */Makefile.in.
+	(f77.rebuilt): Rebuild runtime stuff too.
+
+	* intrin.c (ffeintrin_check_): Accommodate TYPELESS/HOLLERITH
+	types, convert args as necessary, etc.
+
+	* expr.c (ffeexpr_convert): Fix test for TYPELESS/HOLLERITH
+	to obey the docs; crash if no source token when error.
+	(ffeexpr_collapse_convert): Crash if no token when error.
+
+Mon Mar 18 15:51:30 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_init_zero_): Renamed from
+	ffecom_init_local_zero_; now handles top-level
+	(COMMON) initializations too.
+
+	* bld.c (ffebld_constant_is_zero):
+	* com.c (ffecom_symbol_transform_, ffecom_sym_transform_assign_,
+	ffecom_transform_common_, ffecom_transform_equiv_):
+	* data.c:
+	* equiv.c:
+	* equiv.h:
+	* lang-options.h:
+	* stc.c:
+	* storag.c:
+	* storag.h:
+	* symbol.c:
+	* symbol.h:
+	* target.c:
+	* target.h:
+	* top.c:
+	* top.h: All of this is mostly housekeeping-type changes
+	to support -f(no-)zeros, i.e. not always stuff zero
+	values into the initializer fields of symbol/storage objects,
+	but still track that they have been given initial values.
+
+	* bad.def: Fix wording for DATA-related diagnostics.
+
+	* com.c (ffecom_sym_transform_assign_): Don't check
+	any EQUIVALENCE stuff for local ASSIGN, the check was
+	bad (crashing), and it's not necessary, anyway.
+
+	* com.c (ffecom_expr_intrinsic_): For MAX and MIN,
+	ignore null arguments as far arg[123], and fix handling
+	of ANY arguments.  (New intrinsic support now allows
+	spurious trailing null arguments.)
+
+	* com.c (ffecom_init_0): Add HOLLERITH (unsigned)
+	equivalents for INTEGER*2, *4, and *8, so shift intrinsics
+	and other things that need unsigned versions of signed
+	types work.
+
+Sat Mar 16 12:11:40 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* storag.c (ffestorag_exec_layout): Treat adjustable
+	local array like dummy -- don't create storage object.
+	* com.c (ffecom_sym_transform_): Allow for NULL storage
+	object in LOCAL case (adjustable array).
+
+Fri Mar 15 13:09:41 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_sym_transform_): Allow local symbols
+	with nonconstant sizes (adjustable local arrays).
+	(ffecom_type_localvar_): Allow dimensions with nonconstant
+	component (adjustable local arrays).
+	* expr.c: Various minor changes to handle adjustable
+	local arrays (a new case of stateUNCERTAIN).
+	* stu.c (ffestu_sym_end_transition,
+	ffestu_sym_exec_transition): Ditto.
+	* symbol.def: Update docs to reflect these changes.
+
+	* com.c (ffecom_expr_): Reduce space/time needed for
+	opACCTER case by handling it here instead of converting
+	it to opARRTER earlier on.
+	(ffecom_notify_init_storage): Don't convert ACCTER to ARRTER.
+	(ffecom_notify_init_symbol): Ditto.
+
+	* com.c (ffecom_init_0): Crash and burn if any of the types'
+	sizes, according to the GBE, disagrees with the sizes of
+	the FFE's internal implementation.  This might catch
+	Alpha/SGI bugs earlier.
+
+Fri Mar 15 01:09:41 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com-rt.def, com.c, com.h: Changes for rewrite of intrinsic
+	handling.
+	* com.c (ffecom_arglist_expr_): New function.
+	(ffecom_widest_expr_type_): New function.
+	(ffecom_expr_intrinsic_): Reorganize, some rewriting.
+	(ffecom_f2c_make_type_): Layout complex types.
+	(ffecom_gfrt_args_): New function.
+	(ffecom_list_expr): Trivial change for consistency.
+
+	* expr.c (ffeexpr_token_name_rhs_): Go back to getting
+	type from specific, not implementation, info.
+	(ffeexpr_token_funsubstr_): Set intrinsic implementation too!
+	* intrin.c: Major rewrite of most portions.
+	* intrin.def: Major rearchitecting of tables.
+	* intrin.h (ffeintrin_basictype, ffeintrin_kindtype):
+	Now (once again) take ffeintrinSpec as arg, not ffeintrinImp;
+	for now, these return NONE, since they're not really needed
+	and adding the necessary info to the tables is not trivial.
+	(ffeintrin_codegen_imp): New function.
+	* stc.c (ffestc_R1208_item): Change way ffeintrin funcs called,
+	back to original per above; but comment out the code anyway.
+
+	* intrin.c (ffe_init_0): Do internal checks only if
+	-fset-g77-defaults not specified.
+
+	* lang-options.h: Add -fset-g77-defaults option.
+	* lang-specs.h: Always pass -fset-g77-defaults.
+	* top.c, top.h: New option.
+
+Sat Mar  9 17:49:50 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Make-lang.in (stmp-int-hdrs): Use --no-validate when
+	generating the f77.rebuilt files (BUGS, INSTALL, NEWS)
+	so cross-references can work properly in g77.info
+	without a lot of hassle.  Users can probably deal with
+	the way they end up looking in the f77.rebuilt files.
+
+	* bld.c (ffebld_constant_new_integer4_val): INTEGER*8
+	support -- new function.
+	(ffebld_constant_new_logical4_val): New function.
+	* com.c (ffecom_f2c_longint_type_node): New type.
+	(FFECOM_rttypeLONGINT_): New return type code.
+	(ffecom_expr_): Add code to invoke pow_qq instead
+	of pow_ii for INTEGER4 (INTEGER*8) case.
+	If ffecom_expr_power_integer_ returns NULL_TREE, just do
+	the usual work.
+	(ffecom_make_gfrt_): Handle new type.
+	(ffecom_expr_power_integer_): Let caller do the work if in
+	dummy-transforming case, since
+	caller now knows about INTEGER*8 and such, by returning
+	NULL_TREE.
+	* expr.c (ffeexpr_reduced_power_): Complain about non-INTEGER
+	raised to INTEGER4 (INTEGER*8) power.
+
+	* target.c (ffetarget_power_integerdefault_integerdefault):
+	Fix any**negative.
+	* com.c (ffecom_expr_power_integer_): Fix (-1)**(-8) and similar
+	to ABS() the integral result if the exponent is negative
+	and even.
+
+	* ste.c (ffeste_begin_iterdo_): Clean up a type ref.
+	Always convert iteration count to _default_ INTEGER.
+
+	* sta.c (ffesta_second_): Add BYTE and WORD type/stmts;
+	changes by Scott Snyder <snyder@d0sgif.fnal.gov>.
+	* stb.c (ffestb_decl_recursive): Ditto.
+	(ffestb_decl_recursive): Ditto.
+	(ffestb_decl_entsp_2_): Ditto.
+	(ffestb_decl_entsp_3_): Ditto.
+	(ffestb_decl_funcname_2_): Ditto.
+	(ffestb_decl_R539): Ditto.
+	(ffestb_decl_R5395_): Ditto.
+	* stc.c (ffestc_establish_declstmt_): Ditto.
+	* std.c (ffestd_R539item): Ditto.
+	(ffestd_R1219): Ditto.
+	* stp.h: Ditto.
+	* str-1t.fin: Ditto.
+	* str-2t.fin: Ditto.
+
+	* expr.c (ffeexpr_finished_): For DO loops, allow
+	any INTEGER type; convert LOGICAL (assuming -fugly)
+	to corresponding INTEGER type instead of always default
+	INTEGER; let later phases do conversion of DO start,
+	end, incr vars for implied-DO; change checks for non-integral
+	DO vars to be -Wsurprising warnings.
+	* ste.c (ffeste_io_impdo_): Convert start, end, and incr
+	to type of DO variable.
+
+	* com.c (ffecom_init_0): Add new types for [IL][234],
+	much of which was done by Scott Snyder <snyder@d0sgif.fnal.gov>.
+	* target.c: Ditto.
+	* target.h: Ditto.
+
+Wed Mar  6 14:08:45 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* top.c (ffe_init_gbe_): Make -frerun-loop-opt the default.
+
+Mon Mar  4 12:27:00 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* expr.c (ffeexpr_exprstack_push_unary_): Really warn only
+	about two successive _arithmetic_ operators.
+
+	* stc.c (ffestc_R522item_object): Allow SAVE of (understood)
+	local entity.
+
+	* top.c (ffe_decode_option): New -f(no-)second-underscore options.
+	* top.h: New options.
+	* com.c (ffecom_get_external_identifier_, ffecom_get_identifier_):
+	New options.
+
+	* Make-lang.in (f77.maintainer-clean): Clean f/BUGS, f/INSTALL,
+	f/NEWS.
+	($(srcdir)/f/BUGS, $(srcdir)/f/INSTALL, $(srcdir)/f/NEWS):
+	New rules.
+	($(srcdir)/f/g77.info, $(srcdir)/f/g77.dvi): Depend on
+	f/bugs.texi and f/news.texi.
+	(f77.install-man): Install f77 man pages (if enabled).
+	(f77.uninstall): Uninstall info docs, f77 man pages (if enabled).
+
+	* top.c (ffe_init_gbe_): New function.
+	(ffe_decode_option, ffe_file): Call ffe_init_gbe_ to
+	set defaults for gcc options.
+
+Sat Jan 20 13:57:19 1996  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_get_identifier_): Eliminate needless
+	comparison of results of strchr.
+
+Tue Dec 26 11:41:56 1995  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* Make-lang.in: Add rules for new files g77.texi, g77.info,
+	and g77.dvi.
+	Reorganize the *clean rules to more closely parallel gcc's.
+
+	* config-lang.in: Exclude g77.info from diffs.
+
+Sun Dec 10 02:29:13 1995  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* expr.c (ffeexpr_declare_unadorned_,
+	ffeexpr_declare_parenthesized_): Break out handling of
+	contextDATAIMPDO[INDEX,CTRL] so it's independent of symbol state.
+	Don't exec-transition these here (let ffeexpr_sym_impdoitem_
+	handle that when appropriate).  Don't "declare" them twice.
+
+Tue Dec  5 06:48:26 1995  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* stc.c (ffestc_promote_sfdummy_): Allow whereNONE parent
+	symbol, since it is not necessarily known whether it will
+	become LOCAL or DUMMY.
+
+Mon Dec  4 03:46:55 1995  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* lex.c (ffelex_display_token, ffelex_type_string_): Resurrect
+	these from their old versions and update them for possible invocation
+	from debugger.
+	* lex.h (ffelex_display_token): Declare this in case anyone
+	else wants to call it.
+
+	* lex.c (ffelex_total_tokens_): Have this reflect actual allocated
+	tokens, no longer include outstanding "uses" of tokens.
+
+	* malloc.c, malloc.h (MALLOC_DEBUG): New macro to control
+	checking of whether callers follow rules, now defaults to 0
+	for "no checking" to improve compile times.
+
+	* malloc.c (malloc_pool_kill): Fix bug that could prevent
+	subpool from actually being killed (wasn't setting its use
+	count to 1).
+
+	* proj.h, *.c (dmpout): Replace all occurrences of `stdout'
+	and some of `stderr' with `dmpout', so where to dump debugging
+	output can be easily controlled during build; add default
+	for `dmpout' of `stderr' to proj.h.
+
+Sun Dec  3 00:56:29 1995  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* com.c (ffecom_return_expr): Eliminate attempt at warning
+	about unset return values, since the back end does this better,
+	with better wording, and is not triggered by clearly working
+	(but spaghetti) code as easily as this test.
+
+Sat Dec  2 08:28:56 1995  Craig Burley  <burley@gnu.ai.mit.edu>
+
+	* target.c (ffetarget_power_*_integerdefault): Raising 0 to
+	integer constant power should not be an error condition;
+	if so, other code should catch 0 to any power, etc.
+
+	* bad.def (FFEBAD_BAD_POWER): 0**integer now a warning instead
+	of an error.
+
+Fri Dec  1 00:12:03 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* bad.def: Clarify diagnostic regarding complex constant elements.
+	* expr.c (ffeexpr_cb_comma_c_): Capitalize real/imaginary
+	for clarified diagnostic.
+
+	* com.c (ffecom_close_include_): Close the file!
+
+	* lex.c (ffelex_file_fixed): Update line info if the line
+	has any content, not just if it finishes a previous line
+	or has a label.
+	(ffelex_file_free): Clarify switch statement code.
+
+Sat Nov 18 19:37:22 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.17 released.
+
+Fri Nov 17 14:27:24 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Make-lang.in: Fix typo in comment.
+
+	* Makefile.in (f/fini.o, f/proj-h.o): Don't use `$<' since
+	not all makes support it (e.g. NeXT make), use explicit
+	source name instead (with $(srcdir) and munging).
+	(ASSERT_H): assert.h lives in source dir, not build dir.
+
+Thu Nov 16 12:47:50 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c (ffecom_init_0): Fix dumb bug in code to produce
+	warning message about non-32-bit-systems.
+
+	* stc.c (ffestc_R501_item): Parenthesize test to make
+	warning go away (and perhaps fix bug).
+
+Thu Nov 16 03:43:33 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* g77.c: Upgrade to 2.7.0's gcc.c.
+	Fix -v to pass a temp name instead of "/dev/null" for "-o".
+
+Fri Nov 10 19:16:05 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* ste.c (ffeste_begin_iterdo_): Add Toon's change to
+	make loops faster on some machines (implement termination
+	condition as "--i >= 0" instead of "i-- > 0").
+
+Thu Nov  2 03:58:17 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Make-lang.in: Remove unnecessary $(exeext) a la cp/Make-lang.in.
+
+	* com.c (ffecom_expr_): Restore old strategy for assignp variant
+	of opSYMTER case...always return the ASSIGN version of var.
+	That way, `-O -Wuninitialized' will catch "I=3;GOTO I;END"
+	(though the diagnostic will refer to `__g77_ASSIGN_i').
+
+	* com.c (ffecom_expr_power_integer_): For constant rhs case,
+	wrap every new eval of lhs in save_expr() so it is clear to
+	back end that MULT_EXPR(lhs,lhs) has identical operands,
+	otherwise for an rhs like 32767 it generates around 65K pseudo
+	registers, with which stupid_life_analysis cannot cope
+	(due to reg_renumber in regs.h being `short *' instead of
+	`int *').
+
+	* com.c (ffecom_expr_): Speed up implementation of LOGICAL
+	versions of opNOT, opAND, opOR, opXOR/opNEQV, and opEQV by
+	assuming the values actually are kosher LOGICAL bit patterns.
+	Also simplify code that implements some of the INTEGER versions
+	of these.
+
+	* com.c (skip_redundant_dir_prefix, read_name_map,
+	ffecom_open_include_, signed_type, unsigned_type): Fold in
+	changes to cccp.c made from 2.7.0 through ss-950826.
+
+	* equiv.c (ffeequiv_layout_local_): Kill the equiv list
+	if no syms in list.
+
+	* expr.c (ffeexpr_reduced_eqop2_): Issue specific diagnostic
+	regarding usage of .EQV./.NEQV. in preference to .EQ./.NE..
+
+	* intrin.c: Add ERF and ERFC as generic intrinsics.
+	intrin.def: Same.
+
+	* sta.c (ffesta_save_, ffesta_second_): Whoever calls
+	ffestd_exec_begin must also set ffesta_seen_first_exec = TRUE,
+	and anytime stc sees an exec transition, it must do both.
+	stc.c (ffestc_eof): Same.
+
+	* stc.c (ffestc_promote_sfdummy_): If failed implicit typing
+	or CHARACTER*(*) arg, after calling ffesymbol_error, don't
+	reset info to ENTITY/DUMMY, because ffecom_sym_transform_
+	doesn't expect such a thing with ANY/ANY type.
+
+	* target.h (*logical*): Change some of these so they parallel
+	changes in com.c, e.g. for _eqv_, use (l)==(r) instead of
+	!!(l)==!!(r), to get a more faithful result.
+
+Fri Oct 27 07:06:59 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c (ffecom_sym_transform_): Simplify code for local
+	EQUIVALENCE case.
+
+	* expr.c (ffeexpr_exprstack_push_unary_): Warn about two
+	successive operators.
+	(ffeexpr_exprstack_push_binary_): Warn about "surprising"
+	operator precedence, as in "-2**2".
+
+	* lang-options.h: Add -W(no-)surprising options.
+
+	* parse.c (yyparse): Don't reset -fpedantic if not -pedantic.
+
+	* top.c (ffe_decode_option): Support new -Wsurprising option.
+	* top.h: Ditto.
+
+Mon Oct 23 09:14:15 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c (ffecom_finish_symbol_transform_): Don't transform
+	NONE/NONE (CHARACTER*(*)) vars, as these don't mean anything
+	in debugging terms, and can't be turned into anything
+	in the back end (so ffecom_sym_transform_ crashes on them).
+
+	* com.c (ffecom_expr_): Change strategy for assignp variant
+	of opSYMTER case...always return the original var unless
+	it is not wide enough.
+
+	* ste.c (ffeste_io_cilist_): Clarify diagnostic for ASSIGN
+	involving too-narrow variable.  This shouldn't happen, though.
+	(ffeste_io_icilist_): Ditto.
+	(ffeste_R838): Ditto.
+	(ffeste_R839): Ditto.
+
+Thu Oct 19 03:21:20 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c (ffecom_sym_transform_assign_): Set TREE_STATIC
+	using the same decision-making process as used for their twin
+	variables, so ASSIGN can last across RETURN/CALL as appropriate.
+
+Fri Sep 22 20:21:18 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Makefile.in: fini is a host program, so it needs a host-compiled
+	version of proj.o, named proj-h.o.  f/fini, f/fini.o, and
+	f/proj-h.o targets updated accordingly.
+
+	* com.c (__eprintf): New function.
+
+Wed Sep 20 02:26:36 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* lang-options.h: Add omitted -funix-intrinsics-* options.
+
+	* malloc.c (malloc_find_inpool_): Check for infinite
+	loop, crash if detected (user reports encountering
+	them in some large programs, this might help track
+	down the bugs).
+
+Thu Sep  7 13:00:32 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c (lang_print_error_function): Don't dereference null
+	pointer when outside any program unit.
+	(ffecom_let_char_, ffecom_arg_ptr_to_expr): If catlist
+	item or length ever error_mark_node, don't continue processing,
+	since back-end functions like build_pointer_type crash on
+	error_mark_node's (due to pushing bad obstacks, etc.).
+
+Wed Aug 30 15:58:35 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.16 released.
+
+Mon Aug 28 12:24:20 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* bad.c (ffebad_finish): Fix botched message when no places
+	are printed (due to unknown line info, etc.).
+
+	* std.c (ffestd_subr_labels_): Do a better job finding
+	line info in the case of typeANY and diagnostics.
+
+Fri Aug 25 15:19:29 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c (DECL_ARTIFICIAL): Surround all references to this
+	macro with #if !BUILT_FOR_270 and #endif.
+	(init_lex): Surround print_error_function decl with
+	#if !BUILT_FOR_270 and #endif.
+	(lang_init): Call new ffelex_hash_kludge function to solve
+	problem with preprocessed files that have INCLUDE statements.
+
+	* lex.c (ffelex_getc_): New function.
+	(ffelex_cfelex_): Use ffelex_getc_ instead of getc in any
+	paths of code that can be affected by ffelex_hash_kludge.
+	Don't make an EOF token for unrecognized token; set token
+	to NULL instead, to avoid problems when not initialized.
+	(ffelex_hash_): Use ffelex_getc_ instead of getc in any
+	paths of code that can be affected by ffelex_hash_kludge.
+	Test token returned by ffelex_cfelex_ for NULL, meaning
+	unrecognized token.
+	Get rid of useless used_up variable.
+	Don't do ffewhere stuff or kill any tokens if in
+	ffelex_hash_kludge.
+	(ffelex_file_fixed, ffelex_file_free): Use ffelex_getc_
+	instead of getc in any paths of code that can be affected
+	by ffelex_hash_kludge.
+	(ffelex_hash_kludge): New function.
+
+	* lex.h (ffelex_hash_kludge): New function.
+
+Wed Aug 23 15:17:40 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c: Implement -f(no-)underscoring options by always
+	compiling in code to do it, and having that code inhibit
+	itself when -fno-underscoring is in effect.  This option
+	overrides -f(no-)f2c for this purpose; -f(no-)f2c returns
+	to it's <=0.5.15 behavior of affecting only how code
+	is generated, not how/whether names are mangled.
+
+	* target.h: Redo specification of appending underscores so
+	the macros are named "_default" instead of "_is" and the
+	two-underscore macro defaults to 1.
+
+	* top.c, top.h (underscoring): Add appropriate stuff
+	for the -f(no-)underscoring options.
+
+Tue Aug 22 10:25:01 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* bad.c (ffebad_finish): Call report_error_function (in toplev.c)
+	to better identify location of problem.
+	Say "(continued):" instead of "(continued:)" for consistency.
+
+	* com.c (ffecom_gen_sfuncdef_): Set and reset new
+	ffecom_nested_entry_ variable to hold ffesymbol being compiled.
+	(lang_print_error_function): New function from toplev.c.
+	Use ffecom_nested_entry_ to help determine which name
+	and kind-string to print.
+	(ffecom_expr_intrinsic_): Handle EXIT and FLUSH invocations
+	with different calling sequences than library functions.
+	Have SIGNAL and SYSTEM push and pop calltemps, and convert
+	their return values to the destination type (just in case).
+	(FFECOM_rttypeINT_): New return type for `int', in case
+	gcc/f/runtime/libF77/system_.c(system_) is really supposed
+	to return `int' instead of `ftnint'.
+
+	* com.h (report_error_function): Declare this.
+
+	* equiv.c (ffeequiv_layout_local_): Don't forget to consider
+	root variable itself as possible "first rooted variable",
+	else might never set symbol and then crash later.
+
+	* intrin.c (ffeintrin_check_exit_): Change to allow no args
+	and rename to ffeintrin_check_int_1_o_ for `optional'.
+	#define ffeintrin_check_exit_ and _flush_ to this new
+	function, so intrin.def can refer to the appropriate names.
+
+	* intrin.def (FFEINTRIN_impFLUSH): Validate using
+	ffeintrin_check_flush_ so passing an INTEGER arg is allowed.
+
+	* lex.c (ffelex_file_push_, ffelex_file_pop_): New functions
+	to manage input_file_stack in gbe.
+	(ffelex_hash_): Call new functions (instead of doing code).
+	(ffelex_include_): Call new functions to update stack for
+	INCLUDE (_hash_ handles cpp output of #include).
+
+Mon Aug 21 08:09:04 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Makefile.in: Put `-W' in front of every `-Wall', since
+	2.7.0 requires that to engage `-Wunused' for parameters.
+
+	* com.c: Mark all parameters as artificial, so
+	`-W -Wunused' doesn't complain about unused ones (since
+	there's no way right not to individually specify attributes
+	like `unused').
+
+	* proj.h: Don't #define UNUSED if already defined, regardless
+	of host compiler.
+
+Sun Aug 20 16:03:56 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* gbe/2.7.0.diff: Regenerate.
+
+	* lang-options.h, lang-specs.h: If not __STDC__ (ANSI C),
+	avoid doing anything, especially the stringizing in -specs.h.
+
+Thu Aug 17 03:36:12 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* lang-specs.h: Remove useless optional settings of -traditional,
+	since -traditional is always set anyway.
+
+Wed Aug 16 16:56:46 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Make-lang.in (F2C_INSTALL_FLAG, F2CLIBOK): More
+	control over whether to install f2c-related stuff.
+	(install-f2c-*): New targets to install f2c-related
+	stuff in system, not just gcc, directories.
+
+	* com.c: Change calls to ffecom_get_invented_identifier
+	to use generally more predictable names.
+	Change calls to build_range_type to ensure consistency
+	of types of operands.
+	(ffecom_get_external_identifier_): Change to accept
+	symbol info, not just text, so it can use f2c flag for
+	symbol to decide whether to append underscore(s).
+	(ffecom_get_identifier_): Don't change names if f2c flag
+	off for compilation.
+	(ffecom_type_permanent_copy_): Use same type for new max as
+	used for min.
+	(ffecom_notify_init_storage): Offline fixups for stand-alone.
+
+	* data.c (ffedata_gather): Explicitly test for common block,
+	since it's no longer always the case that a local EQUIVALENCE
+	group has no symbol ptr (it now can, if a user-predictable
+	"rooted" symbol has been identified).
+
+	* equiv.c: Add some debugging stuff.
+	(ffeequiv_layout_local_): Set symbol ptr with user-predictable
+	"rooted" symbol, for giving the invented aggregate a
+	predictable name.
+
+	* g77.c (append_arg): Allow for 20 extra args instead of 10.
+	(main): For version-only case, add `-fnull-version' and, unless
+	explicitly omitted, `-lf2c -lm'.
+
+	* lang-options.h: New "-fnull-version" option.
+
+	* lang-specs.h: Support ".fpp" suffix for preprocessed source
+	(useful for OS/2, MS-DOS, other case-insensitive systems).
+
+	* stc.c (ffestc_R544_equiv_): Swap way lists are merged so this
+	is consistent with the order in which lists are built, making
+	user predictability of invented aggregate name much higher.
+
+	* storag.c, storag.h (FFESTORAG_typeDUMMY): Delete this enum.
+
+	* top.c: Accept, but otherwise ignore, `-fnull-version'.
+
+Tue Aug 15 07:01:07 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* DOC, INSTALL, PROJECTS: Extensive improvements to documentation.
+
+Sun Aug 13 01:55:18 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* INSTALL (f77-install-ok): Document the use of this file.
+
+	* Make-lang.in (F77_INSTALL_FLAG): New flag to control
+	whether to install an `f77' command (based on whether
+	a file named `f77-install-ok' exists in the source or
+	build directory) to replace the broken attempt to use
+	comment lines to avoid installing `f77' (broken in the
+	sense that it prevented installation of `g77').
+
+Mon Aug  7 06:14:26 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* DOC: Add new sections for g77 & gcc compiler options,
+	source code form, and types, sizes and precisions.
+	Remove lots of old "delta-version" info, or at least
+	summarize it.
+
+	* INSTALL: Add info here that used to be in DOC.
+	Other changes.
+
+	* g77.c (lookup_option, main): Check for --print-* options,
+	so we avoid adding version-determining stuff.
+
+Wed Jul 26 15:51:03 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Make-lang.in, Makefile.in (input.j, INPUT_H): New file.
+	Update dependencies accordingly.
+
+	* bad.c (ffebad_here): Okay to use unknown line/col.
+
+	* compilers.h (@f77-cpp-input): Remove -P option now that
+	# directives are handled by f771.  Update other options
+	to be more consistent with @c in gcc/gcc.c.  Don't run f771
+	if -E specified, etc., a la @c.
+	(@f77): Don't run f771 if -E specified, etc., a la @c.
+
+	* config-lang.in: Avoid use of word "guaranteed".
+
+	* input.j: New file to wrap around gcc/input.h.
+
+	* lex.j: Add support for parsing # directives output by cpp.
+	(ffelex_cfebackslash_): New function.
+	(ffelex_cfelex_): New function.
+	(ffelex_get_directive_line_): New function.
+	(ffelex_hash_): New function.
+	(ffelex_include_): Change to not use ffewhere_file_(begin|end).
+	Also fix bug in pointing to next line (for diagnostics, &c)
+	following successful INCLUDE.
+	(ffelex_next_line_): New function that does chunk of code
+	seen in several places elsewhere in the lexers.
+	(ffelex_file_fixed): Delay finishing statement until source
+	line is registered with ffewhere, so INCLUDE processing
+	picks up the info correctly.
+	Okay to kill or use unknown line/col objects now.
+	Handle HASH (#) lines.
+	Reorder tests for insubstantial lines to put most frequent
+	occurrences at top, for possible minor speedup.
+	Some general consolidation of code.
+	(ffelex_file_free): Handle HASH (#) lines.
+	Okay to kill or use unknown line/col objects now.
+	Some general consolidation of code.
+	(ffelex_init_1): Detect HASH (#) lines.
+	(ffelex_set_expecting_hollerith): Okay to kill or use unknown
+	line/col objects now.
+
+	* lex.h (FFELEX_typeHASH): New enum.
+
+	* options-lang.h (-fident, -fno-ident): New options.
+
+	* stw.c (ffestw_update): Okay to kill unknown line/col objects
+	now.
+
+	* target.h (FFETARGET_okREALQUAD, FFETARGET_okCOMPLEXDOUBLE,
+	FFETARGET_okCOMPLEXQUAD): #define these appropriately.
+
+	* top.c: Include flag.j wrapper, not flags.h directly.
+	(ffe_is_ident_): New flag.
+	(ffe_decode_option): Handle -fident and -fno-ident.
+	(ffe_file): Replace obsolete ffewhere_file_(begin|end) with
+	ffewhere_file_set.
+
+	* top.h (ffe_is_ident_, ffe_is_ident, ffe_set_is_ident):
+	New flag and access functions.
+
+	* where.c, where.h: Remove all tracking of parent file.
+	(ffewhere_file_begin, ffewhere_file_end): Delete these.
+	(ffewhere_line_use): Make it work with unknown line object.
+
+Mon Jul 17 03:04:09 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c (ffecom_sym_transform_): Set DECL_IN_SYSTEM_HEADER
+	flag for any local vars used as stmtfunc dummies or DATA
+	implied-DO iter vars, so no -Wunused warnings are produced
+	for them (a la f2c).
+	(ffecom_init_0): Do "extern int xargc;" for IARGC() intrinsic.
+	Warn if target machine not 32 bits, since g77 isn't yet
+	working on them at all well.
+
+	* expr.c (ffeexpr_sym_lhs_call_, ffeexpr_sym_lhs_data_,
+	ffeexpr_sym_lhs_extfunc_, ffeexpr_sym_rhs_actualarg_,
+	ffeexpr_sym_rhs_let_, ffeexpr_paren_rhs_let_): Don't
+	gratuitously set attr bits that don't apply just
+	to avoid null set meaning error; instead, use explicit
+	error flag, and allow null attr set, to
+	fix certain bugs discovered by looking at this code.
+
+	* g77.c: Major changes to improve support for gcc long options,
+	to make `g77 -v' report more useful info, and so on.
+
+Mon Jul  3 14:49:16 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* DOC, com.c, intrin.h, intrin.c, intrin.def, target.h, top.c,
+	top.h: Add new `unix' group of intrinsics, which includes the
+	newly added ERF, ERFC, EXIT, plus even newer ABORT, DERF, DERFC,
+	FLUSH, GETARG, GETENV, SIGNAL, and SYSTEM.
+
+Tue Jun 27 23:01:05 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* bld.c, bld.h (ffebld_constant_pool,
+	ffebld_constant_character_pool): Use a single macro (the
+	former) to access the pool for allocating constants, instead
+	of latter in public and FFEBLD_CONSTANT_POOL_ internally
+	in bld.c (which was the only one that was correct before
+	these changes).  Add verification of integrity of certain
+	heap-allocated areas.
+
+	* com.c (ffecom_overlap_, ffecom_args_overlap_,
+	ffecom_tree_canonize_ptr_, ffecom_tree_canonize_ref_): New
+	functions to optimize calling COMPLEX and, someday, CHARACTER
+	functions requiring additional argument to be passed.
+	(ffecom_call_, ffecom_call_binop_, ffecom_expr_,
+	ffecom_expr_intrinsic_): Change calling
+	sequences to include more info on possible destination.
+	(ffecom_expr_intrinsic_): Add ERF(), ERFC(), and EXIT()
+	intrinsic code.
+	(ffecom_sym_transform_): For assumed-size arrays, set high
+	bound to highest possible value instead of low bound, to
+	improve validity of overlap checking.
+	(duplicate_decls): If olddecl and newdecl are the same,
+	don't do any munging, just return affirmative.
+
+	* expr.c: Change ffecom_constant_character_pool() to
+	ffecom_constant_pool().
+
+	* info.c (ffeinfo_new): Compile this version if not being
+	compiled by GNU C.
+
+	* info.h (ffeinfo_new): Don't define macro if not being
+	compiled by GNU C.
+
+	* intrin.c, intrin.def: Add ERF(), ERFC(), and EXIT() intrinsics.
+	(ffeintrin_check_exit_): New for EXIT() subroutine intrinsic.
+
+	* malloc.c, malloc.h (malloc_verify_*): New functions to verify
+	integrity of heap-storage areas.
+
+	* stc.c (ffestc_R834, ffestc_R835): Handle possibility that
+	an enclosing DO won't have a construct name even when the
+	CYCLE/EXIT does (i.e. without dereferencing NULL).
+
+	* target.c, target.h (ffetarget_verify_character1): New function
+	to verify integrity of heap storage used to hold character constant.
+
+Thu Jun 22 15:36:39 1995  Howard Gordon  (flash@super.org)
+
+	* stp.h (ffestpVxtcodeIx): Fix typo in typedef for this.
+
+Mon May 29 15:22:31 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* *: Make all sorts of changes to accommodate upcoming gcc-2.7.0.
+	I didn't keep track of them, nor just when I made them, nor
+	when I (much later, probably in early August 1995) modified
+	them so they could properly handle both 2.7.0 and 2.6.x.
+
+	* com.c (ffecom_expr_power_integer_): Don't expand_start_stmt_expr
+	if transforming dummy args, because the back end cannot handle
+	that (it's rejected by the gcc front end), just generate
+	call to run-time library.
+	Back out changes in 0.5.15 because more temporaries might be
+	needed anyway (for COMPLEX**INTEGER).
+	(ffecom_push_tempvar): Remove inhibitor.
+	Around start_decl and finish_decl (in particular, arround
+	expand_decl, which is called by them), push NULL_TREE into
+	sequence_rtl_expr, an external published by gcc/function.c.
+	This makes sure the temporary is truly in the function's
+	context, not the inner context of a statement-valued expression.
+	(I think the back end is inconsistent here, but am not
+	interested in convincing the gbe maintainers about this now.)
+	(pushdecl): Make sure that when pushing PARM_DECLs, nothing
+	other than them are pushed, as happened for 0.5.15 and which,
+	if done for other reasons not fixed here, might well indicate
+	some other problem -- so crash if it happens.
+
+	* equiv.c (ffeequiv_layout_local_): If the local equiv group
+	has a non-nil COMMON field, it should mean that an error has
+	occurred and been reported, so just trash the local equiv
+	group and do nothing.
+
+	* stc.c (ffestc_promote_sfdummy_): Set sfdummy arg state to
+	UNDERSTOOD so above checking for duplicate args actually
+	works, and so we don't crash later in pushdecl.
+
+	* ste.c (ffeste_R1001): Set initial value only for VAR_DECLs,
+	not for, e.g., LABEL_DECLs, which the FORMAT label can be
+	if it was previously treated as an executable label.
+
+Sat May 20 01:53:53 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c (ffecom_sym_transform_): For adjustable arrays,
+	pass high bound through variable_size in case its primaries
+	are changed (dumb0.f, and this might also improve
+	performance so it approaches f2c|gcc).
+
+Fri May 19 11:00:36 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.15 released.
+
+	* com.c (ffecom_expr_power_integer_): Push temp vars
+	before expanding a statement expression, since that seems
+	to cause temp vars to be "forgotten" after the end of the
+	expansion in the back end.  Disallow more temp-var
+	pushing during such an expansion, just in case.
+	(ffecom_push_tempvar): Crash if a new variable needs to be
+	pushed but cannot be at this point (should never happen).
+
+Wed May 17 12:26:16 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* expr.c (ffeexpr_collapse_convert): Add code to convert
+	LOGICAL to CHARACTER.  Reject conversion of REAL or COMPLEX
+	to CHARACTER entirely, as it cannot be supported with all
+	configurations.
+
+	* target.h, target.c (ffetarget_convert_character1_logical1):
+	New function.
+
+Sun May 14 00:00:09 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c (ffecom_do_entry_, ffecom_gen_sfuncdef_,
+	ffecom_start_progunit_, ffecom_sym_transform_,
+	ffecom_init_0, start_function): Changes to have REAL
+	external functions return same type as DOUBLE PRECISION
+	external functions when -ff2c is in force; while at it,
+	some code cleanups done.
+
+	* stc.c (ffestc_R547_item_object): Disallow array declarator
+	if one already exists for symbol.
+
+	* ste.c (ffeste_R1227): Convert result variable to type
+	of function result as seen by back end (e.g. for when REAL
+	external function actually returns result as double).
+
+	* target.h (FFETARGET_defaultFIXED_LINE_LENGTH): New
+	macro for default for -ffixed-line-length-N option.
+
+	* top.c (ffe_fixed_line_length_): Initialize this to new
+	target.h macro instead of constant 72.
+
+Tue May  9 01:20:03 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* lex.c (ffelex_send_token_): If sending CHARACTER token with
+	null text field, put a single '\0' in it and set length/size
+	fields to 0 (to fix 950508-0.f).
+	(ffelex_image_char_): When setting ffelex_bad_line_ to TRUE,
+	always "close" card image by appending a null char and setting
+	ffelex_card_length_.  As part of this, append useful text
+	to identify the two kinds of problems that involve this.
+	(ffelex_file_fixed): Reset ffelex_bad_line_ to FALSE after
+	seeing a line with invalid first character (fixes 950508-1.f).
+	If final nontab column is zero, assume tab seen in line.
+	(ffelex_card_image_): Always make this array 8 characters
+	longer than reflected by ffelex_card_size_.
+	(ffelex_init_1): Get final nontab column info from top instead
+	of assuming 72.
+
+	* options-lang.h: Add -ffixed-line-length- prefix.
+
+	* top.h: Add ffe_fixed_line_length() and _set_ version, plus
+	corresponding extern.
+
+	* top.c: Handle -ffixed-line-length- option prefix.
+
+Fri Apr 28 05:40:25 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.14 released.
+
+	* Make-lang.in: Add assert.j.
+
+	* Makefile.in: Add assert.j.
+
+	* assert.j: New file.
+
+Thu Apr 27 16:24:22 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* bad.h (ffebad_severity): New function.
+
+	* bad.c (ffebad_severity): New function.
+
+	* bad.def (FFEBAD_OPEN_INCLUDE): Change severity from SEVERE
+	to FATAL, since processing continues, and that seems fine.
+
+	* com.c: Add facility to handle -I.
+	(ffecom_file, ffecom_close_include, ffecom_open_include,
+	ffecom_decode_include_option): New global functions for -I.
+	(ffecom_file_, ffecom_initialize_char_syntax_,
+	ffecom_close_include_, ffecom_decode_include_option_,
+	ffecom_open_include_, append_include_chain, open_include_file,
+	print_containing_files, read_filename_string, file_name_map,
+	savestring): New internal functions for -I.
+
+	* compilers.h: Pass -I flag(s) to f771 (via "%{I*}").
+
+	* lex.c (ffelex_include_): Call ffecom_close_include
+	to close include file, for its tracking needs for -I,
+	instead of using fclose.
+
+	* options-lang.h: Add -I prefix.
+
+	* parse.c (yyparse): Call ffecom_file for main input file,
+	so -I handling works (diagnostics).
+
+	* std.c (ffestd_S3P4): Have ffecom_open_include handle
+	opening and diagnosing errors with INCLUDE files.
+
+	* ste.c (ffeste_begin_iterdo_): Use correct algorithm for
+	calculating # of iterations -- mathematically similar but
+	computationally different algorithm was not handling cases
+	like "DO I=6,5,2" correctly, because (5-6)/2+1 => 1, not 0.
+
+	* top.c (ffe_decode_option): Allow -I, restructure a bit
+	for clarity and, maybe, speed.
+
+Mon Apr 17 13:31:11 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* g77.c: Remove -lc, turns out not all systems has it, but
+	leave other changes in for clarity of code.
+
+Sun Apr 16 21:50:33 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c (ffecom_expr_): Implement ARRAY_EXPR as INDIRECT_REF
+	of appropriate PLUS_EXPRs of ptr_to_expr of array, to see
+	if this generates better code.  (Conditional on
+	FFECOM_FASTER_ARRAY_REFS.)
+
+Sun Apr 16 00:22:48 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Make-lang.in (F77_SRCS): Remove g77.c, since it doesn't
+	contribute to building f771.
+
+	* Makefile.in (dircheck): Remove/replace with f/Makefile, because
+	phony targets that are referenced in other real targets get run
+	when those targets are specified, which is a waste of time (e.g.
+	when rebuilding and only g77.c has changed, f771 was being linked
+	anyway).
+
+	* g77.c: Include -lc between -lf2c and -lm throughout.
+
+	* implic.c (ffeimplic_establish_symbol): If -Wimplicit, warn if
+	implicit type given to symbol.
+
+	* lex.c (ffelex_include_): Don't gratuitously increment line
+	number here.
+
+	* top.h, top.c (ffe_is_warn_implicit_): New global variable and
+	related access macros.
+	(ffe_decode_option): Handle -W options, including -Wall and
+	-Wimplicit.
+
+	* where.c (ffewhere_line_new): Don't muck with root line (was
+	crashing on null input since lexer changes over the past week
+	or so).
+
+Thu Apr 13 16:48:30 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c (ffecom_init_0): Register built-in functions for cos,
+	sin, and sqrt.
+	(ffecom_tree_fun_type_double): New variable.
+	(ffecom_expr_intrinsic_): Update f2c input and output files
+	to latest version of f2c (no important g77-related changes
+	noted, just bug fixes to f2c and such).
+	(builtin_function): New function from c-decl.c.
+
+	* com-rt.def: Refer to built-in functions for cos, sin, and sqrt.
+
+Thu Apr 13 10:25:09 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c (ffecom_expr_intrinsic_): Convert 0. to appropriate
+	type to keep DCMPLX(I) from crashing the compiler.
+	(ffecom_expr_): Don't convert result from ffecom_tree_divide_.
+	(ffecom_tree_divide_): Add tree_type argument, have all callers
+	pass one, and don't convert right-hand operand to it (this is
+	to make this new function work as much like the old in-line
+	code used in ffecom_expr_ as possible).
+
+	* lex.c: Maintain lineno and input_filename the way the gcc
+	lexer does.
+
+	* std.c (ffestd_exec_end): Save and restore lineno and
+	input_filename around the second pass, which sets them
+	appropriately for each saved statement.
+
+Wed Apr 12 09:44:45 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c (ffecom_expr_power_integer_): New function.
+	(ffecom_expr_): Call new function for power op with integer second
+	argument, for generating better code.  Also replace divide
+	code with call to new ffecom_tree_divide_ function.
+	Canonicalize calls to ffecom_truth_value(_invert).
+	(ffecom_tree_divide_): New function.
+
+Wed Apr  5 14:15:44 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* lex.c: Change to allocate text for tokens only when actually
+	needed, which should speed compilation up somewhat.
+	Change to allow INCLUDE at any point where a statement
+	can end, i.e. in ffelex_finish_statement_ or when a SEMICOLON
+	token is sent.
+	Remove some old, obsolete code.
+	Clean up layout of entire file to improve formatting,
+	readability, etc.
+	(ffelex_set_expecting_hollerith): Remove include argument.
+
+Fri Mar 31 23:19:08 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* bad.h, bad.c (ffebad_start_msg, ffebad_start_msg_lex):
+	New functions to generate arbitrary messages.
+	(FFEBAD_severityPEDANTIC): New severity, to correspond
+	to toplev's pedwarn() function.
+
+	* lex.c (ffelex_backslash_): New function to implement
+	backslash processing.
+	(ffelex_file_fixed, ffelex_file_free): Implement new
+	backslash processing.
+
+	* std.c (ffestd_R1001dump_): Don't assume CHARACTER and
+	HOLLERITH tokens stop at '\0' characters, now that backslash
+	processing is supported -- use their advertised lengths instead,
+	and double up the '\002' character for libf2c.
+
+Mon Mar 27 17:10:33 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c (ffecom_init_local_zero_): Implement -finit-local-zero.
+	(ffecom_sym_transform_): Same.
+	(ffecom_transform_equiv_): Same.
+
+	* options-lang.h: Add -f(no-)(init-local-zero,backslash,ugly-init).
+
+	* stb.c (ffestb_V020): Reject "TYPEblah(...", which might be
+	an array assignment.
+
+	* target.h, top.h, top.c: Implement -finit-local-zero.
+
+Fri Mar 24 19:56:22 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Make-lang.in, Makefile.in: Remove conf-proj(.in) and
+	proj.h(.in) rules, plus related config.log, config.cache,
+	and config.status stuff.
+
+	* com.c (ffecom_init_0): Change messages when atof(), bsearch(),
+	or strtoul() do not work as expected in the start-up test.
+
+	* conf-proj, conf-proj.in: Delete.
+
+	* lex.c (ffelex_file_fixed): Allow f2c's '&' in column 1
+	to mean continuation line.
+
+	* options-lang.h: New file, #include'd by ../toplev.c.
+
+	* proj.h.in: Rename back to proj.h.
+
+	* proj.h (LAME_ASSERT): Remove.
+	(LAME_STDIO): Remove.
+	(NO_STDDEF): Remove.
+	(NO_STDLIB): Remove.
+	(NO_BSEARCH): Remove auto detection, rename to !FFEPROJ_BSEARCH.
+	(NO_STRTOUL): Remove auto detection, rename to !FFEPROJ_STRTOUL.
+	(USE_HOST_LIMITS): Remove (maybe still needed by stand-alone?).
+	(STR, STRX): Do only ANSI C definitions.
+
+Mon Mar 13 10:46:13 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* BUGS: Add item about g77 requiring gcc to compile it.
+
+	* NEWS: New file listing user-visible changes in the release.
+
+	* PROJECTS: Update to include a new item or two, and modify
+	or delete items that are addressed in this or previous releases.
+
+	* bad.c (ffebad_finish): Don't crash if missing string &c,
+	just substitute obviously distressed string "[REPORT BUG!!]"
+	for cases where the message/caller are fudgy.
+
+	* bad.def: Clean up error messages in a major way, add new ones
+	for use by changes in target.c.
+
+	* com.c (ffecom_expr_): Handle opANY in opCONVERT.
+	(ffecom_let_char_): Disregard destinations with ERROR_MARK.
+	(ffecom_1, ffecom_1_fn, ffecom_2, ffecom_2s, ffecom_3,
+	ffecom_3s, &c): Check all inputs for error_mark_node.
+	(ffecom_start_progunit_): Don't transform all symbols
+	in BLOCK DATA, since it never executes, and it is silly
+	to, e.g., generate all the structures for NAMELIST.
+	(ffecom_char_length_expr_): Rename to ffecom_intrinsic_len_.
+	(ffecom_intrinsic_ichar_): New function to handle ICHAR of
+	arbitrary expression with possible 0-length operands.
+	(ffecom_expr_intrinsic_): Use ffecom_intrinsic_char_.
+	For MVBITS, set tree_type to void_type_node.
+	(ffecom_start_progunit_): Name master function for entry points
+	after primary entry point so users can easily guess it while
+	debugging.
+	(ffecom_arg_ptr_to_expr): Change treatment of Hollerith,
+	Typeless, and %DESCR.
+	(ffecom_expr_): Change treatment of Hollerith.
+
+	* data.c (ffedata_gather_): Handle opANY in opCONVERT.
+
+	* expr.c (ffeexpr_token_apostrophe_): Issue FFEBAD_NULL_CHAR_CONST
+	warning as necessary.
+	(ffeexpr_token_name_rhs_): Set context for args to intrinsic
+	so that assignment-like concatenation is allowed for ICHAR(),
+	IACHAR(), and LEN() intrinsics.
+	(ffeexpr_reduced_*_): Say "an array" instead of "an entity" in
+	diagnostics, since it's more informative.
+	(ffeexpr_finished_): For many contexts, check for null expression
+	and array before trying to do a conversion, to avoid redundant
+	diagnostics.
+
+	* g77.1: Fix typo for preprocessed suffix (.F, not .f).
+
+	* global.c (ffeglobal_init_common): Warn if initializing
+	blank common.
+	(ffeglobal_pad_common): Enable code to warn if initial
+	padding needed.
+	(ffeglobal_size_common): Complain if enlarging already-
+	initialized common, since it won't work right anyway.
+
+	* intrin.c: Add IMAG() intrinsic.
+	(ffeintrin_check_loc_): Allow opSUBSTR in LOC().
+
+	* intrin.def: Add IMAG() intrinsic.
+
+	* lex.c: Don't report FFEBAD_NULL_CHAR_CONST errors.
+
+	* sta.c, sta.h, stb.c: Changes to clean up error messages (see
+	bad.def).
+
+	* stb.c (ffestb_R100113_): Issue FFEBAD_NULL_CHAR_CONST
+	warning as necessary.
+
+	* stc.c (ffestc_shriek_do_): Don't try to reference doref_line
+	stuff in ANY case, since it won't be valid.
+	(ffestc_R1227): Allow RETURN in main program unit, with
+	appropriate warnings/errors.
+	(ffestc_subr_format_): Array of any type is a CHAREXPR (F77 C5).
+
+	* ste.c (ffeste_begin_doiter_): Couple of fixes to accurately
+	determine if loop never executes.
+
+	* target.c (ffetarget_convert_*_hollerith_): Append spaces,
+	not zeros, to follow F77 Appendix C, and to warn when
+	truncation of non-blanks done.
+	(ffetarget_convert_*_typeless): Rewrite to do typeless
+	conversions properly, and warn when truncation done.
+	(ffetarget_print_binary, ffetarget_print_octal,
+	ffetarget_print_hex): Rewrite to use new implementation of
+	typeless.
+	(ffetarget_typeless_*): Rewrite to use new implementation
+	of typeless, and to warn about overflow.
+
+	* target.h (ffetargetTypeless): New implementation of
+	this type.
+
+	* type.h, type.c (ffetype_size_typeless): Remove (incorrect)
+	implementation of this function and its extern.
+
+Sun Mar  5 18:46:42 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* BUGS: Clarify that constant handling would also fix lack of
+	adequate IEEE-754/854 support to some degree, and typeless
+	and non-decimal constants.
+
+	* com.c (ffecom_type_permanent_copy_): Comment out to avoid
+	warnings.
+	(duplicate_decls): New function a la gcc/c-decl.c.
+	(pushdecl): Use duplicate_decls to decide whether to return
+	existing decl or new one, instead of always returning existing
+	decl.
+	(ffecom_expr_): opPERCENT_LOC now supports CHARACTER arguments.
+	(ffecom_init_0): Give f2c I/O code 0 for basictypeANY/kindtypeANY.
+	(ffecom_sym_transform_): For adjustable arrays, pass low bound
+	through variable_size in case its primaries are changed (950302-1.f).
+
+	* com.h: More decls that belong in tree.h &c.
+
+	* data.c (ffedata_eval_integer1_): Fix opPAREN case to not
+	treat value of expression as an error code.
+
+	* expr.c (ffeexpr_finished_): Allow opSUBSTR in contextLOC case.
+
+	* proj.c: Add "const" as appropriate.
+
+Mon Feb 27 10:04:03 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* bad.def (FFEBAD_BAD_SUBSTR): Fix bad grammar in message.
+
+Fri Feb 24 16:21:31 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.13 released.
+
+	* INSTALL: Warn that f/zzz.o will compare differently between
+	stages, since it puts the __TIME__ macro into a string.
+
+	* com.c (ffecom_sym_transform_): Transform kindFUNCTION/whereDUMMY
+	to pointer-to-function, not function.
+	(ffecom_expr_): Use ffecom_arg_ptr_to_expr instead of
+	ffecom_char_args_ to handle comparison between CHARACTER
+	types, so either operand can be a CONCATENATE.
+	(ffecom_transform_common_): Set size of initialized common area
+	to global (largest-known) size, even though size of init might
+	be smaller.
+
+	* equiv.c (ffeequiv_offset_): Check symbol info for ANY.
+
+	* expr.c (ffeexpr_find_close_paren_, ffeexpr_nil_*): New functions
+	to handle following the contour of a rejected expression, so
+	statements like "PRINT(I,I,I)=0" don't cause the PRINT statement
+	code to get the second passed back to it as if there was a
+	missing close-paren before it, the comma causing the PRINT code
+	to confirm the statement, resulting in an ambiguity vis-a-vis
+	the let statement code.
+	Use the new ffecom_find_close_paren_ handler when an expected
+	close-paren is missing.
+	(ffeexpr_isdigits_): New function, use in all places that
+	currently use isdigit in repetitive code.
+	(ffeexpr_collapse_symter): Collapse to ANY if init-expr is ANY,
+	so as to avoid having symbol get "transformed" if used to
+	dimension an array.
+	(ffeexpr_token_real_, ffeexpr_token_number_real_): Don't issue
+	diagnostic about exponent, since it'll be passed along the
+	handler path, resulting in a diagnostic anyway.
+	(ffeexpr_token_apos_char_): Use consistent handler path
+	regardless of whether diagnostics inhibited.
+	(ffeexpr_token_name_apos_name_): Skip past closing quote/apos
+	even if not a match or other diagnostic issued.
+	(ffeexpr_sym_impdoitem_): Exec-transition local SEEN symbol.
+
+	* lex.c (ffelex_image_char_): Set ffelex_saw_tab_ if TAB
+	seen, not if anything other than TAB seen!
+
+	* stc.c (ffestc_R537_item): If source is ANY but dest isn't,
+	set dest symbol's init expr to ANY.
+	(ffestc_R501_attrib, ffestc_R522, ffestc_R522start): Complain
+	about conflict between "SAVE" by itself and other uses of
+	SAVE only in pedantic mode.
+
+	* ste.c (ffeste_R1212): Fix loop over labels to always
+	increment caseno, to avoid pushcase returning 2 for duplicate
+	values when one of the labels is invalid.
+
+Thu Feb 23 12:42:04 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.12 released.
+
+	* Make-lang.in (f77.install-common): Add "else true;" before outer
+	"fi" per Makefile.in patch.
+
+	* Makefile.in (dircheck): Add "else true;" before "fi" per
+	patch from chs1pm@surrey.ac.uk.
+
+	* com.c (ffecom_push_tempvar): If type desired is ERROR_MARK,
+	return error_mark_node, to avoid crash that results from
+	making a VAR_DECL with error_mark_node as its type.
+
+	* ste.c (ffeste_begin_iterdo_): Convert itercount to INTEGER
+	anytime calculation of number of iterations ends up with type
+	other than INTEGER (e.g. DOUBLE PRECISION, REAL).
+
+Thu Feb 23 02:48:38 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.11 released.
+
+	* DOC: Explain -fugly-args.
+
+	* bad.def (FFEBAD_ACTUALARG): Explain -fugly-args and how to
+	rewrite code to not require it.
+
+	* com.c (ffecom_vardesc_): Handle negative type code, just in
+	case.
+	(ffecom_arg_ptr_to_expr): Let ffecom_expr handle hollerith
+	and typeless constants (move code to ffecom_constantunion).
+	(ffecom_constantunion): Handle hollerith and typeless constants.
+
+	* expr.c (ffecom_finished_): Check -fugly-args in actual-arg
+	context where hollerith/typeless provided.
+
+	* intrin.def (FFEINTRIN_genDFLOAT): Add FFEINTRIN_specDFLOAT.
+	(FFEINTRIN_specDFLOAT): Add as f2c intrinsic.
+
+	* target.h (ffetarget_convert_real[12]_integer,
+	ffetarget_convert_complex[12]_integer): Pass -1 for high integer
+	value if low part is negative.
+	(FFETARGET_defaultIS_UGLY_ARGS): New macro.
+
+	* top.c (ffe_is_ugly_args_): New variable.
+	(ffe_decode_option): Handle -fugly-args and -fno-ugly-args.
+
+	* top.h (ffe_is_ugly_args_, ffe_is_ugly_args(),
+	ffe_set_is_ugly_args()): New variable and macros.
+
+Thu Feb 23 02:48:38 1995  Pedro A M Vazquez  (vazquez@iqm.unicamp.br)
+
+	* g77.c (sys_errlist): Use const for __FreeBSD__ systems
+	as well.
+
+Wed Feb 22 13:33:43 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.10 released.
+
+	* CREDITS: Add Rick Niles.
+
+	* INSTALL: Note how to get around lack of makeinfo.
+
+	* Make-lang.in (f/proj.h): Remove # comment.
+
+	* Makefile.in (f/proj.h): Remove # comment.
+
+	* com.c (ffecom_expr_): Simplify opFUNCREF/opSUBRREF conversion.
+	(ffecom_sym_transform_): For whereGLOBAL and whereDUMMY
+	kindFUNCTION, use ffecom_tree_fun_type[][] only for non-constant
+	(non-statement-function) f2c functions.
+	(ffecom_init_0): ffecom_tree_fun_type[][] and _ptr_to_*_* are
+	really f2c-interface arrays, so use base type void for COMPLEX
+	(like CHARACTER).
+
+Tue Feb 21 19:01:18 1995  Dave Love  <d.love@dl.ac.uk>
+
+	* Make-lang.in (f77.install-common): Expurgate the test for and
+	possible installation of f2c in line with elsewhere.  Seems to have
+	been missing a semicolon anyhow!
+
+Tue Feb 21 11:45:25 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.9 released.
+
+	* Make-lang.in (f/proj.h): touch file to register update,
+	because the previous commands won't necessarily modify it.
+
+	* Makefile.in (f/proj.h): touch file to register update,
+	because the previous commands won't necessarily modify it.
+
+	* Makefile.in (f/str-*.h, f/str-*.j): Explicitly specify
+	output file names, so these targets go in build, not source,
+	directory.
+
+	* bits.c, bits.h: Switch to valid ANSI C replacement for
+	ARRAY_ZERO.
+
+	* com.c (ffecom_expr_): Add assignp arg to support ASSIGN better.
+	If assignp is TRUE, use different tree for FFEBLD_opSYMTER case.
+	(ffecom_sym_transform_assign_): New function.
+	(ffecom_expr_assign): New function.
+	(ffecom_expr_assign_w): New function.
+
+	* com.c (ffecom_f2c_make_type_): Do make_signed_type instead
+	of make_unsigned_type throughout.
+
+	* com.c (ffecom_finish_symbol_transform_): Expand scope of
+	commented-out code to probably produce faster compiler code.
+
+	* com.c (ffecom_gen_sfuncdef_): Push/pop calltemps so
+	COMPLEX works right.
+	Remove obsolete comment.
+
+	* com.c (ffecom_start_progunit_): If non-multi alt-entry
+	COMPLEX function, primary (static) entry point returns result
+	directory, not via extra arg -- to agree with ffecom_return_expr
+	and others.
+	Pretransform all symbols so statement functions are defined
+	before any code emitted.
+
+	* com.c (ffecom_finish_progunit): Don't posttransform all
+	symbols here -- pretransform them instead.
+
+	* com.c (ffecom_init_0): Don't warn about possible ASSIGN
+	crash, as this shouldn't happen now.
+
+	* com.c (ffecom_push_tempvar): Fix to handle temp vars
+	pushed while context is a statement (nested) function, and
+	add appropriate commentary.
+
+	* com.c (ffecom_return_expr): Check TREE_USED to determine
+	where return value is unset.
+
+	* com.h (struct _ffecom_symbol_): Add note about length_tree
+	now being used to keep tree for ASSIGN version of symbol.
+
+	* com.h (ffecom_expr_assign, ffecom_expr_assign_rw): New decls.
+	(error): Add this prototype for back-end function.
+
+	* fini.c (main): Grab input, output, and include names
+	directly off the command line instead of making the latter
+	two out of the first.
+
+	* lex.c: Improve tab handling for both fixed and free source
+	forms, and ignore carriage-returns on input, while generally
+	improving the code.  ffelex_handle_tab_ has been renamed and
+	reinvented as ffelex_image_char_, among other things.
+
+	* malloc.c, malloc.h: Switch to valid ANSI C replacement for
+	ARRAY_ZERO, and kill the full number of bytes in pools and
+	areas.
+
+	* proj.h.in (ARRAY_ZERO, ARRAY_ZERO_SIZE): Remove.
+
+	* ste.c (ffeste_io_cilist_, ffeste_io_icilist_, ffeste_R838,
+	ffeste_R839): Issue diagnostic if a too-narrow variable used in an
+	ASSIGN context despite changes to this code and code in com.c.
+
+	* where.c, where.h: Switch to valid ANSI C replacement for
+	ARRAY_ZERO.
+
+Fri Feb 17 03:35:19 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.8 released.
+
+	* INSTALL: In quick-build case, list g77 target first so g77
+	gets installed.  Also, explain that gcc gets built and installed
+	as well, even though this isn't really what we want (and maybe
+	we'll find a way around this someday).
+
+Fri Feb 17 02:35:41 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.7 released.
+
+	* Makefile.in (CONFIG_H, HCONFIG_H, TCONFIG_H, TM_H): Remove
+	../ prefix in front of .h files, since they're in the cd.
+
+Fri Feb 17 01:50:48 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.6 released.
+
+Thu Feb 16 20:26:54 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* ../README.g77: Remove description of g77 as "not-yet-published".
+
+	* CREDITS: More changes.
+
+	* Make-lang.in (G77STAGESTUFF): Remove cktyps stuff.
+
+	* Makefile.in (CONFIG_H, HCONFIG_H, TCONFIG_H, TM_H): Don't
+	prefix gcc dir with $(srcdir) since these don't live there,
+	they are created in the build dir by gcc's configure.  Add
+	a note explaining what these macros are about.
+	Update dependencies via deps-kinda.
+
+	* README.NEXTSTEP: Credit Toon, and per his request, add his
+	email address.
+
+	* com.h (FFECOM_DETERMINE_TYPES): #include "config.j".
+
+	* config.j, convert.j, flags.j, hconfig.j, rtl.j, tconfig.j,
+	tm.j, tree.j: Don't #include if already done.
+
+	* convert.j: #include "tree.j" first, as convert.h clearly depends
+	on trees being defined.
+
+	* rtl.j: #include "config.j" first, since there's some stuff
+	in rtl.h that assumes it has been #included.
+
+	* tree.j: #include "config.j" first, or real.h makes inconsistent
+	decision about return type of ereal_atof, leading to bugs, and
+	because tree.h/real.h assume config.h already included.
+
+Wed Feb 15 14:40:20 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.5 released.
+
+	* Copyright notices updated to be FSF-style.
+
+	* INSTALL: Some more clarification regarding building just f77.
+
+	* Make-lang.in (F77_SRCS): Update wrt changing some .h to .j.
+	(install-libf77): Fix typo in new parenthetical note.
+
+	* Makefile.in (f/*.o): Update.
+	(CONFIG_H, CONVERT_H, FLAGS_H, GLIMITS_H, HCONFIG_H, RTL_H,
+	TCONFIG_H, TM_H, TREE_H): Update/new symbols.
+	(deps-kinda): More fixes wrt changing some .h to .j.
+	Document and explain this rule a bit better.
+	Accommodate changes in output of gcc -MM.
+
+	* *.h, *.c: Change #include's so proj.h not assumed to #include
+	malloc.h or config.h (now config.j), and so new .j files are
+	used instead of old .h ones.
+
+	* com.c (ffecom_init_0): Use FLOAT_TYPE_SIZE for f2c's
+	TYLONG/TYLOGICAL type codes, to get g77 working on Alpha.
+
+	* com.h: Make all f2c-related integral types "int", not "long
+	int".
+
+	* config.j, convert.j, flags.j, glimits.j, hconfig.j, rtl.j,
+	tconfig.j, tm.j, tree.j: New files wrapping around gbe
+	.h files.
+
+	* config.h, convert.h, flags.h, glimits.h, hconfig.h, rtl.h,
+	tconfig.h, tm.h, tree.h: Deleted so new .j files
+	can #include the gbe files directly, instead of using "../",
+	and thus do better with various kinds of builds.
+
+	* proj.h: Delete unused NO_STDDEF and related stuff.
+
+Tue Feb 14 08:28:08 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* BUGS: Remove item #12, cross-compiling & autoconf scripts
+	reportedly expected to work properly (according to d.love).
+
+	* INSTALL: Add explanation of d.love's patch to config-lang.in.
+	Add explanation of how to install just g77 when gcc already installed.
+	Add note about usability of "-Wall".  Add note about bug-
+	reporting.
+
+	* Make-lang.in ($(srcdir)/f/conf-proj): Add comment about why
+	conf-proj.out.
+	(install-libf77): Echo parenthetical note to user about how to do
+	just the (aborted) libf2c installation.
+	(deps-kinda): Update to work with new configuration/build stuff.
+
+	* bad.c (ffebad_finish): Put capitalized "warning:" &c message
+	as prefix on any diagnostic without pointers into source.
+
+	* bad.def (FFEBAD_TOO_BIG_INIT): Add this warning message.
+
+	* config-lang.in: Add Dave Love's patch to catch case where
+	back-end patches not applied and abort configuration.
+
+	* data.c (ffedata_gather_, ffedata_value_): Warn when about
+	to initialize a large aggregate area, due to design flaw resulting
+	in too much time/space used to handle such cases.
+	Use COMMON area name, and first notice of symbol, for multiple-
+	initialization diagnostic, instead of member symbol and unknown
+	location.
+	(FFEDATA_sizeTOO_BIG_INIT_): New macro per above.
+
+Mon Feb 13 13:54:26 1995  Dave Love  <d.love@dl.ac.uk>
+
+	* Make-lang.in (F77_SRCS): Use $(srcdir)/f/proj.h.in, not
+	$(srcdir)/f/proj.h for build outside srcdir.
+
+Sun Feb 12 13:37:11 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* ../README.g77: Clarify procedures for unpacking, add asterisks
+	to mark important things the user must do.
+
+	* Fix dates in/add dates to ../README.g77, BUGS, CREDITS, DOC,
+	INSTALL, PROJECTS, README.
+
+Sun Feb 12 00:26:10 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.4 released.
+
+	* Make-lang.in (f/proj.h): Reproduce this rule here from
+	Makefile.in.
+	($(srcdir)/f/conf-proj): Put autoconf's stdout in temp file
+	conf-proj.out, then mv to conf-proj only if successful, so
+	conf-proj not touched if autoconf not installed.
+
+	* Makefile.in ($(srcdir)/conf-proj): See Make-lang.in's similar
+	rule.
+
+Sat Feb 11 20:56:02 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* BUGS: Clarify some bugs.
+
+	* DOC: Many improvements and fixes.
+
+	* README: Move bulk of text, edited, to ../README.g77, and
+	replace with pointer to that file.
+
+	* com.c (ffecom_init_0): Comment out warning about sizeof(ftnlen)
+	as per ste.c change.  Add text about ASSIGN to help user understand
+	what is being warned about.
+
+	* conf-proj.in: Fix typos in comments.
+
+	* proj.h.in: Add ARRAY_ZERO_SIZE to parallel malloc.h's version,
+	in case it proves to be needed.
+
+	* ste.c: Comment out assertions requiring sizeof(ftnlen) >=
+	sizeof(char *), in the hopes that overflow will never happen.
+	(ffeste_R838): Change assertion to fatal() with at least
+	partially helpful message.
+
+Sat Feb 11 12:38:00 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* com.c (ffecom_vardesc_): Crash if typecode is -1.
+
+	* ste.c (ffeste_io_dolio_): Crash if typecode is -1.
+
+Sat Feb 11 09:51:57 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* ste.c: In I/O code tests for item arrayness, sort of revert
+	to much earlier code that tests original exp, but also check
+	in newer way just in case.  Newer way alone treated FOO(1:40)
+	as an array, not sure why older way alone didn't work, but I
+	think maybe it was when diagnosed code was involved, and
+	since there are now checks for error_mark_node, maybe the old
+	way alone would work.  But better to be safe; both original
+	ffebld exp _and_ the transformed tree must indicate an array
+	for the size-determination code to be used, else just 1/2 elements
+	assumed.  And this text is for EMACS: (foo at bar).
+
+Fri Feb 10 11:05:50 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* ste.c: In many cases, surround statement-expansion code
+	with ffecom_push_calltemps () and ffecom_pop_calltemps ()
+	so COMPLEX-returning functions can have temporaries pushed
+	in "auto-pop" mode and have them auto-popped at the end of
+	the statement.
+
+Wed Feb  8 14:35:10 1995  Dave Love  <d.love@dl.ac.uk>
+
+	* runtime/f2c.h.in (ftnlen, ftnint): Make same size as integer.
+
+	* runtime/libI77/err.c (f_init): Thinko in MISSING_FILE_ELEMS
+	conditional.
+	* runtime/libI77/wrtfmt.c (mv_cur): Likewise.
+	* runtime/libI77/wsfe.c (x_putc): Likewise.
+
+	* runtime/libF77/signal_.c (signal_): Return 0 (this is a
+	subroutine).
+
+	* Makefile.in (f/proj.h): Depend on com.h.
+	* Make-lang.in (include/f2c.h): Likewise (and proj.h).
+	(install-libf77): Also install f2c.h.
+
+	* runtime/libI77/Makefile.in (*.o): Add f2c.h dependency.
+	* runtime/libF77/Makefile.in:  Likewise.
+
+Wed Feb  8 13:56:47 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* stc.c (ffestc_R501_item): Don't reset kind/where to NONE when
+	setting basictype/kindtype info for symbol, or especially
+	its function/result twin, because kind/where might not be NONE.
+
+Tue Feb  7 14:47:26 1995  Dave Love  <d.love@dl.ac.uk>
+
+	* Make-lang.in (include/f2c.h:): Set shell variable src more
+	robustly (independent of whether srcdir is relative or absolute).
+	* Makefile.in (f/proj.h:): Likewise.
+
+	* conf-proj.in: Check need for LAME_ASSERT.  Fix indentation in
+	check for LAME_STDIO (cosmetic only with ANSI C).
+
+	* com.h: Extra ...SIZE stuff taken from com.c.
+
+	* com.c (FFECOM_DETERMINE_TYPES): Define before including com.h.
+	(BITS_PER_WORD etc.) Remove and use conditional definitions to com.h.
+
+	* runtime/configure.in: #define FFECOM_DETERMINE_TYPES for com.h in
+	f2c type determination.
+
+	* tm.h: Remove (at least pro tem) because of relative path and use
+	top-level one.
+
+	* Make-lang.in (include/f2c.h:): Set shell variable src more
+	robustly (independent of whether srcdir is relative or absolute).
+	* Makefile.in (f/proj.h:): Likewise.
+
+Mon Feb  6 19:58:32 1995  Dave Love  <d.love@dl.ac.uk>
+
+	* g77.c (append_arg): Use K&R declaration for, e.g. SunOS4 build.
+
+Fri Feb  3 20:33:14 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* g77.c (main): Treat -l like filename in terms of -x handling.
+	Rewrite arglist mechanism for ease of maintenance.
+	Make sure every -lf2c is followed by -lm and vice versa.
+
+	* Make-lang.in: Put complete list of sources in F77_SRCS def
+	so changing a .h file, for example, causes rebuild.
+
+	* Makefile.in: Change test for nextstep to m68k-next-nextstep* so
+	all versions of nextstep on m68k get the necessary flag.
+
+Fri Feb  3 19:10:32 1995  Dave Love  <d.love@dl.ac.uk>
+
+	* INSTALL: Note about possible conflict with existing libf2c.a and
+	f2c.h.
+
+	* Make-lang.in (f77.distclean): Tidy and move deletion of
+	f/config.cache to mostlyclean.
+	(install-libf77): Test for $(libdir)/libf2c.* and barf if found
+	unless F2CLIBOK defined.
+
+	* runtime/Makefile.in (all): Change path to include directory (and
+	elsewhere).
+	(INCLUDES): Remove (unused/misleading).
+	(distclean): Include f2c.h.
+	(clean): Include config.cache.
+
+	* runtime/libF77/Makefile.in (.SUFFIXES): Correct typo.
+	(ALL_CFLAGS) Fix up include search path to find f2c.h in top level
+	includes always.
+	(all): Depend on f2c.h.
+	* runtime/libI77/Makefile.in (.SUFFIXES): Likewise.
+
+Thu Feb  2 17:17:06 1995  Dave Love  <d.love@dl.ac.uk>
+
+	* INSTALL: Note about --srcdir and GNU make.
+
+	* runtime/f2c.h.in (Pad_UDread, ALWAYS_FLUSH): Reomve the #defines
+	per below.
+
+	* runtime/configure.in (Pad_UDread, ALWAYS_FLUSH): Define these
+	here, not in f2c.h as they'r eonly relevant for building.
+	* runtime/configure: Regenerated.
+
+	* config-lang.in: Warn about using GNU make outside source tree
+	since I can't get Irix5 or SunOS4 makes to work in this case.
+
+	* Makefile.in (VPATH): Don't set it here.
+	(srcdir): Make it the normal `.' (overridden) at top level.
+	(all.indirect): New dependency `dircheck'.
+	(f771): Likewise
+	(dircheck): New target for foolproofing.
+	(f/proj.h:): Change finding source.
+	(CONFIG_H): Don't use this as the relative path in the include loses
+	f builddir != srcdir.
+
+	* config.h: Remove per CONFIG_H change above.
+
+	* Make-lang.in (F77_FLAGS_TO_PASS): Remove GCC_FOR_TARGET.
+	(f771:): Pass VPATH, srcdir to sub-make.
+	(f/Makefile:): New target.
+	(stmp-int-hdrs): new variable for cheating build.
+	(f77-runtime:): Alter GCC_FOR_TARGET treatment.
+	(include/f2c.h f/runtime/Makefile:) Likewise.
+	(f77-runtime-unsafe:): New (cheating) target.
+
+Thu Feb  2 12:09:51 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* BUGS: Update regarding losing EQUIVALENCE members in -g, and
+	regarding RS/6000 problems in the back end.
+
+	* CREDITS: Make some changes as requested.
+
+	* com.c (ffecom_member_trunk_): Remove unused static variable.
+	(ffecom_finish_symbol_transform_): Improve comments.
+	(ffecom_let_char_): Fix size of temp address-type var.
+	(ffecom_member_phase2_): Try fixing problem fixed by change
+	to ffecom_transform_equiv_ (f_m_p2_ function currently not used).
+	(ffecom_transform_equiv_): Remove def of unused static variable.
+	Comment-out use of ffecom_member_phase2_, until problems with
+	back end fixed.
+	(ffecom_push_tempvar): Fix assertion to not crash okay code.
+
+	* com.h: Remove old, commented-out code.
+	Add prototype for warning() in back end.
+
+	* ste.c (ffeste_io_dofio_, ffeste_io_dolio_, ffeste_io_douio_,
+	ffeste_io_icilist_): Check correct type of variable for arrayness.
+
+Sun Jan 29 14:41:42 1995  Dave Love  <d.love@dl.ac.uk>
+
+	* BUGS: Remove references to my configure bugs; add another.
+
+	* runtime/Makefile.in (AR_FLAGS): Provide default value.
+
+	* runtime/f2c.h.in (integer, logical): Take typedefs from
+	F2C_INTEGER configuration parameter again.
+	(NON_UNIX_STDIO): don't define it.
+
+	* runtime/configure.in: Bring type checks for f2c.h in line with
+	com.h.
+	(MISSING_FILE_ELEMS): New variable to determine whether the relevant
+	elements of the FILE struct exist, independent of NON_UNIX_STDIO.
+	* runtime/libI77/{err,wrtfmt,wsfe}.c (MISSING_FILE_ELEMS): Use new
+	parameter.
+
+	* config-lang.in: Comment out more of f2c rules (c.f. Make-lang.in).
+	(This stuff is relevant iff you gave configure --enable-f2c.)
+	Create f/runtime directory tree iff not building in source
+	directory.
+
+	* Makefile.in (srcdir): Append slash so we get the right value when
+	not building in the source directory.  This is a consequence of not
+	building the `f' sources in `f'.
+	(VPATH): Override configure's value for reasons above.
+	(f/proj.h f/conf-proj): New rules to build proj.h by
+	autoconfiguration.
+
+	* proj.h: Rename to proj.h.in for autoconfiguration.
+	* proj.h.in: New as above.
+	* conf-proj conf-proj.in: New files for autoconfiguration.
+
+	* Make-lang.in (include/f2c.h f/runtime/Makefile:): Change the order
+	of setting the sh variables so that the right GCC_FOR_TARGET is
+	used.
+	(f77.*clean:) Add products of new configuration files and make sure
+	all the *clean targets do something (unlike the ones in
+	cp/Make-lange.in).
+
+	* com.h (FFECOM_f2cINTEGER, FFECOM_f2cLOGICAL): Define as long or
+	int appropriately to ensure sizeof(real) == sizeof(integer).
+
+	* PROJECTS: Library section.
+
+	* runtime/libI77/endfile.c: Don't #include sys/types.h conditional
+	on NON_UNIX_STDIO since rawio.h needs size_t.
+	* runtime/libI77/uio.c: #include <sys/types.h> for size_t if not
+	KR_headers.
+
+Wed Jan 25 03:31:51 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.3 released.
+
+	* INSTALL: Revise.
+
+	* Make-lang.in: Comment out rules for building f2c itself (f/f2c/).
+
+	* README: Revise.
+
+	* com.c (ffecom_init_0): Warn if ftnlen or INTEGER not big enough
+	to hold a char *.
+
+	* gbe/2.6.2.diff: Update.
+
+Mon Jan 23 17:10:49 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* TODO: Remove.
+	BUGS: New file.
+	PROJECTS: New file.
+	CREDITS: New file.
+
+	* cktyps*: Remove.
+	Make-lang.in: Remove cktyps stuff.
+	Makefile.in: Remove cktyps stuff.
+
+	* DOC: Add info on changes for 0.5.3.
+
+	* bad.c: Put "warning:" &c on diagnostic messages.
+	Don't output informational messages if warnings disabled.
+
+Thu Jan 19 12:38:13 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* g77.c: Avoid putting out useless "-xnone -xf77" pairs so
+	larger command lines can be accommodated.
+	Recognize both `-xlang' and `-x lang'.
+	Recognize `-xnone' and `-x none' to mean what it does, instead
+	of treating "none" as any other language.
+	Some minor, slight improvements in the way args are handled
+	(hopefully for clearer, more maintainable code), including
+	consistency checks on arg count just in case.
+
+Wed Jan 18 16:41:57 1995  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* DOC: Explain -fautomatic better.
+
+	* INSTALL: Describe libf2c.a better.
+
+	* Make-lang.in, Makefile.in: Build f771 &c with gcc/ as cd instead
+	of gcc/f/ so debugging info is better (source file tracking).
+	Add new source file type.c.
+
+	* Makefile.in: For nextstep3, link f771 with -segaddr __DATA
+	6000000.  Fix typo.  Change deps-kinda target to handle building
+	from gcc/.  Update dependencies.
+
+	* bld-op.def, bld.h, bld.c: Remove opBACKEND and all related
+	stuff.
+	Remove consistency tests that cause compiler warnings.
+
+	* cktyps.c: Remove all typing checking.
+
+	* com-rt.def: Change all rttypeFLOAT_ intrinsics to rttypeDOUBLE_,
+	to precisely match how they're declared in libf2c.
+
+	* com.h, com.c: Revise to more elegantly track related stuff
+	in the version of f2c.h used to build libf2c.
+
+	* com.c: Increase FFECOM_sizeMAXSTACKITEM, and if 0 or undefined
+	when checked to determine where to put entity, treat as infinite.
+	Rewrite temporary mechanism to be based on trees instead of
+	ffeinfo stuff, and make it much simpler.  Change interface
+	accordingly.
+	Fixes to better track types of things, make appropriate
+	conversions, etc.  E.g. when making an arg for a libf2c
+	function, make sure it's of the right type (such as ftnlen).
+	Delete opBACKEND transformation code.
+	(ffecom_init_0): Smoother initialization of types, especially
+	paying attention to using consistent rules for making INTEGER,
+	REAL, DOUBLE PRECISION, etc., and for deciding their "*N"
+	and kind values that will work across all g77 platforms.
+	No longer require per-target configuration info in target.h
+	or config/*/*; use new type module to store size, alignment.
+	(ffecom_member_phase2): Declare COMMON/EQUIVALENCE group members
+	so debugger sees them.
+	(ffecom_finish_progunit): Transform all symbols in program unit,
+	so -g will show they all exist.
+
+	* expr.c (ffeexpr_collapse_substr): Handle strange substring
+	range values.
+
+	* info.h, info.c: Provide connection to new type module.
+	Remove tests that yield compiler warnings.
+
+	* intrin.c (ffeintrin_is_intrinsic): Properly handle deleted
+	intrinsic.
+
+	* lex.c (ffelex_file_fixed): Remove redundant/buggy code.
+
+	* stc.c (ffestc_kindtype_kind_, ffestc_kindtype_star_): Replace
+	boring switch stmt with simple call to new type module.  This
+	sort of thing is a reason to get up in the morning.
+
+	* ste.c: Update to handle new interface for
+	ffecom_push/pop_tempvar.
+	Fixes to better track types of things.
+	Fixes to not crash for certain diagnosed constructs.
+	(ffeste_begin_iterdo_): Check only constants for overflow to avoid
+	spurious diagnostics.
+	Don't convert larger integer (say, INTEGER*8) to canonical integer
+	for iteration count.
+
+	* stw.h: Track DO iteration count temporary variable.
+
+	* symbol.c: Remove consistency tests that cause compiler warnings.
+
+	* target.c (ffetarget_aggregate_info): Replace big switch with
+	little call to new type module.
+	(ffetarget_layout): Remove consistency tests that cause
+	compiler warnings.
+	(ffetarget_convert_character1_typeless): Pick up length of
+	typeless type from new type module.
+
+	* target.h: Crash build if target float bit pattern cannot be
+	precisely determined.
+	Remove all the type cruft now determined by ffecom_init_0
+	at invocation time and maintained in new type module.
+	Put casts on second arg of all REAL_VALUE_TO_TARGET_DOUBLE
+	uses so compiler warnings avoided (requires target float bit
+	pattern to be precisely determined, hence code to crash build).
+
+	* top.c: Add inits/terminates for new type module.
+
+	* type.h, type.c: New module.
+
+	* gbe/2.6.2.diff: Remove all patches to files in gcc/config/
+	directory and its subdirectories.
+
+Mon Jan  9 19:23:25 1995  Dave Love  <d.love@dl.ac.uk>
+
+	* com.h (FFECOM_F2C_INTEGER_TYPE_NODE): Define and use instead of
+	long_integer_type_node where appropriate.
+
+Tue Jan  3 14:56:18 1995  Dave Love  <d.love@dl.ac.uk>
+
+	* com.h: Make ffecom_f2c_logical_type_node long, consistent with
+	integer.
+
+Fri Dec  2 20:07:37 1994  Dave Love  <d.love@dl.ac.uk>
+
+	* config-lang.in (stagestuff): Add f2c conditionally.
+	* Make-lang.in: Add f2c and related targets.
+	* f2c: Add the directory.
+
+Fri Nov 25 22:17:26 1994  Dave Love  <d.love@dl.ac.uk>
+
+	* Makefile.in (FLAGS_TO_PASS): pass $(CROSS)
+	* Make-lang.in: more changes to runtime targets
+
+Thu Nov 24 18:03:21 1994  Dave Love  <d.love@dl.ac.uk>
+
+	* Makefile.in (FLAGS_TO_PASS): define for sub-makes
+
+	* g77.c (main): change f77-cpp-output to f77-cpp-input (.F files)
+
+Wed Nov 23 15:22:53 1994  Dave Love  <d.love@dl.ac.uk>
+
+	* bad.c (ffebad_finish): kluge to fool emacs19 into finding errors:
+	add trailing space to <file>:<line>:
+
+Tue Nov 22 11:30:50 1994  Dave Love  <d.love@dl.ac.uk>
+
+	* runtime/libF77/signal_.c (RETSIGTYPE): added
+
+Mon Nov 21 13:04:13 1994  Dave Love  <d.love@dl.ac.uk>
+
+	* Makefile.in (compiler): add runtime
+
+	* config-lang.in (stagestuff): add libf2c.a to stagestuff
+
+	* Make-lang.in:
+	G77STAGESTUFF <- MORESTAGESTUFF
+	f77-runtime: new target, plus supporting ones
+
+	* runtime: add the directory, containing libI77, libF77 and autoconf
+	stuff
+
+	* g++.1: remove
+
+	* g77.1: minor fixes
+
+Thu Nov 17 15:18:05 1994  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.2 released.
+
+	* bad.def: Modify wording of FFEBAD_UNIMPL_STMT to indicate
+	that it covers a wide array of possible problems (that, someday,
+	should be handled via separate diagnostics).
+
+	* lex.c: Allow $ in identifiers if -fdollar-ok.
+	* top.c: Support -fdollar-ok.
+	* top.h: Support -fdollar-ok.
+	* target.h: Support -fdollar-ok.
+	* DOC: Describe -fdollar-ok.
+
+	* std.c (ffestd_R1229_finish): Fix bug so stand-alone build works.
+	* ste.c (ffeste_R819A): Fix bug so stand-alone build works.
+
+	* Make: Improvements for stand-alone build.
+
+	* Makefile.in: Fix copyright text at top of file.
+
+	* LINK, SRCS, UNLINK: Removed.  Not particularly useful now that
+	g77 sources live in their own subdirectory.
+
+	* g77.c (main): Cast arg to bzero to avoid warning.  (This is
+	identical to Kenner's fix to cp/g++.c.)
+
+	* gbe/: New subdirectory, to contain .diff files for various
+	versions of the GNU CC back end.
+
+	* gbe/README: New file.
+	* gbe/2.6.2.diff: New file.
+
+Tue Nov  8 10:23:10 1994  Dave Love  <d.love@dl.ac.uk>
+
+	* Make-lang.in: don't install as f77 as well as g77 to avoid
+	confusion with system's compiler (especially while testing)
+
+	* g77.c (main): use -lf2c and -lm; fix sense of test for .f/.F files
+
+Fri Oct 28 09:45:00 1994  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.1 released.
+
+	* gcc.c: Invoke f771 instead of f-771.
+
+Fri Oct 28 02:00:44 1994  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Version 0.5.0 released.
+
+Fri Oct 14 15:03:35 1994  Craig Burley  (burley@gnu.ai.mit.edu)
+
+	* Makefile.in: Handle the Fortran-77 front-end in a subdirectory.
+	* f-*: Move Fortran-77 front-end to f/*.
+
+Local Variables:
+add-log-time-format: current-time-string
+End:
diff --git a/gcc/f/Make-lang.in b/gcc/f/Make-lang.in
new file mode 100644
index 00000000000..47585b0e242
--- /dev/null
+++ b/gcc/f/Make-lang.in
@@ -0,0 +1,516 @@
+# Top level -*- makefile -*- fragment for GNU Fortran.
+#   Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+
+#This file is part of GNU Fortran.
+
+#GNU Fortran is free software; you can redistribute it and/or modify
+#it under the terms of the GNU General Public License as published by
+#the Free Software Foundation; either version 2, or (at your option)
+#any later version.
+
+#GNU Fortran is distributed in the hope that it will be useful,
+#but WITHOUT ANY WARRANTY; without even the implied warranty of
+#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#GNU General Public License for more details.
+
+#You should have received a copy of the GNU General Public License
+#along with GNU Fortran; see the file COPYING.  If not, write to
+#the Free Software Foundation, 59 Temple Place - Suite 330,
+#Boston, MA 02111-1307, USA.
+
+# This file provides the language dependent support in the main Makefile.
+# Each language makefile fragment must provide the following targets:
+#
+# foo.all.build, foo.all.cross, foo.start.encap, foo.rest.encap,
+# foo.install-normal, foo.install-common, foo.install-man,
+# foo.uninstall,
+# foo.mostlyclean, foo.clean, foo.distclean,
+# foo.maintainer-clean, foo.stage1, foo.stage2, foo.stage3, foo.stage4
+#
+# where `foo' is the name of the language.
+#
+# It should also provide rules for:
+#
+# - making any compiler driver (eg: g++)
+# - the compiler proper (eg: cc1plus)
+# - define the names for selecting the language in LANGUAGES.
+#
+# $(srcdir) must be set to the gcc/ source directory (not gcc/f/).
+#
+# Actual name to use when installing a native compiler.
+G77_INSTALL_NAME := $(shell echo g77|sed '$(program_transform_name)')
+
+# Some versions of `touch' (such as the version on Solaris 2.8) 
+# do not correctly set the timestamp due to buggy versions of `utime'
+# in the kernel.  So, we use `echo' instead. 
+STAMP = echo timestamp >
+
+#
+# Define the names for selecting f77 in LANGUAGES.
+# Note that it would be nice to move the dependency on g77
+# into the F77 rule, but that needs a little bit of work
+# to do the right thing within all.cross.
+F77 f77: f771$(exeext)
+
+# Tell GNU make to ignore these if they exist.
+.PHONY: F77 f77 f77.all.build f77.all.cross \
+  f77.start.encap f77.rest.encap f77.dvi \
+  f77.install-normal \
+  f77.install-common f77.install-man \
+  f77.uninstall f77.mostlyclean f77.clean f77.distclean \
+  f77.maintainer-clean \
+  f77.stage1 f77.stage2 f77.stage3 f77.stage4 \
+  f77.stageprofile f77.stagefeedback
+
+g77spec.o: $(srcdir)/f/g77spec.c $(SYSTEM_H) coretypes.h $(TM_H) $(GCC_H) \
+	$(CONFIG_H) intl.h
+	(SHLIB_LINK='$(SHLIB_LINK)' \
+	SHLIB_MULTILIB='$(SHLIB_MULTILIB)'; \
+	$(CC) -c $(ALL_CFLAGS) $(ALL_CPPFLAGS) $(DRIVER_DEFINES) \
+		$(INCLUDES) $(srcdir)/f/g77spec.c)
+
+# Create the compiler driver for g77.
+g77$(exeext): gcc.o g77spec.o version.o prefix.o intl.o \
+  $(LIBDEPS) $(EXTRA_GCC_OBJS)
+	$(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ gcc.o g77spec.o \
+	   version.o prefix.o intl.o $(EXTRA_GCC_OBJS) $(LIBS)
+
+# Create a version of the g77 driver which calls the cross-compiler.
+g77-cross$(exeext): g77$(exeext)
+	rm -f g77-cross$(exeext); \
+	cp g77$(exeext) g77-cross$(exeext)
+
+# The compiler itself.
+
+F77_OBJS = f/bad.o f/bit.o f/bld.o f/com.o f/data.o f/equiv.o f/expr.o \
+ f/global.o f/implic.o f/info.o f/intrin.o f/lab.o f/lex.o f/malloc.o \
+ f/name.o f/parse.o f/src.o f/st.o f/sta.o f/stb.o f/stc.o \
+ f/std.o f/ste.o f/storag.o f/stp.o f/str.o f/sts.o f/stt.o f/stu.o \
+ f/stv.o f/stw.o f/symbol.o f/target.o f/top.o f/type.o f/where.o
+
+# Use loose warnings for this front end.
+f-warn = $(WERROR)
+
+f771$(exeext): $(F77_OBJS) $(BACKEND) $(LIBDEPS)
+	rm -f f771$(exeext)
+	$(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ $(F77_OBJS) $(BACKEND) $(LIBS)
+
+# Keyword tables.
+f/stamp-str: f/str-1t.h f/str-1t.j f/str-2t.h f/str-2t.j \
+ f/str-fo.h f/str-fo.j f/str-io.h f/str-io.j f/str-nq.h  f/str-nq.j \
+ f/str-op.h f/str-op.j f/str-ot.h f/str-ot.j
+	$(STAMP) f/stamp-str
+
+f/str-1t.h f/str-1t.j: f/fini$(build_exeext) f/str-1t.fin
+	./f/fini$(build_exeext) $(srcdir)/f/str-1t.fin f/str-1t.j f/str-1t.h
+
+f/str-2t.h f/str-2t.j: f/fini$(build_exeext) f/str-2t.fin
+	./f/fini$(build_exeext) $(srcdir)/f/str-2t.fin f/str-2t.j f/str-2t.h
+
+f/str-fo.h f/str-fo.j: f/fini$(build_exeext) f/str-fo.fin
+	./f/fini$(build_exeext) $(srcdir)/f/str-fo.fin f/str-fo.j f/str-fo.h
+
+f/str-io.h f/str-io.j: f/fini$(build_exeext) f/str-io.fin
+	./f/fini$(build_exeext) $(srcdir)/f/str-io.fin f/str-io.j f/str-io.h
+
+f/str-nq.h f/str-nq.j: f/fini$(build_exeext) f/str-nq.fin
+	./f/fini$(build_exeext) $(srcdir)/f/str-nq.fin f/str-nq.j f/str-nq.h
+
+f/str-op.h f/str-op.j: f/fini$(build_exeext) f/str-op.fin
+	./f/fini$(build_exeext) $(srcdir)/f/str-op.fin f/str-op.j f/str-op.h
+
+f/str-ot.h f/str-ot.j: f/fini$(build_exeext) f/str-ot.fin
+	./f/fini$(build_exeext) $(srcdir)/f/str-ot.fin f/str-ot.j f/str-ot.h
+
+f/fini$(build_exeext): f/fini.o $(BUILD_LIBDEPS)
+	$(CC_FOR_BUILD) $(BUILD_CFLAGS) $(BUILD_LDFLAGS) -o f/fini$(build_exeext) \
+		f/fini.o $(BUILD_LIBS)
+
+f/fini.o:
+	$(CC_FOR_BUILD) $(BUILD_CFLAGS) $(BUILD_CPPFLAGS) $(INCLUDES) \
+	      -c $(srcdir)/f/fini.c $(OUTPUT_OPTION)
+
+gt-f-lex.h gt-f-where.h gt-f-com.h gt-f-ste.h gtype-f.h : s-gtype; @true
+
+#
+# Build hooks:
+
+f77.all.build: g77$(exeext)
+f77.all.cross: g77-cross$(exeext)
+f77.start.encap: g77$(exeext)
+f77.rest.encap:
+
+f77.srcinfo: doc/g77.info
+	-cp -p $^ $(srcdir)/doc
+f77.srcman: doc/g77.1
+	-cp -p $^ $(srcdir)/doc
+f77.srcextra: f/BUGS f/NEWS 
+	-cp -p $^ $(srcdir)/f
+
+f77.tags: force
+	cd $(srcdir)/f; etags -o TAGS.sub *.c *.h; \
+	etags --include TAGS.sub --include ../TAGS.sub
+
+f77.info: doc/g77.info
+dvi:: doc/g77.dvi
+f77.man: doc/g77.1
+
+check-f77 : check-g77
+lang_checks += check-g77
+
+# g77 documentation.
+TEXI_G77_FILES = f/g77.texi f/bugs.texi f/ffe.texi f/invoke.texi \
+		 f/news.texi f/root.texi $(docdir)/include/fdl.texi \
+		 $(docdir)/include/gpl.texi $(docdir)/include/funding.texi \
+		 $(docdir)/include/gcc-common.texi $(srcdir)/f/intdoc.texi
+
+doc/g77.info: $(TEXI_G77_FILES)
+	if test "x$(BUILD_INFO)" = xinfo; then \
+	  rm -f $(@)*; \
+	  $(MAKEINFO) $(MAKEINFOFLAGS) -I$(docdir)/include -I$(srcdir)/f \
+            -o$@ $<; \
+	else true; fi
+
+doc/g77.dvi: $(TEXI_G77_FILES)
+	$(TEXI2DVI) -I $(srcdir)/f -I $(abs_docdir)/include -I $(objdir)/f -o $@ $<
+
+.INTERMEDIATE: g77.pod
+g77.pod: f/invoke.texi
+	-$(TEXI2POD) < $< > $@
+
+# This dance is all about producing accurate documentation for g77's
+# intrinsics with minimum fuss.  f/ansify appends "\n\" to C strings
+# so ANSI C compilers can compile f/intdoc.h -- gcc can compile f/intdoc.in
+# directly, if f/intdoc.c #include'd that, but we don't want to force
+# people to install gcc just to build the documentation.  We use the
+# C format for f/intdoc.in in the first place to allow a fairly "free",
+# but widely known format for documentation -- basically anyone who knows
+# how to write texinfo source and enclose it in C constants can handle
+# it, and f/ansify allows them to not even end lines with "\n\".  So,
+# essentially, the C preprocessor and compiler are used to enter the
+# document snippets into a data base via name lookup, rather than duplicating
+# that kind of code here.  And we use f/intdoc.c instead of straight
+# texinfo in the first place so that as much information as possible
+# contained in f/intrin.def can be inserted directly and reliably into
+# the documentation.  That's better than replicating it, because it
+# reduces the likelihood of discrepancies between the docs and the compiler
+# itself, which uses f/intrin.def; in fact, many bugs in f/intrin.def have
+# been found only upon reading the documentation that was automatically
+# produced from it.
+
+# If the documentation files depended on executables in the build
+# tree, there'd be no way to ship a source tree with the documentation
+# already generated such that `make' wouldn't attempt to rebuild it.
+# So, we punt and arrange for the documentation files to depend on the
+# dependencies of the executables, not on the executables themselves.
+# But then, we have to build the executables explicitly in their build
+# rules.
+
+INTDOC_DEPS = f/intdoc.c f/intrin.h f/intrin.def
+
+$(srcdir)/f/intdoc.texi: $(INTDOC_DEPS) f/intdoc.in
+	$(MAKE) f/intdoc$(build_exeext)
+	f/intdoc$(build_exeext) > $(srcdir)/f/intdoc.texi
+
+f/intdoc$(build_exeext): $(INTDOC_DEPS) f/intdoc.h0 bconfig.h \
+  $(SYSTEM_H) coretypes.h $(TM_H) $(BUILD_LIBDEPS)
+	$(CC_FOR_BUILD) $(BUILD_CFLAGS) $(BUILD_LDFLAGS) $(INCLUDES) $< \
+	  $(BUILD_LIBS) -o $@
+
+f/intdoc.h0: f/intdoc.in f/ansify$(build_exeext)
+	f/ansify$(build_exeext) $< < $< > $@
+
+f/ansify$(build_exeext): f/ansify.c bconfig.h $(SYSTEM_H) coretypes.h $(TM_H)
+	  $(CC_FOR_BUILD) $(BUILD_CFLAGS) $(BUILD_LDFLAGS) $(INCLUDES) $< \
+	  -o $@
+
+f/BUGS: f/bugs0.texi f/bugs.texi f/root.texi
+	if [ x$(BUILD_INFO) = xinfo ]; then \
+	  rm -f $(@)*; \
+	  $(MAKEINFO) $(MAKEINFOFLAGS) -D BUGSONLY --no-header --no-split \
+           --no-validate -I$(docdir)/include -I$(srcdir)/f -o $@ bugs0.texi; \
+	else true; fi
+
+f/NEWS: f/news0.texi f/news.texi f/root.texi
+	if [ x$(BUILD_INFO) = xinfo ]; then \
+	  rm -f $(@)*; \
+	  $(MAKEINFO) $(MAKEINFOFLAGS) -D NEWSONLY --no-header --no-split \
+           --no-validate -I$(docdir)/include -I$(srcdir)/f -o $@ news0.texi; \
+	else true; fi
+
+#
+# Install hooks:
+# f771 is installed elsewhere as part of $(COMPILERS).
+
+f77.install-normal:
+
+# Install the driver program as $(target)-g77
+# and also as either g77 (if native) or $(tooldir)/bin/g77.
+f77.install-common: installdirs
+	-if [ -f f771$(exeext) ] ; then \
+	  rm -f $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \
+	  $(INSTALL_PROGRAM) g77$(exeext) $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \
+	  chmod a+x $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \
+	else true; fi
+	@if [ -f f77-install-ok -o -f $(srcdir)/f77-install-ok ]; then \
+	  echo ''; \
+	  echo 'Warning: gcc no longer installs an f77 command.'; \
+	  echo '         You must do so yourself.  For more information,'; \
+	  echo '         read "Distributing Binaries" in the g77 docs.'; \
+	  echo '         (To turn off this warning, delete the file'; \
+	  echo '         f77-install-ok in the source or build directory.)'; \
+	  echo ''; \
+	else true; fi
+
+install-info:: $(DESTDIR)$(infodir)/g77.info
+
+f77.install-man: installdirs $(DESTDIR)$(man1dir)/$(G77_INSTALL_NAME)$(man1ext)
+
+$(DESTDIR)$(man1dir)/$(G77_INSTALL_NAME)$(man1ext): doc/g77.1
+	-rm -f $@
+	-$(INSTALL_DATA) $< $@
+	-chmod a-x $@
+
+f77.uninstall: installdirs
+	if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \
+	  echo " install-info --delete --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/g77.info"; \
+	  install-info --delete --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/g77.info || : ; \
+	else : ; fi
+	rm -rf $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \
+	rm -rf $(DESTDIR)$(man1dir)/$(G77_INSTALL_NAME)$(man1ext); \
+	rm -rf $(DESTDIR)$(infodir)/g77.info*
+#
+# Clean hooks:
+# A lot of the ancillary files are deleted by the main makefile.
+# We just have to delete files specific to us.
+
+f77.mostlyclean:
+	-rm -f f/*$(objext)
+	-rm -f f/*$(coverageexts)
+	-rm -f f/fini$(build_exeext) f/stamp-str f/str-*.h f/str-*.j
+	-rm -f f/BUGS f/NEWS
+	-rm -f g77.aux g77.cps g77.ky g77.toc g77.vr g77.fn g77.kys \
+	       g77.pg g77.tp g77.vrs g77.cp g77.fns g77.log g77.pgs g77.tps 
+f77.clean:
+	-rm -f g77spec.o
+f77.distclean:
+	-rm -f f/Makefile
+f77.maintainer-clean:
+	-rm -f $(srcdir)/f/BUGS $(srcdir)/f/TAGS $(srcdir)/f/TAGS.SUB
+	-rm -f $(srcdir)/f/NEWS $(srcdir)/f/intdoc.texi
+#
+# Stage hooks:
+# The main makefile has already created stage?/f.
+
+G77STAGESTUFF = f/*$(objext) f/fini$(build_exeext) f/stamp-str \
+  f/str-*.h f/str-*.j g77spec.o
+
+f77.stage1: stage1-start
+	-mv -f $(G77STAGESTUFF) stage1/f
+
+f77.stage2: stage2-start
+	-mv -f $(G77STAGESTUFF) stage2/f
+
+f77.stage3: stage3-start
+	-mv -f $(G77STAGESTUFF) stage3/f
+
+f77.stage4: stage4-start
+	-mv -f $(G77STAGESTUFF) stage4/f
+
+f77.stageprofile: stageprofile-start
+	-mv -f $(G77STAGESTUFF) stageprofile/f
+
+f77.stagefeedback: stageprofile-start
+	-mv -f $(G77STAGESTUFF) stagefeedback/f
+#
+# .o: .h dependencies.
+
+f/bad.o: f/bad.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/bad.h f/bad.def f/where.h \
+ glimits.h f/top.h f/malloc.h flags.h f/com.h f/com-rt.def $(TREE_H) f/bld.h \
+ f/bld-op.def f/bit.h f/info.h f/info-b.def f/info-k.def f/info-w.def \
+ f/target.h f/lex.h f/type.h f/intrin.h f/intrin.def f/lab.h f/symbol.h \
+ f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h toplev.h intl.h \
+ diagnostic.h coretypes.h $(TM_H)
+f/bit.o: f/bit.c f/proj.h $(CONFIG_H) $(SYSTEM_H) glimits.h f/bit.h \
+ f/malloc.h coretypes.h $(TM_H)
+f/bld.o: f/bld.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/bld.h f/bld-op.def f/bit.h \
+ f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h f/top.h f/lex.h \
+ f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h f/global.h \
+ f/name.h f/intrin.h f/intrin.def real.h coretypes.h $(TM_H)
+f/com.o: f/com.c f/proj.h $(CONFIG_H) $(SYSTEM_H) flags.h $(RTL_H) $(TREE_H) \
+ output.h convert.h f/com.h f/com-rt.def f/bld.h f/bld-op.def f/bit.h \
+ f/malloc.h f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \
+ f/bad.def f/where.h glimits.h f/top.h f/lex.h f/type.h f/intrin.h \
+ f/intrin.def f/lab.h f/symbol.h f/symbol.def f/equiv.h f/storag.h f/global.h \
+ f/name.h f/expr.h f/implic.h f/src.h f/st.h $(GGC_H) toplev.h diagnostic.h \
+ $(LANGHOOKS_DEF) langhooks.h intl.h real.h debug.h gt-f-com.h gtype-f.h \
+ coretypes.h $(TM_H)
+f/data.o: f/data.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/data.h f/bld.h f/bld-op.def \
+ f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \
+ f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h \
+ f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h \
+ f/global.h f/name.h f/intrin.h f/intrin.def f/expr.h f/st.h coretypes.h $(TM_H)
+f/equiv.o: f/equiv.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/equiv.h f/bld.h \
+ f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h \
+ f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h \
+ glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def \
+ f/global.h f/name.h f/intrin.h f/intrin.def f/data.h coretypes.h $(TM_H)
+f/expr.o: f/expr.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/expr.h f/bld.h f/bld-op.def \
+ f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \
+ f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h \
+ f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h \
+ f/global.h f/name.h f/intrin.h f/intrin.def f/implic.h f/src.h f/st.h \
+ f/stamp-str real.h coretypes.h $(TM_H)
+f/fini.o: f/fini.c f/proj.h bconfig.h $(SYSTEM_H) f/malloc.h coretypes.h $(TM_H)
+f/global.o: f/global.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/global.h f/info.h \
+ f/info-b.def f/info-k.def f/info-w.def f/target.h $(TREE_H) f/bad.h f/bad.def \
+ f/where.h glimits.h f/top.h f/malloc.h f/lex.h f/type.h f/name.h f/symbol.h \
+ f/symbol.def f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def f/lab.h \
+ f/storag.h f/intrin.h f/intrin.def f/equiv.h coretypes.h $(TM_H)
+f/implic.o: f/implic.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/implic.h f/info.h \
+ f/info-b.def f/info-k.def f/info-w.def f/target.h $(TREE_H) f/bad.h f/bad.def \
+ f/where.h glimits.h f/top.h f/malloc.h f/lex.h f/type.h f/symbol.h \
+ f/symbol.def f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def f/lab.h \
+ f/storag.h f/intrin.h f/intrin.def f/equiv.h f/global.h f/name.h f/src.h \
+ coretypes.h $(TM_H)
+f/info.o: f/info.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/info.h f/info-b.def \
+ f/info-k.def f/info-w.def f/target.h $(TREE_H) f/bad.h f/bad.def f/where.h \
+ glimits.h f/top.h f/malloc.h f/lex.h f/type.h coretypes.h $(TM_H)
+f/intrin.o: f/intrin.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/intrin.h \
+ f/intrin.def f/bld.h f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def \
+ $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \
+ f/bad.def f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h \
+ f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/expr.h f/src.h \
+ coretypes.h $(TM_H)
+f/lab.o: f/lab.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/lab.h f/com.h f/com-rt.def \
+ $(TREE_H) f/bld.h f/bld-op.def f/bit.h f/malloc.h f/info.h f/info-b.def \
+ f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h \
+ f/top.h f/lex.h f/type.h f/intrin.h f/intrin.def f/symbol.h f/symbol.def \
+ f/equiv.h f/storag.h f/global.h f/name.h coretypes.h $(TM_H)
+f/lex.o: f/lex.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/top.h f/malloc.h f/where.h \
+ glimits.h f/bad.h f/bad.def f/com.h f/com-rt.def $(TREE_H) f/bld.h \
+ f/bld-op.def f/bit.h f/info.h f/info-b.def f/info-k.def f/info-w.def \
+ f/target.h f/lex.h f/type.h f/intrin.h f/intrin.def f/lab.h f/symbol.h \
+ f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h f/src.h flags.h \
+ debug.h input.h toplev.h output.h $(GGC_H) gt-f-lex.h coretypes.h $(TM_H)
+f/malloc.o: f/malloc.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/malloc.h \
+ coretypes.h $(TM_H)
+f/name.o: f/name.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/bad.h f/bad.def f/where.h \
+ glimits.h f/top.h f/malloc.h f/name.h f/global.h f/info.h f/info-b.def \
+ f/info-k.def f/info-w.def f/target.h $(TREE_H) f/lex.h f/type.h f/symbol.h \
+ f/symbol.def f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def f/lab.h \
+ f/storag.h f/intrin.h f/intrin.def f/equiv.h f/src.h coretypes.h $(TM_H)
+f/parse.o: f/parse.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/top.h f/malloc.h \
+ f/where.h glimits.h f/com.h f/com-rt.def $(TREE_H) f/bld.h f/bld-op.def \
+ f/bit.h f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \
+ f/bad.def f/lex.h f/type.h f/intrin.h f/intrin.def f/lab.h f/symbol.h \
+ f/symbol.def f/equiv.h f/storag.h f/global.h f/name.h version.h flags.h \
+ coretypes.h $(TM_H)
+f/src.o: f/src.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/src.h f/bad.h f/bad.def \
+ f/where.h glimits.h f/top.h f/malloc.h coretypes.h $(TM_H)
+f/st.o: f/st.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/st.h f/bad.h f/bad.def \
+ f/where.h glimits.h f/top.h f/malloc.h f/lex.h f/symbol.h f/symbol.def \
+ f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def $(TREE_H) f/info.h \
+ f/info-b.def f/info-k.def f/info-w.def f/target.h f/type.h f/lab.h \
+ f/storag.h f/intrin.h f/intrin.def f/equiv.h f/global.h f/name.h f/sta.h \
+ f/stamp-str f/stb.h f/expr.h f/stp.h f/stt.h f/stc.h f/std.h \
+ f/stv.h f/stw.h f/ste.h f/sts.h f/stu.h coretypes.h $(TM_H)
+f/sta.o: f/sta.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/sta.h f/bad.h f/bad.def \
+ f/where.h glimits.h f/top.h f/malloc.h f/lex.h f/stamp-str f/symbol.h \
+ f/symbol.def f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def $(TREE_H) \
+ f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/type.h f/lab.h \
+ f/storag.h f/intrin.h f/intrin.def f/equiv.h f/global.h f/name.h f/implic.h \
+ f/stb.h f/expr.h f/stp.h f/stt.h f/stc.h f/std.h f/stv.h f/stw.h coretypes.h \
+ $(TM_H)
+f/stb.o: f/stb.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stb.h f/bad.h f/bad.def \
+ f/where.h glimits.h f/top.h f/malloc.h f/expr.h f/bld.h f/bld-op.def f/bit.h \
+ f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/target.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h \
+ f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/stp.h \
+ f/stt.h f/stamp-str f/src.h f/sta.h f/stc.h coretypes.h $(TM_H)
+f/stc.o: f/stc.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stc.h f/bad.h f/bad.def \
+ f/where.h glimits.h f/top.h f/malloc.h f/bld.h f/bld-op.def f/bit.h f/com.h \
+ f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def \
+ f/target.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def \
+ f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/expr.h f/stp.h \
+ f/stt.h f/stamp-str f/data.h f/implic.h f/src.h f/sta.h f/std.h f/stv.h \
+ f/stw.h coretypes.h $(TM_H)
+f/std.o: f/std.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/std.h f/bld.h f/bld-op.def \
+ f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \
+ f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h \
+ f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h f/symbol.def f/equiv.h \
+ f/global.h f/name.h f/intrin.h f/intrin.def f/stp.h f/stt.h f/stamp-str \
+ f/stv.h f/stw.h f/sta.h f/ste.h f/sts.h coretypes.h $(TM_H)
+f/ste.o: f/ste.c f/proj.h $(CONFIG_H) $(SYSTEM_H) $(RTL_H) toplev.h f/ste.h \
+ f/bld.h f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H)	\
+ f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def \
+ f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h \
+ f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def f/stp.h \
+ f/stt.h f/stamp-str f/sts.h f/stv.h f/stw.h f/expr.h f/sta.h $(GGC_H) \
+ gt-f-ste.h coretypes.h $(TM_H)
+f/storag.o: f/storag.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/storag.h f/bld.h  \
+ f/bld-op.def f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) \
+ f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \
+ f/bad.def f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h \
+ f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h \
+ f/intrin.def f/data.h coretypes.h $(TM_H)
+f/stp.o: f/stp.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stp.h f/bld.h f/bld-op.def \
+ f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h \
+ f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def \
+ f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h \
+ f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h \
+ f/intrin.def f/stt.h coretypes.h $(TM_H)
+f/str.o: f/str.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/src.h f/bad.h f/bad.def \
+ f/where.h glimits.h f/top.h f/malloc.h f/stamp-str f/lex.h coretypes.h $(TM_H)
+f/sts.o: f/sts.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/sts.h f/malloc.h f/com.h \
+ f/com-rt.def $(TREE_H) f/bld.h f/bld-op.def f/bit.h f/info.h \
+ f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def \
+ f/where.h glimits.h f/top.h f/lex.h f/type.h f/intrin.h f/intrin.def \
+ f/lab.h f/symbol.h f/symbol.def f/equiv.h f/storag.h f/global.h \
+ f/name.h coretypes.h $(TM_H)
+f/stt.o: f/stt.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stt.h f/top.h f/malloc.h \
+ f/where.h glimits.h f/bld.h f/bld-op.def f/bit.h f/com.h f/com-rt.def \
+ $(TREE_H) f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h \
+ f/bad.h f/bad.def f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h \
+ f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def \
+ f/stp.h f/expr.h f/sta.h f/stamp-str coretypes.h $(TM_H)
+f/stu.o: f/stu.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/bld.h f/bld-op.def f/bit.h \
+ f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h f/info-b.def \
+ f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def f/where.h \
+ glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h f/symbol.h \
+ f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h f/intrin.def \
+ f/implic.h f/stu.h f/sta.h f/stamp-str coretypes.h $(TM_H)
+f/stv.o: f/stv.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stv.h f/lab.h f/com.h \
+ f/com-rt.def $(TREE_H) f/bld.h f/bld-op.def f/bit.h f/malloc.h \
+ f/info.h f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h \
+ f/bad.def f/where.h glimits.h f/top.h f/lex.h f/type.h f/intrin.h \
+ f/intrin.def f/symbol.h f/symbol.def f/equiv.h f/storag.h f/global.h \
+ f/name.h coretypes.h $(TM_H)
+f/stw.o: f/stw.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/stw.h f/bld.h f/bld-op.def \
+ f/bit.h f/malloc.h f/com.h f/com-rt.def $(TREE_H) f/info.h \
+ f/info-b.def f/info-k.def f/info-w.def f/target.h f/bad.h f/bad.def \
+ f/where.h glimits.h f/top.h f/lex.h f/type.h f/lab.h f/storag.h \
+ f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h \
+ f/intrin.def f/stv.h f/sta.h f/stamp-str coretypes.h $(TM_H)
+f/symbol.o: f/symbol.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/symbol.h \
+ f/symbol.def f/bld.h f/bld-op.def f/bit.h f/malloc.h f/com.h \
+ f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/target.h f/bad.h f/bad.def f/where.h glimits.h f/top.h \
+ f/lex.h f/type.h f/lab.h f/storag.h f/intrin.h f/intrin.def f/equiv.h \
+ f/global.h f/name.h f/src.h f/st.h coretypes.h $(TM_H)
+f/target.o: f/target.c f/proj.h $(CONFIG_H) $(SYSTEM_H) glimits.h f/target.h \
+ $(TREE_H) f/bad.h f/bad.def f/where.h f/top.h f/malloc.h f/info.h real.h \
+ f/info-b.def f/info-k.def f/info-w.def f/type.h f/lex.h diagnostic.h \
+ coretypes.h $(TM_H) toplev.h
+f/top.o: f/top.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/top.h f/malloc.h f/where.h \
+ glimits.h f/bad.h f/bad.def f/bit.h f/bld.h f/bld-op.def f/com.h \
+ f/com-rt.def $(TREE_H) f/info.h f/info-b.def f/info-k.def \
+ f/info-w.def f/target.h f/lex.h f/type.h f/lab.h f/storag.h \
+ f/symbol.h f/symbol.def f/equiv.h f/global.h f/name.h f/intrin.h \
+ f/intrin.def f/data.h f/expr.h f/implic.h f/src.h f/st.h flags.h \
+ toplev.h coretypes.h $(TM_H) opts.h options.h
+f/type.o: f/type.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/type.h f/malloc.h \
+ coretypes.h $(TM_H)
+f/where.o: f/where.c f/proj.h $(CONFIG_H) $(SYSTEM_H) f/where.h glimits.h \
+ f/top.h f/malloc.h f/lex.h $(GGC_H) gt-f-where.h coretypes.h $(TM_H)
diff --git a/gcc/f/RELEASE-PREP b/gcc/f/RELEASE-PREP
new file mode 100644
index 00000000000..71eebf614c4
--- /dev/null
+++ b/gcc/f/RELEASE-PREP
@@ -0,0 +1,5 @@
+1999-03-13  RELEASE-PREP
+
+Things to do to prepare a g77 release.
+
+-  Update root.texi: clear DEVELOPMENT flag, set version info.
diff --git a/gcc/f/ansify.c b/gcc/f/ansify.c
new file mode 100644
index 00000000000..b03206d79e3
--- /dev/null
+++ b/gcc/f/ansify.c
@@ -0,0 +1,190 @@
+/* ansify.c
+   Copyright (C) 1997, 2003 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.  */
+
+#include "bconfig.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+
+#define die_unless(c) \
+  do if (!(c)) \
+    { \
+      fprintf (stderr, "%s:%lu: %s\n", argv[1], lineno, #c); \
+      die (); \
+    } \
+  while(0)
+
+static void ATTRIBUTE_NORETURN
+die (void)
+{
+  exit (1);
+}
+
+int
+main(int argc, char **argv)
+{
+  int c;
+  static unsigned long lineno = 1;
+
+  die_unless (argc == 2);
+
+  printf ("\
+/* This file is automatically generated from `%s',\n\
+   which you should modify instead.  */\n\
+#line 1 \"%s\"\n\
+",
+	  argv[1], argv[1]);
+
+  while ((c = getchar ()) != EOF)
+    {
+      switch (c)
+	{
+	default:
+	  putchar (c);
+	  break;
+
+	case '\n':
+	  ++lineno;
+	  putchar (c);
+	  break;
+
+	case '"':
+	  putchar (c);
+	  for (;;)
+	    {
+	      c = getchar ();
+	      die_unless (c != EOF);
+	      switch (c)
+		{
+		case '"':
+		  putchar (c);
+		  goto next_char;
+
+		case '\n':
+		  putchar ('\\');
+		  putchar ('n');
+		  putchar ('\\');
+		  putchar ('\n');
+		  ++lineno;
+		  break;
+
+		case '\\':
+		  putchar (c);
+		  c = getchar ();
+		  die_unless (c != EOF);
+		  putchar (c);
+		  if (c == '\n')
+		    ++lineno;
+		  break;
+		  
+		default:
+		  putchar (c);
+		  break;
+		}
+	    }
+	  break;
+
+	case '\'':
+	  putchar (c);
+	  for (;;)
+	    {
+	      c = getchar ();
+	      die_unless (c != EOF);
+	      switch (c)
+		{
+		case '\'':
+		  putchar (c);
+		  goto next_char;
+		  
+		case '\n':
+		  putchar ('\\');
+		  putchar ('n');
+		  putchar ('\\');
+		  putchar ('\n');
+		  ++lineno;
+		  break;
+		  
+		case '\\':
+		  putchar (c);
+		  c = getchar ();
+		  die_unless (c != EOF);
+		  putchar (c);
+		  if (c == '\n')
+		    ++lineno;
+		  break;
+		  
+		default:
+		  putchar (c);
+		  break;
+		}
+	    }
+	  break;
+
+	case '/':
+	  putchar (c);
+	  c = getchar ();
+	  putchar (c);
+	  if (c != '*')
+	    break;
+	  for (;;)
+	    {
+	      c = getchar ();
+	      die_unless (c != EOF);
+
+	      switch (c)
+		{
+		case '\n':
+		  ++lineno;
+		  putchar (c);
+		  break;
+		  
+		case '*':
+		  c = getchar ();
+		  die_unless (c != EOF);
+		  if (c == '/')
+		    {
+		      putchar ('*');
+		      putchar ('/');
+		      goto next_char;
+		    }
+		  if (c == '\n')
+		    {
+		      ++lineno;
+		      putchar (c);
+		    }
+		  break;
+		  
+		default:
+		  /* Don't bother outputting content of comments.  */
+		  break;
+		}
+	    }
+	  break;
+	}
+      
+    next_char:
+      ;
+    }
+
+  die_unless (c == EOF);
+
+  return 0;
+}
diff --git a/gcc/f/bad.c b/gcc/f/bad.c
new file mode 100644
index 00000000000..bed9734ecc7
--- /dev/null
+++ b/gcc/f/bad.c
@@ -0,0 +1,537 @@
+/* bad.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Related Modules:
+      None
+
+   Description:
+      Handles the displaying of diagnostic messages regarding the user's source
+      files.
+
+   Modifications:
+*/
+
+/* If there's a %E or %4 in the messages, set this to at least 5,
+   for example.  */
+
+#define FFEBAD_MAX_ 6
+
+/* Include files. */
+
+#include "proj.h"
+#include "bad.h"
+#include "flags.h"
+#include "com.h"
+#include "toplev.h"
+#include "where.h"
+#include "intl.h"
+#include "diagnostic.h"
+
+/* Externals defined here. */
+
+bool ffebad_is_inhibited_ = FALSE;
+
+/* Simple definitions and enumerations. */
+
+#define FFEBAD_LONG_MSGS_ 1	/* 0 to use short (or same) messages. */
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffebad_message_
+  {
+    const ffebadSeverity severity;
+    const char *const message;
+  };
+
+/* Static objects accessed by functions in this module.	 */
+
+static const struct _ffebad_message_ ffebad_messages_[]
+=
+{
+#define FFEBAD_MSG(kwd,sev,msgid) { sev, msgid },
+#if FFEBAD_LONG_MSGS_ == 0
+#define LONG(m)
+#define SHORT(m) m
+#else
+#define LONG(m) m
+#define SHORT(m)
+#endif
+#include "bad.def"
+#undef FFEBAD_MSG
+#undef LONG
+#undef SHORT
+};
+
+static struct
+  {
+    ffewhereLine line;
+    ffewhereColumn col;
+    ffebadIndex tag;
+  }
+
+ffebad_here_[FFEBAD_MAX_];
+static const char *ffebad_string_[FFEBAD_MAX_];
+static ffebadIndex ffebad_order_[FFEBAD_MAX_];
+static ffebad ffebad_errnum_;
+static ffebadSeverity ffebad_severity_;
+static const char *ffebad_message_;
+static unsigned char ffebad_index_;
+static ffebadIndex ffebad_places_;
+static bool ffebad_is_temp_inhibited_;	/* Effective setting of
+					   _is_inhibited_ for this
+					   _start/_finish invocation. */
+
+/* Static functions (internal). */
+
+static int ffebad_bufputs_ (char buf[], int bufi, const char *s);
+
+/* Internal macros. */
+
+#define ffebad_bufflush_(buf, bufi) \
+  (((buf)[bufi] = '\0'), fputs ((buf), stderr), 0)
+#define ffebad_bufputc_(buf, bufi, c) \
+  (((bufi) == ARRAY_SIZE (buf)) \
+   ? (ffebad_bufflush_ ((buf), (bufi)), ((buf)[0] = (c)), 1) \
+   : (((buf)[bufi] = (c)), (bufi) + 1))
+
+
+static int
+ffebad_bufputs_ (char buf[], int bufi, const char *s)
+{
+  for (; *s != '\0'; ++s)
+    bufi = ffebad_bufputc_ (buf, bufi, *s);
+  return bufi;
+}
+
+/* ffebad_init_0 -- Initialize
+
+   ffebad_init_0();  */
+
+void
+ffebad_init_0 (void)
+{
+  assert (FFEBAD == ARRAY_SIZE (ffebad_messages_));
+}
+
+ffebadSeverity
+ffebad_severity (ffebad errnum)
+{
+  return ffebad_messages_[errnum].severity;
+}
+
+/* ffebad_start_ -- Start displaying an error message
+
+   ffebad_start(FFEBAD_SOME_ERROR_CODE);
+
+   Call ffebad_start to establish the message, ffebad_here and ffebad_string
+   to send run-time data to it as necessary, then ffebad_finish when through
+   to actually get it to print (to stderr).
+
+   Note: ffebad_start(errnum) turns into ffebad_start_(FALSE,errnum).  No
+   outside caller should call ffebad_start_ directly (as indicated by the
+   trailing underscore).
+
+   Call ffebad_start to start a normal message, one that might be inhibited
+   by the current state of statement guessing.	Call ffebad_start_lex
+   instead to start a message that is global to all statement guesses and
+   happens only once for all guesses (i.e. the lexer).
+
+   sev and message are overrides for the severity and messages when errnum
+   is FFEBAD, meaning the caller didn't want to have to put a message in
+   bad.def to produce a diagnostic.  */
+
+bool
+ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev,
+	       const char *msgid)
+{
+  unsigned char i;
+
+  if (ffebad_is_inhibited_ && !lex_override)
+    {
+      ffebad_is_temp_inhibited_ = TRUE;
+      return FALSE;
+    }
+
+  if (errnum != FFEBAD)
+    {
+      ffebad_severity_ = ffebad_messages_[errnum].severity;
+      ffebad_message_ = gettext (ffebad_messages_[errnum].message);
+    }
+  else
+    {
+      ffebad_severity_ = sev;
+      ffebad_message_ = gettext (msgid);
+    }
+
+  switch (ffebad_severity_)
+    {				/* Tell toplev.c about this message. */
+    case FFEBAD_severityINFORMATIONAL:
+    case FFEBAD_severityTRIVIAL:
+      if (inhibit_warnings)
+	{			/* User wants no warnings. */
+	  ffebad_is_temp_inhibited_ = TRUE;
+	  return FALSE;
+	}
+      /* Fall through.  */
+    case FFEBAD_severityWARNING:
+    case FFEBAD_severityPECULIAR:
+    case FFEBAD_severityPEDANTIC:
+      if ((ffebad_severity_ != FFEBAD_severityPEDANTIC)
+	  || !flag_pedantic_errors)
+	{
+	  if (!diagnostic_report_warnings_p ())
+	    {			/* User wants no warnings. */
+	      ffebad_is_temp_inhibited_ = TRUE;
+	      return FALSE;
+	    }
+	  diagnostic_kind_count (global_dc, DK_WARNING)++;
+	  break;
+	}
+      /* Fall through (PEDANTIC && flag_pedantic_errors).  */
+    case FFEBAD_severityFATAL:
+    case FFEBAD_severityWEIRD:
+    case FFEBAD_severitySEVERE:
+    case FFEBAD_severityDISASTER:
+      diagnostic_kind_count (global_dc, DK_ERROR)++;
+      break;
+
+    default:
+      break;
+    }
+
+  ffebad_is_temp_inhibited_ = FALSE;
+  ffebad_errnum_ = errnum;
+  ffebad_index_ = 0;
+  ffebad_places_ = 0;
+  for (i = 0; i < FFEBAD_MAX_; ++i)
+    {
+      ffebad_string_[i] = NULL;
+      ffebad_here_[i].line = ffewhere_line_unknown ();
+      ffebad_here_[i].col = ffewhere_column_unknown ();
+    }
+
+  return TRUE;
+}
+
+/* ffebad_here -- Establish source location of some diagnostic concern
+
+   ffebad_here(ffebadIndex i,ffewhereLine line,ffewhereColumn col);
+
+   Call ffebad_start to establish the message, ffebad_here and ffebad_string
+   to send run-time data to it as necessary, then ffebad_finish when through
+   to actually get it to print (to stderr).  */
+
+void
+ffebad_here (ffebadIndex index, ffewhereLine line, ffewhereColumn col)
+{
+  ffewhereLineNumber line_num;
+  ffewhereLineNumber ln;
+  ffewhereColumnNumber col_num;
+  ffewhereColumnNumber cn;
+  ffebadIndex i;
+  ffebadIndex j;
+
+  if (ffebad_is_temp_inhibited_)
+    return;
+
+  assert (index < FFEBAD_MAX_);
+  ffebad_here_[index].line = ffewhere_line_use (line);
+  ffebad_here_[index].col = ffewhere_column_use (col);
+  if (ffewhere_line_is_unknown (line)
+      || ffewhere_column_is_unknown (col))
+    {
+      ffebad_here_[index].tag = FFEBAD_MAX_;
+      return;
+    }
+  ffebad_here_[index].tag = 0;	/* For now, though it shouldn't matter. */
+
+  /* Sort the source line/col points into the order they occur in the source
+     file.  Deal with duplicates appropriately. */
+
+  line_num = ffewhere_line_number (line);
+  col_num = ffewhere_column_number (col);
+
+  /* Determine where in the ffebad_order_ array this new place should go. */
+
+  for (i = 0; i < ffebad_places_; ++i)
+    {
+      ln = ffewhere_line_number (ffebad_here_[ffebad_order_[i]].line);
+      cn = ffewhere_column_number (ffebad_here_[ffebad_order_[i]].col);
+      if (line_num < ln)
+	break;
+      if (line_num == ln)
+	{
+	  if (col_num == cn)
+	    {
+	      ffebad_here_[index].tag = i;
+	      return;		/* Shouldn't go in, has equivalent. */
+	    }
+	  else if (col_num < cn)
+	    break;
+	}
+    }
+
+  /* Before putting new place in ffebad_order_[i], first increment all tags
+     that are i or greater. */
+
+  if (i != ffebad_places_)
+    {
+      for (j = 0; j < FFEBAD_MAX_; ++j)
+	{
+	  if (ffebad_here_[j].tag >= i)
+	    ++ffebad_here_[j].tag;
+	}
+    }
+
+  /* Then slide all ffebad_order_[] entries at and above i up one entry. */
+
+  for (j = ffebad_places_; j > i; --j)
+    ffebad_order_[j] = ffebad_order_[j - 1];
+
+  /* Finally can put new info in ffebad_order_[i]. */
+
+  ffebad_order_[i] = index;
+  ffebad_here_[index].tag = i;
+  ++ffebad_places_;
+}
+
+/* Establish string for next index (always in order) of message
+
+   ffebad_string(const char *string);
+
+   Call ffebad_start to establish the message, ffebad_here and ffebad_string
+   to send run-time data to it as necessary, then ffebad_finish when through
+   to actually get it to print (to stderr).  Note: don't trash the string
+   until after calling ffebad_finish, since we just maintain a pointer to
+   the argument passed in until then.  */
+
+void
+ffebad_string (const char *string)
+{
+  if (ffebad_is_temp_inhibited_)
+    return;
+
+  assert (ffebad_index_ != FFEBAD_MAX_);
+  ffebad_string_[ffebad_index_++] = string;
+}
+
+/* ffebad_finish -- Display error message with where & run-time info
+
+   ffebad_finish();
+
+   Call ffebad_start to establish the message, ffebad_here and ffebad_string
+   to send run-time data to it as necessary, then ffebad_finish when through
+   to actually get it to print (to stderr).  */
+
+void
+ffebad_finish (void)
+{
+#define MAX_SPACES 132
+  static const char *const spaces
+  = "...>\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
+\040\040\040";			/* MAX_SPACES - 1 spaces. */
+  ffewhereLineNumber last_line_num;
+  ffewhereLineNumber ln;
+  ffewhereLineNumber rn;
+  ffewhereColumnNumber last_col_num;
+  ffewhereColumnNumber cn;
+  ffewhereColumnNumber cnt;
+  ffewhereLine l;
+  ffebadIndex bi;
+  unsigned short i;
+  char pointer;
+  unsigned char c;
+  unsigned const char *s;
+  const char *fn;
+  static char buf[1024];
+  int bufi;
+  int index;
+
+  if (ffebad_is_temp_inhibited_)
+    return;
+
+  switch (ffebad_severity_)
+    {
+    case FFEBAD_severityINFORMATIONAL:
+      s = _("note:");
+      break;
+
+    case FFEBAD_severityWARNING:
+      s = _("warning:");
+      break;
+
+    case FFEBAD_severitySEVERE:
+      s = _("fatal:");
+      break;
+
+    default:
+      s = "";
+      break;
+    }
+
+  /* Display the annoying source references. */
+
+  last_line_num = 0;
+  last_col_num = 0;
+
+  for (bi = 0; bi < ffebad_places_; ++bi)
+    {
+      if (ffebad_places_ == 1)
+	pointer = '^';
+      else
+	pointer = '1' + bi;
+
+      l = ffebad_here_[ffebad_order_[bi]].line;
+      ln = ffewhere_line_number (l);
+      rn = ffewhere_line_filelinenum (l);
+      cn = ffewhere_column_number (ffebad_here_[ffebad_order_[bi]].col);
+      fn = ffewhere_line_filename (l);
+      if (ln != last_line_num)
+	{
+	  if (bi != 0)
+	    fputc ('\n', stderr);
+	  diagnostic_report_current_function (global_dc);
+	  fprintf (stderr,
+		   /* the trailing space on the <file>:<line>: line
+		      fools emacs19 compilation mode into finding the
+		      report */
+		   "%s:%" ffewhereLineNumber_f "u: %s\n   %s\n   %s%c",
+		   fn, rn,
+		   s,
+		   ffewhere_line_content (l),
+		   &spaces[cn > MAX_SPACES ? 0 : MAX_SPACES - cn + 4],
+		   pointer);
+	  last_line_num = ln;
+	  last_col_num = cn;
+	  s = _("(continued):");
+	}
+      else
+	{
+	  cnt = cn - last_col_num;
+	  fprintf (stderr,
+		   "%s%c", &spaces[cnt > MAX_SPACES
+				   ? 0 : MAX_SPACES - cnt + 4],
+		   pointer);
+	  last_col_num = cn;
+	}
+    }
+  if (ffebad_places_ == 0)
+    {
+      /* Didn't output "warning:" string, capitalize it for message.  */
+      if (s[0] != '\0')
+	{
+	  char c;
+
+	  c = TOUPPER (s[0]);
+	  fprintf (stderr, "%c%s ", c, &s[1]);
+	}
+      else if (s[0] != '\0')
+	fprintf (stderr, "%s ", s);
+    }
+  else
+    fputc ('\n', stderr);
+
+  /* Release the ffewhere info. */
+
+  for (bi = 0; bi < FFEBAD_MAX_; ++bi)
+    {
+      ffewhere_line_kill (ffebad_here_[bi].line);
+      ffewhere_column_kill (ffebad_here_[bi].col);
+    }
+
+  /* Now display the message. */
+
+  bufi = 0;
+  for (i = 0; (c = ffebad_message_[i]) != '\0'; ++i)
+    {
+      if (c == '%')
+	{
+	  c = ffebad_message_[++i];
+	  if (ISUPPER (c))
+	    {
+	      index = c - 'A';
+
+	      if ((index < 0) || (index >= FFEBAD_MAX_))
+		{
+		  bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!] %"));
+		  bufi = ffebad_bufputc_ (buf, bufi, c);
+		}
+	      else
+		{
+		  s = ffebad_string_[index];
+		  if (s == NULL)
+		    bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!]"));
+		  else
+		    bufi = ffebad_bufputs_ (buf, bufi, s);
+		}
+	    }
+	  else if (ISDIGIT (c))
+	    {
+	      index = c - '0';
+
+	      if ((index < 0) || (index >= FFEBAD_MAX_))
+		{
+		  bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!] %"));
+		  bufi = ffebad_bufputc_ (buf, bufi, c);
+		}
+	      else
+		{
+		  pointer = ffebad_here_[index].tag + '1';
+		  if (pointer == FFEBAD_MAX_ + '1')
+		    pointer = '?';
+		  else if (ffebad_places_ == 1)
+		    pointer = '^';
+		  bufi = ffebad_bufputc_ (buf, bufi, '(');
+		  bufi = ffebad_bufputc_ (buf, bufi, pointer);
+		  bufi = ffebad_bufputc_ (buf, bufi, ')');
+		}
+	    }
+	  else if (c == '\0')
+	    break;
+	  else if (c == '%')
+	    bufi = ffebad_bufputc_ (buf, bufi, '%');
+	  else
+	    {
+	      bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!]"));
+	      bufi = ffebad_bufputc_ (buf, bufi, '%');
+	      bufi = ffebad_bufputc_ (buf, bufi, c);
+	    }
+	}
+      else
+	bufi = ffebad_bufputc_ (buf, bufi, c);
+    }
+  bufi = ffebad_bufputc_ (buf, bufi, '\n');
+  bufi = ffebad_bufflush_ (buf, bufi);
+}
diff --git a/gcc/f/bad.def b/gcc/f/bad.def
new file mode 100644
index 00000000000..92d7e233030
--- /dev/null
+++ b/gcc/f/bad.def
@@ -0,0 +1,1103 @@
+/* bad.def -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995, 1996, 1997, 2002 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      bad.c
+
+   Modifications:
+*/
+
+#define INFORM FFEBAD_severityINFORMATIONAL
+#define TRIVIAL FFEBAD_severityTRIVIAL
+#define WARN FFEBAD_severityWARNING
+#define PECULIAR FFEBAD_severityPECULIAR
+#define FATAL FFEBAD_severityFATAL
+#define WEIRD FFEBAD_severityWEIRD
+#define SEVERE FFEBAD_severitySEVERE
+#define DISASTER FFEBAD_severityDISASTER
+
+FFEBAD_MSG (FFEBAD_MISSING_FIRST_BINARY_OPERAND, FATAL,
+/* xgettext:no-c-format */
+"Missing first operand for binary operator at %0")
+FFEBAD_MSG (FFEBAD_NULL_CHAR_CONST, WARN,
+/* xgettext:no-c-format */
+"Zero-length character constant at %0")
+FFEBAD_MSG (FFEBAD_INVALID_TOKEN_IN_EXPRESSION, FATAL,
+/* xgettext:no-c-format */
+"Invalid token at %0 in expression or subexpression at %1")
+FFEBAD_MSG (FFEBAD_MISSING_OPERAND_FOR_OPERATOR, FATAL,
+/* xgettext:no-c-format */
+"Missing operand for operator at %1 at end of expression at %0")
+FFEBAD_MSG (FFEBAD_LABEL_ALREADY_DEFINED, FATAL,
+/* xgettext:no-c-format */
+"Label %A already defined at %1 when redefined at %0")
+FFEBAD_MSG (FFEBAD_UNRECOGNIZED_CHARACTER, FATAL,
+/* xgettext:no-c-format */
+"Unrecognized character at %0 [info -f g77 M LEX]")
+FFEBAD_MSG (FFEBAD_LABEL_WITHOUT_STMT, WARN,
+/* xgettext:no-c-format */
+"Label definition %A at %0 on empty statement (as of %1)")
+FFEBAD_MSG (FFEBAD_EXTRA_LABEL_DEF, FATAL,
+/* xgettext:no-c-format */
+LONG("Extra label definition %A at %0 -- perhaps previous label definition %B at %1 should have CONTINUE statement?")
+/* xgettext:no-c-format */
+SHORT("Extra label definition %A at %0 following label definition %B at %1"))
+FFEBAD_MSG (FFEBAD_FIRST_CHAR_INVALID, FATAL,
+/* xgettext:no-c-format */
+"Invalid first character at %0 [info -f g77 M LEX]")
+FFEBAD_MSG (FFEBAD_LINE_TOO_LONG, FATAL,
+/* xgettext:no-c-format */
+"Line too long as of %0 [info -f g77 M LEX]")
+FFEBAD_MSG (FFEBAD_LABEL_FIELD_NOT_NUMERIC, FATAL,
+/* xgettext:no-c-format */
+"Non-numeric character at %0 in label field [info -f g77 M LEX]")
+FFEBAD_MSG (FFEBAD_LABEL_NUMBER_INVALID, FATAL,
+/* xgettext:no-c-format */
+"Label number at %0 not in range 1-99999")
+FFEBAD_MSG (FFEBAD_NON_ANSI_COMMENT, WARN,
+/* xgettext:no-c-format */
+"At %0, '!' and '/*' are not valid comment delimiters")
+FFEBAD_MSG (FFEBAD_NON_ANSI_CONTINUATION_COLUMN, WARN,
+/* xgettext:no-c-format */
+"Continuation indicator at %0 must appear in column 6 [info -f g77 M LEX]")
+FFEBAD_MSG (FFEBAD_LABEL_ON_CONTINUATION, FATAL,
+/* xgettext:no-c-format */
+"Label at %0 invalid with continuation line indicator at %1 [info -f g77 M LEX]")
+FFEBAD_MSG (FFEBAD_INVALID_CONTINUATION, FATAL,
+/* xgettext:no-c-format */
+LONG("Continuation indicator at %0 invalid on first non-comment line of file or following END or INCLUDE [info -f g77 M LEX]")
+/* xgettext:no-c-format */
+SHORT("Continuation indicator at %0 invalid here [info -f g77 M LEX]"))
+FFEBAD_MSG (FFEBAD_NO_CLOSING_APOSTROPHE, FATAL,
+/* xgettext:no-c-format */
+"Character constant at %0 has no closing apostrophe at %1")
+FFEBAD_MSG (FFEBAD_NOT_ENOUGH_HOLLERITH_CHARS, FATAL,
+/* xgettext:no-c-format */
+"Hollerith constant at %0 specified %A more characters than are present as of %1")
+FFEBAD_MSG (FFEBAD_MISSING_CLOSE_PAREN, FATAL,
+/* xgettext:no-c-format */
+"Missing close parenthese at %0 needed to match open parenthese at %1")
+FFEBAD_MSG (FFEBAD_INTEGER_TOO_LARGE, FATAL,
+/* xgettext:no-c-format */
+"Integer at %0 too large")
+FFEBAD_MSG (FFEBAD_BAD_MAGICAL, WARN,
+/* xgettext:no-c-format */
+LONG("Integer at %0 too large except as negative number (preceded by unary minus sign)")
+/* xgettext:no-c-format */
+SHORT("Non-negative integer at %0 too large"))
+FFEBAD_MSG (FFEBAD_BAD_MAGICAL_PRECEDENCE, WARN,
+/* xgettext:no-c-format */
+LONG("Integer at %0 too large; even though preceded by unary minus sign at %1, subsequent operator at %2 has precedence over unary minus -- enclose unary minus sign and integer in parentheses to force precedence")
+/* xgettext:no-c-format */
+SHORT("Integer at %0 too large (%2 has precedence over %1)"))
+FFEBAD_MSG (FFEBAD_BAD_MAGICAL_BINARY, WARN,
+/* xgettext:no-c-format */
+LONG("Integer at %0 too large; even though preceded by minus sign at %1, because minus sign is a binary, not unary, operator -- insert plus sign before minus sign to change it to a unary minus sign")
+/* xgettext:no-c-format */
+SHORT("Integer at %0 too large (needs unary, not binary, minus at %1)"))
+FFEBAD_MSG (FFEBAD_BAD_MAGICAL_PRECEDENCE_BINARY, WARN,
+/* xgettext:no-c-format */
+LONG("Integer at %0 too large; even though preceded by minus sign at %1, subsequent operator at %2 has precedence over minus, and that minus sign should be a unary minus rather than a binary minus -- insert plus sign before minus sign to change it to a unary minus sign, and enclose unary minus sign and integer in parentheses to force precedence")
+/* xgettext:no-c-format */
+SHORT("Integer at %0 too large (%2 has precedence over %1, which needs to be unary, not binary, minus)"))
+FFEBAD_MSG (FFEBAD_IGNORING_PERIOD, FATAL,
+/* xgettext:no-c-format */
+"Period at %0 not followed by digits for floating-point number or by `NOT.', `TRUE.', or `FALSE.'")
+FFEBAD_MSG (FFEBAD_INSERTING_PERIOD, FATAL,
+/* xgettext:no-c-format */
+"Missing close-period between `.%A' at %0 and %1")
+FFEBAD_MSG (FFEBAD_INVALID_EXPONENT, FATAL,
+/* xgettext:no-c-format */
+"Invalid exponent at %0 for real constant at %1; nondigit `%A' in exponent field")
+FFEBAD_MSG (FFEBAD_MISSING_EXPONENT_VALUE, FATAL,
+/* xgettext:no-c-format */
+"Missing value at %1 for real-number exponent at %0")
+FFEBAD_MSG (FFEBAD_MISSING_BINARY_OPERATOR, FATAL,
+/* xgettext:no-c-format */
+"Expected binary operator between expressions at %0 and at %1")
+FFEBAD_MSG (FFEBAD_INVALID_DOTDOT, FATAL,
+/* xgettext:no-c-format */
+LONG("Period at %0 not followed by valid keyword forming a valid binary operator; `.%A.' is not a valid binary operator")
+/* xgettext:no-c-format */
+SHORT("`.%A.' at %0 not a binary operator"))
+FFEBAD_MSG (FFEBAD_QUOTE_MISSES_DIGITS, FATAL,
+/* xgettext:no-c-format */
+LONG("Double-quote at %0 not followed by a string of valid octal digits at %1")
+/* xgettext:no-c-format */
+SHORT("Invalid octal constant at %0"))
+FFEBAD_MSG (FFEBAD_INVALID_BINARY_DIGIT, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid binary digit(s) found in string of digits at %0")
+/* xgettext:no-c-format */
+SHORT("Invalid binary constant at %0"))
+FFEBAD_MSG (FFEBAD_INVALID_HEX_DIGIT, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid hexadecimal digit(s) found in string of digits at %0")
+/* xgettext:no-c-format */
+SHORT("Invalid hexadecimal constant at %0"))
+FFEBAD_MSG (FFEBAD_INVALID_OCTAL_DIGIT, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid octal digit(s) found in string of digits at %0")
+/* xgettext:no-c-format */
+SHORT("Invalid octal constant at %0"))
+FFEBAD_MSG (FFEBAD_INVALID_RADIX_SPECIFIER, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid radix specifier `%A' at %0 for typeless constant at %1")
+/* xgettext:no-c-format */
+SHORT("Invalid typeless constant at %1"))
+FFEBAD_MSG (FFEBAD_INVALID_TYPELESS_BINARY_DIGIT, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid binary digit(s) found in string of digits at %0")
+/* xgettext:no-c-format */
+SHORT("Invalid binary constant at %0"))
+FFEBAD_MSG (FFEBAD_INVALID_TYPELESS_OCTAL_DIGIT, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid octal digit(s) found in string of digits at %0")
+/* xgettext:no-c-format */
+SHORT("Invalid octal constant at %0"))
+FFEBAD_MSG (FFEBAD_INVALID_TYPELESS_HEX_DIGIT, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid hexadecimal digit(s) found in string of digits at %0")
+/* xgettext:no-c-format */
+SHORT("Invalid hexadecimal constant at %0"))
+FFEBAD_MSG (FFEBAD_INVALID_COMPLEX_PART, FATAL,
+/* xgettext:no-c-format */
+LONG("%A part of complex constant at %0 must be a real or integer constant -- otherwise use CMPLX() or COMPLEX() in place of ()")
+/* xgettext:no-c-format */
+SHORT("%A part of complex constant at %0 not a real or integer constant"))
+FFEBAD_MSG (FFEBAD_INVALID_PERCENT, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid keyword `%%%A' at %0 in this context")
+/* xgettext:no-c-format */
+SHORT("Invalid keyword `%%%A' at %0"))
+FFEBAD_MSG (FFEBAD_NULL_EXPRESSION, FATAL,
+/* xgettext:no-c-format */
+LONG("Null expression between %0 and %1 invalid in this context")
+/* xgettext:no-c-format */
+SHORT("Invalid null expression between %0 and %1"))
+FFEBAD_MSG (FFEBAD_CONCAT_ARGS_TYPE, FATAL,
+/* xgettext:no-c-format */
+LONG("Concatenation operator at %0 must operate on two subexpressions of character type, but neither subexpression at %1 or %2 is of character type")
+/* xgettext:no-c-format */
+SHORT("Invalid operands at %1 and %2 for concatenation operator at %0"))
+FFEBAD_MSG (FFEBAD_CONCAT_ARG_TYPE, FATAL,
+/* xgettext:no-c-format */
+LONG("Concatenation operator at %0 must operate on two subexpressions of character type, but the subexpression at %1 is not of character type")
+/* xgettext:no-c-format */
+SHORT("Invalid operand at %1 for concatenation operator at %0"))
+FFEBAD_MSG (FFEBAD_CONCAT_ARG_KIND, FATAL,
+/* xgettext:no-c-format */
+LONG("Concatenation operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning character scalars, or a combination of both -- but the subexpression at %1 is %A")
+/* xgettext:no-c-format */
+SHORT("Invalid operand (is %A) at %1 for concatenation operator at %0"))
+FFEBAD_MSG (FFEBAD_MATH_ARGS_TYPE, FATAL,
+/* xgettext:no-c-format */
+LONG("Arithmetic operator at %0 must operate on two subexpressions of arithmetic type, but neither subexpression at %1 or %2 is of arithmetic type")
+/* xgettext:no-c-format */
+SHORT("Invalid operands at %1 and %2 for arithmetic operator at %0"))
+FFEBAD_MSG (FFEBAD_MATH_ARG_TYPE, FATAL,
+/* xgettext:no-c-format */
+LONG("Arithmetic operator at %0 must operate on two subexpressions of arithmetic type, but the subexpression at %1 is not of arithmetic type")
+/* xgettext:no-c-format */
+SHORT("Invalid operand at %1 for arithmetic operator at %0"))
+FFEBAD_MSG (FFEBAD_MATH_ARG_KIND, FATAL,
+/* xgettext:no-c-format */
+LONG("Arithmetic operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning arithmetic scalars, or a combination of both -- but the subexpression at %1 is %A")
+/* xgettext:no-c-format */
+SHORT("Invalid operand (is %A) at %1 for arithmetic operator at %0"))
+FFEBAD_MSG (FFEBAD_NO_CLOSING_QUOTE, FATAL,
+/* xgettext:no-c-format */
+LONG("Character constant at %0 has no closing quote at %1 [info -f g77 M LEX]")
+/* xgettext:no-c-format */
+SHORT("Unterminated character constant at %0 [info -f g77 M LEX]"))
+FFEBAD_MSG (FFEBAD_BAD_CHAR_CONTINUE, FATAL,
+/* xgettext:no-c-format */
+LONG("Continuation line at %0 must have initial `&' since it continues a character context [info -f g77 M LEX]")
+/* xgettext:no-c-format */
+SHORT("Missing initial `&' on continuation line at %0 [info -f g77 M LEX]"))
+FFEBAD_MSG (FFEBAD_BAD_LEXTOK_CONTINUE, FATAL,
+/* xgettext:no-c-format */
+LONG("Continuation line at %0 must have initial `&' since it continues a split lexical token [info -f g77 M LEX]")
+/* xgettext:no-c-format */
+SHORT("Missing initial `&' on continuation line at %0 [info -f g77 M LEX]"))
+FFEBAD_MSG (FFEBAD_BAD_FREE_CONTINUE, FATAL,
+/* xgettext:no-c-format */
+LONG("Continuation line at %0 invalid because it consists only of a single `&' as the only nonblank character")
+/* xgettext:no-c-format */
+SHORT("Invalid continuation line at %0"))
+FFEBAD_MSG (FFEBAD_STMT_BEGINS_BAD, FATAL,
+/* xgettext:no-c-format */
+LONG("Statement at %0 begins with invalid token [info -f g77 M LEX]")
+/* xgettext:no-c-format */
+SHORT("Invalid statement at %0 [info -f g77 M LEX]"))
+FFEBAD_MSG (FFEBAD_SEMICOLON, FATAL,
+/* xgettext:no-c-format */
+"Semicolon at %0 is an invalid token")
+FFEBAD_MSG (FFEBAD_UNREC_STMT, FATAL,
+/* xgettext:no-c-format */
+LONG("Unrecognized statement name at %0 and invalid form for assignment or statement-function definition at %1")
+/* xgettext:no-c-format */
+SHORT("Invalid statement at %0"))
+FFEBAD_MSG (FFEBAD_INVALID_STMT_FORM, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid form for %A statement at %0")
+/* xgettext:no-c-format */
+SHORT("Invalid %A statement at %0"))
+FFEBAD_MSG (FFEBAD_INVALID_HOLL_IN_STMT, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid use of hollerith constant in statement at %0 -- enclose the constant in parentheses (for example, change BACKSPACE 2HAB to BACKSPACE (2HAB))")
+/* xgettext:no-c-format */
+SHORT("Enclose hollerith constant in statement at %0 in parentheses"))
+FFEBAD_MSG (FFEBAD_FORMAT_EXTRA_COMMA, FATAL,
+/* xgettext:no-c-format */
+"Extraneous comma in FORMAT statement at %0")
+FFEBAD_MSG (FFEBAD_FORMAT_MISSING_COMMA, WARN,
+/* xgettext:no-c-format */
+"Missing comma in FORMAT statement at %0")
+FFEBAD_MSG (FFEBAD_FORMAT_SPURIOUS_SIGN, FATAL,
+/* xgettext:no-c-format */
+"Spurious sign in FORMAT statement at %0")
+FFEBAD_MSG (FFEBAD_FORMAT_SPURIOUS_NUMBER, FATAL,
+/* xgettext:no-c-format */
+"Spurious number in FORMAT statement at %0")
+FFEBAD_MSG (FFEBAD_FORMAT_TEXT_IN_NUMBER, FATAL,
+/* xgettext:no-c-format */
+"Spurious text trailing number in FORMAT statement at %0")
+FFEBAD_MSG (FFEBAD_FORMAT_P_NOCOMMA, FATAL,
+/* xgettext:no-c-format */
+LONG("nP control edit descriptor not followed by comma but followed by edit descriptor at %0 other than D, E, EN, F, or G")
+/* xgettext:no-c-format */
+SHORT("Invalid edit descriptor at %0 following nP control edit descriptor"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_SPEC, FATAL,
+/* xgettext:no-c-format */
+"Unrecognized FORMAT specifier at %0")
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_I_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid I specifier in FORMAT statement at %0 -- correct form: [r]Iw.[m]")
+/* xgettext:no-c-format */
+SHORT("Invalid I specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_B_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid B specifier in FORMAT statement at %0 -- correct form: [r]Bw.[m]")
+/* xgettext:no-c-format */
+SHORT("Invalid B specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_O_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid O specifier in FORMAT statement at %0 -- correct form: [r]Ow.[m]")
+/* xgettext:no-c-format */
+SHORT("Invalid O specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_Z_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid Z specifier in FORMAT statement at %0 -- correct form: [r]Zw.[m]")
+/* xgettext:no-c-format */
+SHORT("Invalid Z specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_F_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid F specifier in FORMAT statement at %0 -- correct form: [r]Fw.d")
+/* xgettext:no-c-format */
+SHORT("Invalid F specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_E_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid E specifier in FORMAT statement at %0 -- correct form: [r]Ew.d[Ee]")
+/* xgettext:no-c-format */
+SHORT("Invalid E specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_EN_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid EN specifier in FORMAT statement at %0 -- correct form: [r]ENw.d[Ee]")
+/* xgettext:no-c-format */
+SHORT("Invalid EN specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_G_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid G specifier in FORMAT statement at %0 -- correct form: [r]Gw.d[Ee]")
+/* xgettext:no-c-format */
+SHORT("Invalid G specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_L_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid L specifier in FORMAT statement at %0 -- correct form: [r]Lw")
+/* xgettext:no-c-format */
+SHORT("Invalid L specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_A_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid A specifier in FORMAT statement at %0 -- correct form: [r]A[w]")
+/* xgettext:no-c-format */
+SHORT("Invalid A specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_D_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid D specifier in FORMAT statement at %0 -- correct form: [r]Dw.d")
+/* xgettext:no-c-format */
+SHORT("Invalid D specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_Q_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid Q specifier in FORMAT statement at %0 -- correct form: Q")
+/* xgettext:no-c-format */
+SHORT("Invalid Q specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_DOLLAR_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid $ specifier in FORMAT statement at %0 -- correct form: $")
+/* xgettext:no-c-format */
+SHORT("Invalid $ specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_P_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid P specifier in FORMAT statement at %0 -- correct form: kP")
+/* xgettext:no-c-format */
+SHORT("Invalid P specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_T_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid T specifier in FORMAT statement at %0 -- correct form: Tn")
+/* xgettext:no-c-format */
+SHORT("Invalid T specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_TL_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid TL specifier in FORMAT statement at %0 -- correct form: TLn")
+/* xgettext:no-c-format */
+SHORT("Invalid TL specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_TR_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid TR specifier in FORMAT statement at %0 -- correct form: TRn")
+/* xgettext:no-c-format */
+SHORT("Invalid TR specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_X_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid X specifier in FORMAT statement at %0 -- correct form: nX")
+/* xgettext:no-c-format */
+SHORT("Invalid X specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_S_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid S specifier in FORMAT statement at %0 -- correct form: S")
+/* xgettext:no-c-format */
+SHORT("Invalid S specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_SP_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid SP specifier in FORMAT statement at %0 -- correct form: SP")
+/* xgettext:no-c-format */
+SHORT("Invalid SP specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_SS_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid SS specifier in FORMAT statement at %0 -- correct form: SS")
+/* xgettext:no-c-format */
+SHORT("Invalid SS specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_BN_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid BN specifier in FORMAT statement at %0 -- correct form: BN")
+/* xgettext:no-c-format */
+SHORT("Invalid BN specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_BZ_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid BZ specifier in FORMAT statement at %0 -- correct form: BZ")
+/* xgettext:no-c-format */
+SHORT("Invalid BZ specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_COLON_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid : specifier in FORMAT statement at %0 -- correct form: :")
+/* xgettext:no-c-format */
+SHORT("Invalid : specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_BAD_H_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid H specifier in FORMAT statement at %0 -- correct form: nHcharacters  !where n is an unsigned decimal constant, and characters               !contains exactly n characters (including spaces)")
+/* xgettext:no-c-format */
+SHORT("Invalid H specifier in FORMAT statement at %0"))
+FFEBAD_MSG (FFEBAD_FORMAT_MISSING_PAREN, FATAL,
+/* xgettext:no-c-format */
+"Missing close-parenthese(s) in FORMAT statement at %0")
+FFEBAD_MSG (FFEBAD_FORMAT_MISSING_DOT, FATAL,
+/* xgettext:no-c-format */
+"Missing number following period in FORMAT statement at %0")
+FFEBAD_MSG (FFEBAD_FORMAT_MISSING_EXP, FATAL,
+/* xgettext:no-c-format */
+"Missing number following `E' in FORMAT statement at %0")
+FFEBAD_MSG (FFEBAD_FORMAT_EXPR_TOKEN, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid token with FORMAT run-time expression at %0 -- use the traditional operators .LT., .LE., .GT., .GE., .EQ., and .NE. in place of the newer tokens <, <=, >, >=, ==, and !=, because > ends an expression within a FORMAT statement")
+/* xgettext:no-c-format */
+SHORT("Invalid token with FORMAT run-time expression at %0"))
+FFEBAD_MSG (FFEBAD_TRAILING_COMMA, WARN,
+/* xgettext:no-c-format */
+"Spurious trailing comma preceding terminator at %0")
+FFEBAD_MSG (FFEBAD_INTERFACE_ASSIGNMENT, WARN,
+/* xgettext:no-c-format */
+"At %0, specify OPERATOR instead of ASSIGNMENT for INTERFACE statement not specifying the assignment operator (=)")
+FFEBAD_MSG (FFEBAD_INTERFACE_OPERATOR, WARN,
+/* xgettext:no-c-format */
+"At %0, specify ASSIGNMENT instead of OPERATOR for INTERFACE statement specifying the assignment operator (=)")
+FFEBAD_MSG (FFEBAD_INTERFACE_NONLETTER, FATAL,
+/* xgettext:no-c-format */
+LONG("Defined operator at %0 contains a nonletter -- must contain only letters A-Z (or a-z)")
+/* xgettext:no-c-format */
+SHORT("Nonletter in defined operator at %0"))
+FFEBAD_MSG (FFEBAD_INVALID_TYPEDECL_ATTR, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid type-declaration attribute at %0 -- must be one of: DIMENSION(array-spec), EXTERNAL, INTRINSIC, PARAMETER, or SAVE")
+/* xgettext:no-c-format */
+SHORT("Invalid type-declaration attribute at %0"))
+FFEBAD_MSG (FFEBAD_INVALID_TYPEDECL_INIT, FATAL,
+/* xgettext:no-c-format */
+"Cannot specify =initialization-expr at %0 unless `::' appears before list of objects")
+FFEBAD_MSG (FFEBAD_LABEL_USE_DEF, FATAL,
+/* xgettext:no-c-format */
+"Reference to label at %1 inconsistent with its definition at %0")
+FFEBAD_MSG (FFEBAD_LABEL_USE_USE, FATAL,
+/* xgettext:no-c-format */
+"Reference to label at %1 inconsistent with earlier reference at %0")
+FFEBAD_MSG (FFEBAD_LABEL_DEF_DO, FATAL,
+/* xgettext:no-c-format */
+"DO-statement reference to label at %1 follows its definition at %0")
+FFEBAD_MSG (FFEBAD_LABEL_BLOCK, WARN,
+/* xgettext:no-c-format */
+"Reference to label at %1 is outside block containing definition at %0")
+FFEBAD_MSG (FFEBAD_LABEL_DO_BLOCK_DO, FATAL,
+/* xgettext:no-c-format */
+"DO-statement references to label at %0 and %2 separated by unterminated block starting at %1")
+FFEBAD_MSG (FFEBAD_LABEL_DO_BLOCK_END, FATAL,
+/* xgettext:no-c-format */
+"DO-statement reference to label at %0 and label definition at %2 separated by unterminated block starting at %1")
+FFEBAD_MSG (FFEBAD_INVALID_LABEL_DEF, FATAL,
+/* xgettext:no-c-format */
+"Label definition at %0 invalid on this kind of statement")
+FFEBAD_MSG (FFEBAD_ORDER_1, FATAL,
+/* xgettext:no-c-format */
+"Statement at %0 invalid in this context")
+FFEBAD_MSG (FFEBAD_ORDER_2, FATAL,
+/* xgettext:no-c-format */
+"Statement at %0 invalid in context established by statement at %1")
+FFEBAD_MSG (FFEBAD_CONSTRUCT_NAMED, FATAL,
+/* xgettext:no-c-format */
+"Statement at %0 must specify construct name specified at %1")
+FFEBAD_MSG (FFEBAD_CONSTRUCT_NOT_NAMED, FATAL,
+/* xgettext:no-c-format */
+"Construct name at %0 superfluous, no construct name specified at %1")
+FFEBAD_MSG (FFEBAD_CONSTRUCT_WRONG_NAME, FATAL,
+/* xgettext:no-c-format */
+"Construct name at %0 not the same as construct name at %1")
+FFEBAD_MSG (FFEBAD_CONSTRUCT_NO_DO_NAME, FATAL,
+/* xgettext:no-c-format */
+"Construct name at %0 does not match construct name for any containing DO constructs")
+FFEBAD_MSG (FFEBAD_DO_HAD_LABEL, FATAL,
+/* xgettext:no-c-format */
+"Label definition missing at %0 for DO construct specifying label at %1")
+FFEBAD_MSG (FFEBAD_AFTER_ELSE, FATAL,
+/* xgettext:no-c-format */
+"Statement at %0 follows ELSE block for IF construct at %1")
+FFEBAD_MSG (FFEBAD_FORMAT_NO_LABEL_DEF, FATAL,
+/* xgettext:no-c-format */
+"No label definition for FORMAT statement at %0")
+FFEBAD_MSG (FFEBAD_SECOND_ELSE_WHERE, FATAL,
+/* xgettext:no-c-format */
+"Second occurrence of ELSE WHERE at %0 within WHERE at %1")
+FFEBAD_MSG (FFEBAD_END_WO, WARN,
+/* xgettext:no-c-format */
+"END statement at %0 missing `%A' keyword required for internal or module procedure(s) bounded by %1")
+FFEBAD_MSG (FFEBAD_INVALID_MODULE_PROCEDURE, FATAL,
+/* xgettext:no-c-format */
+"MODULE PROCEDURE statement at %0 disallowed because INTERFACE at %1 specifies no generic name, operator, or assignment")
+FFEBAD_MSG (FFEBAD_BLOCKDATA_NOT_NAMED, FATAL,
+/* xgettext:no-c-format */
+"BLOCK DATA name at %0 superfluous, no name specified at %1")
+FFEBAD_MSG (FFEBAD_PROGRAM_NOT_NAMED, FATAL,
+/* xgettext:no-c-format */
+"Program name at %0 superfluous, no PROGRAM statement specified at %1")
+FFEBAD_MSG (FFEBAD_UNIT_WRONG_NAME, FATAL,
+/* xgettext:no-c-format */
+"Program unit name at %0 not the same as name at %1")
+FFEBAD_MSG (FFEBAD_TYPE_WRONG_NAME, FATAL,
+/* xgettext:no-c-format */
+"Type name at %0 not the same as name at %1")
+FFEBAD_MSG (FFEBAD_EOF_BEFORE_BLOCK_END, FATAL,
+/* xgettext:no-c-format */
+"End of source file before end of block started at %0")
+FFEBAD_MSG (FFEBAD_UNDEF_LABEL, FATAL,
+/* xgettext:no-c-format */
+"Undefined label, first referenced at %0")
+FFEBAD_MSG (FFEBAD_CONFLICTING_SAVES, WARN,
+/* xgettext:no-c-format */
+"SAVE statement or attribute at %1 cannot be specified along with SAVE statement or attribute at %0")
+FFEBAD_MSG (FFEBAD_CONFLICTING_ACCESSES, FATAL,
+/* xgettext:no-c-format */
+"PUBLIC or PRIVATE statement at %1 cannot be specified along with PUBLIC or PRIVATE statement at %0")
+FFEBAD_MSG (FFEBAD_RETURN_IN_MAIN, WARN,
+/* xgettext:no-c-format */
+"RETURN statement at %0 invalid within a main program unit")
+FFEBAD_MSG (FFEBAD_ALTRETURN_IN_PROGRAM, FATAL,
+/* xgettext:no-c-format */
+"Alternate return specifier at %0 invalid within a main program unit")
+FFEBAD_MSG (FFEBAD_ALTRETURN_IN_FUNCTION, FATAL,
+/* xgettext:no-c-format */
+"Alternate return specifier at %0 invalid within a function")
+FFEBAD_MSG (FFEBAD_DERIVTYP_ACCESS, FATAL,
+/* xgettext:no-c-format */
+"Access specifier or PRIVATE statement at %0 invalid for derived-type definition within other than the specification part of a module")
+FFEBAD_MSG (FFEBAD_DERIVTYP_ACCESS_FIRST, FATAL,
+/* xgettext:no-c-format */
+"Access specifier at %0 must immediately follow derived-type statement at %1 with no intervening statements")
+FFEBAD_MSG (FFEBAD_DERIVTYP_NO_COMPONENTS, FATAL,
+/* xgettext:no-c-format */
+"No components specified as of %0 for derived-type definition beginning at %1")
+FFEBAD_MSG (FFEBAD_STRUCT_NO_COMPONENTS, FATAL,
+/* xgettext:no-c-format */
+"No components specified as of %0 for structure definition beginning at %1")
+FFEBAD_MSG (FFEBAD_STRUCT_MISSING_NAME, FATAL,
+/* xgettext:no-c-format */
+"Missing structure name for outer structure definition at %0")
+FFEBAD_MSG (FFEBAD_STRUCT_IGNORING_FIELD, FATAL,
+/* xgettext:no-c-format */
+"Field names at %0 for outer structure definition -- specify them in a subsequent RECORD statement instead")
+FFEBAD_MSG (FFEBAD_STRUCT_MISSING_FIELD, FATAL,
+/* xgettext:no-c-format */
+"Missing field name(s) for structure definition at %0 within structure definition at %1")
+FFEBAD_MSG (FFEBAD_MAP_NO_COMPONENTS, FATAL,
+/* xgettext:no-c-format */
+"No components specified as of %0 for map beginning at %1")
+FFEBAD_MSG (FFEBAD_UNION_NO_TWO_MAPS, FATAL,
+/* xgettext:no-c-format */
+"Zero or one maps specified as of %0 for union beginning at %1 -- at least two are required")
+FFEBAD_MSG (FFEBAD_MISSING_SPECIFIER, FATAL,
+/* xgettext:no-c-format */
+"Missing %A specifier in statement at %0")
+FFEBAD_MSG (FFEBAD_NAMELIST_ITEMS, FATAL,
+/* xgettext:no-c-format */
+"Items in I/O list starting at %0 invalid for namelist-directed I/O")
+FFEBAD_MSG (FFEBAD_CONFLICTING_SPECS, FATAL,
+/* xgettext:no-c-format */
+"Conflicting I/O control specifications at %0 and %1")
+FFEBAD_MSG (FFEBAD_NO_UNIT_SPEC, FATAL,
+/* xgettext:no-c-format */
+"No UNIT= specifier in I/O control list at %0")
+FFEBAD_MSG (FFEBAD_MISSING_ADVANCE_SPEC, FATAL,
+/* xgettext:no-c-format */
+"Specification at %0 requires ADVANCE=`NO' specification in same I/O control list")
+FFEBAD_MSG (FFEBAD_MISSING_FORMAT_SPEC, FATAL,
+/* xgettext:no-c-format */
+"Specification at %0 requires explicit FMT= specification in same I/O control list")
+FFEBAD_MSG (FFEBAD_SPEC_VALUE, FATAL,
+/* xgettext:no-c-format */
+LONG("Unrecognized value for character constant at %0 -- expecting %A")
+/* xgettext:no-c-format */
+SHORT("Unrecognized value for character constant at %0"))
+FFEBAD_MSG (FFEBAD_CASE_SECOND_DEFAULT, FATAL,
+/* xgettext:no-c-format */
+"Second occurrence of CASE DEFAULT at %0 within SELECT CASE at %1")
+FFEBAD_MSG (FFEBAD_CASE_DUPLICATE, FATAL,
+/* xgettext:no-c-format */
+"Duplicate or overlapping case values/ranges at %0 and %1")
+FFEBAD_MSG (FFEBAD_CASE_TYPE_DISAGREE, FATAL,
+/* xgettext:no-c-format */
+"Type and/or kind-type parameter disagreement between CASE value or value within range at %0 and SELECT CASE at %1")
+FFEBAD_MSG (FFEBAD_CASE_LOGICAL_RANGE, FATAL,
+/* xgettext:no-c-format */
+"Range specification at %0 invalid for CASE statement within logical-type SELECT CASE statement")
+FFEBAD_MSG (FFEBAD_CASE_BAD_RANGE, FATAL,
+/* xgettext:no-c-format */
+LONG("Range specification at %0 invalid -- at least one expression must be specified, or use CASE DEFAULT")
+/* xgettext:no-c-format */
+SHORT("Range specification at %0 invalid"))
+FFEBAD_MSG (FFEBAD_CASE_RANGE_USELESS, INFORM,
+/* xgettext:no-c-format */
+LONG("Range specification at %0 useless; first expression greater than second expression in range, so range can never be matched by any selection expression")
+/* xgettext:no-c-format */
+SHORT("Useless range at %0"))
+FFEBAD_MSG (FFEBAD_F90, FATAL,
+/* xgettext:no-c-format */
+"Fortran 90 feature at %0 unsupported")
+FFEBAD_MSG (FFEBAD_KINDTYPE, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid kind at %0 for type at %1 -- unsupported or not permitted")
+/* xgettext:no-c-format */
+SHORT("Invalid kind at %0 for type at %1"))
+FFEBAD_MSG (FFEBAD_BAD_IMPLICIT, FATAL,
+/* xgettext:no-c-format */
+LONG("Cannot establish implicit type for initial letter `%A' at %0 -- already explicitly established or used to set implicit type of some name, or backwards order of letters in letter range")
+/* xgettext:no-c-format */
+SHORT("Cannot establish implicit type for initial letter `%A' at %0"))
+FFEBAD_MSG (FFEBAD_SYMERR, FATAL,
+/* xgettext:no-c-format */
+"Invalid declaration of or reference to symbol `%A' at %0 [initially seen at %1]")
+FFEBAD_MSG (FFEBAD_LABEL_WRONG_PLACE, FATAL,
+/* xgettext:no-c-format */
+LONG("Label definition %A (at %0) invalid -- must be in columns 1-5")
+/* xgettext:no-c-format */
+SHORT("Invalid label definition %A (at %0)"))
+FFEBAD_MSG (FFEBAD_NULL_ELEMENT, FATAL,
+/* xgettext:no-c-format */
+"Null element at %0 for array reference at %1")
+FFEBAD_MSG (FFEBAD_TOO_FEW_ELEMENTS, FATAL,
+/* xgettext:no-c-format */
+"Too few elements (%A missing) as of %0 for array reference at %1")
+FFEBAD_MSG (FFEBAD_TOO_MANY_ELEMENTS, FATAL,
+/* xgettext:no-c-format */
+"Too many elements as of %0 for array reference at %1")
+FFEBAD_MSG (FFEBAD_MISSING_COLON_IN_SUBSTR, FATAL,
+/* xgettext:no-c-format */
+"Missing colon as of %0 in substring reference for %1")
+FFEBAD_MSG (FFEBAD_BAD_SUBSTR, FATAL,
+/* xgettext:no-c-format */
+"Invalid use at %0 of substring operator on %1")
+FFEBAD_MSG (FFEBAD_RANGE_SUBSTR, WARN,
+/* xgettext:no-c-format */
+"Substring begin/end point at %0 out of defined range")
+FFEBAD_MSG (FFEBAD_RANGE_ARRAY, WARN,
+/* xgettext:no-c-format */
+"Array element value at %0 out of defined range")
+FFEBAD_MSG (FFEBAD_EXPR_WRONG, FATAL,
+/* xgettext:no-c-format */
+"Expression at %0 has incorrect data type or rank for its context")
+FFEBAD_MSG (FFEBAD_DIV_BY_ZERO, WARN,
+/* xgettext:no-c-format */
+"Division by 0 (zero) at %0 (IEEE not yet supported)")
+FFEBAD_MSG (FFEBAD_DO_STEP_ZERO, FATAL,
+/* xgettext:no-c-format */
+"%A step count known to be 0 (zero) at %0")
+FFEBAD_MSG (FFEBAD_DO_END_OVERFLOW, WARN,
+/* xgettext:no-c-format */
+"%A end value plus step count known to overflow at %0")
+FFEBAD_MSG (FFEBAD_DO_IMP_OVERFLOW, WARN,
+/* xgettext:no-c-format */
+"%A begin, end, and step-count values known to result in implementation-dependent behavior due to overflow(s) in intermediate calculations at %0")
+FFEBAD_MSG (FFEBAD_DO_NULL, WARN,
+/* xgettext:no-c-format */
+"%A begin, end, and step-count values known to result in no iterations at %0")
+FFEBAD_MSG (FFEBAD_BAD_TYPES, FATAL,
+/* xgettext:no-c-format */
+"Type disagreement between expressions at %0 and %1")
+FFEBAD_MSG (FFEBAD_FORMAT_EXPR_SPEC, FATAL,
+/* xgettext:no-c-format */
+LONG("Run-time expression at %0 in FORMAT statement that does not follow the first executable statement in the program unit -- move the statement")
+/* xgettext:no-c-format */
+SHORT("FORMAT at %0 with run-time expression must follow first executable statement"))
+FFEBAD_MSG (FFEBAD_BAD_IMPDO, FATAL,
+/* xgettext:no-c-format */
+LONG("Unexpected token at %0 in implied-DO construct at %1 -- form of implied-DO is `(item-list,do-var=start,end[,incr])'")
+/* xgettext:no-c-format */
+SHORT("Unexpected token at %0 in implied-DO construct at %1"))
+FFEBAD_MSG (FFEBAD_BAD_IMPDCL, FATAL,
+/* xgettext:no-c-format */
+"No specification for implied-DO iterator `%A' at %0")
+FFEBAD_MSG (FFEBAD_IMPDO_PAREN, WARN,
+/* xgettext:no-c-format */
+"Gratuitous parentheses surround implied-DO construct at %0")
+FFEBAD_MSG (FFEBAD_ZERO_SIZE, FATAL,
+/* xgettext:no-c-format */
+"Zero-size specification invalid at %0")
+FFEBAD_MSG (FFEBAD_ZERO_ARRAY, FATAL,
+/* xgettext:no-c-format */
+"Zero-size array at %0")
+FFEBAD_MSG (FFEBAD_BAD_COMPLEX, FATAL,
+/* xgettext:no-c-format */
+"Target machine does not support complex entity of kind specified at %0")
+FFEBAD_MSG (FFEBAD_BAD_DBLCMPLX, FATAL,
+/* xgettext:no-c-format */
+"Target machine does not support DOUBLE COMPLEX, specified at %0")
+FFEBAD_MSG (FFEBAD_BAD_POWER, WARN,
+/* xgettext:no-c-format */
+"Attempt to raise constant zero to a power at %0")
+FFEBAD_MSG (FFEBAD_BOOL_ARGS_TYPE, FATAL,
+/* xgettext:no-c-format */
+LONG("Boolean/logical operator at %0 must operate on two subexpressions of logical type, but neither subexpression at %1 or %2 is of logical type")
+/* xgettext:no-c-format */
+SHORT("Invalid operands at %1 and %2 for boolean operator at %0"))
+FFEBAD_MSG (FFEBAD_BOOL_ARG_TYPE, FATAL,
+/* xgettext:no-c-format */
+LONG("Boolean/logical operator at %0 must operate on two subexpressions of logical type, but the subexpression at %1 is not of logical type")
+/* xgettext:no-c-format */
+SHORT("Invalid operand at %1 for boolean operator at %0"))
+FFEBAD_MSG (FFEBAD_BOOL_ARG_KIND, FATAL,
+/* xgettext:no-c-format */
+LONG("Boolean/logical operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning logical scalars, or a combination of both -- but the subexpression at %1 is %A")
+/* xgettext:no-c-format */
+SHORT("Invalid operand (is %A) at %1 for boolean operator at %0"))
+FFEBAD_MSG (FFEBAD_NOT_ARG_TYPE, FATAL,
+/* xgettext:no-c-format */
+LONG(".NOT. operator at %0 must operate on subexpression of logical type, but the subexpression at %1 is not of logical type")
+/* xgettext:no-c-format */
+SHORT("Invalid operand at %1 for .NOT. operator at %0"))
+FFEBAD_MSG (FFEBAD_NOT_ARG_KIND, FATAL,
+/* xgettext:no-c-format */
+LONG(".NOT. operator at %0 must operate on scalar subexpressions -- but the subexpression at %1 is %A")
+/* xgettext:no-c-format */
+SHORT("Invalid operand (is %A) at %1 for .NOT. operator at %0"))
+FFEBAD_MSG (FFEBAD_EQOP_ARGS_TYPE, FATAL,
+/* xgettext:no-c-format */
+LONG("Equality operator at %0 must operate on two subexpressions of arithmetic or character type, but neither subexpression at %1 or %2 is of arithmetic or character type")
+/* xgettext:no-c-format */
+SHORT("Invalid operands at %1 and %2 for equality operator at %0"))
+FFEBAD_MSG (FFEBAD_EQOP_ARG_TYPE, FATAL,
+/* xgettext:no-c-format */
+LONG("Equality operator at %0 must operate on two subexpressions of arithmetic or character type, but the subexpression at %1 is not of arithmetic or character type")
+/* xgettext:no-c-format */
+SHORT("Invalid operand at %1 for equality operator at %0"))
+FFEBAD_MSG (FFEBAD_EQOP_ARG_KIND, FATAL,
+/* xgettext:no-c-format */
+LONG("Equality operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning arithmetic or character scalars, or a combination of both -- but the subexpression at %1 is %A")
+/* xgettext:no-c-format */
+SHORT("Invalid operand (is %A) at %1 for equality operator at %0"))
+FFEBAD_MSG (FFEBAD_RELOP_ARGS_TYPE, FATAL,
+/* xgettext:no-c-format */
+LONG("Relational operator at %0 must operate on two subexpressions of integer, real, or character type, but neither subexpression at %1 or %2 is of integer, real, or character type")
+/* xgettext:no-c-format */
+SHORT("Invalid operands at %1 and %2 for relational operator at %0"))
+FFEBAD_MSG (FFEBAD_RELOP_ARG_TYPE, FATAL,
+/* xgettext:no-c-format */
+LONG("Relational operator at %0 must operate on two subexpressions of integer, real, or character type, but the subexpression at %1 is not of integer, real, or character type")
+/* xgettext:no-c-format */
+SHORT("Invalid operand at %1 for relational operator at %0"))
+FFEBAD_MSG (FFEBAD_RELOP_ARG_KIND, FATAL,
+/* xgettext:no-c-format */
+LONG("Relational operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning integer, real, or character scalars, or a combination of both -- but the subexpression at %1 is %A")
+/* xgettext:no-c-format */
+SHORT("Invalid operand (is %A) at %1 for relational operator at %0"))
+FFEBAD_MSG (FFEBAD_INTRINSIC_REF, FATAL,
+/* xgettext:no-c-format */
+LONG("Reference to intrinsic `%A' at %0 invalid -- one or more arguments have incorrect type")
+/* xgettext:no-c-format */
+SHORT("Invalid reference to intrinsic `%A' at %0"))
+FFEBAD_MSG (FFEBAD_INTRINSIC_TOOFEW, FATAL,
+/* xgettext:no-c-format */
+LONG("Too few arguments passed to intrinsic `%A' at %0")
+/* xgettext:no-c-format */
+SHORT("Too few arguments for intrinsic `%A' at %0"))
+FFEBAD_MSG (FFEBAD_INTRINSIC_TOOMANY, FATAL,
+/* xgettext:no-c-format */
+LONG("Too many arguments passed to intrinsic `%A' at %0")
+/* xgettext:no-c-format */
+SHORT("Too many arguments for intrinsic `%A' at %0"))
+FFEBAD_MSG (FFEBAD_INTRINSIC_DISABLED, FATAL,
+/* xgettext:no-c-format */
+LONG("Reference to disabled intrinsic `%A' at %0")
+/* xgettext:no-c-format */
+SHORT("Disabled intrinsic `%A' at %0"))
+FFEBAD_MSG (FFEBAD_INTRINSIC_IS_SUBR, FATAL,
+/* xgettext:no-c-format */
+LONG("Reference to intrinsic subroutine `%A' as if it were a function at %0")
+/* xgettext:no-c-format */
+SHORT("Function reference to intrinsic subroutine `%A' at %0"))
+FFEBAD_MSG (FFEBAD_INTRINSIC_IS_FUNC, FATAL,
+/* xgettext:no-c-format */
+LONG("Reference to intrinsic function `%A' as if it were a subroutine at %0")
+/* xgettext:no-c-format */
+SHORT("Subroutine reference to intrinsic function `%A' at %0"))
+FFEBAD_MSG (FFEBAD_INTRINSIC_UNIMPL, FATAL,
+/* xgettext:no-c-format */
+LONG("Reference to unimplemented intrinsic `%A' at %0 -- use EXTERNAL to reference user-written procedure with this name")
+/* xgettext:no-c-format */
+SHORT("Unimplemented intrinsic `%A' at %0"))
+FFEBAD_MSG (FFEBAD_INTRINSIC_UNIMPLW, WARN,
+/* xgettext:no-c-format */
+LONG("Reference to unimplemented intrinsic `%A' at %0 (assumed EXTERNAL)")
+/* xgettext:no-c-format */
+SHORT("Unimplemented intrinsic `%A' at %0 (assumed EXTERNAL)"))
+FFEBAD_MSG (FFEBAD_INTRINSIC_AMBIG, FATAL,
+/* xgettext:no-c-format */
+"Reference to generic intrinsic `%A' at %0 could be to form %B or %C")
+FFEBAD_MSG (FFEBAD_INTRINSIC_CMPAMBIG, FATAL,
+/* xgettext:no-c-format */
+"Ambiguous use of intrinsic `%A' at %0 [info -f g77 M CMPAMBIG]")
+FFEBAD_MSG (FFEBAD_INTRINSIC_EXPIMP, WARN,
+/* xgettext:no-c-format */
+"Intrinsic `%A' referenced %Bly at %0, %Cly at %1 [info -f g77 M EXPIMP]")
+FFEBAD_MSG (FFEBAD_INTRINSIC_GLOBAL, WARN,
+/* xgettext:no-c-format */
+"Same name `%A' used for %B at %0 and %C at %1 [info -f g77 M INTGLOB]")
+FFEBAD_MSG (FFEBAD_INTRINSIC_TYPE, WARN,
+/* xgettext:no-c-format */
+"Explicit type declaration for intrinsic `%A' disagrees with invocation at %0")
+FFEBAD_MSG (FFEBAD_OPEN_INCLUDE, FATAL,
+/* xgettext:no-c-format */
+"Unable to open INCLUDE file `%A' at %0")
+FFEBAD_MSG (FFEBAD_DOITER, FATAL,
+/* xgettext:no-c-format */
+LONG("Attempt to modify variable `%A' at %0 while it serves as DO-loop iterator at %1")
+/* xgettext:no-c-format */
+SHORT("Modification of DO-loop iterator `%A' at %0"))
+FFEBAD_MSG (FFEBAD_DOITER_IMPDO, FATAL,
+/* xgettext:no-c-format */
+LONG("Attempt to modify variable `%A' via item #%B in list at %0 while it serves as implied-DO iterator at %1")
+/* xgettext:no-c-format */
+SHORT("Modification of DO-loop iterator `%A' at %0"))
+FFEBAD_MSG (FFEBAD_TOO_MANY_DIMS, FATAL,
+/* xgettext:no-c-format */
+LONG("Array has too many dimensions, as of dimension specifier at %0")
+/* xgettext:no-c-format */
+SHORT("Too many dimensions at %0"))
+FFEBAD_MSG (FFEBAD_NULL_ARGUMENT, FATAL,
+/* xgettext:no-c-format */
+"Null argument at %0 for statement function reference at %1")
+FFEBAD_MSG (FFEBAD_NULL_ARGUMENT_W, WARN,
+/* xgettext:no-c-format */
+"Null argument at %0 for procedure invocation at %1")
+FFEBAD_MSG (FFEBAD_TOO_FEW_ARGUMENTS, FATAL,
+/* xgettext:no-c-format */
+"%A too few arguments (starting with dummy argument `%B') as of %0 for statement function reference at %1")
+FFEBAD_MSG (FFEBAD_TOO_MANY_ARGUMENTS, FATAL,
+/* xgettext:no-c-format */
+"%A too many arguments as of %0 for statement function reference at %1")
+FFEBAD_MSG (FFEBAD_ARRAY_AS_SFARG, FATAL,
+/* xgettext:no-c-format */
+"Array supplied at %1 for dummy argument `%A' in statement function reference at %0")
+FFEBAD_MSG (FFEBAD_FORMAT_UNSUPPORTED, FATAL,
+/* xgettext:no-c-format */
+"Unsupported FORMAT specifier at %0")
+FFEBAD_MSG (FFEBAD_FORMAT_VARIABLE, FATAL,
+/* xgettext:no-c-format */
+"Variable-expression FORMAT specifier at %0 -- unsupported")
+FFEBAD_MSG (FFEBAD_OPEN_UNSUPPORTED, FATAL,
+/* xgettext:no-c-format */
+LONG("Unsupported OPEN control item at %0 -- ACTION=, ASSOCIATEVARIABLE=, BLOCKSIZE=, BUFFERCOUNT=, CARRIAGECONTROL=, DEFAULTFILE=, DELIM=, DISPOSE=, EXTENDSIZE=, INITIALSIZE=, KEY=, MAXREC=, NOSPANBLOCKS, ORGANIZATION=, PAD=, POSITION=, READONLY=, RECORDTYPE=, SHARED=, and USEROPEN= are not supported")
+/* xgettext:no-c-format */
+SHORT("Unsupported OPEN control item at %0"))
+FFEBAD_MSG (FFEBAD_INQUIRE_UNSUPPORTED, FATAL,
+/* xgettext:no-c-format */
+LONG("Unsupported INQUIRE control item at %0 -- ACTION=, CARRIAGECONTROL=, DEFAULTFILE=, DELIM=, KEYED=, ORGANIZATION=, PAD=, POSITION=, READ=, READWRITE=, RECORDTYPE=, and WRITE= are not supported")
+/* xgettext:no-c-format */
+SHORT("Unsupported INQUIRE control item at %0"))
+FFEBAD_MSG (FFEBAD_READ_UNSUPPORTED, FATAL,
+/* xgettext:no-c-format */
+LONG("Unsupported READ control item at %0 -- ADVANCE=, EOR=, KEYEQ=, KEYGE=, KEYGT=, KEYID=, NULLS=, and SIZE= are not supported")
+/* xgettext:no-c-format */
+SHORT("Unsupported READ control item at %0"))
+FFEBAD_MSG (FFEBAD_WRITE_UNSUPPORTED, FATAL,
+/* xgettext:no-c-format */
+LONG("Unsupported WRITE control item at %0 -- ADVANCE= and EOR= are not supported")
+/* xgettext:no-c-format */
+SHORT("Unsupported WRITE control item at %0"))
+FFEBAD_MSG (FFEBAD_VXT_UNSUPPORTED, FATAL,
+/* xgettext:no-c-format */
+"Unsupported VXT statement at %0")
+FFEBAD_MSG (FFEBAD_DATA_REINIT, FATAL,
+/* xgettext:no-c-format */
+"Attempt to specify second initial value for `%A' at %0")
+FFEBAD_MSG (FFEBAD_DATA_TOOFEW, FATAL,
+/* xgettext:no-c-format */
+"Too few initial values in list of initializers for `%A' at %0")
+FFEBAD_MSG (FFEBAD_DATA_TOOMANY, FATAL,
+/* xgettext:no-c-format */
+"Too many initial values in list of initializers starting at %0")
+FFEBAD_MSG (FFEBAD_DATA_RANGE, FATAL,
+/* xgettext:no-c-format */
+"Array or substring specification for `%A' out of range in statement at %0")
+FFEBAD_MSG (FFEBAD_DATA_SUBSCRIPT, FATAL,
+/* xgettext:no-c-format */
+"Array subscript #%B out of range for initialization of `%A' in statement at %0")
+FFEBAD_MSG (FFEBAD_DATA_ZERO, FATAL,
+/* xgettext:no-c-format */
+"Implied do-loop step count of 0 (zero) for iteration variable `%A' in statement at %0")
+FFEBAD_MSG (FFEBAD_DATA_EMPTY, FATAL,
+/* xgettext:no-c-format */
+"Implied do-loop iteration count of 0 (zero) for iteration variable `%A' in statement at %0")
+FFEBAD_MSG (FFEBAD_DATA_EVAL, FATAL,
+/* xgettext:no-c-format */
+"Not an integer constant expression in implied do-loop in statement at %0")
+FFEBAD_MSG (FFEBAD_DATA_MULTIPLE, FATAL,
+/* xgettext:no-c-format */
+"Attempt to specify second initial value for element of `%A' at %0")
+FFEBAD_MSG (FFEBAD_EQUIV_COMMON, FATAL,
+/* xgettext:no-c-format */
+"Attempt to EQUIVALENCE common areas `%A' and `%B' at %0")
+FFEBAD_MSG (FFEBAD_EQUIV_ALIGN, FATAL,
+/* xgettext:no-c-format */
+"Can't place `%A' as directed by EQUIVALENCE due to alignment restrictions")
+FFEBAD_MSG (FFEBAD_EQUIV_MISMATCH, FATAL,
+/* xgettext:no-c-format */
+"Mismatched EQUIVALENCE requirements for placement of `%A' at both %C and %D bytes offset from `%B'")
+FFEBAD_MSG (FFEBAD_EQUIV_RANGE, FATAL,
+/* xgettext:no-c-format */
+"Array or substring specification for `%A' out of range in EQUIVALENCE statement")
+FFEBAD_MSG (FFEBAD_EQUIV_SUBSTR, FATAL,
+/* xgettext:no-c-format */
+"Substring of non-CHARACTER entity `%A' in EQUIVALENCE statement")
+FFEBAD_MSG (FFEBAD_EQUIV_ARRAY, FATAL,
+/* xgettext:no-c-format */
+"Array reference to scalar variable `%A' in EQUIVALENCE statement")
+FFEBAD_MSG (FFEBAD_EQUIV_SUBSCRIPT, WARN,
+/* xgettext:no-c-format */
+"Array subscript #%B out of range for EQUIVALENCE of `%A'")
+FFEBAD_MSG (FFEBAD_COMMON_PAD, WARN,
+/* xgettext:no-c-format */
+LONG("Padding of %A %D required before `%B' in common block `%C' at %0 -- consider reordering members, largest-type-size first")
+/* xgettext:no-c-format */
+SHORT("Padding of %A %D required before `%B' in common block `%C' at %0"))
+FFEBAD_MSG (FFEBAD_COMMON_NEG, FATAL,
+/* xgettext:no-c-format */
+"Attempt to extend COMMON area beyond its starting point via EQUIVALENCE of `%A'")
+FFEBAD_MSG (FFEBAD_EQUIV_FEW, FATAL,
+/* xgettext:no-c-format */
+"Too few elements in reference to array `%A' in EQUIVALENCE statement")
+FFEBAD_MSG (FFEBAD_EQUIV_MANY, FATAL,
+/* xgettext:no-c-format */
+"Too many elements in reference to array `%A' in EQUIVALENCE statement")
+FFEBAD_MSG (FFEBAD_MIXED_TYPES, WARN,
+/* xgettext:no-c-format */
+"Mixed CHARACTER and non-CHARACTER types via COMMON/EQUIVALENCE -- for example, `%A' and `%B'")
+FFEBAD_MSG (FFEBAD_IMPLICIT_ADJLEN, FATAL,
+/* xgettext:no-c-format */
+LONG("Invalid length specification at %0 for IMPLICIT statement -- must be integer constant expression")
+/* xgettext:no-c-format */
+SHORT("Invalid length specification at %0"))
+FFEBAD_MSG (FFEBAD_ENTRY_CONFLICTS, FATAL,
+/* xgettext:no-c-format */
+LONG("Type of ENTRY point at %0 to function conflicts with type(s) of previous entrypoint(s) -- must all be identical-length CHARACTER or none be CHARACTER type")
+/* xgettext:no-c-format */
+SHORT("Type of ENTRY point at %0 to function conflicts with type(s) of previous entrypoint(s)"))
+FFEBAD_MSG (FFEBAD_RETURN_VALUE_UNSET, WARN,
+/* xgettext:no-c-format */
+"Return value `%A' for FUNCTION at %0 not referenced in subprogram")
+FFEBAD_MSG (FFEBAD_COMMON_ALREADY_INIT, FATAL,
+/* xgettext:no-c-format */
+LONG("Common block `%A' initialized at %0 already initialized at %1 -- only one program unit may specify initial values for a particular common block")
+/* xgettext:no-c-format */
+SHORT("Common block `%A' initialized at %0 already initialized at %1"))
+FFEBAD_MSG (FFEBAD_COMMON_INIT_PAD, WARN,
+/* xgettext:no-c-format */
+LONG("Initial padding for common block `%A' is %B %C at %0 -- consider reordering members, largest-type-size first")
+/* xgettext:no-c-format */
+SHORT("Initial padding for common block `%A' is %B %C at %0"))
+FFEBAD_MSG (FFEBAD_COMMON_DIFF_PAD, FATAL,
+/* xgettext:no-c-format */
+LONG("Initial padding for common block `%A' is %B %D at %0 but %C %E at %1 -- consider reordering members, largest-type-size first")
+/* xgettext:no-c-format */
+SHORT("Initial padding for common block `%A' is %B %D at %0 but %C %E at %1"))
+FFEBAD_MSG (FFEBAD_COMMON_DIFF_SAVE, WARN,
+/* xgettext:no-c-format */
+"Common block `%A' is SAVEd, explicitly or implicitly, at %0 but not SAVEd at %1")
+FFEBAD_MSG (FFEBAD_COMMON_DIFF_SIZE, WARN,
+/* xgettext:no-c-format */
+"Common block `%A' is %B %D in length at %0 but %C %E at %1")
+FFEBAD_MSG (FFEBAD_COMMON_ENLARGED, FATAL,
+/* xgettext:no-c-format */
+LONG("Common block `%A' is initialized to %B %D long at %0 but enlarged to %C %E at %1 -- use consistent definitions or reorder program units in source file")
+/* xgettext:no-c-format */
+SHORT("Common block `%A' is initialized to %B %D long at %0 but enlarged to %C %E at %1"))
+FFEBAD_MSG (FFEBAD_COMMON_BLANK_INIT, WARN,
+/* xgettext:no-c-format */
+"Blank common initialized at %0")
+FFEBAD_MSG (FFEBAD_NEED_INTRINSIC, WARN,
+/* xgettext:no-c-format */
+"Intrinsic `%A' is passed as actual argument at %0 but not explicitly declared INTRINSIC")
+FFEBAD_MSG (FFEBAD_NEED_EXTERNAL, WARN,
+/* xgettext:no-c-format */
+"External procedure `%A' is passed as actual argument at %0 but not explicitly declared EXTERNAL")
+FFEBAD_MSG (FFEBAD_SYMBOL_UPPER_CASE, WARN,
+/* xgettext:no-c-format */
+"Character `%A' (for example) is upper-case in symbol name at %0")
+FFEBAD_MSG (FFEBAD_SYMBOL_LOWER_CASE, WARN,
+/* xgettext:no-c-format */
+"Character `%A' (for example) is lower-case in symbol name at %0")
+FFEBAD_MSG (FFEBAD_SYMBOL_NOLOWER_INITCAP, WARN,
+/* xgettext:no-c-format */
+"Character `%A' not followed at some point by lower-case character in symbol name at %0")
+FFEBAD_MSG (FFEBAD_SYMBOL_LOWER_INITCAP, WARN,
+/* xgettext:no-c-format */
+"Initial character `%A' is lower-case in symbol name at %0")
+FFEBAD_MSG (FFEBAD_DO_REAL, WARN,
+/* xgettext:no-c-format */
+LONG("DO-variable `%A' is type REAL or DOUBLE PRECISION at %0 -- unexpected behavior likely")
+/* xgettext:no-c-format */
+SHORT("DO-variable `%A' is type REAL or DOUBLE PRECISION at %0"))
+FFEBAD_MSG (FFEBAD_NAMELIST_CASE, WARN,
+/* xgettext:no-c-format */
+"NAMELIST not adequately supported by run-time library for source files with case preserved")
+FFEBAD_MSG (FFEBAD_NESTED_PERCENT, WARN,
+/* xgettext:no-c-format */
+"Nested %% construct (%%VAL, %%REF, or %%DESCR) at %0")
+FFEBAD_MSG (FFEBAD_ACTUALARG, WARN,
+/* xgettext:no-c-format */
+LONG("Invalid actual argument at %0 -- replace hollerith constants with %%REF('string') and typeless constants with INTEGER constant equivalents, or use -fugly-args or -fugly")
+/* xgettext:no-c-format */
+SHORT("Invalid actual argument at %0"))
+FFEBAD_MSG (FFEBAD_QUAD_UNSUPPORTED, FATAL,
+/* xgettext:no-c-format */
+LONG("Quadruple-precision floating-point unsupported -- treating constant at %0 as double-precision")
+/* xgettext:no-c-format */
+SHORT("Quadruple-precision floating-point unsupported"))
+FFEBAD_MSG (FFEBAD_TOO_BIG_INIT, WARN,
+/* xgettext:no-c-format */
+LONG("Initialization of large (%B-unit) aggregate area `%A' at %0 slow and takes lots of memory during g77 compile")
+/* xgettext:no-c-format */
+SHORT("This could take a while (initializing `%A' at %0)..."))
+FFEBAD_MSG (FFEBAD_BLOCKDATA_STMT, FATAL,
+/* xgettext:no-c-format */
+"Statement at %0 invalid in BLOCK DATA program unit at %1")
+FFEBAD_MSG (FFEBAD_TRUNCATING_CHARACTER, FATAL,
+/* xgettext:no-c-format */
+"Truncating characters on right side of character constant at %0")
+FFEBAD_MSG (FFEBAD_TRUNCATING_HOLLERITH, FATAL,
+/* xgettext:no-c-format */
+"Truncating characters on right side of hollerith constant at %0")
+FFEBAD_MSG (FFEBAD_TRUNCATING_NUMERIC, FATAL,
+/* xgettext:no-c-format */
+"Truncating non-zero data on left side of numeric constant at %0")
+FFEBAD_MSG (FFEBAD_TRUNCATING_TYPELESS, FATAL,
+/* xgettext:no-c-format */
+"Truncating non-zero data on left side of typeless constant at %0")
+FFEBAD_MSG (FFEBAD_TYPELESS_OVERFLOW, FATAL,
+/* xgettext:no-c-format */
+"Typeless constant at %0 too large")
+FFEBAD_MSG (FFEBAD_AMPERSAND, WARN,
+/* xgettext:no-c-format */
+"First-column ampersand continuation at %0")
+FFEBAD_MSG (FFEBAD_FILEWIDE_ALREADY_SEEN, FATAL,
+/* xgettext:no-c-format */
+"Global name `%A' defined at %0 already defined at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSG (FFEBAD_FILEWIDE_ALREADY_SEEN_W, WARN,
+/* xgettext:no-c-format */
+"Global name `%A' defined at %0 already defined at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSG (FFEBAD_FILEWIDE_DISAGREEMENT, FATAL,
+/* xgettext:no-c-format */
+"Global name `%A' is %B at %0 but is %C at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSG (FFEBAD_FILEWIDE_DISAGREEMENT_W, WARN,
+/* xgettext:no-c-format */
+"Global name `%A' is %B at %0 but is %C at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSG (FFEBAD_FILEWIDE_TYPE_MISMATCH, FATAL,
+/* xgettext:no-c-format */
+"Global name `%A' at %0 has different type at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSG (FFEBAD_FILEWIDE_TYPE_MISMATCH_W, WARN,
+/* xgettext:no-c-format */
+"Global name `%A' at %0 has different type at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSG (FFEBAD_FILEWIDE_NARGS, FATAL,
+/* xgettext:no-c-format */
+"Too %B arguments passed to `%A' at %0 versus definition at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSG (FFEBAD_FILEWIDE_NARGS_W, WARN,
+/* xgettext:no-c-format */
+"Too %B arguments for `%A' at %0 versus invocation at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSG (FFEBAD_FILEWIDE_ARG, FATAL,
+/* xgettext:no-c-format */
+"Argument #%B of `%A' is %C at %0 but is %D at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSG (FFEBAD_FILEWIDE_ARG_W, WARN,
+/* xgettext:no-c-format */
+"Argument #%B of `%A' is %C at %0 but is %D at %1 [info -f g77 M GLOBALS]")
+FFEBAD_MSG (FFEBAD_ARRAY_LARGE, FATAL,
+/* xgettext:no-c-format */
+"Array `%A' at %0 is too large to handle")
+FFEBAD_MSG (FFEBAD_SFUNC_UNUSED, WARN,
+/* xgettext:no-c-format */
+"Statement function `%A' defined at %0 is not used")
+FFEBAD_MSG (FFEBAD_INTRINSIC_Y2KBAD, WARN,
+/* xgettext:no-c-format */
+"Intrinsic `%A', invoked at %0, known to be non-Y2K-compliant [info -f g77 M Y2KBAD]")
+FFEBAD_MSG (FFEBAD_NOCANDO, DISASTER,
+/* xgettext:no-c-format */
+"Internal compiler error -- cannot perform operation")
+
+#undef INFORM
+#undef TRIVIAL
+#undef WARN
+#undef PECULIAR
+#undef FATAL
+#undef WEIRD
+#undef SEVERE
+#undef DISASTER
diff --git a/gcc/f/bad.h b/gcc/f/bad.h
new file mode 100644
index 00000000000..bd7581e50d9
--- /dev/null
+++ b/gcc/f/bad.h
@@ -0,0 +1,106 @@
+/* bad.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995, 2002 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      bad.c
+
+   Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef GCC_F_BAD_H
+#define GCC_F_BAD_H
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+  {
+#define FFEBAD_MSG(KWD,SEV,MSG) KWD,
+#include "bad.def"
+#undef FFEBAD_MSG
+    FFEBAD
+  } ffebad;
+
+typedef enum
+  {
+
+    /* Order important; must be increasing severity. */
+
+    FFEBAD_severityINFORMATIONAL,	/* User notice. */
+    FFEBAD_severityTRIVIAL,	/* Internal notice. */
+    FFEBAD_severityWARNING,	/* User warning. */
+    FFEBAD_severityPECULIAR,	/* Internal warning. */
+    FFEBAD_severityPEDANTIC,	/* Pedantic, could be warning or error. */
+    FFEBAD_severityFATAL,	/* User error. */
+    FFEBAD_severityWEIRD,	/* Internal error. */
+    FFEBAD_severitySEVERE,	/* User error, cannot continue. */
+    FFEBAD_severityDISASTER,	/* Internal error, cannot continue. */
+    FFEBAD_severity
+  } ffebadSeverity;
+
+/* Typedefs. */
+
+typedef unsigned char ffebadIndex;
+
+/* Include files needed by this one. */
+
+#include "where.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+extern bool ffebad_is_inhibited_;
+
+/* Declare functions with prototypes. */
+
+void ffebad_finish (void);
+void ffebad_here (ffebadIndex i, ffewhereLine wl, ffewhereColumn wc);
+void ffebad_init_0 (void);
+bool ffebad_is_fatal (ffebad errnum);
+ffebadSeverity ffebad_severity (ffebad errnum);
+bool ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev,
+		    const char *msgid);
+void ffebad_string (const char *string);
+
+/* Define macros. */
+
+#define ffebad_inhibit() (ffebad_is_inhibited_)
+#define ffebad_init_1()
+#define ffebad_init_2()
+#define ffebad_init_3()
+#define ffebad_init_4()
+#define ffebad_set_inhibit(f) (ffebad_is_inhibited_ = (f))
+#define ffebad_start(e) ffebad_start_ (FALSE, (e), FFEBAD_severity, NULL)
+#define ffebad_start_lex(e) ffebad_start_ (TRUE, (e), FFEBAD_severity, NULL)
+#define ffebad_start_msg(msgid,s) ffebad_start_ (FALSE, FFEBAD, (s), (msgid))
+#define ffebad_start_msg_lex(msgid,s) ffebad_start_ (TRUE, FFEBAD, (s), (msgid))
+#define ffebad_terminate_0()
+#define ffebad_terminate_1()
+#define ffebad_terminate_2()
+#define ffebad_terminate_3()
+#define ffebad_terminate_4()
+
+/* End of #include file. */
+
+#endif /* ! GCC_F_BAD_H */
diff --git a/gcc/f/bit.c b/gcc/f/bit.c
new file mode 100644
index 00000000000..00f064b1da2
--- /dev/null
+++ b/gcc/f/bit.c
@@ -0,0 +1,200 @@
+/* bit.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Related Modules:
+      None
+
+   Description:
+      Tracks arrays of booleans in useful ways.
+
+   Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "bit.h"
+#include "malloc.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+
+/* ffebit_count -- Count # of bits set a particular way
+
+   ffebit b;  // the ffebit object
+   ffebitCount offset;	// 0..size-1
+   bool value;	// FALSE (0), TRUE (1)
+   ffebitCount range;  // # bits to test
+   ffebitCount number;	// # bits equal to value
+   ffebit_count(b,offset,value,range,&number);
+
+   Sets <number> to # bits at <offset> through <offset + range - 1> set to
+   <value>.  If <range> is 0, <number> is set to 0.  */
+
+void
+ffebit_count (ffebit b, ffebitCount offset, bool value, ffebitCount range,
+	      ffebitCount *number)
+{
+  ffebitCount element;
+  ffebitCount bitno;
+
+  assert (offset + range <= b->size);
+
+  for (*number = 0; range != 0; --range, ++offset)
+    {
+      element = offset / CHAR_BIT;
+      bitno = offset % CHAR_BIT;
+      if (value
+	  == ((b->bits[element] & ((unsigned char) 1 << bitno)) == 0 ? FALSE : TRUE))
+	++ * number;
+    }
+}
+
+/* ffebit_new -- Create a new ffebit object
+
+   ffebit b;
+   ffebit_kill(b);
+
+   Destroys an ffebit object obtained via ffebit_new.  */
+
+void
+ffebit_kill (ffebit b)
+{
+  malloc_kill_ks (b->pool, b,
+		  offsetof (struct _ffebit_, bits)
+		  + (b->size + CHAR_BIT - 1) / CHAR_BIT);
+}
+
+/* ffebit_new -- Create a new ffebit object
+
+   ffebit b;
+   mallocPool pool;
+   ffebitCount size;
+   b = ffebit_new(pool,size);
+
+   Allocates an ffebit object that holds the values of <size> bits in pool
+   <pool>.  */
+
+ffebit
+ffebit_new (mallocPool pool, ffebitCount size)
+{
+  ffebit b;
+
+  b = malloc_new_zks (pool, "ffebit",
+		      offsetof (struct _ffebit_, bits)
+		      + (size + CHAR_BIT - 1) / CHAR_BIT,
+		      0);
+  b->pool = pool;
+  b->size = size;
+
+  return b;
+}
+
+/* ffebit_set -- Set value of # of bits
+
+   ffebit b;  // the ffebit object
+   ffebitCount offset;	// 0..size-1
+   bool value;	// FALSE (0), TRUE (1)
+   ffebitCount length;	// # bits to set starting at offset (usually 1)
+   ffebit_set(b,offset,value,length);
+
+   Sets bit #s <offset> through <offset + length - 1> to <value>.  */
+
+void
+ffebit_set (ffebit b, ffebitCount offset, bool value, ffebitCount length)
+{
+  ffebitCount i;
+  ffebitCount element;
+  ffebitCount bitno;
+
+  assert (offset + length <= b->size);
+
+  for (i = 0; i < length; ++i, ++offset)
+    {
+      element = offset / CHAR_BIT;
+      bitno = offset % CHAR_BIT;
+      b->bits[element] = (((unsigned char) (value ? 1 : 0)) << bitno)
+	| (b->bits[element] & ~((unsigned char) 1 << bitno));
+    }
+}
+
+/* ffebit_test -- Test value of # of bits
+
+   ffebit b;  // the ffebit object
+   ffebitCount offset;	// 0..size-1
+   bool value;	// FALSE (0), TRUE (1)
+   ffebitCount length;	// # bits with same value
+   ffebit_test(b,offset,&value,&length);
+
+   Returns value of bits at <offset> through <offset + length - 1> in
+   <value>.  If <offset> is already at the end of the bit array (if
+   offset == ffebit_size(b)), <length> is set to 0 and <value> is
+   undefined.  */
+
+void
+ffebit_test (ffebit b, ffebitCount offset, bool *value, ffebitCount *length)
+{
+  ffebitCount i;
+  ffebitCount element;
+  ffebitCount bitno;
+
+  if (offset >= b->size)
+    {
+      assert (offset == b->size);
+      *length = 0;
+      return;
+    }
+
+  element = offset / CHAR_BIT;
+  bitno = offset % CHAR_BIT;
+  *value = (b->bits[element] & ((unsigned char) 1 << bitno)) == 0 ? FALSE : TRUE;
+  *length = 1;
+
+  for (i = b->size - offset - 1, ++offset; i != 0; --i, ++offset, ++*length)
+    {
+      element = offset / CHAR_BIT;
+      bitno = offset % CHAR_BIT;
+      if (*value
+	  != ((b->bits[element] & ((unsigned char) 1 << bitno)) == 0 ? FALSE : TRUE))
+	break;
+    }
+}
diff --git a/gcc/f/bit.h b/gcc/f/bit.h
new file mode 100644
index 00000000000..6b559efe668
--- /dev/null
+++ b/gcc/f/bit.h
@@ -0,0 +1,84 @@
+/* bit.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      bit.c
+
+   Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef GCC_F_BIT_H
+#define GCC_F_BIT_H
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+typedef struct _ffebit_ *ffebit;
+typedef unsigned long ffebitCount;
+#define ffebitCount_f "l"
+
+/* Include files needed by this one. */
+
+#include "malloc.h"
+
+/* Structure definitions. */
+
+struct _ffebit_
+  {
+    mallocPool pool;
+    ffebitCount size;
+    unsigned char bits[1];
+  };
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+void ffebit_count (ffebit b, ffebitCount offset, bool value, ffebitCount range,
+		   ffebitCount *number);
+void ffebit_kill (ffebit b);
+ffebit ffebit_new (mallocPool pool, ffebitCount size);
+void ffebit_set (ffebit b, ffebitCount offset, bool value, ffebitCount length);
+void ffebit_test (ffebit b, ffebitCount offset, bool *value, ffebitCount *length);
+
+/* Define macros. */
+
+#define ffebit_init_0()
+#define ffebit_init_1()
+#define ffebit_init_2()
+#define ffebit_init_3()
+#define ffebit_init_4()
+#define ffebit_pool(b) ((b)->pool)
+#define ffebit_size(b) ((b)->size)
+#define ffebit_terminate_0()
+#define ffebit_terminate_1()
+#define ffebit_terminate_2()
+#define ffebit_terminate_3()
+#define ffebit_terminate_4()
+
+/* End of #include file. */
+
+#endif /* ! GCC_F_BIT_H */
diff --git a/gcc/f/bld-op.def b/gcc/f/bld-op.def
new file mode 100644
index 00000000000..737dcc7e2f6
--- /dev/null
+++ b/gcc/f/bld-op.def
@@ -0,0 +1,69 @@
+/* bld-op.def -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      bad.c
+
+   Modifications:
+*/
+
+FFEBLD_OP (FFEBLD_opANY, "ANY", 0)
+FFEBLD_OP (FFEBLD_opSTAR, "STAR", 0)	/* For adjustable arrays, alternate return dummies, etc. */
+FFEBLD_OP (FFEBLD_opCONTER, "CONTER", 0)
+FFEBLD_OP (FFEBLD_opARRTER, "ARRTER", 0)	/* Array of constants (DATA...). */
+FFEBLD_OP (FFEBLD_opACCTER, "ACCTER", 0)	/* Accreting ARRTER. */
+FFEBLD_OP (FFEBLD_opSYMTER, "SYMTER", 0)
+FFEBLD_OP (FFEBLD_opITEM, "ITEM", 0)
+FFEBLD_OP (FFEBLD_opUPLUS, "UPLUS", 1)
+FFEBLD_OP (FFEBLD_opUMINUS, "UMINUS", 1)
+FFEBLD_OP (FFEBLD_opADD, "ADD", 2)
+FFEBLD_OP (FFEBLD_opSUBTRACT, "SUBTRACT", 2)
+FFEBLD_OP (FFEBLD_opMULTIPLY, "MULTIPLY", 2)
+FFEBLD_OP (FFEBLD_opDIVIDE, "DIVIDE", 2)
+FFEBLD_OP (FFEBLD_opPOWER, "POWER", 2)
+FFEBLD_OP (FFEBLD_opCONCATENATE, "CONCATENATE", 2)
+FFEBLD_OP (FFEBLD_opNOT, "NOT", 1)
+FFEBLD_OP (FFEBLD_opLT, "LT", 2)
+FFEBLD_OP (FFEBLD_opLE, "LE", 2)
+FFEBLD_OP (FFEBLD_opEQ, "EQ", 2)
+FFEBLD_OP (FFEBLD_opNE, "NE", 2)
+FFEBLD_OP (FFEBLD_opGT, "GT", 2)
+FFEBLD_OP (FFEBLD_opGE, "GE", 2)
+FFEBLD_OP (FFEBLD_opAND, "AND", 2)
+FFEBLD_OP (FFEBLD_opOR, "OR", 2)
+FFEBLD_OP (FFEBLD_opXOR, "XOR", 2)
+FFEBLD_OP (FFEBLD_opEQV, "EQV", 2)
+FFEBLD_OP (FFEBLD_opNEQV, "NEQV", 2)
+FFEBLD_OP (FFEBLD_opPAREN, "PAREN", 1)
+FFEBLD_OP (FFEBLD_opPERCENT_LOC, "%LOC", 1)
+FFEBLD_OP (FFEBLD_opPERCENT_VAL, "%VAL", 1)
+FFEBLD_OP (FFEBLD_opPERCENT_REF, "%REF", 1)
+FFEBLD_OP (FFEBLD_opPERCENT_DESCR, "%DESCR", 1)
+FFEBLD_OP (FFEBLD_opCONVERT, "CONVERT", 1)
+FFEBLD_OP (FFEBLD_opREPEAT, "REPEAT", 2)
+FFEBLD_OP (FFEBLD_opBOUNDS, "BOUNDS", 2)	/* For low:high in dimension lists. */
+FFEBLD_OP (FFEBLD_opFUNCREF, "FUNCREF", 2)
+FFEBLD_OP (FFEBLD_opSUBRREF, "SUBRREF", 2)
+FFEBLD_OP (FFEBLD_opARRAYREF, "ARRAYREF", 2)
+FFEBLD_OP (FFEBLD_opSUBSTR, "SUBSTR", 2)
+FFEBLD_OP (FFEBLD_opLABTER, "LABTER", 0)
+FFEBLD_OP (FFEBLD_opLABTOK, "LABTOK", 0)	/* Like LABTER but contains ffelexToken instead. */
+FFEBLD_OP (FFEBLD_opIMPDO, "IMPDO", 2)
diff --git a/gcc/f/bld.c b/gcc/f/bld.c
new file mode 100644
index 00000000000..ec7c5cd683e
--- /dev/null
+++ b/gcc/f/bld.c
@@ -0,0 +1,3135 @@
+/* bld.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1996, 2003, 2004 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Related Modules:
+      None
+
+   Description:
+      The primary "output" of the FFE includes ffebld objects, which
+      connect expressions, operators, and operands together, along with
+      connecting lists of expressions together for argument or dimension
+      lists.
+
+   Modifications:
+      30-Aug-92	 JCB  1.1
+	 Change names of some things for consistency.
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "bld.h"
+#include "bit.h"
+#include "info.h"
+#include "lex.h"
+#include "malloc.h"
+#include "target.h"
+#include "where.h"
+#include "real.h"
+
+/* Externals defined here.  */
+
+const ffebldArity ffebld_arity_op_[(int) FFEBLD_op]
+=
+{
+#define FFEBLD_OP(KWD,NAME,ARITY) ARITY,
+#include "bld-op.def"
+#undef FFEBLD_OP
+};
+struct _ffebld_pool_stack_ ffebld_pool_stack_;
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module.	 */
+
+#if FFETARGET_okCHARACTER1
+static ffebldConstant ffebld_constant_character1_;
+#endif
+#if FFETARGET_okCOMPLEX1
+static ffebldConstant ffebld_constant_complex1_;
+#endif
+#if FFETARGET_okCOMPLEX2
+static ffebldConstant ffebld_constant_complex2_;
+#endif
+#if FFETARGET_okCOMPLEX3
+static ffebldConstant ffebld_constant_complex3_;
+#endif
+#if FFETARGET_okINTEGER1
+static ffebldConstant ffebld_constant_integer1_;
+#endif
+#if FFETARGET_okINTEGER2
+static ffebldConstant ffebld_constant_integer2_;
+#endif
+#if FFETARGET_okINTEGER3
+static ffebldConstant ffebld_constant_integer3_;
+#endif
+#if FFETARGET_okINTEGER4
+static ffebldConstant ffebld_constant_integer4_;
+#endif
+#if FFETARGET_okLOGICAL1
+static ffebldConstant ffebld_constant_logical1_;
+#endif
+#if FFETARGET_okLOGICAL2
+static ffebldConstant ffebld_constant_logical2_;
+#endif
+#if FFETARGET_okLOGICAL3
+static ffebldConstant ffebld_constant_logical3_;
+#endif
+#if FFETARGET_okLOGICAL4
+static ffebldConstant ffebld_constant_logical4_;
+#endif
+#if FFETARGET_okREAL1
+static ffebldConstant ffebld_constant_real1_;
+#endif
+#if FFETARGET_okREAL2
+static ffebldConstant ffebld_constant_real2_;
+#endif
+#if FFETARGET_okREAL3
+static ffebldConstant ffebld_constant_real3_;
+#endif
+static ffebldConstant ffebld_constant_hollerith_;
+static ffebldConstant ffebld_constant_typeless_[FFEBLD_constTYPELESS_LAST
+					  - FFEBLD_constTYPELESS_FIRST + 1];
+
+static const char *const ffebld_op_string_[]
+=
+{
+#define FFEBLD_OP(KWD,NAME,ARITY) NAME,
+#include "bld-op.def"
+#undef FFEBLD_OP
+};
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+#define integerdefault_ CATX(integer,FFETARGET_ktINTEGERDEFAULT)
+#define logicaldefault_ CATX(logical,FFETARGET_ktLOGICALDEFAULT)
+#define realdefault_ CATX(real,FFETARGET_ktREALDEFAULT)
+#define realdouble_ CATX(real,FFETARGET_ktREALDOUBLE)
+#define realquad_ CATX(real,FFETARGET_ktREALQUAD)
+
+/* ffebld_constant_cmp -- Compare two constants a la strcmp
+
+   ffebldConstant c1, c2;
+   if (ffebld_constant_cmp(c1,c2) == 0)
+       // they're equal, else they're not.
+
+   Returns -1 if c1 < c2, 0 if c1 == c2, +1 if c1 == c2.  */
+
+int
+ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2)
+{
+  if (c1 == c2)
+    return 0;
+
+  assert (ffebld_constant_type (c1) == ffebld_constant_type (c2));
+
+  switch (ffebld_constant_type (c1))
+    {
+#if FFETARGET_okINTEGER1
+    case FFEBLD_constINTEGER1:
+      return ffetarget_cmp_integer1 (ffebld_constant_integer1 (c1),
+				     ffebld_constant_integer1 (c2));
+#endif
+
+#if FFETARGET_okINTEGER2
+    case FFEBLD_constINTEGER2:
+      return ffetarget_cmp_integer2 (ffebld_constant_integer2 (c1),
+				     ffebld_constant_integer2 (c2));
+#endif
+
+#if FFETARGET_okINTEGER3
+    case FFEBLD_constINTEGER3:
+      return ffetarget_cmp_integer3 (ffebld_constant_integer3 (c1),
+				     ffebld_constant_integer3 (c2));
+#endif
+
+#if FFETARGET_okINTEGER4
+    case FFEBLD_constINTEGER4:
+      return ffetarget_cmp_integer4 (ffebld_constant_integer4 (c1),
+				     ffebld_constant_integer4 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL1
+    case FFEBLD_constLOGICAL1:
+      return ffetarget_cmp_logical1 (ffebld_constant_logical1 (c1),
+				     ffebld_constant_logical1 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL2
+    case FFEBLD_constLOGICAL2:
+      return ffetarget_cmp_logical2 (ffebld_constant_logical2 (c1),
+				     ffebld_constant_logical2 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL3
+    case FFEBLD_constLOGICAL3:
+      return ffetarget_cmp_logical3 (ffebld_constant_logical3 (c1),
+				     ffebld_constant_logical3 (c2));
+#endif
+
+#if FFETARGET_okLOGICAL4
+    case FFEBLD_constLOGICAL4:
+      return ffetarget_cmp_logical4 (ffebld_constant_logical4 (c1),
+				     ffebld_constant_logical4 (c2));
+#endif
+
+#if FFETARGET_okREAL1
+    case FFEBLD_constREAL1:
+      return ffetarget_cmp_real1 (ffebld_constant_real1 (c1),
+				  ffebld_constant_real1 (c2));
+#endif
+
+#if FFETARGET_okREAL2
+    case FFEBLD_constREAL2:
+      return ffetarget_cmp_real2 (ffebld_constant_real2 (c1),
+				  ffebld_constant_real2 (c2));
+#endif
+
+#if FFETARGET_okREAL3
+    case FFEBLD_constREAL3:
+      return ffetarget_cmp_real3 (ffebld_constant_real3 (c1),
+				  ffebld_constant_real3 (c2));
+#endif
+
+#if FFETARGET_okCHARACTER1
+    case FFEBLD_constCHARACTER1:
+      return ffetarget_cmp_character1 (ffebld_constant_character1 (c1),
+				       ffebld_constant_character1 (c2));
+#endif
+
+    default:
+      assert ("bad constant type" == NULL);
+      return 0;
+    }
+}
+
+/* ffebld_constant_is_magical -- Determine if integer is "magical"
+
+   ffebldConstant c;
+   if (ffebld_constant_is_magical(c))
+       // it is 2**(n-1), where n is # bits in ffetargetIntegerDefault type
+       // (this test is important for 2's-complement machines only).  */
+
+bool
+ffebld_constant_is_magical (ffebldConstant c)
+{
+  switch (ffebld_constant_type (c))
+    {
+    case FFEBLD_constINTEGERDEFAULT:
+      return ffetarget_integerdefault_is_magical (ffebld_constant_integer1 (c));
+
+    default:
+      return FALSE;
+    }
+}
+
+/* Determine if constant is zero.  Used to ensure step count
+   for DO loops isn't zero, also to determine if values will
+   be binary zeros, so not entirely portable at this point.  */
+
+bool
+ffebld_constant_is_zero (ffebldConstant c)
+{
+  switch (ffebld_constant_type (c))
+    {
+#if FFETARGET_okINTEGER1
+    case FFEBLD_constINTEGER1:
+      return ffebld_constant_integer1 (c) == 0;
+#endif
+
+#if FFETARGET_okINTEGER2
+    case FFEBLD_constINTEGER2:
+      return ffebld_constant_integer2 (c) == 0;
+#endif
+
+#if FFETARGET_okINTEGER3
+    case FFEBLD_constINTEGER3:
+      return ffebld_constant_integer3 (c) == 0;
+#endif
+
+#if FFETARGET_okINTEGER4
+    case FFEBLD_constINTEGER4:
+      return ffebld_constant_integer4 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL1
+    case FFEBLD_constLOGICAL1:
+      return ffebld_constant_logical1 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL2
+    case FFEBLD_constLOGICAL2:
+      return ffebld_constant_logical2 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL3
+    case FFEBLD_constLOGICAL3:
+      return ffebld_constant_logical3 (c) == 0;
+#endif
+
+#if FFETARGET_okLOGICAL4
+    case FFEBLD_constLOGICAL4:
+      return ffebld_constant_logical4 (c) == 0;
+#endif
+
+#if FFETARGET_okREAL1
+    case FFEBLD_constREAL1:
+      return ffetarget_iszero_real1 (ffebld_constant_real1 (c));
+#endif
+
+#if FFETARGET_okREAL2
+    case FFEBLD_constREAL2:
+      return ffetarget_iszero_real2 (ffebld_constant_real2 (c));
+#endif
+
+#if FFETARGET_okREAL3
+    case FFEBLD_constREAL3:
+      return ffetarget_iszero_real3 (ffebld_constant_real3 (c));
+#endif
+
+#if FFETARGET_okCOMPLEX1
+    case FFEBLD_constCOMPLEX1:
+      return ffetarget_iszero_real1 (ffebld_constant_complex1 (c).real)
+     && ffetarget_iszero_real1 (ffebld_constant_complex1 (c).imaginary);
+#endif
+
+#if FFETARGET_okCOMPLEX2
+    case FFEBLD_constCOMPLEX2:
+      return ffetarget_iszero_real2 (ffebld_constant_complex2 (c).real)
+     && ffetarget_iszero_real2 (ffebld_constant_complex2 (c).imaginary);
+#endif
+
+#if FFETARGET_okCOMPLEX3
+    case FFEBLD_constCOMPLEX3:
+      return ffetarget_iszero_real3 (ffebld_constant_complex3 (c).real)
+     && ffetarget_iszero_real3 (ffebld_constant_complex3 (c).imaginary);
+#endif
+
+#if FFETARGET_okCHARACTER1
+    case FFEBLD_constCHARACTER1:
+      return ffetarget_iszero_character1 (ffebld_constant_character1 (c));
+#endif
+
+    case FFEBLD_constHOLLERITH:
+      return ffetarget_iszero_hollerith (ffebld_constant_hollerith (c));
+
+    case FFEBLD_constBINARY_MIL:
+    case FFEBLD_constBINARY_VXT:
+    case FFEBLD_constOCTAL_MIL:
+    case FFEBLD_constOCTAL_VXT:
+    case FFEBLD_constHEX_X_MIL:
+    case FFEBLD_constHEX_X_VXT:
+    case FFEBLD_constHEX_Z_MIL:
+    case FFEBLD_constHEX_Z_VXT:
+      return ffetarget_iszero_typeless (ffebld_constant_typeless (c));
+
+    default:
+      return FALSE;
+    }
+}
+
+/* ffebld_constant_new_character1 -- Return character1 constant object from token
+
+   See prototype.  */
+
+#if FFETARGET_okCHARACTER1
+ffebldConstant
+ffebld_constant_new_character1 (ffelexToken t)
+{
+  ffetargetCharacter1 val;
+
+  ffetarget_character1 (&val, t, ffebld_constant_pool());
+  return ffebld_constant_new_character1_val (val);
+}
+
+#endif
+/* ffebld_constant_new_character1_val -- Return an character1 constant object
+
+   See prototype.  */
+
+#if FFETARGET_okCHARACTER1
+ffebldConstant
+ffebld_constant_new_character1_val (ffetargetCharacter1 val)
+{
+  ffebldConstant nc;
+  ffebldConstant P;
+  ffebldConstant Q;
+  int cmp = 0;
+  P = ffebld_constant_character1_;
+  Q = P;
+  if (!P)
+   {
+    /* make this node the root */
+     nc = malloc_new_kp (ffebld_constant_pool(),
+                         "FFEBLD_constCHARACTER1",
+                         sizeof (*nc));
+     nc->consttype = FFEBLD_constCHARACTER1;
+     nc->u.character1 = val;
+     nc->hook = FFECOM_constantNULL;
+     nc->llink = NULL;
+     nc->rlink = NULL;
+     ffebld_constant_character1_ = nc;
+     return nc;
+   }
+  else
+    while (P)
+     {
+       Q = P;
+       cmp = ffetarget_cmp_character1 (val, ffebld_constant_character1 (P));
+       if (cmp > 0)
+         P = P->llink;
+       else if (cmp < 0)
+         P = P->rlink;
+       else
+         return P;
+     }
+
+  nc = malloc_new_kp (ffebld_constant_pool(),
+		      "FFEBLD_constCHARACTER1",
+		      sizeof (*nc));
+  nc->consttype = FFEBLD_constCHARACTER1;
+  nc->u.character1 = val;
+  nc->hook = FFECOM_constantNULL;
+  nc->llink = NULL;
+  nc->rlink = NULL;
+
+  if (cmp < 0)
+    Q->llink = nc;
+  else
+    Q->rlink = nc;
+  return nc;
+}
+
+#endif
+/* ffebld_constant_new_complex1 -- Return complex1 constant object from token
+
+   See prototype.  */
+
+#if FFETARGET_okCOMPLEX1
+ffebldConstant
+ffebld_constant_new_complex1 (ffebldConstant real,
+			      ffebldConstant imaginary)
+{
+  ffetargetComplex1 val;
+
+  val.real = ffebld_constant_real1 (real);
+  val.imaginary = ffebld_constant_real1 (imaginary);
+  return ffebld_constant_new_complex1_val (val);
+}
+
+#endif
+/* ffebld_constant_new_complex1_val -- Return a complex1 constant object
+
+   See prototype.  */
+
+#if FFETARGET_okCOMPLEX1
+ffebldConstant
+ffebld_constant_new_complex1_val (ffetargetComplex1 val)
+{
+  ffebldConstant nc;
+  ffebldConstant P;
+  ffebldConstant Q;
+  int cmp = 0;
+  P = ffebld_constant_complex1_;
+  Q = P;
+  if (!P)
+   {
+    /* make this node the root */
+     nc = malloc_new_kp (ffebld_constant_pool(),
+                         "FFEBLD_constCOMPLEX1",
+                         sizeof (*nc));
+     nc->consttype = FFEBLD_constCOMPLEX1;
+     nc->u.complex1 = val;
+     nc->hook = FFECOM_constantNULL;
+     nc->llink = NULL;
+     nc->rlink = NULL;
+     ffebld_constant_complex1_ = nc;
+     return nc;
+   }
+  else
+    while (P)
+     {
+       Q = P;
+       cmp = ffetarget_cmp_real1 (val.real, 
+                                  ffebld_constant_complex1 (P).real);
+       if (cmp == 0)
+         cmp = ffetarget_cmp_real1 (val.imaginary,
+                                  ffebld_constant_complex1 (P).imaginary);
+       if (cmp > 0)
+         P = P->llink;
+       else if (cmp < 0)
+         P = P->rlink;
+       else
+         return P;
+     }
+
+  nc = malloc_new_kp (ffebld_constant_pool(),
+		      "FFEBLD_constCOMPLEX1",
+		      sizeof (*nc));
+  nc->consttype = FFEBLD_constCOMPLEX1;
+  nc->u.complex1 = val;
+  nc->hook = FFECOM_constantNULL;
+  nc->llink = NULL;
+  nc->rlink = NULL;
+
+  if (cmp < 0)
+    Q->llink = nc;
+  else
+    Q->rlink = nc;
+  return nc;
+}
+
+#endif
+/* ffebld_constant_new_complex2 -- Return complex2 constant object from token
+
+   See prototype.  */
+
+#if FFETARGET_okCOMPLEX2
+ffebldConstant
+ffebld_constant_new_complex2 (ffebldConstant real,
+			      ffebldConstant imaginary)
+{
+  ffetargetComplex2 val;
+
+  val.real = ffebld_constant_real2 (real);
+  val.imaginary = ffebld_constant_real2 (imaginary);
+  return ffebld_constant_new_complex2_val (val);
+}
+
+#endif
+/* ffebld_constant_new_complex2_val -- Return a complex2 constant object
+
+   See prototype.  */
+
+#if FFETARGET_okCOMPLEX2
+ffebldConstant
+ffebld_constant_new_complex2_val (ffetargetComplex2 val)
+{
+  ffebldConstant nc;
+  ffebldConstant P;
+  ffebldConstant Q;
+  int cmp = 0;
+  P = ffebld_constant_complex2_;
+  Q = P;
+  if (!P)
+   {
+    /* make this node the root */
+     nc = malloc_new_kp (ffebld_constant_pool(),
+                         "FFEBLD_constCOMPLEX2",
+                         sizeof (*nc));
+     nc->consttype = FFEBLD_constCOMPLEX2;
+     nc->u.complex2 = val;
+     nc->hook = FFECOM_constantNULL;
+     nc->llink = NULL;
+     nc->rlink = NULL;
+     ffebld_constant_complex2_ = nc;
+     return nc;
+   }
+  else
+    while (P)
+     {
+       Q = P;
+       cmp = ffetarget_cmp_real2 (val.real,
+                                  ffebld_constant_complex2 (P).real);
+       if (cmp == 0)
+         cmp = ffetarget_cmp_real2 (val.imaginary,
+                                    ffebld_constant_complex2 (P).imaginary);   
+       if (cmp > 0)
+         P = P->llink;
+       else if (cmp < 0)
+         P = P->rlink;
+       else
+         return P;
+     }
+
+  nc = malloc_new_kp (ffebld_constant_pool(),
+		      "FFEBLD_constCOMPLEX2",
+		      sizeof (*nc));
+  nc->consttype = FFEBLD_constCOMPLEX2;
+  nc->u.complex2 = val;
+  nc->hook = FFECOM_constantNULL;
+  nc->llink = NULL;
+  nc->rlink = NULL;
+
+  if (cmp < 0)
+    Q->llink = nc;
+  else
+    Q->rlink = nc;
+  return nc;
+}
+
+#endif
+/* ffebld_constant_new_hollerith -- Return hollerith constant object from token
+
+   See prototype.  */
+
+ffebldConstant
+ffebld_constant_new_hollerith (ffelexToken t)
+{
+  ffetargetHollerith val;
+
+  ffetarget_hollerith (&val, t, ffebld_constant_pool());
+  return ffebld_constant_new_hollerith_val (val);
+}
+
+/* ffebld_constant_new_hollerith_val -- Return an hollerith constant object
+
+   See prototype.  */
+
+ffebldConstant
+ffebld_constant_new_hollerith_val (ffetargetHollerith val)
+{
+  ffebldConstant nc;
+  ffebldConstant P;
+  ffebldConstant Q;
+  int cmp = 0;
+  P = ffebld_constant_hollerith_;
+  Q = P;
+  if (!P)
+   {
+    /* make this node the root */
+     nc = malloc_new_kp (ffebld_constant_pool(),
+                         "FFEBLD_constHOLLERITH",
+                         sizeof (*nc));
+     nc->consttype = FFEBLD_constHOLLERITH;
+     nc->u.hollerith = val;
+     nc->hook = FFECOM_constantNULL;
+     nc->llink = NULL;
+     nc->rlink = NULL;
+     ffebld_constant_hollerith_ = nc;
+     return nc;
+   }
+  else
+    while (P)
+     {
+       Q = P;
+       cmp = ffetarget_cmp_hollerith (val, ffebld_constant_hollerith (P));
+       if (cmp > 0)
+         P = P->llink;
+       else if (cmp < 0)
+         P = P->rlink;
+       else
+         return P;
+     }
+
+  nc = malloc_new_kp (ffebld_constant_pool(),
+		      "FFEBLD_constHOLLERITH",
+		      sizeof (*nc));
+  nc->consttype = FFEBLD_constHOLLERITH;
+  nc->u.hollerith = val;
+  nc->hook = FFECOM_constantNULL;
+  nc->llink = NULL;
+  nc->rlink = NULL;
+
+  if (cmp < 0)
+    Q->llink = nc;
+  else
+    Q->rlink = nc;
+  return nc;
+}
+
+/* ffebld_constant_new_integer1 -- Return integer1 constant object from token
+
+   See prototype.
+
+   Parses the token as a decimal integer constant, thus it must be an
+   FFELEX_typeNUMBER.  */
+
+#if FFETARGET_okINTEGER1
+ffebldConstant
+ffebld_constant_new_integer1 (ffelexToken t)
+{
+  ffetargetInteger1 val;
+
+  assert (ffelex_token_type (t) == FFELEX_typeNUMBER);
+
+  ffetarget_integer1 (&val, t);
+  return ffebld_constant_new_integer1_val (val);
+}
+
+#endif
+/* ffebld_constant_new_integer1_val -- Return an integer1 constant object
+
+   See prototype.  */
+
+#if FFETARGET_okINTEGER1
+ffebldConstant
+ffebld_constant_new_integer1_val (ffetargetInteger1 val)
+{
+
+  ffebldConstant nc;
+  ffebldConstant P;
+  ffebldConstant Q;
+  int cmp = 0;
+  P = ffebld_constant_integer1_;
+  Q = P;
+  if (!P)
+   {
+    /* make this node the root */
+     nc = malloc_new_kp (ffebld_constant_pool(),
+                         "FFEBLD_constINTEGER1",
+                         sizeof (*nc));
+     nc->consttype = FFEBLD_constINTEGER1;
+     nc->u.integer1 = val;
+     nc->hook = FFECOM_constantNULL;
+     nc->llink = NULL;
+     nc->rlink = NULL;
+     ffebld_constant_integer1_ = nc;
+     return nc;
+   }
+  else
+    while (P)
+     {
+       Q = P;
+       cmp = ffetarget_cmp_integer1 (val, ffebld_constant_integer1 (P));
+       if (cmp > 0)
+         P = P->llink;
+       else if (cmp < 0)
+         P = P->rlink;
+       else
+         return P;
+     }
+
+  nc = malloc_new_kp (ffebld_constant_pool(),
+		      "FFEBLD_constINTEGER1",
+		      sizeof (*nc));
+  nc->consttype = FFEBLD_constINTEGER1;
+  nc->u.integer1 = val;
+  nc->hook = FFECOM_constantNULL;
+  nc->llink = NULL;
+  nc->rlink = NULL;
+
+  if (cmp < 0)
+    Q->llink = nc;
+  else
+    Q->rlink = nc;
+  return nc;
+}
+
+#endif
+/* ffebld_constant_new_integer2_val -- Return an integer2 constant object
+
+   See prototype.  */
+
+#if FFETARGET_okINTEGER2
+ffebldConstant
+ffebld_constant_new_integer2_val (ffetargetInteger2 val)
+{
+  ffebldConstant nc;
+  ffebldConstant P;
+  ffebldConstant Q;
+  int cmp = 0;
+  P = ffebld_constant_integer2_;
+  Q = P;
+  if (!P)
+   {
+    /* make this node the root */
+     nc = malloc_new_kp (ffebld_constant_pool(),
+                         "FFEBLD_constINTEGER2",
+                         sizeof (*nc));
+     nc->consttype = FFEBLD_constINTEGER2;
+     nc->u.integer2 = val;
+     nc->hook = FFECOM_constantNULL;
+     nc->llink = NULL;
+     nc->rlink = NULL;
+     ffebld_constant_integer2_ = nc;
+     return nc;
+   }
+  else
+    while (P)
+     {
+       Q = P;
+       cmp = ffetarget_cmp_integer2 (val, ffebld_constant_integer2 (P));
+       if (cmp > 0)
+         P = P->llink;
+       else if (cmp < 0)
+         P = P->rlink;
+       else
+         return P;
+     }
+
+  nc = malloc_new_kp (ffebld_constant_pool(),
+		      "FFEBLD_constINTEGER2",
+		      sizeof (*nc));
+  nc->consttype = FFEBLD_constINTEGER2;
+  nc->u.integer2 = val;
+  nc->hook = FFECOM_constantNULL;
+  nc->llink = NULL;
+  nc->rlink = NULL;
+
+  if (cmp < 0)
+    Q->llink = nc;
+  else
+    Q->rlink = nc;
+  return nc;
+}
+
+#endif
+/* ffebld_constant_new_integer3_val -- Return an integer3 constant object
+
+   See prototype.  */
+
+#if FFETARGET_okINTEGER3
+ffebldConstant
+ffebld_constant_new_integer3_val (ffetargetInteger3 val)
+{
+  ffebldConstant nc;
+  ffebldConstant P;
+  ffebldConstant Q;
+  int cmp = 0;
+  P = ffebld_constant_integer3_;
+  Q = P;
+  if (!P)
+   {
+    /* make this node the root */
+     nc = malloc_new_kp (ffebld_constant_pool(),
+                         "FFEBLD_constINTEGER3",
+                         sizeof (*nc));
+     nc->consttype = FFEBLD_constINTEGER3;
+     nc->u.integer3 = val;
+     nc->hook = FFECOM_constantNULL;
+     nc->llink = NULL;
+     nc->rlink = NULL;
+     ffebld_constant_integer3_ = nc;
+     return nc;
+   }
+  else
+    while (P)
+     {
+       Q = P;
+       cmp = ffetarget_cmp_integer3 (val, ffebld_constant_integer3 (P));
+       if (cmp > 0)
+         P = P->llink;
+       else if (cmp < 0)
+         P = P->rlink;
+       else
+         return P;
+     }
+
+  nc = malloc_new_kp (ffebld_constant_pool(),
+		      "FFEBLD_constINTEGER3",
+		      sizeof (*nc));
+  nc->consttype = FFEBLD_constINTEGER3;
+  nc->u.integer3 = val;
+  nc->hook = FFECOM_constantNULL;
+  nc->llink = NULL;
+  nc->rlink = NULL;
+
+  if (cmp < 0)
+    Q->llink = nc;
+  else
+    Q->rlink = nc;
+  return nc;
+}
+
+#endif
+/* ffebld_constant_new_integer4_val -- Return an integer4 constant object
+
+   See prototype.  */
+
+#if FFETARGET_okINTEGER4
+ffebldConstant
+ffebld_constant_new_integer4_val (ffetargetInteger4 val)
+{
+  ffebldConstant nc;
+  ffebldConstant P;
+  ffebldConstant Q;
+  int cmp = 0;
+  P = ffebld_constant_integer4_;
+  Q = P;
+  if (!P)
+   {
+    /* make this node the root */
+     nc = malloc_new_kp (ffebld_constant_pool(),
+                         "FFEBLD_constINTEGER4",
+                         sizeof (*nc));
+     nc->consttype = FFEBLD_constINTEGER4;
+     nc->u.integer4 = val;
+     nc->hook = FFECOM_constantNULL;
+     nc->llink = NULL;
+     nc->rlink = NULL;
+     ffebld_constant_integer4_ = nc;
+     return nc;
+   }
+  else
+    while (P)
+     {
+       Q = P;
+       cmp = ffetarget_cmp_integer4 (val, ffebld_constant_integer4 (P));
+       if (cmp > 0)
+         P = P->llink;
+       else if (cmp < 0)
+         P = P->rlink;
+       else
+         return P;
+     }
+
+  nc = malloc_new_kp (ffebld_constant_pool(),
+		      "FFEBLD_constINTEGER4",
+		      sizeof (*nc));
+  nc->consttype = FFEBLD_constINTEGER4;
+  nc->u.integer4 = val;
+  nc->hook = FFECOM_constantNULL;
+  nc->llink = NULL;
+  nc->rlink = NULL;
+
+  if (cmp < 0)
+    Q->llink = nc;
+  else
+    Q->rlink = nc;
+  return nc;
+}
+
+#endif
+/* ffebld_constant_new_integerbinary -- Return binary constant object from token
+
+   See prototype.
+
+   Parses the token as a binary integer constant, thus it must be an
+   FFELEX_typeNUMBER.  */
+
+ffebldConstant
+ffebld_constant_new_integerbinary (ffelexToken t)
+{
+  ffetargetIntegerDefault val;
+
+  assert ((ffelex_token_type (t) == FFELEX_typeNAME)
+	  || (ffelex_token_type (t) == FFELEX_typeNUMBER));
+
+  ffetarget_integerbinary (&val, t);
+  return ffebld_constant_new_integerdefault_val (val);
+}
+
+/* ffebld_constant_new_integerhex -- Return hex constant object from token
+
+   See prototype.
+
+   Parses the token as a hex integer constant, thus it must be an
+   FFELEX_typeNUMBER.  */
+
+ffebldConstant
+ffebld_constant_new_integerhex (ffelexToken t)
+{
+  ffetargetIntegerDefault val;
+
+  assert ((ffelex_token_type (t) == FFELEX_typeNAME)
+	  || (ffelex_token_type (t) == FFELEX_typeNUMBER));
+
+  ffetarget_integerhex (&val, t);
+  return ffebld_constant_new_integerdefault_val (val);
+}
+
+/* ffebld_constant_new_integeroctal -- Return octal constant object from token
+
+   See prototype.
+
+   Parses the token as a octal integer constant, thus it must be an
+   FFELEX_typeNUMBER.  */
+
+ffebldConstant
+ffebld_constant_new_integeroctal (ffelexToken t)
+{
+  ffetargetIntegerDefault val;
+
+  assert ((ffelex_token_type (t) == FFELEX_typeNAME)
+	  || (ffelex_token_type (t) == FFELEX_typeNUMBER));
+
+  ffetarget_integeroctal (&val, t);
+  return ffebld_constant_new_integerdefault_val (val);
+}
+
+/* ffebld_constant_new_logical1 -- Return logical1 constant object from token
+
+   See prototype.
+
+   Parses the token as a decimal logical constant, thus it must be an
+   FFELEX_typeNUMBER.  */
+
+#if FFETARGET_okLOGICAL1
+ffebldConstant
+ffebld_constant_new_logical1 (bool truth)
+{
+  ffetargetLogical1 val;
+
+  ffetarget_logical1 (&val, truth);
+  return ffebld_constant_new_logical1_val (val);
+}
+
+#endif
+/* ffebld_constant_new_logical1_val -- Return a logical1 constant object
+
+   See prototype.  */
+
+#if FFETARGET_okLOGICAL1
+ffebldConstant
+ffebld_constant_new_logical1_val (ffetargetLogical1 val)
+{
+  ffebldConstant nc;
+  ffebldConstant P;
+  ffebldConstant Q;
+  int cmp = 0;
+  P = ffebld_constant_logical1_;
+  Q = P;
+  if (!P)
+   {
+    /* make this node the root */
+     nc = malloc_new_kp (ffebld_constant_pool(),
+                         "FFEBLD_constLOGICAL1",
+                         sizeof (*nc));
+     nc->consttype = FFEBLD_constLOGICAL1;
+     nc->u.logical1 = val;
+     nc->hook = FFECOM_constantNULL;
+     nc->llink = NULL;
+     nc->rlink = NULL;
+     ffebld_constant_logical1_ = nc;
+     return nc;
+   }
+  else
+    while (P)
+     {
+       Q = P;
+       cmp = ffetarget_cmp_logical1 (val, ffebld_constant_logical1 (P));
+       if (cmp > 0)
+         P = P->llink;
+       else if (cmp < 0)
+         P = P->rlink;
+       else
+         return P;
+     }
+
+  nc = malloc_new_kp (ffebld_constant_pool(),
+		      "FFEBLD_constLOGICAL1",
+		      sizeof (*nc));
+  nc->consttype = FFEBLD_constLOGICAL1;
+  nc->u.logical1 = val;
+  nc->hook = FFECOM_constantNULL;
+  nc->llink = NULL;
+  nc->rlink = NULL;
+
+  if (cmp < 0)
+    Q->llink = nc;
+  else
+    Q->rlink = nc;
+  return nc;
+}
+
+#endif
+/* ffebld_constant_new_logical2_val -- Return a logical2 constant object
+
+   See prototype.  */
+
+#if FFETARGET_okLOGICAL2
+ffebldConstant
+ffebld_constant_new_logical2_val (ffetargetLogical2 val)
+{
+  ffebldConstant nc;
+  ffebldConstant P;
+  ffebldConstant Q;
+  int cmp = 0;
+  P = ffebld_constant_logical2_;
+  Q = P;
+  if (!P)
+   {
+    /* make this node the root */
+     nc = malloc_new_kp (ffebld_constant_pool(),
+                         "FFEBLD_constLOGICAL2",
+                         sizeof (*nc));
+     nc->consttype = FFEBLD_constLOGICAL2;
+     nc->u.logical2 = val;
+     nc->hook = FFECOM_constantNULL;
+     nc->llink = NULL;
+     nc->rlink = NULL;
+     ffebld_constant_logical2_ = nc;
+     return nc;
+   }
+  else
+    while (P)
+     {
+       Q = P;
+       cmp = ffetarget_cmp_logical2 (val, ffebld_constant_logical2 (P));
+       if (cmp > 0)
+         P = P->llink;
+       else if (cmp < 0)
+         P = P->rlink;
+       else
+         return P;
+     }
+
+  nc = malloc_new_kp (ffebld_constant_pool(),
+		      "FFEBLD_constLOGICAL2",
+		      sizeof (*nc));
+  nc->consttype = FFEBLD_constLOGICAL2;
+  nc->u.logical2 = val;
+  nc->hook = FFECOM_constantNULL;
+  nc->llink = NULL;
+  nc->rlink = NULL;
+
+  if (cmp < 0)
+    Q->llink = nc;
+  else
+    Q->rlink = nc;
+  return nc;
+}
+
+#endif
+/* ffebld_constant_new_logical3_val -- Return a logical3 constant object
+
+   See prototype.  */
+
+#if FFETARGET_okLOGICAL3
+ffebldConstant
+ffebld_constant_new_logical3_val (ffetargetLogical3 val)
+{
+  ffebldConstant nc;
+  ffebldConstant P;
+  ffebldConstant Q;
+  int cmp = 0;
+  P = ffebld_constant_logical3_;
+  Q = P;
+  if (!P)
+   {
+    /* make this node the root */
+     nc = malloc_new_kp (ffebld_constant_pool(),
+                         "FFEBLD_constLOGICAL3",
+                         sizeof (*nc));
+     nc->consttype = FFEBLD_constLOGICAL3;
+     nc->u.logical3 = val;
+     nc->hook = FFECOM_constantNULL;
+     nc->llink = NULL;
+     nc->rlink = NULL;
+     ffebld_constant_logical3_ = nc;
+     return nc;
+   }
+  else
+    while (P)
+     {
+       Q = P;
+       cmp = ffetarget_cmp_logical3 (val, ffebld_constant_logical3 (P));
+       if (cmp > 0)
+         P = P->llink;
+       else if (cmp < 0)
+         P = P->rlink;
+       else
+         return P;
+     }
+
+  nc = malloc_new_kp (ffebld_constant_pool(),
+		      "FFEBLD_constLOGICAL3",
+		      sizeof (*nc));
+  nc->consttype = FFEBLD_constLOGICAL3;
+  nc->u.logical3 = val;
+  nc->hook = FFECOM_constantNULL;
+  nc->llink = NULL;
+  nc->rlink = NULL;
+
+  if (cmp < 0)
+    Q->llink = nc;
+  else
+    Q->rlink = nc;
+  return nc;
+}
+
+#endif
+/* ffebld_constant_new_logical4_val -- Return a logical4 constant object
+
+   See prototype.  */
+
+#if FFETARGET_okLOGICAL4
+ffebldConstant
+ffebld_constant_new_logical4_val (ffetargetLogical4 val)
+{
+  ffebldConstant nc;
+  ffebldConstant P;
+  ffebldConstant Q;
+  int cmp = 0;
+  P = ffebld_constant_logical4_;
+  Q = P;
+  if (!P)
+   {
+    /* make this node the root */
+     nc = malloc_new_kp (ffebld_constant_pool(),
+                         "FFEBLD_constLOGICAL4",
+                         sizeof (*nc));
+     nc->consttype = FFEBLD_constLOGICAL4;
+     nc->u.logical4 = val;
+     nc->hook = FFECOM_constantNULL;
+     nc->llink = NULL;
+     nc->rlink = NULL;
+     ffebld_constant_logical4_ = nc;
+     return nc;
+   }
+  else
+    while (P)
+     {
+       Q = P;
+       cmp = ffetarget_cmp_logical4 (val, ffebld_constant_logical4 (P));
+       if (cmp > 0)
+         P = P->llink;
+       else if (cmp < 0)
+         P = P->rlink;
+       else
+         return P;
+     }
+
+  nc = malloc_new_kp (ffebld_constant_pool(),
+		      "FFEBLD_constLOGICAL4",
+		      sizeof (*nc));
+  nc->consttype = FFEBLD_constLOGICAL4;
+  nc->u.logical4 = val;
+  nc->hook = FFECOM_constantNULL;
+  nc->llink = NULL;
+  nc->rlink = NULL;
+
+  if (cmp < 0)
+    Q->llink = nc;
+  else
+    Q->rlink = nc;
+  return nc;
+}
+
+#endif
+/* ffebld_constant_new_real1 -- Return real1 constant object from token
+
+   See prototype.  */
+
+#if FFETARGET_okREAL1
+ffebldConstant
+ffebld_constant_new_real1 (ffelexToken integer, ffelexToken decimal,
+      ffelexToken fraction, ffelexToken exponent, ffelexToken exponent_sign,
+			   ffelexToken exponent_digits)
+{
+  ffetargetReal1 val;
+
+  ffetarget_real1 (&val,
+      integer, decimal, fraction, exponent, exponent_sign, exponent_digits);
+  return ffebld_constant_new_real1_val (val);
+}
+
+#endif
+/* ffebld_constant_new_real1_val -- Return an real1 constant object
+
+   See prototype.  */
+
+#if FFETARGET_okREAL1
+ffebldConstant
+ffebld_constant_new_real1_val (ffetargetReal1 val)
+{
+  ffebldConstant nc;
+  ffebldConstant P;
+  ffebldConstant Q;
+  int cmp = 0;
+  P = ffebld_constant_real1_;
+  Q = P;
+  if (!P)
+   {
+    /* make this node the root */
+     nc = malloc_new_kp (ffebld_constant_pool(),
+                         "FFEBLD_constREAL1",
+                         sizeof (*nc));
+     nc->consttype = FFEBLD_constREAL1;
+     nc->u.real1 = val;
+     nc->hook = FFECOM_constantNULL;
+     nc->llink = NULL;
+     nc->rlink = NULL;
+     ffebld_constant_real1_ = nc;
+     return nc;
+   }
+  else
+    while (P)
+     {
+       Q = P;
+       cmp = ffetarget_cmp_real1 (val, ffebld_constant_real1 (P));
+       if (cmp > 0)
+         P = P->llink;
+       else if (cmp < 0)
+         P = P->rlink;
+       else
+         return P;
+     }
+
+  nc = malloc_new_kp (ffebld_constant_pool(),
+		      "FFEBLD_constREAL1",
+		      sizeof (*nc));
+  nc->consttype = FFEBLD_constREAL1;
+  nc->u.real1 = val;
+  nc->hook = FFECOM_constantNULL;
+  nc->llink = NULL;
+  nc->rlink = NULL;
+
+  if (cmp < 0)
+    Q->llink = nc;
+  else
+    Q->rlink = nc;
+  return nc;
+}
+
+#endif
+/* ffebld_constant_new_real2 -- Return real2 constant object from token
+
+   See prototype.  */
+
+#if FFETARGET_okREAL2
+ffebldConstant
+ffebld_constant_new_real2 (ffelexToken integer, ffelexToken decimal,
+      ffelexToken fraction, ffelexToken exponent, ffelexToken exponent_sign,
+			   ffelexToken exponent_digits)
+{
+  ffetargetReal2 val;
+
+  ffetarget_real2 (&val,
+      integer, decimal, fraction, exponent, exponent_sign, exponent_digits);
+  return ffebld_constant_new_real2_val (val);
+}
+
+#endif
+/* ffebld_constant_new_real2_val -- Return an real2 constant object
+
+   See prototype.  */
+
+#if FFETARGET_okREAL2
+ffebldConstant
+ffebld_constant_new_real2_val (ffetargetReal2 val)
+{
+  ffebldConstant nc;
+  ffebldConstant P;
+  ffebldConstant Q;
+  int cmp = 0;
+  P = ffebld_constant_real2_;
+  Q = P;
+  if (!P)
+   {
+    /* make this node the root */
+     nc = malloc_new_kp (ffebld_constant_pool(),
+                         "FFEBLD_constREAL2",
+                         sizeof (*nc));
+     nc->consttype = FFEBLD_constREAL1;
+     nc->u.real2 = val;
+     nc->hook = FFECOM_constantNULL;
+     nc->llink = NULL;
+     nc->rlink = NULL;
+     ffebld_constant_real2_ = nc;
+     return nc;
+   }
+  else
+    while (P)
+     {
+       Q = P;
+       cmp = ffetarget_cmp_real2 (val, ffebld_constant_real2 (P));
+       if (cmp > 0)
+         P = P->llink;
+       else if (cmp < 0)
+         P = P->rlink;
+       else
+         return P;
+     }
+
+  nc = malloc_new_kp (ffebld_constant_pool(),
+		      "FFEBLD_constREAL2",
+		      sizeof (*nc));
+  nc->consttype = FFEBLD_constREAL2;
+  nc->u.real2 = val;
+  nc->hook = FFECOM_constantNULL;
+  nc->llink = NULL;
+  nc->rlink = NULL;
+
+  if (cmp < 0)
+    Q->llink = nc;
+  else
+    Q->rlink = nc;
+  return nc;
+}
+
+#endif
+/* ffebld_constant_new_typeless_bm -- Return typeless constant object from token
+
+   See prototype.
+
+   Parses the token as a decimal integer constant, thus it must be an
+   FFELEX_typeNUMBER.  */
+
+ffebldConstant
+ffebld_constant_new_typeless_bm (ffelexToken t)
+{
+  ffetargetTypeless val;
+
+  ffetarget_binarymil (&val, t);
+  return ffebld_constant_new_typeless_val (FFEBLD_constBINARY_MIL, val);
+}
+
+/* ffebld_constant_new_typeless_bv -- Return typeless constant object from token
+
+   See prototype.
+
+   Parses the token as a decimal integer constant, thus it must be an
+   FFELEX_typeNUMBER.  */
+
+ffebldConstant
+ffebld_constant_new_typeless_bv (ffelexToken t)
+{
+  ffetargetTypeless val;
+
+  ffetarget_binaryvxt (&val, t);
+  return ffebld_constant_new_typeless_val (FFEBLD_constBINARY_VXT, val);
+}
+
+/* ffebld_constant_new_typeless_hxm -- Return typeless constant object from token
+
+   See prototype.
+
+   Parses the token as a decimal integer constant, thus it must be an
+   FFELEX_typeNUMBER.  */
+
+ffebldConstant
+ffebld_constant_new_typeless_hxm (ffelexToken t)
+{
+  ffetargetTypeless val;
+
+  ffetarget_hexxmil (&val, t);
+  return ffebld_constant_new_typeless_val (FFEBLD_constHEX_X_MIL, val);
+}
+
+/* ffebld_constant_new_typeless_hxv -- Return typeless constant object from token
+
+   See prototype.
+
+   Parses the token as a decimal integer constant, thus it must be an
+   FFELEX_typeNUMBER.  */
+
+ffebldConstant
+ffebld_constant_new_typeless_hxv (ffelexToken t)
+{
+  ffetargetTypeless val;
+
+  ffetarget_hexxvxt (&val, t);
+  return ffebld_constant_new_typeless_val (FFEBLD_constHEX_X_VXT, val);
+}
+
+/* ffebld_constant_new_typeless_hzm -- Return typeless constant object from token
+
+   See prototype.
+
+   Parses the token as a decimal integer constant, thus it must be an
+   FFELEX_typeNUMBER.  */
+
+ffebldConstant
+ffebld_constant_new_typeless_hzm (ffelexToken t)
+{
+  ffetargetTypeless val;
+
+  ffetarget_hexzmil (&val, t);
+  return ffebld_constant_new_typeless_val (FFEBLD_constHEX_Z_MIL, val);
+}
+
+/* ffebld_constant_new_typeless_hzv -- Return typeless constant object from token
+
+   See prototype.
+
+   Parses the token as a decimal integer constant, thus it must be an
+   FFELEX_typeNUMBER.  */
+
+ffebldConstant
+ffebld_constant_new_typeless_hzv (ffelexToken t)
+{
+  ffetargetTypeless val;
+
+  ffetarget_hexzvxt (&val, t);
+  return ffebld_constant_new_typeless_val (FFEBLD_constHEX_Z_VXT, val);
+}
+
+/* ffebld_constant_new_typeless_om -- Return typeless constant object from token
+
+   See prototype.
+
+   Parses the token as a decimal integer constant, thus it must be an
+   FFELEX_typeNUMBER.  */
+
+ffebldConstant
+ffebld_constant_new_typeless_om (ffelexToken t)
+{
+  ffetargetTypeless val;
+
+  ffetarget_octalmil (&val, t);
+  return ffebld_constant_new_typeless_val (FFEBLD_constOCTAL_MIL, val);
+}
+
+/* ffebld_constant_new_typeless_ov -- Return typeless constant object from token
+
+   See prototype.
+
+   Parses the token as a decimal integer constant, thus it must be an
+   FFELEX_typeNUMBER.  */
+
+ffebldConstant
+ffebld_constant_new_typeless_ov (ffelexToken t)
+{
+  ffetargetTypeless val;
+
+  ffetarget_octalvxt (&val, t);
+  return ffebld_constant_new_typeless_val (FFEBLD_constOCTAL_VXT, val);
+}
+
+/* ffebld_constant_new_typeless_val -- Return a typeless constant object
+
+   See prototype.  */
+
+ffebldConstant
+ffebld_constant_new_typeless_val (ffebldConst type, ffetargetTypeless val)
+{
+
+  ffebldConstant nc;
+  ffebldConstant P;
+  ffebldConstant Q;
+  int cmp = 0;
+  P = ffebld_constant_typeless_[type
+                            - FFEBLD_constTYPELESS_FIRST];
+  Q = P;
+  if (!P)
+   {
+    /* make this node the root */
+     nc = malloc_new_kp (ffebld_constant_pool(),
+                         "FFEBLD_constTYPELESS",
+                         sizeof (*nc));
+     nc->consttype = type;
+     nc->u.typeless = val;
+     nc->hook = FFECOM_constantNULL;
+     nc->llink = NULL;
+     nc->rlink = NULL;
+     ffebld_constant_typeless_[type- FFEBLD_constTYPELESS_FIRST] = nc;
+     return nc;
+   }
+  else
+    while (P)
+     {
+       Q = P;
+       cmp = ffetarget_cmp_typeless (val, ffebld_constant_typeless (P));
+       if (cmp > 0)
+         P = P->llink;
+       else if (cmp < 0)
+         P = P->rlink;
+       else
+         return P;
+     }
+
+  nc = malloc_new_kp (ffebld_constant_pool(),
+		      "FFEBLD_constTYPELESS",
+		      sizeof (*nc));
+  nc->consttype = type;
+  nc->u.typeless = val;
+  nc->hook = FFECOM_constantNULL;
+  nc->llink = NULL;
+  nc->rlink = NULL;
+
+  if (cmp < 0)
+    Q->llink = nc;
+  else
+    Q->rlink = nc;
+  return nc;
+}
+
+/* ffebld_constantarray_get -- Get a value from an array of constants
+
+   See prototype.  */
+
+ffebldConstantUnion
+ffebld_constantarray_get (ffebldConstantArray array, ffeinfoBasictype bt,
+			  ffeinfoKindtype kt, ffetargetOffset offset)
+{
+  ffebldConstantUnion u;
+
+  switch (bt)
+    {
+    case FFEINFO_basictypeINTEGER:
+      switch (kt)
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  u.integer1 = *(array.integer1 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  u.integer2 = *(array.integer2 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  u.integer3 = *(array.integer3 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  u.integer4 = *(array.integer4 + offset);
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      switch (kt)
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  u.logical1 = *(array.logical1 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  u.logical2 = *(array.logical2 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  u.logical3 = *(array.logical3 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  u.logical4 = *(array.logical4 + offset);
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (kt)
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  u.real1 = *(array.real1 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  u.real2 = *(array.real2 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  u.real3 = *(array.real3 + offset);
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (kt)
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  u.complex1 = *(array.complex1 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  u.complex2 = *(array.complex2 + offset);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  u.complex3 = *(array.complex3 + offset);
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (kt)
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  u.character1.length = 1;
+	  u.character1.text = array.character1 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad basictype" == NULL);
+      break;
+    }
+
+  return u;
+}
+
+/* ffebld_constantarray_new -- Make an array of constants
+
+   See prototype.  */
+
+ffebldConstantArray
+ffebld_constantarray_new (ffeinfoBasictype bt,
+			  ffeinfoKindtype kt, ffetargetOffset size)
+{
+  ffebldConstantArray ptr;
+
+  switch (bt)
+    {
+    case FFEINFO_basictypeINTEGER:
+      switch (kt)
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  ptr.integer1 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetInteger1),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  ptr.integer2 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetInteger2),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  ptr.integer3 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetInteger3),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  ptr.integer4 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetInteger4),
+					 0);
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      switch (kt)
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  ptr.logical1 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetLogical1),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  ptr.logical2 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetLogical2),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  ptr.logical3 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetLogical3),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  ptr.logical4 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetLogical4),
+					 0);
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (kt)
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  ptr.real1 = malloc_new_zkp (ffebld_constant_pool(),
+				      "ffebldConstantArray",
+				      size *= sizeof (ffetargetReal1),
+				      0);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  ptr.real2 = malloc_new_zkp (ffebld_constant_pool(),
+				      "ffebldConstantArray",
+				      size *= sizeof (ffetargetReal2),
+				      0);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  ptr.real3 = malloc_new_zkp (ffebld_constant_pool(),
+				      "ffebldConstantArray",
+				      size *= sizeof (ffetargetReal3),
+				      0);
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (kt)
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  ptr.complex1 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetComplex1),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  ptr.complex2 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetComplex2),
+					 0);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  ptr.complex3 = malloc_new_zkp (ffebld_constant_pool(),
+					 "ffebldConstantArray",
+					 size *= sizeof (ffetargetComplex3),
+					 0);
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (kt)
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  ptr.character1 = malloc_new_zkp (ffebld_constant_pool(),
+					   "ffebldConstantArray",
+					   size
+					   *= sizeof (ffetargetCharacterUnit1),
+					   0);
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad basictype" == NULL);
+      break;
+    }
+
+  return ptr;
+}
+
+/* ffebld_constantarray_preparray -- Prepare for copy between arrays
+
+   See prototype.
+
+   Like _prepare, but the source is an array instead of a single-value
+   constant.  */
+
+void
+ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size,
+       ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
+		   ffetargetOffset offset, ffebldConstantArray source_array,
+				ffeinfoBasictype cbt, ffeinfoKindtype ckt)
+{
+  switch (abt)
+    {
+    case FFEINFO_basictypeINTEGER:
+      switch (akt)
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  *aptr = array.integer1 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  *aptr = array.integer2 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  *aptr = array.integer3 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  *aptr = array.integer4 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER akindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      switch (akt)
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  *aptr = array.logical1 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  *aptr = array.logical2 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  *aptr = array.logical3 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  *aptr = array.logical4 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL akindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (akt)
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  *aptr = array.real1 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  *aptr = array.real2 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  *aptr = array.real3 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL akindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (akt)
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  *aptr = array.complex1 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  *aptr = array.complex2 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  *aptr = array.complex3 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX akindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (akt)
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  *aptr = array.character1 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER akindtype" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad abasictype" == NULL);
+      break;
+    }
+
+  switch (cbt)
+    {
+    case FFEINFO_basictypeINTEGER:
+      switch (ckt)
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  *cptr = source_array.integer1;
+	  *size = sizeof (*source_array.integer1);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  *cptr = source_array.integer2;
+	  *size = sizeof (*source_array.integer2);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  *cptr = source_array.integer3;
+	  *size = sizeof (*source_array.integer3);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  *cptr = source_array.integer4;
+	  *size = sizeof (*source_array.integer4);
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER ckindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      switch (ckt)
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  *cptr = source_array.logical1;
+	  *size = sizeof (*source_array.logical1);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  *cptr = source_array.logical2;
+	  *size = sizeof (*source_array.logical2);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  *cptr = source_array.logical3;
+	  *size = sizeof (*source_array.logical3);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  *cptr = source_array.logical4;
+	  *size = sizeof (*source_array.logical4);
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL ckindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (ckt)
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  *cptr = source_array.real1;
+	  *size = sizeof (*source_array.real1);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  *cptr = source_array.real2;
+	  *size = sizeof (*source_array.real2);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  *cptr = source_array.real3;
+	  *size = sizeof (*source_array.real3);
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL ckindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (ckt)
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  *cptr = source_array.complex1;
+	  *size = sizeof (*source_array.complex1);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  *cptr = source_array.complex2;
+	  *size = sizeof (*source_array.complex2);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  *cptr = source_array.complex3;
+	  *size = sizeof (*source_array.complex3);
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX ckindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (ckt)
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  *cptr = source_array.character1;
+	  *size = sizeof (*source_array.character1);
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER ckindtype" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad cbasictype" == NULL);
+      break;
+    }
+}
+
+/* ffebld_constantarray_prepare -- Prepare for copy between value and array
+
+   See prototype.
+
+   Like _put, but just returns the pointers to the beginnings of the
+   array and the constant and returns the size (the amount of info to
+   copy).  The idea is that the caller can use memcpy to accomplish the
+   same thing as _put (though slower), or the caller can use a different
+   function that swaps bytes, words, etc for a different target machine.
+   Also, the type of the array may be different from the type of the
+   constant; the array type is used to determine the meaning (scale) of
+   the offset field (to calculate the array pointer), the constant type is
+   used to determine the constant pointer and the size (amount of info to
+   copy).  */
+
+void
+ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size,
+       ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
+		      ffetargetOffset offset, ffebldConstantUnion *constant,
+			      ffeinfoBasictype cbt, ffeinfoKindtype ckt)
+{
+  switch (abt)
+    {
+    case FFEINFO_basictypeINTEGER:
+      switch (akt)
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  *aptr = array.integer1 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  *aptr = array.integer2 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  *aptr = array.integer3 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  *aptr = array.integer4 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER akindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      switch (akt)
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  *aptr = array.logical1 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  *aptr = array.logical2 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  *aptr = array.logical3 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  *aptr = array.logical4 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL akindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (akt)
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  *aptr = array.real1 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  *aptr = array.real2 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  *aptr = array.real3 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL akindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (akt)
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  *aptr = array.complex1 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  *aptr = array.complex2 + offset;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  *aptr = array.complex3 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX akindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (akt)
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  *aptr = array.character1 + offset;
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER akindtype" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad abasictype" == NULL);
+      break;
+    }
+
+  switch (cbt)
+    {
+    case FFEINFO_basictypeINTEGER:
+      switch (ckt)
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  *cptr = &constant->integer1;
+	  *size = sizeof (constant->integer1);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  *cptr = &constant->integer2;
+	  *size = sizeof (constant->integer2);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  *cptr = &constant->integer3;
+	  *size = sizeof (constant->integer3);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  *cptr = &constant->integer4;
+	  *size = sizeof (constant->integer4);
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER ckindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      switch (ckt)
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  *cptr = &constant->logical1;
+	  *size = sizeof (constant->logical1);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  *cptr = &constant->logical2;
+	  *size = sizeof (constant->logical2);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  *cptr = &constant->logical3;
+	  *size = sizeof (constant->logical3);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  *cptr = &constant->logical4;
+	  *size = sizeof (constant->logical4);
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL ckindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (ckt)
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  *cptr = &constant->real1;
+	  *size = sizeof (constant->real1);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  *cptr = &constant->real2;
+	  *size = sizeof (constant->real2);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  *cptr = &constant->real3;
+	  *size = sizeof (constant->real3);
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL ckindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (ckt)
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  *cptr = &constant->complex1;
+	  *size = sizeof (constant->complex1);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  *cptr = &constant->complex2;
+	  *size = sizeof (constant->complex2);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  *cptr = &constant->complex3;
+	  *size = sizeof (constant->complex3);
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX ckindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (ckt)
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  *cptr = ffetarget_text_character1 (constant->character1);
+	  *size = ffetarget_length_character1 (constant->character1);
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER ckindtype" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad cbasictype" == NULL);
+      break;
+    }
+}
+
+/* ffebld_constantarray_put -- Put a value into an array of constants
+
+   See prototype.  */
+
+void
+ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt,
+   ffeinfoKindtype kt, ffetargetOffset offset, ffebldConstantUnion constant)
+{
+  switch (bt)
+    {
+    case FFEINFO_basictypeINTEGER:
+      switch (kt)
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  *(array.integer1 + offset) = constant.integer1;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  *(array.integer2 + offset) = constant.integer2;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  *(array.integer3 + offset) = constant.integer3;
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  *(array.integer4 + offset) = constant.integer4;
+	  break;
+#endif
+
+	default:
+	  assert ("bad INTEGER kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      switch (kt)
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  *(array.logical1 + offset) = constant.logical1;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  *(array.logical2 + offset) = constant.logical2;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  *(array.logical3 + offset) = constant.logical3;
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  *(array.logical4 + offset) = constant.logical4;
+	  break;
+#endif
+
+	default:
+	  assert ("bad LOGICAL kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (kt)
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  *(array.real1 + offset) = constant.real1;
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  *(array.real2 + offset) = constant.real2;
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  *(array.real3 + offset) = constant.real3;
+	  break;
+#endif
+
+	default:
+	  assert ("bad REAL kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (kt)
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  *(array.complex1 + offset) = constant.complex1;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  *(array.complex2 + offset) = constant.complex2;
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  *(array.complex3 + offset) = constant.complex3;
+	  break;
+#endif
+
+	default:
+	  assert ("bad COMPLEX kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (kt)
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  memcpy (array.character1 + offset,
+		  ffetarget_text_character1 (constant.character1),
+		  ffetarget_length_character1 (constant.character1));
+	  break;
+#endif
+
+	default:
+	  assert ("bad CHARACTER kindtype" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad basictype" == NULL);
+      break;
+    }
+}
+
+/* ffebld_init_0 -- Initialize the module
+
+   ffebld_init_0();  */
+
+void
+ffebld_init_0 (void)
+{
+  assert (FFEBLD_op == ARRAY_SIZE (ffebld_op_string_));
+  assert (FFEBLD_op == ARRAY_SIZE (ffebld_arity_op_));
+}
+
+/* ffebld_init_1 -- Initialize the module for a file
+
+   ffebld_init_1();  */
+
+void
+ffebld_init_1 (void)
+{
+#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_
+  int i;
+
+#if FFETARGET_okCHARACTER1
+  ffebld_constant_character1_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX1
+  ffebld_constant_complex1_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX2
+  ffebld_constant_complex2_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX3
+  ffebld_constant_complex3_ = NULL;
+#endif
+#if FFETARGET_okINTEGER1
+  ffebld_constant_integer1_ = NULL;
+#endif
+#if FFETARGET_okINTEGER2
+  ffebld_constant_integer2_ = NULL;
+#endif
+#if FFETARGET_okINTEGER3
+  ffebld_constant_integer3_ = NULL;
+#endif
+#if FFETARGET_okINTEGER4
+  ffebld_constant_integer4_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL1
+  ffebld_constant_logical1_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL2
+  ffebld_constant_logical2_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL3
+  ffebld_constant_logical3_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL4
+  ffebld_constant_logical4_ = NULL;
+#endif
+#if FFETARGET_okREAL1
+  ffebld_constant_real1_ = NULL;
+#endif
+#if FFETARGET_okREAL2
+  ffebld_constant_real2_ = NULL;
+#endif
+#if FFETARGET_okREAL3
+  ffebld_constant_real3_ = NULL;
+#endif
+  ffebld_constant_hollerith_ = NULL;
+  for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
+    ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
+#endif
+}
+
+/* ffebld_init_2 -- Initialize the module
+
+   ffebld_init_2();  */
+
+void
+ffebld_init_2 (void)
+{
+#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
+  int i;
+#endif
+
+  ffebld_pool_stack_.next = NULL;
+  ffebld_pool_stack_.pool = ffe_pool_program_unit ();
+#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
+#if FFETARGET_okCHARACTER1
+  ffebld_constant_character1_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX1
+  ffebld_constant_complex1_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX2
+  ffebld_constant_complex2_ = NULL;
+#endif
+#if FFETARGET_okCOMPLEX3
+  ffebld_constant_complex3_ = NULL;
+#endif
+#if FFETARGET_okINTEGER1
+  ffebld_constant_integer1_ = NULL;
+#endif
+#if FFETARGET_okINTEGER2
+  ffebld_constant_integer2_ = NULL;
+#endif
+#if FFETARGET_okINTEGER3
+  ffebld_constant_integer3_ = NULL;
+#endif
+#if FFETARGET_okINTEGER4
+  ffebld_constant_integer4_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL1
+  ffebld_constant_logical1_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL2
+  ffebld_constant_logical2_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL3
+  ffebld_constant_logical3_ = NULL;
+#endif
+#if FFETARGET_okLOGICAL4
+  ffebld_constant_logical4_ = NULL;
+#endif
+#if FFETARGET_okREAL1
+  ffebld_constant_real1_ = NULL;
+#endif
+#if FFETARGET_okREAL2
+  ffebld_constant_real2_ = NULL;
+#endif
+#if FFETARGET_okREAL3
+  ffebld_constant_real3_ = NULL;
+#endif
+  ffebld_constant_hollerith_ = NULL;
+  for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
+    ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
+#endif
+}
+
+/* ffebld_list_length -- Return # of opITEMs in list
+
+   ffebld list;	 // Must be NULL or opITEM
+   ffebldListLength length;
+   length = ffebld_list_length(list);
+
+   Returns 0 if list is NULL, 1 if it's ffebld_trail is NULL, and so on.  */
+
+ffebldListLength
+ffebld_list_length (ffebld list)
+{
+  ffebldListLength length;
+
+  for (length = 0; list != NULL; ++length, list = ffebld_trail (list))
+    ;
+
+  return length;
+}
+
+/* ffebld_new_accter -- Create an ffebld object that is an array
+
+   ffebld x;
+   ffebldConstantArray a;
+   ffebit b;
+   x = ffebld_new_accter(a,b);	*/
+
+ffebld
+ffebld_new_accter (ffebldConstantArray a, ffebit b)
+{
+  ffebld x;
+
+  x = ffebld_new ();
+  x->op = FFEBLD_opACCTER;
+  x->u.accter.array = a;
+  x->u.accter.bits = b;
+  x->u.accter.pad = 0;
+  return x;
+}
+
+/* ffebld_new_arrter -- Create an ffebld object that is an array
+
+   ffebld x;
+   ffebldConstantArray a;
+   ffetargetOffset size;
+   x = ffebld_new_arrter(a,size);  */
+
+ffebld
+ffebld_new_arrter (ffebldConstantArray a, ffetargetOffset size)
+{
+  ffebld x;
+
+  x = ffebld_new ();
+  x->op = FFEBLD_opARRTER;
+  x->u.arrter.array = a;
+  x->u.arrter.size = size;
+  x->u.arrter.pad = 0;
+  return x;
+}
+
+/* ffebld_new_conter_with_orig -- Create an ffebld object that is a constant
+
+   ffebld x;
+   ffebldConstant c;
+   x = ffebld_new_conter_with_orig(c,NULL);  */
+
+ffebld
+ffebld_new_conter_with_orig (ffebldConstant c, ffebld o)
+{
+  ffebld x;
+
+  x = ffebld_new ();
+  x->op = FFEBLD_opCONTER;
+  x->u.conter.expr = c;
+  x->u.conter.orig = o;
+  x->u.conter.pad = 0;
+  return x;
+}
+
+/* ffebld_new_item -- Create an ffebld item object
+
+   ffebld x,y,z;
+   x = ffebld_new_item(y,z);  */
+
+ffebld
+ffebld_new_item (ffebld head, ffebld trail)
+{
+  ffebld x;
+
+  x = ffebld_new ();
+  x->op = FFEBLD_opITEM;
+  x->u.item.head = head;
+  x->u.item.trail = trail;
+  return x;
+}
+
+/* ffebld_new_labter -- Create an ffebld object that is a label
+
+   ffebld x;
+   ffelab l;
+   x = ffebld_new_labter(c);  */
+
+ffebld
+ffebld_new_labter (ffelab l)
+{
+  ffebld x;
+
+  x = ffebld_new ();
+  x->op = FFEBLD_opLABTER;
+  x->u.labter = l;
+  return x;
+}
+
+/* ffebld_new_labtok -- Create object that is a label's NUMBER token
+
+   ffebld x;
+   ffelexToken t;
+   x = ffebld_new_labter(c);
+
+   Like the other ffebld_new_ functions, the
+   supplied argument is stored exactly as is: ffelex_token_use is NOT
+   called, so the token is "consumed", if one is indeed supplied (it may
+   be NULL).  */
+
+ffebld
+ffebld_new_labtok (ffelexToken t)
+{
+  ffebld x;
+
+  x = ffebld_new ();
+  x->op = FFEBLD_opLABTOK;
+  x->u.labtok = t;
+  return x;
+}
+
+/* ffebld_new_none -- Create an ffebld object with no arguments
+
+   ffebld x;
+   x = ffebld_new_none(FFEBLD_opWHATEVER);  */
+
+ffebld
+ffebld_new_none (ffebldOp o)
+{
+  ffebld x;
+
+  x = ffebld_new ();
+  x->op = o;
+  return x;
+}
+
+/* ffebld_new_one -- Create an ffebld object with one argument
+
+   ffebld x,y;
+   x = ffebld_new_one(FFEBLD_opWHATEVER,y);  */
+
+ffebld
+ffebld_new_one (ffebldOp o, ffebld left)
+{
+  ffebld x;
+
+  x = ffebld_new ();
+  x->op = o;
+  x->u.nonter.left = left;
+  x->u.nonter.hook = FFECOM_nonterNULL;
+  return x;
+}
+
+/* ffebld_new_symter -- Create an ffebld object that is a symbol
+
+   ffebld x;
+   ffesymbol s;
+   ffeintrinGen gen;	// Generic intrinsic id, if any
+   ffeintrinSpec spec;	// Specific intrinsic id, if any
+   ffeintrinImp imp;	// Implementation intrinsic id, if any
+   x = ffebld_new_symter (s, gen, spec, imp);  */
+
+ffebld
+ffebld_new_symter (ffesymbol s, ffeintrinGen gen, ffeintrinSpec spec,
+		   ffeintrinImp imp)
+{
+  ffebld x;
+
+  x = ffebld_new ();
+  x->op = FFEBLD_opSYMTER;
+  x->u.symter.symbol = s;
+  x->u.symter.generic = gen;
+  x->u.symter.specific = spec;
+  x->u.symter.implementation = imp;
+  x->u.symter.do_iter = FALSE;
+  return x;
+}
+
+/* ffebld_new_two -- Create an ffebld object with two arguments
+
+   ffebld x,y,z;
+   x = ffebld_new_two(FFEBLD_opWHATEVER,y,z);  */
+
+ffebld
+ffebld_new_two (ffebldOp o, ffebld left, ffebld right)
+{
+  ffebld x;
+
+  x = ffebld_new ();
+  x->op = o;
+  x->u.nonter.left = left;
+  x->u.nonter.right = right;
+  x->u.nonter.hook = FFECOM_nonterNULL;
+  return x;
+}
+
+/* ffebld_pool_pop -- Pop ffebld's pool stack
+
+   ffebld_pool_pop();  */
+
+void
+ffebld_pool_pop (void)
+{
+  ffebldPoolstack_ ps;
+
+  assert (ffebld_pool_stack_.next != NULL);
+  ps = ffebld_pool_stack_.next;
+  ffebld_pool_stack_.next = ps->next;
+  ffebld_pool_stack_.pool = ps->pool;
+  malloc_kill_ks (malloc_pool_image (), ps, sizeof (*ps));
+}
+
+/* ffebld_pool_push -- Push ffebld's pool stack
+
+   ffebld_pool_push();	*/
+
+void
+ffebld_pool_push (mallocPool pool)
+{
+  ffebldPoolstack_ ps;
+
+  ps = malloc_new_ks (malloc_pool_image (), "Pool stack", sizeof (*ps));
+  ps->next = ffebld_pool_stack_.next;
+  ps->pool = ffebld_pool_stack_.pool;
+  ffebld_pool_stack_.next = ps;
+  ffebld_pool_stack_.pool = pool;
+}
+
+/* ffebld_op_string -- Return short string describing op
+
+   ffebldOp o;
+   ffebld_op_string(o);
+
+   Returns a short string (uppercase) containing the name of the op.  */
+
+const char *
+ffebld_op_string (ffebldOp o)
+{
+  if (o >= ARRAY_SIZE (ffebld_op_string_))
+    return "?\?\?";
+  return ffebld_op_string_[o];
+}
+
+/* ffebld_size_max -- Return maximum possible size of CHARACTER-type expr
+
+   ffetargetCharacterSize sz;
+   ffebld b;
+   sz = ffebld_size_max (b);
+
+   Like ffebld_size_known, but if that would return NONE and the expression
+   is opSUBSTR, opCONVERT, opPAREN, or opCONCATENATE, returns ffebld_size_max
+   of the subexpression(s).  */
+
+ffetargetCharacterSize
+ffebld_size_max (ffebld b)
+{
+  ffetargetCharacterSize sz;
+
+recurse:			/* :::::::::::::::::::: */
+
+  sz = ffebld_size_known (b);
+
+  if (sz != FFETARGET_charactersizeNONE)
+    return sz;
+
+  switch (ffebld_op (b))
+    {
+    case FFEBLD_opSUBSTR:
+    case FFEBLD_opCONVERT:
+    case FFEBLD_opPAREN:
+      b = ffebld_left (b);
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFEBLD_opCONCATENATE:
+      sz = ffebld_size_max (ffebld_left (b))
+	+ ffebld_size_max (ffebld_right (b));
+      return sz;
+
+    default:
+      return sz;
+    }
+}
diff --git a/gcc/f/bld.h b/gcc/f/bld.h
new file mode 100644
index 00000000000..900b5dea019
--- /dev/null
+++ b/gcc/f/bld.h
@@ -0,0 +1,748 @@
+/* bld.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      bld.c
+
+   Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef GCC_F_BLD_H
+#define GCC_F_BLD_H
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+  {
+    FFEBLD_constNONE,
+    FFEBLD_constINTEGER1,
+    FFEBLD_constINTEGER2,
+    FFEBLD_constINTEGER3,
+    FFEBLD_constINTEGER4,
+    FFEBLD_constINTEGER5,
+    FFEBLD_constINTEGER6,
+    FFEBLD_constINTEGER7,
+    FFEBLD_constINTEGER8,
+    FFEBLD_constLOGICAL1,
+    FFEBLD_constLOGICAL2,
+    FFEBLD_constLOGICAL3,
+    FFEBLD_constLOGICAL4,
+    FFEBLD_constLOGICAL5,
+    FFEBLD_constLOGICAL6,
+    FFEBLD_constLOGICAL7,
+    FFEBLD_constLOGICAL8,
+    FFEBLD_constREAL1,
+    FFEBLD_constREAL2,
+    FFEBLD_constREAL3,
+    FFEBLD_constREAL4,
+    FFEBLD_constREAL5,
+    FFEBLD_constREAL6,
+    FFEBLD_constREAL7,
+    FFEBLD_constREAL8,
+    FFEBLD_constCOMPLEX1,
+    FFEBLD_constCOMPLEX2,
+    FFEBLD_constCOMPLEX3,
+    FFEBLD_constCOMPLEX4,
+    FFEBLD_constCOMPLEX5,
+    FFEBLD_constCOMPLEX6,
+    FFEBLD_constCOMPLEX7,
+    FFEBLD_constCOMPLEX8,
+    FFEBLD_constCHARACTER1,
+    FFEBLD_constCHARACTER2,
+    FFEBLD_constCHARACTER3,
+    FFEBLD_constCHARACTER4,
+    FFEBLD_constCHARACTER5,
+    FFEBLD_constCHARACTER6,
+    FFEBLD_constCHARACTER7,
+    FFEBLD_constCHARACTER8,
+    FFEBLD_constHOLLERITH,
+    FFEBLD_constTYPELESS_FIRST,
+    FFEBLD_constBINARY_MIL = FFEBLD_constTYPELESS_FIRST,
+    FFEBLD_constBINARY_VXT,
+    FFEBLD_constOCTAL_MIL,
+    FFEBLD_constOCTAL_VXT,
+    FFEBLD_constHEX_X_MIL,
+    FFEBLD_constHEX_X_VXT,
+    FFEBLD_constHEX_Z_MIL,
+    FFEBLD_constHEX_Z_VXT,
+    FFEBLD_constTYPELESS_LAST = FFEBLD_constHEX_Z_VXT,
+    FFEBLD_const
+  } ffebldConst;
+
+typedef enum
+  {
+#define FFEBLD_OP(KWD,NAME,ARITY) KWD,
+#include "bld-op.def"
+#undef FFEBLD_OP
+    FFEBLD_op
+  } ffebldOp;
+
+/* Typedefs. */
+
+typedef struct _ffebld_ *ffebld;
+typedef unsigned char ffebldArity;
+typedef union _ffebld_constant_array_ ffebldConstantArray;
+typedef struct _ffebld_constant_ *ffebldConstant;
+typedef union _ffebld_constant_union_ ffebldConstantUnion;
+typedef ffebld *ffebldListBottom;
+typedef unsigned int ffebldListLength;
+#define ffebldListLength_f ""
+typedef struct _ffebld_pool_stack_ *ffebldPoolstack_;
+
+/* Include files needed by this one. */
+
+#include "bit.h"
+#include "com.h"
+#include "info.h"
+#include "intrin.h"
+#include "lab.h"
+#include "lex.h"
+#include "malloc.h"
+#include "symbol.h"
+#include "target.h"
+
+#define FFEBLD_whereconstPROGUNIT_ 1
+#define FFEBLD_whereconstFILE_ 2
+
+#define FFEBLD_whereconstCURRENT_ FFEBLD_whereconstFILE_
+
+/* Structure definitions. */
+
+#define FFEBLD_constINTEGERDEFAULT FFEBLD_constINTEGER1
+#define FFEBLD_constLOGICALDEFAULT FFEBLD_constLOGICAL1
+#define FFEBLD_constREALDEFAULT FFEBLD_constREAL1
+#define FFEBLD_constREALDOUBLE FFEBLD_constREAL2
+#define FFEBLD_constREALQUAD FFEBLD_constREAL3
+#define FFEBLD_constCOMPLEX FFEBLD_constCOMPLEX1
+#define FFEBLD_constCOMPLEXDOUBLE FFEBLD_constCOMPLEX2
+#define FFEBLD_constCOMPLEXQUAD FFEBLD_constCOMPLEX3
+#define FFEBLD_constCHARACTERDEFAULT FFEBLD_constCHARACTER1
+
+union _ffebld_constant_union_
+  {
+    ffetargetTypeless typeless;
+    ffetargetHollerith hollerith;
+#if FFETARGET_okINTEGER1
+    ffetargetInteger1 integer1;
+#endif
+#if FFETARGET_okINTEGER2
+    ffetargetInteger2 integer2;
+#endif
+#if FFETARGET_okINTEGER3
+    ffetargetInteger3 integer3;
+#endif
+#if FFETARGET_okINTEGER4
+    ffetargetInteger4 integer4;
+#endif
+#if FFETARGET_okLOGICAL1
+    ffetargetLogical1 logical1;
+#endif
+#if FFETARGET_okLOGICAL2
+    ffetargetLogical2 logical2;
+#endif
+#if FFETARGET_okLOGICAL3
+    ffetargetLogical3 logical3;
+#endif
+#if FFETARGET_okLOGICAL4
+    ffetargetLogical4 logical4;
+#endif
+#if FFETARGET_okREAL1
+    ffetargetReal1 real1;
+#endif
+#if FFETARGET_okREAL2
+    ffetargetReal2 real2;
+#endif
+#if FFETARGET_okREAL3
+    ffetargetReal3 real3;
+#endif
+#if FFETARGET_okCOMPLEX1
+    ffetargetComplex1 complex1;
+#endif
+#if FFETARGET_okCOMPLEX2
+    ffetargetComplex2 complex2;
+#endif
+#if FFETARGET_okCOMPLEX3
+    ffetargetComplex3 complex3;
+#endif
+#if FFETARGET_okCHARACTER1
+    ffetargetCharacter1 character1;
+#endif
+  };
+
+union _ffebld_constant_array_
+  {
+#if FFETARGET_okINTEGER1
+    ffetargetInteger1 *integer1;
+#endif
+#if FFETARGET_okINTEGER2
+    ffetargetInteger2 *integer2;
+#endif
+#if FFETARGET_okINTEGER3
+    ffetargetInteger3 *integer3;
+#endif
+#if FFETARGET_okINTEGER4
+    ffetargetInteger4 *integer4;
+#endif
+#if FFETARGET_okLOGICAL1
+    ffetargetLogical1 *logical1;
+#endif
+#if FFETARGET_okLOGICAL2
+    ffetargetLogical2 *logical2;
+#endif
+#if FFETARGET_okLOGICAL3
+    ffetargetLogical3 *logical3;
+#endif
+#if FFETARGET_okLOGICAL4
+    ffetargetLogical4 *logical4;
+#endif
+#if FFETARGET_okREAL1
+    ffetargetReal1 *real1;
+#endif
+#if FFETARGET_okREAL2
+    ffetargetReal2 *real2;
+#endif
+#if FFETARGET_okREAL3
+    ffetargetReal3 *real3;
+#endif
+#if FFETARGET_okCOMPLEX1
+    ffetargetComplex1 *complex1;
+#endif
+#if FFETARGET_okCOMPLEX2
+    ffetargetComplex2 *complex2;
+#endif
+#if FFETARGET_okCOMPLEX3
+    ffetargetComplex3 *complex3;
+#endif
+#if FFETARGET_okCHARACTER1
+    ffetargetCharacterUnit1 *character1;
+#endif
+  };
+
+struct _ffebld_
+  {
+    ffebldOp op;
+    ffeinfo info;		/* Not used or valid for
+				   op=={STAR,ITEM,BOUNDS,REPEAT,LABTER,
+				   LABTOK,IMPDO}. */
+    union
+      {
+	struct
+	  {
+	    ffebld left;
+	    ffebld right;
+	    ffecomNonter hook;	/* Whatever the compiler/backend wants! */
+	  }
+	nonter;
+	struct
+	  {
+	    ffebld head;
+	    ffebld trail;
+	  }
+	item;
+	struct
+	  {
+	    ffebldConstant expr;
+	    ffebld orig;	/* Original expression, or NULL if none. */
+	    ffetargetAlign pad;	/* Initial padding (for DATA, etc.). */
+	  }
+	conter;
+	struct
+	  {
+	    ffebldConstantArray array;
+	    ffetargetOffset size;
+	    ffetargetAlign pad;	/* Initial padding (for DATA, etc.). */
+	  }
+	arrter;
+	struct
+	  {
+	    ffebldConstantArray array;
+	    ffebit bits;
+	    ffetargetAlign pad;	/* Initial padding (for DATA, etc.). */
+	  }
+	accter;
+	struct
+	  {
+	    ffesymbol symbol;
+	    ffeintrinGen generic;	/* Id for generic intrinsic. */
+	    ffeintrinSpec specific;	/* Id for specific intrinsic. */
+	    ffeintrinImp implementation;	/* Id for implementation. */
+	    bool do_iter;	/* TRUE if this ref is a read-only ref by
+				   definition (ref within DO loop using this
+				   var as iterator). */
+	  }
+	symter;
+	ffelab labter;
+	ffelexToken labtok;
+      }
+    u;
+  };
+
+struct _ffebld_constant_
+  {
+    ffebldConstant rlink;
+    ffebldConstant llink;
+    ffebldConstant first_complex;	/* First complex const with me as
+					   real. */
+    ffebldConst consttype;
+    ffecomConstant hook;	/* Whatever the compiler/backend wants! */
+    bool numeric;		/* A numeric kind of constant. */
+    ffebldConstantUnion u;
+  };
+
+struct _ffebld_pool_stack_
+  {
+    ffebldPoolstack_ next;
+    mallocPool pool;
+  };
+
+/* Global objects accessed by users of this module. */
+
+extern const ffebldArity ffebld_arity_op_[(int) FFEBLD_op];
+extern struct _ffebld_pool_stack_ ffebld_pool_stack_;
+
+/* Declare functions with prototypes. */
+
+int ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2);
+bool ffebld_constant_is_magical (ffebldConstant c);
+bool ffebld_constant_is_zero (ffebldConstant c);
+#if FFETARGET_okCHARACTER1
+ffebldConstant ffebld_constant_new_character1 (ffelexToken t);
+ffebldConstant ffebld_constant_new_character1_val (ffetargetCharacter1 val);
+#endif
+#if FFETARGET_okCOMPLEX1
+ffebldConstant ffebld_constant_new_complex1 (ffebldConstant real,
+					     ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex1_val (ffetargetComplex1 val);
+#endif
+#if FFETARGET_okCOMPLEX2
+ffebldConstant ffebld_constant_new_complex2 (ffebldConstant real,
+					     ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex2_val (ffetargetComplex2 val);
+#endif
+#if FFETARGET_okCOMPLEX3
+ffebldConstant ffebld_constant_new_complex3 (ffebldConstant real,
+					     ffebldConstant imaginary);
+ffebldConstant ffebld_constant_new_complex3_val (ffetargetComplex3 val);
+#endif
+ffebldConstant ffebld_constant_new_hollerith (ffelexToken t);
+ffebldConstant ffebld_constant_new_hollerith_val (ffetargetHollerith val);
+#if FFETARGET_okINTEGER1
+ffebldConstant ffebld_constant_new_integer1 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer1_val (ffetargetInteger1 val);
+#endif
+#if FFETARGET_okINTEGER2
+ffebldConstant ffebld_constant_new_integer2 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer2_val (ffetargetInteger2 val);
+#endif
+#if FFETARGET_okINTEGER3
+ffebldConstant ffebld_constant_new_integer3 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer3_val (ffetargetInteger3 val);
+#endif
+#if FFETARGET_okINTEGER4
+ffebldConstant ffebld_constant_new_integer4 (ffelexToken t);
+ffebldConstant ffebld_constant_new_integer4_val (ffetargetInteger4 val);
+#endif
+ffebldConstant ffebld_constant_new_integerbinary (ffelexToken t);
+ffebldConstant ffebld_constant_new_integerhex (ffelexToken t);
+ffebldConstant ffebld_constant_new_integeroctal (ffelexToken t);
+#if FFETARGET_okLOGICAL1
+ffebldConstant ffebld_constant_new_logical1 (bool truth);
+ffebldConstant ffebld_constant_new_logical1_val (ffetargetLogical1 val);
+#endif
+#if FFETARGET_okLOGICAL2
+ffebldConstant ffebld_constant_new_logical2 (bool truth);
+ffebldConstant ffebld_constant_new_logical2_val (ffetargetLogical2 val);
+#endif
+#if FFETARGET_okLOGICAL3
+ffebldConstant ffebld_constant_new_logical3 (bool truth);
+ffebldConstant ffebld_constant_new_logical3_val (ffetargetLogical3 val);
+#endif
+#if FFETARGET_okLOGICAL4
+ffebldConstant ffebld_constant_new_logical4 (bool truth);
+ffebldConstant ffebld_constant_new_logical4_val (ffetargetLogical4 val);
+#endif
+#if FFETARGET_okREAL1
+ffebldConstant ffebld_constant_new_real1 (ffelexToken integer,
+	    ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+		    ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real1_val (ffetargetReal1 val);
+#endif
+#if FFETARGET_okREAL2
+ffebldConstant ffebld_constant_new_real2 (ffelexToken integer,
+	    ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+		    ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real2_val (ffetargetReal2 val);
+#endif
+#if FFETARGET_okREAL3
+ffebldConstant ffebld_constant_new_real3 (ffelexToken integer,
+	    ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+		    ffelexToken exponent_sign, ffelexToken exponent_digits);
+ffebldConstant ffebld_constant_new_real3_val (ffetargetReal3 val);
+#endif
+ffebldConstant ffebld_constant_new_typeless_bm (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_bv (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_hxm (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_hxv (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_hzm (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_hzv (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_om (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_ov (ffelexToken t);
+ffebldConstant ffebld_constant_new_typeless_val (ffebldConst type,
+						 ffetargetTypeless val);
+ffebldConstant ffebld_constant_negated (ffebldConstant c);
+ffebldConstantUnion ffebld_constantarray_get (ffebldConstantArray array,
+	   ffeinfoBasictype bt, ffeinfoKindtype kt, ffetargetOffset offset);
+void ffebld_constantarray_kill (ffebldConstantArray array, ffeinfoBasictype bt,
+				ffeinfoKindtype kt, ffetargetOffset size);
+ffebldConstantArray ffebld_constantarray_new (ffeinfoBasictype bt,
+				  ffeinfoKindtype kt, ffetargetOffset size);
+void ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size,
+       ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
+		      ffetargetOffset offset, ffebldConstantUnion *constant,
+				 ffeinfoBasictype cbt, ffeinfoKindtype ckt);
+void ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size,
+       ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
+		   ffetargetOffset offset, ffebldConstantArray source_array,
+				 ffeinfoBasictype cbt, ffeinfoKindtype ckt);
+void ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt,
+  ffeinfoKindtype kt, ffetargetOffset offset, ffebldConstantUnion constant);
+void ffebld_init_0 (void);
+void ffebld_init_1 (void);
+void ffebld_init_2 (void);
+ffebldListLength ffebld_list_length (ffebld l);
+ffebld ffebld_new_accter (ffebldConstantArray array, ffebit b);
+ffebld ffebld_new_arrter (ffebldConstantArray array, ffetargetOffset size);
+ffebld ffebld_new_conter_with_orig (ffebldConstant c, ffebld orig);
+ffebld ffebld_new_item (ffebld head, ffebld trail);
+ffebld ffebld_new_labter (ffelab l);
+ffebld ffebld_new_labtok (ffelexToken t);
+ffebld ffebld_new_none (ffebldOp o);
+ffebld ffebld_new_symter (ffesymbol s, ffeintrinGen gen, ffeintrinSpec spec,
+			  ffeintrinImp imp);
+ffebld ffebld_new_one (ffebldOp o, ffebld left);
+ffebld ffebld_new_two (ffebldOp o, ffebld left, ffebld right);
+const char *ffebld_op_string (ffebldOp o);
+void ffebld_pool_pop (void);
+void ffebld_pool_push (mallocPool pool);
+ffetargetCharacterSize ffebld_size_max (ffebld b);
+
+/* Define macros. */
+
+#define ffebld_accter(b) ((b)->u.accter.array)
+#define ffebld_accter_bits(b) ((b)->u.accter.bits)
+#define ffebld_accter_pad(b) ((b)->u.accter.pad)
+#define ffebld_accter_set_bits(b,bt) ((b)->u.accter.bits = (bt))
+#define ffebld_accter_set_pad(b,p) ((b)->u.accter.pad = (p))
+#define ffebld_accter_size(b) ffebit_size((b)->u.accter.bits)
+#define ffebld_append_item(b,i) (**(b) = ffebld_new_item((i),NULL),	      \
+				 *(b) = &((**(b))->u.item.trail))
+#define ffebld_arity(b) ffebld_arity_op(ffebld_op(b))
+#define ffebld_arity_op(o) (ffebld_arity_op_[o])
+#define ffebld_arrter(b) ((b)->u.arrter.array)
+#define ffebld_arrter_pad(b) ((b)->u.arrter.pad)
+#define ffebld_arrter_set_pad(b,p) ((b)->u.arrter.pad = (p))
+#define ffebld_arrter_set_size(b,s) ((b)->u.arrter.size = (s))
+#define ffebld_arrter_size(b) ((b)->u.arrter.size)
+#define ffebld_basictype(b) (ffeinfo_basictype (ffebld_info ((b))))
+#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
+#define ffebld_constant_pool() ffe_pool_program_unit()
+#elif FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_
+#define ffebld_constant_pool() ffe_pool_file()
+#else
+#error
+#endif
+#define ffebld_constant_character1(c) ((c)->u.character1)
+#define ffebld_constant_character2(c) ((c)->u.character2)
+#define ffebld_constant_character3(c) ((c)->u.character3)
+#define ffebld_constant_character4(c) ((c)->u.character4)
+#define ffebld_constant_character5(c) ((c)->u.character5)
+#define ffebld_constant_character6(c) ((c)->u.character6)
+#define ffebld_constant_character7(c) ((c)->u.character7)
+#define ffebld_constant_character8(c) ((c)->u.character8)
+#define ffebld_constant_characterdefault ffebld_constant_character1
+#define ffebld_constant_complex1(c) ((c)->u.complex1)
+#define ffebld_constant_complex2(c) ((c)->u.complex2)
+#define ffebld_constant_complex3(c) ((c)->u.complex3)
+#define ffebld_constant_complex4(c) ((c)->u.complex4)
+#define ffebld_constant_complex5(c) ((c)->u.complex5)
+#define ffebld_constant_complex6(c) ((c)->u.complex6)
+#define ffebld_constant_complex7(c) ((c)->u.complex7)
+#define ffebld_constant_complex8(c) ((c)->u.complex8)
+#define ffebld_constant_complexdefault ffebld_constant_complex1
+#define ffebld_constant_complexdouble ffebld_constant_complex2
+#define ffebld_constant_complexquad ffebld_constant_complex3
+#define ffebld_constant_copy(c) (c)
+#define ffebld_constant_hollerith(c) ((c)->u.hollerith)
+#define ffebld_constant_hook(c) ((c)->hook)
+#define ffebld_constant_integer1(c) ((c)->u.integer1)
+#define ffebld_constant_integer2(c) ((c)->u.integer2)
+#define ffebld_constant_integer3(c) ((c)->u.integer3)
+#define ffebld_constant_integer4(c) ((c)->u.integer4)
+#define ffebld_constant_integer5(c) ((c)->u.integer5)
+#define ffebld_constant_integer6(c) ((c)->u.integer6)
+#define ffebld_constant_integer7(c) ((c)->u.integer7)
+#define ffebld_constant_integer8(c) ((c)->u.integer8)
+#define ffebld_constant_integerdefault ffebld_constant_integer1
+#define ffebld_constant_is_numeric(c) ((c)->numeric)
+#define ffebld_constant_logical1(c) ((c)->u.logical1)
+#define ffebld_constant_logical2(c) ((c)->u.logical2)
+#define ffebld_constant_logical3(c) ((c)->u.logical3)
+#define ffebld_constant_logical4(c) ((c)->u.logical4)
+#define ffebld_constant_logical5(c) ((c)->u.logical5)
+#define ffebld_constant_logical6(c) ((c)->u.logical6)
+#define ffebld_constant_logical7(c) ((c)->u.logical7)
+#define ffebld_constant_logical8(c) ((c)->u.logical8)
+#define ffebld_constant_logicaldefault ffebld_constant_logical1
+#define ffebld_constant_new_characterdefault ffebld_constant_new_character1
+#define ffebld_constant_new_characterdefault_val ffebld_constant_new_character1_val
+#define ffebld_constant_new_complexdefault ffebld_constant_new_complex1
+#define ffebld_constant_new_complexdefault_val ffebld_constant_new_complex1_val
+#define ffebld_constant_new_complexdouble ffebld_constant_new_complex2
+#define ffebld_constant_new_complexdouble_val ffebld_constant_new_complex2_val
+#define ffebld_constant_new_complexquad ffebld_constant_new_complex3
+#define ffebld_constant_new_complexquad_valffebld_constant_new_complex3_val
+#define ffebld_constant_new_integerdefault ffebld_constant_new_integer1
+#define ffebld_constant_new_integerdefault_val ffebld_constant_new_integer1_val
+#define ffebld_constant_new_logicaldefault ffebld_constant_new_logical1
+#define ffebld_constant_new_logicaldefault_val ffebld_constant_new_logical1_val
+#define ffebld_constant_new_realdefault ffebld_constant_new_real1
+#define ffebld_constant_new_realdefault_val ffebld_constant_new_real1_val
+#define ffebld_constant_new_realdouble ffebld_constant_new_real2
+#define ffebld_constant_new_realdouble_val ffebld_constant_new_real2_val
+#define ffebld_constant_new_realquad ffebld_constant_new_real3
+#define ffebld_constant_new_realquad_val ffebld_constant_new_real3_val
+#define ffebld_constant_ptr_to_union(c) (&(c)->u)
+#define ffebld_constant_real1(c) ((c)->u.real1)
+#define ffebld_constant_real2(c) ((c)->u.real2)
+#define ffebld_constant_real3(c) ((c)->u.real3)
+#define ffebld_constant_real4(c) ((c)->u.real4)
+#define ffebld_constant_real5(c) ((c)->u.real5)
+#define ffebld_constant_real6(c) ((c)->u.real6)
+#define ffebld_constant_real7(c) ((c)->u.real7)
+#define ffebld_constant_real8(c) ((c)->u.real8)
+#define ffebld_constant_realdefault ffebld_constant_real1
+#define ffebld_constant_realdouble ffebld_constant_real2
+#define ffebld_constant_realquad ffebld_constant_real3
+#define ffebld_constant_set_hook(c,h) ((c)->hook = (h))
+#define ffebld_constant_set_union(c,un) ((c)->u = (un))
+#define ffebld_constant_type(c) ((c)->consttype)
+#define ffebld_constant_typeless(c) ((c)->u.typeless)
+#define ffebld_constant_union(c) ((c)->u)
+#define ffebld_conter(b) ((b)->u.conter.expr)
+#define ffebld_conter_orig(b) ((b)->u.conter.orig)
+#define ffebld_conter_pad(b) ((b)->u.conter.pad)
+#define ffebld_conter_set_orig(b,o) ((b)->u.conter.orig = (o))
+#define ffebld_conter_set_pad(b,p) ((b)->u.conter.pad = (p))
+#define ffebld_copy(b) (b)	/* ~~~Someday really make a copy. */
+#define ffebld_cu_ptr_typeless(u) &(u).typeless
+#define ffebld_cu_ptr_hollerith(u) &(u).hollerith
+#define ffebld_cu_ptr_integer1(u) &(u).integer1
+#define ffebld_cu_ptr_integer2(u) &(u).integer2
+#define ffebld_cu_ptr_integer3(u) &(u).integer3
+#define ffebld_cu_ptr_integer4(u) &(u).integer4
+#define ffebld_cu_ptr_integer5(u) &(u).integer5
+#define ffebld_cu_ptr_integer6(u) &(u).integer6
+#define ffebld_cu_ptr_integer7(u) &(u).integer7
+#define ffebld_cu_ptr_integer8(u) &(u).integer8
+#define ffebld_cu_ptr_integerdefault ffebld_cu_ptr_integer1
+#define ffebld_cu_ptr_logical1(u) &(u).logical1
+#define ffebld_cu_ptr_logical2(u) &(u).logical2
+#define ffebld_cu_ptr_logical3(u) &(u).logical3
+#define ffebld_cu_ptr_logical4(u) &(u).logical4
+#define ffebld_cu_ptr_logical5(u) &(u).logical5
+#define ffebld_cu_ptr_logical6(u) &(u).logical6
+#define ffebld_cu_ptr_logical7(u) &(u).logical7
+#define ffebld_cu_ptr_logical8(u) &(u).logical8
+#define ffebld_cu_ptr_logicaldefault ffebld_cu_ptr_logical1
+#define ffebld_cu_ptr_real1(u) &(u).real1
+#define ffebld_cu_ptr_real2(u) &(u).real2
+#define ffebld_cu_ptr_real3(u) &(u).real3
+#define ffebld_cu_ptr_real4(u) &(u).real4
+#define ffebld_cu_ptr_real5(u) &(u).real5
+#define ffebld_cu_ptr_real6(u) &(u).real6
+#define ffebld_cu_ptr_real7(u) &(u).real7
+#define ffebld_cu_ptr_real8(u) &(u).real8
+#define ffebld_cu_ptr_realdefault ffebld_cu_ptr_real1
+#define ffebld_cu_ptr_realdouble ffebld_cu_ptr_real2
+#define ffebld_cu_ptr_realquad ffebld_cu_ptr_real3
+#define ffebld_cu_ptr_complex1(u) &(u).complex1
+#define ffebld_cu_ptr_complex2(u) &(u).complex2
+#define ffebld_cu_ptr_complex3(u) &(u).complex3
+#define ffebld_cu_ptr_complex4(u) &(u).complex4
+#define ffebld_cu_ptr_complex5(u) &(u).complex5
+#define ffebld_cu_ptr_complex6(u) &(u).complex6
+#define ffebld_cu_ptr_complex7(u) &(u).complex7
+#define ffebld_cu_ptr_complex8(u) &(u).complex8
+#define ffebld_cu_ptr_complexdefault ffebld_cu_ptr_complex1
+#define ffebld_cu_ptr_complexdouble ffebld_cu_ptr_complex2
+#define ffebld_cu_ptr_complexquad ffebld_cu_ptr_complex3
+#define ffebld_cu_ptr_character1(u) &(u).character1
+#define ffebld_cu_ptr_character2(u) &(u).character2
+#define ffebld_cu_ptr_character3(u) &(u).character3
+#define ffebld_cu_ptr_character4(u) &(u).character4
+#define ffebld_cu_ptr_character5(u) &(u).character5
+#define ffebld_cu_ptr_character6(u) &(u).character6
+#define ffebld_cu_ptr_character7(u) &(u).character7
+#define ffebld_cu_ptr_character8(u) &(u).character8
+#define ffebld_cu_val_typeless(u) (u).typeless
+#define ffebld_cu_val_hollerith(u) (u).hollerith
+#define ffebld_cu_val_integer1(u) (u).integer1
+#define ffebld_cu_val_integer2(u) (u).integer2
+#define ffebld_cu_val_integer3(u) (u).integer3
+#define ffebld_cu_val_integer4(u) (u).integer4
+#define ffebld_cu_val_integer5(u) (u).integer5
+#define ffebld_cu_val_integer6(u) (u).integer6
+#define ffebld_cu_val_integer7(u) (u).integer7
+#define ffebld_cu_val_integer8(u) (u).integer8
+#define ffebld_cu_val_integerdefault ffebld_cu_val_integer1
+#define ffebld_cu_val_logical1(u) (u).logical1
+#define ffebld_cu_val_logical2(u) (u).logical2
+#define ffebld_cu_val_logical3(u) (u).logical3
+#define ffebld_cu_val_logical4(u) (u).logical4
+#define ffebld_cu_val_logical5(u) (u).logical5
+#define ffebld_cu_val_logical6(u) (u).logical6
+#define ffebld_cu_val_logical7(u) (u).logical7
+#define ffebld_cu_val_logical8(u) (u).logical8
+#define ffebld_cu_val_logicaldefault ffebld_cu_val_logical
+#define ffebld_cu_val_real1(u) (u).real1
+#define ffebld_cu_val_real2(u) (u).real2
+#define ffebld_cu_val_real3(u) (u).real3
+#define ffebld_cu_val_real4(u) (u).real4
+#define ffebld_cu_val_real5(u) (u).real5
+#define ffebld_cu_val_real6(u) (u).real6
+#define ffebld_cu_val_real7(u) (u).real7
+#define ffebld_cu_val_real8(u) (u).real8
+#define ffebld_cu_val_realdefault ffebld_cu_val_real1
+#define ffebld_cu_val_realdouble ffebld_cu_val_real2
+#define ffebld_cu_val_realquad ffebld_cu_val_real3
+#define ffebld_cu_val_complex1(u) (u).complex1
+#define ffebld_cu_val_complex2(u) (u).complex2
+#define ffebld_cu_val_complex3(u) (u).complex3
+#define ffebld_cu_val_complex4(u) (u).complex4
+#define ffebld_cu_val_complex5(u) (u).complex5
+#define ffebld_cu_val_complex6(u) (u).complex6
+#define ffebld_cu_val_complex7(u) (u).complex7
+#define ffebld_cu_val_complex8(u) (u).complex8
+#define ffebld_cu_val_complexdefault ffebld_cu_val_complex1
+#define ffebld_cu_val_complexdouble ffebld_cu_val_complex2
+#define ffebld_cu_val_complexquad ffebld_cu_val_complex3
+#define ffebld_cu_val_character1(u) (u).character1
+#define ffebld_cu_val_character2(u) (u).character2
+#define ffebld_cu_val_character3(u) (u).character3
+#define ffebld_cu_val_character4(u) (u).character4
+#define ffebld_cu_val_character5(u) (u).character5
+#define ffebld_cu_val_character6(u) (u).character6
+#define ffebld_cu_val_character7(u) (u).character7
+#define ffebld_cu_val_character8(u) (u).character8
+#define ffebld_end_list(b) (*(b) = NULL)
+#define ffebld_head(b) ((b)->u.item.head)
+#define ffebld_info(b) ((b)->info)
+#define ffebld_init_3()
+#define ffebld_init_4()
+#define ffebld_init_list(l,b) (*(l) = NULL, *(b) = (l))
+#define ffebld_item_hook(b) ((b)->u.item.hook)
+#define ffebld_item_set_hook(b,h) ((b)->u.item.hook = (h))
+#define ffebld_kind(b) (ffeinfo_kind (ffebld_info ((b))))
+#define ffebld_kindtype(b) (ffeinfo_kindtype (ffebld_info ((b))))
+#define ffebld_labter(b) ((b)->u.labter)
+#define ffebld_labtok(b) ((b)->u.labtok)
+#define ffebld_left(b) ((b)->u.nonter.left)
+#define ffebld_name_string(n) ((n)->name)
+#define ffebld_new()							      \
+  ((ffebld) malloc_new_kp(ffebld_pool(), "FFEBLD",sizeof(struct _ffebld_)))
+#define ffebld_new_any() ffebld_new_none(FFEBLD_opANY)
+#define ffebld_new_conter(c) ffebld_new_conter_with_orig((c),NULL)
+#define ffebld_new_star() ffebld_new_none(FFEBLD_opSTAR)
+#define ffebld_new_uplus(l) ffebld_new_one(FFEBLD_opUPLUS,(l))
+#define ffebld_new_uminus(l) ffebld_new_one(FFEBLD_opUMINUS,(l))
+#define ffebld_new_add(l,r) ffebld_new_two(FFEBLD_opADD,(l),(r))
+#define ffebld_new_subtract(l,r) ffebld_new_two(FFEBLD_opSUBTRACT,(l),(r))
+#define ffebld_new_multiply(l,r) ffebld_new_two(FFEBLD_opMULTIPLY,(l),(r))
+#define ffebld_new_divide(l,r) ffebld_new_two(FFEBLD_opDIVIDE,(l),(r))
+#define ffebld_new_power(l,r) ffebld_new_two(FFEBLD_opPOWER,(l),(r))
+#define ffebld_new_bounds(l,r) ffebld_new_two(FFEBLD_opBOUNDS,(l),(r))
+#define ffebld_new_concatenate(l,r) ffebld_new_two(FFEBLD_opCONCATENATE,(l),(r))
+#define ffebld_new_not(l) ffebld_new_one(FFEBLD_opNOT,(l))
+#define ffebld_new_lt(l,r) ffebld_new_two(FFEBLD_opLT,(l),(r))
+#define ffebld_new_le(l,r) ffebld_new_two(FFEBLD_opLE,(l),(r))
+#define ffebld_new_eq(l,r) ffebld_new_two(FFEBLD_opEQ,(l),(r))
+#define ffebld_new_ne(l,r) ffebld_new_two(FFEBLD_opNE,(l),(r))
+#define ffebld_new_gt(l,r) ffebld_new_two(FFEBLD_opGT,(l),(r))
+#define ffebld_new_ge(l,r) ffebld_new_two(FFEBLD_opGE,(l),(r))
+#define ffebld_new_and(l,r) ffebld_new_two(FFEBLD_opAND,(l),(r))
+#define ffebld_new_or(l,r) ffebld_new_two(FFEBLD_opOR,(l),(r))
+#define ffebld_new_xor(l,r) ffebld_new_two(FFEBLD_opXOR,(l),(r))
+#define ffebld_new_eqv(l,r) ffebld_new_two(FFEBLD_opEQV,(l),(r))
+#define ffebld_new_neqv(l,r) ffebld_new_two(FFEBLD_opNEQV,(l),(r))
+#define ffebld_new_paren(l) ffebld_new_one(FFEBLD_opPAREN,(l))
+#define ffebld_new_repeat(l,r) ffebld_new_two(FFEBLD_opREPEAT,(l),(r))
+#define ffebld_new_percent_descr(l) ffebld_new_one(FFEBLD_opPERCENT_DESCR,(l))
+#define ffebld_new_percent_loc(l) ffebld_new_one(FFEBLD_opPERCENT_LOC,(l))
+#define ffebld_new_percent_ref(l) ffebld_new_one(FFEBLD_opPERCENT_REF,(l))
+#define ffebld_new_percent_val(l) ffebld_new_one(FFEBLD_opPERCENT_VAL,(l))
+#define ffebld_new_complex(l,r) ffebld_new_two(FFEBLD_opCOMPLEX,(l),(r))
+#define ffebld_new_convert(l) ffebld_new_one(FFEBLD_opCONVERT,(l))
+#define ffebld_new_funcref(l,r) ffebld_new_two(FFEBLD_opFUNCREF,(l),(r))
+#define ffebld_new_subrref(l,r) ffebld_new_two(FFEBLD_opSUBRREF,(l),(r))
+#define ffebld_new_arrayref(l,r) ffebld_new_two(FFEBLD_opARRAYREF,(l),(r))
+#define ffebld_new_substr(l,r) ffebld_new_two(FFEBLD_opSUBSTR,(l),(r))
+#define ffebld_new_impdo(l,r) ffebld_new_two(FFEBLD_opIMPDO,(l),(r))
+#define ffebld_nonter_hook(b) ((b)->u.nonter.hook)
+#define ffebld_nonter_set_hook(b,h) ((b)->u.nonter.hook = (h))
+#define ffebld_op(b) ((b)->op)
+#define ffebld_pool() (ffebld_pool_stack_.pool)
+#define ffebld_rank(b) (ffeinfo_rank (ffebld_info ((b))))
+#define ffebld_right(b) ((b)->u.nonter.right)
+#define ffebld_set_accter(b,a) ((b)->u.accter.array = (a))
+#define ffebld_set_arrter(b,a) ((b)->u.arrter.array = (a))
+#define ffebld_set_conter(b,c) ((b)->u.conter.expr = (c))
+#define ffebld_set_info(b,i) ((b)->info = (i))
+#define ffebld_set_labter(b,l) ((b)->u.labter = (l))
+#define ffebld_set_op(b,o) ((b)->op = (o))
+#define ffebld_set_head(b,h) ((b)->u.item.head = (h))
+#define ffebld_set_left(b,l) ((b)->u.nonter.left = (l))
+#define ffebld_set_right(b,r) ((b)->u.nonter.right = (r))
+#define ffebld_set_trail(b,t) ((b)->u.item.trail = (t))
+#define ffebld_size(b) (ffeinfo_size (ffebld_info ((b))))
+#define ffebld_size_known(b) ffebld_size((b))
+#define ffebld_symter(b) ((b)->u.symter.symbol)
+#define ffebld_symter_generic(b) ((b)->u.symter.generic)
+#define ffebld_symter_doiter(b) ((b)->u.symter.do_iter)
+#define ffebld_symter_implementation(b) ((b)->u.symter.implementation)
+#define ffebld_symter_specific(b) ((b)->u.symter.specific)
+#define ffebld_symter_set_generic(b,g) ((b)->u.symter.generic = (g))
+#define ffebld_symter_set_implementation(b,i) \
+  ((b)->u.symter.implementation = (i))
+#define ffebld_symter_set_is_doiter(b,f) ((b)->u.symter.do_iter = (f))
+#define ffebld_symter_set_specific(b,s) ((b)->u.symter.specific = (s))
+#define ffebld_terminate_0()
+#define ffebld_terminate_1()
+#define ffebld_terminate_2()
+#define ffebld_terminate_3()
+#define ffebld_terminate_4()
+#define ffebld_trail(b) ((b)->u.item.trail)
+#define ffebld_where(b) (ffeinfo_where (ffebld_info ((b))))
+
+/* End of #include file. */
+
+#endif /* ! GCC_F_BLD_H */
diff --git a/gcc/f/bugs.texi b/gcc/f/bugs.texi
new file mode 100644
index 00000000000..fdc4f159deb
--- /dev/null
+++ b/gcc/f/bugs.texi
@@ -0,0 +1,260 @@
+@c Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004 Free Software Foundation, Inc.
+@c This is part of the G77 manual.
+@c For copying conditions, see the file g77.texi.
+
+@c The text of this file appears in the file BUGS
+@c in the G77 distribution, as well as in the G77 manual.
+
+@c Keep this the same as the dates above, since it's used
+@c in the standalone derivations of this file (e.g. BUGS).
+@set copyrights-bugs 1995,1996,1997,1998,1999,2000,2001,2002,2004
+
+@set last-update-bugs 2004-05-18
+
+@ifset DOC-BUGS
+@include root.texi
+@c The immediately following lines apply to the BUGS file
+@c which is derived from this file.
+@emph{Note:} This file is automatically generated from the files
+@file{bugs0.texi} and @file{bugs.texi}.
+@file{BUGS} is @emph{not} a source file,
+although it is normally included within source distributions.
+
+This file lists known bugs in the @value{which-g77} version
+of the GNU Fortran compiler.
+Copyright (C) @value{copyrights-bugs} Free Software Foundation, Inc.
+You may copy, distribute, and modify it freely as long as you preserve
+this copyright notice and permission notice.
+
+@node Top,,, (dir)
+@chapter Known Bugs In GNU Fortran
+@end ifset
+
+@ifset DOC-G77
+@node Known Bugs
+@section Known Bugs In GNU Fortran
+@end ifset
+
+This section identifies bugs that @code{g77} @emph{users}
+might run into in the @value{which-g77} version
+of @code{g77}.
+This includes bugs that are actually in the @code{gcc}
+back end (GBE) or in @code{libf2c}, because those
+sets of code are at least somewhat under the control
+of (and necessarily intertwined with) @code{g77},
+so it isn't worth separating them out.
+
+@ifset DOC-G77
+For information on bugs in @emph{other} versions of @code{g77},
+see @ref{News,,News About GNU Fortran}.
+There, lists of bugs fixed in various versions of @code{g77}
+can help determine what bugs existed in prior versions.
+@end ifset
+
+@ifset DOC-BUGS
+For information on bugs in @emph{other} versions of @code{g77},
+see @file{@value{path-g77}/NEWS}.
+There, lists of bugs fixed in various versions of @code{g77}
+can help determine what bugs existed in prior versions.
+@end ifset
+
+@ifset DEVELOPMENT
+@emph{Warning:} The information below is still under development,
+and might not accurately reflect the @code{g77} code base
+of which it is a part.
+Efforts are made to keep it somewhat up-to-date,
+but they are particularly concentrated
+on any version of this information
+that is distributed as part of a @emph{released} @code{g77}.
+
+In particular, while this information is intended to apply to
+the @value{which-g77} version of @code{g77},
+only an official @emph{release} of that version
+is expected to contain documentation that is
+most consistent with the @code{g77} product in that version.
+@end ifset
+
+The following information was last updated on @value{last-update-bugs}:
+
+@itemize @bullet
+@item
+@code{g77} fails to warn about
+use of a ``live'' iterative-DO variable
+as an implied-DO variable
+in a @code{WRITE} or @code{PRINT} statement
+(although it does warn about this in a @code{READ} statement).
+
+@item
+Something about @code{g77}'s straightforward handling of
+label references and definitions sometimes prevents the GBE
+from unrolling loops.
+Until this is solved, try inserting or removing @code{CONTINUE}
+statements as the terminal statement, using the @code{END DO}
+form instead, and so on.
+
+@item
+Some confusion in diagnostics concerning failing @code{INCLUDE}
+statements from within @code{INCLUDE}'d or @code{#include}'d files.
+
+@cindex integer constants
+@cindex constants, integer
+@item
+@code{g77} assumes that @code{INTEGER(KIND=1)} constants range
+from @samp{-2**31} to @samp{2**31-1} (the range for
+two's-complement 32-bit values),
+instead of determining their range from the actual range of the
+type for the configuration (and, someday, for the constant).
+
+Further, it generally doesn't implement the handling
+of constants very well in that it makes assumptions about the
+configuration that it no longer makes regarding variables (types).
+
+Included with this item is the fact that @code{g77} doesn't recognize
+that, on IEEE-754/854-compliant systems, @samp{0./0.} should produce a NaN
+and no warning instead of the value @samp{0.} and a warning.
+
+@cindex compiler speed
+@cindex speed, of compiler
+@cindex compiler memory usage
+@cindex memory usage, of compiler
+@cindex large aggregate areas
+@cindex initialization, bug
+@cindex DATA statement
+@cindex statements, DATA
+@item
+@code{g77} uses way too much memory and CPU time to process large aggregate
+areas having any initialized elements.
+
+For example, @samp{REAL A(1000000)} followed by @samp{DATA A(1)/1/}
+takes up way too much time and space, including
+the size of the generated assembler file.
+
+Version 0.5.18 improves cases like this---specifically,
+cases of @emph{sparse} initialization that leave large, contiguous
+areas uninitialized---significantly.
+However, even with the improvements, these cases still
+require too much memory and CPU time.
+
+(Version 0.5.18 also improves cases where the initial values are
+zero to a much greater degree, so if the above example
+ends with @samp{DATA A(1)/0/}, the compile-time performance
+will be about as good as it will ever get, aside from unrelated
+improvements to the compiler.)
+
+Note that @code{g77} does display a warning message to
+notify the user before the compiler appears to hang.
+@ifset DOC-G77
+A warning message is issued when @code{g77} sees code that provides
+initial values (e.g. via @code{DATA}) to an aggregate area (@code{COMMON}
+or @code{EQUIVALENCE}, or even a large enough array or @code{CHARACTER}
+variable)
+that is large enough to increase @code{g77}'s compile time by roughly
+a factor of 10.
+
+This size currently is quite small, since @code{g77}
+currently has a known bug requiring too much memory
+and time to handle such cases.
+In @file{@value{path-g77}/data.c}, the macro
+@code{FFEDATA_sizeTOO_BIG_INIT_} is defined
+to the minimum size for the warning to appear.
+The size is specified in storage units,
+which can be bytes, words, or whatever, on a case-by-case basis.
+
+After changing this macro definition, you must
+(of course) rebuild and reinstall @code{g77} for
+the change to take effect.
+
+Note that, as of version 0.5.18, improvements have
+reduced the scope of the problem for @emph{sparse}
+initialization of large arrays, especially those
+with large, contiguous uninitialized areas.
+However, the warning is issued at a point prior to
+when @code{g77} knows whether the initialization is sparse,
+and delaying the warning could mean it is produced
+too late to be helpful.
+
+Therefore, the macro definition should not be adjusted to
+reflect sparse cases.
+Instead, adjust it to generate the warning when densely
+initialized arrays begin to cause responses noticeably slower
+than linear performance would suggest.
+@end ifset
+
+@cindex code, displaying main source
+@cindex displaying main source code
+@cindex debugging main source code
+@cindex printing main source
+@item
+When debugging, after starting up the debugger but before being able
+to see the source code for the main program unit, the user must currently
+set a breakpoint at @code{MAIN__} (or @code{MAIN___} or @code{MAIN_} if
+@code{MAIN__} doesn't exist)
+and run the program until it hits the breakpoint.
+At that point, the
+main program unit is activated and about to execute its first
+executable statement, but that's the state in which the debugger should
+start up, as is the case for languages like C.
+
+@cindex debugger
+@item
+Debugging @code{g77}-compiled code using debuggers other than
+@code{gdb} is likely not to work.
+
+Getting @code{g77} and @code{gdb} to work together is a known
+problem---getting @code{g77} to work properly with other
+debuggers, for which source code often is unavailable to @code{g77}
+developers, seems like a much larger, unknown problem,
+and is a lower priority than making @code{g77} and @code{gdb}
+work together properly.
+
+On the other hand, information about problems other debuggers
+have with @code{g77} output might make it easier to properly
+fix @code{g77}, and perhaps even improve @code{gdb}, so it
+is definitely welcome.
+Such information might even lead to all relevant products
+working together properly sooner.
+
+@cindex Alpha, support
+@cindex support, Alpha
+@item
+@code{g77} doesn't work perfectly on 64-bit configurations
+such as the Digital Semiconductor (``DEC'') Alpha.
+
+This problem is largely resolved as of version 0.5.23.
+
+@cindex padding
+@cindex structures
+@cindex common blocks
+@cindex equivalence areas
+@item
+@code{g77} currently inserts needless padding for things like
+@samp{COMMON A,IPAD} where @samp{A} is @code{CHARACTER*1} and @samp{IPAD}
+is @code{INTEGER(KIND=1)} on machines like x86,
+because the back end insists that @samp{IPAD}
+be aligned to a 4-byte boundary,
+but the processor has no such requirement
+(though it is usually good for performance).
+
+The @code{gcc} back end needs to provide a wider array
+of specifications of alignment requirements and preferences for targets,
+and front ends like @code{g77} should take advantage of this
+when it becomes available.
+
+@cindex complex performance
+@cindex aliasing
+@item
+The @code{libf2c} routines that perform some run-time
+arithmetic on @code{COMPLEX} operands
+were modified circa version 0.5.20 of @code{g77}
+to work properly even in the presence of aliased operands.
+
+While the @code{g77} and @code{netlib} versions of @code{libf2c}
+differ on how this is accomplished,
+the main differences are that we believe
+the @code{g77} version works properly
+even in the presence of @emph{partially} aliased operands.
+
+However, these modifications have reduced performance
+on targets such as x86,
+due to the extra copies of operands involved.
+@end itemize
diff --git a/gcc/f/bugs0.texi b/gcc/f/bugs0.texi
new file mode 100644
index 00000000000..9636f4da3d4
--- /dev/null
+++ b/gcc/f/bugs0.texi
@@ -0,0 +1,9 @@
+\input texinfo  @c -*-texinfo-*-
+@c %**start of header
+@setfilename BUGS
+@c %**end of header
+
+@c This tells bugs.texi that it's generating just the BUGS file.
+@set DOC-BUGS
+@include bugs.texi
+@bye
diff --git a/gcc/f/com-rt.def b/gcc/f/com-rt.def
new file mode 100644
index 00000000000..185aef52d05
--- /dev/null
+++ b/gcc/f/com-rt.def
@@ -0,0 +1,289 @@
+/* com-rt.def -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      com.c
+
+   Modifications:
+*/
+
+/* DEFGFRT(CODE,NAME,TYPE,VOLATILE,COMPLEX,CONST):
+
+   CODE -- the #define name to use to refer to the function in g77 code
+
+   NAME -- the name as seen by the back end and, with whatever massaging
+	   is normal, the linker
+
+   TYPE -- a code for the tree for the type, assigned when first encountered
+	   (NOTE: There's a distinction made between the semantic return
+	   value for the function, and the actual return mechanism; e.g.
+	   `r_abs()' computes a single-precision `float' return value
+	   but returns it as a `double'.  This distinction is important
+	   and is flagged via the _F2C_ versus _GNU_ suffix.)
+
+   ARGS -- a string of codes representing the types of the arguments; the
+           last type specifies the type for that and all following args,
+           and the null pointer (0) means the same as "0":
+
+               0  Not applicable at and beyond this point
+               &  Pointer to type that follows
+               a  char
+               c  complex
+               d  doublereal
+               e  doublecomplex
+               f  real
+               i  integer
+               j  longint
+
+   VOLATILE -- TRUE if the function never returns (gen's emit_barrier in
+	       g77 back end)
+
+   COMPLEX -- TRUE if the return value is COMPLEX or DOUBLE COMPLEX and
+	      thus might need to be returned as ptr-to-1st-arg
+
+   CONST -- TRUE if the function is const
+            (does not have side effects and only depends on its arguments).
+
+*/
+
+DEFGFRT (FFECOM_gfrtCAT, "s_cat", FFECOM_rttypeVOID_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCMP, "s_cmp", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCOPY, "s_copy", FFECOM_rttypeVOID_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPAUSE, "s_paus", FFECOM_rttypeVOID_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSTOP, "s_stop", FFECOM_rttypeVOID_, 0, TRUE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtRANGE, "s_rnge", FFECOM_rttypeINTEGER_, 0, TRUE, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtSRDUE, "s_rdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERDUE, "e_rdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSUE, "s_rsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERSUE, "e_rsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRDFE, "s_rdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERDFE, "e_rdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSFI, "s_rsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERSFI, "e_rsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSFE, "s_rsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERSFE, "e_rsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSLI, "s_rsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERSLI, "e_rsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSLE, "s_rsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERSLE, "e_rsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRSNE, "s_rsne", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtSWDUE, "s_wdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWDUE, "e_wdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSUE, "s_wsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWSUE, "e_wsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWDFE, "s_wdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWDFE, "e_wdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSFI, "s_wsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWSFI, "e_wsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSFE, "s_wsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWSFE, "e_wsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSLI, "s_wsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWSLI, "e_wsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSLE, "s_wsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEWSLE, "e_wsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSWSNE, "s_wsne", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtDOFIO, "do_fio", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDOLIO, "do_lio", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDOUIO, "do_uio", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtFOPEN, "f_open", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFCLOS, "f_clos", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFINQU, "f_inqu", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtFBACK, "f_back", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFEND, "f_end", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFREW, "f_rew", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtABORT, "G77_abort_0", FFECOM_rttypeVOID_, 0, TRUE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtABS, "r_abs", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtACCESS, "G77_access_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtACOS, "r_acos", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtAIMAG, "r_imag", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtAINT, "r_int", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtALARM, "G77_alarm_0", FFECOM_rttypeINTEGER_, "&i0", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtALOG, "r_log", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtALOG10, "r_lg10", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtAMOD, "r_mod", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtANINT, "r_nint", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtASIN, "r_asin", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtATAN, "r_atan", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtATAN2, "r_atn2", FFECOM_rttypeREAL_F2C_, "&f&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCABS, "c_abs", FFECOM_rttypeREAL_F2C_, "&c", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCCOS, "c_cos", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtCEXP, "c_exp", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtCHDIR, "G77_chdir_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCLOG, "c_log", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtCHMOD, "G77_chmod_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCONJG, "r_cnjg", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtCOS, "r_cos", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCOSH, "r_cosh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCSIN, "c_sin", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtCSQRT, "c_sqrt", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtCTIME, "G77_ctime_0", FFECOM_rttypeCHARACTER_, "&j", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDABS, "d_abs", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDACOS, "d_acos", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDASIN, "d_asin", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDATAN, "d_atan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDATAN2, "d_atn2", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDATE, "G77_date_y2kbug_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDATE_AND_TIME, "G77_date_and_time_0", FFECOM_rttypeVOID_, "&a&a&a&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_BESJ0, "j0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_BESJ1, "j1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_BESJN, "jn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_BESY0, "y0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_BESY1, "y1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_BESYN, "yn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtDCOS, "d_cos", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDCOSH, "d_cosh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDDIM, "d_dim", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDERF, "G77_derf_0", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDERFC, "G77_derfc_0", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDEXP, "d_exp", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDIM, "r_dim", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDINT, "d_int", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDLOG, "d_log", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDLOG10, "d_lg10", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDMOD, "d_mod", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDNINT, "d_nint", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDPROD, "d_prod", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDSIGN, "d_sign", FFECOM_rttypeDOUBLE_, "&d&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDSIN, "d_sin", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDSINH, "d_sinh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDSQRT, "d_sqrt", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDTAN, "d_tan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDTANH, "d_tanh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtDTIME, "G77_dtime_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERF, "G77_erf_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtERFC, "G77_erfc_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtETIME, "G77_etime_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEXIT, "G77_exit_0", FFECOM_rttypeVOID_, "&i", TRUE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtEXP, "r_exp", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFDATE, "G77_fdate_0", FFECOM_rttypeCHARACTER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFGET, "G77_fget_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFGETC, "G77_fgetc_0", FFECOM_rttypeINTEGER_, "&i&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFLUSH, "G77_flush_0", FFECOM_rttypeVOID_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFLUSH1, "G77_flush1_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFNUM, "G77_fnum_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFPUT, "G77_fput_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFPUTC, "G77_fputc_0", FFECOM_rttypeINTEGER_, "&i&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFSTAT, "G77_fstat_0", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFTELL, "G77_ftell_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtFSEEK, "G77_fseek_0", FFECOM_rttypeINTEGER_, "&i&i&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGERROR, "G77_gerror_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETARG, "G77_getarg_0", FFECOM_rttypeVOID_, "&i&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETCWD, "G77_getcwd_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETGID, "G77_getgid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETLOG, "G77_getlog_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETPID, "G77_getpid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETUID, "G77_getuid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGETENV, "G77_getenv_0", FFECOM_rttypeVOID_, "&a&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtGMTIME, "G77_gmtime_0", FFECOM_rttypeVOID_, "&i&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtHOSTNM, "G77_hostnm_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIABS, "i_abs", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIARGC, "G77_iargc_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIDATE, "G77_idate_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIDIM, "i_dim", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIDNINT, "i_dnnt", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIERRNO, "G77_ierrno_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtINDEX, "i_indx", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtIRAND, "G77_irand_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtISIGN, "i_sign", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtISATTY, "G77_isatty_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtITIME, "G77_itime_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtKILL, "G77_kill_0", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLEN, "i_len", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtLGE, "l_ge", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLGT, "l_gt", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLINK, "G77_link_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLLE, "l_le", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLLT, "l_lt", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLNBLNK, "G77_lnblnk_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLSTAT, "G77_lstat_0", FFECOM_rttypeINTEGER_, "&a&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtLTIME, "G77_ltime_0", FFECOM_rttypeVOID_, "&i&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtMCLOCK, "G77_mclock_0", FFECOM_rttypeLONGINT_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtMOD, "i_mod", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtNINT, "i_nint", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPERROR, "G77_perror_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtRAND, "G77_rand_0", FFECOM_rttypeREAL_F2C_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtRENAME, "G77_rename_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSECNDS, "G77_secnds_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSECOND, "G77_second_0", FFECOM_rttypeREAL_F2C_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSIGN, "r_sign", FFECOM_rttypeREAL_F2C_, "&f&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtL_SIGNAL, "G77_signal_0", FFECOM_rttypeVOIDSTAR_, "&i0", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSIN, "r_sin", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSINH, "r_sinh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSLEEP, "G77_sleep_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSQRT, "r_sqrt", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSRAND, "G77_srand_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSTAT, "G77_stat_0", FFECOM_rttypeINTEGER_, "&a&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSYMLNK, "G77_symlnk_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSYSTEM, "G77_system_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtSYSTEM_CLOCK, "G77_system_clock_0", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtTAN, "r_tan", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtTANH, "r_tanh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtTIME, "G77_time_0", FFECOM_rttypeLONGINT_, 0, FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtTTYNAM, "G77_ttynam_0", FFECOM_rttypeCHARACTER_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtUNLINK, "G77_unlink_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtUMASK, "G77_umask_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtVXTIDATE, "G77_vxtidate_y2kbug_0", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtVXTTIME, "G77_vxttime_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCDABS, "z_abs", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtCDCOS, "z_cos", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtCDEXP, "z_exp", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtCDLOG, "z_log", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtDCONJG, "d_cnjg", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtCDSIN, "z_sin", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtCDSQRT, "z_sqrt", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtDIMAG, "d_imag", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE, FALSE)
+
+DEFGFRT (FFECOM_gfrtL_ACOS, "acos", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_ASIN, "asin", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_ATAN, "__builtin_atan", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_ATAN2, "__builtin_atan2", FFECOM_rttypeDOUBLE_, "dd", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_COS, "__builtin_cos", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_COSH, "cosh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_ERF, "erf", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_ERFC, "erfc", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_EXP, "__builtin_exp", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_FLOOR, "__builtin_floor", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_FMOD, "__builtin_fmod", FFECOM_rttypeDOUBLE_, "dd", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_LOG, "__builtin_log", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_LOG10, "log10", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_POW, "__builtin_pow", FFECOM_rttypeDOUBLE_, "dd", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_SIN, "__builtin_sin", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_SINH, "sinh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_SQRT, "__builtin_sqrt", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_TAN, "__builtin_tan", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+DEFGFRT (FFECOM_gfrtL_TANH, "tanh", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
+
+DEFGFRT (FFECOM_gfrtPOW_CI, "pow_ci", FFECOM_rttypeCOMPLEX_F2C_, "&c&i", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_DD, "pow_dd", FFECOM_rttypeDOUBLE_, "&d&d", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_DI, "pow_di", FFECOM_rttypeDOUBLE_, "&d&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_II, "pow_ii", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_QQ, "pow_qq", FFECOM_rttypeLONGINT_, "&j&j", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_RI, "pow_ri", FFECOM_rttypeREAL_F2C_, "&f&i", FALSE, FALSE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_ZI, "pow_zi", FFECOM_rttypeDBLCMPLX_F2C_, "&e&i", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtPOW_ZZ, "pow_zz", FFECOM_rttypeDBLCMPLX_F2C_, "&e&e", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtDIV_CC, "c_div", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
+DEFGFRT (FFECOM_gfrtDIV_ZZ, "z_div", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
diff --git a/gcc/f/com.c b/gcc/f/com.c
new file mode 100644
index 00000000000..a64ef86b172
--- /dev/null
+++ b/gcc/f/com.c
@@ -0,0 +1,16525 @@
+/* com.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+   Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Related Modules:
+      None
+
+   Description:
+      Contains compiler-specific functions.
+
+   Modifications:
+*/
+
+/* Understanding this module means understanding the interface between
+   the g77 front end and the gcc back end (or, perhaps, some other
+   back end).  In here are the functions called by the front end proper
+   to notify whatever back end is in place about certain things, and
+   also the back-end-specific functions.  It's a bear to deal with, so
+   lately I've been trying to simplify things, especially with regard
+   to the gcc-back-end-specific stuff.
+
+   Building expressions generally seems quite easy, but building decls
+   has been challenging and is undergoing revision.  gcc has several
+   kinds of decls:
+
+   TYPE_DECL -- a type (int, float, struct, function, etc.)
+   CONST_DECL -- a constant of some type other than function
+   LABEL_DECL -- a variable or a constant?
+   PARM_DECL -- an argument to a function (a variable that is a dummy)
+   RESULT_DECL -- the return value of a function (a variable)
+   VAR_DECL -- other variable (can hold a ptr-to-function, struct, int, etc.)
+   FUNCTION_DECL -- a function (either the actual function or an extern ref)
+   FIELD_DECL -- a field in a struct or union (goes into types)
+
+   g77 has a set of functions that somewhat parallels the gcc front end
+   when it comes to building decls:
+
+   Internal Function (one we define, not just declare as extern):
+   if (is_nested) push_f_function_context ();
+   start_function (get_identifier ("function_name"), function_type,
+		   is_nested, is_public);
+   // for each arg, build PARM_DECL and call push_parm_decl (decl) with it;
+   store_parm_decls (is_main_program);
+   ffecom_start_compstmt ();
+   // for stmts and decls inside function, do appropriate things;
+   ffecom_end_compstmt ();
+   finish_function (is_nested);
+   if (is_nested) pop_f_function_context ();
+
+   Everything Else:
+   tree d;
+   tree init;
+   // fill in external, public, static, &c for decl, and
+   // set DECL_INITIAL to error_mark_node if going to initialize
+   // set is_top_level TRUE only if not at top level and decl
+   // must go in top level (i.e. not within current function decl context)
+   d = start_decl (decl, is_top_level);
+   init = ...;	// if have initializer
+   finish_decl (d, init, is_top_level);
+
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "flags.h"
+#include "real.h"
+#include "rtl.h"
+#include "toplev.h"
+#include "tree.h"
+#include "output.h"  /* Must follow tree.h so TREE_CODE is defined! */
+#include "convert.h"
+#include "ggc.h"
+#include "diagnostic.h"
+#include "intl.h"
+#include "langhooks.h"
+#include "langhooks-def.h"
+#include "debug.h"
+
+/* VMS-specific definitions */
+#ifdef VMS
+#include <descrip.h>
+#define O_RDONLY	0	/* Open arg for Read/Only  */
+#define O_WRONLY	1	/* Open arg for Write/Only */
+#define read(fd,buf,size)	VMS_read (fd,buf,size)
+#define write(fd,buf,size)	VMS_write (fd,buf,size)
+#define open(fname,mode,prot)	VMS_open (fname,mode,prot)
+#define fopen(fname,mode)	VMS_fopen (fname,mode)
+#define freopen(fname,mode,ofile) VMS_freopen (fname,mode,ofile)
+#define strncat(dst,src,cnt) VMS_strncat (dst,src,cnt)
+#define fstat(fd,stbuf)		VMS_fstat (fd,stbuf)
+static int VMS_fstat (), VMS_stat ();
+static char * VMS_strncat ();
+static int VMS_read ();
+static int VMS_write ();
+static int VMS_open ();
+static FILE * VMS_fopen ();
+static FILE * VMS_freopen ();
+static void hack_vms_include_specification ();
+typedef struct { unsigned :16, :16, :16; } vms_ino_t;
+#define ino_t vms_ino_t
+#define INCLUDE_LEN_FUDGE 10	/* leave room for VMS syntax conversion */
+#endif /* VMS */
+
+#define FFECOM_DETERMINE_TYPES 1 /* for com.h */
+#include "com.h"
+#include "bad.h"
+#include "bld.h"
+#include "equiv.h"
+#include "expr.h"
+#include "implic.h"
+#include "info.h"
+#include "malloc.h"
+#include "src.h"
+#include "st.h"
+#include "storag.h"
+#include "symbol.h"
+#include "target.h"
+#include "top.h"
+#include "type.h"
+
+/* Externals defined here.  */
+
+/* Stream for reading from the input file.  */
+FILE *finput;
+
+/* These definitions parallel those in c-decl.c so that code from that
+   module can be used pretty much as is.  Much of these defs aren't
+   otherwise used, i.e. by g77 code per se, except some of them are used
+   to build some of them that are.  The ones that are global (i.e. not
+   "static") are those that ste.c and such might use (directly
+   or by using com macros that reference them in their definitions).  */
+
+tree string_type_node;
+
+/* The rest of these are inventions for g77, though there might be
+   similar things in the C front end.  As they are found, these
+   inventions should be renamed to be canonical.  Note that only
+   the ones currently required to be global are so.  */
+
+static GTY(()) tree ffecom_tree_fun_type_void;
+
+tree ffecom_integer_type_node;	/* Abbrev for _tree_type[blah][blah]. */
+tree ffecom_integer_zero_node;	/* Like *_*_* with g77's integer type. */
+tree ffecom_integer_one_node;	/* " */
+tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype];
+
+/* _fun_type things are the f2c-specific versions.  For -fno-f2c,
+   just use build_function_type and build_pointer_type on the
+   appropriate _tree_type array element.  */
+
+static GTY(()) tree ffecom_tree_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
+static GTY(()) tree
+  ffecom_tree_ptr_to_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
+static GTY(()) tree ffecom_tree_subr_type;
+static GTY(()) tree ffecom_tree_ptr_to_subr_type;
+static GTY(()) tree ffecom_tree_blockdata_type;
+
+static GTY(()) tree ffecom_tree_xargc_;
+
+ffecomSymbol ffecom_symbol_null_
+=
+{
+  NULL_TREE,
+  NULL_TREE,
+  NULL_TREE,
+  NULL_TREE,
+  false
+};
+ffeinfoKindtype ffecom_pointer_kind_ = FFEINFO_basictypeNONE;
+ffeinfoKindtype ffecom_label_kind_ = FFEINFO_basictypeNONE;
+
+int ffecom_f2c_typecode_[FFEINFO_basictype][FFEINFO_kindtype];
+tree ffecom_f2c_integer_type_node;
+static GTY(()) tree ffecom_f2c_ptr_to_integer_type_node;
+tree ffecom_f2c_address_type_node;
+tree ffecom_f2c_real_type_node;
+static GTY(()) tree ffecom_f2c_ptr_to_real_type_node;
+tree ffecom_f2c_doublereal_type_node;
+tree ffecom_f2c_complex_type_node;
+tree ffecom_f2c_doublecomplex_type_node;
+tree ffecom_f2c_longint_type_node;
+tree ffecom_f2c_logical_type_node;
+tree ffecom_f2c_flag_type_node;
+tree ffecom_f2c_ftnlen_type_node;
+tree ffecom_f2c_ftnlen_zero_node;
+tree ffecom_f2c_ftnlen_one_node;
+tree ffecom_f2c_ftnlen_two_node;
+tree ffecom_f2c_ptr_to_ftnlen_type_node;
+tree ffecom_f2c_ftnint_type_node;
+tree ffecom_f2c_ptr_to_ftnint_type_node;
+
+/* Simple definitions and enumerations. */
+
+#ifndef FFECOM_sizeMAXSTACKITEM
+#define FFECOM_sizeMAXSTACKITEM 32*1024	/* Keep user-declared things
+					   larger than this # bytes
+					   off stack if possible. */
+#endif
+
+/* For systems that have large enough stacks, they should define
+   this to 0, and here, for ease of use later on, we just undefine
+   it if it is 0.  */
+
+#if FFECOM_sizeMAXSTACKITEM == 0
+#undef FFECOM_sizeMAXSTACKITEM
+#endif
+
+typedef enum
+  {
+    FFECOM_rttypeVOID_,
+    FFECOM_rttypeVOIDSTAR_,	/* C's `void *' type. */
+    FFECOM_rttypeFTNINT_,	/* f2c's `ftnint' type. */
+    FFECOM_rttypeINTEGER_,	/* f2c's `integer' type. */
+    FFECOM_rttypeLONGINT_,	/* f2c's `longint' type. */
+    FFECOM_rttypeLOGICAL_,	/* f2c's `logical' type. */
+    FFECOM_rttypeREAL_F2C_,	/* f2c's `real' returned as `double'. */
+    FFECOM_rttypeREAL_GNU_,	/* `real' returned as such. */
+    FFECOM_rttypeCOMPLEX_F2C_,	/* f2c's `complex' returned via 1st arg. */
+    FFECOM_rttypeCOMPLEX_GNU_,	/* f2c's `complex' returned directly. */
+    FFECOM_rttypeDOUBLE_,	/* C's `double' type. */
+    FFECOM_rttypeDOUBLEREAL_,	/* f2c's `doublereal' type. */
+    FFECOM_rttypeDBLCMPLX_F2C_,	/* f2c's `doublecomplex' returned via 1st arg. */
+    FFECOM_rttypeDBLCMPLX_GNU_,	/* f2c's `doublecomplex' returned directly. */
+    FFECOM_rttypeCHARACTER_,	/* f2c `char *'/`ftnlen' pair. */
+    FFECOM_rttype_
+  } ffecomRttype_;
+
+/* Internal typedefs. */
+
+typedef struct _ffecom_concat_list_ ffecomConcatList_;
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffecom_concat_list_
+  {
+    ffebld *exprs;
+    int count;
+    int max;
+    ffetargetCharacterSize minlen;
+    ffetargetCharacterSize maxlen;
+  };
+
+/* Static functions (internal). */
+
+static tree ffe_type_for_mode (enum machine_mode, int);
+static tree ffe_type_for_size (unsigned int, int);
+static tree ffe_unsigned_type (tree);
+static tree ffe_signed_type (tree);
+static tree ffe_signed_or_unsigned_type (int, tree);
+static bool ffe_mark_addressable (tree);
+static tree ffe_truthvalue_conversion (tree);
+static void ffecom_init_decl_processing (void);
+static tree ffecom_arglist_expr_ (const char *argstring, ffebld args);
+static tree ffecom_widest_expr_type_ (ffebld list);
+static bool ffecom_overlap_ (tree dest_decl, tree dest_offset,
+			     tree dest_size, tree source_tree,
+			     ffebld source, bool scalar_arg);
+static bool ffecom_args_overlapping_ (tree dest_tree, ffebld dest,
+				      tree args, tree callee_commons,
+				      bool scalar_args);
+static tree ffecom_build_f2c_string_ (int i, const char *s);
+static tree ffecom_call_ (tree fn, ffeinfoKindtype kt,
+			  bool is_f2c_complex, tree type,
+			  tree args, tree dest_tree,
+			  ffebld dest, bool *dest_used,
+			  tree callee_commons, bool scalar_args, tree hook);
+static tree ffecom_call_binop_ (tree fn, ffeinfoKindtype kt,
+				bool is_f2c_complex, tree type,
+				ffebld left, ffebld right,
+				tree dest_tree, ffebld dest,
+				bool *dest_used, tree callee_commons,
+				bool scalar_args, bool ref, tree hook);
+static void ffecom_char_args_x_ (tree *xitem, tree *length,
+				 ffebld expr, bool with_null);
+static tree ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy);
+static tree ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s);
+static ffecomConcatList_
+  ffecom_concat_list_gather_ (ffecomConcatList_ catlist,
+			      ffebld expr,
+			      ffetargetCharacterSize max);
+static void ffecom_concat_list_kill_ (ffecomConcatList_ catlist);
+static ffecomConcatList_ ffecom_concat_list_new_ (ffebld expr,
+						ffetargetCharacterSize max);
+static void ffecom_debug_kludge_ (tree aggr, const char *aggr_type,
+				  ffesymbol member, tree member_type,
+				  ffetargetOffset offset);
+static void ffecom_do_entry_ (ffesymbol fn, int entrynum);
+static tree ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
+			  bool *dest_used, bool assignp, bool widenp);
+static tree ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
+				    ffebld dest, bool *dest_used);
+static tree ffecom_expr_power_integer_ (ffebld expr);
+static void ffecom_expr_transform_ (ffebld expr);
+static void ffecom_f2c_make_type_ (tree *type, int tcode, const char *name);
+static void ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size,
+				      int code);
+static ffeglobal ffecom_finish_global_ (ffeglobal global);
+static ffesymbol ffecom_finish_symbol_transform_ (ffesymbol s);
+static tree ffecom_get_appended_identifier_ (char us, const char *text);
+static tree ffecom_get_external_identifier_ (ffesymbol s);
+static tree ffecom_get_identifier_ (const char *text);
+static tree ffecom_gen_sfuncdef_ (ffesymbol s,
+				  ffeinfoBasictype bt,
+				  ffeinfoKindtype kt);
+static const char *ffecom_gfrt_args_ (ffecomGfrt ix);
+static tree ffecom_gfrt_tree_ (ffecomGfrt ix);
+static tree ffecom_init_zero_ (tree decl);
+static tree ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg,
+				     tree *maybe_tree);
+static tree ffecom_intrinsic_len_ (ffebld expr);
+static void ffecom_let_char_ (tree dest_tree,
+			      tree dest_length,
+			      ffetargetCharacterSize dest_size,
+			      ffebld source);
+static void ffecom_make_gfrt_ (ffecomGfrt ix);
+static void ffecom_member_phase1_ (ffestorag mst, ffestorag st);
+static void ffecom_member_phase2_ (ffestorag mst, ffestorag st);
+static void ffecom_prepare_let_char_ (ffetargetCharacterSize dest_size,
+				      ffebld source);
+static void ffecom_push_dummy_decls_ (ffebld dumlist,
+				      bool stmtfunc);
+static void ffecom_start_progunit_ (void);
+static ffesymbol ffecom_sym_transform_ (ffesymbol s);
+static ffesymbol ffecom_sym_transform_assign_ (ffesymbol s);
+static void ffecom_transform_common_ (ffesymbol s);
+static void ffecom_transform_equiv_ (ffestorag st);
+static tree ffecom_transform_namelist_ (ffesymbol s);
+static void ffecom_tree_canonize_ptr_ (tree *decl, tree *offset,
+				       tree t);
+static void ffecom_tree_canonize_ref_ (tree *decl, tree *offset,
+				       tree *size, tree tree);
+static tree ffecom_tree_divide_ (tree tree_type, tree left, tree right,
+				 tree dest_tree, ffebld dest,
+				 bool *dest_used, tree hook);
+static tree ffecom_type_localvar_ (ffesymbol s,
+				   ffeinfoBasictype bt,
+				   ffeinfoKindtype kt);
+static tree ffecom_type_namelist_ (void);
+static tree ffecom_type_vardesc_ (void);
+static tree ffecom_vardesc_ (ffebld expr);
+static tree ffecom_vardesc_array_ (ffesymbol s);
+static tree ffecom_vardesc_dims_ (ffesymbol s);
+static tree ffecom_convert_narrow_ (tree type, tree expr);
+static tree ffecom_convert_widen_ (tree type, tree expr);
+
+/* These are static functions that parallel those found in the C front
+   end and thus have the same names.  */
+
+static tree bison_rule_compstmt_ (void);
+static void bison_rule_pushlevel_ (void);
+static void delete_block (tree block);
+static int duplicate_decls (tree newdecl, tree olddecl);
+static void finish_decl (tree decl, tree init, bool is_top_level);
+static void finish_function (int nested);
+static const char *ffe_printable_name (tree decl, int v);
+static void ffe_print_error_function (diagnostic_context *, const char *);
+static tree lookup_name_current_level (tree name);
+static struct f_binding_level *make_binding_level (void);
+static void pop_f_function_context (void);
+static void push_f_function_context (void);
+static void push_parm_decl (tree parm);
+static tree pushdecl_top_level (tree decl);
+static int kept_level_p (void);
+static tree storedecls (tree decls);
+static void store_parm_decls (int is_main_program);
+static tree start_decl (tree decl, bool is_top_level);
+static void start_function (tree name, tree type, int nested, int public);
+static void ffecom_file_ (const char *name);
+static void ffecom_close_include_ (FILE *f);
+static FILE *ffecom_open_include_ (char *name, ffewhereLine l,
+				   ffewhereColumn c);
+
+/* Static objects accessed by functions in this module. */
+
+static ffesymbol ffecom_primary_entry_ = NULL;
+static ffesymbol ffecom_nested_entry_ = NULL;
+static ffeinfoKind ffecom_primary_entry_kind_;
+static bool ffecom_primary_entry_is_proc_;
+static GTY(()) tree ffecom_outer_function_decl_;
+static GTY(()) tree ffecom_previous_function_decl_;
+static GTY(()) tree ffecom_which_entrypoint_decl_;
+static GTY(()) tree ffecom_float_zero_;
+static GTY(()) tree ffecom_float_half_;
+static GTY(()) tree ffecom_double_zero_;
+static GTY(()) tree ffecom_double_half_;
+static GTY(()) tree ffecom_func_result_;/* For functions. */
+static GTY(()) tree ffecom_func_length_;/* For CHARACTER fns. */
+static ffebld ffecom_list_blockdata_;
+static ffebld ffecom_list_common_;
+static ffebld ffecom_master_arglist_;
+static ffeinfoBasictype ffecom_master_bt_;
+static ffeinfoKindtype ffecom_master_kt_;
+static ffetargetCharacterSize ffecom_master_size_;
+static int ffecom_num_fns_ = 0;
+static int ffecom_num_entrypoints_ = 0;
+static bool ffecom_is_altreturning_ = FALSE;
+static GTY(()) tree ffecom_multi_type_node_;
+static GTY(()) tree ffecom_multi_retval_;
+static GTY(()) tree
+  ffecom_multi_fields_[FFEINFO_basictype][FFEINFO_kindtype];
+static bool ffecom_member_namelisted_;	/* _member_phase1_ namelisted? */
+static bool ffecom_doing_entry_ = FALSE;
+static bool ffecom_transform_only_dummies_ = FALSE;
+static int ffecom_typesize_pointer_;
+static int ffecom_typesize_integer1_;
+
+/* Holds pointer-to-function expressions.  */
+
+static GTY(()) tree ffecom_gfrt_[FFECOM_gfrt];
+
+/* Holds the external names of the functions.  */
+
+static const char *const ffecom_gfrt_name_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) NAME,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* Whether the function returns.  */
+
+static const bool ffecom_gfrt_volatile_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) VOLATILE,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* Whether the function returns type complex.  */
+
+static const bool ffecom_gfrt_complex_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) COMPLEX,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* Whether the function is const
+   (i.e., has no side effects and only depends on its arguments).  */
+
+static const bool ffecom_gfrt_const_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) CONST,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* Type code for the function return value.  */
+
+static const ffecomRttype_ ffecom_gfrt_type_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) TYPE,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* String of codes for the function's arguments.  */
+
+static const char *const ffecom_gfrt_argstring_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) ARGS,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* Internal macros. */
+
+/* We let tm.h override the types used here, to handle trivial differences
+   such as the choice of unsigned int or long unsigned int for size_t.
+   When machines start needing nontrivial differences in the size type,
+   it would be best to do something here to figure out automatically
+   from other information what type to use.  */
+
+#ifndef SIZE_TYPE
+#define SIZE_TYPE "long unsigned int"
+#endif
+
+#define ffecom_concat_list_count_(catlist) ((catlist).count)
+#define ffecom_concat_list_expr_(catlist,i) ((catlist).exprs[(i)])
+#define ffecom_concat_list_maxlen_(catlist) ((catlist).maxlen)
+#define ffecom_concat_list_minlen_(catlist) ((catlist).minlen)
+
+#define ffecom_char_args_(i,l,e) ffecom_char_args_x_((i),(l),(e),FALSE)
+#define ffecom_char_args_with_null_(i,l,e) ffecom_char_args_x_((i),(l),(e),TRUE)
+
+/* For each binding contour we allocate a binding_level structure
+ * which records the names defined in that contour.
+ * Contours include:
+ *  0) the global one
+ *  1) one for each function definition,
+ *     where internal declarations of the parameters appear.
+ *
+ * The current meaning of a name can be found by searching the levels from
+ * the current one out to the global one.
+ */
+
+/* Note that the information in the `names' component of the global contour
+   is duplicated in the IDENTIFIER_GLOBAL_VALUEs of all identifiers.  */
+
+struct f_binding_level GTY(())
+  {
+    /* A chain of _DECL nodes for all variables, constants, functions,
+       and typedef types.  These are in the reverse of the order supplied.
+     */
+    tree names;
+
+    /* For each level (except not the global one),
+       a chain of BLOCK nodes for all the levels
+       that were entered and exited one level down.  */
+    tree blocks;
+
+    /* The BLOCK node for this level, if one has been preallocated.
+       If 0, the BLOCK is allocated (if needed) when the level is popped.  */
+    tree this_block;
+
+    /* The binding level which this one is contained in (inherits from).  */
+    struct f_binding_level *level_chain;
+
+    /* 0: no ffecom_prepare_* functions called at this level yet;
+       1: ffecom_prepare* functions called, except not ffecom_prepare_end;
+       2: ffecom_prepare_end called.  */
+    int prep_state;
+  };
+
+#define NULL_BINDING_LEVEL (struct f_binding_level *) NULL
+
+/* The binding level currently in effect.  */
+
+static GTY(()) struct f_binding_level *current_binding_level;
+
+/* A chain of binding_level structures awaiting reuse.  */
+
+static GTY((deletable (""))) struct f_binding_level *free_binding_level;
+
+/* The outermost binding level, for names of file scope.
+   This is created when the compiler is started and exists
+   through the entire run.  */
+
+static struct f_binding_level *global_binding_level;
+
+/* Binding level structures are initialized by copying this one.  */
+
+static const struct f_binding_level clear_binding_level
+=
+{NULL, NULL, NULL, NULL_BINDING_LEVEL, 0};
+
+/* Language-dependent contents of an identifier.  */
+
+struct lang_identifier GTY(())
+{
+  struct tree_identifier common;
+  tree global_value;
+  tree local_value;
+  tree label_value;
+  bool invented;
+};
+
+/* Macros for access to language-specific slots in an identifier.  */
+/* Each of these slots contains a DECL node or null.  */
+
+/* This represents the value which the identifier has in the
+   file-scope namespace.  */
+#define IDENTIFIER_GLOBAL_VALUE(NODE)	\
+  (((struct lang_identifier *)(NODE))->global_value)
+/* This represents the value which the identifier has in the current
+   scope.  */
+#define IDENTIFIER_LOCAL_VALUE(NODE)	\
+  (((struct lang_identifier *)(NODE))->local_value)
+/* This represents the value which the identifier has as a label in
+   the current label scope.  */
+#define IDENTIFIER_LABEL_VALUE(NODE)	\
+  (((struct lang_identifier *)(NODE))->label_value)
+/* This is nonzero if the identifier was "made up" by g77 code.  */
+#define IDENTIFIER_INVENTED(NODE)	\
+  (((struct lang_identifier *)(NODE))->invented)
+
+/* The resulting tree type.  */
+union lang_tree_node
+  GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
+       chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
+{
+  union tree_node GTY ((tag ("0"),
+			desc ("tree_node_structure (&%h)")))
+    generic;
+  struct lang_identifier GTY ((tag ("1"))) identifier;
+};
+
+/* Fortran doesn't use either of these.  */
+struct lang_decl GTY(())
+{
+};
+struct lang_type GTY(())
+{
+};
+
+/* In identifiers, C uses the following fields in a special way:
+   TREE_PUBLIC	      to record that there was a previous local extern decl.
+   TREE_USED	      to record that such a decl was used.
+   TREE_ADDRESSABLE   to record that the address of such a decl was used.  */
+
+/* A list (chain of TREE_LIST nodes) of all LABEL_DECLs in the function
+   that have names.  Here so we can clear out their names' definitions
+   at the end of the function.  */
+
+static GTY(()) tree named_labels;
+
+/* A list of LABEL_DECLs from outer contexts that are currently shadowed.  */
+
+static GTY(()) tree shadowed_labels;
+
+/* Return the subscript expression, modified to do range-checking.
+
+   `array' is the array type to be checked against.
+   `element' is the subscript expression to check.
+   `dim' is the dimension number (starting at 0).
+   `total_dims' is the total number of dimensions (0 for CHARACTER substring).
+   `item' is the array decl or NULL_TREE.
+*/
+
+static tree
+ffecom_subscript_check_ (tree array, tree element, int dim, int total_dims,
+			 const char *array_name, tree item)
+{
+  tree low = TYPE_MIN_VALUE (TYPE_DOMAIN (array));
+  tree high = TYPE_MAX_VALUE (TYPE_DOMAIN (array));
+  tree cond;
+  tree die;
+  tree args;
+
+  if (element == error_mark_node)
+    return element;
+
+  if (TREE_TYPE (low) != TREE_TYPE (element))
+    {
+      if (TYPE_PRECISION (TREE_TYPE (low))
+	  > TYPE_PRECISION (TREE_TYPE (element)))
+	element = convert (TREE_TYPE (low), element);
+      else
+	{
+	  low = convert (TREE_TYPE (element), low);
+	  if (high)
+	    high = convert (TREE_TYPE (element), high);
+	}
+    }
+
+  element = ffecom_save_tree (element);
+  if (total_dims == 0)
+    {
+      /* Special handling for substring range checks.  Fortran allows the
+         end subscript < begin subscript, which means that expressions like
+       string(1:0) are valid (and yield a null string).  In view of this,
+       enforce two simpler conditions:
+          1) element<=high for end-substring;
+          2) element>=low for start-substring.
+       Run-time character movement will enforce remaining conditions.
+
+       More complicated checks would be better, but present structure only
+       provides one index element at a time, so it is not possible to
+       enforce a check of both i and j in string(i:j).  If it were, the
+       complete set of rules would read,
+         if ( ((j<i) && ((low<=i<=high) || (low<=j<=high))) ||
+              ((low<=i<=high) && (low<=j<=high)) )
+           ok ;
+         else
+           range error ;
+      */
+      if (dim)
+        cond = ffecom_2 (LE_EXPR, integer_type_node, element, high);
+      else
+        cond = ffecom_2 (LE_EXPR, integer_type_node, low, element);
+    }
+  else
+    {
+      /* Array reference substring range checking.  */
+
+      cond = ffecom_2 (LE_EXPR, integer_type_node,
+                     low,
+                     element);
+      if (high)
+        {
+          cond = ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
+                         cond,
+                         ffecom_2 (LE_EXPR, integer_type_node,
+                                   element,
+                                   high));
+        }
+    }
+
+  /* If the array index is safe at compile-time, return element.  */
+  if (integer_nonzerop (cond))
+    return element;
+
+  {
+    int len;
+    char *proc;
+    char *var;
+    tree arg3;
+    tree arg2;
+    tree arg1;
+    tree arg4;
+
+    switch (total_dims)
+      {
+      case 0:
+	var = concat (array_name, "[", (dim ? "end" : "start"),
+		      "-substring]", NULL);
+	len = strlen (var) + 1;
+	arg1 = build_string (len, var);
+	free (var);
+	break;
+
+      case 1:
+	len = strlen (array_name) + 1;
+	arg1 = build_string (len, array_name);
+	break;
+
+      default:
+	var = xmalloc (strlen (array_name) + 40);
+	sprintf (var, "%s[subscript-%d-of-%d]",
+		 array_name,
+		 dim + 1, total_dims);
+	len = strlen (var) + 1;
+	arg1 = build_string (len, var);
+	free (var);
+	break;
+      }
+
+    TREE_TYPE (arg1)
+      = build_type_variant (build_array_type (char_type_node,
+					      build_range_type
+					      (integer_type_node,
+					       integer_one_node,
+					       build_int_2 (len, 0))),
+			    1, 0);
+    TREE_CONSTANT (arg1) = 1;
+    TREE_STATIC (arg1) = 1;
+    arg1 = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (arg1)),
+		     arg1);
+
+    /* s_rnge adds one to the element to print it, so bias against
+       that -- want to print a faithful *subscript* value.  */
+    arg2 = convert (ffecom_f2c_ftnint_type_node,
+		    ffecom_2 (MINUS_EXPR,
+			      TREE_TYPE (element),
+			      element,
+			      convert (TREE_TYPE (element),
+				       integer_one_node)));
+
+    proc = concat (input_filename, "/",
+		   IDENTIFIER_POINTER (DECL_NAME (current_function_decl)),
+		   NULL);
+    len = strlen (proc) + 1;
+    arg3 = build_string (len, proc);
+
+    free (proc);
+
+    TREE_TYPE (arg3)
+      = build_type_variant (build_array_type (char_type_node,
+					      build_range_type
+					      (integer_type_node,
+					       integer_one_node,
+					       build_int_2 (len, 0))),
+			    1, 0);
+    TREE_CONSTANT (arg3) = 1;
+    TREE_STATIC (arg3) = 1;
+    arg3 = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (arg3)),
+		     arg3);
+
+    arg4 = convert (ffecom_f2c_ftnint_type_node,
+		    build_int_2 (input_line, 0));
+
+    arg1 = build_tree_list (NULL_TREE, arg1);
+    arg2 = build_tree_list (NULL_TREE, arg2);
+    arg3 = build_tree_list (NULL_TREE, arg3);
+    arg4 = build_tree_list (NULL_TREE, arg4);
+    TREE_CHAIN (arg3) = arg4;
+    TREE_CHAIN (arg2) = arg3;
+    TREE_CHAIN (arg1) = arg2;
+
+    args = arg1;
+  }
+  die = ffecom_call_gfrt (FFECOM_gfrtRANGE,
+			  args, NULL_TREE);
+  TREE_SIDE_EFFECTS (die) = 1;
+  die = convert (void_type_node, die);
+
+  if (integer_zerop (cond) && item)
+    ffe_mark_addressable (item);
+
+  return ffecom_3 (COND_EXPR, TREE_TYPE (element), cond, element, die);
+}
+
+/* Return the computed element of an array reference.
+
+   `item' is NULL_TREE, or the transformed pointer to the array.
+   `expr' is the original opARRAYREF expression, which is transformed
+     if `item' is NULL_TREE.
+   `want_ptr' is nonzero if a pointer to the element, instead of
+     the element itself, is to be returned.  */
+
+static tree
+ffecom_arrayref_ (tree item, ffebld expr, int want_ptr)
+{
+  ffebld dims[FFECOM_dimensionsMAX];
+  int i;
+  int total_dims;
+  int flatten = ffe_is_flatten_arrays ();
+  int need_ptr;
+  tree array;
+  tree element;
+  tree tree_type;
+  tree tree_type_x;
+  const char *array_name;
+  ffetype type;
+  ffebld list;
+
+  if (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER)
+    array_name = ffesymbol_text (ffebld_symter (ffebld_left (expr)));
+  else
+    array_name = "[expr?]";
+
+  /* Build up ARRAY_REFs in reverse order (since we're column major
+     here in Fortran land). */
+
+  for (i = 0, list = ffebld_right (expr);
+       list != NULL;
+       ++i, list = ffebld_trail (list))
+    {
+      dims[i] = ffebld_head (list);
+      type = ffeinfo_type (ffebld_basictype (dims[i]),
+			   ffebld_kindtype (dims[i]));
+      if (! flatten
+	  && ffecom_typesize_pointer_ > ffecom_typesize_integer1_
+	  && ffetype_size (type) > ffecom_typesize_integer1_)
+	/* E.g. ARRAY(INDEX), given INTEGER*8 INDEX, on a system with 64-bit
+	   pointers and 32-bit integers.  Do the full 64-bit pointer
+	   arithmetic, for codes using arrays for nonstandard heap-like
+	   work.  */
+	flatten = 1;
+    }
+
+  total_dims = i;
+
+  need_ptr = want_ptr || flatten;
+
+  if (! item)
+    {
+      if (need_ptr)
+	item = ffecom_ptr_to_expr (ffebld_left (expr));
+      else
+	item = ffecom_expr (ffebld_left (expr));
+
+      if (item == error_mark_node)
+	return item;
+
+      if (ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereFLEETING
+	  && ! ffe_mark_addressable (item))
+	return error_mark_node;
+    }
+
+  if (item == error_mark_node)
+    return item;
+
+  if (need_ptr)
+    {
+      tree min;
+
+      for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item)));
+	   i >= 0;
+	   --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array)))
+	{
+	  min = TYPE_MIN_VALUE (TYPE_DOMAIN (array));
+	  element = ffecom_expr_ (dims[i], NULL, NULL, NULL, FALSE, TRUE);
+	  if (flag_bounds_check)
+	    element = ffecom_subscript_check_ (array, element, i, total_dims,
+					       array_name, item);
+	  if (element == error_mark_node)
+	    return element;
+
+	  /* Widen integral arithmetic as desired while preserving
+	     signedness.  */
+	  tree_type = TREE_TYPE (element);
+	  tree_type_x = tree_type;
+	  if (tree_type
+	      && GET_MODE_CLASS (TYPE_MODE (tree_type)) == MODE_INT
+	      && TYPE_PRECISION (tree_type) < TYPE_PRECISION (sizetype))
+	    tree_type_x = (TREE_UNSIGNED (tree_type) ? usizetype : ssizetype);
+
+	  if (TREE_TYPE (min) != tree_type_x)
+	    min = convert (tree_type_x, min);
+	  if (TREE_TYPE (element) != tree_type_x)
+	    element = convert (tree_type_x, element);
+
+	  item = ffecom_2 (PLUS_EXPR,
+			   build_pointer_type (TREE_TYPE (array)),
+			   item,
+			   size_binop (MULT_EXPR,
+				       size_in_bytes (TREE_TYPE (array)),
+				       convert (sizetype,
+						fold (build (MINUS_EXPR,
+							     tree_type_x,
+							     element, min)))));
+	}
+      if (! want_ptr)
+	{
+	  item = ffecom_1 (INDIRECT_REF,
+			   TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item))),
+			   item);
+	}
+    }
+  else
+    {
+      for (--i;
+	   i >= 0;
+	   --i)
+	{
+	  array = TYPE_MAIN_VARIANT (TREE_TYPE (item));
+
+	  element = ffecom_expr_ (dims[i], NULL, NULL, NULL, FALSE, TRUE);
+	  if (flag_bounds_check)
+	    element = ffecom_subscript_check_ (array, element, i, total_dims,
+					       array_name, item);
+	  if (element == error_mark_node)
+	    return element;
+
+	  /* Widen integral arithmetic as desired while preserving
+	     signedness.  */
+	  tree_type = TREE_TYPE (element);
+	  tree_type_x = tree_type;
+	  if (tree_type
+	      && GET_MODE_CLASS (TYPE_MODE (tree_type)) == MODE_INT
+	      && TYPE_PRECISION (tree_type) < TYPE_PRECISION (sizetype))
+	    tree_type_x = (TREE_UNSIGNED (tree_type) ? usizetype : ssizetype);
+
+	  element = convert (tree_type_x, element);
+
+	  item = ffecom_2 (ARRAY_REF,
+			   TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item))),
+			   item,
+			   element);
+	}
+    }
+
+  return item;
+}
+
+/* This is like gcc's stabilize_reference -- in fact, most of the code
+   comes from that -- but it handles the situation where the reference
+   is going to have its subparts picked at, and it shouldn't change
+   (or trigger extra invocations of functions in the subtrees) due to
+   this.  save_expr is a bit overzealous, because we don't need the
+   entire thing calculated and saved like a temp.  So, for DECLs, no
+   change is needed, because these are stable aggregates, and ARRAY_REF
+   and such might well be stable too, but for things like calculations,
+   we do need to calculate a snapshot of a value before picking at it.  */
+
+static tree
+ffecom_stabilize_aggregate_ (tree ref)
+{
+  tree result;
+  enum tree_code code = TREE_CODE (ref);
+
+  switch (code)
+    {
+    case VAR_DECL:
+    case PARM_DECL:
+    case RESULT_DECL:
+      /* No action is needed in this case.  */
+      return ref;
+
+    case NOP_EXPR:
+    case CONVERT_EXPR:
+    case FLOAT_EXPR:
+    case FIX_TRUNC_EXPR:
+    case FIX_FLOOR_EXPR:
+    case FIX_ROUND_EXPR:
+    case FIX_CEIL_EXPR:
+      result = build_nt (code, stabilize_reference (TREE_OPERAND (ref, 0)));
+      break;
+
+    case INDIRECT_REF:
+      result = build_nt (INDIRECT_REF,
+			 stabilize_reference_1 (TREE_OPERAND (ref, 0)));
+      break;
+
+    case COMPONENT_REF:
+      result = build_nt (COMPONENT_REF,
+			 stabilize_reference (TREE_OPERAND (ref, 0)),
+			 TREE_OPERAND (ref, 1));
+      break;
+
+    case BIT_FIELD_REF:
+      result = build_nt (BIT_FIELD_REF,
+			 stabilize_reference (TREE_OPERAND (ref, 0)),
+			 stabilize_reference_1 (TREE_OPERAND (ref, 1)),
+			 stabilize_reference_1 (TREE_OPERAND (ref, 2)));
+      break;
+
+    case ARRAY_REF:
+      result = build_nt (ARRAY_REF,
+			 stabilize_reference (TREE_OPERAND (ref, 0)),
+			 stabilize_reference_1 (TREE_OPERAND (ref, 1)));
+      break;
+
+    case COMPOUND_EXPR:
+      result = build_nt (COMPOUND_EXPR,
+			 stabilize_reference_1 (TREE_OPERAND (ref, 0)),
+			 stabilize_reference (TREE_OPERAND (ref, 1)));
+      break;
+
+    case RTL_EXPR:
+      abort ();
+
+
+    default:
+      return save_expr (ref);
+
+    case ERROR_MARK:
+      return error_mark_node;
+    }
+
+  TREE_TYPE (result) = TREE_TYPE (ref);
+  TREE_READONLY (result) = TREE_READONLY (ref);
+  TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (ref);
+  TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
+
+  return result;
+}
+
+/* A rip-off of gcc's convert.c convert_to_complex function,
+   reworked to handle complex implemented as C structures
+   (RECORD_TYPE with two fields, real and imaginary `r' and `i').  */
+
+static tree
+ffecom_convert_to_complex_ (tree type, tree expr)
+{
+  register enum tree_code form = TREE_CODE (TREE_TYPE (expr));
+  tree subtype;
+
+  assert (TREE_CODE (type) == RECORD_TYPE);
+
+  subtype = TREE_TYPE (TYPE_FIELDS (type));
+
+  if (form == REAL_TYPE || form == INTEGER_TYPE || form == ENUMERAL_TYPE)
+    {
+      expr = convert (subtype, expr);
+      return ffecom_2 (COMPLEX_EXPR, type, expr,
+		       convert (subtype, integer_zero_node));
+    }
+
+  if (form == RECORD_TYPE)
+    {
+      tree elt_type = TREE_TYPE (TYPE_FIELDS (TREE_TYPE (expr)));
+      if (TYPE_MAIN_VARIANT (elt_type) == TYPE_MAIN_VARIANT (subtype))
+	return expr;
+      else
+	{
+	  expr = save_expr (expr);
+	  return ffecom_2 (COMPLEX_EXPR,
+			   type,
+			   convert (subtype,
+				    ffecom_1 (REALPART_EXPR,
+					      TREE_TYPE (TYPE_FIELDS (TREE_TYPE (expr))),
+					      expr)),
+			   convert (subtype,
+				    ffecom_1 (IMAGPART_EXPR,
+					      TREE_TYPE (TYPE_FIELDS (TREE_TYPE (expr))),
+					      expr)));
+	}
+    }
+
+  if (form == POINTER_TYPE || form == REFERENCE_TYPE)
+    error ("pointer value used where a complex was expected");
+  else
+    error ("aggregate value used where a complex was expected");
+
+  return ffecom_2 (COMPLEX_EXPR, type,
+		   convert (subtype, integer_zero_node),
+		   convert (subtype, integer_zero_node));
+}
+
+/* Like gcc's convert(), but crashes if widening might happen.  */
+
+static tree
+ffecom_convert_narrow_ (tree type, tree expr)
+{
+  register tree e = expr;
+  register enum tree_code code = TREE_CODE (type);
+
+  if (type == TREE_TYPE (e)
+      || TREE_CODE (e) == ERROR_MARK)
+    return e;
+  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (e)))
+    return fold (build1 (NOP_EXPR, type, e));
+  if (TREE_CODE (TREE_TYPE (e)) == ERROR_MARK
+      || code == ERROR_MARK)
+    return error_mark_node;
+  if (TREE_CODE (TREE_TYPE (e)) == VOID_TYPE)
+    {
+      assert ("void value not ignored as it ought to be" == NULL);
+      return error_mark_node;
+    }
+  assert (code != VOID_TYPE);
+  if ((code != RECORD_TYPE)
+      && (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE))
+    assert ("converting COMPLEX to REAL" == NULL);
+  assert (code != ENUMERAL_TYPE);
+  if (code == INTEGER_TYPE)
+    {
+      assert ((TREE_CODE (TREE_TYPE (e)) == INTEGER_TYPE
+	       && TYPE_PRECISION (type) <= TYPE_PRECISION (TREE_TYPE (e)))
+	      || (TREE_CODE (TREE_TYPE (e)) == POINTER_TYPE
+		  && (TYPE_PRECISION (type)
+		      == TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (e))))));
+      return fold (convert_to_integer (type, e));
+    }
+  if (code == POINTER_TYPE)
+    {
+      assert (TREE_CODE (TREE_TYPE (e)) == POINTER_TYPE);
+      return fold (convert_to_pointer (type, e));
+    }
+  if (code == REAL_TYPE)
+    {
+      assert (TREE_CODE (TREE_TYPE (e)) == REAL_TYPE);
+      assert (TYPE_PRECISION (type) <= TYPE_PRECISION (TREE_TYPE (e)));
+      return fold (convert_to_real (type, e));
+    }
+  if (code == COMPLEX_TYPE)
+    {
+      assert (TREE_CODE (TREE_TYPE (e)) == COMPLEX_TYPE);
+      assert (TYPE_PRECISION (TREE_TYPE (type)) <= TYPE_PRECISION (TREE_TYPE (TREE_TYPE (e))));
+      return fold (convert_to_complex (type, e));
+    }
+  if (code == RECORD_TYPE)
+    {
+      assert (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE);
+      /* Check that at least the first field name agrees.  */
+      assert (DECL_NAME (TYPE_FIELDS (type))
+	      == DECL_NAME (TYPE_FIELDS (TREE_TYPE (e))));
+      assert (TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (type)))
+	      <= TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e)))));
+      if (TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (type)))
+	  == TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e)))))
+	return e;
+      return fold (ffecom_convert_to_complex_ (type, e));
+    }
+
+  assert ("conversion to non-scalar type requested" == NULL);
+  return error_mark_node;
+}
+
+/* Like gcc's convert(), but crashes if narrowing might happen.  */
+
+static tree
+ffecom_convert_widen_ (tree type, tree expr)
+{
+  register tree e = expr;
+  register enum tree_code code = TREE_CODE (type);
+
+  if (type == TREE_TYPE (e)
+      || TREE_CODE (e) == ERROR_MARK)
+    return e;
+  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (e)))
+    return fold (build1 (NOP_EXPR, type, e));
+  if (TREE_CODE (TREE_TYPE (e)) == ERROR_MARK
+      || code == ERROR_MARK)
+    return error_mark_node;
+  if (TREE_CODE (TREE_TYPE (e)) == VOID_TYPE)
+    {
+      assert ("void value not ignored as it ought to be" == NULL);
+      return error_mark_node;
+    }
+  assert (code != VOID_TYPE);
+  if ((code != RECORD_TYPE)
+      && (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE))
+    assert ("narrowing COMPLEX to REAL" == NULL);
+  assert (code != ENUMERAL_TYPE);
+  if (code == INTEGER_TYPE)
+    {
+      assert ((TREE_CODE (TREE_TYPE (e)) == INTEGER_TYPE
+	       && TYPE_PRECISION (type) >= TYPE_PRECISION (TREE_TYPE (e)))
+	      || (TREE_CODE (TREE_TYPE (e)) == POINTER_TYPE
+		  && (TYPE_PRECISION (type)
+		      == TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (e))))));
+      return fold (convert_to_integer (type, e));
+    }
+  if (code == POINTER_TYPE)
+    {
+      assert (TREE_CODE (TREE_TYPE (e)) == POINTER_TYPE);
+      return fold (convert_to_pointer (type, e));
+    }
+  if (code == REAL_TYPE)
+    {
+      assert (TREE_CODE (TREE_TYPE (e)) == REAL_TYPE);
+      assert (TYPE_PRECISION (type) >= TYPE_PRECISION (TREE_TYPE (e)));
+      return fold (convert_to_real (type, e));
+    }
+  if (code == COMPLEX_TYPE)
+    {
+      assert (TREE_CODE (TREE_TYPE (e)) == COMPLEX_TYPE);
+      assert (TYPE_PRECISION (TREE_TYPE (type)) >= TYPE_PRECISION (TREE_TYPE (TREE_TYPE (e))));
+      return fold (convert_to_complex (type, e));
+    }
+  if (code == RECORD_TYPE)
+    {
+      assert (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE);
+      /* Check that at least the first field name agrees.  */
+      assert (DECL_NAME (TYPE_FIELDS (type))
+	      == DECL_NAME (TYPE_FIELDS (TREE_TYPE (e))));
+      assert (TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (type)))
+	      >= TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e)))));
+      if (TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (type)))
+	  == TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e)))))
+	return e;
+      return fold (ffecom_convert_to_complex_ (type, e));
+    }
+
+  assert ("conversion to non-scalar type requested" == NULL);
+  return error_mark_node;
+}
+
+/* Handles making a COMPLEX type, either the standard
+   (but buggy?) gbe way, or the safer (but less elegant?)
+   f2c way.  */
+
+static tree
+ffecom_make_complex_type_ (tree subtype)
+{
+  tree type;
+  tree realfield;
+  tree imagfield;
+
+  if (ffe_is_emulate_complex ())
+    {
+      type = make_node (RECORD_TYPE);
+      realfield = ffecom_decl_field (type, NULL_TREE, "r", subtype);
+      imagfield = ffecom_decl_field (type, realfield, "i", subtype);
+      TYPE_FIELDS (type) = realfield;
+      layout_type (type);
+    }
+  else
+    {
+      type = make_node (COMPLEX_TYPE);
+      TREE_TYPE (type) = subtype;
+      layout_type (type);
+    }
+
+  return type;
+}
+
+/* Chooses either the gbe or the f2c way to build a
+   complex constant.  */
+
+static tree
+ffecom_build_complex_constant_ (tree type, tree realpart, tree imagpart)
+{
+  tree bothparts;
+
+  if (ffe_is_emulate_complex ())
+    {
+      bothparts = build_tree_list (TYPE_FIELDS (type), realpart);
+      TREE_CHAIN (bothparts) = build_tree_list (TREE_CHAIN (TYPE_FIELDS (type)), imagpart);
+      bothparts = build_constructor (type, bothparts);
+    }
+  else
+    {
+      bothparts = build_complex (type, realpart, imagpart);
+    }
+
+  return bothparts;
+}
+
+static tree
+ffecom_arglist_expr_ (const char *c, ffebld expr)
+{
+  tree list;
+  tree *plist = &list;
+  tree trail = NULL_TREE;	/* Append char length args here. */
+  tree *ptrail = &trail;
+  tree length;
+  ffebld exprh;
+  tree item;
+  bool ptr = FALSE;
+  tree wanted = NULL_TREE;
+  static const char zed[] = "0";
+
+  if (c == NULL)
+    c = &zed[0];
+
+  while (expr != NULL)
+    {
+      if (*c != '\0')
+	{
+	  ptr = FALSE;
+	  if (*c == '&')
+	    {
+	      ptr = TRUE;
+	      ++c;
+	    }
+	  switch (*(c++))
+	    {
+	    case '\0':
+	      ptr = TRUE;
+	      wanted = NULL_TREE;
+	      break;
+
+	    case 'a':
+	      assert (ptr);
+	      wanted = NULL_TREE;
+	      break;
+
+	    case 'c':
+	      wanted = ffecom_f2c_complex_type_node;
+	      break;
+
+	    case 'd':
+	      wanted = ffecom_f2c_doublereal_type_node;
+	      break;
+
+	    case 'e':
+	      wanted = ffecom_f2c_doublecomplex_type_node;
+	      break;
+
+	    case 'f':
+	      wanted = ffecom_f2c_real_type_node;
+	      break;
+
+	    case 'i':
+	      wanted = ffecom_f2c_integer_type_node;
+	      break;
+
+	    case 'j':
+	      wanted = ffecom_f2c_longint_type_node;
+	      break;
+
+	    default:
+	      assert ("bad argstring code" == NULL);
+	      wanted = NULL_TREE;
+	      break;
+	    }
+	}
+
+      exprh = ffebld_head (expr);
+      if (exprh == NULL)
+	wanted = NULL_TREE;
+
+      if ((wanted == NULL_TREE)
+	  || (ptr
+	      && (TYPE_MODE
+		  (ffecom_tree_type[ffeinfo_basictype (ffebld_info (exprh))]
+		   [ffeinfo_kindtype (ffebld_info (exprh))])
+		   == TYPE_MODE (wanted))))
+	*plist
+	  = build_tree_list (NULL_TREE,
+			     ffecom_arg_ptr_to_expr (exprh,
+						     &length));
+      else
+	{
+	  item = ffecom_arg_expr (exprh, &length);
+	  item = ffecom_convert_widen_ (wanted, item);
+	  if (ptr)
+	    {
+	      item = ffecom_1 (ADDR_EXPR,
+			       build_pointer_type (TREE_TYPE (item)),
+			       item);
+	    }
+	  *plist
+	    = build_tree_list (NULL_TREE,
+			       item);
+	}
+
+      plist = &TREE_CHAIN (*plist);
+      expr = ffebld_trail (expr);
+      if (length != NULL_TREE)
+	{
+	  *ptrail = build_tree_list (NULL_TREE, length);
+	  ptrail = &TREE_CHAIN (*ptrail);
+	}
+    }
+
+  /* We've run out of args in the call; if the implementation expects
+     more, supply null pointers for them, which the implementation can
+     check to see if an arg was omitted. */
+
+  while (*c != '\0' && *c != '0')
+    {
+      if (*c == '&')
+	++c;
+      else
+	assert ("missing arg to run-time routine!" == NULL);
+
+      switch (*(c++))
+	{
+	case '\0':
+	case 'a':
+	case 'c':
+	case 'd':
+	case 'e':
+	case 'f':
+	case 'i':
+	case 'j':
+	  break;
+
+	default:
+	  assert ("bad arg string code" == NULL);
+	  break;
+	}
+      *plist
+	= build_tree_list (NULL_TREE,
+			   null_pointer_node);
+      plist = &TREE_CHAIN (*plist);
+    }
+
+  *plist = trail;
+
+  return list;
+}
+
+static tree
+ffecom_widest_expr_type_ (ffebld list)
+{
+  ffebld item;
+  ffebld widest = NULL;
+  ffetype type;
+  ffetype widest_type = NULL;
+  tree t;
+
+  for (; list != NULL; list = ffebld_trail (list))
+    {
+      item = ffebld_head (list);
+      if (item == NULL)
+	continue;
+      if ((widest != NULL)
+	  && (ffeinfo_basictype (ffebld_info (item))
+	      != ffeinfo_basictype (ffebld_info (widest))))
+	continue;
+      type = ffeinfo_type (ffeinfo_basictype (ffebld_info (item)),
+			   ffeinfo_kindtype (ffebld_info (item)));
+      if ((widest == FFEINFO_kindtypeNONE)
+	  || (ffetype_size (type)
+	      > ffetype_size (widest_type)))
+	{
+	  widest = item;
+	  widest_type = type;
+	}
+    }
+
+  assert (widest != NULL);
+  t = ffecom_tree_type[ffeinfo_basictype (ffebld_info (widest))]
+    [ffeinfo_kindtype (ffebld_info (widest))];
+  assert (t != NULL_TREE);
+  return t;
+}
+
+/* Check whether a partial overlap between two expressions is possible.
+
+   Can *starting* to write a portion of expr1 change the value
+   computed (perhaps already, *partially*) by expr2?
+
+   Currently, this is a concern only for a COMPLEX expr1.  But if it
+   isn't in COMMON or local EQUIVALENCE, since we don't support
+   aliasing of arguments, it isn't a concern.  */
+
+static bool
+ffecom_possible_partial_overlap_ (ffebld expr1, ffebld expr2 ATTRIBUTE_UNUSED)
+{
+  ffesymbol sym;
+  ffestorag st;
+
+  switch (ffebld_op (expr1))
+    {
+    case FFEBLD_opSYMTER:
+      sym = ffebld_symter (expr1);
+      break;
+
+    case FFEBLD_opARRAYREF:
+      if (ffebld_op (ffebld_left (expr1)) != FFEBLD_opSYMTER)
+	return FALSE;
+      sym = ffebld_symter (ffebld_left (expr1));
+      break;
+
+    default:
+      return FALSE;
+    }
+
+  if (ffesymbol_where (sym) != FFEINFO_whereCOMMON
+      && (ffesymbol_where (sym) != FFEINFO_whereLOCAL
+	  || ! (st = ffesymbol_storage (sym))
+	  || ! ffestorag_parent (st)))
+    return FALSE;
+
+  /* It's in COMMON or local EQUIVALENCE.  */
+
+  return TRUE;
+}
+
+/* Check whether dest and source might overlap.  ffebld versions of these
+   might or might not be passed, will be NULL if not.
+
+   The test is really whether source_tree is modifiable and, if modified,
+   might overlap destination such that the value(s) in the destination might
+   change before it is finally modified.  dest_* are the canonized
+   destination itself.  */
+
+static bool
+ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size,
+		 tree source_tree, ffebld source UNUSED, bool scalar_arg)
+{
+  tree source_decl;
+  tree source_offset;
+  tree source_size;
+  tree t;
+
+  if (source_tree == NULL_TREE)
+    return FALSE;
+
+  switch (TREE_CODE (source_tree))
+    {
+    case ERROR_MARK:
+    case IDENTIFIER_NODE:
+    case INTEGER_CST:
+    case REAL_CST:
+    case COMPLEX_CST:
+    case STRING_CST:
+    case CONST_DECL:
+    case VAR_DECL:
+    case RESULT_DECL:
+    case FIELD_DECL:
+    case MINUS_EXPR:
+    case MULT_EXPR:
+    case TRUNC_DIV_EXPR:
+    case CEIL_DIV_EXPR:
+    case FLOOR_DIV_EXPR:
+    case ROUND_DIV_EXPR:
+    case TRUNC_MOD_EXPR:
+    case CEIL_MOD_EXPR:
+    case FLOOR_MOD_EXPR:
+    case ROUND_MOD_EXPR:
+    case RDIV_EXPR:
+    case EXACT_DIV_EXPR:
+    case FIX_TRUNC_EXPR:
+    case FIX_CEIL_EXPR:
+    case FIX_FLOOR_EXPR:
+    case FIX_ROUND_EXPR:
+    case FLOAT_EXPR:
+    case NEGATE_EXPR:
+    case MIN_EXPR:
+    case MAX_EXPR:
+    case ABS_EXPR:
+    case LSHIFT_EXPR:
+    case RSHIFT_EXPR:
+    case LROTATE_EXPR:
+    case RROTATE_EXPR:
+    case BIT_IOR_EXPR:
+    case BIT_XOR_EXPR:
+    case BIT_AND_EXPR:
+    case BIT_NOT_EXPR:
+    case TRUTH_ANDIF_EXPR:
+    case TRUTH_ORIF_EXPR:
+    case TRUTH_AND_EXPR:
+    case TRUTH_OR_EXPR:
+    case TRUTH_XOR_EXPR:
+    case TRUTH_NOT_EXPR:
+    case LT_EXPR:
+    case LE_EXPR:
+    case GT_EXPR:
+    case GE_EXPR:
+    case EQ_EXPR:
+    case NE_EXPR:
+    case COMPLEX_EXPR:
+    case CONJ_EXPR:
+    case REALPART_EXPR:
+    case IMAGPART_EXPR:
+    case LABEL_EXPR:
+    case COMPONENT_REF:
+      return FALSE;
+
+    case COMPOUND_EXPR:
+      return ffecom_overlap_ (dest_decl, dest_offset, dest_size,
+			      TREE_OPERAND (source_tree, 1), NULL,
+			      scalar_arg);
+
+    case MODIFY_EXPR:
+      return ffecom_overlap_ (dest_decl, dest_offset, dest_size,
+			      TREE_OPERAND (source_tree, 0), NULL,
+			      scalar_arg);
+
+    case CONVERT_EXPR:
+    case NOP_EXPR:
+    case NON_LVALUE_EXPR:
+    case PLUS_EXPR:
+      if (TREE_CODE (TREE_TYPE (source_tree)) != POINTER_TYPE)
+	return TRUE;
+
+      ffecom_tree_canonize_ptr_ (&source_decl, &source_offset,
+				 source_tree);
+      source_size = TYPE_SIZE (TREE_TYPE (TREE_TYPE (source_tree)));
+      break;
+
+    case COND_EXPR:
+      return
+	ffecom_overlap_ (dest_decl, dest_offset, dest_size,
+			 TREE_OPERAND (source_tree, 1), NULL,
+			 scalar_arg)
+	  || ffecom_overlap_ (dest_decl, dest_offset, dest_size,
+			      TREE_OPERAND (source_tree, 2), NULL,
+			      scalar_arg);
+
+
+    case ADDR_EXPR:
+      ffecom_tree_canonize_ref_ (&source_decl, &source_offset,
+				 &source_size,
+				 TREE_OPERAND (source_tree, 0));
+      break;
+
+    case PARM_DECL:
+      if (TREE_CODE (TREE_TYPE (source_tree)) != POINTER_TYPE)
+	return TRUE;
+
+      source_decl = source_tree;
+      source_offset = bitsize_zero_node;
+      source_size = TYPE_SIZE (TREE_TYPE (TREE_TYPE (source_tree)));
+      break;
+
+    case SAVE_EXPR:
+    case REFERENCE_EXPR:
+    case PREDECREMENT_EXPR:
+    case PREINCREMENT_EXPR:
+    case POSTDECREMENT_EXPR:
+    case POSTINCREMENT_EXPR:
+    case INDIRECT_REF:
+    case ARRAY_REF:
+    case CALL_EXPR:
+    default:
+      return TRUE;
+    }
+
+  /* Come here when source_decl, source_offset, and source_size filled
+     in appropriately.  */
+
+  if (source_decl == NULL_TREE)
+    return FALSE;		/* No decl involved, so no overlap. */
+
+  if (source_decl != dest_decl)
+    return FALSE;		/* Different decl, no overlap. */
+
+  if (TREE_CODE (dest_size) == ERROR_MARK)
+    return TRUE;		/* Assignment into entire assumed-size
+				   array?  Shouldn't happen.... */
+
+  t = ffecom_2 (LE_EXPR, integer_type_node,
+		ffecom_2 (PLUS_EXPR, TREE_TYPE (dest_offset),
+			  dest_offset,
+			  convert (TREE_TYPE (dest_offset),
+				   dest_size)),
+		convert (TREE_TYPE (dest_offset),
+			 source_offset));
+
+  if (integer_onep (t))
+    return FALSE;		/* Destination precedes source. */
+
+  if (!scalar_arg
+      || (source_size == NULL_TREE)
+      || (TREE_CODE (source_size) == ERROR_MARK)
+      || integer_zerop (source_size))
+    return TRUE;		/* No way to tell if dest follows source. */
+
+  t = ffecom_2 (LE_EXPR, integer_type_node,
+		ffecom_2 (PLUS_EXPR, TREE_TYPE (source_offset),
+			  source_offset,
+			  convert (TREE_TYPE (source_offset),
+				   source_size)),
+		convert (TREE_TYPE (source_offset),
+			 dest_offset));
+
+  if (integer_onep (t))
+    return FALSE;		/* Destination follows source. */
+
+  return TRUE;		/* Destination and source overlap. */
+}
+
+/* Check whether dest might overlap any of a list of arguments or is
+   in a COMMON area the callee might know about (and thus modify).  */
+
+static bool
+ffecom_args_overlapping_ (tree dest_tree, ffebld dest UNUSED, tree args,
+			  tree callee_commons, bool scalar_args)
+{
+  tree arg;
+  tree dest_decl;
+  tree dest_offset;
+  tree dest_size;
+
+  ffecom_tree_canonize_ref_ (&dest_decl, &dest_offset, &dest_size,
+			     dest_tree);
+
+  if (dest_decl == NULL_TREE)
+    return FALSE;		/* Seems unlikely! */
+
+  /* If the decl cannot be determined reliably, or if its in COMMON
+     and the callee isn't known to not futz with COMMON via other
+     means, overlap might happen.  */
+
+  if ((TREE_CODE (dest_decl) == ERROR_MARK)
+      || ((callee_commons != NULL_TREE)
+	  && TREE_PUBLIC (dest_decl)))
+    return TRUE;
+
+  for (; args != NULL_TREE; args = TREE_CHAIN (args))
+    {
+      if (((arg = TREE_VALUE (args)) != NULL_TREE)
+	  && ffecom_overlap_ (dest_decl, dest_offset, dest_size,
+			      arg, NULL, scalar_args))
+	return TRUE;
+    }
+
+  return FALSE;
+}
+
+/* Build a string for a variable name as used by NAMELIST.  This means that
+   if we're using the f2c library, we build an uppercase string, since
+   f2c does this.  */
+
+static tree
+ffecom_build_f2c_string_ (int i, const char *s)
+{
+  if (!ffe_is_f2c_library ())
+    return build_string (i, s);
+
+  {
+    char *tmp;
+    const char *p;
+    char *q;
+    char space[34];
+    tree t;
+
+    if (((size_t) i) > ARRAY_SIZE (space))
+      tmp = malloc_new_ks (malloc_pool_image (), "f2c_string", i);
+    else
+      tmp = &space[0];
+
+    for (p = s, q = tmp; *p != '\0'; ++p, ++q)
+      *q = TOUPPER (*p);
+    *q = '\0';
+
+    t = build_string (i, tmp);
+
+    if (((size_t) i) > ARRAY_SIZE (space))
+      malloc_kill_ks (malloc_pool_image (), tmp, i);
+
+    return t;
+  }
+}
+
+/* Returns CALL_EXPR or equivalent with given type (pass NULL_TREE for
+   type to just get whatever the function returns), handling the
+   f2c value-returning convention, if required, by prepending
+   to the arglist a pointer to a temporary to receive the return value.	 */
+
+static tree
+ffecom_call_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, tree type,
+	      tree args, tree dest_tree, ffebld dest, bool *dest_used,
+	      tree callee_commons, bool scalar_args, tree hook)
+{
+  tree item;
+  tree tempvar;
+
+  if (dest_used != NULL)
+    *dest_used = FALSE;
+
+  if (is_f2c_complex)
+    {
+      if ((dest_used == NULL)
+	  || (dest == NULL)
+	  || (ffeinfo_basictype (ffebld_info (dest))
+	      != FFEINFO_basictypeCOMPLEX)
+	  || (ffeinfo_kindtype (ffebld_info (dest)) != kt)
+	  || ((type != NULL_TREE) && (TREE_TYPE (dest_tree) != type))
+	  || ffecom_args_overlapping_ (dest_tree, dest, args,
+				       callee_commons,
+				       scalar_args))
+	{
+	  tempvar = hook;
+	  assert (tempvar);
+	}
+      else
+	{
+	  *dest_used = TRUE;
+	  tempvar = dest_tree;
+	  type = NULL_TREE;
+	}
+
+      item
+	= build_tree_list (NULL_TREE,
+			   ffecom_1 (ADDR_EXPR,
+				     build_pointer_type (TREE_TYPE (tempvar)),
+				     tempvar));
+      TREE_CHAIN (item) = args;
+
+      item = ffecom_3s (CALL_EXPR, TREE_TYPE (TREE_TYPE (TREE_TYPE (fn))), fn,
+			item, NULL_TREE);
+
+      if (tempvar != dest_tree)
+	item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar), item, tempvar);
+    }
+  else
+    item = ffecom_3s (CALL_EXPR, TREE_TYPE (TREE_TYPE (TREE_TYPE (fn))), fn,
+		      args, NULL_TREE);
+
+  if ((type != NULL_TREE) && (TREE_TYPE (item) != type))
+    item = ffecom_convert_narrow_ (type, item);
+
+  return item;
+}
+
+/* Given two arguments, transform them and make a call to the given
+   function via ffecom_call_.  */
+
+static tree
+ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex,
+		    tree type, ffebld left, ffebld right, tree dest_tree,
+		    ffebld dest, bool *dest_used, tree callee_commons,
+		    bool scalar_args, bool ref, tree hook)
+{
+  tree left_tree;
+  tree right_tree;
+  tree left_length;
+  tree right_length;
+
+  if (ref)
+    {
+      /* Pass arguments by reference.  */
+      left_tree = ffecom_arg_ptr_to_expr (left, &left_length);
+      right_tree = ffecom_arg_ptr_to_expr (right, &right_length);
+    }
+  else
+    {
+      /* Pass arguments by value.  */
+      left_tree = ffecom_arg_expr (left, &left_length);
+      right_tree = ffecom_arg_expr (right, &right_length);
+    }
+
+
+  left_tree = build_tree_list (NULL_TREE, left_tree);
+  right_tree = build_tree_list (NULL_TREE, right_tree);
+  TREE_CHAIN (left_tree) = right_tree;
+
+  if (left_length != NULL_TREE)
+    {
+      left_length = build_tree_list (NULL_TREE, left_length);
+      TREE_CHAIN (right_tree) = left_length;
+    }
+
+  if (right_length != NULL_TREE)
+    {
+      right_length = build_tree_list (NULL_TREE, right_length);
+      if (left_length != NULL_TREE)
+	TREE_CHAIN (left_length) = right_length;
+      else
+	TREE_CHAIN (right_tree) = right_length;
+    }
+
+  return ffecom_call_ (fn, kt, is_f2c_complex, type, left_tree,
+		       dest_tree, dest, dest_used, callee_commons,
+		       scalar_args, hook);
+}
+
+/* Return ptr/length args for char subexpression
+
+   Handles CHARACTER-type CONTER, SYMTER, SUBSTR, ARRAYREF, and FUNCREF
+   subexpressions by constructing the appropriate trees for the ptr-to-
+   character-text and length-of-character-text arguments in a calling
+   sequence.
+
+   Note that if with_null is TRUE, and the expression is an opCONTER,
+   a null byte is appended to the string.  */
+
+static void
+ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
+{
+  tree item;
+  tree high;
+  ffetargetCharacter1 val;
+  ffetargetCharacterSize newlen;
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opCONTER:
+      val = ffebld_constant_character1 (ffebld_conter (expr));
+      newlen = ffetarget_length_character1 (val);
+      if (with_null)
+	{
+	  /* Begin FFETARGET-NULL-KLUDGE.  */
+	  if (newlen != 0)
+	    ++newlen;
+	}
+      *length = build_int_2 (newlen, 0);
+      TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
+      high = build_int_2 (newlen, 0);
+      TREE_TYPE (high) = ffecom_f2c_ftnlen_type_node;
+      item = build_string (newlen,
+			   ffetarget_text_character1 (val));
+      /* End FFETARGET-NULL-KLUDGE.  */
+      TREE_TYPE (item)
+	= build_type_variant
+	  (build_array_type
+	   (char_type_node,
+	    build_range_type
+	    (ffecom_f2c_ftnlen_type_node,
+	     ffecom_f2c_ftnlen_one_node,
+	     high)),
+	   1, 0);
+      TREE_CONSTANT (item) = 1;
+      TREE_STATIC (item) = 1;
+      item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)),
+		       item);
+      break;
+
+    case FFEBLD_opSYMTER:
+      {
+	ffesymbol s = ffebld_symter (expr);
+
+	item = ffesymbol_hook (s).decl_tree;
+	if (item == NULL_TREE)
+	  {
+	    s = ffecom_sym_transform_ (s);
+	    item = ffesymbol_hook (s).decl_tree;
+	  }
+	if (ffesymbol_kind (s) == FFEINFO_kindENTITY)
+	  {
+	    if (ffesymbol_size (s) == FFETARGET_charactersizeNONE)
+	      *length = ffesymbol_hook (s).length_tree;
+	    else
+	      {
+		*length = build_int_2 (ffesymbol_size (s), 0);
+		TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
+	      }
+	  }
+	else if (item == error_mark_node)
+	  *length = error_mark_node;
+	else
+	  /* FFEINFO_kindFUNCTION.  */
+	  *length = NULL_TREE;
+	if (!ffesymbol_hook (s).addr
+	    && (item != error_mark_node))
+	  item = ffecom_1 (ADDR_EXPR,
+			   build_pointer_type (TREE_TYPE (item)),
+			   item);
+      }
+      break;
+
+    case FFEBLD_opARRAYREF:
+      {
+	ffecom_char_args_ (&item, length, ffebld_left (expr));
+
+	if (item == error_mark_node || *length == error_mark_node)
+	  {
+	    item = *length = error_mark_node;
+	    break;
+	  }
+
+	item = ffecom_arrayref_ (item, expr, 1);
+      }
+      break;
+
+    case FFEBLD_opSUBSTR:
+      {
+	ffebld start;
+	ffebld end;
+	ffebld thing = ffebld_right (expr);
+	tree start_tree;
+	tree end_tree;
+	const char *char_name;
+	ffebld left_symter;
+	tree array;
+
+	assert (ffebld_op (thing) == FFEBLD_opITEM);
+	start = ffebld_head (thing);
+	thing = ffebld_trail (thing);
+	assert (ffebld_trail (thing) == NULL);
+	end = ffebld_head (thing);
+
+	/* Determine name for pretty-printing range-check errors.  */
+	for (left_symter = ffebld_left (expr);
+	     left_symter && ffebld_op (left_symter) == FFEBLD_opARRAYREF;
+	     left_symter = ffebld_left (left_symter))
+	  ;
+	if (ffebld_op (left_symter) == FFEBLD_opSYMTER)
+	  char_name = ffesymbol_text (ffebld_symter (left_symter));
+	else
+	  char_name = "[expr?]";
+
+	ffecom_char_args_ (&item, length, ffebld_left (expr));
+
+	if (item == error_mark_node || *length == error_mark_node)
+	  {
+	    item = *length = error_mark_node;
+	    break;
+	  }
+
+	array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item)));
+
+	/* ~~~~Handle INTEGER*8 start/end, a la FFEBLD_opARRAYREF.  */
+
+	if (start == NULL)
+	  {
+	    if (end == NULL)
+	      ;
+	    else
+	      {
+		end_tree = ffecom_expr (end);
+		if (flag_bounds_check)
+		  end_tree = ffecom_subscript_check_ (array, end_tree, 1, 0,
+						      char_name, NULL_TREE);
+		end_tree = convert (ffecom_f2c_ftnlen_type_node,
+				    end_tree);
+
+		if (end_tree == error_mark_node)
+		  {
+		    item = *length = error_mark_node;
+		    break;
+		  }
+
+		*length = end_tree;
+	      }
+	  }
+	else
+	  {
+	    start_tree = ffecom_expr (start);
+	    if (flag_bounds_check)
+	      start_tree = ffecom_subscript_check_ (array, start_tree, 0, 0,
+						    char_name, NULL_TREE);
+	    start_tree = convert (ffecom_f2c_ftnlen_type_node,
+				  start_tree);
+
+	    if (start_tree == error_mark_node)
+	      {
+		item = *length = error_mark_node;
+		break;
+	      }
+
+	    start_tree = ffecom_save_tree (start_tree);
+
+	    item = ffecom_2 (PLUS_EXPR, TREE_TYPE (item),
+			     item,
+			     ffecom_2 (MINUS_EXPR,
+				       TREE_TYPE (start_tree),
+				       start_tree,
+				       ffecom_f2c_ftnlen_one_node));
+
+	    if (end == NULL)
+	      {
+		*length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
+				    ffecom_f2c_ftnlen_one_node,
+				    ffecom_2 (MINUS_EXPR,
+					      ffecom_f2c_ftnlen_type_node,
+					      *length,
+					      start_tree));
+	      }
+	    else
+	      {
+		end_tree = ffecom_expr (end);
+		if (flag_bounds_check)
+		  end_tree = ffecom_subscript_check_ (array, end_tree, 1, 0,
+						      char_name, NULL_TREE);
+		end_tree = convert (ffecom_f2c_ftnlen_type_node,
+				    end_tree);
+
+		if (end_tree == error_mark_node)
+		  {
+		    item = *length = error_mark_node;
+		    break;
+		  }
+
+		*length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
+				    ffecom_f2c_ftnlen_one_node,
+				    ffecom_2 (MINUS_EXPR,
+					      ffecom_f2c_ftnlen_type_node,
+					      end_tree, start_tree));
+	      }
+	  }
+      }
+      break;
+
+    case FFEBLD_opFUNCREF:
+      {
+	ffesymbol s = ffebld_symter (ffebld_left (expr));
+	tree tempvar;
+	tree args;
+	ffetargetCharacterSize size = ffeinfo_size (ffebld_info (expr));
+	ffecomGfrt ix;
+
+	if (size == FFETARGET_charactersizeNONE)
+	  /* ~~Kludge alert!  This should someday be fixed. */
+	  size = 24;
+
+	*length = build_int_2 (size, 0);
+	TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
+
+	if (ffeinfo_where (ffebld_info (ffebld_left (expr)))
+	    == FFEINFO_whereINTRINSIC)
+	  {
+	    if (size == 1)
+	      {
+		/* Invocation of an intrinsic returning CHARACTER*1.  */
+		item = ffecom_expr_intrinsic_ (expr, NULL_TREE,
+					       NULL, NULL);
+		break;
+	      }
+	    ix = ffeintrin_gfrt_direct (ffebld_symter_implementation (ffebld_left (expr)));
+	    assert (ix != FFECOM_gfrt);
+	    item = ffecom_gfrt_tree_ (ix);
+	  }
+	else
+	  {
+	    ix = FFECOM_gfrt;
+	    item = ffesymbol_hook (s).decl_tree;
+	    if (item == NULL_TREE)
+	      {
+		s = ffecom_sym_transform_ (s);
+		item = ffesymbol_hook (s).decl_tree;
+	      }
+	    if (item == error_mark_node)
+	      {
+		item = *length = error_mark_node;
+		break;
+	      }
+
+	    if (!ffesymbol_hook (s).addr)
+	      item = ffecom_1_fn (item);
+	  }
+	tempvar = ffebld_nonter_hook (expr);
+	assert (tempvar);
+	tempvar = ffecom_1 (ADDR_EXPR,
+			    build_pointer_type (TREE_TYPE (tempvar)),
+			    tempvar);
+
+	args = build_tree_list (NULL_TREE, tempvar);
+
+	if (ffesymbol_where (s) == FFEINFO_whereCONSTANT)	/* Sfunc args by value. */
+	  TREE_CHAIN (args) = ffecom_list_expr (ffebld_right (expr));
+	else
+	  {
+	    TREE_CHAIN (args) = build_tree_list (NULL_TREE, *length);
+	    if (ffesymbol_where (s) == FFEINFO_whereINTRINSIC)
+	      {
+		TREE_CHAIN (TREE_CHAIN (args))
+		  = ffecom_arglist_expr_ (ffecom_gfrt_args_ (ix),
+					  ffebld_right (expr));
+	      }
+	    else
+	      {
+		TREE_CHAIN (TREE_CHAIN (args))
+		  = ffecom_list_ptr_to_expr (ffebld_right (expr));
+	      }
+	  }
+
+	item = ffecom_3s (CALL_EXPR,
+			  TREE_TYPE (TREE_TYPE (TREE_TYPE (item))),
+			  item, args, NULL_TREE);
+	item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar), item,
+			 tempvar);
+      }
+      break;
+
+    case FFEBLD_opCONVERT:
+
+      ffecom_char_args_ (&item, length, ffebld_left (expr));
+
+      if (item == error_mark_node || *length == error_mark_node)
+	{
+	  item = *length = error_mark_node;
+	  break;
+	}
+
+      if ((ffebld_size_known (ffebld_left (expr))
+	   == FFETARGET_charactersizeNONE)
+	  || (ffebld_size_known (ffebld_left (expr)) < (ffebld_size (expr))))
+	{			/* Possible blank-padding needed, copy into
+				   temporary. */
+	  tree tempvar;
+	  tree args;
+	  tree newlen;
+
+	  tempvar = ffebld_nonter_hook (expr);
+	  assert (tempvar);
+	  tempvar = ffecom_1 (ADDR_EXPR,
+			      build_pointer_type (TREE_TYPE (tempvar)),
+			      tempvar);
+
+	  newlen = build_int_2 (ffebld_size (expr), 0);
+	  TREE_TYPE (newlen) = ffecom_f2c_ftnlen_type_node;
+
+	  args = build_tree_list (NULL_TREE, tempvar);
+	  TREE_CHAIN (args) = build_tree_list (NULL_TREE, item);
+	  TREE_CHAIN (TREE_CHAIN (args)) = build_tree_list (NULL_TREE, newlen);
+	  TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (args)))
+	    = build_tree_list (NULL_TREE, *length);
+
+	  item = ffecom_call_gfrt (FFECOM_gfrtCOPY, args, NULL_TREE);
+	  TREE_SIDE_EFFECTS (item) = 1;
+	  item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar), fold (item),
+			   tempvar);
+	  *length = newlen;
+	}
+      else
+	{			/* Just truncate the length. */
+	  *length = build_int_2 (ffebld_size (expr), 0);
+	  TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
+	}
+      break;
+
+    default:
+      assert ("bad op for single char arg expr" == NULL);
+      item = NULL_TREE;
+      break;
+    }
+
+  *xitem = item;
+}
+
+/* Check the size of the type to be sure it doesn't overflow the
+   "portable" capacities of the compiler back end.  `dummy' types
+   can generally overflow the normal sizes as long as the computations
+   themselves don't overflow.  A particular target of the back end
+   must still enforce its size requirements, though, and the back
+   end takes care of this in stor-layout.c.  */
+
+static tree
+ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy)
+{
+  if (TREE_CODE (type) == ERROR_MARK)
+    return type;
+
+  if (TYPE_SIZE (type) == NULL_TREE)
+    return type;
+
+  if (TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST)
+    return type;
+
+  /* An array is too large if size is negative or the type_size overflows
+     or its "upper half" is larger than 3 (which would make the signed
+     byte size and offset computations overflow).  */
+
+  if ((tree_int_cst_sgn (TYPE_SIZE (type)) < 0)
+      || (!dummy && (TREE_INT_CST_HIGH (TYPE_SIZE (type)) > 3
+	             || TREE_OVERFLOW (TYPE_SIZE (type)))))
+    {
+      ffebad_start (FFEBAD_ARRAY_LARGE);
+      ffebad_string (ffesymbol_text (s));
+      ffebad_here (0, ffesymbol_where_line (s), ffesymbol_where_column (s));
+      ffebad_finish ();
+
+      return error_mark_node;
+    }
+
+  return type;
+}
+
+/* Builds a length argument (PARM_DECL).  Also wraps type in an array type
+   where the dimension info is (1:size) where <size> is ffesymbol_size(s) if
+   known, length_arg if not known (FFETARGET_charactersizeNONE).  */
+
+static tree
+ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s)
+{
+  ffetargetCharacterSize sz = ffesymbol_size (s);
+  tree highval;
+  tree tlen;
+  tree type = *xtype;
+
+  if (ffesymbol_where (s) == FFEINFO_whereCONSTANT)
+    tlen = NULL_TREE;		/* A statement function, no length passed. */
+  else
+    {
+      if (ffesymbol_where (s) == FFEINFO_whereDUMMY)
+	tlen = ffecom_get_invented_identifier ("__g77_length_%s",
+					       ffesymbol_text (s));
+      else
+	tlen = ffecom_get_invented_identifier ("__g77_%s", "length");
+      tlen = build_decl (PARM_DECL, tlen, ffecom_f2c_ftnlen_type_node);
+      DECL_ARTIFICIAL (tlen) = 1;
+    }
+
+  if (sz == FFETARGET_charactersizeNONE)
+    {
+      assert (tlen != NULL_TREE);
+      highval = variable_size (tlen);
+    }
+  else
+    {
+      highval = build_int_2 (sz, 0);
+      TREE_TYPE (highval) = ffecom_f2c_ftnlen_type_node;
+    }
+
+  type = build_array_type (type,
+			   build_range_type (ffecom_f2c_ftnlen_type_node,
+					     ffecom_f2c_ftnlen_one_node,
+					     highval));
+
+  *xtype = type;
+  return tlen;
+}
+
+/* ffecom_concat_list_gather_ -- Gather list of concatenated string exprs
+
+   ffecomConcatList_ catlist;
+   ffebld expr;	 // expr of CHARACTER basictype.
+   ffetargetCharacterSize max;	// max chars to gather or _...NONE if no max
+   catlist = ffecom_concat_list_gather_(catlist,expr,max);
+
+   Scans expr for character subexpressions, updates and returns catlist
+   accordingly.	 */
+
+static ffecomConcatList_
+ffecom_concat_list_gather_ (ffecomConcatList_ catlist, ffebld expr,
+			    ffetargetCharacterSize max)
+{
+  ffetargetCharacterSize sz;
+
+ recurse:
+
+  if (expr == NULL)
+    return catlist;
+
+  if ((max != FFETARGET_charactersizeNONE) && (catlist.minlen >= max))
+    return catlist;		/* Don't append any more items. */
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opCONTER:
+    case FFEBLD_opSYMTER:
+    case FFEBLD_opARRAYREF:
+    case FFEBLD_opFUNCREF:
+    case FFEBLD_opSUBSTR:
+    case FFEBLD_opCONVERT:	/* Callers should strip this off beforehand
+				   if they don't need to preserve it. */
+      if (catlist.count == catlist.max)
+	{			/* Make a (larger) list. */
+	  ffebld *newx;
+	  int newmax;
+
+	  newmax = (catlist.max == 0) ? 8 : catlist.max * 2;
+	  newx = malloc_new_ks (malloc_pool_image (), "catlist",
+				newmax * sizeof (newx[0]));
+	  if (catlist.max != 0)
+	    {
+	      memcpy (newx, catlist.exprs, catlist.max * sizeof (newx[0]));
+	      malloc_kill_ks (malloc_pool_image (), catlist.exprs,
+			      catlist.max * sizeof (newx[0]));
+	    }
+	  catlist.max = newmax;
+	  catlist.exprs = newx;
+	}
+      if ((sz = ffebld_size_known (expr)) != FFETARGET_charactersizeNONE)
+	catlist.minlen += sz;
+      else
+	++catlist.minlen;	/* Not true for F90; can be 0 length. */
+      if ((sz = ffebld_size_max (expr)) == FFETARGET_charactersizeNONE)
+	catlist.maxlen = sz;
+      else
+	catlist.maxlen += sz;
+      if ((max != FFETARGET_charactersizeNONE) && (catlist.minlen > max))
+	{			/* This item overlaps (or is beyond) the end
+				   of the destination. */
+	  switch (ffebld_op (expr))
+	    {
+	    case FFEBLD_opCONTER:
+	    case FFEBLD_opSYMTER:
+	    case FFEBLD_opARRAYREF:
+	    case FFEBLD_opFUNCREF:
+	    case FFEBLD_opSUBSTR:
+	      /* ~~Do useful truncations here. */
+	      break;
+
+	    default:
+	      assert ("op changed or inconsistent switches!" == NULL);
+	      break;
+	    }
+	}
+      catlist.exprs[catlist.count++] = expr;
+      return catlist;
+
+    case FFEBLD_opPAREN:
+      expr = ffebld_left (expr);
+      goto recurse;		/* :::::::::::::::::::: */
+
+    case FFEBLD_opCONCATENATE:
+      catlist = ffecom_concat_list_gather_ (catlist, ffebld_left (expr), max);
+      expr = ffebld_right (expr);
+      goto recurse;		/* :::::::::::::::::::: */
+
+#if 0				/* Breaks passing small actual arg to larger
+				   dummy arg of sfunc */
+    case FFEBLD_opCONVERT:
+      expr = ffebld_left (expr);
+      {
+	ffetargetCharacterSize cmax;
+
+	cmax = catlist.len + ffebld_size_known (expr);
+
+	if ((max == FFETARGET_charactersizeNONE) || (max > cmax))
+	  max = cmax;
+      }
+      goto recurse;		/* :::::::::::::::::::: */
+#endif
+
+    case FFEBLD_opANY:
+      return catlist;
+
+    default:
+      assert ("bad op in _gather_" == NULL);
+      return catlist;
+    }
+}
+
+/* ffecom_concat_list_kill_ -- Kill list of concatenated string exprs
+
+   ffecomConcatList_ catlist;
+   ffecom_concat_list_kill_(catlist);
+
+   Anything allocated within the list info is deallocated.  */
+
+static void
+ffecom_concat_list_kill_ (ffecomConcatList_ catlist)
+{
+  if (catlist.max != 0)
+    malloc_kill_ks (malloc_pool_image (), catlist.exprs,
+		    catlist.max * sizeof (catlist.exprs[0]));
+}
+
+/* Make list of concatenated string exprs.
+
+   Returns a flattened list of concatenated subexpressions given a
+   tree of such expressions.  */
+
+static ffecomConcatList_
+ffecom_concat_list_new_ (ffebld expr, ffetargetCharacterSize max)
+{
+  ffecomConcatList_ catlist;
+
+  catlist.maxlen = catlist.minlen = catlist.max = catlist.count = 0;
+  return ffecom_concat_list_gather_ (catlist, expr, max);
+}
+
+/* Provide some kind of useful info on member of aggregate area,
+   since current g77/gcc technology does not provide debug info
+   on these members.  */
+
+static void
+ffecom_debug_kludge_ (tree aggr, const char *aggr_type, ffesymbol member,
+		      tree member_type UNUSED, ffetargetOffset offset)
+{
+  tree value;
+  tree decl;
+  int len;
+  char *buff;
+  char space[120];
+#if 0
+  tree type_id;
+
+  for (type_id = member_type;
+       TREE_CODE (type_id) != IDENTIFIER_NODE;
+       )
+    {
+      switch (TREE_CODE (type_id))
+	{
+	case INTEGER_TYPE:
+	case REAL_TYPE:
+	  type_id = TYPE_NAME (type_id);
+	  break;
+
+	case ARRAY_TYPE:
+	case COMPLEX_TYPE:
+	  type_id = TREE_TYPE (type_id);
+	  break;
+
+	default:
+	  assert ("no IDENTIFIER_NODE for type!" == NULL);
+	  type_id = error_mark_node;
+	  break;
+	}
+    }
+#endif
+
+  if (ffecom_transform_only_dummies_
+      || !ffe_is_debug_kludge ())
+    return;	/* Can't do this yet, maybe later. */
+
+  len = 60
+    + strlen (aggr_type)
+    + IDENTIFIER_LENGTH (DECL_NAME (aggr));
+#if 0
+    + IDENTIFIER_LENGTH (type_id);
+#endif
+
+  if (((size_t) len) >= ARRAY_SIZE (space))
+    buff = malloc_new_ks (malloc_pool_image (), "debug_kludge", len + 1);
+  else
+    buff = &space[0];
+
+  sprintf (&buff[0], "At (%s) `%s' plus %ld bytes",
+	   aggr_type,
+	   IDENTIFIER_POINTER (DECL_NAME (aggr)),
+	   (long int) offset);
+
+  value = build_string (len, buff);
+  TREE_TYPE (value)
+    = build_type_variant (build_array_type (char_type_node,
+					    build_range_type
+					    (integer_type_node,
+					     integer_one_node,
+					     build_int_2 (strlen (buff), 0))),
+			  1, 0);
+  decl = build_decl (VAR_DECL,
+		     ffecom_get_identifier_ (ffesymbol_text (member)),
+		     TREE_TYPE (value));
+  TREE_CONSTANT (decl) = 1;
+  TREE_STATIC (decl) = 1;
+  DECL_INITIAL (decl) = error_mark_node;
+  DECL_IN_SYSTEM_HEADER (decl) = 1;	/* Don't let -Wunused complain. */
+  decl = start_decl (decl, FALSE);
+  finish_decl (decl, value, FALSE);
+
+  if (buff != &space[0])
+    malloc_kill_ks (malloc_pool_image (), buff, len + 1);
+}
+
+/* ffecom_do_entry_ -- Do compilation of a particular entrypoint
+
+   ffesymbol fn;  // the SUBROUTINE, FUNCTION, or ENTRY symbol itself
+   int i;  // entry# for this entrypoint (used by master fn)
+   ffecom_do_entrypoint_(s,i);
+
+   Makes a public entry point that calls our private master fn (already
+   compiled).  */
+
+static void
+ffecom_do_entry_ (ffesymbol fn, int entrynum)
+{
+  ffebld item;
+  tree type;			/* Type of function. */
+  tree multi_retval;		/* Var holding return value (union). */
+  tree result;			/* Var holding result. */
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  ffeglobal g;
+  ffeglobalType gt;
+  bool charfunc;		/* All entry points return same type
+				   CHARACTER. */
+  bool cmplxfunc;		/* Use f2c way of returning COMPLEX. */
+  bool multi;			/* Master fn has multiple return types. */
+  bool altreturning = FALSE;	/* This entry point has alternate
+				   returns. */
+  location_t old_loc = input_location;
+
+  input_filename = ffesymbol_where_filename (fn);
+  input_line = ffesymbol_where_filelinenum (fn);
+
+  ffecom_doing_entry_ = TRUE;	/* Don't bother with array dimensions. */
+
+  switch (ffecom_primary_entry_kind_)
+    {
+    case FFEINFO_kindFUNCTION:
+
+      /* Determine actual return type for function. */
+
+      gt = FFEGLOBAL_typeFUNC;
+      bt = ffesymbol_basictype (fn);
+      kt = ffesymbol_kindtype (fn);
+      if (bt == FFEINFO_basictypeNONE)
+	{
+	  ffeimplic_establish_symbol (fn);
+	  if (ffesymbol_funcresult (fn) != NULL)
+	    ffeimplic_establish_symbol (ffesymbol_funcresult (fn));
+	  bt = ffesymbol_basictype (fn);
+	  kt = ffesymbol_kindtype (fn);
+	}
+
+      if (bt == FFEINFO_basictypeCHARACTER)
+	charfunc = TRUE, cmplxfunc = FALSE;
+      else if ((bt == FFEINFO_basictypeCOMPLEX)
+	       && ffesymbol_is_f2c (fn))
+	charfunc = FALSE, cmplxfunc = TRUE;
+      else
+	charfunc = cmplxfunc = FALSE;
+
+      if (charfunc)
+	type = ffecom_tree_fun_type_void;
+      else if (ffesymbol_is_f2c (fn))
+	type = ffecom_tree_fun_type[bt][kt];
+      else
+	type = build_function_type (ffecom_tree_type[bt][kt], NULL_TREE);
+
+      if ((type == NULL_TREE)
+	  || (TREE_TYPE (type) == NULL_TREE))
+	type = ffecom_tree_fun_type_void;	/* _sym_exec_transition. */
+
+      multi = (ffecom_master_bt_ == FFEINFO_basictypeNONE);
+      break;
+
+    case FFEINFO_kindSUBROUTINE:
+      gt = FFEGLOBAL_typeSUBR;
+      bt = FFEINFO_basictypeNONE;
+      kt = FFEINFO_kindtypeNONE;
+      if (ffecom_is_altreturning_)
+	{			/* Am _I_ altreturning? */
+	  for (item = ffesymbol_dummyargs (fn);
+	       item != NULL;
+	       item = ffebld_trail (item))
+	    {
+	      if (ffebld_op (ffebld_head (item)) == FFEBLD_opSTAR)
+		{
+		  altreturning = TRUE;
+		  break;
+		}
+	    }
+	  if (altreturning)
+	    type = ffecom_tree_subr_type;
+	  else
+	    type = ffecom_tree_fun_type_void;
+	}
+      else
+	type = ffecom_tree_fun_type_void;
+      charfunc = FALSE;
+      cmplxfunc = FALSE;
+      multi = FALSE;
+      break;
+
+    default:
+      assert ("say what??" == NULL);
+      /* Fall through. */
+    case FFEINFO_kindANY:
+      gt = FFEGLOBAL_typeANY;
+      bt = FFEINFO_basictypeNONE;
+      kt = FFEINFO_kindtypeNONE;
+      type = error_mark_node;
+      charfunc = FALSE;
+      cmplxfunc = FALSE;
+      multi = FALSE;
+      break;
+    }
+
+  /* build_decl uses the current lineno and input_filename to set the decl
+     source info.  So, I've putzed with ffestd and ffeste code to update that
+     source info to point to the appropriate statement just before calling
+     ffecom_do_entrypoint (which calls this fn).  */
+
+  start_function (ffecom_get_external_identifier_ (fn),
+		  type,
+		  0,		/* nested/inline */
+		  1);		/* TREE_PUBLIC */
+
+  if (((g = ffesymbol_global (fn)) != NULL)
+      && ((ffeglobal_type (g) == gt)
+	  || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)))
+    {
+      ffeglobal_set_hook (g, current_function_decl);
+    }
+
+  /* Reset args in master arg list so they get retransitioned. */
+
+  for (item = ffecom_master_arglist_;
+       item != NULL;
+       item = ffebld_trail (item))
+    {
+      ffebld arg;
+      ffesymbol s;
+
+      arg = ffebld_head (item);
+      if (ffebld_op (arg) != FFEBLD_opSYMTER)
+	continue;		/* Alternate return or some such thing. */
+      s = ffebld_symter (arg);
+      ffesymbol_hook (s).decl_tree = NULL_TREE;
+      ffesymbol_hook (s).length_tree = NULL_TREE;
+    }
+
+  /* Build dummy arg list for this entry point. */
+
+  if (charfunc || cmplxfunc)
+    {				/* Prepend arg for where result goes. */
+      tree type;
+      tree length;
+
+      if (charfunc)
+	type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt];
+      else
+	type = ffecom_tree_type[FFEINFO_basictypeCOMPLEX][kt];
+
+      result = ffecom_get_invented_identifier ("__g77_%s", "result");
+
+      /* Make length arg _and_ enhance type info for CHAR arg itself.  */
+
+      if (charfunc)
+	length = ffecom_char_enhance_arg_ (&type, fn);
+      else
+	length = NULL_TREE;	/* Not ref'd if !charfunc. */
+
+      type = build_pointer_type (type);
+      result = build_decl (PARM_DECL, result, type);
+
+      push_parm_decl (result);
+      ffecom_func_result_ = result;
+
+      if (charfunc)
+	{
+	  push_parm_decl (length);
+	  ffecom_func_length_ = length;
+	}
+    }
+  else
+    result = DECL_RESULT (current_function_decl);
+
+  ffecom_push_dummy_decls_ (ffesymbol_dummyargs (fn), FALSE);
+
+  store_parm_decls (0);
+
+  ffecom_start_compstmt ();
+  /* Disallow temp vars at this level.  */
+  current_binding_level->prep_state = 2;
+
+  /* Make local var to hold return type for multi-type master fn. */
+
+  if (multi)
+    {
+      multi_retval = ffecom_get_invented_identifier ("__g77_%s",
+						     "multi_retval");
+      multi_retval = build_decl (VAR_DECL, multi_retval,
+				 ffecom_multi_type_node_);
+      multi_retval = start_decl (multi_retval, FALSE);
+      finish_decl (multi_retval, NULL_TREE, FALSE);
+    }
+  else
+    multi_retval = NULL_TREE;	/* Not actually ref'd if !multi. */
+
+  /* Here we emit the actual code for the entry point. */
+
+  {
+    ffebld list;
+    ffebld arg;
+    ffesymbol s;
+    tree arglist = NULL_TREE;
+    tree *plist = &arglist;
+    tree prepend;
+    tree call;
+    tree actarg;
+    tree master_fn;
+
+    /* Prepare actual arg list based on master arg list. */
+
+    for (list = ffecom_master_arglist_;
+	 list != NULL;
+	 list = ffebld_trail (list))
+      {
+	arg = ffebld_head (list);
+	if (ffebld_op (arg) != FFEBLD_opSYMTER)
+	  continue;
+	s = ffebld_symter (arg);
+	if (ffesymbol_hook (s).decl_tree == NULL_TREE
+	    || ffesymbol_hook (s).decl_tree == error_mark_node)
+	  actarg = null_pointer_node;	/* We don't have this arg. */
+	else
+	  actarg = ffesymbol_hook (s).decl_tree;
+	*plist = build_tree_list (NULL_TREE, actarg);
+	plist = &TREE_CHAIN (*plist);
+      }
+
+    /* This code appends the length arguments for character
+       variables/arrays.  */
+
+    for (list = ffecom_master_arglist_;
+	 list != NULL;
+	 list = ffebld_trail (list))
+      {
+	arg = ffebld_head (list);
+	if (ffebld_op (arg) != FFEBLD_opSYMTER)
+	  continue;
+	s = ffebld_symter (arg);
+	if (ffesymbol_basictype (s) != FFEINFO_basictypeCHARACTER)
+	  continue;		/* Only looking for CHARACTER arguments. */
+	if (ffesymbol_kind (s) != FFEINFO_kindENTITY)
+	  continue;		/* Only looking for variables and arrays. */
+	if (ffesymbol_hook (s).length_tree == NULL_TREE
+	    || ffesymbol_hook (s).length_tree == error_mark_node)
+	  actarg = ffecom_f2c_ftnlen_zero_node;	/* We don't have this arg. */
+	else
+	  actarg = ffesymbol_hook (s).length_tree;
+	*plist = build_tree_list (NULL_TREE, actarg);
+	plist = &TREE_CHAIN (*plist);
+      }
+
+    /* Prepend character-value return info to actual arg list. */
+
+    if (charfunc)
+      {
+	prepend = build_tree_list (NULL_TREE, ffecom_func_result_);
+	TREE_CHAIN (prepend)
+	  = build_tree_list (NULL_TREE, ffecom_func_length_);
+	TREE_CHAIN (TREE_CHAIN (prepend)) = arglist;
+	arglist = prepend;
+      }
+
+    /* Prepend multi-type return value to actual arg list. */
+
+    if (multi)
+      {
+	prepend
+	  = build_tree_list (NULL_TREE,
+			     ffecom_1 (ADDR_EXPR,
+			      build_pointer_type (TREE_TYPE (multi_retval)),
+				       multi_retval));
+	TREE_CHAIN (prepend) = arglist;
+	arglist = prepend;
+      }
+
+    /* Prepend my entry-point number to the actual arg list. */
+
+    prepend = build_tree_list (NULL_TREE, build_int_2 (entrynum, 0));
+    TREE_CHAIN (prepend) = arglist;
+    arglist = prepend;
+
+    /* Build the call to the master function. */
+
+    master_fn = ffecom_1_fn (ffecom_previous_function_decl_);
+    call = ffecom_3s (CALL_EXPR,
+		      TREE_TYPE (TREE_TYPE (TREE_TYPE (master_fn))),
+		      master_fn, arglist, NULL_TREE);
+
+    /* Decide whether the master function is a function or subroutine, and
+       handle the return value for my entry point. */
+
+    if (charfunc || ((ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE)
+		     && !altreturning))
+      {
+	expand_expr_stmt (call);
+	expand_null_return ();
+      }
+    else if (multi && cmplxfunc)
+      {
+	expand_expr_stmt (call);
+	result
+	  = ffecom_1 (INDIRECT_REF,
+		      TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (result))),
+		      result);
+	result = ffecom_modify (NULL_TREE, result,
+				ffecom_2 (COMPONENT_REF, TREE_TYPE (result),
+					  multi_retval,
+					  ffecom_multi_fields_[bt][kt]));
+	expand_expr_stmt (result);
+	expand_null_return ();
+      }
+    else if (multi)
+      {
+	expand_expr_stmt (call);
+	result
+	  = ffecom_modify (NULL_TREE, result,
+			   convert (TREE_TYPE (result),
+				    ffecom_2 (COMPONENT_REF,
+					      ffecom_tree_type[bt][kt],
+					      multi_retval,
+					      ffecom_multi_fields_[bt][kt])));
+	expand_return (result);
+      }
+    else if (cmplxfunc)
+      {
+	result
+	  = ffecom_1 (INDIRECT_REF,
+		      TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (result))),
+		      result);
+	result = ffecom_modify (NULL_TREE, result, call);
+	expand_expr_stmt (result);
+	expand_null_return ();
+      }
+    else
+      {
+	result = ffecom_modify (NULL_TREE,
+				result,
+				convert (TREE_TYPE (result),
+					 call));
+	expand_return (result);
+      }
+  }
+
+  ffecom_end_compstmt ();
+
+  finish_function (0);
+
+  input_location = old_loc;
+
+  ffecom_doing_entry_ = FALSE;
+}
+
+/* Transform expr into gcc tree with possible destination
+
+   Recursive descent on expr while making corresponding tree nodes and
+   attaching type info and such.  If destination supplied and compatible
+   with temporary that would be made in certain cases, temporary isn't
+   made, destination used instead, and dest_used flag set TRUE.  */
+
+static tree
+ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest, bool *dest_used,
+	      bool assignp, bool widenp)
+{
+  tree item;
+  tree list;
+  tree args;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  tree t;
+  tree dt;			/* decl_tree for an ffesymbol. */
+  tree tree_type, tree_type_x;
+  tree left, right;
+  ffesymbol s;
+  enum tree_code code;
+
+  assert (expr != NULL);
+
+  if (dest_used != NULL)
+    *dest_used = FALSE;
+
+  bt = ffeinfo_basictype (ffebld_info (expr));
+  kt = ffeinfo_kindtype (ffebld_info (expr));
+  tree_type = ffecom_tree_type[bt][kt];
+
+  /* Widen integral arithmetic as desired while preserving signedness.  */
+  tree_type_x = NULL_TREE;
+  if (widenp && tree_type
+      && GET_MODE_CLASS (TYPE_MODE (tree_type)) == MODE_INT
+      && TYPE_PRECISION (tree_type) < TYPE_PRECISION (sizetype))
+    tree_type_x = (TREE_UNSIGNED (tree_type) ? usizetype : ssizetype);
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opACCTER:
+      {
+	ffebitCount i;
+	ffebit bits = ffebld_accter_bits (expr);
+	ffetargetOffset source_offset = 0;
+	ffetargetOffset dest_offset = ffebld_accter_pad (expr);
+	tree purpose;
+
+	assert (dest_offset == 0
+		|| (bt == FFEINFO_basictypeCHARACTER
+		    && kt == FFEINFO_kindtypeCHARACTER1));
+
+	list = item = NULL;
+	for (;;)
+	  {
+	    ffebldConstantUnion cu;
+	    ffebitCount length;
+	    bool value;
+	    ffebldConstantArray ca = ffebld_accter (expr);
+
+	    ffebit_test (bits, source_offset, &value, &length);
+	    if (length == 0)
+	      break;
+
+	    if (value)
+	      {
+		for (i = 0; i < length; ++i)
+		  {
+		    cu = ffebld_constantarray_get (ca, bt, kt,
+						   source_offset + i);
+
+		    t = ffecom_constantunion (&cu, bt, kt, tree_type);
+
+		    if (i == 0
+			&& dest_offset != 0)
+		      purpose = build_int_2 (dest_offset, 0);
+		    else
+		      purpose = NULL_TREE;
+
+		    if (list == NULL_TREE)
+		      list = item = build_tree_list (purpose, t);
+		    else
+		      {
+			TREE_CHAIN (item) = build_tree_list (purpose, t);
+			item = TREE_CHAIN (item);
+		      }
+		  }
+	      }
+	    source_offset += length;
+	    dest_offset += length;
+	  }
+      }
+
+      item = build_int_2 ((ffebld_accter_size (expr)
+			   + ffebld_accter_pad (expr)) - 1, 0);
+      ffebit_kill (ffebld_accter_bits (expr));
+      TREE_TYPE (item) = ffecom_integer_type_node;
+      item
+	= build_array_type
+	  (tree_type,
+	   build_range_type (ffecom_integer_type_node,
+			     ffecom_integer_zero_node,
+			     item));
+      list = build_constructor (item, list);
+      TREE_CONSTANT (list) = 1;
+      TREE_STATIC (list) = 1;
+      return list;
+
+    case FFEBLD_opARRTER:
+      {
+	ffetargetOffset i;
+
+	list = NULL_TREE;
+	if (ffebld_arrter_pad (expr) == 0)
+	  item = NULL_TREE;
+	else
+	  {
+	    assert (bt == FFEINFO_basictypeCHARACTER
+		    && kt == FFEINFO_kindtypeCHARACTER1);
+
+	    /* Becomes PURPOSE first time through loop.  */
+	    item = build_int_2 (ffebld_arrter_pad (expr), 0);
+	  }
+
+	for (i = 0; i < ffebld_arrter_size (expr); ++i)
+	  {
+	    ffebldConstantUnion cu
+	    = ffebld_constantarray_get (ffebld_arrter (expr), bt, kt, i);
+
+	    t = ffecom_constantunion (&cu, bt, kt, tree_type);
+
+	    if (list == NULL_TREE)
+	      /* Assume item is PURPOSE first time through loop.  */
+	      list = item = build_tree_list (item, t);
+	    else
+	      {
+		TREE_CHAIN (item) = build_tree_list (NULL_TREE, t);
+		item = TREE_CHAIN (item);
+	      }
+	  }
+      }
+
+      item = build_int_2 ((ffebld_arrter_size (expr)
+			  + ffebld_arrter_pad (expr)) - 1, 0);
+      TREE_TYPE (item) = ffecom_integer_type_node;
+      item
+	= build_array_type
+	  (tree_type,
+	   build_range_type (ffecom_integer_type_node,
+			     ffecom_integer_zero_node,
+			     item));
+      list = build_constructor (item, list);
+      TREE_CONSTANT (list) = 1;
+      TREE_STATIC (list) = 1;
+      return list;
+
+    case FFEBLD_opCONTER:
+      assert (ffebld_conter_pad (expr) == 0);
+      item
+	= ffecom_constantunion (&ffebld_constant_union (ffebld_conter (expr)),
+				bt, kt, tree_type);
+      return item;
+
+    case FFEBLD_opSYMTER:
+      if ((ffebld_symter_generic (expr) != FFEINTRIN_genNONE)
+	  || (ffebld_symter_specific (expr) != FFEINTRIN_specNONE))
+	return ffecom_ptr_to_expr (expr);	/* Same as %REF(intrinsic). */
+      s = ffebld_symter (expr);
+      t = ffesymbol_hook (s).decl_tree;
+
+      if (assignp)
+	{			/* ASSIGN'ed-label expr. */
+	  if (ffe_is_ugly_assign ())
+	    {
+	      /* User explicitly wants ASSIGN'ed variables to be at the same
+		 memory address as the variables when used in non-ASSIGN
+		 contexts.  That can make old, arcane, non-standard code
+		 work, but don't try to do it when a pointer wouldn't fit
+		 in the normal variable (take other approach, and warn,
+		 instead).  */
+
+	      if (t == NULL_TREE)
+		{
+		  s = ffecom_sym_transform_ (s);
+		  t = ffesymbol_hook (s).decl_tree;
+		  assert (t != NULL_TREE);
+		}
+
+	      if (t == error_mark_node)
+		return t;
+
+	      if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (t)))
+		  >= GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
+		{
+		  if (ffesymbol_hook (s).addr)
+		    t = ffecom_1 (INDIRECT_REF,
+				  TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))), t);
+		  return t;
+		}
+
+	      if (ffesymbol_hook (s).assign_tree == NULL_TREE)
+		{
+		  /* xgettext:no-c-format */
+		  ffebad_start_msg ("ASSIGN'ed label cannot fit into `%A' at %0 -- using wider sibling",
+				    FFEBAD_severityWARNING);
+		  ffebad_string (ffesymbol_text (s));
+		  ffebad_here (0, ffesymbol_where_line (s),
+			       ffesymbol_where_column (s));
+		  ffebad_finish ();
+		}
+	    }
+
+	  /* Don't use the normal variable's tree for ASSIGN, though mark
+	     it as in the system header (housekeeping).  Use an explicit,
+	     specially created sibling that is known to be wide enough
+	     to hold pointers to labels.  */
+
+	  if (t != NULL_TREE
+	      && TREE_CODE (t) == VAR_DECL)
+	    DECL_IN_SYSTEM_HEADER (t) = 1;	/* Don't let -Wunused complain. */
+
+	  t = ffesymbol_hook (s).assign_tree;
+	  if (t == NULL_TREE)
+	    {
+	      s = ffecom_sym_transform_assign_ (s);
+	      t = ffesymbol_hook (s).assign_tree;
+	      assert (t != NULL_TREE);
+	    }
+	}
+      else
+	{
+	  if (t == NULL_TREE)
+	    {
+	      s = ffecom_sym_transform_ (s);
+	      t = ffesymbol_hook (s).decl_tree;
+	      assert (t != NULL_TREE);
+	    }
+	  if (ffesymbol_hook (s).addr)
+	    t = ffecom_1 (INDIRECT_REF,
+			  TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))), t);
+	}
+      return t;
+
+    case FFEBLD_opARRAYREF:
+      return ffecom_arrayref_ (NULL_TREE, expr, 0);
+
+    case FFEBLD_opUPLUS:
+      left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
+      return ffecom_1 (NOP_EXPR, tree_type, left);
+
+    case FFEBLD_opPAREN:
+      /* ~~~Make sure Fortran rules respected here */
+      left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
+      return ffecom_1 (NOP_EXPR, tree_type, left);
+
+    case FFEBLD_opUMINUS:
+      left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
+      if (tree_type_x)
+	{
+	  tree_type = tree_type_x;
+	  left = convert (tree_type, left);
+	}
+      return ffecom_1 (NEGATE_EXPR, tree_type, left);
+
+    case FFEBLD_opADD:
+      left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
+      right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp);
+      if (tree_type_x)
+	{
+	  tree_type = tree_type_x;
+	  left = convert (tree_type, left);
+	  right = convert (tree_type, right);
+	}
+      return ffecom_2 (PLUS_EXPR, tree_type, left, right);
+
+    case FFEBLD_opSUBTRACT:
+      left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
+      right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp);
+      if (tree_type_x)
+	{
+	  tree_type = tree_type_x;
+	  left = convert (tree_type, left);
+	  right = convert (tree_type, right);
+	}
+      return ffecom_2 (MINUS_EXPR, tree_type, left, right);
+
+    case FFEBLD_opMULTIPLY:
+      left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
+      right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp);
+      if (tree_type_x)
+	{
+	  tree_type = tree_type_x;
+	  left = convert (tree_type, left);
+	  right = convert (tree_type, right);
+	}
+      return ffecom_2 (MULT_EXPR, tree_type, left, right);
+
+    case FFEBLD_opDIVIDE:
+      left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
+      right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp);
+      if (tree_type_x)
+	{
+	  tree_type = tree_type_x;
+	  left = convert (tree_type, left);
+	  right = convert (tree_type, right);
+	}
+      return ffecom_tree_divide_ (tree_type, left, right,
+			          dest_tree, dest, dest_used,
+				  ffebld_nonter_hook (expr));
+
+    case FFEBLD_opPOWER:
+      {
+	ffebld left = ffebld_left (expr);
+	ffebld right = ffebld_right (expr);
+	ffecomGfrt code;
+	ffeinfoKindtype rtkt;
+	ffeinfoKindtype ltkt;
+	bool ref = TRUE;
+
+	switch (ffeinfo_basictype (ffebld_info (right)))
+	  {
+
+	  case FFEINFO_basictypeINTEGER:
+	    if (1 || optimize)
+	      {
+		item = ffecom_expr_power_integer_ (expr);
+		if (item != NULL_TREE)
+		  return item;
+	      }
+
+	    rtkt = FFEINFO_kindtypeINTEGER1;
+	    switch (ffeinfo_basictype (ffebld_info (left)))
+	      {
+	      case FFEINFO_basictypeINTEGER:
+		if ((ffeinfo_kindtype (ffebld_info (left))
+		    == FFEINFO_kindtypeINTEGER4)
+		    || (ffeinfo_kindtype (ffebld_info (right))
+			== FFEINFO_kindtypeINTEGER4))
+		  {
+		    code = FFECOM_gfrtPOW_QQ;
+		    ltkt = FFEINFO_kindtypeINTEGER4;
+		    rtkt = FFEINFO_kindtypeINTEGER4;
+		  }
+		else
+		  {
+		    code = FFECOM_gfrtPOW_II;
+		    ltkt = FFEINFO_kindtypeINTEGER1;
+		  }
+		break;
+
+	      case FFEINFO_basictypeREAL:
+		if (ffeinfo_kindtype (ffebld_info (left))
+		    == FFEINFO_kindtypeREAL1)
+		  {
+		    code = FFECOM_gfrtPOW_RI;
+		    ltkt = FFEINFO_kindtypeREAL1;
+		  }
+		else
+		  {
+		    code = FFECOM_gfrtPOW_DI;
+		    ltkt = FFEINFO_kindtypeREAL2;
+		  }
+		break;
+
+	      case FFEINFO_basictypeCOMPLEX:
+		if (ffeinfo_kindtype (ffebld_info (left))
+		    == FFEINFO_kindtypeREAL1)
+		  {
+		    code = FFECOM_gfrtPOW_CI;	/* Overlapping result okay. */
+		    ltkt = FFEINFO_kindtypeREAL1;
+		  }
+		else
+		  {
+		    code = FFECOM_gfrtPOW_ZI;	/* Overlapping result okay. */
+		    ltkt = FFEINFO_kindtypeREAL2;
+		  }
+		break;
+
+	      default:
+		assert ("bad pow_*i" == NULL);
+		code = FFECOM_gfrtPOW_CI;	/* Overlapping result okay. */
+		ltkt = FFEINFO_kindtypeREAL1;
+		break;
+	      }
+	    if (ffeinfo_kindtype (ffebld_info (left)) != ltkt)
+	      left = ffeexpr_convert (left, NULL, NULL,
+				      ffeinfo_basictype (ffebld_info (left)),
+				      ltkt, 0,
+				      FFETARGET_charactersizeNONE,
+				      FFEEXPR_contextLET);
+	    if (ffeinfo_kindtype (ffebld_info (right)) != rtkt)
+	      right = ffeexpr_convert (right, NULL, NULL,
+				       FFEINFO_basictypeINTEGER,
+				       rtkt, 0,
+				       FFETARGET_charactersizeNONE,
+				       FFEEXPR_contextLET);
+	    break;
+
+	  case FFEINFO_basictypeREAL:
+	    if (ffeinfo_kindtype (ffebld_info (left)) == FFEINFO_kindtypeREAL1)
+	      left = ffeexpr_convert (left, NULL, NULL, FFEINFO_basictypeREAL,
+				      FFEINFO_kindtypeREALDOUBLE, 0,
+				      FFETARGET_charactersizeNONE,
+				      FFEEXPR_contextLET);
+	    if (ffeinfo_kindtype (ffebld_info (right))
+		== FFEINFO_kindtypeREAL1)
+	      right = ffeexpr_convert (right, NULL, NULL,
+				       FFEINFO_basictypeREAL,
+				       FFEINFO_kindtypeREALDOUBLE, 0,
+				       FFETARGET_charactersizeNONE,
+				       FFEEXPR_contextLET);
+	    /* We used to call FFECOM_gfrtPOW_DD here,
+	       which passes arguments by reference.  */
+	    code = FFECOM_gfrtL_POW;
+	    /* Pass arguments by value. */
+	    ref  = FALSE;
+	    break;
+
+	  case FFEINFO_basictypeCOMPLEX:
+	    if (ffeinfo_kindtype (ffebld_info (left)) == FFEINFO_kindtypeREAL1)
+	      left = ffeexpr_convert (left, NULL, NULL,
+				      FFEINFO_basictypeCOMPLEX,
+				      FFEINFO_kindtypeREALDOUBLE, 0,
+				      FFETARGET_charactersizeNONE,
+				      FFEEXPR_contextLET);
+	    if (ffeinfo_kindtype (ffebld_info (right))
+		== FFEINFO_kindtypeREAL1)
+	      right = ffeexpr_convert (right, NULL, NULL,
+				       FFEINFO_basictypeCOMPLEX,
+				       FFEINFO_kindtypeREALDOUBLE, 0,
+				       FFETARGET_charactersizeNONE,
+				       FFEEXPR_contextLET);
+	    code = FFECOM_gfrtPOW_ZZ;	/* Overlapping result okay. */
+	    ref = TRUE;			/* Pass arguments by reference. */
+	    break;
+
+	  default:
+	    assert ("bad pow_x*" == NULL);
+	    code = FFECOM_gfrtPOW_II;
+	    break;
+	  }
+	return ffecom_call_binop_ (ffecom_gfrt_tree_ (code),
+				   ffecom_gfrt_kindtype (code),
+				   (ffe_is_f2c_library ()
+				    && ffecom_gfrt_complex_[code]),
+				   tree_type, left, right,
+				   dest_tree, dest, dest_used,
+				   NULL_TREE, FALSE, ref,
+				   ffebld_nonter_hook (expr));
+      }
+
+    case FFEBLD_opNOT:
+      switch (bt)
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  item = ffecom_truth_value_invert (ffecom_expr (ffebld_left (expr)));
+	  return convert (tree_type, item);
+
+	case FFEINFO_basictypeINTEGER:
+	  return ffecom_1 (BIT_NOT_EXPR, tree_type,
+			   ffecom_expr (ffebld_left (expr)));
+
+	default:
+	  assert ("NOT bad basictype" == NULL);
+	  /* Fall through. */
+	case FFEINFO_basictypeANY:
+	  return error_mark_node;
+	}
+      break;
+
+    case FFEBLD_opFUNCREF:
+      assert (ffeinfo_basictype (ffebld_info (expr))
+	      != FFEINFO_basictypeCHARACTER);
+      /* Fall through.	 */
+    case FFEBLD_opSUBRREF:
+      if (ffeinfo_where (ffebld_info (ffebld_left (expr)))
+	  == FFEINFO_whereINTRINSIC)
+	{			/* Invocation of an intrinsic. */
+	  item = ffecom_expr_intrinsic_ (expr, dest_tree, dest,
+					 dest_used);
+	  return item;
+	}
+      s = ffebld_symter (ffebld_left (expr));
+      dt = ffesymbol_hook (s).decl_tree;
+      if (dt == NULL_TREE)
+	{
+	  s = ffecom_sym_transform_ (s);
+	  dt = ffesymbol_hook (s).decl_tree;
+	}
+      if (dt == error_mark_node)
+	return dt;
+
+      if (ffesymbol_hook (s).addr)
+	item = dt;
+      else
+	item = ffecom_1_fn (dt);
+
+      if (ffesymbol_where (s) == FFEINFO_whereCONSTANT)
+	args = ffecom_list_expr (ffebld_right (expr));
+      else
+	args = ffecom_list_ptr_to_expr (ffebld_right (expr));
+
+      if (args == error_mark_node)
+	return error_mark_node;
+
+      item = ffecom_call_ (item, kt,
+			   ffesymbol_is_f2c (s)
+			   && (bt == FFEINFO_basictypeCOMPLEX)
+			   && (ffesymbol_where (s)
+			       != FFEINFO_whereCONSTANT),
+			   tree_type,
+			   args,
+			   dest_tree, dest, dest_used,
+			   error_mark_node, FALSE,
+			   ffebld_nonter_hook (expr));
+      TREE_SIDE_EFFECTS (item) = 1;
+      return item;
+
+    case FFEBLD_opAND:
+      switch (bt)
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  item
+	    = ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
+		       ffecom_truth_value (ffecom_expr (ffebld_left (expr))),
+		     ffecom_truth_value (ffecom_expr (ffebld_right (expr))));
+	  return convert (tree_type, item);
+
+	case FFEINFO_basictypeINTEGER:
+	  return ffecom_2 (BIT_AND_EXPR, tree_type,
+			   ffecom_expr (ffebld_left (expr)),
+			   ffecom_expr (ffebld_right (expr)));
+
+	default:
+	  assert ("AND bad basictype" == NULL);
+	  /* Fall through. */
+	case FFEINFO_basictypeANY:
+	  return error_mark_node;
+	}
+      break;
+
+    case FFEBLD_opOR:
+      switch (bt)
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  item
+	    = ffecom_2 (TRUTH_ORIF_EXPR, integer_type_node,
+		       ffecom_truth_value (ffecom_expr (ffebld_left (expr))),
+		     ffecom_truth_value (ffecom_expr (ffebld_right (expr))));
+	  return convert (tree_type, item);
+
+	case FFEINFO_basictypeINTEGER:
+	  return ffecom_2 (BIT_IOR_EXPR, tree_type,
+			   ffecom_expr (ffebld_left (expr)),
+			   ffecom_expr (ffebld_right (expr)));
+
+	default:
+	  assert ("OR bad basictype" == NULL);
+	  /* Fall through. */
+	case FFEINFO_basictypeANY:
+	  return error_mark_node;
+	}
+      break;
+
+    case FFEBLD_opXOR:
+    case FFEBLD_opNEQV:
+      switch (bt)
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  item
+	    = ffecom_2 (NE_EXPR, integer_type_node,
+			ffecom_expr (ffebld_left (expr)),
+			ffecom_expr (ffebld_right (expr)));
+	  return convert (tree_type, ffecom_truth_value (item));
+
+	case FFEINFO_basictypeINTEGER:
+	  return ffecom_2 (BIT_XOR_EXPR, tree_type,
+			   ffecom_expr (ffebld_left (expr)),
+			   ffecom_expr (ffebld_right (expr)));
+
+	default:
+	  assert ("XOR/NEQV bad basictype" == NULL);
+	  /* Fall through. */
+	case FFEINFO_basictypeANY:
+	  return error_mark_node;
+	}
+      break;
+
+    case FFEBLD_opEQV:
+      switch (bt)
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  item
+	    = ffecom_2 (EQ_EXPR, integer_type_node,
+			ffecom_expr (ffebld_left (expr)),
+			ffecom_expr (ffebld_right (expr)));
+	  return convert (tree_type, ffecom_truth_value (item));
+
+	case FFEINFO_basictypeINTEGER:
+	  return
+	    ffecom_1 (BIT_NOT_EXPR, tree_type,
+		      ffecom_2 (BIT_XOR_EXPR, tree_type,
+				ffecom_expr (ffebld_left (expr)),
+				ffecom_expr (ffebld_right (expr))));
+
+	default:
+	  assert ("EQV bad basictype" == NULL);
+	  /* Fall through. */
+	case FFEINFO_basictypeANY:
+	  return error_mark_node;
+	}
+      break;
+
+    case FFEBLD_opCONVERT:
+      if (ffebld_op (ffebld_left (expr)) == FFEBLD_opANY)
+	return error_mark_node;
+
+      switch (bt)
+	{
+	case FFEINFO_basictypeLOGICAL:
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeREAL:
+	  return convert (tree_type, ffecom_expr (ffebld_left (expr)));
+
+	case FFEINFO_basictypeCOMPLEX:
+	  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+	    {
+	    case FFEINFO_basictypeINTEGER:
+	    case FFEINFO_basictypeLOGICAL:
+	    case FFEINFO_basictypeREAL:
+	      item = ffecom_expr (ffebld_left (expr));
+	      if (item == error_mark_node)
+		return error_mark_node;
+	      /* convert() takes care of converting to the subtype first,
+		 at least in gcc-2.7.2. */
+	      item = convert (tree_type, item);
+	      return item;
+
+	    case FFEINFO_basictypeCOMPLEX:
+	      return convert (tree_type, ffecom_expr (ffebld_left (expr)));
+
+	    default:
+	      assert ("CONVERT COMPLEX bad basictype" == NULL);
+	      /* Fall through. */
+	    case FFEINFO_basictypeANY:
+	      return error_mark_node;
+	    }
+	  break;
+
+	default:
+	  assert ("CONVERT bad basictype" == NULL);
+	  /* Fall through. */
+	case FFEINFO_basictypeANY:
+	  return error_mark_node;
+	}
+      break;
+
+    case FFEBLD_opLT:
+      code = LT_EXPR;
+      goto relational;		/* :::::::::::::::::::: */
+
+    case FFEBLD_opLE:
+      code = LE_EXPR;
+      goto relational;		/* :::::::::::::::::::: */
+
+    case FFEBLD_opEQ:
+      code = EQ_EXPR;
+      goto relational;		/* :::::::::::::::::::: */
+
+    case FFEBLD_opNE:
+      code = NE_EXPR;
+      goto relational;		/* :::::::::::::::::::: */
+
+    case FFEBLD_opGT:
+      code = GT_EXPR;
+      goto relational;		/* :::::::::::::::::::: */
+
+    case FFEBLD_opGE:
+      code = GE_EXPR;
+
+    relational:		/* :::::::::::::::::::: */
+      switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+	{
+	case FFEINFO_basictypeLOGICAL:
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeREAL:
+	  item = ffecom_2 (code, integer_type_node,
+			   ffecom_expr (ffebld_left (expr)),
+			   ffecom_expr (ffebld_right (expr)));
+	  return convert (tree_type, item);
+
+	case FFEINFO_basictypeCOMPLEX:
+	  assert (code == EQ_EXPR || code == NE_EXPR);
+	  {
+	    tree real_type;
+	    tree arg1 = ffecom_expr (ffebld_left (expr));
+	    tree arg2 = ffecom_expr (ffebld_right (expr));
+
+	    if (arg1 == error_mark_node || arg2 == error_mark_node)
+	      return error_mark_node;
+
+	    arg1 = ffecom_save_tree (arg1);
+	    arg2 = ffecom_save_tree (arg2);
+
+	    if (TREE_CODE (TREE_TYPE (arg1)) == COMPLEX_TYPE)
+	      {
+		real_type = TREE_TYPE (TREE_TYPE (arg1));
+		assert (real_type == TREE_TYPE (TREE_TYPE (arg2)));
+	      }
+	    else
+	      {
+		real_type = TREE_TYPE (TYPE_FIELDS (TREE_TYPE (arg1)));
+		assert (real_type == TREE_TYPE (TYPE_FIELDS (TREE_TYPE (arg2))));
+	      }
+
+	    item
+	      = ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
+			  ffecom_2 (EQ_EXPR, integer_type_node,
+				  ffecom_1 (REALPART_EXPR, real_type, arg1),
+				 ffecom_1 (REALPART_EXPR, real_type, arg2)),
+			  ffecom_2 (EQ_EXPR, integer_type_node,
+				  ffecom_1 (IMAGPART_EXPR, real_type, arg1),
+				    ffecom_1 (IMAGPART_EXPR, real_type,
+					      arg2)));
+	    if (code == EQ_EXPR)
+	      item = ffecom_truth_value (item);
+	    else
+	      item = ffecom_truth_value_invert (item);
+	    return convert (tree_type, item);
+	  }
+
+	case FFEINFO_basictypeCHARACTER:
+	  {
+	    ffebld left = ffebld_left (expr);
+	    ffebld right = ffebld_right (expr);
+	    tree left_tree;
+	    tree right_tree;
+	    tree left_length;
+	    tree right_length;
+
+	    /* f2c run-time functions do the implicit blank-padding for us,
+	       so we don't usually have to implement blank-padding ourselves.
+	       (The exception is when we pass an argument to a separately
+	       compiled statement function -- if we know the arg is not the
+	       same length as the dummy, we must truncate or extend it.	 If
+	       we "inline" statement functions, that necessity goes away as
+	       well.)
+
+	       Strip off the CONVERT operators that blank-pad.  (Truncation by
+	       CONVERT shouldn't happen here, but it can happen in
+	       assignments.) */
+
+	    while (ffebld_op (left) == FFEBLD_opCONVERT)
+	      left = ffebld_left (left);
+	    while (ffebld_op (right) == FFEBLD_opCONVERT)
+	      right = ffebld_left (right);
+
+	    left_tree = ffecom_arg_ptr_to_expr (left, &left_length);
+	    right_tree = ffecom_arg_ptr_to_expr (right, &right_length);
+
+	    if (left_tree == error_mark_node || left_length == error_mark_node
+		|| right_tree == error_mark_node
+		|| right_length == error_mark_node)
+	      return error_mark_node;
+
+	    if ((ffebld_size_known (left) == 1)
+		&& (ffebld_size_known (right) == 1))
+	      {
+		left_tree
+		  = ffecom_1 (INDIRECT_REF,
+		      TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (left_tree))),
+			      left_tree);
+		right_tree
+		  = ffecom_1 (INDIRECT_REF,
+		     TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (right_tree))),
+			      right_tree);
+
+		item
+		  = ffecom_2 (code, integer_type_node,
+			      ffecom_2 (ARRAY_REF,
+		      TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (left_tree))),
+					left_tree,
+					integer_one_node),
+			      ffecom_2 (ARRAY_REF,
+		     TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (right_tree))),
+					right_tree,
+					integer_one_node));
+	      }
+	    else
+	      {
+		item = build_tree_list (NULL_TREE, left_tree);
+		TREE_CHAIN (item) = build_tree_list (NULL_TREE, right_tree);
+		TREE_CHAIN (TREE_CHAIN (item)) = build_tree_list (NULL_TREE,
+							       left_length);
+		TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item)))
+		  = build_tree_list (NULL_TREE, right_length);
+		item = ffecom_call_gfrt (FFECOM_gfrtCMP, item, NULL_TREE);
+		item = ffecom_2 (code, integer_type_node,
+				 item,
+				 convert (TREE_TYPE (item),
+					  integer_zero_node));
+	      }
+	    item = convert (tree_type, item);
+	  }
+
+	  return item;
+
+	default:
+	  assert ("relational bad basictype" == NULL);
+	  /* Fall through. */
+	case FFEINFO_basictypeANY:
+	  return error_mark_node;
+	}
+      break;
+
+    case FFEBLD_opPERCENT_LOC:
+      item = ffecom_arg_ptr_to_expr (ffebld_left (expr), &list);
+      return convert (tree_type, item);
+
+    case FFEBLD_opPERCENT_VAL:
+      item = ffecom_arg_expr (ffebld_left (expr), &list);
+      return convert (tree_type, item);
+
+    case FFEBLD_opITEM:
+    case FFEBLD_opSTAR:
+    case FFEBLD_opBOUNDS:
+    case FFEBLD_opREPEAT:
+    case FFEBLD_opLABTER:
+    case FFEBLD_opLABTOK:
+    case FFEBLD_opIMPDO:
+    case FFEBLD_opCONCATENATE:
+    case FFEBLD_opSUBSTR:
+    default:
+      assert ("bad op" == NULL);
+      /* Fall through. */
+    case FFEBLD_opANY:
+      return error_mark_node;
+    }
+
+#if 1
+  assert ("didn't think anything got here anymore!!" == NULL);
+#else
+  switch (ffebld_arity (expr))
+    {
+    case 2:
+      TREE_OPERAND (item, 0) = ffecom_expr (ffebld_left (expr));
+      TREE_OPERAND (item, 1) = ffecom_expr (ffebld_right (expr));
+      if (TREE_OPERAND (item, 0) == error_mark_node
+	  || TREE_OPERAND (item, 1) == error_mark_node)
+	return error_mark_node;
+      break;
+
+    case 1:
+      TREE_OPERAND (item, 0) = ffecom_expr (ffebld_left (expr));
+      if (TREE_OPERAND (item, 0) == error_mark_node)
+	return error_mark_node;
+      break;
+
+    default:
+      break;
+    }
+
+  return fold (item);
+#endif
+}
+
+/* Returns the tree that does the intrinsic invocation.
+
+   Note: this function applies only to intrinsics returning
+   CHARACTER*1 or non-CHARACTER results, and to intrinsic
+   subroutines.  */
+
+static tree
+ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, ffebld dest,
+			bool *dest_used)
+{
+  tree expr_tree;
+  tree saved_expr1;		/* For those who need it. */
+  tree saved_expr2;		/* For those who need it. */
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  tree tree_type;
+  tree arg1_type;
+  tree real_type;		/* REAL type corresponding to COMPLEX. */
+  tree tempvar;
+  ffebld list = ffebld_right (expr);	/* List of (some) args. */
+  ffebld arg1;			/* For handy reference. */
+  ffebld arg2;
+  ffebld arg3;
+  ffeintrinImp codegen_imp;
+  ffecomGfrt gfrt;
+
+  assert (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER);
+
+  if (dest_used != NULL)
+    *dest_used = FALSE;
+
+  bt = ffeinfo_basictype (ffebld_info (expr));
+  kt = ffeinfo_kindtype (ffebld_info (expr));
+  tree_type = ffecom_tree_type[bt][kt];
+
+  if (list != NULL)
+    {
+      arg1 = ffebld_head (list);
+      if (arg1 != NULL && ffebld_op (arg1) == FFEBLD_opANY)
+	return error_mark_node;
+      if ((list = ffebld_trail (list)) != NULL)
+	{
+	  arg2 = ffebld_head (list);
+	  if (arg2 != NULL && ffebld_op (arg2) == FFEBLD_opANY)
+	    return error_mark_node;
+	  if ((list = ffebld_trail (list)) != NULL)
+	    {
+	      arg3 = ffebld_head (list);
+	      if (arg3 != NULL && ffebld_op (arg3) == FFEBLD_opANY)
+		return error_mark_node;
+	    }
+	  else
+	    arg3 = NULL;
+	}
+      else
+	arg2 = arg3 = NULL;
+    }
+  else
+    arg1 = arg2 = arg3 = NULL;
+
+  /* <list> ends up at the opITEM of the 3rd arg, or NULL if there are < 3
+     args.  This is used by the MAX/MIN expansions. */
+
+  if (arg1 != NULL)
+    arg1_type = ffecom_tree_type
+      [ffeinfo_basictype (ffebld_info (arg1))]
+      [ffeinfo_kindtype (ffebld_info (arg1))];
+  else
+    arg1_type = NULL_TREE;	/* Really not needed, but might catch bugs
+				   here. */
+
+  /* There are several ways for each of the cases in the following switch
+     statements to exit (from simplest to use to most complicated):
+
+     break;  (when expr_tree == NULL)
+
+     A standard call is made to the specific intrinsic just as if it had been
+     passed in as a dummy procedure and called as any old procedure.  This
+     method can produce slower code but in some cases it's the easiest way for
+     now.  However, if a (presumably faster) direct call is available,
+     that is used, so this is the easiest way in many more cases now.
+
+     gfrt = FFECOM_gfrtWHATEVER;
+     break;
+
+     gfrt contains the gfrt index of a library function to call, passing the
+     argument(s) by value rather than by reference.  Used when a more
+     careful choice of library function is needed than that provided
+     by the vanilla `break;'.
+
+     return expr_tree;
+
+     The expr_tree has been completely set up and is ready to be returned
+     as is.  No further actions are taken.  Use this when the tree is not
+     in the simple form for one of the arity_n labels.	 */
+
+  /* For info on how the switch statement cases were written, see the files
+     enclosed in comments below the switch statement. */
+
+  codegen_imp = ffebld_symter_implementation (ffebld_left (expr));
+  gfrt = ffeintrin_gfrt_direct (codegen_imp);
+  if (gfrt == FFECOM_gfrt)
+    gfrt = ffeintrin_gfrt_indirect (codegen_imp);
+
+  switch (codegen_imp)
+    {
+    case FFEINTRIN_impABS:
+    case FFEINTRIN_impCABS:
+    case FFEINTRIN_impCDABS:
+    case FFEINTRIN_impDABS:
+    case FFEINTRIN_impIABS:
+      if (ffeinfo_basictype (ffebld_info (arg1))
+	  == FFEINFO_basictypeCOMPLEX)
+	{
+	  if (kt == FFEINFO_kindtypeREAL1)
+	    gfrt = FFECOM_gfrtCABS;
+	  else if (kt == FFEINFO_kindtypeREAL2)
+	    gfrt = FFECOM_gfrtCDABS;
+	  break;
+	}
+      return ffecom_1 (ABS_EXPR, tree_type,
+		       convert (tree_type, ffecom_expr (arg1)));
+
+    case FFEINTRIN_impACOS:
+    case FFEINTRIN_impDACOS:
+      break;
+
+    case FFEINTRIN_impAIMAG:
+    case FFEINTRIN_impDIMAG:
+    case FFEINTRIN_impIMAGPART:
+      if (TREE_CODE (arg1_type) == COMPLEX_TYPE)
+	arg1_type = TREE_TYPE (arg1_type);
+      else
+	arg1_type = TREE_TYPE (TYPE_FIELDS (arg1_type));
+
+      return
+	convert (tree_type,
+		 ffecom_1 (IMAGPART_EXPR, arg1_type,
+			   ffecom_expr (arg1)));
+
+    case FFEINTRIN_impAINT:
+    case FFEINTRIN_impDINT:
+#if 0
+      /* ~~Someday implement FIX_TRUNC_EXPR yielding same type as arg.  */
+      return ffecom_1 (FIX_TRUNC_EXPR, tree_type, ffecom_expr (arg1));
+#else /* in the meantime, must use floor to avoid range problems with ints */
+      /* r__1 = r1 >= 0 ? floor(r1) : -floor(-r1); */
+      saved_expr1 = ffecom_save_tree (ffecom_expr (arg1));
+      return
+	convert (tree_type,
+		 ffecom_3 (COND_EXPR, double_type_node,
+			   ffecom_truth_value
+			   (ffecom_2 (GE_EXPR, integer_type_node,
+				      saved_expr1,
+				      convert (arg1_type,
+					       ffecom_float_zero_))),
+			   ffecom_call_gfrt (FFECOM_gfrtL_FLOOR,
+					     build_tree_list (NULL_TREE,
+						  convert (double_type_node,
+							   saved_expr1)),
+					     NULL_TREE),
+			   ffecom_1 (NEGATE_EXPR, double_type_node,
+				     ffecom_call_gfrt (FFECOM_gfrtL_FLOOR,
+						 build_tree_list (NULL_TREE,
+						  convert (double_type_node,
+						      ffecom_1 (NEGATE_EXPR,
+								arg1_type,
+							       saved_expr1))),
+						       NULL_TREE)
+				     ))
+		 );
+#endif
+
+    case FFEINTRIN_impANINT:
+    case FFEINTRIN_impDNINT:
+#if 0				/* This way of doing it won't handle real
+				   numbers of large magnitudes. */
+      saved_expr1 = ffecom_save_tree (ffecom_expr (arg1));
+      expr_tree = convert (tree_type,
+			   convert (integer_type_node,
+				    ffecom_3 (COND_EXPR, tree_type,
+					      ffecom_truth_value
+					      (ffecom_2 (GE_EXPR,
+							 integer_type_node,
+							 saved_expr1,
+						       ffecom_float_zero_)),
+					      ffecom_2 (PLUS_EXPR,
+							tree_type,
+							saved_expr1,
+							ffecom_float_half_),
+					      ffecom_2 (MINUS_EXPR,
+							tree_type,
+							saved_expr1,
+						     ffecom_float_half_))));
+      return expr_tree;
+#else /* So we instead call floor. */
+      /* r__1 = r1 >= 0 ? floor(r1 + .5) : -floor(.5 - r1) */
+      saved_expr1 = ffecom_save_tree (ffecom_expr (arg1));
+      return
+	convert (tree_type,
+		 ffecom_3 (COND_EXPR, double_type_node,
+			   ffecom_truth_value
+			   (ffecom_2 (GE_EXPR, integer_type_node,
+				      saved_expr1,
+				      convert (arg1_type,
+					       ffecom_float_zero_))),
+			   ffecom_call_gfrt (FFECOM_gfrtL_FLOOR,
+					     build_tree_list (NULL_TREE,
+						  convert (double_type_node,
+							   ffecom_2 (PLUS_EXPR,
+								     arg1_type,
+								     saved_expr1,
+								     convert (arg1_type,
+									      ffecom_float_half_)))),
+					     NULL_TREE),
+			   ffecom_1 (NEGATE_EXPR, double_type_node,
+				     ffecom_call_gfrt (FFECOM_gfrtL_FLOOR,
+						       build_tree_list (NULL_TREE,
+									convert (double_type_node,
+										 ffecom_2 (MINUS_EXPR,
+											   arg1_type,
+											   convert (arg1_type,
+												    ffecom_float_half_),
+											   saved_expr1))),
+						       NULL_TREE))
+			   )
+		 );
+#endif
+
+    case FFEINTRIN_impASIN:
+    case FFEINTRIN_impDASIN:
+    case FFEINTRIN_impATAN:
+    case FFEINTRIN_impDATAN:
+    case FFEINTRIN_impATAN2:
+    case FFEINTRIN_impDATAN2:
+      break;
+
+    case FFEINTRIN_impCHAR:
+    case FFEINTRIN_impACHAR:
+      tempvar = ffebld_nonter_hook (expr);
+      assert (tempvar);
+      {
+	tree tmv = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (tempvar)));
+
+	expr_tree = ffecom_modify (tmv,
+				   ffecom_2 (ARRAY_REF, tmv, tempvar,
+					     integer_one_node),
+				   convert (tmv, ffecom_expr (arg1)));
+      }
+      expr_tree = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar),
+			    expr_tree,
+			    tempvar);
+      expr_tree = ffecom_1 (ADDR_EXPR,
+			    build_pointer_type (TREE_TYPE (expr_tree)),
+			    expr_tree);
+      return expr_tree;
+
+    case FFEINTRIN_impCMPLX:
+    case FFEINTRIN_impDCMPLX:
+      if (arg2 == NULL)
+	return
+	  convert (tree_type, ffecom_expr (arg1));
+
+      real_type = ffecom_tree_type[FFEINFO_basictypeREAL][kt];
+      return
+	ffecom_2 (COMPLEX_EXPR, tree_type,
+		  convert (real_type, ffecom_expr (arg1)),
+		  convert (real_type,
+			   ffecom_expr (arg2)));
+
+    case FFEINTRIN_impCOMPLEX:
+      return
+	ffecom_2 (COMPLEX_EXPR, tree_type,
+		  ffecom_expr (arg1),
+		  ffecom_expr (arg2));
+
+    case FFEINTRIN_impCONJG:
+    case FFEINTRIN_impDCONJG:
+      {
+	tree arg1_tree;
+
+	real_type = ffecom_tree_type[FFEINFO_basictypeREAL][kt];
+	arg1_tree = ffecom_save_tree (ffecom_expr (arg1));
+	return
+	  ffecom_2 (COMPLEX_EXPR, tree_type,
+		    ffecom_1 (REALPART_EXPR, real_type, arg1_tree),
+		    ffecom_1 (NEGATE_EXPR, real_type,
+			      ffecom_1 (IMAGPART_EXPR, real_type, arg1_tree)));
+      }
+
+    case FFEINTRIN_impCOS:
+    case FFEINTRIN_impCCOS:
+    case FFEINTRIN_impCDCOS:
+    case FFEINTRIN_impDCOS:
+      if (bt == FFEINFO_basictypeCOMPLEX)
+	{
+	  if (kt == FFEINFO_kindtypeREAL1)
+	    gfrt = FFECOM_gfrtCCOS;	/* Overlapping result okay. */
+	  else if (kt == FFEINFO_kindtypeREAL2)
+	    gfrt = FFECOM_gfrtCDCOS;	/* Overlapping result okay. */
+	}
+      break;
+
+    case FFEINTRIN_impCOSH:
+    case FFEINTRIN_impDCOSH:
+      break;
+
+    case FFEINTRIN_impDBLE:
+    case FFEINTRIN_impDFLOAT:
+    case FFEINTRIN_impDREAL:
+    case FFEINTRIN_impFLOAT:
+    case FFEINTRIN_impIDINT:
+    case FFEINTRIN_impIFIX:
+    case FFEINTRIN_impINT2:
+    case FFEINTRIN_impINT8:
+    case FFEINTRIN_impINT:
+    case FFEINTRIN_impLONG:
+    case FFEINTRIN_impREAL:
+    case FFEINTRIN_impSHORT:
+    case FFEINTRIN_impSNGL:
+      return convert (tree_type, ffecom_expr (arg1));
+
+    case FFEINTRIN_impDIM:
+    case FFEINTRIN_impDDIM:
+    case FFEINTRIN_impIDIM:
+      saved_expr1 = ffecom_save_tree (convert (tree_type,
+					       ffecom_expr (arg1)));
+      saved_expr2 = ffecom_save_tree (convert (tree_type,
+					       ffecom_expr (arg2)));
+      return
+	ffecom_3 (COND_EXPR, tree_type,
+		  ffecom_truth_value
+		  (ffecom_2 (GT_EXPR, integer_type_node,
+			     saved_expr1,
+			     saved_expr2)),
+		  ffecom_2 (MINUS_EXPR, tree_type,
+			    saved_expr1,
+			    saved_expr2),
+		  convert (tree_type, ffecom_float_zero_));
+
+    case FFEINTRIN_impDPROD:
+      return
+	ffecom_2 (MULT_EXPR, tree_type,
+		  convert (tree_type, ffecom_expr (arg1)),
+		  convert (tree_type, ffecom_expr (arg2)));
+
+    case FFEINTRIN_impEXP:
+    case FFEINTRIN_impCDEXP:
+    case FFEINTRIN_impCEXP:
+    case FFEINTRIN_impDEXP:
+      if (bt == FFEINFO_basictypeCOMPLEX)
+	{
+	  if (kt == FFEINFO_kindtypeREAL1)
+	    gfrt = FFECOM_gfrtCEXP;	/* Overlapping result okay. */
+	  else if (kt == FFEINFO_kindtypeREAL2)
+	    gfrt = FFECOM_gfrtCDEXP;	/* Overlapping result okay. */
+	}
+      break;
+
+    case FFEINTRIN_impICHAR:
+    case FFEINTRIN_impIACHAR:
+#if 0				/* The simple approach. */
+      ffecom_char_args_ (&expr_tree, &saved_expr1 /* Ignored */ , arg1);
+      expr_tree
+	= ffecom_1 (INDIRECT_REF,
+		    TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))),
+		    expr_tree);
+      expr_tree
+	= ffecom_2 (ARRAY_REF,
+		    TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))),
+		    expr_tree,
+		    integer_one_node);
+      return convert (tree_type, expr_tree);
+#else /* The more interesting (and more optimal) approach. */
+      expr_tree = ffecom_intrinsic_ichar_ (tree_type, arg1, &saved_expr1);
+      expr_tree = ffecom_3 (COND_EXPR, tree_type,
+			    saved_expr1,
+			    expr_tree,
+			    convert (tree_type, integer_zero_node));
+      return expr_tree;
+#endif
+
+    case FFEINTRIN_impINDEX:
+      break;
+
+    case FFEINTRIN_impLEN:
+#if 0
+      break;					/* The simple approach. */
+#else
+      return ffecom_intrinsic_len_ (arg1);	/* The more optimal approach. */
+#endif
+
+    case FFEINTRIN_impLGE:
+    case FFEINTRIN_impLGT:
+    case FFEINTRIN_impLLE:
+    case FFEINTRIN_impLLT:
+      break;
+
+    case FFEINTRIN_impLOG:
+    case FFEINTRIN_impALOG:
+    case FFEINTRIN_impCDLOG:
+    case FFEINTRIN_impCLOG:
+    case FFEINTRIN_impDLOG:
+      if (bt == FFEINFO_basictypeCOMPLEX)
+	{
+	  if (kt == FFEINFO_kindtypeREAL1)
+	    gfrt = FFECOM_gfrtCLOG;	/* Overlapping result okay. */
+	  else if (kt == FFEINFO_kindtypeREAL2)
+	    gfrt = FFECOM_gfrtCDLOG;	/* Overlapping result okay. */
+	}
+      break;
+
+    case FFEINTRIN_impLOG10:
+    case FFEINTRIN_impALOG10:
+    case FFEINTRIN_impDLOG10:
+      if (gfrt != FFECOM_gfrt)
+	break;	/* Already picked one, stick with it. */
+
+      if (kt == FFEINFO_kindtypeREAL1)
+	/* We used to call FFECOM_gfrtALOG10 here.  */
+	gfrt = FFECOM_gfrtL_LOG10;
+      else if (kt == FFEINFO_kindtypeREAL2)
+	/* We used to call FFECOM_gfrtDLOG10 here.  */
+	gfrt = FFECOM_gfrtL_LOG10;
+      break;
+
+    case FFEINTRIN_impMAX:
+    case FFEINTRIN_impAMAX0:
+    case FFEINTRIN_impAMAX1:
+    case FFEINTRIN_impDMAX1:
+    case FFEINTRIN_impMAX0:
+    case FFEINTRIN_impMAX1:
+      if (bt != ffeinfo_basictype (ffebld_info (arg1)))
+	arg1_type = ffecom_widest_expr_type_ (ffebld_right (expr));
+      else
+	arg1_type = tree_type;
+      expr_tree = ffecom_2 (MAX_EXPR, arg1_type,
+			    convert (arg1_type, ffecom_expr (arg1)),
+			    convert (arg1_type, ffecom_expr (arg2)));
+      for (; list != NULL; list = ffebld_trail (list))
+	{
+	  if ((ffebld_head (list) == NULL)
+	      || (ffebld_op (ffebld_head (list)) == FFEBLD_opANY))
+	    continue;
+	  expr_tree = ffecom_2 (MAX_EXPR, arg1_type,
+				expr_tree,
+				convert (arg1_type,
+					 ffecom_expr (ffebld_head (list))));
+	}
+      return convert (tree_type, expr_tree);
+
+    case FFEINTRIN_impMIN:
+    case FFEINTRIN_impAMIN0:
+    case FFEINTRIN_impAMIN1:
+    case FFEINTRIN_impDMIN1:
+    case FFEINTRIN_impMIN0:
+    case FFEINTRIN_impMIN1:
+      if (bt != ffeinfo_basictype (ffebld_info (arg1)))
+	arg1_type = ffecom_widest_expr_type_ (ffebld_right (expr));
+      else
+	arg1_type = tree_type;
+      expr_tree = ffecom_2 (MIN_EXPR, arg1_type,
+			    convert (arg1_type, ffecom_expr (arg1)),
+			    convert (arg1_type, ffecom_expr (arg2)));
+      for (; list != NULL; list = ffebld_trail (list))
+	{
+	  if ((ffebld_head (list) == NULL)
+	      || (ffebld_op (ffebld_head (list)) == FFEBLD_opANY))
+	    continue;
+	  expr_tree = ffecom_2 (MIN_EXPR, arg1_type,
+				expr_tree,
+				convert (arg1_type,
+					 ffecom_expr (ffebld_head (list))));
+	}
+      return convert (tree_type, expr_tree);
+
+    case FFEINTRIN_impMOD:
+    case FFEINTRIN_impAMOD:
+    case FFEINTRIN_impDMOD:
+      if (bt != FFEINFO_basictypeREAL)
+	return ffecom_2 (TRUNC_MOD_EXPR, tree_type,
+			 convert (tree_type, ffecom_expr (arg1)),
+			 convert (tree_type, ffecom_expr (arg2)));
+
+      if (kt == FFEINFO_kindtypeREAL1)
+	/* We used to call FFECOM_gfrtAMOD here.  */
+	gfrt = FFECOM_gfrtL_FMOD;
+      else if (kt == FFEINFO_kindtypeREAL2)
+	/* We used to call FFECOM_gfrtDMOD here.  */
+	gfrt = FFECOM_gfrtL_FMOD;
+      break;
+
+    case FFEINTRIN_impNINT:
+    case FFEINTRIN_impIDNINT:
+#if 0
+      /* ~~Ideally FIX_ROUND_EXPR would be implemented, but it ain't yet.  */
+      return ffecom_1 (FIX_ROUND_EXPR, tree_type, ffecom_expr (arg1));
+#else
+      /* i__1 = r1 >= 0 ? floor(r1 + .5) : -floor(.5 - r1); */
+      saved_expr1 = ffecom_save_tree (ffecom_expr (arg1));
+      return
+	convert (ffecom_integer_type_node,
+		 ffecom_3 (COND_EXPR, arg1_type,
+			   ffecom_truth_value
+			   (ffecom_2 (GE_EXPR, integer_type_node,
+				      saved_expr1,
+				      convert (arg1_type,
+					       ffecom_float_zero_))),
+			   ffecom_2 (PLUS_EXPR, arg1_type,
+				     saved_expr1,
+				     convert (arg1_type,
+					      ffecom_float_half_)),
+			   ffecom_2 (MINUS_EXPR, arg1_type,
+				     saved_expr1,
+				     convert (arg1_type,
+					      ffecom_float_half_))));
+#endif
+
+    case FFEINTRIN_impSIGN:
+    case FFEINTRIN_impDSIGN:
+    case FFEINTRIN_impISIGN:
+      {
+	tree arg2_tree = ffecom_expr (arg2);
+
+	saved_expr1
+	  = ffecom_save_tree
+	  (ffecom_1 (ABS_EXPR, tree_type,
+		     convert (tree_type,
+			      ffecom_expr (arg1))));
+	expr_tree
+	  = ffecom_3 (COND_EXPR, tree_type,
+		      ffecom_truth_value
+		      (ffecom_2 (GE_EXPR, integer_type_node,
+				 arg2_tree,
+				 convert (TREE_TYPE (arg2_tree),
+					  integer_zero_node))),
+		      saved_expr1,
+		      ffecom_1 (NEGATE_EXPR, tree_type, saved_expr1));
+	/* Make sure SAVE_EXPRs get referenced early enough. */
+	expr_tree
+	  = ffecom_2 (COMPOUND_EXPR, tree_type,
+		      convert (void_type_node, saved_expr1),
+		      expr_tree);
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impSIN:
+    case FFEINTRIN_impCDSIN:
+    case FFEINTRIN_impCSIN:
+    case FFEINTRIN_impDSIN:
+      if (bt == FFEINFO_basictypeCOMPLEX)
+	{
+	  if (kt == FFEINFO_kindtypeREAL1)
+	    gfrt = FFECOM_gfrtCSIN;	/* Overlapping result okay. */
+	  else if (kt == FFEINFO_kindtypeREAL2)
+	    gfrt = FFECOM_gfrtCDSIN;	/* Overlapping result okay. */
+	}
+      break;
+
+    case FFEINTRIN_impSINH:
+    case FFEINTRIN_impDSINH:
+      break;
+
+    case FFEINTRIN_impSQRT:
+    case FFEINTRIN_impCDSQRT:
+    case FFEINTRIN_impCSQRT:
+    case FFEINTRIN_impDSQRT:
+      if (bt == FFEINFO_basictypeCOMPLEX)
+	{
+	  if (kt == FFEINFO_kindtypeREAL1)
+	    gfrt = FFECOM_gfrtCSQRT;	/* Overlapping result okay. */
+	  else if (kt == FFEINFO_kindtypeREAL2)
+	    gfrt = FFECOM_gfrtCDSQRT;	/* Overlapping result okay. */
+	}
+      break;
+
+    case FFEINTRIN_impTAN:
+    case FFEINTRIN_impDTAN:
+    case FFEINTRIN_impTANH:
+    case FFEINTRIN_impDTANH:
+      break;
+
+    case FFEINTRIN_impREALPART:
+      if (TREE_CODE (arg1_type) == COMPLEX_TYPE)
+	arg1_type = TREE_TYPE (arg1_type);
+      else
+	arg1_type = TREE_TYPE (TYPE_FIELDS (arg1_type));
+
+      return
+	convert (tree_type,
+		 ffecom_1 (REALPART_EXPR, arg1_type,
+			   ffecom_expr (arg1)));
+
+    case FFEINTRIN_impIAND:
+    case FFEINTRIN_impAND:
+      return ffecom_2 (BIT_AND_EXPR, tree_type,
+		       convert (tree_type,
+				ffecom_expr (arg1)),
+		       convert (tree_type,
+				ffecom_expr (arg2)));
+
+    case FFEINTRIN_impIOR:
+    case FFEINTRIN_impOR:
+      return ffecom_2 (BIT_IOR_EXPR, tree_type,
+		       convert (tree_type,
+				ffecom_expr (arg1)),
+		       convert (tree_type,
+				ffecom_expr (arg2)));
+
+    case FFEINTRIN_impIEOR:
+    case FFEINTRIN_impXOR:
+      return ffecom_2 (BIT_XOR_EXPR, tree_type,
+		       convert (tree_type,
+				ffecom_expr (arg1)),
+		       convert (tree_type,
+				ffecom_expr (arg2)));
+
+    case FFEINTRIN_impLSHIFT:
+      return ffecom_2 (LSHIFT_EXPR, tree_type,
+		       ffecom_expr (arg1),
+		       convert (integer_type_node,
+				ffecom_expr (arg2)));
+
+    case FFEINTRIN_impRSHIFT:
+      return ffecom_2 (RSHIFT_EXPR, tree_type,
+		       ffecom_expr (arg1),
+		       convert (integer_type_node,
+				ffecom_expr (arg2)));
+
+    case FFEINTRIN_impNOT:
+      return ffecom_1 (BIT_NOT_EXPR, tree_type, ffecom_expr (arg1));
+
+    case FFEINTRIN_impBIT_SIZE:
+      return convert (tree_type, TYPE_SIZE (arg1_type));
+
+    case FFEINTRIN_impBTEST:
+      {
+	ffetargetLogical1 target_true;
+	ffetargetLogical1 target_false;
+	tree true_tree;
+	tree false_tree;
+
+	ffetarget_logical1 (&target_true, TRUE);
+	ffetarget_logical1 (&target_false, FALSE);
+	if (target_true == 1)
+	  true_tree = convert (tree_type, integer_one_node);
+	else
+	  true_tree = convert (tree_type, build_int_2 (target_true, 0));
+	if (target_false == 0)
+	  false_tree = convert (tree_type, integer_zero_node);
+	else
+	  false_tree = convert (tree_type, build_int_2 (target_false, 0));
+
+	return
+	  ffecom_3 (COND_EXPR, tree_type,
+		    ffecom_truth_value
+		    (ffecom_2 (EQ_EXPR, integer_type_node,
+			       ffecom_2 (BIT_AND_EXPR, arg1_type,
+					 ffecom_expr (arg1),
+					 ffecom_2 (LSHIFT_EXPR, arg1_type,
+						   convert (arg1_type,
+							  integer_one_node),
+						   convert (integer_type_node,
+							    ffecom_expr (arg2)))),
+			       convert (arg1_type,
+					integer_zero_node))),
+		    false_tree,
+		    true_tree);
+      }
+
+    case FFEINTRIN_impIBCLR:
+      return
+	ffecom_2 (BIT_AND_EXPR, tree_type,
+		  ffecom_expr (arg1),
+		  ffecom_1 (BIT_NOT_EXPR, tree_type,
+			    ffecom_2 (LSHIFT_EXPR, tree_type,
+				      convert (tree_type,
+					       integer_one_node),
+				      convert (integer_type_node,
+					       ffecom_expr (arg2)))));
+
+    case FFEINTRIN_impIBITS:
+      {
+	tree arg3_tree = ffecom_save_tree (convert (integer_type_node,
+						    ffecom_expr (arg3)));
+	tree uns_type
+	= ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt];
+
+	expr_tree
+	  = ffecom_2 (BIT_AND_EXPR, tree_type,
+		      ffecom_2 (RSHIFT_EXPR, tree_type,
+				ffecom_expr (arg1),
+				convert (integer_type_node,
+					 ffecom_expr (arg2))),
+		      convert (tree_type,
+			       ffecom_2 (RSHIFT_EXPR, uns_type,
+					 ffecom_1 (BIT_NOT_EXPR,
+						   uns_type,
+						   convert (uns_type,
+							integer_zero_node)),
+					 ffecom_2 (MINUS_EXPR,
+						   integer_type_node,
+						   TYPE_SIZE (uns_type),
+						   arg3_tree))));
+	/* Fix up, because the RSHIFT_EXPR above can't shift over TYPE_SIZE.  */
+	expr_tree
+	  = ffecom_3 (COND_EXPR, tree_type,
+		      ffecom_truth_value
+		      (ffecom_2 (NE_EXPR, integer_type_node,
+				 arg3_tree,
+				 integer_zero_node)),
+		      expr_tree,
+		      convert (tree_type, integer_zero_node));
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impIBSET:
+      return
+	ffecom_2 (BIT_IOR_EXPR, tree_type,
+		  ffecom_expr (arg1),
+		  ffecom_2 (LSHIFT_EXPR, tree_type,
+			    convert (tree_type, integer_one_node),
+			    convert (integer_type_node,
+				     ffecom_expr (arg2))));
+
+    case FFEINTRIN_impISHFT:
+      {
+	tree arg1_tree = ffecom_save_tree (ffecom_expr (arg1));
+	tree arg2_tree = ffecom_save_tree (convert (integer_type_node,
+						    ffecom_expr (arg2)));
+	tree uns_type
+	= ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt];
+
+	expr_tree
+	  = ffecom_3 (COND_EXPR, tree_type,
+		      ffecom_truth_value
+		      (ffecom_2 (GE_EXPR, integer_type_node,
+				 arg2_tree,
+				 integer_zero_node)),
+		      ffecom_2 (LSHIFT_EXPR, tree_type,
+				arg1_tree,
+				arg2_tree),
+		      convert (tree_type,
+			       ffecom_2 (RSHIFT_EXPR, uns_type,
+					 convert (uns_type, arg1_tree),
+					 ffecom_1 (NEGATE_EXPR,
+						   integer_type_node,
+						   arg2_tree))));
+	/* Fix up, because {L|R}SHIFT_EXPR don't go over TYPE_SIZE bounds.  */
+	expr_tree
+	  = ffecom_3 (COND_EXPR, tree_type,
+		      ffecom_truth_value
+		      (ffecom_2 (NE_EXPR, integer_type_node,
+				 ffecom_1 (ABS_EXPR,
+					   integer_type_node,
+					   arg2_tree),
+				 TYPE_SIZE (uns_type))),
+		      expr_tree,
+		      convert (tree_type, integer_zero_node));
+	/* Make sure SAVE_EXPRs get referenced early enough. */
+	expr_tree
+	  = ffecom_2 (COMPOUND_EXPR, tree_type,
+		      convert (void_type_node, arg1_tree),
+		      ffecom_2 (COMPOUND_EXPR, tree_type,
+				convert (void_type_node, arg2_tree),
+				expr_tree));
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impISHFTC:
+      {
+	tree arg1_tree = ffecom_save_tree (ffecom_expr (arg1));
+	tree arg2_tree = ffecom_save_tree (convert (integer_type_node,
+						    ffecom_expr (arg2)));
+	tree arg3_tree = (arg3 == NULL) ? TYPE_SIZE (tree_type)
+	: ffecom_save_tree (convert (integer_type_node, ffecom_expr (arg3)));
+	tree shift_neg;
+	tree shift_pos;
+	tree mask_arg1;
+	tree masked_arg1;
+	tree uns_type
+	= ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt];
+
+	mask_arg1
+	  = ffecom_2 (LSHIFT_EXPR, tree_type,
+		      ffecom_1 (BIT_NOT_EXPR, tree_type,
+				convert (tree_type, integer_zero_node)),
+		      arg3_tree);
+	/* Fix up, because LSHIFT_EXPR above can't shift over TYPE_SIZE.  */
+	mask_arg1
+	  = ffecom_3 (COND_EXPR, tree_type,
+		      ffecom_truth_value
+		      (ffecom_2 (NE_EXPR, integer_type_node,
+				 arg3_tree,
+				 TYPE_SIZE (uns_type))),
+		      mask_arg1,
+		      convert (tree_type, integer_zero_node));
+	mask_arg1 = ffecom_save_tree (mask_arg1);
+	masked_arg1
+	  = ffecom_2 (BIT_AND_EXPR, tree_type,
+		      arg1_tree,
+		      ffecom_1 (BIT_NOT_EXPR, tree_type,
+				mask_arg1));
+	masked_arg1 = ffecom_save_tree (masked_arg1);
+	shift_neg
+	  = ffecom_2 (BIT_IOR_EXPR, tree_type,
+		      convert (tree_type,
+			       ffecom_2 (RSHIFT_EXPR, uns_type,
+					 convert (uns_type, masked_arg1),
+					 ffecom_1 (NEGATE_EXPR,
+						   integer_type_node,
+						   arg2_tree))),
+		      ffecom_2 (LSHIFT_EXPR, tree_type,
+				arg1_tree,
+				ffecom_2 (PLUS_EXPR, integer_type_node,
+					  arg2_tree,
+					  arg3_tree)));
+	shift_pos
+	  = ffecom_2 (BIT_IOR_EXPR, tree_type,
+		      ffecom_2 (LSHIFT_EXPR, tree_type,
+				arg1_tree,
+				arg2_tree),
+		      convert (tree_type,
+			       ffecom_2 (RSHIFT_EXPR, uns_type,
+					 convert (uns_type, masked_arg1),
+					 ffecom_2 (MINUS_EXPR,
+						   integer_type_node,
+						   arg3_tree,
+						   arg2_tree))));
+	expr_tree
+	  = ffecom_3 (COND_EXPR, tree_type,
+		      ffecom_truth_value
+		      (ffecom_2 (LT_EXPR, integer_type_node,
+				 arg2_tree,
+				 integer_zero_node)),
+		      shift_neg,
+		      shift_pos);
+	expr_tree
+	  = ffecom_2 (BIT_IOR_EXPR, tree_type,
+		      ffecom_2 (BIT_AND_EXPR, tree_type,
+				mask_arg1,
+				arg1_tree),
+		      ffecom_2 (BIT_AND_EXPR, tree_type,
+				ffecom_1 (BIT_NOT_EXPR, tree_type,
+					  mask_arg1),
+				expr_tree));
+	expr_tree
+	  = ffecom_3 (COND_EXPR, tree_type,
+		      ffecom_truth_value
+		      (ffecom_2 (TRUTH_ORIF_EXPR, integer_type_node,
+				 ffecom_2 (EQ_EXPR, integer_type_node,
+					   ffecom_1 (ABS_EXPR,
+						     integer_type_node,
+						     arg2_tree),
+					   arg3_tree),
+				 ffecom_2 (EQ_EXPR, integer_type_node,
+					   arg2_tree,
+					   integer_zero_node))),
+		      arg1_tree,
+		      expr_tree);
+	/* Make sure SAVE_EXPRs get referenced early enough. */
+	expr_tree
+	  = ffecom_2 (COMPOUND_EXPR, tree_type,
+		      convert (void_type_node, arg1_tree),
+		      ffecom_2 (COMPOUND_EXPR, tree_type,
+				convert (void_type_node, arg2_tree),
+				ffecom_2 (COMPOUND_EXPR, tree_type,
+					  convert (void_type_node,
+						   mask_arg1),
+					  ffecom_2 (COMPOUND_EXPR, tree_type,
+						    convert (void_type_node,
+							     masked_arg1),
+						    expr_tree))));
+	expr_tree
+	  = ffecom_2 (COMPOUND_EXPR, tree_type,
+		      convert (void_type_node,
+			       arg3_tree),
+		      expr_tree);
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impLOC:
+      {
+	tree arg1_tree = ffecom_expr (arg1);
+
+	expr_tree
+	  = convert (tree_type,
+		     ffecom_1 (ADDR_EXPR,
+			       build_pointer_type (TREE_TYPE (arg1_tree)),
+			       arg1_tree));
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impMVBITS:
+      {
+	tree arg1_tree;
+	tree arg2_tree;
+	tree arg3_tree;
+	ffebld arg4 = ffebld_head (ffebld_trail (list));
+	tree arg4_tree;
+	tree arg4_type;
+	ffebld arg5 = ffebld_head (ffebld_trail (ffebld_trail (list)));
+	tree arg5_tree;
+	tree prep_arg1;
+	tree prep_arg4;
+	tree arg5_plus_arg3;
+
+	arg2_tree = convert (integer_type_node,
+			     ffecom_expr (arg2));
+	arg3_tree = ffecom_save_tree (convert (integer_type_node,
+					       ffecom_expr (arg3)));
+	arg4_tree = ffecom_expr_rw (NULL_TREE, arg4);
+	arg4_type = TREE_TYPE (arg4_tree);
+
+	arg1_tree = ffecom_save_tree (convert (arg4_type,
+					       ffecom_expr (arg1)));
+
+	arg5_tree = ffecom_save_tree (convert (integer_type_node,
+					       ffecom_expr (arg5)));
+
+	prep_arg1
+	  = ffecom_2 (LSHIFT_EXPR, arg4_type,
+		      ffecom_2 (BIT_AND_EXPR, arg4_type,
+				ffecom_2 (RSHIFT_EXPR, arg4_type,
+					  arg1_tree,
+					  arg2_tree),
+				ffecom_1 (BIT_NOT_EXPR, arg4_type,
+					  ffecom_2 (LSHIFT_EXPR, arg4_type,
+						    ffecom_1 (BIT_NOT_EXPR,
+							      arg4_type,
+							      convert
+							      (arg4_type,
+							integer_zero_node)),
+						    arg3_tree))),
+		      arg5_tree);
+	arg5_plus_arg3
+	  = ffecom_save_tree (ffecom_2 (PLUS_EXPR, arg4_type,
+					arg5_tree,
+					arg3_tree));
+	prep_arg4
+	  = ffecom_2 (LSHIFT_EXPR, arg4_type,
+		      ffecom_1 (BIT_NOT_EXPR, arg4_type,
+				convert (arg4_type,
+					 integer_zero_node)),
+		      arg5_plus_arg3);
+	/* Fix up, because LSHIFT_EXPR above can't shift over TYPE_SIZE.  */
+	prep_arg4
+	  = ffecom_3 (COND_EXPR, arg4_type,
+		      ffecom_truth_value
+		      (ffecom_2 (NE_EXPR, integer_type_node,
+				 arg5_plus_arg3,
+				 convert (TREE_TYPE (arg5_plus_arg3),
+					  TYPE_SIZE (arg4_type)))),
+		      prep_arg4,
+		      convert (arg4_type, integer_zero_node));
+	prep_arg4
+	  = ffecom_2 (BIT_AND_EXPR, arg4_type,
+		      arg4_tree,
+		      ffecom_2 (BIT_IOR_EXPR, arg4_type,
+				prep_arg4,
+				ffecom_1 (BIT_NOT_EXPR, arg4_type,
+					  ffecom_2 (LSHIFT_EXPR, arg4_type,
+						    ffecom_1 (BIT_NOT_EXPR,
+							      arg4_type,
+							      convert
+							      (arg4_type,
+							integer_zero_node)),
+						    arg5_tree))));
+	prep_arg1
+	  = ffecom_2 (BIT_IOR_EXPR, arg4_type,
+		      prep_arg1,
+		      prep_arg4);
+	/* Fix up (twice), because LSHIFT_EXPR above
+	   can't shift over TYPE_SIZE.  */
+	prep_arg1
+	  = ffecom_3 (COND_EXPR, arg4_type,
+		      ffecom_truth_value
+		      (ffecom_2 (NE_EXPR, integer_type_node,
+				 arg3_tree,
+				 convert (TREE_TYPE (arg3_tree),
+					  integer_zero_node))),
+		      prep_arg1,
+		      arg4_tree);
+	prep_arg1
+	  = ffecom_3 (COND_EXPR, arg4_type,
+		      ffecom_truth_value
+		      (ffecom_2 (NE_EXPR, integer_type_node,
+				 arg3_tree,
+				 convert (TREE_TYPE (arg3_tree),
+					  TYPE_SIZE (arg4_type)))),
+		      prep_arg1,
+		      arg1_tree);
+	expr_tree
+	  = ffecom_2s (MODIFY_EXPR, void_type_node,
+		       arg4_tree,
+		       prep_arg1);
+	/* Make sure SAVE_EXPRs get referenced early enough. */
+	expr_tree
+	  = ffecom_2 (COMPOUND_EXPR, void_type_node,
+		      arg1_tree,
+		      ffecom_2 (COMPOUND_EXPR, void_type_node,
+				arg3_tree,
+				ffecom_2 (COMPOUND_EXPR, void_type_node,
+					  arg5_tree,
+					  ffecom_2 (COMPOUND_EXPR, void_type_node,
+						    arg5_plus_arg3,
+						    expr_tree))));
+	expr_tree
+	  = ffecom_2 (COMPOUND_EXPR, void_type_node,
+		      arg4_tree,
+		      expr_tree);
+
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impDERF:
+    case FFEINTRIN_impERF:
+    case FFEINTRIN_impDERFC:
+    case FFEINTRIN_impERFC:
+      break;
+
+    case FFEINTRIN_impIARGC:
+      /* extern int xargc; i__1 = xargc - 1; */
+      expr_tree = ffecom_2 (MINUS_EXPR, TREE_TYPE (ffecom_tree_xargc_),
+			    ffecom_tree_xargc_,
+			    convert (TREE_TYPE (ffecom_tree_xargc_),
+				     integer_one_node));
+      return expr_tree;
+
+    case FFEINTRIN_impSIGNAL_func:
+    case FFEINTRIN_impSIGNAL_subr:
+      {
+	tree arg1_tree;
+	tree arg2_tree;
+	tree arg3_tree;
+
+	arg1_tree = convert (ffecom_f2c_integer_type_node,
+			     ffecom_expr (arg1));
+	arg1_tree = ffecom_1 (ADDR_EXPR,
+			      build_pointer_type (TREE_TYPE (arg1_tree)),
+			      arg1_tree);
+
+	/* Pass procedure as a pointer to it, anything else by value.  */
+	if (ffeinfo_kind (ffebld_info (arg2)) == FFEINFO_kindENTITY)
+	  arg2_tree = convert (integer_type_node, ffecom_expr (arg2));
+	else
+	  arg2_tree = ffecom_ptr_to_expr (arg2);
+	arg2_tree = convert (TREE_TYPE (null_pointer_node),
+			     arg2_tree);
+
+	if (arg3 != NULL)
+	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
+	else
+	  arg3_tree = NULL_TREE;
+
+	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+	TREE_CHAIN (arg1_tree) = arg2_tree;
+
+	expr_tree
+	  = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+			  ffecom_gfrt_kindtype (gfrt),
+			  FALSE,
+			  ((codegen_imp == FFEINTRIN_impSIGNAL_subr) ?
+			   NULL_TREE :
+			   tree_type),
+			  arg1_tree,
+			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+			  ffebld_nonter_hook (expr));
+
+	if (arg3_tree != NULL_TREE)
+	  expr_tree
+	    = ffecom_modify (NULL_TREE, arg3_tree,
+			     convert (TREE_TYPE (arg3_tree),
+				      expr_tree));
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impALARM:
+      {
+	tree arg1_tree;
+	tree arg2_tree;
+	tree arg3_tree;
+
+	arg1_tree = convert (ffecom_f2c_integer_type_node,
+			     ffecom_expr (arg1));
+	arg1_tree = ffecom_1 (ADDR_EXPR,
+			      build_pointer_type (TREE_TYPE (arg1_tree)),
+			      arg1_tree);
+
+	/* Pass procedure as a pointer to it, anything else by value.  */
+	if (ffeinfo_kind (ffebld_info (arg2)) == FFEINFO_kindENTITY)
+	  arg2_tree = convert (integer_type_node, ffecom_expr (arg2));
+	else
+	  arg2_tree = ffecom_ptr_to_expr (arg2);
+	arg2_tree = convert (TREE_TYPE (null_pointer_node),
+			     arg2_tree);
+
+	if (arg3 != NULL)
+	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
+	else
+	  arg3_tree = NULL_TREE;
+
+	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+	TREE_CHAIN (arg1_tree) = arg2_tree;
+
+	expr_tree
+	  = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+			  ffecom_gfrt_kindtype (gfrt),
+			  FALSE,
+			  NULL_TREE,
+			  arg1_tree,
+			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+			  ffebld_nonter_hook (expr));
+
+	if (arg3_tree != NULL_TREE)
+	  expr_tree
+	    = ffecom_modify (NULL_TREE, arg3_tree,
+			     convert (TREE_TYPE (arg3_tree),
+				      expr_tree));
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impCHDIR_subr:
+    case FFEINTRIN_impFDATE_subr:
+    case FFEINTRIN_impFGET_subr:
+    case FFEINTRIN_impFPUT_subr:
+    case FFEINTRIN_impGETCWD_subr:
+    case FFEINTRIN_impHOSTNM_subr:
+    case FFEINTRIN_impSYSTEM_subr:
+    case FFEINTRIN_impUNLINK_subr:
+      {
+	tree arg1_len = integer_zero_node;
+	tree arg1_tree;
+	tree arg2_tree;
+
+	arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len);
+
+	if (arg2 != NULL)
+	  arg2_tree = ffecom_expr_w (NULL_TREE, arg2);
+	else
+	  arg2_tree = NULL_TREE;
+
+	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+	arg1_len = build_tree_list (NULL_TREE, arg1_len);
+	TREE_CHAIN (arg1_tree) = arg1_len;
+
+	expr_tree
+	  = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+			  ffecom_gfrt_kindtype (gfrt),
+			  FALSE,
+			  NULL_TREE,
+			  arg1_tree,
+			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+			  ffebld_nonter_hook (expr));
+
+	if (arg2_tree != NULL_TREE)
+	  expr_tree
+	    = ffecom_modify (NULL_TREE, arg2_tree,
+			     convert (TREE_TYPE (arg2_tree),
+				      expr_tree));
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impEXIT:
+      if (arg1 != NULL)
+	break;
+
+      expr_tree = build_tree_list (NULL_TREE,
+				   ffecom_1 (ADDR_EXPR,
+					     build_pointer_type
+					     (ffecom_integer_type_node),
+					     integer_zero_node));
+
+      return
+	ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+		      ffecom_gfrt_kindtype (gfrt),
+		      FALSE,
+		      void_type_node,
+		      expr_tree,
+		      NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+		      ffebld_nonter_hook (expr));
+
+    case FFEINTRIN_impFLUSH:
+      if (arg1 == NULL)
+	gfrt = FFECOM_gfrtFLUSH;
+      else
+	gfrt = FFECOM_gfrtFLUSH1;
+      break;
+
+    case FFEINTRIN_impCHMOD_subr:
+    case FFEINTRIN_impLINK_subr:
+    case FFEINTRIN_impRENAME_subr:
+    case FFEINTRIN_impSYMLNK_subr:
+      {
+	tree arg1_len = integer_zero_node;
+	tree arg1_tree;
+	tree arg2_len = integer_zero_node;
+	tree arg2_tree;
+	tree arg3_tree;
+
+	arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len);
+	arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len);
+	if (arg3 != NULL)
+	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
+	else
+	  arg3_tree = NULL_TREE;
+
+	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+	arg1_len = build_tree_list (NULL_TREE, arg1_len);
+	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+	arg2_len = build_tree_list (NULL_TREE, arg2_len);
+	TREE_CHAIN (arg1_tree) = arg2_tree;
+	TREE_CHAIN (arg2_tree) = arg1_len;
+	TREE_CHAIN (arg1_len) = arg2_len;
+	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+				  ffecom_gfrt_kindtype (gfrt),
+				  FALSE,
+				  NULL_TREE,
+				  arg1_tree,
+				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+				  ffebld_nonter_hook (expr));
+	if (arg3_tree != NULL_TREE)
+	  expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
+				     convert (TREE_TYPE (arg3_tree),
+					      expr_tree));
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impLSTAT_subr:
+    case FFEINTRIN_impSTAT_subr:
+      {
+	tree arg1_len = integer_zero_node;
+	tree arg1_tree;
+	tree arg2_tree;
+	tree arg3_tree;
+
+	arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len);
+
+	arg2_tree = ffecom_ptr_to_expr (arg2);
+
+	if (arg3 != NULL)
+	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
+	else
+	  arg3_tree = NULL_TREE;
+
+	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+	arg1_len = build_tree_list (NULL_TREE, arg1_len);
+	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+	TREE_CHAIN (arg1_tree) = arg2_tree;
+	TREE_CHAIN (arg2_tree) = arg1_len;
+	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+				  ffecom_gfrt_kindtype (gfrt),
+				  FALSE,
+				  NULL_TREE,
+				  arg1_tree,
+				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+				  ffebld_nonter_hook (expr));
+	if (arg3_tree != NULL_TREE)
+	  expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
+				     convert (TREE_TYPE (arg3_tree),
+					      expr_tree));
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impFGETC_subr:
+    case FFEINTRIN_impFPUTC_subr:
+      {
+	tree arg1_tree;
+	tree arg2_tree;
+	tree arg2_len = integer_zero_node;
+	tree arg3_tree;
+
+	arg1_tree = convert (ffecom_f2c_integer_type_node,
+			     ffecom_expr (arg1));
+	arg1_tree = ffecom_1 (ADDR_EXPR,
+			      build_pointer_type (TREE_TYPE (arg1_tree)),
+			      arg1_tree);
+
+	arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len);
+	if (arg3 != NULL)
+	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
+	else
+	  arg3_tree = NULL_TREE;
+
+	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+	arg2_len = build_tree_list (NULL_TREE, arg2_len);
+	TREE_CHAIN (arg1_tree) = arg2_tree;
+	TREE_CHAIN (arg2_tree) = arg2_len;
+
+	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+				  ffecom_gfrt_kindtype (gfrt),
+				  FALSE,
+				  NULL_TREE,
+				  arg1_tree,
+				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+				  ffebld_nonter_hook (expr));
+	if (arg3_tree != NULL_TREE)
+	  expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
+				     convert (TREE_TYPE (arg3_tree),
+					      expr_tree));
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impFSTAT_subr:
+      {
+	tree arg1_tree;
+	tree arg2_tree;
+	tree arg3_tree;
+
+	arg1_tree = convert (ffecom_f2c_integer_type_node,
+			     ffecom_expr (arg1));
+	arg1_tree = ffecom_1 (ADDR_EXPR,
+			      build_pointer_type (TREE_TYPE (arg1_tree)),
+			      arg1_tree);
+
+	arg2_tree = convert (ffecom_f2c_ptr_to_integer_type_node,
+			     ffecom_ptr_to_expr (arg2));
+
+	if (arg3 == NULL)
+	  arg3_tree = NULL_TREE;
+	else
+	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
+
+	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+	TREE_CHAIN (arg1_tree) = arg2_tree;
+	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+				  ffecom_gfrt_kindtype (gfrt),
+				  FALSE,
+				  NULL_TREE,
+				  arg1_tree,
+				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+				  ffebld_nonter_hook (expr));
+	if (arg3_tree != NULL_TREE) {
+	  expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
+				     convert (TREE_TYPE (arg3_tree),
+					      expr_tree));
+	}
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impKILL_subr:
+      {
+	tree arg1_tree;
+	tree arg2_tree;
+	tree arg3_tree;
+
+	arg1_tree = convert (ffecom_f2c_integer_type_node,
+			     ffecom_expr (arg1));
+	arg1_tree = ffecom_1 (ADDR_EXPR,
+			      build_pointer_type (TREE_TYPE (arg1_tree)),
+			      arg1_tree);
+
+	arg2_tree = convert (ffecom_f2c_integer_type_node,
+			     ffecom_expr (arg2));
+	arg2_tree = ffecom_1 (ADDR_EXPR,
+			      build_pointer_type (TREE_TYPE (arg2_tree)),
+			      arg2_tree);
+
+	if (arg3 == NULL)
+	  arg3_tree = NULL_TREE;
+	else
+	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
+
+	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+	TREE_CHAIN (arg1_tree) = arg2_tree;
+	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+				  ffecom_gfrt_kindtype (gfrt),
+				  FALSE,
+				  NULL_TREE,
+				  arg1_tree,
+				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+				  ffebld_nonter_hook (expr));
+	if (arg3_tree != NULL_TREE) {
+	  expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
+				     convert (TREE_TYPE (arg3_tree),
+					      expr_tree));
+	}
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impCTIME_subr:
+    case FFEINTRIN_impTTYNAM_subr:
+      {
+	tree arg1_len = integer_zero_node;
+	tree arg1_tree;
+	tree arg2_tree;
+
+	arg1_tree = ffecom_arg_ptr_to_expr (arg2, &arg1_len);
+
+	arg2_tree = convert (((codegen_imp == FFEINTRIN_impCTIME_subr) ?
+			      ffecom_f2c_longint_type_node :
+			      ffecom_f2c_integer_type_node),
+			     ffecom_expr (arg1));
+	arg2_tree = ffecom_1 (ADDR_EXPR,
+			      build_pointer_type (TREE_TYPE (arg2_tree)),
+			      arg2_tree);
+
+	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+	arg1_len = build_tree_list (NULL_TREE, arg1_len);
+	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
+	TREE_CHAIN (arg1_len) = arg2_tree;
+	TREE_CHAIN (arg1_tree) = arg1_len;
+
+	expr_tree
+	  = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+			  ffecom_gfrt_kindtype (gfrt),
+			  FALSE,
+			  NULL_TREE,
+			  arg1_tree,
+			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+			  ffebld_nonter_hook (expr));
+	TREE_SIDE_EFFECTS (expr_tree) = 1;
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impIRAND:
+    case FFEINTRIN_impRAND:
+      /* Arg defaults to 0 (normal random case) */
+      {
+	tree arg1_tree;
+
+	if (arg1 == NULL)
+	  arg1_tree = ffecom_integer_zero_node;
+	else
+	  arg1_tree = ffecom_expr (arg1);
+	arg1_tree = convert (ffecom_f2c_integer_type_node,
+			     arg1_tree);
+	arg1_tree = ffecom_1 (ADDR_EXPR,
+			      build_pointer_type (TREE_TYPE (arg1_tree)),
+			      arg1_tree);
+	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
+
+	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+				  ffecom_gfrt_kindtype (gfrt),
+				  FALSE,
+				  ((codegen_imp == FFEINTRIN_impIRAND) ?
+				   ffecom_f2c_integer_type_node :
+				   ffecom_f2c_real_type_node),
+				  arg1_tree,
+				  dest_tree, dest, dest_used,
+				  NULL_TREE, TRUE,
+				  ffebld_nonter_hook (expr));
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impFTELL_subr:
+    case FFEINTRIN_impUMASK_subr:
+      {
+	tree arg1_tree;
+	tree arg2_tree;
+
+	arg1_tree = convert (ffecom_f2c_integer_type_node,
+			     ffecom_expr (arg1));
+	arg1_tree = ffecom_1 (ADDR_EXPR,
+			      build_pointer_type (TREE_TYPE (arg1_tree)),
+			      arg1_tree);
+
+	if (arg2 == NULL)
+	  arg2_tree = NULL_TREE;
+	else
+	  arg2_tree = ffecom_expr_w (NULL_TREE, arg2);
+
+	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+				  ffecom_gfrt_kindtype (gfrt),
+				  FALSE,
+				  NULL_TREE,
+				  build_tree_list (NULL_TREE, arg1_tree),
+				  NULL_TREE, NULL, NULL, NULL_TREE,
+				  TRUE,
+				  ffebld_nonter_hook (expr));
+	if (arg2_tree != NULL_TREE) {
+	  expr_tree = ffecom_modify (NULL_TREE, arg2_tree,
+				     convert (TREE_TYPE (arg2_tree),
+					      expr_tree));
+	}
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impCPU_TIME:
+    case FFEINTRIN_impSECOND_subr:
+      {
+	tree arg1_tree;
+
+	arg1_tree = ffecom_expr_w (NULL_TREE, arg1);
+
+	expr_tree
+	  = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+			  ffecom_gfrt_kindtype (gfrt),
+			  FALSE,
+			  NULL_TREE,
+			  NULL_TREE,
+			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
+			  ffebld_nonter_hook (expr));
+
+	expr_tree
+	  = ffecom_modify (NULL_TREE, arg1_tree,
+			   convert (TREE_TYPE (arg1_tree),
+				    expr_tree));
+      }
+      return expr_tree;
+
+    case FFEINTRIN_impDTIME_subr:
+    case FFEINTRIN_impETIME_subr:
+      {
+	tree arg1_tree;
+	tree result_tree;
+
+	result_tree = ffecom_expr_w (NULL_TREE, arg2);
+
+	arg1_tree = ffecom_ptr_to_expr (arg1);
+
+	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
+				  ffecom_gfrt_kindtype (gfrt),
+				  FALSE,
+				  NULL_TREE,
+				  build_tree_list (NULL_TREE, arg1_tree),
+				  NULL_TREE, NULL, NULL, NULL_TREE,
+				  TRUE,
+				  ffebld_nonter_hook (expr));
+	expr_tree = ffecom_modify (NULL_TREE, result_tree,
+				   convert (TREE_TYPE (result_tree),
+					    expr_tree));
+      }
+      return expr_tree;
+
+      /* Straightforward calls of libf2c routines: */
+    case FFEINTRIN_impABORT:
+    case FFEINTRIN_impACCESS:
+    case FFEINTRIN_impBESJ0:
+    case FFEINTRIN_impBESJ1:
+    case FFEINTRIN_impBESJN:
+    case FFEINTRIN_impBESY0:
+    case FFEINTRIN_impBESY1:
+    case FFEINTRIN_impBESYN:
+    case FFEINTRIN_impCHDIR_func:
+    case FFEINTRIN_impCHMOD_func:
+    case FFEINTRIN_impDATE:
+    case FFEINTRIN_impDATE_AND_TIME:
+    case FFEINTRIN_impDBESJ0:
+    case FFEINTRIN_impDBESJ1:
+    case FFEINTRIN_impDBESJN:
+    case FFEINTRIN_impDBESY0:
+    case FFEINTRIN_impDBESY1:
+    case FFEINTRIN_impDBESYN:
+    case FFEINTRIN_impDTIME_func:
+    case FFEINTRIN_impETIME_func:
+    case FFEINTRIN_impFGETC_func:
+    case FFEINTRIN_impFGET_func:
+    case FFEINTRIN_impFNUM:
+    case FFEINTRIN_impFPUTC_func:
+    case FFEINTRIN_impFPUT_func:
+    case FFEINTRIN_impFSEEK:
+    case FFEINTRIN_impFSTAT_func:
+    case FFEINTRIN_impFTELL_func:
+    case FFEINTRIN_impGERROR:
+    case FFEINTRIN_impGETARG:
+    case FFEINTRIN_impGETCWD_func:
+    case FFEINTRIN_impGETENV:
+    case FFEINTRIN_impGETGID:
+    case FFEINTRIN_impGETLOG:
+    case FFEINTRIN_impGETPID:
+    case FFEINTRIN_impGETUID:
+    case FFEINTRIN_impGMTIME:
+    case FFEINTRIN_impHOSTNM_func:
+    case FFEINTRIN_impIDATE_unix:
+    case FFEINTRIN_impIDATE_vxt:
+    case FFEINTRIN_impIERRNO:
+    case FFEINTRIN_impISATTY:
+    case FFEINTRIN_impITIME:
+    case FFEINTRIN_impKILL_func:
+    case FFEINTRIN_impLINK_func:
+    case FFEINTRIN_impLNBLNK:
+    case FFEINTRIN_impLSTAT_func:
+    case FFEINTRIN_impLTIME:
+    case FFEINTRIN_impMCLOCK8:
+    case FFEINTRIN_impMCLOCK:
+    case FFEINTRIN_impPERROR:
+    case FFEINTRIN_impRENAME_func:
+    case FFEINTRIN_impSECNDS:
+    case FFEINTRIN_impSECOND_func:
+    case FFEINTRIN_impSLEEP:
+    case FFEINTRIN_impSRAND:
+    case FFEINTRIN_impSTAT_func:
+    case FFEINTRIN_impSYMLNK_func:
+    case FFEINTRIN_impSYSTEM_CLOCK:
+    case FFEINTRIN_impSYSTEM_func:
+    case FFEINTRIN_impTIME8:
+    case FFEINTRIN_impTIME_unix:
+    case FFEINTRIN_impTIME_vxt:
+    case FFEINTRIN_impUMASK_func:
+    case FFEINTRIN_impUNLINK_func:
+      break;
+
+    case FFEINTRIN_impCTIME_func:	/* CHARACTER functions not handled here. */
+    case FFEINTRIN_impFDATE_func:	/* CHARACTER functions not handled here. */
+    case FFEINTRIN_impTTYNAM_func:	/* CHARACTER functions not handled here. */
+    case FFEINTRIN_impNONE:
+    case FFEINTRIN_imp:		/* Hush up gcc warning. */
+      fprintf (stderr, "No %s implementation.\n",
+	       ffeintrin_name_implementation (ffebld_symter_implementation (ffebld_left (expr))));
+      assert ("unimplemented intrinsic" == NULL);
+      return error_mark_node;
+    }
+
+  assert (gfrt != FFECOM_gfrt);	/* Must have an implementation! */
+
+  expr_tree = ffecom_arglist_expr_ (ffecom_gfrt_args_ (gfrt),
+				    ffebld_right (expr));
+
+  return ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ffecom_gfrt_kindtype (gfrt),
+		       (ffe_is_f2c_library () && ffecom_gfrt_complex_[gfrt]),
+		       tree_type,
+		       expr_tree, dest_tree, dest, dest_used,
+		       NULL_TREE, TRUE,
+		       ffebld_nonter_hook (expr));
+
+  /* See bottom of this file for f2c transforms used to determine
+     many of the above implementations.  The info seems to confuse
+     Emacs's C mode indentation, which is why it's been moved to
+     the bottom of this source file.  */
+}
+
+/* For power (exponentiation) where right-hand operand is type INTEGER,
+   generate in-line code to do it the fast way (which, if the operand
+   is a constant, might just mean a series of multiplies).  */
+
+static tree
+ffecom_expr_power_integer_ (ffebld expr)
+{
+  tree l = ffecom_expr (ffebld_left (expr));
+  tree r = ffecom_expr (ffebld_right (expr));
+  tree ltype = TREE_TYPE (l);
+  tree rtype = TREE_TYPE (r);
+  tree result = NULL_TREE;
+
+  if (l == error_mark_node
+      || r == error_mark_node)
+    return error_mark_node;
+
+  if (TREE_CODE (r) == INTEGER_CST)
+    {
+      int sgn = tree_int_cst_sgn (r);
+
+      if (sgn == 0)
+	return convert (ltype, integer_one_node);
+
+      if ((TREE_CODE (ltype) == INTEGER_TYPE)
+	  && (sgn < 0))
+	{
+	  /* Reciprocal of integer is either 0, -1, or 1, so after
+	     calculating that (which we leave to the back end to do
+	     or not do optimally), don't bother with any multiplying.  */
+
+	  result = ffecom_tree_divide_ (ltype,
+					convert (ltype, integer_one_node),
+					l,
+					NULL_TREE, NULL, NULL, NULL_TREE);
+	  r = ffecom_1 (NEGATE_EXPR,
+			rtype,
+			r);
+	  if ((TREE_INT_CST_LOW (r) & 1) == 0)
+	    result = ffecom_1 (ABS_EXPR, rtype,
+			       result);
+	}
+
+      /* Generate appropriate series of multiplies, preceded
+	 by divide if the exponent is negative.  */
+
+      l = save_expr (l);
+
+      if (sgn < 0)
+	{
+	  l = ffecom_tree_divide_ (ltype,
+				   convert (ltype, integer_one_node),
+				   l,
+				   NULL_TREE, NULL, NULL,
+				   ffebld_nonter_hook (expr));
+	  r = ffecom_1 (NEGATE_EXPR, rtype, r);
+	  assert (TREE_CODE (r) == INTEGER_CST);
+
+	  if (tree_int_cst_sgn (r) < 0)
+	    {			/* The "most negative" number.  */
+	      r = ffecom_1 (NEGATE_EXPR, rtype,
+			    ffecom_2 (RSHIFT_EXPR, rtype,
+				      r,
+				      integer_one_node));
+	      l = save_expr (l);
+	      l = ffecom_2 (MULT_EXPR, ltype,
+			    l,
+			    l);
+	    }
+	}
+
+      for (;;)
+	{
+	  if (TREE_INT_CST_LOW (r) & 1)
+	    {
+	      if (result == NULL_TREE)
+		result = l;
+	      else
+		result = ffecom_2 (MULT_EXPR, ltype,
+				   result,
+				   l);
+	    }
+
+	  r = ffecom_2 (RSHIFT_EXPR, rtype,
+			r,
+			integer_one_node);
+	  if (integer_zerop (r))
+	    break;
+	  assert (TREE_CODE (r) == INTEGER_CST);
+
+	  l = save_expr (l);
+	  l = ffecom_2 (MULT_EXPR, ltype,
+			l,
+			l);
+	}
+      return result;
+    }
+
+  /* Though rhs isn't a constant, in-line code cannot be expanded
+     while transforming dummies
+     because the back end cannot be easily convinced to generate
+     stores (MODIFY_EXPR), handle temporaries, and so on before
+     all the appropriate rtx's have been generated for things like
+     dummy args referenced in rhs -- which doesn't happen until
+     store_parm_decls() is called (expand_function_start, I believe,
+     does the actual rtx-stuffing of PARM_DECLs).
+
+     So, in this case, let the caller generate the call to the
+     run-time-library function to evaluate the power for us.  */
+
+  if (ffecom_transform_only_dummies_)
+    return NULL_TREE;
+
+  /* Right-hand operand not a constant, expand in-line code to figure
+     out how to do the multiplies, &c.
+
+     The returned expression is expressed this way in GNU C, where l and
+     r are the "inputs":
+
+     ({ typeof (r) rtmp = r;
+	typeof (l) ltmp = l;
+	typeof (l) result;
+
+	if (rtmp == 0)
+	  result = 1;
+	else
+	  {
+	    if ((basetypeof (l) == basetypeof (int))
+		&& (rtmp < 0))
+	      {
+	        result = ((typeof (l)) 1) / ltmp;
+	        if ((ltmp < 0) && (((-rtmp) & 1) == 0))
+		  result = -result;
+	      }
+	    else
+	      {
+		result = 1;
+		if ((basetypeof (l) != basetypeof (int))
+		    && (rtmp < 0))
+		  {
+		    ltmp = ((typeof (l)) 1) / ltmp;
+		    rtmp = -rtmp;
+		    if (rtmp < 0)
+		      {
+		        rtmp = -(rtmp >> 1);
+		        ltmp *= ltmp;
+		      }
+		  }
+		for (;;)
+		  {
+		    if (rtmp & 1)
+		      result *= ltmp;
+		    if ((rtmp >>= 1) == 0)
+		      break;
+		    ltmp *= ltmp;
+		  }
+	      }
+	  }
+	result;
+     })
+
+     Note that some of the above is compile-time collapsable, such as
+     the first part of the if statements that checks the base type of
+     l against int.  The if statements are phrased that way to suggest
+     an easy way to generate the if/else constructs here, knowing that
+     the back end should (and probably does) eliminate the resulting
+     dead code (either the int case or the non-int case), something
+     it couldn't do without the redundant phrasing, requiring explicit
+     dead-code elimination here, which would be kind of difficult to
+     read.  */
+
+  {
+    tree rtmp;
+    tree ltmp;
+    tree divide;
+    tree basetypeof_l_is_int;
+    tree se;
+    tree t;
+
+    basetypeof_l_is_int
+      = build_int_2 ((TREE_CODE (ltype) == INTEGER_TYPE), 0);
+
+    se = expand_start_stmt_expr (/*has_scope=*/1);
+
+    ffecom_start_compstmt ();
+
+    rtmp = ffecom_make_tempvar ("power_r", rtype,
+				FFETARGET_charactersizeNONE, -1);
+    ltmp = ffecom_make_tempvar ("power_l", ltype,
+				FFETARGET_charactersizeNONE, -1);
+    result = ffecom_make_tempvar ("power_res", ltype,
+				  FFETARGET_charactersizeNONE, -1);
+    if (TREE_CODE (ltype) == COMPLEX_TYPE
+	|| TREE_CODE (ltype) == RECORD_TYPE)
+      divide = ffecom_make_tempvar ("power_div", ltype,
+				    FFETARGET_charactersizeNONE, -1);
+    else
+      divide = NULL_TREE;
+
+    expand_expr_stmt (ffecom_modify (void_type_node,
+				     rtmp,
+				     r));
+    expand_expr_stmt (ffecom_modify (void_type_node,
+				     ltmp,
+				     l));
+    expand_start_cond (ffecom_truth_value
+		       (ffecom_2 (EQ_EXPR, integer_type_node,
+				  rtmp,
+				  convert (rtype, integer_zero_node))),
+		       0);
+    expand_expr_stmt (ffecom_modify (void_type_node,
+				     result,
+				     convert (ltype, integer_one_node)));
+    expand_start_else ();
+    if (! integer_zerop (basetypeof_l_is_int))
+      {
+	expand_start_cond (ffecom_2 (LT_EXPR, integer_type_node,
+				     rtmp,
+				     convert (rtype,
+					      integer_zero_node)),
+			   0);
+	expand_expr_stmt (ffecom_modify (void_type_node,
+					 result,
+					 ffecom_tree_divide_
+					 (ltype,
+					  convert (ltype, integer_one_node),
+					  ltmp,
+					  NULL_TREE, NULL, NULL,
+					  divide)));
+	expand_start_cond (ffecom_truth_value
+			   (ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
+				      ffecom_2 (LT_EXPR, integer_type_node,
+						ltmp,
+						convert (ltype,
+							 integer_zero_node)),
+				      ffecom_2 (EQ_EXPR, integer_type_node,
+						ffecom_2 (BIT_AND_EXPR,
+							  rtype,
+							  ffecom_1 (NEGATE_EXPR,
+								    rtype,
+								    rtmp),
+							  convert (rtype,
+								   integer_one_node)),
+						convert (rtype,
+							 integer_zero_node)))),
+			   0);
+	expand_expr_stmt (ffecom_modify (void_type_node,
+					 result,
+					 ffecom_1 (NEGATE_EXPR,
+						   ltype,
+						   result)));
+	expand_end_cond ();
+	expand_start_else ();
+      }
+    expand_expr_stmt (ffecom_modify (void_type_node,
+				     result,
+				     convert (ltype, integer_one_node)));
+    expand_start_cond (ffecom_truth_value
+		       (ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
+				  ffecom_truth_value_invert
+				  (basetypeof_l_is_int),
+				  ffecom_2 (LT_EXPR, integer_type_node,
+					    rtmp,
+					    convert (rtype,
+						     integer_zero_node)))),
+		       0);
+    expand_expr_stmt (ffecom_modify (void_type_node,
+				     ltmp,
+				     ffecom_tree_divide_
+				     (ltype,
+				      convert (ltype, integer_one_node),
+				      ltmp,
+				      NULL_TREE, NULL, NULL,
+				      divide)));
+    expand_expr_stmt (ffecom_modify (void_type_node,
+				     rtmp,
+				     ffecom_1 (NEGATE_EXPR, rtype,
+					       rtmp)));
+    expand_start_cond (ffecom_truth_value
+		       (ffecom_2 (LT_EXPR, integer_type_node,
+				  rtmp,
+				  convert (rtype, integer_zero_node))),
+		       0);
+    expand_expr_stmt (ffecom_modify (void_type_node,
+				     rtmp,
+				     ffecom_1 (NEGATE_EXPR, rtype,
+					       ffecom_2 (RSHIFT_EXPR,
+							 rtype,
+							 rtmp,
+							 integer_one_node))));
+    expand_expr_stmt (ffecom_modify (void_type_node,
+				     ltmp,
+				     ffecom_2 (MULT_EXPR, ltype,
+					       ltmp,
+					       ltmp)));
+    expand_end_cond ();
+    expand_end_cond ();
+    expand_start_loop (1);
+    expand_start_cond (ffecom_truth_value
+		       (ffecom_2 (BIT_AND_EXPR, rtype,
+				  rtmp,
+				  convert (rtype, integer_one_node))),
+		       0);
+    expand_expr_stmt (ffecom_modify (void_type_node,
+				     result,
+				     ffecom_2 (MULT_EXPR, ltype,
+					       result,
+					       ltmp)));
+    expand_end_cond ();
+    expand_exit_loop_if_false (NULL,
+			       ffecom_truth_value
+			       (ffecom_modify (rtype,
+					       rtmp,
+					       ffecom_2 (RSHIFT_EXPR,
+							 rtype,
+							 rtmp,
+							 integer_one_node))));
+    expand_expr_stmt (ffecom_modify (void_type_node,
+				     ltmp,
+				     ffecom_2 (MULT_EXPR, ltype,
+					       ltmp,
+					       ltmp)));
+    expand_end_loop ();
+    expand_end_cond ();
+    if (!integer_zerop (basetypeof_l_is_int))
+      expand_end_cond ();
+    expand_expr_stmt (result);
+
+    t = ffecom_end_compstmt ();
+
+    result = expand_end_stmt_expr (se);
+
+    /* This code comes from c-parse.in, after its expand_end_stmt_expr.  */
+
+    if (TREE_CODE (t) == BLOCK)
+      {
+	/* Make a BIND_EXPR for the BLOCK already made.  */
+	result = build (BIND_EXPR, TREE_TYPE (result),
+			NULL_TREE, result, t);
+	/* Remove the block from the tree at this point.
+	   It gets put back at the proper place
+	   when the BIND_EXPR is expanded.  */
+	delete_block (t);
+      }
+    else
+      result = t;
+  }
+
+  return result;
+}
+
+/* ffecom_expr_transform_ -- Transform symbols in expr
+
+   ffebld expr;	 // FFE expression.
+   ffecom_expr_transform_ (expr);
+
+   Recursive descent on expr while transforming any untransformed SYMTERs.  */
+
+static void
+ffecom_expr_transform_ (ffebld expr)
+{
+  tree t;
+  ffesymbol s;
+
+ tail_recurse:
+
+  if (expr == NULL)
+    return;
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opSYMTER:
+      s = ffebld_symter (expr);
+      t = ffesymbol_hook (s).decl_tree;
+      if ((t == NULL_TREE)
+	  && ((ffesymbol_kind (s) != FFEINFO_kindNONE)
+	      || ((ffesymbol_where (s) != FFEINFO_whereNONE)
+		  && (ffesymbol_where (s) != FFEINFO_whereINTRINSIC))))
+	{
+	  s = ffecom_sym_transform_ (s);
+	  t = ffesymbol_hook (s).decl_tree;	/* Sfunc expr non-dummy,
+						   DIMENSION expr? */
+	}
+      break;			/* Ok if (t == NULL) here. */
+
+    case FFEBLD_opITEM:
+      ffecom_expr_transform_ (ffebld_head (expr));
+      expr = ffebld_trail (expr);
+      goto tail_recurse;	/* :::::::::::::::::::: */
+
+    default:
+      break;
+    }
+
+  switch (ffebld_arity (expr))
+    {
+    case 2:
+      ffecom_expr_transform_ (ffebld_left (expr));
+      expr = ffebld_right (expr);
+      goto tail_recurse;	/* :::::::::::::::::::: */
+
+    case 1:
+      expr = ffebld_left (expr);
+      goto tail_recurse;	/* :::::::::::::::::::: */
+
+    default:
+      break;
+    }
+
+  return;
+}
+
+/* Make a type based on info in live f2c.h file.  */
+
+static void
+ffecom_f2c_make_type_ (tree *type, int tcode, const char *name)
+{
+  switch (tcode)
+    {
+    case FFECOM_f2ccodeCHAR:
+      *type = make_signed_type (CHAR_TYPE_SIZE);
+      break;
+
+    case FFECOM_f2ccodeSHORT:
+      *type = make_signed_type (SHORT_TYPE_SIZE);
+      break;
+
+    case FFECOM_f2ccodeINT:
+      *type = make_signed_type (INT_TYPE_SIZE);
+      break;
+
+    case FFECOM_f2ccodeLONG:
+      *type = make_signed_type (LONG_TYPE_SIZE);
+      break;
+
+    case FFECOM_f2ccodeLONGLONG:
+      *type = make_signed_type (LONG_LONG_TYPE_SIZE);
+      break;
+
+    case FFECOM_f2ccodeCHARPTR:
+      *type = build_pointer_type (DEFAULT_SIGNED_CHAR
+				  ? signed_char_type_node
+				  : unsigned_char_type_node);
+      break;
+
+    case FFECOM_f2ccodeFLOAT:
+      *type = make_node (REAL_TYPE);
+      TYPE_PRECISION (*type) = FLOAT_TYPE_SIZE;
+      layout_type (*type);
+      break;
+
+    case FFECOM_f2ccodeDOUBLE:
+      *type = make_node (REAL_TYPE);
+      TYPE_PRECISION (*type) = DOUBLE_TYPE_SIZE;
+      layout_type (*type);
+      break;
+
+    case FFECOM_f2ccodeLONGDOUBLE:
+      *type = make_node (REAL_TYPE);
+      TYPE_PRECISION (*type) = LONG_DOUBLE_TYPE_SIZE;
+      layout_type (*type);
+      break;
+
+    case FFECOM_f2ccodeTWOREALS:
+      *type = ffecom_make_complex_type_ (ffecom_f2c_real_type_node);
+      break;
+
+    case FFECOM_f2ccodeTWODOUBLEREALS:
+      *type = ffecom_make_complex_type_ (ffecom_f2c_doublereal_type_node);
+      break;
+
+    default:
+      assert ("unexpected FFECOM_f2ccodeXYZZY!" == NULL);
+      *type = error_mark_node;
+      return;
+    }
+
+  pushdecl (build_decl (TYPE_DECL,
+			ffecom_get_invented_identifier ("__g77_f2c_%s", name),
+			*type));
+}
+
+/* Set the f2c list-directed-I/O code for whatever (integral) type has the
+   given size.  */
+
+static void
+ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size, int code)
+{
+  int j;
+  tree t;
+
+  for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j)
+    if ((t = ffecom_tree_type[bt][j]) != NULL_TREE
+	&& compare_tree_int (TYPE_SIZE (t), size) == 0)
+      {
+	assert (code != -1);
+	ffecom_f2c_typecode_[bt][j] = code;
+	code = -1;
+      }
+}
+
+/* Finish up globals after doing all program units in file
+
+   Need to handle only uninitialized COMMON areas.  */
+
+static ffeglobal
+ffecom_finish_global_ (ffeglobal global)
+{
+  tree cbtype;
+  tree cbt;
+  tree size;
+
+  if (ffeglobal_type (global) != FFEGLOBAL_typeCOMMON)
+      return global;
+
+  if (ffeglobal_common_init (global))
+      return global;
+
+  cbt = ffeglobal_hook (global);
+  if ((cbt == NULL_TREE)
+      || !ffeglobal_common_have_size (global))
+    return global;		/* No need to make common, never ref'd. */
+
+  DECL_EXTERNAL (cbt) = 0;
+
+  /* Give the array a size now.  */
+
+  size = build_int_2 ((ffeglobal_common_size (global)
+		      + ffeglobal_common_pad (global)) - 1,
+		      0);
+
+  cbtype = TREE_TYPE (cbt);
+  TYPE_DOMAIN (cbtype) = build_range_type (integer_type_node,
+					   integer_zero_node,
+					   size);
+  if (!TREE_TYPE (size))
+    TREE_TYPE (size) = TYPE_DOMAIN (cbtype);
+  layout_type (cbtype);
+
+  cbt = start_decl (cbt, FALSE);
+  assert (cbt == ffeglobal_hook (global));
+
+  finish_decl (cbt, NULL_TREE, FALSE);
+
+  return global;
+}
+
+/* Finish up any untransformed symbols.  */
+
+static ffesymbol
+ffecom_finish_symbol_transform_ (ffesymbol s)
+{
+  if ((s == NULL) || (TREE_CODE (current_function_decl) == ERROR_MARK))
+    return s;
+
+  /* It's easy to know to transform an untransformed symbol, to make sure
+     we put out debugging info for it.  But COMMON variables, unlike
+     EQUIVALENCE ones, aren't given declarations in addition to the
+     tree expressions that specify offsets, because COMMON variables
+     can be referenced in the outer scope where only dummy arguments
+     (PARM_DECLs) should really be seen.  To be safe, just don't do any
+     VAR_DECLs for COMMON variables when we transform them for real
+     use, and therefore we do all the VAR_DECL creating here.  */
+
+  if (ffesymbol_hook (s).decl_tree == NULL_TREE)
+    {
+      if (ffesymbol_kind (s) != FFEINFO_kindNONE
+	  || (ffesymbol_where (s) != FFEINFO_whereNONE
+	      && ffesymbol_where (s) != FFEINFO_whereINTRINSIC
+	      && ffesymbol_where (s) != FFEINFO_whereDUMMY))
+	/* Not transformed, and not CHARACTER*(*), and not a dummy
+	   argument, which can happen only if the entry point names
+	   it "rides in on" are all invalidated for other reasons.  */
+	s = ffecom_sym_transform_ (s);
+    }
+
+  if ((ffesymbol_where (s) == FFEINFO_whereCOMMON)
+      && (ffesymbol_hook (s).decl_tree != error_mark_node))
+    {
+      /* This isn't working, at least for dbxout.  The .s file looks
+	 okay to me (burley), but in gdb 4.9 at least, the variables
+	 appear to reside somewhere outside of the common area, so
+	 it doesn't make sense to mislead anyone by generating the info
+	 on those variables until this is fixed.  NOTE: Same problem
+	 with EQUIVALENCE, sadly...see similar #if later.  */
+      ffecom_member_phase2_ (ffesymbol_storage (ffesymbol_common (s)),
+			     ffesymbol_storage (s));
+    }
+
+  return s;
+}
+
+/* Append underscore(s) to name before calling get_identifier.  "us"
+   is nonzero if the name already contains an underscore and thus
+   needs two underscores appended.  */
+
+static tree
+ffecom_get_appended_identifier_ (char us, const char *name)
+{
+  int i;
+  char *newname;
+  tree id;
+
+  newname = xmalloc ((i = strlen (name)) + 1
+		     + ffe_is_underscoring ()
+		     + us);
+  memcpy (newname, name, i);
+  newname[i] = '_';
+  newname[i + us] = '_';
+  newname[i + 1 + us] = '\0';
+  id = get_identifier (newname);
+
+  free (newname);
+
+  return id;
+}
+
+/* Decide whether to append underscore to name before calling
+   get_identifier.  */
+
+static tree
+ffecom_get_external_identifier_ (ffesymbol s)
+{
+  char us;
+  const char *name = ffesymbol_text (s);
+
+  /* If name is a built-in name, just return it as is.  */
+
+  if (!ffe_is_underscoring ()
+      || (strcmp (name, FFETARGET_nameBLANK_COMMON) == 0)
+      || (strcmp (name, FFETARGET_nameUNNAMED_MAIN) == 0)
+      || (strcmp (name, FFETARGET_nameUNNAMED_BLOCK_DATA) == 0))
+    return get_identifier (name);
+
+  us = ffe_is_second_underscore ()
+    ? (strchr (name, '_') != NULL)
+      : 0;
+
+  return ffecom_get_appended_identifier_ (us, name);
+}
+
+/* Decide whether to append underscore to internal name before calling
+   get_identifier.
+
+   This is for non-external, top-function-context names only.  Transform
+   identifier so it doesn't conflict with the transformed result
+   of using a _different_ external name.  E.g. if "CALL FOO" is
+   transformed into "FOO_();", then the variable in "FOO_ = 3"
+   must be transformed into something that does not conflict, since
+   these two things should be independent.
+
+   The transformation is as follows.  If the name does not contain
+   an underscore, there is no possible conflict, so just return.
+   If the name does contain an underscore, then transform it just
+   like we transform an external identifier.  */
+
+static tree
+ffecom_get_identifier_ (const char *name)
+{
+  /* If name does not contain an underscore, just return it as is.  */
+
+  if (!ffe_is_underscoring ()
+      || (strchr (name, '_') == NULL))
+    return get_identifier (name);
+
+  return ffecom_get_appended_identifier_ (ffe_is_second_underscore (),
+					  name);
+}
+
+/* ffecom_gen_sfuncdef_ -- Generate definition of statement function
+
+   tree t;
+   ffesymbol s;	 // kindFUNCTION, whereIMMEDIATE.
+   t = ffecom_gen_sfuncdef_(s,ffesymbol_basictype(s),
+	 ffesymbol_kindtype(s));
+
+   Call after setting up containing function and getting trees for all
+   other symbols.  */
+
+static tree
+ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt)
+{
+  ffebld expr = ffesymbol_sfexpr (s);
+  tree type;
+  tree func;
+  tree result;
+  bool charfunc = (bt == FFEINFO_basictypeCHARACTER);
+  static bool recurse = FALSE;
+  location_t old_loc = input_location;
+
+  ffecom_nested_entry_ = s;
+
+  /* For now, we don't have a handy pointer to where the sfunc is actually
+     defined, though that should be easy to add to an ffesymbol. (The
+     token/where info available might well point to the place where the type
+     of the sfunc is declared, especially if that precedes the place where
+     the sfunc itself is defined, which is typically the case.)  We should
+     put out a null pointer rather than point somewhere wrong, but I want to
+     see how it works at this point.  */
+
+  input_filename = ffesymbol_where_filename (s);
+  input_line = ffesymbol_where_filelinenum (s);
+
+  /* Pretransform the expression so any newly discovered things belong to the
+     outer program unit, not to the statement function. */
+
+  ffecom_expr_transform_ (expr);
+
+  /* Make sure no recursive invocation of this fn (a specific case of failing
+     to pretransform an sfunc's expression, i.e. where its expression
+     references another untransformed sfunc) happens. */
+
+  assert (!recurse);
+  recurse = TRUE;
+
+  push_f_function_context ();
+
+  if (charfunc)
+    type = void_type_node;
+  else
+    {
+      type = ffecom_tree_type[bt][kt];
+      if (type == NULL_TREE)
+	type = integer_type_node;	/* _sym_exec_transition reports
+					   error. */
+    }
+
+  start_function (ffecom_get_identifier_ (ffesymbol_text (s)),
+		  build_function_type (type, NULL_TREE),
+		  1,		/* nested/inline */
+		  0);		/* TREE_PUBLIC */
+
+  /* We don't worry about COMPLEX return values here, because this is
+     entirely internal to our code, and gcc has the ability to return COMPLEX
+     directly as a value.  */
+
+  if (charfunc)
+    {				/* Prepend arg for where result goes. */
+      tree type;
+
+      type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt];
+
+      result = ffecom_get_invented_identifier ("__g77_%s", "result");
+
+      ffecom_char_enhance_arg_ (&type, s);	/* Ignore returned length. */
+
+      type = build_pointer_type (type);
+      result = build_decl (PARM_DECL, result, type);
+
+      push_parm_decl (result);
+    }
+  else
+    result = NULL_TREE;		/* Not ref'd if !charfunc. */
+
+  ffecom_push_dummy_decls_ (ffesymbol_dummyargs (s), TRUE);
+
+  store_parm_decls (0);
+
+  ffecom_start_compstmt ();
+
+  if (expr != NULL)
+    {
+      if (charfunc)
+	{
+	  ffetargetCharacterSize sz = ffesymbol_size (s);
+	  tree result_length;
+
+	  result_length = build_int_2 (sz, 0);
+	  TREE_TYPE (result_length) = ffecom_f2c_ftnlen_type_node;
+
+	  ffecom_prepare_let_char_ (sz, expr);
+
+	  ffecom_prepare_end ();
+
+	  ffecom_let_char_ (result, result_length, sz, expr);
+	  expand_null_return ();
+	}
+      else
+	{
+	  ffecom_prepare_expr (expr);
+
+	  ffecom_prepare_end ();
+
+	  expand_return (ffecom_modify (NULL_TREE,
+					DECL_RESULT (current_function_decl),
+					ffecom_expr (expr)));
+	}
+    }
+
+  ffecom_end_compstmt ();
+
+  func = current_function_decl;
+  finish_function (1);
+
+  pop_f_function_context ();
+
+  recurse = FALSE;
+
+  input_location = old_loc;
+
+  ffecom_nested_entry_ = NULL;
+
+  return func;
+}
+
+static const char *
+ffecom_gfrt_args_ (ffecomGfrt ix)
+{
+  return ffecom_gfrt_argstring_[ix];
+}
+
+static tree
+ffecom_gfrt_tree_ (ffecomGfrt ix)
+{
+  if (ffecom_gfrt_[ix] == NULL_TREE)
+    ffecom_make_gfrt_ (ix);
+
+  return ffecom_1 (ADDR_EXPR,
+		   build_pointer_type (TREE_TYPE (ffecom_gfrt_[ix])),
+		   ffecom_gfrt_[ix]);
+}
+
+/* Return initialize-to-zero expression for this VAR_DECL.  */
+
+/* A somewhat evil way to prevent the garbage collector
+   from collecting 'tree' structures.  */
+#define NUM_TRACKED_CHUNK 63
+struct tree_ggc_tracker GTY(())
+{
+  struct tree_ggc_tracker *next;
+  tree trees[NUM_TRACKED_CHUNK];
+};
+static GTY(()) struct tree_ggc_tracker *tracker_head;
+
+void
+ffecom_save_tree_forever (tree t)
+{
+  int i;
+  if (tracker_head != NULL)
+    for (i = 0; i < NUM_TRACKED_CHUNK; i++)
+      if (tracker_head->trees[i] == NULL)
+	{
+	  tracker_head->trees[i] = t;
+	  return;
+	}
+
+  {
+    /* Need to allocate a new block.  */
+    struct tree_ggc_tracker *old_head = tracker_head;
+
+    tracker_head = ggc_alloc (sizeof (*tracker_head));
+    tracker_head->next = old_head;
+    tracker_head->trees[0] = t;
+    for (i = 1; i < NUM_TRACKED_CHUNK; i++)
+      tracker_head->trees[i] = NULL;
+  }
+}
+
+static tree
+ffecom_init_zero_ (tree decl)
+{
+  tree init;
+  int incremental = TREE_STATIC (decl);
+  tree type = TREE_TYPE (decl);
+
+  if (incremental)
+    {
+      make_decl_rtl (decl, NULL);
+      assemble_variable (decl, TREE_PUBLIC (decl) ? 1 : 0, 0, 1);
+    }
+
+  if ((TREE_CODE (type) != ARRAY_TYPE)
+      && (TREE_CODE (type) != RECORD_TYPE)
+      && (TREE_CODE (type) != UNION_TYPE)
+      && !incremental)
+    init = convert (type, integer_zero_node);
+  else if (!incremental)
+    {
+      init = build_constructor (type, NULL_TREE);
+      TREE_CONSTANT (init) = 1;
+      TREE_STATIC (init) = 1;
+    }
+  else
+    {
+      assemble_zeros (int_size_in_bytes (type));
+      init = error_mark_node;
+    }
+
+  return init;
+}
+
+static tree
+ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg, tree *maybe_tree)
+{
+  tree expr_tree;
+  tree length_tree;
+
+  switch (ffebld_op (arg))
+    {
+    case FFEBLD_opCONTER:	/* For F90, check 0-length. */
+      if (ffetarget_length_character1
+	  (ffebld_constant_character1
+	   (ffebld_conter (arg))) == 0)
+	{
+	  *maybe_tree = integer_zero_node;
+	  return convert (tree_type, integer_zero_node);
+	}
+
+      *maybe_tree = integer_one_node;
+      expr_tree = build_int_2 (*ffetarget_text_character1
+			       (ffebld_constant_character1
+				(ffebld_conter (arg))),
+			       0);
+      TREE_TYPE (expr_tree) = tree_type;
+      return expr_tree;
+
+    case FFEBLD_opSYMTER:
+    case FFEBLD_opARRAYREF:
+    case FFEBLD_opFUNCREF:
+    case FFEBLD_opSUBSTR:
+      ffecom_char_args_ (&expr_tree, &length_tree, arg);
+
+      if ((expr_tree == error_mark_node)
+	  || (length_tree == error_mark_node))
+	{
+	  *maybe_tree = error_mark_node;
+	  return error_mark_node;
+	}
+
+      if (integer_zerop (length_tree))
+	{
+	  *maybe_tree = integer_zero_node;
+	  return convert (tree_type, integer_zero_node);
+	}
+
+      expr_tree
+	= ffecom_1 (INDIRECT_REF,
+		    TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))),
+		    expr_tree);
+      expr_tree
+	= ffecom_2 (ARRAY_REF,
+		    TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))),
+		    expr_tree,
+		    integer_one_node);
+      expr_tree = convert (tree_type, expr_tree);
+
+      if (TREE_CODE (length_tree) == INTEGER_CST)
+	*maybe_tree = integer_one_node;
+      else			/* Must check length at run time.  */
+	*maybe_tree
+	  = ffecom_truth_value
+	    (ffecom_2 (GT_EXPR, integer_type_node,
+		       length_tree,
+		       ffecom_f2c_ftnlen_zero_node));
+      return expr_tree;
+
+    case FFEBLD_opPAREN:
+    case FFEBLD_opCONVERT:
+      if (ffeinfo_size (ffebld_info (arg)) == 0)
+	{
+	  *maybe_tree = integer_zero_node;
+	  return convert (tree_type, integer_zero_node);
+	}
+      return ffecom_intrinsic_ichar_ (tree_type, ffebld_left (arg),
+				      maybe_tree);
+
+    case FFEBLD_opCONCATENATE:
+      {
+	tree maybe_left;
+	tree maybe_right;
+	tree expr_left;
+	tree expr_right;
+
+	expr_left = ffecom_intrinsic_ichar_ (tree_type, ffebld_left (arg),
+					     &maybe_left);
+	expr_right = ffecom_intrinsic_ichar_ (tree_type, ffebld_right (arg),
+					      &maybe_right);
+	*maybe_tree = ffecom_2 (TRUTH_ORIF_EXPR, integer_type_node,
+				maybe_left,
+				maybe_right);
+	expr_tree = ffecom_3 (COND_EXPR, tree_type,
+			      maybe_left,
+			      expr_left,
+			      expr_right);
+	return expr_tree;
+      }
+
+    default:
+      assert ("bad op in ICHAR" == NULL);
+      return error_mark_node;
+    }
+}
+
+/* ffecom_intrinsic_len_ -- Return length info for char arg (LEN())
+
+   tree length_arg;
+   ffebld expr;
+   length_arg = ffecom_intrinsic_len_ (expr);
+
+   Handles CHARACTER-type CONTER, SYMTER, SUBSTR, ARRAYREF, and FUNCREF
+   subexpressions by constructing the appropriate tree for the
+   length-of-character-text argument in a calling sequence.  */
+
+static tree
+ffecom_intrinsic_len_ (ffebld expr)
+{
+  ffetargetCharacter1 val;
+  tree length;
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opCONTER:
+      val = ffebld_constant_character1 (ffebld_conter (expr));
+      length = build_int_2 (ffetarget_length_character1 (val), 0);
+      TREE_TYPE (length) = ffecom_f2c_ftnlen_type_node;
+      break;
+
+    case FFEBLD_opSYMTER:
+      {
+	ffesymbol s = ffebld_symter (expr);
+	tree item;
+
+	item = ffesymbol_hook (s).decl_tree;
+	if (item == NULL_TREE)
+	  {
+	    s = ffecom_sym_transform_ (s);
+	    item = ffesymbol_hook (s).decl_tree;
+	  }
+	if (ffesymbol_kind (s) == FFEINFO_kindENTITY)
+	  {
+	    if (ffesymbol_size (s) == FFETARGET_charactersizeNONE)
+	      length = ffesymbol_hook (s).length_tree;
+	    else
+	      {
+		length = build_int_2 (ffesymbol_size (s), 0);
+		TREE_TYPE (length) = ffecom_f2c_ftnlen_type_node;
+	      }
+	  }
+	else if (item == error_mark_node)
+	  length = error_mark_node;
+	else			/* FFEINFO_kindFUNCTION: */
+	  length = NULL_TREE;
+      }
+      break;
+
+    case FFEBLD_opARRAYREF:
+      length = ffecom_intrinsic_len_ (ffebld_left (expr));
+      break;
+
+    case FFEBLD_opSUBSTR:
+      {
+	ffebld start;
+	ffebld end;
+	ffebld thing = ffebld_right (expr);
+	tree start_tree;
+	tree end_tree;
+
+	assert (ffebld_op (thing) == FFEBLD_opITEM);
+	start = ffebld_head (thing);
+	thing = ffebld_trail (thing);
+	assert (ffebld_trail (thing) == NULL);
+	end = ffebld_head (thing);
+
+	length = ffecom_intrinsic_len_ (ffebld_left (expr));
+
+	if (length == error_mark_node)
+	  break;
+
+	if (start == NULL)
+	  {
+	    if (end == NULL)
+	      ;
+	    else
+	      {
+		length = convert (ffecom_f2c_ftnlen_type_node,
+				  ffecom_expr (end));
+	      }
+	  }
+	else
+	  {
+	    start_tree = convert (ffecom_f2c_ftnlen_type_node,
+				  ffecom_expr (start));
+
+	    if (start_tree == error_mark_node)
+	      {
+		length = error_mark_node;
+		break;
+	      }
+
+	    if (end == NULL)
+	      {
+		length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
+				   ffecom_f2c_ftnlen_one_node,
+				   ffecom_2 (MINUS_EXPR,
+					     ffecom_f2c_ftnlen_type_node,
+					     length,
+					     start_tree));
+	      }
+	    else
+	      {
+		end_tree = convert (ffecom_f2c_ftnlen_type_node,
+				    ffecom_expr (end));
+
+		if (end_tree == error_mark_node)
+		  {
+		    length = error_mark_node;
+		    break;
+		  }
+
+		length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
+				   ffecom_f2c_ftnlen_one_node,
+				   ffecom_2 (MINUS_EXPR,
+					     ffecom_f2c_ftnlen_type_node,
+					     end_tree, start_tree));
+	      }
+	  }
+      }
+      break;
+
+    case FFEBLD_opCONCATENATE:
+      length
+	= ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
+		    ffecom_intrinsic_len_ (ffebld_left (expr)),
+		    ffecom_intrinsic_len_ (ffebld_right (expr)));
+      break;
+
+    case FFEBLD_opFUNCREF:
+    case FFEBLD_opCONVERT:
+      length = build_int_2 (ffebld_size (expr), 0);
+      TREE_TYPE (length) = ffecom_f2c_ftnlen_type_node;
+      break;
+
+    default:
+      assert ("bad op for single char arg expr" == NULL);
+      length = ffecom_f2c_ftnlen_zero_node;
+      break;
+    }
+
+  assert (length != NULL_TREE);
+
+  return length;
+}
+
+/* Handle CHARACTER assignments.
+
+   Generates code to do the assignment.	 Used by ordinary assignment
+   statement handler ffecom_let_stmt and by statement-function
+   handler to generate code for a statement function.  */
+
+static void
+ffecom_let_char_ (tree dest_tree, tree dest_length,
+		  ffetargetCharacterSize dest_size, ffebld source)
+{
+  ffecomConcatList_ catlist;
+  tree source_length;
+  tree source_tree;
+  tree expr_tree;
+
+  if ((dest_tree == error_mark_node)
+      || (dest_length == error_mark_node))
+    return;
+
+  assert (dest_tree != NULL_TREE);
+  assert (dest_length != NULL_TREE);
+
+  /* Source might be an opCONVERT, which just means it is a different size
+     than the destination.  Since the underlying implementation here handles
+     that (directly or via the s_copy or s_cat run-time-library functions),
+     we don't need the "convenience" of an opCONVERT that tells us to
+     truncate or blank-pad, particularly since the resulting implementation
+     would probably be slower than otherwise. */
+
+  while (ffebld_op (source) == FFEBLD_opCONVERT)
+    source = ffebld_left (source);
+
+  catlist = ffecom_concat_list_new_ (source, dest_size);
+  switch (ffecom_concat_list_count_ (catlist))
+    {
+    case 0:			/* Shouldn't happen, but in case it does... */
+      ffecom_concat_list_kill_ (catlist);
+      source_tree = null_pointer_node;
+      source_length = ffecom_f2c_ftnlen_zero_node;
+      expr_tree = build_tree_list (NULL_TREE, dest_tree);
+      TREE_CHAIN (expr_tree) = build_tree_list (NULL_TREE, source_tree);
+      TREE_CHAIN (TREE_CHAIN (expr_tree))
+	= build_tree_list (NULL_TREE, dest_length);
+      TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree)))
+	= build_tree_list (NULL_TREE, source_length);
+
+      expr_tree = ffecom_call_gfrt (FFECOM_gfrtCOPY, expr_tree, NULL_TREE);
+      TREE_SIDE_EFFECTS (expr_tree) = 1;
+
+      expand_expr_stmt (expr_tree);
+
+      return;
+
+    case 1:			/* The (fairly) easy case. */
+      ffecom_char_args_ (&source_tree, &source_length,
+			 ffecom_concat_list_expr_ (catlist, 0));
+      ffecom_concat_list_kill_ (catlist);
+      assert (source_tree != NULL_TREE);
+      assert (source_length != NULL_TREE);
+
+      if ((source_tree == error_mark_node)
+	  || (source_length == error_mark_node))
+	return;
+
+      if (dest_size == 1)
+	{
+	  dest_tree
+	    = ffecom_1 (INDIRECT_REF,
+			TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE
+						      (dest_tree))),
+			dest_tree);
+	  dest_tree
+	    = ffecom_2 (ARRAY_REF,
+			TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE
+						      (dest_tree))),
+			dest_tree,
+			integer_one_node);
+	  source_tree
+	    = ffecom_1 (INDIRECT_REF,
+			TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE
+						      (source_tree))),
+			source_tree);
+	  source_tree
+	    = ffecom_2 (ARRAY_REF,
+			TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE
+						      (source_tree))),
+			source_tree,
+			integer_one_node);
+
+	  expr_tree = ffecom_modify (void_type_node, dest_tree, source_tree);
+
+	  expand_expr_stmt (expr_tree);
+
+	  return;
+	}
+
+      expr_tree = build_tree_list (NULL_TREE, dest_tree);
+      TREE_CHAIN (expr_tree) = build_tree_list (NULL_TREE, source_tree);
+      TREE_CHAIN (TREE_CHAIN (expr_tree))
+	= build_tree_list (NULL_TREE, dest_length);
+      TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree)))
+	= build_tree_list (NULL_TREE, source_length);
+
+      expr_tree = ffecom_call_gfrt (FFECOM_gfrtCOPY, expr_tree, NULL_TREE);
+      TREE_SIDE_EFFECTS (expr_tree) = 1;
+
+      expand_expr_stmt (expr_tree);
+
+      return;
+
+    default:			/* Must actually concatenate things. */
+      break;
+    }
+
+  /* Heavy-duty concatenation. */
+
+  {
+    int count = ffecom_concat_list_count_ (catlist);
+    int i;
+    tree lengths;
+    tree items;
+    tree length_array;
+    tree item_array;
+    tree citem;
+    tree clength;
+
+    {
+      tree hook;
+
+      hook = ffebld_nonter_hook (source);
+      assert (hook);
+      assert (TREE_CODE (hook) == TREE_VEC);
+      assert (TREE_VEC_LENGTH (hook) == 2);
+      length_array = lengths = TREE_VEC_ELT (hook, 0);
+      item_array = items = TREE_VEC_ELT (hook, 1);
+    }
+
+    for (i = 0; i < count; ++i)
+      {
+	ffecom_char_args_ (&citem, &clength,
+			   ffecom_concat_list_expr_ (catlist, i));
+	if ((citem == error_mark_node)
+	    || (clength == error_mark_node))
+	  {
+	    ffecom_concat_list_kill_ (catlist);
+	    return;
+	  }
+
+	items
+	  = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (items),
+		      ffecom_modify (void_type_node,
+				     ffecom_2 (ARRAY_REF,
+		     TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item_array))),
+					       item_array,
+					       build_int_2 (i, 0)),
+				     citem),
+		      items);
+	lengths
+	  = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (lengths),
+		      ffecom_modify (void_type_node,
+				     ffecom_2 (ARRAY_REF,
+		   TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (length_array))),
+					       length_array,
+					       build_int_2 (i, 0)),
+				     clength),
+		      lengths);
+      }
+
+    expr_tree = build_tree_list (NULL_TREE, dest_tree);
+    TREE_CHAIN (expr_tree)
+      = build_tree_list (NULL_TREE,
+			 ffecom_1 (ADDR_EXPR,
+				   build_pointer_type (TREE_TYPE (items)),
+				   items));
+    TREE_CHAIN (TREE_CHAIN (expr_tree))
+      = build_tree_list (NULL_TREE,
+			 ffecom_1 (ADDR_EXPR,
+				   build_pointer_type (TREE_TYPE (lengths)),
+				   lengths));
+    TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree)))
+      = build_tree_list
+	(NULL_TREE,
+	 ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node,
+		   convert (ffecom_f2c_ftnlen_type_node,
+			    build_int_2 (count, 0))));
+    TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree))))
+      = build_tree_list (NULL_TREE, dest_length);
+
+    expr_tree = ffecom_call_gfrt (FFECOM_gfrtCAT, expr_tree, NULL_TREE);
+    TREE_SIDE_EFFECTS (expr_tree) = 1;
+
+    expand_expr_stmt (expr_tree);
+  }
+
+  ffecom_concat_list_kill_ (catlist);
+}
+
+/* ffecom_make_gfrt_ -- Make initial info for run-time routine
+
+   ffecomGfrt ix;
+   ffecom_make_gfrt_(ix);
+
+   Assumes gfrt_[ix] is NULL_TREE, and replaces it with the FUNCTION_DECL
+   for the indicated run-time routine (ix).  */
+
+static void
+ffecom_make_gfrt_ (ffecomGfrt ix)
+{
+  tree t;
+  tree ttype;
+
+  switch (ffecom_gfrt_type_[ix])
+    {
+    case FFECOM_rttypeVOID_:
+      ttype = void_type_node;
+      break;
+
+    case FFECOM_rttypeVOIDSTAR_:
+      ttype = TREE_TYPE (null_pointer_node);	/* `void *'. */
+      break;
+
+    case FFECOM_rttypeFTNINT_:
+      ttype = ffecom_f2c_ftnint_type_node;
+      break;
+
+    case FFECOM_rttypeINTEGER_:
+      ttype = ffecom_f2c_integer_type_node;
+      break;
+
+    case FFECOM_rttypeLONGINT_:
+      ttype = ffecom_f2c_longint_type_node;
+      break;
+
+    case FFECOM_rttypeLOGICAL_:
+      ttype = ffecom_f2c_logical_type_node;
+      break;
+
+    case FFECOM_rttypeREAL_F2C_:
+      ttype = double_type_node;
+      break;
+
+    case FFECOM_rttypeREAL_GNU_:
+      ttype = float_type_node;
+      break;
+
+    case FFECOM_rttypeCOMPLEX_F2C_:
+      ttype = void_type_node;
+      break;
+
+    case FFECOM_rttypeCOMPLEX_GNU_:
+      ttype = ffecom_f2c_complex_type_node;
+      break;
+
+    case FFECOM_rttypeDOUBLE_:
+      ttype = double_type_node;
+      break;
+
+    case FFECOM_rttypeDOUBLEREAL_:
+      ttype = ffecom_f2c_doublereal_type_node;
+      break;
+
+    case FFECOM_rttypeDBLCMPLX_F2C_:
+      ttype = void_type_node;
+      break;
+
+    case FFECOM_rttypeDBLCMPLX_GNU_:
+      ttype = ffecom_f2c_doublecomplex_type_node;
+      break;
+
+    case FFECOM_rttypeCHARACTER_:
+      ttype = void_type_node;
+      break;
+
+    default:
+      ttype = NULL;
+      assert ("bad rttype" == NULL);
+      break;
+    }
+
+  ttype = build_function_type (ttype, NULL_TREE);
+  t = build_decl (FUNCTION_DECL,
+		  get_identifier (ffecom_gfrt_name_[ix]),
+		  ttype);
+  DECL_EXTERNAL (t) = 1;
+  TREE_READONLY (t) = ffecom_gfrt_const_[ix] ? 1 : 0;
+  TREE_PUBLIC (t) = 1;
+  TREE_THIS_VOLATILE (t) = ffecom_gfrt_volatile_[ix] ? 1 : 0;
+
+  /* Sanity check:  A function that's const cannot be volatile.  */
+
+  assert (ffecom_gfrt_const_[ix] ? !ffecom_gfrt_volatile_[ix] : 1);
+
+  /* Sanity check: A function that's const cannot return complex.  */
+
+  assert (ffecom_gfrt_const_[ix] ? !ffecom_gfrt_complex_[ix] : 1);
+
+  t = start_decl (t, TRUE);
+
+  finish_decl (t, NULL_TREE, TRUE);
+
+  ffecom_gfrt_[ix] = t;
+}
+
+/* Phase 1 pass over each member of a COMMON/EQUIVALENCE group.  */
+
+static void
+ffecom_member_phase1_ (ffestorag mst UNUSED, ffestorag st)
+{
+  ffesymbol s = ffestorag_symbol (st);
+
+  if (ffesymbol_namelisted (s))
+    ffecom_member_namelisted_ = TRUE;
+}
+
+/* Phase 2 pass over each member of a COMMON/EQUIVALENCE group.  Declare
+   the member so debugger will see it.  Otherwise nobody should be
+   referencing the member.  */
+
+static void
+ffecom_member_phase2_ (ffestorag mst, ffestorag st)
+{
+  ffesymbol s;
+  tree t;
+  tree mt;
+  tree type;
+
+  if ((mst == NULL)
+      || ((mt = ffestorag_hook (mst)) == NULL)
+      || (mt == error_mark_node))
+    return;
+
+  if ((st == NULL)
+      || ((s = ffestorag_symbol (st)) == NULL))
+    return;
+
+  type = ffecom_type_localvar_ (s,
+				ffesymbol_basictype (s),
+				ffesymbol_kindtype (s));
+  if (type == error_mark_node)
+    return;
+
+  t = build_decl (VAR_DECL,
+		  ffecom_get_identifier_ (ffesymbol_text (s)),
+		  type);
+
+  TREE_STATIC (t) = TREE_STATIC (mt);
+  DECL_INITIAL (t) = NULL_TREE;
+  TREE_ASM_WRITTEN (t) = 1;
+  TREE_USED (t) = 1;
+
+  SET_DECL_RTL (t,
+		gen_rtx (MEM, TYPE_MODE (type),
+			 plus_constant (XEXP (DECL_RTL (mt), 0),
+					ffestorag_modulo (mst)
+					+ ffestorag_offset (st)
+					- ffestorag_offset (mst))));
+
+  t = start_decl (t, FALSE);
+
+  finish_decl (t, NULL_TREE, FALSE);
+}
+
+/* Prepare source expression for assignment into a destination perhaps known
+   to be of a specific size.  */
+
+static void
+ffecom_prepare_let_char_ (ffetargetCharacterSize dest_size, ffebld source)
+{
+  ffecomConcatList_ catlist;
+  int count;
+  int i;
+  tree ltmp;
+  tree itmp;
+  tree tempvar = NULL_TREE;
+
+  while (ffebld_op (source) == FFEBLD_opCONVERT)
+    source = ffebld_left (source);
+
+  catlist = ffecom_concat_list_new_ (source, dest_size);
+  count = ffecom_concat_list_count_ (catlist);
+
+  if (count >= 2)
+    {
+      ltmp
+	= ffecom_make_tempvar ("let_char_len", ffecom_f2c_ftnlen_type_node,
+			       FFETARGET_charactersizeNONE, count);
+      itmp
+	= ffecom_make_tempvar ("let_char_item", ffecom_f2c_address_type_node,
+			       FFETARGET_charactersizeNONE, count);
+
+      tempvar = make_tree_vec (2);
+      TREE_VEC_ELT (tempvar, 0) = ltmp;
+      TREE_VEC_ELT (tempvar, 1) = itmp;
+    }
+
+  for (i = 0; i < count; ++i)
+    ffecom_prepare_arg_ptr_to_expr (ffecom_concat_list_expr_ (catlist, i));
+
+  ffecom_concat_list_kill_ (catlist);
+
+  if (tempvar)
+    {
+      ffebld_nonter_set_hook (source, tempvar);
+      current_binding_level->prep_state = 1;
+    }
+}
+
+/* ffecom_push_dummy_decls_ -- Transform dummy args, push parm decls in order
+
+   Ignores STAR (alternate-return) dummies.  All other get exec-transitioned
+   (which generates their trees) and then their trees get push_parm_decl'd.
+
+   The second arg is TRUE if the dummies are for a statement function, in
+   which case lengths are not pushed for character arguments (since they are
+   always known by both the caller and the callee, though the code allows
+   for someday permitting CHAR*(*) stmtfunc dummies).  */
+
+static void
+ffecom_push_dummy_decls_ (ffebld dummy_list, bool stmtfunc)
+{
+  ffebld dummy;
+  ffebld dumlist;
+  ffesymbol s;
+  tree parm;
+
+  ffecom_transform_only_dummies_ = TRUE;
+
+  /* First push the parms corresponding to actual dummy "contents".  */
+
+  for (dumlist = dummy_list; dumlist != NULL; dumlist = ffebld_trail (dumlist))
+    {
+      dummy = ffebld_head (dumlist);
+      switch (ffebld_op (dummy))
+	{
+	case FFEBLD_opSTAR:
+	case FFEBLD_opANY:
+	  continue;		/* Forget alternate returns. */
+
+	default:
+	  break;
+	}
+      assert (ffebld_op (dummy) == FFEBLD_opSYMTER);
+      s = ffebld_symter (dummy);
+      parm = ffesymbol_hook (s).decl_tree;
+      if (parm == NULL_TREE)
+	{
+	  s = ffecom_sym_transform_ (s);
+	  parm = ffesymbol_hook (s).decl_tree;
+	  assert (parm != NULL_TREE);
+	}
+      if (parm != error_mark_node)
+	push_parm_decl (parm);
+    }
+
+  /* Then, for CHARACTER dummies, push the parms giving their lengths.  */
+
+  for (dumlist = dummy_list; dumlist != NULL; dumlist = ffebld_trail (dumlist))
+    {
+      dummy = ffebld_head (dumlist);
+      switch (ffebld_op (dummy))
+	{
+	case FFEBLD_opSTAR:
+	case FFEBLD_opANY:
+	  continue;		/* Forget alternate returns, they mean
+				   NOTHING! */
+
+	default:
+	  break;
+	}
+      s = ffebld_symter (dummy);
+      if (ffesymbol_basictype (s) != FFEINFO_basictypeCHARACTER)
+	continue;		/* Only looking for CHARACTER arguments. */
+      if (stmtfunc && (ffesymbol_size (s) != FFETARGET_charactersizeNONE))
+	continue;		/* Stmtfunc arg with known size needs no
+				   length param. */
+      if (ffesymbol_kind (s) != FFEINFO_kindENTITY)
+	continue;		/* Only looking for variables and arrays. */
+      parm = ffesymbol_hook (s).length_tree;
+      assert (parm != NULL_TREE);
+      if (parm != error_mark_node)
+	push_parm_decl (parm);
+    }
+
+  ffecom_transform_only_dummies_ = FALSE;
+}
+
+/* ffecom_start_progunit_ -- Beginning of program unit
+
+   Does GNU back end stuff necessary to teach it about the start of its
+   equivalent of a Fortran program unit.  */
+
+static void
+ffecom_start_progunit_ (void)
+{
+  ffesymbol fn = ffecom_primary_entry_;
+  ffebld arglist;
+  tree id;			/* Identifier (name) of function. */
+  tree type;			/* Type of function. */
+  tree result;			/* Result of function. */
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  ffeglobal g;
+  ffeglobalType gt;
+  ffeglobalType egt = FFEGLOBAL_type;
+  bool charfunc;
+  bool cmplxfunc;
+  bool altentries = (ffecom_num_entrypoints_ != 0);
+  bool multi
+  = altentries
+  && (ffecom_primary_entry_kind_ == FFEINFO_kindFUNCTION)
+  && (ffecom_master_bt_ == FFEINFO_basictypeNONE);
+  bool main_program = FALSE;
+  location_t old_loc = input_location;
+
+  assert (fn != NULL);
+  assert (ffesymbol_hook (fn).decl_tree == NULL_TREE);
+
+  input_filename = ffesymbol_where_filename (fn);
+  input_line = ffesymbol_where_filelinenum (fn);
+
+  switch (ffecom_primary_entry_kind_)
+    {
+    case FFEINFO_kindPROGRAM:
+      main_program = TRUE;
+      gt = FFEGLOBAL_typeMAIN;
+      bt = FFEINFO_basictypeNONE;
+      kt = FFEINFO_kindtypeNONE;
+      type = ffecom_tree_fun_type_void;
+      charfunc = FALSE;
+      cmplxfunc = FALSE;
+      break;
+
+    case FFEINFO_kindBLOCKDATA:
+      gt = FFEGLOBAL_typeBDATA;
+      bt = FFEINFO_basictypeNONE;
+      kt = FFEINFO_kindtypeNONE;
+      type = ffecom_tree_fun_type_void;
+      charfunc = FALSE;
+      cmplxfunc = FALSE;
+      break;
+
+    case FFEINFO_kindFUNCTION:
+      gt = FFEGLOBAL_typeFUNC;
+      egt = FFEGLOBAL_typeEXT;
+      bt = ffesymbol_basictype (fn);
+      kt = ffesymbol_kindtype (fn);
+      if (bt == FFEINFO_basictypeNONE)
+	{
+	  ffeimplic_establish_symbol (fn);
+	  if (ffesymbol_funcresult (fn) != NULL)
+	    ffeimplic_establish_symbol (ffesymbol_funcresult (fn));
+	  bt = ffesymbol_basictype (fn);
+	  kt = ffesymbol_kindtype (fn);
+	}
+
+      if (multi)
+	charfunc = cmplxfunc = FALSE;
+      else if (bt == FFEINFO_basictypeCHARACTER)
+	charfunc = TRUE, cmplxfunc = FALSE;
+      else if ((bt == FFEINFO_basictypeCOMPLEX)
+	       && ffesymbol_is_f2c (fn)
+	       && !altentries)
+	charfunc = FALSE, cmplxfunc = TRUE;
+      else
+	charfunc = cmplxfunc = FALSE;
+
+      if (multi || charfunc)
+	type = ffecom_tree_fun_type_void;
+      else if (ffesymbol_is_f2c (fn) && !altentries)
+	type = ffecom_tree_fun_type[bt][kt];
+      else
+	type = build_function_type (ffecom_tree_type[bt][kt], NULL_TREE);
+
+      if ((type == NULL_TREE)
+	  || (TREE_TYPE (type) == NULL_TREE))
+	type = ffecom_tree_fun_type_void;	/* _sym_exec_transition. */
+      break;
+
+    case FFEINFO_kindSUBROUTINE:
+      gt = FFEGLOBAL_typeSUBR;
+      egt = FFEGLOBAL_typeEXT;
+      bt = FFEINFO_basictypeNONE;
+      kt = FFEINFO_kindtypeNONE;
+      if (ffecom_is_altreturning_)
+	type = ffecom_tree_subr_type;
+      else
+	type = ffecom_tree_fun_type_void;
+      charfunc = FALSE;
+      cmplxfunc = FALSE;
+      break;
+
+    default:
+      assert ("say what??" == NULL);
+      /* Fall through. */
+    case FFEINFO_kindANY:
+      gt = FFEGLOBAL_typeANY;
+      bt = FFEINFO_basictypeNONE;
+      kt = FFEINFO_kindtypeNONE;
+      type = error_mark_node;
+      charfunc = FALSE;
+      cmplxfunc = FALSE;
+      break;
+    }
+
+  if (altentries)
+    {
+      id = ffecom_get_invented_identifier ("__g77_masterfun_%s",
+					   ffesymbol_text (fn));
+    }
+#if FFETARGET_isENFORCED_MAIN
+  else if (main_program)
+    id = get_identifier (FFETARGET_nameENFORCED_MAIN_NAME);
+#endif
+  else
+    id = ffecom_get_external_identifier_ (fn);
+
+  start_function (id,
+		  type,
+		  0,		/* nested/inline */
+		  !altentries);	/* TREE_PUBLIC */
+
+  TREE_USED (current_function_decl) = 1;	/* Avoid spurious warning if altentries. */
+
+  if (!altentries
+      && ((g = ffesymbol_global (fn)) != NULL)
+      && ((ffeglobal_type (g) == gt)
+	  || (ffeglobal_type (g) == egt)))
+    {
+      ffeglobal_set_hook (g, current_function_decl);
+    }
+
+  /* Arg handling needs exec-transitioned ffesymbols to work with.  But
+     exec-transitioning needs current_function_decl to be filled in.  So we
+     do these things in two phases. */
+
+  if (altentries)
+    {				/* 1st arg identifies which entrypoint. */
+      ffecom_which_entrypoint_decl_
+	= build_decl (PARM_DECL,
+		      ffecom_get_invented_identifier ("__g77_%s",
+						      "which_entrypoint"),
+		      integer_type_node);
+      push_parm_decl (ffecom_which_entrypoint_decl_);
+    }
+
+  if (charfunc
+      || cmplxfunc
+      || multi)
+    {				/* Arg for result (return value). */
+      tree type;
+      tree length;
+
+      if (charfunc)
+	type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt];
+      else if (cmplxfunc)
+	type = ffecom_tree_type[FFEINFO_basictypeCOMPLEX][kt];
+      else
+	type = ffecom_multi_type_node_;
+
+      result = ffecom_get_invented_identifier ("__g77_%s", "result");
+
+      /* Make length arg _and_ enhance type info for CHAR arg itself.  */
+
+      if (charfunc)
+	length = ffecom_char_enhance_arg_ (&type, fn);
+      else
+	length = NULL_TREE;	/* Not ref'd if !charfunc. */
+
+      type = build_pointer_type (type);
+      result = build_decl (PARM_DECL, result, type);
+
+      push_parm_decl (result);
+      if (multi)
+	ffecom_multi_retval_ = result;
+      else
+	ffecom_func_result_ = result;
+
+      if (charfunc)
+	{
+	  push_parm_decl (length);
+	  ffecom_func_length_ = length;
+	}
+    }
+
+  if (ffecom_primary_entry_is_proc_)
+    {
+      if (altentries)
+	arglist = ffecom_master_arglist_;
+      else
+	arglist = ffesymbol_dummyargs (fn);
+      ffecom_push_dummy_decls_ (arglist, FALSE);
+    }
+
+  if (TREE_CODE (current_function_decl) != ERROR_MARK)
+    store_parm_decls (main_program ? 1 : 0);
+
+  ffecom_start_compstmt ();
+  /* Disallow temp vars at this level.  */
+  current_binding_level->prep_state = 2;
+
+  input_location = old_loc;
+
+  /* This handles any symbols still untransformed, in case -g specified.
+     This used to be done in ffecom_finish_progunit, but it turns out to
+     be necessary to do it here so that statement functions are
+     expanded before code.  But don't bother for BLOCK DATA.  */
+
+  if (ffecom_primary_entry_kind_ != FFEINFO_kindBLOCKDATA)
+    ffesymbol_drive (ffecom_finish_symbol_transform_);
+}
+
+/* ffecom_sym_transform_ -- Transform FFE sym into backend sym
+
+   ffesymbol s;
+   ffecom_sym_transform_(s);
+
+   The ffesymbol_hook info for s is updated with appropriate backend info
+   on the symbol.  */
+
+static ffesymbol
+ffecom_sym_transform_ (ffesymbol s)
+{
+  tree t;			/* Transformed thingy. */
+  tree tlen;			/* Length if CHAR*(*). */
+  bool addr;			/* Is t the address of the thingy? */
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  ffeglobal g;
+  location_t old_loc = input_location;
+
+  /* Must ensure special ASSIGN variables are declared at top of outermost
+     block, else they'll end up in the innermost block when their first
+     ASSIGN is seen, which leaves them out of scope when they're the
+     subject of a GOTO or I/O statement.
+
+     We make this variable even if -fugly-assign.  Just let it go unused,
+     in case it turns out there are cases where we really want to use this
+     variable anyway (e.g. ASSIGN to INTEGER*2 variable).  */
+
+  if (! ffecom_transform_only_dummies_
+      && ffesymbol_assigned (s)
+      && ! ffesymbol_hook (s).assign_tree)
+    s = ffecom_sym_transform_assign_ (s);
+
+  if (ffesymbol_sfdummyparent (s) == NULL)
+    {
+      input_filename = ffesymbol_where_filename (s);
+      input_line = ffesymbol_where_filelinenum (s);
+    }
+  else
+    {
+      ffesymbol sf = ffesymbol_sfdummyparent (s);
+
+      input_filename = ffesymbol_where_filename (sf);
+      input_line = ffesymbol_where_filelinenum (sf);
+    }
+
+  bt = ffeinfo_basictype (ffebld_info (s));
+  kt = ffeinfo_kindtype (ffebld_info (s));
+
+  t = NULL_TREE;
+  tlen = NULL_TREE;
+  addr = FALSE;
+
+  switch (ffesymbol_kind (s))
+    {
+    case FFEINFO_kindNONE:
+      switch (ffesymbol_where (s))
+	{
+	case FFEINFO_whereDUMMY:	/* Subroutine or function. */
+	  assert (ffecom_transform_only_dummies_);
+
+	  /* Before 0.4, this could be ENTITY/DUMMY, but see
+	     ffestu_sym_end_transition -- no longer true (in particular, if
+	     it could be an ENTITY, it _will_ be made one, so that
+	     possibility won't come through here).  So we never make length
+	     arg for CHARACTER type.  */
+
+	  t = build_decl (PARM_DECL,
+			  ffecom_get_identifier_ (ffesymbol_text (s)),
+			  ffecom_tree_ptr_to_subr_type);
+	  DECL_ARTIFICIAL (t) = 1;
+	  addr = TRUE;
+	  break;
+
+	case FFEINFO_whereGLOBAL:	/* Subroutine or function. */
+	  assert (!ffecom_transform_only_dummies_);
+
+	  if (((g = ffesymbol_global (s)) != NULL)
+	      && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
+		  || (ffeglobal_type (g) == FFEGLOBAL_typeFUNC)
+		  || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))
+	      && (ffeglobal_hook (g) != NULL_TREE)
+	      && ffe_is_globals ())
+	    {
+	      t = ffeglobal_hook (g);
+	      break;
+	    }
+
+	  t = build_decl (FUNCTION_DECL,
+			  ffecom_get_external_identifier_ (s),
+			  ffecom_tree_subr_type);	/* Assume subr. */
+	  DECL_EXTERNAL (t) = 1;
+	  TREE_PUBLIC (t) = 1;
+
+	  t = start_decl (t, FALSE);
+	  finish_decl (t, NULL_TREE, FALSE);
+
+	  if ((g != NULL)
+	      && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
+		  || (ffeglobal_type (g) == FFEGLOBAL_typeFUNC)
+		  || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)))
+	    ffeglobal_set_hook (g, t);
+
+	  ffecom_save_tree_forever (t);
+
+	  break;
+
+	default:
+	  assert ("NONE where unexpected" == NULL);
+	  /* Fall through. */
+	case FFEINFO_whereANY:
+	  break;
+	}
+      break;
+
+    case FFEINFO_kindENTITY:
+      switch (ffeinfo_where (ffesymbol_info (s)))
+	{
+
+	case FFEINFO_whereCONSTANT:
+	  /* ~~Debugging info needed? */
+	  assert (!ffecom_transform_only_dummies_);
+	  t = error_mark_node;	/* Shouldn't ever see this in expr. */
+	  break;
+
+	case FFEINFO_whereLOCAL:
+	  assert (!ffecom_transform_only_dummies_);
+
+	  {
+	    ffestorag st = ffesymbol_storage (s);
+	    tree type;
+
+	    type = ffecom_type_localvar_ (s, bt, kt);
+
+	    if (type == error_mark_node)
+	      {
+		t = error_mark_node;
+		break;
+	      }
+
+	    if ((st != NULL)
+		&& (ffestorag_size (st) == 0))
+	      {
+		t = error_mark_node;
+		break;
+	      }
+
+	    if ((st != NULL)
+		&& (ffestorag_parent (st) != NULL))
+	      {			/* Child of EQUIVALENCE parent. */
+		ffestorag est;
+		tree et;
+		ffetargetOffset offset;
+
+		est = ffestorag_parent (st);
+		ffecom_transform_equiv_ (est);
+
+		et = ffestorag_hook (est);
+		assert (et != NULL_TREE);
+
+		if (! TREE_STATIC (et))
+		  put_var_into_stack (et, /*rescan=*/true);
+
+		offset = ffestorag_modulo (est)
+		  + ffestorag_offset (ffesymbol_storage (s))
+		  - ffestorag_offset (est);
+
+		ffecom_debug_kludge_ (et, "EQUIVALENCE", s, type, offset);
+
+		/* (t_type *) (((char *) &et) + offset) */
+
+		t = convert (string_type_node,	/* (char *) */
+			     ffecom_1 (ADDR_EXPR,
+				       build_pointer_type (TREE_TYPE (et)),
+				       et));
+		t = ffecom_2 (PLUS_EXPR, TREE_TYPE (t),
+			      t,
+			      build_int_2 (offset, 0));
+		t = convert (build_pointer_type (type),
+			     t);
+		TREE_CONSTANT (t) = staticp (et);
+
+		addr = TRUE;
+	      }
+	    else
+	      {
+		tree initexpr;
+		bool init = ffesymbol_is_init (s);
+
+		t = build_decl (VAR_DECL,
+				ffecom_get_identifier_ (ffesymbol_text (s)),
+				type);
+
+		if (init
+		    || ffesymbol_namelisted (s)
+#ifdef FFECOM_sizeMAXSTACKITEM
+		    || ((st != NULL)
+			&& (ffestorag_size (st) > FFECOM_sizeMAXSTACKITEM))
+#endif
+		    || ((ffecom_primary_entry_kind_ != FFEINFO_kindPROGRAM)
+			&& (ffecom_primary_entry_kind_
+			    != FFEINFO_kindBLOCKDATA)
+			&& (ffesymbol_is_save (s) || ffe_is_saveall ())))
+		  TREE_STATIC (t) = !ffesymbol_attr (s, FFESYMBOL_attrADJUSTABLE);
+		else
+		  TREE_STATIC (t) = 0;	/* No need to make static. */
+
+		if (init || ffe_is_init_local_zero ())
+		  DECL_INITIAL (t) = error_mark_node;
+
+		/* Keep -Wunused from complaining about var if it
+		   is used as sfunc arg or DATA implied-DO.  */
+		if (ffesymbol_attrs (s) & FFESYMBOL_attrsSFARG)
+		  DECL_IN_SYSTEM_HEADER (t) = 1;
+
+		t = start_decl (t, FALSE);
+
+		if (init)
+		  {
+		    if (ffesymbol_init (s) != NULL)
+		      initexpr = ffecom_expr (ffesymbol_init (s));
+		    else
+		      initexpr = ffecom_init_zero_ (t);
+		  }
+		else if (ffe_is_init_local_zero ())
+		  initexpr = ffecom_init_zero_ (t);
+		else
+		  initexpr = NULL_TREE;	/* Not ref'd if !init. */
+
+		finish_decl (t, initexpr, FALSE);
+
+		if (st != NULL && DECL_SIZE (t) != error_mark_node)
+		  {
+		    assert (TREE_CODE (DECL_SIZE_UNIT (t)) == INTEGER_CST);
+		    assert (0 == compare_tree_int (DECL_SIZE_UNIT (t),
+						   ffestorag_size (st)));
+		  }
+	      }
+	  }
+	  break;
+
+	case FFEINFO_whereRESULT:
+	  assert (!ffecom_transform_only_dummies_);
+
+	  if (bt == FFEINFO_basictypeCHARACTER)
+	    {			/* Result is already in list of dummies, use
+				   it (& length). */
+	      t = ffecom_func_result_;
+	      tlen = ffecom_func_length_;
+	      addr = TRUE;
+	      break;
+	    }
+	  if ((ffecom_num_entrypoints_ == 0)
+	      && (bt == FFEINFO_basictypeCOMPLEX)
+	      && (ffesymbol_is_f2c (ffecom_primary_entry_)))
+	    {			/* Result is already in list of dummies, use
+				   it. */
+	      t = ffecom_func_result_;
+	      addr = TRUE;
+	      break;
+	    }
+	  if (ffecom_func_result_ != NULL_TREE)
+	    {
+	      t = ffecom_func_result_;
+	      break;
+	    }
+	  if ((ffecom_num_entrypoints_ != 0)
+	      && (ffecom_master_bt_ == FFEINFO_basictypeNONE))
+	    {
+	      assert (ffecom_multi_retval_ != NULL_TREE);
+	      t = ffecom_1 (INDIRECT_REF, ffecom_multi_type_node_,
+			    ffecom_multi_retval_);
+	      t = ffecom_2 (COMPONENT_REF, ffecom_tree_type[bt][kt],
+			    t, ffecom_multi_fields_[bt][kt]);
+
+	      break;
+	    }
+
+	  t = build_decl (VAR_DECL,
+			  ffecom_get_identifier_ (ffesymbol_text (s)),
+			  ffecom_tree_type[bt][kt]);
+	  TREE_STATIC (t) = 0;	/* Put result on stack. */
+	  t = start_decl (t, FALSE);
+	  finish_decl (t, NULL_TREE, FALSE);
+
+	  ffecom_func_result_ = t;
+
+	  break;
+
+	case FFEINFO_whereDUMMY:
+	  {
+	    tree type;
+	    ffebld dl;
+	    ffebld dim;
+	    tree low;
+	    tree high;
+	    tree old_sizes;
+	    bool adjustable = FALSE;	/* Conditionally adjustable? */
+
+	    type = ffecom_tree_type[bt][kt];
+	    if (ffesymbol_sfdummyparent (s) != NULL)
+	      {
+		if (current_function_decl == ffecom_outer_function_decl_)
+		  {			/* Exec transition before sfunc
+					   context; get it later. */
+		    break;
+		  }
+		t = ffecom_get_identifier_ (ffesymbol_text
+					    (ffesymbol_sfdummyparent (s)));
+	      }
+	    else
+	      t = ffecom_get_identifier_ (ffesymbol_text (s));
+
+	    assert (ffecom_transform_only_dummies_);
+
+	    old_sizes = get_pending_sizes ();
+	    put_pending_sizes (old_sizes);
+
+	    if (bt == FFEINFO_basictypeCHARACTER)
+	      tlen = ffecom_char_enhance_arg_ (&type, s);
+	    type = ffecom_check_size_overflow_ (s, type, TRUE);
+
+	    for (dl = ffesymbol_dims (s); dl != NULL; dl = ffebld_trail (dl))
+	      {
+		if (type == error_mark_node)
+		  break;
+
+		dim = ffebld_head (dl);
+		assert (ffebld_op (dim) == FFEBLD_opBOUNDS);
+		if ((ffebld_left (dim) == NULL) || ffecom_doing_entry_)
+		  low = ffecom_integer_one_node;
+		else
+		  low = ffecom_expr (ffebld_left (dim));
+		assert (ffebld_right (dim) != NULL);
+		if ((ffebld_op (ffebld_right (dim)) == FFEBLD_opSTAR)
+		    || ffecom_doing_entry_)
+		  {
+		    /* Used to just do high=low.  But for ffecom_tree_
+		       canonize_ref_, it probably is important to correctly
+		       assess the size.  E.g. given COMPLEX C(*),CFUNC and
+		       C(2)=CFUNC(C), overlap can happen, while it can't
+		       for, say, C(1)=CFUNC(C(2)).  */
+		    /* Even more recently used to set to INT_MAX, but that
+		       broke when some overflow checking went into the back
+		       end.  Now we just leave the upper bound unspecified.  */
+		    high = NULL;
+		  }
+		else
+		  high = ffecom_expr (ffebld_right (dim));
+
+		/* Determine whether array is conditionally adjustable,
+		   to decide whether back-end magic is needed.
+
+		   Normally the front end uses the back-end function
+		   variable_size to wrap SAVE_EXPR's around expressions
+		   affecting the size/shape of an array so that the
+		   size/shape info doesn't change during execution
+		   of the compiled code even though variables and
+		   functions referenced in those expressions might.
+
+		   variable_size also makes sure those saved expressions
+		   get evaluated immediately upon entry to the
+		   compiled procedure -- the front end normally doesn't
+		   have to worry about that.
+
+		   However, there is a problem with this that affects
+		   g77's implementation of entry points, and that is
+		   that it is _not_ true that each invocation of the
+		   compiled procedure is permitted to evaluate
+		   array size/shape info -- because it is possible
+		   that, for some invocations, that info is invalid (in
+		   which case it is "promised" -- i.e. a violation of
+		   the Fortran standard -- that the compiled code
+		   won't reference the array or its size/shape
+		   during that particular invocation).
+
+		   To phrase this in C terms, consider this gcc function:
+
+		     void foo (int *n, float (*a)[*n])
+		     {
+		       // a is "pointer to array ...", fyi.
+		     }
+
+		   Suppose that, for some invocations, it is permitted
+		   for a caller of foo to do this:
+
+		       foo (NULL, NULL);
+
+		   Now the _written_ code for foo can take such a call
+		   into account by either testing explicitly for whether
+		   (a == NULL) || (n == NULL) -- presumably it is
+		   not permitted to reference *a in various fashions
+		   if (n == NULL) I suppose -- or it can avoid it by
+		   looking at other info (other arguments, static/global
+		   data, etc.).
+
+		   However, this won't work in gcc 2.5.8 because it'll
+		   automatically emit the code to save the "*n"
+		   expression, which'll yield a NULL dereference for
+		   the "foo (NULL, NULL)" call, something the code
+		   for foo cannot prevent.
+
+		   g77 definitely needs to avoid executing such
+		   code anytime the pointer to the adjustable array
+		   is NULL, because even if its bounds expressions
+		   don't have any references to possible "absent"
+		   variables like "*n" -- say all variable references
+		   are to COMMON variables, i.e. global (though in C,
+		   local static could actually make sense) -- the
+		   expressions could yield other run-time problems
+		   for allowably "dead" values in those variables.
+
+		   For example, let's consider a more complicated
+		   version of foo:
+
+		     extern int i;
+		     extern int j;
+
+		     void foo (float (*a)[i/j])
+		     {
+		       ...
+		     }
+
+		   The above is (essentially) quite valid for Fortran
+		   but, again, for a call like "foo (NULL);", it is
+		   permitted for i and j to be undefined when the
+		   call is made.  If j happened to be zero, for
+		   example, emitting the code to evaluate "i/j"
+		   could result in a run-time error.
+
+		   Offhand, though I don't have my F77 or F90
+		   standards handy, it might even be valid for a
+		   bounds expression to contain a function reference,
+		   in which case I doubt it is permitted for an
+		   implementation to invoke that function in the
+		   Fortran case involved here (invocation of an
+		   alternate ENTRY point that doesn't have the adjustable
+		   array as one of its arguments).
+
+		   So, the code that the compiler would normally emit
+		   to preevaluate the size/shape info for an
+		   adjustable array _must not_ be executed at run time
+		   in certain cases.  Specifically, for Fortran,
+		   the case is when the pointer to the adjustable
+		   array == NULL.  (For gnu-ish C, it might be nice
+		   for the source code itself to specify an expression
+		   that, if TRUE, inhibits execution of the code.  Or
+		   reverse the sense for elegance.)
+
+		   (Note that g77 could use a different test than NULL,
+		   actually, since it happens to always pass an
+		   integer to the called function that specifies which
+		   entry point is being invoked.  Hmm, this might
+		   solve the next problem.)
+
+		   One way a user could, I suppose, write "foo" so
+		   it works is to insert COND_EXPR's for the
+		   size/shape info so the dangerous stuff isn't
+		   actually done, as in:
+
+		     void foo (int *n, float (*a)[(a == NULL) ? 0 : *n])
+		     {
+		       ...
+		     }
+
+		   The next problem is that the front end needs to
+		   be able to tell the back end about the array's
+		   decl _before_ it tells it about the conditional
+		   expression to inhibit evaluation of size/shape info,
+		   as shown above.
+
+		   To solve this, the front end needs to be able
+		   to give the back end the expression to inhibit
+		   generation of the preevaluation code _after_
+		   it makes the decl for the adjustable array.
+
+		   Until then, the above example using the COND_EXPR
+		   doesn't pass muster with gcc because the "(a == NULL)"
+		   part has a reference to "a", which is still
+		   undefined at that point.
+
+		   g77 will therefore use a different mechanism in the
+		   meantime.  */
+
+		if (!adjustable
+		    && ((TREE_CODE (low) != INTEGER_CST)
+			|| (high && TREE_CODE (high) != INTEGER_CST)))
+		  adjustable = TRUE;
+
+#if 0				/* Old approach -- see below. */
+		if (TREE_CODE (low) != INTEGER_CST)
+		  low = ffecom_3 (COND_EXPR, integer_type_node,
+				  ffecom_adjarray_passed_ (s),
+				  low,
+				  ffecom_integer_zero_node);
+
+		if (high && TREE_CODE (high) != INTEGER_CST)
+		  high = ffecom_3 (COND_EXPR, integer_type_node,
+				   ffecom_adjarray_passed_ (s),
+				   high,
+				   ffecom_integer_zero_node);
+#endif
+
+		/* ~~~gcc/stor-layout.c (layout_type) should do this,
+		   probably.  Fixes 950302-1.f.  */
+
+		if (TREE_CODE (low) != INTEGER_CST)
+		  low = variable_size (low);
+
+		/* ~~~Similarly, this fixes dumb0.f.  The C front end
+		   does this, which is why dumb0.c would work.  */
+
+		if (high && TREE_CODE (high) != INTEGER_CST)
+		  high = variable_size (high);
+
+		type
+		  = build_array_type
+		    (type,
+		     build_range_type (ffecom_integer_type_node,
+				       low, high));
+		type = ffecom_check_size_overflow_ (s, type, TRUE);
+	      }
+
+	    if (type == error_mark_node)
+	      {
+		t = error_mark_node;
+		break;
+	      }
+
+	    if ((ffesymbol_sfdummyparent (s) == NULL)
+		 || (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER))
+	      {
+		type = build_pointer_type (type);
+		addr = TRUE;
+	      }
+
+	    t = build_decl (PARM_DECL, t, type);
+	    DECL_ARTIFICIAL (t) = 1;
+
+	    /* If this arg is present in every entry point's list of
+	       dummy args, then we're done.  */
+
+	    if (ffesymbol_numentries (s)
+		== (ffecom_num_entrypoints_ + 1))
+	      break;
+
+#if 1
+
+	    /* If variable_size in stor-layout has been called during
+	       the above, then get_pending_sizes should have the
+	       yet-to-be-evaluated saved expressions pending.
+	       Make the whole lot of them get emitted, conditionally
+	       on whether the array decl ("t" above) is not NULL.  */
+
+	    {
+	      tree sizes = get_pending_sizes ();
+	      tree tem;
+
+	      for (tem = sizes;
+		   tem != old_sizes;
+		   tem = TREE_CHAIN (tem))
+		{
+		  tree temv = TREE_VALUE (tem);
+
+		  if (sizes == tem)
+		    sizes = temv;
+		  else
+		    sizes
+		      = ffecom_2 (COMPOUND_EXPR,
+				  TREE_TYPE (sizes),
+				  temv,
+				  sizes);
+		}
+
+	      if (sizes != tem)
+		{
+		  sizes
+		    = ffecom_3 (COND_EXPR,
+				TREE_TYPE (sizes),
+				ffecom_2 (NE_EXPR,
+					  integer_type_node,
+					  t,
+					  null_pointer_node),
+				sizes,
+				convert (TREE_TYPE (sizes),
+					 integer_zero_node));
+		  sizes = ffecom_save_tree (sizes);
+
+		  sizes
+		    = tree_cons (NULL_TREE, sizes, tem);
+		}
+
+	      if (sizes)
+		put_pending_sizes (sizes);
+	    }
+
+#else
+#if 0
+	    if (adjustable
+		&& (ffesymbol_numentries (s)
+		    != ffecom_num_entrypoints_ + 1))
+	      DECL_SOMETHING (t)
+		= ffecom_2 (NE_EXPR, integer_type_node,
+			    t,
+			    null_pointer_node);
+#else
+#if 0
+	    if (adjustable
+		&& (ffesymbol_numentries (s)
+		    != ffecom_num_entrypoints_ + 1))
+	      {
+		ffebad_start (FFEBAD_MISSING_ADJARRAY_UNSUPPORTED);
+		ffebad_here (0, ffesymbol_where_line (s),
+			     ffesymbol_where_column (s));
+		ffebad_string (ffesymbol_text (s));
+		ffebad_finish ();
+	      }
+#endif
+#endif
+#endif
+	  }
+	  break;
+
+	case FFEINFO_whereCOMMON:
+	  {
+	    ffesymbol cs;
+	    ffeglobal cg;
+	    tree ct;
+	    ffestorag st = ffesymbol_storage (s);
+	    tree type;
+
+	    cs = ffesymbol_common (s);	/* The COMMON area itself.  */
+	    if (st != NULL)	/* Else not laid out. */
+	      {
+		ffecom_transform_common_ (cs);
+		st = ffesymbol_storage (s);
+	      }
+
+	    type = ffecom_type_localvar_ (s, bt, kt);
+
+	    cg = ffesymbol_global (cs);	/* The global COMMON info.  */
+	    if ((cg == NULL)
+		|| (ffeglobal_type (cg) != FFEGLOBAL_typeCOMMON))
+	      ct = NULL_TREE;
+	    else
+	      ct = ffeglobal_hook (cg);	/* The common area's tree.  */
+
+	    if ((ct == NULL_TREE)
+		|| (st == NULL)
+		|| (type == error_mark_node))
+	      t = error_mark_node;
+	    else
+	      {
+		ffetargetOffset offset;
+		ffestorag cst;
+		tree toffset;
+
+		cst = ffestorag_parent (st);
+		assert (cst == ffesymbol_storage (cs));
+
+		offset = ffestorag_modulo (cst)
+		  + ffestorag_offset (st)
+		  - ffestorag_offset (cst);
+
+		ffecom_debug_kludge_ (ct, "COMMON", s, type, offset);
+
+		/* (t_type *) (((char *) &ct) + offset) */
+
+		t = convert (string_type_node,	/* (char *) */
+			     ffecom_1 (ADDR_EXPR,
+				       build_pointer_type (TREE_TYPE (ct)),
+				       ct));
+		toffset = build_int_2 (offset, 0);
+		TREE_TYPE (toffset) = ssizetype;
+		t = ffecom_2 (PLUS_EXPR, TREE_TYPE (t),
+			      t, toffset);
+		t = convert (build_pointer_type (type),
+			     t);
+		TREE_CONSTANT (t) = 1;
+
+		addr = TRUE;
+	      }
+	  }
+	  break;
+
+	case FFEINFO_whereIMMEDIATE:
+	case FFEINFO_whereGLOBAL:
+	case FFEINFO_whereFLEETING:
+	case FFEINFO_whereFLEETING_CADDR:
+	case FFEINFO_whereFLEETING_IADDR:
+	case FFEINFO_whereINTRINSIC:
+	case FFEINFO_whereCONSTANT_SUBOBJECT:
+	default:
+	  assert ("ENTITY where unheard of" == NULL);
+	  /* Fall through. */
+	case FFEINFO_whereANY:
+	  t = error_mark_node;
+	  break;
+	}
+      break;
+
+    case FFEINFO_kindFUNCTION:
+      switch (ffeinfo_where (ffesymbol_info (s)))
+	{
+	case FFEINFO_whereLOCAL:	/* Me. */
+	  assert (!ffecom_transform_only_dummies_);
+	  t = current_function_decl;
+	  break;
+
+	case FFEINFO_whereGLOBAL:
+	  assert (!ffecom_transform_only_dummies_);
+
+	  if (((g = ffesymbol_global (s)) != NULL)
+	      && ((ffeglobal_type (g) == FFEGLOBAL_typeFUNC)
+		  || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))
+	      && (ffeglobal_hook (g) != NULL_TREE)
+	      && ffe_is_globals ())
+	    {
+	      t = ffeglobal_hook (g);
+	      break;
+	    }
+
+	  if (ffesymbol_is_f2c (s)
+	      && (ffesymbol_where (s) != FFEINFO_whereCONSTANT))
+	    t = ffecom_tree_fun_type[bt][kt];
+	  else
+	    t = build_function_type (ffecom_tree_type[bt][kt], NULL_TREE);
+
+	  t = build_decl (FUNCTION_DECL,
+			  ffecom_get_external_identifier_ (s),
+			  t);
+	  DECL_EXTERNAL (t) = 1;
+	  TREE_PUBLIC (t) = 1;
+
+	  t = start_decl (t, FALSE);
+	  finish_decl (t, NULL_TREE, FALSE);
+
+	  if ((g != NULL)
+	      && ((ffeglobal_type (g) == FFEGLOBAL_typeFUNC)
+		  || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)))
+	    ffeglobal_set_hook (g, t);
+
+	  ffecom_save_tree_forever (t);
+
+	  break;
+
+	case FFEINFO_whereDUMMY:
+	  assert (ffecom_transform_only_dummies_);
+
+	  if (ffesymbol_is_f2c (s)
+	      && (ffesymbol_where (s) != FFEINFO_whereCONSTANT))
+	    t = ffecom_tree_ptr_to_fun_type[bt][kt];
+	  else
+	    t = build_pointer_type
+	      (build_function_type (ffecom_tree_type[bt][kt], NULL_TREE));
+
+	  t = build_decl (PARM_DECL,
+			  ffecom_get_identifier_ (ffesymbol_text (s)),
+			  t);
+	  DECL_ARTIFICIAL (t) = 1;
+	  addr = TRUE;
+	  break;
+
+	case FFEINFO_whereCONSTANT:	/* Statement function. */
+	  assert (!ffecom_transform_only_dummies_);
+	  t = ffecom_gen_sfuncdef_ (s, bt, kt);
+	  break;
+
+	case FFEINFO_whereINTRINSIC:
+	  assert (!ffecom_transform_only_dummies_);
+	  break;		/* Let actual references generate their
+				   decls. */
+
+	default:
+	  assert ("FUNCTION where unheard of" == NULL);
+	  /* Fall through. */
+	case FFEINFO_whereANY:
+	  t = error_mark_node;
+	  break;
+	}
+      break;
+
+    case FFEINFO_kindSUBROUTINE:
+      switch (ffeinfo_where (ffesymbol_info (s)))
+	{
+	case FFEINFO_whereLOCAL:	/* Me. */
+	  assert (!ffecom_transform_only_dummies_);
+	  t = current_function_decl;
+	  break;
+
+	case FFEINFO_whereGLOBAL:
+	  assert (!ffecom_transform_only_dummies_);
+
+	  if (((g = ffesymbol_global (s)) != NULL)
+	      && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
+		  || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))
+	      && (ffeglobal_hook (g) != NULL_TREE)
+	      && ffe_is_globals ())
+	    {
+	      t = ffeglobal_hook (g);
+	      break;
+	    }
+
+	  t = build_decl (FUNCTION_DECL,
+			  ffecom_get_external_identifier_ (s),
+			  ffecom_tree_subr_type);
+	  DECL_EXTERNAL (t) = 1;
+	  TREE_PUBLIC (t) = 1;
+
+	  t = start_decl (t, ffe_is_globals ());
+	  finish_decl (t, NULL_TREE, ffe_is_globals ());
+
+	  if ((g != NULL)
+	      && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
+		  || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)))
+	    ffeglobal_set_hook (g, t);
+
+	  ffecom_save_tree_forever (t);
+
+	  break;
+
+	case FFEINFO_whereDUMMY:
+	  assert (ffecom_transform_only_dummies_);
+
+	  t = build_decl (PARM_DECL,
+			  ffecom_get_identifier_ (ffesymbol_text (s)),
+			  ffecom_tree_ptr_to_subr_type);
+	  DECL_ARTIFICIAL (t) = 1;
+	  addr = TRUE;
+	  break;
+
+	case FFEINFO_whereINTRINSIC:
+	  assert (!ffecom_transform_only_dummies_);
+	  break;		/* Let actual references generate their
+				   decls. */
+
+	default:
+	  assert ("SUBROUTINE where unheard of" == NULL);
+	  /* Fall through. */
+	case FFEINFO_whereANY:
+	  t = error_mark_node;
+	  break;
+	}
+      break;
+
+    case FFEINFO_kindPROGRAM:
+      switch (ffeinfo_where (ffesymbol_info (s)))
+	{
+	case FFEINFO_whereLOCAL:	/* Me. */
+	  assert (!ffecom_transform_only_dummies_);
+	  t = current_function_decl;
+	  break;
+
+	case FFEINFO_whereCOMMON:
+	case FFEINFO_whereDUMMY:
+	case FFEINFO_whereGLOBAL:
+	case FFEINFO_whereRESULT:
+	case FFEINFO_whereFLEETING:
+	case FFEINFO_whereFLEETING_CADDR:
+	case FFEINFO_whereFLEETING_IADDR:
+	case FFEINFO_whereIMMEDIATE:
+	case FFEINFO_whereINTRINSIC:
+	case FFEINFO_whereCONSTANT:
+	case FFEINFO_whereCONSTANT_SUBOBJECT:
+	default:
+	  assert ("PROGRAM where unheard of" == NULL);
+	  /* Fall through. */
+	case FFEINFO_whereANY:
+	  t = error_mark_node;
+	  break;
+	}
+      break;
+
+    case FFEINFO_kindBLOCKDATA:
+      switch (ffeinfo_where (ffesymbol_info (s)))
+	{
+	case FFEINFO_whereLOCAL:	/* Me. */
+	  assert (!ffecom_transform_only_dummies_);
+	  t = current_function_decl;
+	  break;
+
+	case FFEINFO_whereGLOBAL:
+	  assert (!ffecom_transform_only_dummies_);
+
+	  t = build_decl (FUNCTION_DECL,
+			  ffecom_get_external_identifier_ (s),
+			  ffecom_tree_blockdata_type);
+	  DECL_EXTERNAL (t) = 1;
+	  TREE_PUBLIC (t) = 1;
+
+	  t = start_decl (t, FALSE);
+	  finish_decl (t, NULL_TREE, FALSE);
+
+	  ffecom_save_tree_forever (t);
+
+	  break;
+
+	case FFEINFO_whereCOMMON:
+	case FFEINFO_whereDUMMY:
+	case FFEINFO_whereRESULT:
+	case FFEINFO_whereFLEETING:
+	case FFEINFO_whereFLEETING_CADDR:
+	case FFEINFO_whereFLEETING_IADDR:
+	case FFEINFO_whereIMMEDIATE:
+	case FFEINFO_whereINTRINSIC:
+	case FFEINFO_whereCONSTANT:
+	case FFEINFO_whereCONSTANT_SUBOBJECT:
+	default:
+	  assert ("BLOCKDATA where unheard of" == NULL);
+	  /* Fall through. */
+	case FFEINFO_whereANY:
+	  t = error_mark_node;
+	  break;
+	}
+      break;
+
+    case FFEINFO_kindCOMMON:
+      switch (ffeinfo_where (ffesymbol_info (s)))
+	{
+	case FFEINFO_whereLOCAL:
+	  assert (!ffecom_transform_only_dummies_);
+	  ffecom_transform_common_ (s);
+	  break;
+
+	case FFEINFO_whereNONE:
+	case FFEINFO_whereCOMMON:
+	case FFEINFO_whereDUMMY:
+	case FFEINFO_whereGLOBAL:
+	case FFEINFO_whereRESULT:
+	case FFEINFO_whereFLEETING:
+	case FFEINFO_whereFLEETING_CADDR:
+	case FFEINFO_whereFLEETING_IADDR:
+	case FFEINFO_whereIMMEDIATE:
+	case FFEINFO_whereINTRINSIC:
+	case FFEINFO_whereCONSTANT:
+	case FFEINFO_whereCONSTANT_SUBOBJECT:
+	default:
+	  assert ("COMMON where unheard of" == NULL);
+	  /* Fall through. */
+	case FFEINFO_whereANY:
+	  t = error_mark_node;
+	  break;
+	}
+      break;
+
+    case FFEINFO_kindCONSTRUCT:
+      switch (ffeinfo_where (ffesymbol_info (s)))
+	{
+	case FFEINFO_whereLOCAL:
+	  assert (!ffecom_transform_only_dummies_);
+	  break;
+
+	case FFEINFO_whereNONE:
+	case FFEINFO_whereCOMMON:
+	case FFEINFO_whereDUMMY:
+	case FFEINFO_whereGLOBAL:
+	case FFEINFO_whereRESULT:
+	case FFEINFO_whereFLEETING:
+	case FFEINFO_whereFLEETING_CADDR:
+	case FFEINFO_whereFLEETING_IADDR:
+	case FFEINFO_whereIMMEDIATE:
+	case FFEINFO_whereINTRINSIC:
+	case FFEINFO_whereCONSTANT:
+	case FFEINFO_whereCONSTANT_SUBOBJECT:
+	default:
+	  assert ("CONSTRUCT where unheard of" == NULL);
+	  /* Fall through. */
+	case FFEINFO_whereANY:
+	  t = error_mark_node;
+	  break;
+	}
+      break;
+
+    case FFEINFO_kindNAMELIST:
+      switch (ffeinfo_where (ffesymbol_info (s)))
+	{
+	case FFEINFO_whereLOCAL:
+	  assert (!ffecom_transform_only_dummies_);
+	  t = ffecom_transform_namelist_ (s);
+	  break;
+
+	case FFEINFO_whereNONE:
+	case FFEINFO_whereCOMMON:
+	case FFEINFO_whereDUMMY:
+	case FFEINFO_whereGLOBAL:
+	case FFEINFO_whereRESULT:
+	case FFEINFO_whereFLEETING:
+	case FFEINFO_whereFLEETING_CADDR:
+	case FFEINFO_whereFLEETING_IADDR:
+	case FFEINFO_whereIMMEDIATE:
+	case FFEINFO_whereINTRINSIC:
+	case FFEINFO_whereCONSTANT:
+	case FFEINFO_whereCONSTANT_SUBOBJECT:
+	default:
+	  assert ("NAMELIST where unheard of" == NULL);
+	  /* Fall through. */
+	case FFEINFO_whereANY:
+	  t = error_mark_node;
+	  break;
+	}
+      break;
+
+    default:
+      assert ("kind unheard of" == NULL);
+      /* Fall through. */
+    case FFEINFO_kindANY:
+      t = error_mark_node;
+      break;
+    }
+
+  ffesymbol_hook (s).decl_tree = t;
+  ffesymbol_hook (s).length_tree = tlen;
+  ffesymbol_hook (s).addr = addr;
+
+  input_location = old_loc;
+
+  return s;
+}
+
+/* Transform into ASSIGNable symbol.
+
+   Symbol has already been transformed, but for whatever reason, the
+   resulting decl_tree has been deemed not usable for an ASSIGN target.
+   (E.g. it isn't wide enough to hold a pointer.)  So, here we invent
+   another local symbol of type void * and stuff that in the assign_tree
+   argument.  The F77/F90 standards allow this implementation.  */
+
+static ffesymbol
+ffecom_sym_transform_assign_ (ffesymbol s)
+{
+  tree t;			/* Transformed thingy. */
+  location_t old_loc = input_location;
+
+  if (ffesymbol_sfdummyparent (s) == NULL)
+    {
+      input_filename = ffesymbol_where_filename (s);
+      input_line = ffesymbol_where_filelinenum (s);
+    }
+  else
+    {
+      ffesymbol sf = ffesymbol_sfdummyparent (s);
+
+      input_filename = ffesymbol_where_filename (sf);
+      input_line = ffesymbol_where_filelinenum (sf);
+    }
+
+  assert (!ffecom_transform_only_dummies_);
+
+  t = build_decl (VAR_DECL,
+		  ffecom_get_invented_identifier ("__g77_ASSIGN_%s",
+						   ffesymbol_text (s)),
+		  TREE_TYPE (null_pointer_node));
+
+  switch (ffesymbol_where (s))
+    {
+    case FFEINFO_whereLOCAL:
+      /* Unlike for regular vars, SAVE status is easy to determine for
+	 ASSIGNed vars, since there's no initialization, there's no
+	 effective storage association (so "SAVE J" does not apply to
+	 K even given "EQUIVALENCE (J,K)"), there's no size issue
+	 to worry about, etc.  */
+      if ((ffesymbol_is_save (s) || ffe_is_saveall ())
+	  && (ffecom_primary_entry_kind_ != FFEINFO_kindPROGRAM)
+	  && (ffecom_primary_entry_kind_ != FFEINFO_kindBLOCKDATA))
+	TREE_STATIC (t) = 1;	/* SAVEd in proc, make static. */
+      else
+	TREE_STATIC (t) = 0;	/* No need to make static. */
+      break;
+
+    case FFEINFO_whereCOMMON:
+      TREE_STATIC (t) = 1;	/* Assume COMMONs always SAVEd. */
+      break;
+
+    case FFEINFO_whereDUMMY:
+      /* Note that twinning a DUMMY means the caller won't see
+	 the ASSIGNed value.  But both F77 and F90 allow implementations
+	 to do this, i.e. disallow Fortran code that would try and
+	 take advantage of actually putting a label into a variable
+	 via a dummy argument (or any other storage association, for
+	 that matter).  */
+      TREE_STATIC (t) = 0;
+      break;
+
+    default:
+      TREE_STATIC (t) = 0;
+      break;
+    }
+
+  t = start_decl (t, FALSE);
+  finish_decl (t, NULL_TREE, FALSE);
+
+  ffesymbol_hook (s).assign_tree = t;
+
+  input_location = old_loc;
+
+  return s;
+}
+
+/* Implement COMMON area in back end.
+
+   Because COMMON-based variables can be referenced in the dimension
+   expressions of dummy (adjustable) arrays, and because dummies
+   (in the gcc back end) need to be put in the outer binding level
+   of a function (which has two binding levels, the outer holding
+   the dummies and the inner holding the other vars), special care
+   must be taken to handle COMMON areas.
+
+   The current strategy is basically to always tell the back end about
+   the COMMON area as a top-level external reference to just a block
+   of storage of the master type of that area (e.g. integer, real,
+   character, whatever -- not a structure).  As a distinct action,
+   if initial values are provided, tell the back end about the area
+   as a top-level non-external (initialized) area and remember not to
+   allow further initialization or expansion of the area.  Meanwhile,
+   if no initialization happens at all, tell the back end about
+   the largest size we've seen declared so the space does get reserved.
+   (This function doesn't handle all that stuff, but it does some
+   of the important things.)
+
+   Meanwhile, for COMMON variables themselves, just keep creating
+   references like *((float *) (&common_area + offset)) each time
+   we reference the variable.  In other words, don't make a VAR_DECL
+   or any kind of component reference (like we used to do before 0.4),
+   though we might do that as well just for debugging purposes (and
+   stuff the rtl with the appropriate offset expression).  */
+
+static void
+ffecom_transform_common_ (ffesymbol s)
+{
+  ffestorag st = ffesymbol_storage (s);
+  ffeglobal g = ffesymbol_global (s);
+  tree cbt;
+  tree cbtype;
+  tree init;
+  tree high;
+  bool is_init = ffestorag_is_init (st);
+
+  assert (st != NULL);
+
+  if ((g == NULL)
+      || (ffeglobal_type (g) != FFEGLOBAL_typeCOMMON))
+    return;
+
+  /* First update the size of the area in global terms.  */
+
+  ffeglobal_size_common (s, ffestorag_size (st));
+
+  if (!ffeglobal_common_init (g))
+    is_init = FALSE;	/* No explicit init, don't let erroneous joins init. */
+
+  cbt = ffeglobal_hook (g);
+
+  /* If we already have declared this common block for a previous program
+     unit, and either we already initialized it or we don't have new
+     initialization for it, just return what we have without changing it.  */
+
+  if ((cbt != NULL_TREE)
+      && (!is_init
+	  || !DECL_EXTERNAL (cbt)))
+    {
+      if (st->hook == NULL) ffestorag_set_hook (st, cbt);
+      return;
+    }
+
+  /* Process inits.  */
+
+  if (is_init)
+    {
+      if (ffestorag_init (st) != NULL)
+	{
+	  ffebld sexp;
+
+	  /* Set the padding for the expression, so ffecom_expr
+	     knows to insert that many zeros.  */
+	  switch (ffebld_op (sexp = ffestorag_init (st)))
+	    {
+	    case FFEBLD_opCONTER:
+	      ffebld_conter_set_pad (sexp, ffestorag_modulo (st));
+	      break;
+
+	    case FFEBLD_opARRTER:
+	      ffebld_arrter_set_pad (sexp, ffestorag_modulo (st));
+	      break;
+
+	    case FFEBLD_opACCTER:
+	      ffebld_accter_set_pad (sexp, ffestorag_modulo (st));
+	      break;
+
+	    default:
+	      assert ("bad op for cmn init (pad)" == NULL);
+	      break;
+	    }
+
+	  init = ffecom_expr (sexp);
+	  if (init == error_mark_node)
+	    {			/* Hopefully the back end complained! */
+	      init = NULL_TREE;
+	      if (cbt != NULL_TREE)
+		return;
+	    }
+	}
+      else
+	init = error_mark_node;
+    }
+  else
+    init = NULL_TREE;
+
+  /* cbtype must be permanently allocated!  */
+
+  /* Allocate the MAX of the areas so far, seen filewide.  */
+  high = build_int_2 ((ffeglobal_common_size (g)
+		       + ffeglobal_common_pad (g)) - 1, 0);
+  TREE_TYPE (high) = ffecom_integer_type_node;
+
+  if (init)
+    cbtype = build_array_type (char_type_node,
+			       build_range_type (integer_type_node,
+						 integer_zero_node,
+						 high));
+  else
+    cbtype = build_array_type (char_type_node, NULL_TREE);
+
+  if (cbt == NULL_TREE)
+    {
+      cbt
+	= build_decl (VAR_DECL,
+		      ffecom_get_external_identifier_ (s),
+		      cbtype);
+      TREE_STATIC (cbt) = 1;
+      TREE_PUBLIC (cbt) = 1;
+    }
+  else
+    {
+      assert (is_init);
+      TREE_TYPE (cbt) = cbtype;
+    }
+  DECL_EXTERNAL (cbt) = init ? 0 : 1;
+  DECL_INITIAL (cbt) = init ? error_mark_node : NULL_TREE;
+
+  cbt = start_decl (cbt, TRUE);
+  if (ffeglobal_hook (g) != NULL)
+    assert (cbt == ffeglobal_hook (g));
+
+  assert (!init || !DECL_EXTERNAL (cbt));
+
+  /* Make sure that any type can live in COMMON and be referenced
+     without getting a bus error.  We could pick the most restrictive
+     alignment of all entities actually placed in the COMMON, but
+     this seems easy enough.  */
+
+  DECL_ALIGN (cbt) = BIGGEST_ALIGNMENT;
+  DECL_USER_ALIGN (cbt) = 0;
+
+  if (is_init && (ffestorag_init (st) == NULL))
+    init = ffecom_init_zero_ (cbt);
+
+  finish_decl (cbt, init, TRUE);
+
+  if (is_init)
+    ffestorag_set_init (st, ffebld_new_any ());
+
+  if (init)
+    {
+      assert (DECL_SIZE_UNIT (cbt) != NULL_TREE);
+      assert (TREE_CODE (DECL_SIZE_UNIT (cbt)) == INTEGER_CST);
+      assert (0 == compare_tree_int (DECL_SIZE_UNIT (cbt),
+				     (ffeglobal_common_size (g)
+				      + ffeglobal_common_pad (g))));
+    }
+
+  ffeglobal_set_hook (g, cbt);
+
+  ffestorag_set_hook (st, cbt);
+
+  ffecom_save_tree_forever (cbt);
+}
+
+/* Make master area for local EQUIVALENCE.  */
+
+static void
+ffecom_transform_equiv_ (ffestorag eqst)
+{
+  tree eqt;
+  tree eqtype;
+  tree init;
+  tree high;
+  bool is_init = ffestorag_is_init (eqst);
+
+  assert (eqst != NULL);
+
+  eqt = ffestorag_hook (eqst);
+
+  if (eqt != NULL_TREE)
+    return;
+
+  /* Process inits.  */
+
+  if (is_init)
+    {
+      if (ffestorag_init (eqst) != NULL)
+	{
+	  ffebld sexp;
+
+	  /* Set the padding for the expression, so ffecom_expr
+	     knows to insert that many zeros.  */
+	  switch (ffebld_op (sexp = ffestorag_init (eqst)))
+	    {
+	    case FFEBLD_opCONTER:
+	      ffebld_conter_set_pad (sexp, ffestorag_modulo (eqst));
+	      break;
+
+	    case FFEBLD_opARRTER:
+	      ffebld_arrter_set_pad (sexp, ffestorag_modulo (eqst));
+	      break;
+
+	    case FFEBLD_opACCTER:
+	      ffebld_accter_set_pad (sexp, ffestorag_modulo (eqst));
+	      break;
+
+	    default:
+	      assert ("bad op for eqv init (pad)" == NULL);
+	      break;
+	    }
+
+	  init = ffecom_expr (sexp);
+	  if (init == error_mark_node)
+	    init = NULL_TREE;	/* Hopefully the back end complained! */
+	}
+      else
+	init = error_mark_node;
+    }
+  else if (ffe_is_init_local_zero ())
+    init = error_mark_node;
+  else
+    init = NULL_TREE;
+
+  ffecom_member_namelisted_ = FALSE;
+  ffestorag_drive (ffestorag_list_equivs (eqst),
+		   &ffecom_member_phase1_,
+		   eqst);
+
+  high = build_int_2 ((ffestorag_size (eqst)
+		       + ffestorag_modulo (eqst)) - 1, 0);
+  TREE_TYPE (high) = ffecom_integer_type_node;
+
+  eqtype = build_array_type (char_type_node,
+			     build_range_type (ffecom_integer_type_node,
+					       ffecom_integer_zero_node,
+					       high));
+
+  eqt = build_decl (VAR_DECL,
+		    ffecom_get_invented_identifier ("__g77_equiv_%s",
+						    ffesymbol_text
+						    (ffestorag_symbol (eqst))),
+		    eqtype);
+  DECL_EXTERNAL (eqt) = 0;
+  if (is_init
+      || ffecom_member_namelisted_
+#ifdef FFECOM_sizeMAXSTACKITEM
+      || (ffestorag_size (eqst) > FFECOM_sizeMAXSTACKITEM)
+#endif
+      || ((ffecom_primary_entry_kind_ != FFEINFO_kindPROGRAM)
+	  && (ffecom_primary_entry_kind_ != FFEINFO_kindBLOCKDATA)
+	  && (ffestorag_is_save (eqst) || ffe_is_saveall ())))
+    TREE_STATIC (eqt) = 1;
+  else
+    TREE_STATIC (eqt) = 0;
+  TREE_PUBLIC (eqt) = 0;
+  TREE_ADDRESSABLE (eqt) = 1;  /* Ensure non-register allocation */
+  DECL_CONTEXT (eqt) = current_function_decl;
+  if (init)
+    DECL_INITIAL (eqt) = error_mark_node;
+  else
+    DECL_INITIAL (eqt) = NULL_TREE;
+
+  eqt = start_decl (eqt, FALSE);
+
+  /* Make sure that any type can live in EQUIVALENCE and be referenced
+     without getting a bus error.  We could pick the most restrictive
+     alignment of all entities actually placed in the EQUIVALENCE, but
+     this seems easy enough.  */
+
+  DECL_ALIGN (eqt) = BIGGEST_ALIGNMENT;
+  DECL_USER_ALIGN (eqt) = 0;
+
+  if ((!is_init && ffe_is_init_local_zero ())
+      || (is_init && (ffestorag_init (eqst) == NULL)))
+    init = ffecom_init_zero_ (eqt);
+
+  finish_decl (eqt, init, FALSE);
+
+  if (is_init)
+    ffestorag_set_init (eqst, ffebld_new_any ());
+
+  {
+    assert (TREE_CODE (DECL_SIZE_UNIT (eqt)) == INTEGER_CST);
+    assert (0 == compare_tree_int (DECL_SIZE_UNIT (eqt),
+				   (ffestorag_size (eqst)
+				    + ffestorag_modulo (eqst))));
+  }
+
+  ffestorag_set_hook (eqst, eqt);
+
+  ffestorag_drive (ffestorag_list_equivs (eqst),
+		   &ffecom_member_phase2_,
+		   eqst);
+}
+
+/* Implement NAMELIST in back end.  See f2c/format.c for more info.  */
+
+static tree
+ffecom_transform_namelist_ (ffesymbol s)
+{
+  tree nmlt;
+  tree nmltype = ffecom_type_namelist_ ();
+  tree nmlinits;
+  tree nameinit;
+  tree varsinit;
+  tree nvarsinit;
+  tree field;
+  tree high;
+  int i;
+  static int mynumber = 0;
+
+  nmlt = build_decl (VAR_DECL,
+		     ffecom_get_invented_identifier ("__g77_namelist_%d",
+						     mynumber++),
+		     nmltype);
+  TREE_STATIC (nmlt) = 1;
+  DECL_INITIAL (nmlt) = error_mark_node;
+
+  nmlt = start_decl (nmlt, FALSE);
+
+  /* Process inits.  */
+
+  i = strlen (ffesymbol_text (s));
+
+  high = build_int_2 (i, 0);
+  TREE_TYPE (high) = ffecom_f2c_ftnlen_type_node;
+
+  nameinit = ffecom_build_f2c_string_ (i + 1,
+				       ffesymbol_text (s));
+  TREE_TYPE (nameinit)
+    = build_type_variant
+    (build_array_type
+     (char_type_node,
+      build_range_type (ffecom_f2c_ftnlen_type_node,
+			ffecom_f2c_ftnlen_one_node,
+			high)),
+     1, 0);
+  TREE_CONSTANT (nameinit) = 1;
+  TREE_STATIC (nameinit) = 1;
+  nameinit = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (nameinit)),
+		       nameinit);
+
+  varsinit = ffecom_vardesc_array_ (s);
+  varsinit = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (varsinit)),
+		       varsinit);
+  TREE_CONSTANT (varsinit) = 1;
+  TREE_STATIC (varsinit) = 1;
+
+  {
+    ffebld b;
+
+    for (i = 0, b = ffesymbol_namelist (s); b != NULL; b = ffebld_trail (b))
+      ++i;
+  }
+  nvarsinit = build_int_2 (i, 0);
+  TREE_TYPE (nvarsinit) = integer_type_node;
+  TREE_CONSTANT (nvarsinit) = 1;
+  TREE_STATIC (nvarsinit) = 1;
+
+  nmlinits = build_tree_list ((field = TYPE_FIELDS (nmltype)), nameinit);
+  TREE_CHAIN (nmlinits) = build_tree_list ((field = TREE_CHAIN (field)),
+					   varsinit);
+  TREE_CHAIN (TREE_CHAIN (nmlinits))
+    = build_tree_list ((field = TREE_CHAIN (field)), nvarsinit);
+
+  nmlinits = build_constructor (nmltype, nmlinits);
+  TREE_CONSTANT (nmlinits) = 1;
+  TREE_STATIC (nmlinits) = 1;
+
+  finish_decl (nmlt, nmlinits, FALSE);
+
+  nmlt = ffecom_1 (ADDR_EXPR, build_pointer_type (nmltype), nmlt);
+
+  return nmlt;
+}
+
+/* A subroutine of ffecom_tree_canonize_ref_.  The incoming tree is
+   analyzed on the assumption it is calculating a pointer to be
+   indirected through.  It must return the proper decl and offset,
+   taking into account different units of measurements for offsets.  */
+
+static void
+ffecom_tree_canonize_ptr_ (tree *decl, tree *offset, tree t)
+{
+  switch (TREE_CODE (t))
+    {
+    case NOP_EXPR:
+    case CONVERT_EXPR:
+    case NON_LVALUE_EXPR:
+      ffecom_tree_canonize_ptr_ (decl, offset, TREE_OPERAND (t, 0));
+      break;
+
+    case PLUS_EXPR:
+      ffecom_tree_canonize_ptr_ (decl, offset, TREE_OPERAND (t, 0));
+      if ((*decl == NULL_TREE)
+	  || (*decl == error_mark_node))
+	break;
+
+      if (TREE_CODE (TREE_OPERAND (t, 1)) == INTEGER_CST)
+	{
+	  /* An offset into COMMON.  */
+	  *offset = fold (build (PLUS_EXPR, TREE_TYPE (*offset),
+				 *offset, TREE_OPERAND (t, 1)));
+	  /* Convert offset (presumably in bytes) into canonical units
+	     (presumably bits).  */
+	  *offset = size_binop (MULT_EXPR,
+				convert (bitsizetype, *offset),
+				TYPE_SIZE (TREE_TYPE (TREE_TYPE (t))));
+	  break;
+	}
+      /* Not a COMMON reference, so an unrecognized pattern.  */
+      *decl = error_mark_node;
+      break;
+
+    case PARM_DECL:
+      *decl = t;
+      *offset = bitsize_zero_node;
+      break;
+
+    case ADDR_EXPR:
+      if (TREE_CODE (TREE_OPERAND (t, 0)) == VAR_DECL)
+	{
+	  /* A reference to COMMON.  */
+	  *decl = TREE_OPERAND (t, 0);
+	  *offset = bitsize_zero_node;
+	  break;
+	}
+      /* Fall through.  */
+    default:
+      /* Not a COMMON reference, so an unrecognized pattern.  */
+      *decl = error_mark_node;
+      break;
+    }
+}
+
+/* Given a tree that is possibly intended for use as an lvalue, return
+   information representing a canonical view of that tree as a decl, an
+   offset into that decl, and a size for the lvalue.
+
+   If there's no applicable decl, NULL_TREE is returned for the decl,
+   and the other fields are left undefined.
+
+   If the tree doesn't fit the recognizable forms, an ERROR_MARK node
+   is returned for the decl, and the other fields are left undefined.
+
+   Otherwise, the decl returned currently is either a VAR_DECL or a
+   PARM_DECL.
+
+   The offset returned is always valid, but of course not necessarily
+   a constant, and not necessarily converted into the appropriate
+   type, leaving that up to the caller (so as to avoid that overhead
+   if the decls being looked at are different anyway).
+
+   If the size cannot be determined (e.g. an adjustable array),
+   an ERROR_MARK node is returned for the size.  Otherwise, the
+   size returned is valid, not necessarily a constant, and not
+   necessarily converted into the appropriate type as with the
+   offset.
+
+   Note that the offset and size expressions are expressed in the
+   base storage units (usually bits) rather than in the units of
+   the type of the decl, because two decls with different types
+   might overlap but with apparently non-overlapping array offsets,
+   whereas converting the array offsets to consistant offsets will
+   reveal the overlap.  */
+
+static void
+ffecom_tree_canonize_ref_ (tree *decl, tree *offset, tree *size, tree t)
+{
+  /* The default path is to report a nonexistant decl.  */
+  *decl = NULL_TREE;
+
+  if (t == NULL_TREE)
+    return;
+
+  switch (TREE_CODE (t))
+    {
+    case ERROR_MARK:
+    case IDENTIFIER_NODE:
+    case INTEGER_CST:
+    case REAL_CST:
+    case COMPLEX_CST:
+    case STRING_CST:
+    case CONST_DECL:
+    case PLUS_EXPR:
+    case MINUS_EXPR:
+    case MULT_EXPR:
+    case TRUNC_DIV_EXPR:
+    case CEIL_DIV_EXPR:
+    case FLOOR_DIV_EXPR:
+    case ROUND_DIV_EXPR:
+    case TRUNC_MOD_EXPR:
+    case CEIL_MOD_EXPR:
+    case FLOOR_MOD_EXPR:
+    case ROUND_MOD_EXPR:
+    case RDIV_EXPR:
+    case EXACT_DIV_EXPR:
+    case FIX_TRUNC_EXPR:
+    case FIX_CEIL_EXPR:
+    case FIX_FLOOR_EXPR:
+    case FIX_ROUND_EXPR:
+    case FLOAT_EXPR:
+    case NEGATE_EXPR:
+    case MIN_EXPR:
+    case MAX_EXPR:
+    case ABS_EXPR:
+    case LSHIFT_EXPR:
+    case RSHIFT_EXPR:
+    case LROTATE_EXPR:
+    case RROTATE_EXPR:
+    case BIT_IOR_EXPR:
+    case BIT_XOR_EXPR:
+    case BIT_AND_EXPR:
+    case BIT_NOT_EXPR:
+    case TRUTH_ANDIF_EXPR:
+    case TRUTH_ORIF_EXPR:
+    case TRUTH_AND_EXPR:
+    case TRUTH_OR_EXPR:
+    case TRUTH_XOR_EXPR:
+    case TRUTH_NOT_EXPR:
+    case LT_EXPR:
+    case LE_EXPR:
+    case GT_EXPR:
+    case GE_EXPR:
+    case EQ_EXPR:
+    case NE_EXPR:
+    case COMPLEX_EXPR:
+    case CONJ_EXPR:
+    case REALPART_EXPR:
+    case IMAGPART_EXPR:
+    case LABEL_EXPR:
+    case COMPONENT_REF:
+    case COMPOUND_EXPR:
+    case ADDR_EXPR:
+      return;
+
+    case VAR_DECL:
+    case PARM_DECL:
+      *decl = t;
+      *offset = bitsize_zero_node;
+      *size = TYPE_SIZE (TREE_TYPE (t));
+      return;
+
+    case ARRAY_REF:
+      {
+	tree array = TREE_OPERAND (t, 0);
+	tree element = TREE_OPERAND (t, 1);
+	tree init_offset;
+
+	if ((array == NULL_TREE)
+	    || (element == NULL_TREE))
+	  {
+	    *decl = error_mark_node;
+	    return;
+	  }
+
+	ffecom_tree_canonize_ref_ (decl, &init_offset, size,
+				   array);
+	if ((*decl == NULL_TREE)
+	    || (*decl == error_mark_node))
+	  return;
+
+	/* Calculate ((element - base) * NBBY) + init_offset.  */
+	*offset = fold (build (MINUS_EXPR, TREE_TYPE (element),
+			       element,
+			       TYPE_MIN_VALUE (TYPE_DOMAIN
+					       (TREE_TYPE (array)))));
+
+	*offset = size_binop (MULT_EXPR,
+			      convert (bitsizetype, *offset),
+			      TYPE_SIZE (TREE_TYPE (TREE_TYPE (array))));
+
+	*offset = size_binop (PLUS_EXPR, init_offset, *offset);
+
+	*size = TYPE_SIZE (TREE_TYPE (t));
+	return;
+      }
+
+    case INDIRECT_REF:
+
+      /* Most of this code is to handle references to COMMON.  And so
+	 far that is useful only for calling library functions, since
+	 external (user) functions might reference common areas.  But
+	 even calling an external function, it's worthwhile to decode
+	 COMMON references because if not storing into COMMON, we don't
+	 want COMMON-based arguments to gratuitously force use of a
+	 temporary.  */
+
+      *size = TYPE_SIZE (TREE_TYPE (t));
+
+      ffecom_tree_canonize_ptr_ (decl, offset,
+				 TREE_OPERAND (t, 0));
+
+      return;
+
+    case CONVERT_EXPR:
+    case NOP_EXPR:
+    case MODIFY_EXPR:
+    case NON_LVALUE_EXPR:
+    case RESULT_DECL:
+    case FIELD_DECL:
+    case COND_EXPR:		/* More cases than we can handle. */
+    case SAVE_EXPR:
+    case REFERENCE_EXPR:
+    case PREDECREMENT_EXPR:
+    case PREINCREMENT_EXPR:
+    case POSTDECREMENT_EXPR:
+    case POSTINCREMENT_EXPR:
+    case CALL_EXPR:
+    default:
+      *decl = error_mark_node;
+      return;
+    }
+}
+
+/* Do divide operation appropriate to type of operands.  */
+
+static tree
+ffecom_tree_divide_ (tree tree_type, tree left, tree right, tree dest_tree,
+		     ffebld dest, bool *dest_used, tree hook)
+{
+  if ((left == error_mark_node)
+      || (right == error_mark_node))
+    return error_mark_node;
+
+  switch (TREE_CODE (tree_type))
+    {
+    case INTEGER_TYPE:
+      return ffecom_2 (TRUNC_DIV_EXPR, tree_type,
+		       left,
+		       right);
+
+    case COMPLEX_TYPE:
+      if (! optimize_size)
+	return ffecom_2 (RDIV_EXPR, tree_type,
+			 left,
+			 right);
+      {
+	ffecomGfrt ix;
+
+	if (TREE_TYPE (tree_type)
+	    == ffecom_tree_type [FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1])
+	  ix = FFECOM_gfrtDIV_CC;	/* Overlapping result okay. */
+	else
+	  ix = FFECOM_gfrtDIV_ZZ;	/* Overlapping result okay. */
+
+	left = ffecom_1 (ADDR_EXPR,
+			 build_pointer_type (TREE_TYPE (left)),
+			 left);
+	left = build_tree_list (NULL_TREE, left);
+	right = ffecom_1 (ADDR_EXPR,
+			  build_pointer_type (TREE_TYPE (right)),
+			  right);
+	right = build_tree_list (NULL_TREE, right);
+	TREE_CHAIN (left) = right;
+
+	return ffecom_call_ (ffecom_gfrt_tree_ (ix),
+			     ffecom_gfrt_kindtype (ix),
+			     ffe_is_f2c_library (),
+			     tree_type,
+			     left,
+			     dest_tree, dest, dest_used,
+			     NULL_TREE, TRUE, hook);
+      }
+      break;
+
+    case RECORD_TYPE:
+      {
+	ffecomGfrt ix;
+
+	if (TREE_TYPE (TYPE_FIELDS (tree_type))
+	    == ffecom_tree_type [FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1])
+	  ix = FFECOM_gfrtDIV_CC;	/* Overlapping result okay. */
+	else
+	  ix = FFECOM_gfrtDIV_ZZ;	/* Overlapping result okay. */
+
+	left = ffecom_1 (ADDR_EXPR,
+			 build_pointer_type (TREE_TYPE (left)),
+			 left);
+	left = build_tree_list (NULL_TREE, left);
+	right = ffecom_1 (ADDR_EXPR,
+			  build_pointer_type (TREE_TYPE (right)),
+			  right);
+	right = build_tree_list (NULL_TREE, right);
+	TREE_CHAIN (left) = right;
+
+	return ffecom_call_ (ffecom_gfrt_tree_ (ix),
+			     ffecom_gfrt_kindtype (ix),
+			     ffe_is_f2c_library (),
+			     tree_type,
+			     left,
+			     dest_tree, dest, dest_used,
+			     NULL_TREE, TRUE, hook);
+      }
+      break;
+
+    default:
+      return ffecom_2 (RDIV_EXPR, tree_type,
+		       left,
+		       right);
+    }
+}
+
+/* Build type info for non-dummy variable.  */
+
+static tree
+ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt)
+{
+  tree type;
+  ffebld dl;
+  ffebld dim;
+  tree lowt;
+  tree hight;
+
+  type = ffecom_tree_type[bt][kt];
+  if (bt == FFEINFO_basictypeCHARACTER)
+    {
+      hight = build_int_2 (ffesymbol_size (s), 0);
+      TREE_TYPE (hight) = ffecom_f2c_ftnlen_type_node;
+
+      type
+	= build_array_type
+	  (type,
+	   build_range_type (ffecom_f2c_ftnlen_type_node,
+			     ffecom_f2c_ftnlen_one_node,
+			     hight));
+      type = ffecom_check_size_overflow_ (s, type, FALSE);
+    }
+
+  for (dl = ffesymbol_dims (s); dl != NULL; dl = ffebld_trail (dl))
+    {
+      if (type == error_mark_node)
+	break;
+
+      dim = ffebld_head (dl);
+      assert (ffebld_op (dim) == FFEBLD_opBOUNDS);
+
+      if (ffebld_left (dim) == NULL)
+	lowt = integer_one_node;
+      else
+	lowt = ffecom_expr (ffebld_left (dim));
+
+      if (TREE_CODE (lowt) != INTEGER_CST)
+	lowt = variable_size (lowt);
+
+      assert (ffebld_right (dim) != NULL);
+      hight = ffecom_expr (ffebld_right (dim));
+
+      if (TREE_CODE (hight) != INTEGER_CST)
+	hight = variable_size (hight);
+
+      type = build_array_type (type,
+			       build_range_type (ffecom_integer_type_node,
+						 lowt, hight));
+      type = ffecom_check_size_overflow_ (s, type, FALSE);
+    }
+
+  return type;
+}
+
+/* Build Namelist type.  */
+
+static GTY(()) tree ffecom_type_namelist_var;
+static tree
+ffecom_type_namelist_ (void)
+{
+  if (ffecom_type_namelist_var == NULL_TREE)
+    {
+      tree namefield, varsfield, nvarsfield, vardesctype, type;
+
+      vardesctype = ffecom_type_vardesc_ ();
+
+      type = make_node (RECORD_TYPE);
+
+      vardesctype = build_pointer_type (build_pointer_type (vardesctype));
+
+      namefield = ffecom_decl_field (type, NULL_TREE, "name",
+				     string_type_node);
+      varsfield = ffecom_decl_field (type, namefield, "vars", vardesctype);
+      nvarsfield = ffecom_decl_field (type, varsfield, "nvars",
+				      integer_type_node);
+
+      TYPE_FIELDS (type) = namefield;
+      layout_type (type);
+
+      ffecom_type_namelist_var = type;
+    }
+
+  return ffecom_type_namelist_var;
+}
+
+/* Build Vardesc type.  */
+
+static GTY(()) tree ffecom_type_vardesc_var;
+static tree
+ffecom_type_vardesc_ (void)
+{
+  if (ffecom_type_vardesc_var == NULL_TREE)
+    {
+      tree namefield, addrfield, dimsfield, typefield, type;
+      type = make_node (RECORD_TYPE);
+
+      namefield = ffecom_decl_field (type, NULL_TREE, "name",
+				     string_type_node);
+      addrfield = ffecom_decl_field (type, namefield, "addr",
+				     string_type_node);
+      dimsfield = ffecom_decl_field (type, addrfield, "dims",
+				     ffecom_f2c_ptr_to_ftnlen_type_node);
+      typefield = ffecom_decl_field (type, dimsfield, "type",
+				     integer_type_node);
+
+      TYPE_FIELDS (type) = namefield;
+      layout_type (type);
+
+      ffecom_type_vardesc_var = type;
+    }
+
+  return ffecom_type_vardesc_var;
+}
+
+static tree
+ffecom_vardesc_ (ffebld expr)
+{
+  ffesymbol s;
+
+  assert (ffebld_op (expr) == FFEBLD_opSYMTER);
+  s = ffebld_symter (expr);
+
+  if (ffesymbol_hook (s).vardesc_tree == NULL_TREE)
+    {
+      int i;
+      tree vardesctype = ffecom_type_vardesc_ ();
+      tree var;
+      tree nameinit;
+      tree dimsinit;
+      tree addrinit;
+      tree typeinit;
+      tree field;
+      tree varinits;
+      static int mynumber = 0;
+
+      var = build_decl (VAR_DECL,
+			ffecom_get_invented_identifier ("__g77_vardesc_%d",
+							mynumber++),
+			vardesctype);
+      TREE_STATIC (var) = 1;
+      DECL_INITIAL (var) = error_mark_node;
+
+      var = start_decl (var, FALSE);
+
+      /* Process inits.  */
+
+      nameinit = ffecom_build_f2c_string_ ((i = strlen (ffesymbol_text (s)))
+					   + 1,
+					   ffesymbol_text (s));
+      TREE_TYPE (nameinit)
+	= build_type_variant
+	(build_array_type
+	 (char_type_node,
+	  build_range_type (integer_type_node,
+			    integer_one_node,
+			    build_int_2 (i, 0))),
+	 1, 0);
+      TREE_CONSTANT (nameinit) = 1;
+      TREE_STATIC (nameinit) = 1;
+      nameinit = ffecom_1 (ADDR_EXPR,
+			   build_pointer_type (TREE_TYPE (nameinit)),
+			   nameinit);
+
+      addrinit = ffecom_arg_ptr_to_expr (expr, &typeinit);
+
+      dimsinit = ffecom_vardesc_dims_ (s);
+
+      if (typeinit == NULL_TREE)
+	{
+	  ffeinfoBasictype bt = ffesymbol_basictype (s);
+	  ffeinfoKindtype kt = ffesymbol_kindtype (s);
+	  int tc = ffecom_f2c_typecode (bt, kt);
+
+	  assert (tc != -1);
+	  typeinit = build_int_2 (tc, (tc < 0) ? -1 : 0);
+	}
+      else
+	typeinit = ffecom_1 (NEGATE_EXPR, TREE_TYPE (typeinit), typeinit);
+
+      varinits = build_tree_list ((field = TYPE_FIELDS (vardesctype)),
+				  nameinit);
+      TREE_CHAIN (varinits) = build_tree_list ((field = TREE_CHAIN (field)),
+					       addrinit);
+      TREE_CHAIN (TREE_CHAIN (varinits))
+	= build_tree_list ((field = TREE_CHAIN (field)), dimsinit);
+      TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (varinits)))
+	= build_tree_list ((field = TREE_CHAIN (field)), typeinit);
+
+      varinits = build_constructor (vardesctype, varinits);
+      TREE_CONSTANT (varinits) = 1;
+      TREE_STATIC (varinits) = 1;
+
+      finish_decl (var, varinits, FALSE);
+
+      var = ffecom_1 (ADDR_EXPR, build_pointer_type (vardesctype), var);
+
+      ffesymbol_hook (s).vardesc_tree = var;
+    }
+
+  return ffesymbol_hook (s).vardesc_tree;
+}
+
+static tree
+ffecom_vardesc_array_ (ffesymbol s)
+{
+  ffebld b;
+  tree list;
+  tree item = NULL_TREE;
+  tree var;
+  int i;
+  static int mynumber = 0;
+
+  for (i = 0, list = NULL_TREE, b = ffesymbol_namelist (s);
+       b != NULL;
+       b = ffebld_trail (b), ++i)
+    {
+      tree t;
+
+      t = ffecom_vardesc_ (ffebld_head (b));
+
+      if (list == NULL_TREE)
+	list = item = build_tree_list (NULL_TREE, t);
+      else
+	{
+	  TREE_CHAIN (item) = build_tree_list (NULL_TREE, t);
+	  item = TREE_CHAIN (item);
+	}
+    }
+
+  item = build_array_type (build_pointer_type (ffecom_type_vardesc_ ()),
+			   build_range_type (integer_type_node,
+					     integer_one_node,
+					     build_int_2 (i, 0)));
+  list = build_constructor (item, list);
+  TREE_CONSTANT (list) = 1;
+  TREE_STATIC (list) = 1;
+
+  var = ffecom_get_invented_identifier ("__g77_vardesc_array_%d", mynumber++);
+  var = build_decl (VAR_DECL, var, item);
+  TREE_STATIC (var) = 1;
+  DECL_INITIAL (var) = error_mark_node;
+  var = start_decl (var, FALSE);
+  finish_decl (var, list, FALSE);
+
+  return var;
+}
+
+static tree
+ffecom_vardesc_dims_ (ffesymbol s)
+{
+  if (ffesymbol_dims (s) == NULL)
+    return convert (ffecom_f2c_ptr_to_ftnlen_type_node,
+		    integer_zero_node);
+
+  {
+    ffebld b;
+    ffebld e;
+    tree list;
+    tree backlist;
+    tree item = NULL_TREE;
+    tree var;
+    tree numdim;
+    tree numelem;
+    tree baseoff = NULL_TREE;
+    static int mynumber = 0;
+
+    numdim = build_int_2 ((int) ffesymbol_rank (s), 0);
+    TREE_TYPE (numdim) = ffecom_f2c_ftnlen_type_node;
+
+    numelem = ffecom_expr (ffesymbol_arraysize (s));
+    TREE_TYPE (numelem) = ffecom_f2c_ftnlen_type_node;
+
+    list = NULL_TREE;
+    backlist = NULL_TREE;
+    for (b = ffesymbol_dims (s), e = ffesymbol_extents (s);
+	 b != NULL;
+	 b = ffebld_trail (b), e = ffebld_trail (e))
+      {
+	tree t;
+	tree low;
+	tree back;
+
+	if (ffebld_trail (b) == NULL)
+	  t = NULL_TREE;
+	else
+	  {
+	    t = convert (ffecom_f2c_ftnlen_type_node,
+			 ffecom_expr (ffebld_head (e)));
+
+	    if (list == NULL_TREE)
+	      list = item = build_tree_list (NULL_TREE, t);
+	    else
+	      {
+		TREE_CHAIN (item) = build_tree_list (NULL_TREE, t);
+		item = TREE_CHAIN (item);
+	      }
+	  }
+
+	if (ffebld_left (ffebld_head (b)) == NULL)
+	  low = ffecom_integer_one_node;
+	else
+	  low = ffecom_expr (ffebld_left (ffebld_head (b)));
+	low = convert (ffecom_f2c_ftnlen_type_node, low);
+
+	back = build_tree_list (low, t);
+	TREE_CHAIN (back) = backlist;
+	backlist = back;
+      }
+
+    for (item = backlist; item != NULL_TREE; item = TREE_CHAIN (item))
+      {
+	if (TREE_VALUE (item) == NULL_TREE)
+	  baseoff = TREE_PURPOSE (item);
+	else
+	  baseoff = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
+			      TREE_PURPOSE (item),
+			      ffecom_2 (MULT_EXPR,
+					ffecom_f2c_ftnlen_type_node,
+					TREE_VALUE (item),
+					baseoff));
+      }
+
+    /* backlist now dead, along with all TREE_PURPOSEs on it.  */
+
+    baseoff = build_tree_list (NULL_TREE, baseoff);
+    TREE_CHAIN (baseoff) = list;
+
+    numelem = build_tree_list (NULL_TREE, numelem);
+    TREE_CHAIN (numelem) = baseoff;
+
+    numdim = build_tree_list (NULL_TREE, numdim);
+    TREE_CHAIN (numdim) = numelem;
+
+    item = build_array_type (ffecom_f2c_ftnlen_type_node,
+			     build_range_type (integer_type_node,
+					       integer_zero_node,
+					       build_int_2
+					       ((int) ffesymbol_rank (s)
+						+ 2, 0)));
+    list = build_constructor (item, numdim);
+    TREE_CONSTANT (list) = 1;
+    TREE_STATIC (list) = 1;
+
+    var = ffecom_get_invented_identifier ("__g77_dims_%d", mynumber++);
+    var = build_decl (VAR_DECL, var, item);
+    TREE_STATIC (var) = 1;
+    DECL_INITIAL (var) = error_mark_node;
+    var = start_decl (var, FALSE);
+    finish_decl (var, list, FALSE);
+
+    var = ffecom_1 (ADDR_EXPR, build_pointer_type (item), var);
+
+    return var;
+  }
+}
+
+/* Essentially does a "fold (build1 (code, type, node))" while checking
+   for certain housekeeping things.
+
+   NOTE: for building an ADDR_EXPR around a FUNCTION_DECL, use
+   ffecom_1_fn instead.  */
+
+tree
+ffecom_1 (enum tree_code code, tree type, tree node)
+{
+  tree item;
+
+  if ((node == error_mark_node)
+      || (type == error_mark_node))
+    return error_mark_node;
+
+  if (code == ADDR_EXPR)
+    {
+      if (!ffe_mark_addressable (node))
+	assert ("can't mark_addressable this node!" == NULL);
+    }
+
+  switch (ffe_is_emulate_complex () ? code : NOP_EXPR)
+    {
+      tree realtype;
+
+    case REALPART_EXPR:
+      item = build (COMPONENT_REF, type, node, TYPE_FIELDS (TREE_TYPE (node)));
+      break;
+
+    case IMAGPART_EXPR:
+      item = build (COMPONENT_REF, type, node, TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (node))));
+      break;
+
+
+    case NEGATE_EXPR:
+      if (TREE_CODE (type) != RECORD_TYPE)
+	{
+	  item = build1 (code, type, node);
+	  break;
+	}
+      node = ffecom_stabilize_aggregate_ (node);
+      realtype = TREE_TYPE (TYPE_FIELDS (type));
+      item =
+	ffecom_2 (COMPLEX_EXPR, type,
+		  ffecom_1 (NEGATE_EXPR, realtype,
+			    ffecom_1 (REALPART_EXPR, realtype,
+				      node)),
+		  ffecom_1 (NEGATE_EXPR, realtype,
+			    ffecom_1 (IMAGPART_EXPR, realtype,
+				      node)));
+      break;
+
+    default:
+      item = build1 (code, type, node);
+      break;
+    }
+
+  if (TREE_SIDE_EFFECTS (node))
+    TREE_SIDE_EFFECTS (item) = 1;
+  if (code == ADDR_EXPR && staticp (node))
+    TREE_CONSTANT (item) = 1;
+  else if (code == INDIRECT_REF)
+    TREE_READONLY (item) = TYPE_READONLY (type);
+  return fold (item);
+}
+
+/* Like ffecom_1 (ADDR_EXPR, TREE_TYPE (node), node), except
+   handles TREE_CODE (node) == FUNCTION_DECL.  In particular,
+   does not set TREE_ADDRESSABLE (because calling an inline
+   function does not mean the function needs to be separately
+   compiled).  */
+
+tree
+ffecom_1_fn (tree node)
+{
+  tree item;
+  tree type;
+
+  if (node == error_mark_node)
+    return error_mark_node;
+
+  type = build_type_variant (TREE_TYPE (node),
+			     TREE_READONLY (node),
+			     TREE_THIS_VOLATILE (node));
+  item = build1 (ADDR_EXPR,
+		 build_pointer_type (type), node);
+  if (TREE_SIDE_EFFECTS (node))
+    TREE_SIDE_EFFECTS (item) = 1;
+  if (staticp (node))
+    TREE_CONSTANT (item) = 1;
+  return fold (item);
+}
+
+/* Essentially does a "fold (build (code, type, node1, node2))" while
+   checking for certain housekeeping things.  */
+
+tree
+ffecom_2 (enum tree_code code, tree type, tree node1, tree node2)
+{
+  tree item;
+
+  if ((node1 == error_mark_node)
+      || (node2 == error_mark_node)
+      || (type == error_mark_node))
+    return error_mark_node;
+
+  switch (ffe_is_emulate_complex () ? code : NOP_EXPR)
+    {
+      tree a, b, c, d, realtype;
+
+    case CONJ_EXPR:
+      assert ("no CONJ_EXPR support yet" == NULL);
+      return error_mark_node;
+
+    case COMPLEX_EXPR:
+      item = build_tree_list (TYPE_FIELDS (type), node1);
+      TREE_CHAIN (item) = build_tree_list (TREE_CHAIN (TYPE_FIELDS (type)), node2);
+      item = build_constructor (type, item);
+      break;
+
+    case PLUS_EXPR:
+      if (TREE_CODE (type) != RECORD_TYPE)
+	{
+	  item = build (code, type, node1, node2);
+	  break;
+	}
+      node1 = ffecom_stabilize_aggregate_ (node1);
+      node2 = ffecom_stabilize_aggregate_ (node2);
+      realtype = TREE_TYPE (TYPE_FIELDS (type));
+      item =
+	ffecom_2 (COMPLEX_EXPR, type,
+		  ffecom_2 (PLUS_EXPR, realtype,
+			    ffecom_1 (REALPART_EXPR, realtype,
+				      node1),
+			    ffecom_1 (REALPART_EXPR, realtype,
+				      node2)),
+		  ffecom_2 (PLUS_EXPR, realtype,
+			    ffecom_1 (IMAGPART_EXPR, realtype,
+				      node1),
+			    ffecom_1 (IMAGPART_EXPR, realtype,
+				      node2)));
+      break;
+
+    case MINUS_EXPR:
+      if (TREE_CODE (type) != RECORD_TYPE)
+	{
+	  item = build (code, type, node1, node2);
+	  break;
+	}
+      node1 = ffecom_stabilize_aggregate_ (node1);
+      node2 = ffecom_stabilize_aggregate_ (node2);
+      realtype = TREE_TYPE (TYPE_FIELDS (type));
+      item =
+	ffecom_2 (COMPLEX_EXPR, type,
+		  ffecom_2 (MINUS_EXPR, realtype,
+			    ffecom_1 (REALPART_EXPR, realtype,
+				      node1),
+			    ffecom_1 (REALPART_EXPR, realtype,
+				      node2)),
+		  ffecom_2 (MINUS_EXPR, realtype,
+			    ffecom_1 (IMAGPART_EXPR, realtype,
+				      node1),
+			    ffecom_1 (IMAGPART_EXPR, realtype,
+				      node2)));
+      break;
+
+    case MULT_EXPR:
+      if (TREE_CODE (type) != RECORD_TYPE)
+	{
+	  item = build (code, type, node1, node2);
+	  break;
+	}
+      node1 = ffecom_stabilize_aggregate_ (node1);
+      node2 = ffecom_stabilize_aggregate_ (node2);
+      realtype = TREE_TYPE (TYPE_FIELDS (type));
+      a = save_expr (ffecom_1 (REALPART_EXPR, realtype,
+			       node1));
+      b = save_expr (ffecom_1 (IMAGPART_EXPR, realtype,
+			       node1));
+      c = save_expr (ffecom_1 (REALPART_EXPR, realtype,
+			       node2));
+      d = save_expr (ffecom_1 (IMAGPART_EXPR, realtype,
+			       node2));
+      item =
+	ffecom_2 (COMPLEX_EXPR, type,
+		  ffecom_2 (MINUS_EXPR, realtype,
+			    ffecom_2 (MULT_EXPR, realtype,
+				      a,
+				      c),
+			    ffecom_2 (MULT_EXPR, realtype,
+				      b,
+				      d)),
+		  ffecom_2 (PLUS_EXPR, realtype,
+			    ffecom_2 (MULT_EXPR, realtype,
+				      a,
+				      d),
+			    ffecom_2 (MULT_EXPR, realtype,
+				      c,
+				      b)));
+      break;
+
+    case EQ_EXPR:
+      if ((TREE_CODE (node1) != RECORD_TYPE)
+	  && (TREE_CODE (node2) != RECORD_TYPE))
+	{
+	  item = build (code, type, node1, node2);
+	  break;
+	}
+      assert (TREE_CODE (node1) == RECORD_TYPE);
+      assert (TREE_CODE (node2) == RECORD_TYPE);
+      node1 = ffecom_stabilize_aggregate_ (node1);
+      node2 = ffecom_stabilize_aggregate_ (node2);
+      realtype = TREE_TYPE (TYPE_FIELDS (type));
+      item =
+	ffecom_2 (TRUTH_ANDIF_EXPR, type,
+		  ffecom_2 (code, type,
+			    ffecom_1 (REALPART_EXPR, realtype,
+				      node1),
+			    ffecom_1 (REALPART_EXPR, realtype,
+				      node2)),
+		  ffecom_2 (code, type,
+			    ffecom_1 (IMAGPART_EXPR, realtype,
+				      node1),
+			    ffecom_1 (IMAGPART_EXPR, realtype,
+				      node2)));
+      break;
+
+    case NE_EXPR:
+      if ((TREE_CODE (node1) != RECORD_TYPE)
+	  && (TREE_CODE (node2) != RECORD_TYPE))
+	{
+	  item = build (code, type, node1, node2);
+	  break;
+	}
+      assert (TREE_CODE (node1) == RECORD_TYPE);
+      assert (TREE_CODE (node2) == RECORD_TYPE);
+      node1 = ffecom_stabilize_aggregate_ (node1);
+      node2 = ffecom_stabilize_aggregate_ (node2);
+      realtype = TREE_TYPE (TYPE_FIELDS (type));
+      item =
+	ffecom_2 (TRUTH_ORIF_EXPR, type,
+		  ffecom_2 (code, type,
+			    ffecom_1 (REALPART_EXPR, realtype,
+				      node1),
+			    ffecom_1 (REALPART_EXPR, realtype,
+				      node2)),
+		  ffecom_2 (code, type,
+			    ffecom_1 (IMAGPART_EXPR, realtype,
+				      node1),
+			    ffecom_1 (IMAGPART_EXPR, realtype,
+				      node2)));
+      break;
+
+    default:
+      item = build (code, type, node1, node2);
+      break;
+    }
+
+  if (TREE_SIDE_EFFECTS (node1) || TREE_SIDE_EFFECTS (node2))
+    TREE_SIDE_EFFECTS (item) = 1;
+  return fold (item);
+}
+
+/* ffecom_2pass_advise_entrypoint -- Advise that there's this entrypoint
+
+   ffesymbol s;	 // the ENTRY point itself
+   if (ffecom_2pass_advise_entrypoint(s))
+       // the ENTRY point has been accepted
+
+   Does whatever compiler needs to do when it learns about the entrypoint,
+   like determine the return type of the master function, count the
+   number of entrypoints, etc.	Returns FALSE if the return type is
+   not compatible with the return type(s) of other entrypoint(s).
+
+   NOTE: for every call to this fn that returns TRUE, _do_entrypoint must
+   later (after _finish_progunit) be called with the same entrypoint(s)
+   as passed to this fn for which TRUE was returned.
+
+   03-Jan-92  JCB  2.0
+      Return FALSE if the return type conflicts with previous entrypoints.  */
+
+bool
+ffecom_2pass_advise_entrypoint (ffesymbol entry)
+{
+  ffebld list;			/* opITEM. */
+  ffebld mlist;			/* opITEM. */
+  ffebld plist;			/* opITEM. */
+  ffebld arg;			/* ffebld_head(opITEM). */
+  ffebld item;			/* opITEM. */
+  ffesymbol s;			/* ffebld_symter(arg). */
+  ffeinfoBasictype bt = ffesymbol_basictype (entry);
+  ffeinfoKindtype kt = ffesymbol_kindtype (entry);
+  ffetargetCharacterSize size = ffesymbol_size (entry);
+  bool ok;
+
+  if (ffecom_num_entrypoints_ == 0)
+    {				/* First entrypoint, make list of main
+				   arglist's dummies. */
+      assert (ffecom_primary_entry_ != NULL);
+
+      ffecom_master_bt_ = ffesymbol_basictype (ffecom_primary_entry_);
+      ffecom_master_kt_ = ffesymbol_kindtype (ffecom_primary_entry_);
+      ffecom_master_size_ = ffesymbol_size (ffecom_primary_entry_);
+
+      for (plist = NULL, list = ffesymbol_dummyargs (ffecom_primary_entry_);
+	   list != NULL;
+	   list = ffebld_trail (list))
+	{
+	  arg = ffebld_head (list);
+	  if (ffebld_op (arg) != FFEBLD_opSYMTER)
+	    continue;		/* Alternate return or some such thing. */
+	  item = ffebld_new_item (arg, NULL);
+	  if (plist == NULL)
+	    ffecom_master_arglist_ = item;
+	  else
+	    ffebld_set_trail (plist, item);
+	  plist = item;
+	}
+    }
+
+  /* If necessary, scan entry arglist for alternate returns.  Do this scan
+     apparently redundantly (it's done below to UNIONize the arglists) so
+     that we don't complain about RETURN 1 if an offending ENTRY is the only
+     one with an alternate return.  */
+
+  if (!ffecom_is_altreturning_)
+    {
+      for (list = ffesymbol_dummyargs (entry);
+	   list != NULL;
+	   list = ffebld_trail (list))
+	{
+	  arg = ffebld_head (list);
+	  if (ffebld_op (arg) == FFEBLD_opSTAR)
+	    {
+	      ffecom_is_altreturning_ = TRUE;
+	      break;
+	    }
+	}
+    }
+
+  /* Now check type compatibility. */
+
+  switch (ffecom_master_bt_)
+    {
+    case FFEINFO_basictypeNONE:
+      ok = (bt != FFEINFO_basictypeCHARACTER);
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      ok
+	= (bt == FFEINFO_basictypeCHARACTER)
+	&& (kt == ffecom_master_kt_)
+	&& (size == ffecom_master_size_);
+      break;
+
+    case FFEINFO_basictypeANY:
+      return FALSE;		/* Just don't bother. */
+
+    default:
+      if (bt == FFEINFO_basictypeCHARACTER)
+	{
+	  ok = FALSE;
+	  break;
+	}
+      ok = TRUE;
+      if ((bt != ffecom_master_bt_) || (kt != ffecom_master_kt_))
+	{
+	  ffecom_master_bt_ = FFEINFO_basictypeNONE;
+	  ffecom_master_kt_ = FFEINFO_kindtypeNONE;
+	}
+      break;
+    }
+
+  if (!ok)
+    {
+      ffebad_start (FFEBAD_ENTRY_CONFLICTS);
+      ffest_ffebad_here_current_stmt (0);
+      ffebad_finish ();
+      return FALSE;		/* Can't handle entrypoint. */
+    }
+
+  /* Entrypoint type compatible with previous types. */
+
+  ++ffecom_num_entrypoints_;
+
+  /* Master-arg-list = UNION(Master-arg-list,entry-arg-list). */
+
+  for (list = ffesymbol_dummyargs (entry);
+       list != NULL;
+       list = ffebld_trail (list))
+    {
+      arg = ffebld_head (list);
+      if (ffebld_op (arg) != FFEBLD_opSYMTER)
+	continue;		/* Alternate return or some such thing. */
+      s = ffebld_symter (arg);
+      for (plist = NULL, mlist = ffecom_master_arglist_;
+	   mlist != NULL;
+	   plist = mlist, mlist = ffebld_trail (mlist))
+	{			/* plist points to previous item for easy
+				   appending of arg. */
+	  if (ffebld_symter (ffebld_head (mlist)) == s)
+	    break;		/* Already have this arg in the master list. */
+	}
+      if (mlist != NULL)
+	continue;		/* Already have this arg in the master list. */
+
+      /* Append this arg to the master list. */
+
+      item = ffebld_new_item (arg, NULL);
+      if (plist == NULL)
+	ffecom_master_arglist_ = item;
+      else
+	ffebld_set_trail (plist, item);
+    }
+
+  return TRUE;
+}
+
+/* ffecom_2pass_do_entrypoint -- Do compilation of entrypoint
+
+   ffesymbol s;	 // the ENTRY point itself
+   ffecom_2pass_do_entrypoint(s);
+
+   Does whatever compiler needs to do to make the entrypoint actually
+   happen.  Must be called for each entrypoint after
+   ffecom_finish_progunit is called.  */
+
+void
+ffecom_2pass_do_entrypoint (ffesymbol entry)
+{
+  static int mfn_num = 0;
+  static int ent_num;
+
+  if (mfn_num != ffecom_num_fns_)
+    {				/* First entrypoint for this program unit. */
+      ent_num = 1;
+      mfn_num = ffecom_num_fns_;
+      ffecom_do_entry_ (ffecom_primary_entry_, 0);
+    }
+  else
+    ++ent_num;
+
+  --ffecom_num_entrypoints_;
+
+  ffecom_do_entry_ (entry, ent_num);
+}
+
+/* Essentially does a "fold (build (code, type, node1, node2))" while
+   checking for certain housekeeping things.  Always sets
+   TREE_SIDE_EFFECTS.  */
+
+tree
+ffecom_2s (enum tree_code code, tree type, tree node1, tree node2)
+{
+  tree item;
+
+  if ((node1 == error_mark_node)
+      || (node2 == error_mark_node)
+      || (type == error_mark_node))
+    return error_mark_node;
+
+  item = build (code, type, node1, node2);
+  TREE_SIDE_EFFECTS (item) = 1;
+  return fold (item);
+}
+
+/* Essentially does a "fold (build (code, type, node1, node2, node3))" while
+   checking for certain housekeeping things.  */
+
+tree
+ffecom_3 (enum tree_code code, tree type, tree node1, tree node2, tree node3)
+{
+  tree item;
+
+  if ((node1 == error_mark_node)
+      || (node2 == error_mark_node)
+      || (node3 == error_mark_node)
+      || (type == error_mark_node))
+    return error_mark_node;
+
+  item = build (code, type, node1, node2, node3);
+  if (TREE_SIDE_EFFECTS (node1) || TREE_SIDE_EFFECTS (node2)
+      || (node3 != NULL_TREE && TREE_SIDE_EFFECTS (node3)))
+    TREE_SIDE_EFFECTS (item) = 1;
+  return fold (item);
+}
+
+/* Essentially does a "fold (build (code, type, node1, node2, node3))" while
+   checking for certain housekeeping things.  Always sets
+   TREE_SIDE_EFFECTS.  */
+
+tree
+ffecom_3s (enum tree_code code, tree type, tree node1, tree node2, tree node3)
+{
+  tree item;
+
+  if ((node1 == error_mark_node)
+      || (node2 == error_mark_node)
+      || (node3 == error_mark_node)
+      || (type == error_mark_node))
+    return error_mark_node;
+
+  item = build (code, type, node1, node2, node3);
+  TREE_SIDE_EFFECTS (item) = 1;
+  return fold (item);
+}
+
+/* ffecom_arg_expr -- Transform argument expr into gcc tree
+
+   See use by ffecom_list_expr.
+
+   If expression is NULL, returns an integer zero tree.	 If it is not
+   a CHARACTER expression, returns whatever ffecom_expr
+   returns and sets the length return value to NULL_TREE.  Otherwise
+   generates code to evaluate the character expression, returns the proper
+   pointer to the result, but does NOT set the length return value to a tree
+   that specifies the length of the result.  (In other words, the length
+   variable is always set to NULL_TREE, because a length is never passed.)
+
+   21-Dec-91  JCB  1.1
+      Don't set returned length, since nobody needs it (yet; someday if
+      we allow CHARACTER*(*) dummies to statement functions, we'll need
+      it).  */
+
+tree
+ffecom_arg_expr (ffebld expr, tree *length)
+{
+  tree ign;
+
+  *length = NULL_TREE;
+
+  if (expr == NULL)
+    return integer_zero_node;
+
+  if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
+    return ffecom_expr (expr);
+
+  return ffecom_arg_ptr_to_expr (expr, &ign);
+}
+
+/* Transform expression into constant argument-pointer-to-expression tree.
+
+   If the expression can be transformed into a argument-pointer-to-expression
+   tree that is constant, that is done, and the tree returned.  Else
+   NULL_TREE is returned.
+
+   That way, a caller can attempt to provide compile-time initialization
+   of a variable and, if that fails, *then* choose to start a new block
+   and resort to using temporaries, as appropriate.  */
+
+tree
+ffecom_arg_ptr_to_const_expr (ffebld expr, tree *length)
+{
+  if (! expr)
+    return integer_zero_node;
+
+  if (ffebld_op (expr) == FFEBLD_opANY)
+    {
+      if (length)
+	*length = error_mark_node;
+      return error_mark_node;
+    }
+
+  if (ffebld_arity (expr) == 0
+      && (ffebld_op (expr) != FFEBLD_opSYMTER
+	  || ffebld_where (expr) == FFEINFO_whereCOMMON
+	  || ffebld_where (expr) == FFEINFO_whereGLOBAL
+	  || ffebld_where (expr) == FFEINFO_whereINTRINSIC))
+    {
+      tree t;
+
+      t = ffecom_arg_ptr_to_expr (expr, length);
+      assert (TREE_CONSTANT (t));
+      assert (! length || TREE_CONSTANT (*length));
+      return t;
+    }
+
+  if (length
+      && ffebld_size (expr) != FFETARGET_charactersizeNONE)
+    *length = build_int_2 (ffebld_size (expr), 0);
+  else if (length)
+    *length = NULL_TREE;
+  return NULL_TREE;
+}
+
+/* ffecom_arg_ptr_to_expr -- Transform argument expr into gcc tree
+
+   See use by ffecom_list_ptr_to_expr.
+
+   If expression is NULL, returns an integer zero tree.	 If it is not
+   a CHARACTER expression, returns whatever ffecom_ptr_to_expr
+   returns and sets the length return value to NULL_TREE.  Otherwise
+   generates code to evaluate the character expression, returns the proper
+   pointer to the result, AND sets the length return value to a tree that
+   specifies the length of the result.
+
+   If the length argument is NULL, this is a slightly special
+   case of building a FORMAT expression, that is, an expression that
+   will be used at run time without regard to length.  For the current
+   implementation, which uses the libf2c library, this means it is nice
+   to append a null byte to the end of the expression, where feasible,
+   to make sure any diagnostic about the FORMAT string terminates at
+   some useful point.
+
+   For now, treat %REF(char-expr) as the same as char-expr with a NULL
+   length argument.  This might even be seen as a feature, if a null
+   byte can always be appended.  */
+
+tree
+ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
+{
+  tree item;
+  tree ign_length;
+  ffecomConcatList_ catlist;
+
+  if (length != NULL)
+    *length = NULL_TREE;
+
+  if (expr == NULL)
+    return integer_zero_node;
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opPERCENT_VAL:
+      if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
+	return ffecom_expr (ffebld_left (expr));
+      {
+	tree temp_exp;
+	tree temp_length;
+
+	temp_exp = ffecom_arg_ptr_to_expr (ffebld_left (expr), &temp_length);
+	if (temp_exp == error_mark_node)
+	  return error_mark_node;
+
+	return ffecom_1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (temp_exp)),
+			 temp_exp);
+      }
+
+    case FFEBLD_opPERCENT_REF:
+      if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
+	return ffecom_ptr_to_expr (ffebld_left (expr));
+      if (length != NULL)
+	{
+	  ign_length = NULL_TREE;
+	  length = &ign_length;
+	}
+      expr = ffebld_left (expr);
+      break;
+
+    case FFEBLD_opPERCENT_DESCR:
+      switch (ffeinfo_basictype (ffebld_info (expr)))
+	{
+	case FFEINFO_basictypeCHARACTER:
+	  break;		/* Passed by descriptor anyway. */
+
+	default:
+	  item = ffecom_ptr_to_expr (expr);
+	  if (item != error_mark_node)
+	    *length = TYPE_SIZE (TREE_TYPE (TREE_TYPE (item)));
+	  break;
+	}
+      break;
+
+    default:
+      break;
+    }
+
+  if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
+    return ffecom_ptr_to_expr (expr);
+
+  assert (ffeinfo_kindtype (ffebld_info (expr))
+	  == FFEINFO_kindtypeCHARACTER1);
+
+  while (ffebld_op (expr) == FFEBLD_opPAREN)
+    expr = ffebld_left (expr);
+
+  catlist = ffecom_concat_list_new_ (expr, FFETARGET_charactersizeNONE);
+  switch (ffecom_concat_list_count_ (catlist))
+    {
+    case 0:			/* Shouldn't happen, but in case it does... */
+      if (length != NULL)
+	{
+	  *length = ffecom_f2c_ftnlen_zero_node;
+	  TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
+	}
+      ffecom_concat_list_kill_ (catlist);
+      return null_pointer_node;
+
+    case 1:			/* The (fairly) easy case. */
+      if (length == NULL)
+	ffecom_char_args_with_null_ (&item, &ign_length,
+				     ffecom_concat_list_expr_ (catlist, 0));
+      else
+	ffecom_char_args_ (&item, length,
+			   ffecom_concat_list_expr_ (catlist, 0));
+      ffecom_concat_list_kill_ (catlist);
+      assert (item != NULL_TREE);
+      return item;
+
+    default:			/* Must actually concatenate things. */
+      break;
+    }
+
+  {
+    int count = ffecom_concat_list_count_ (catlist);
+    int i;
+    tree lengths;
+    tree items;
+    tree length_array;
+    tree item_array;
+    tree citem;
+    tree clength;
+    tree temporary;
+    tree num;
+    tree known_length;
+    ffetargetCharacterSize sz;
+
+    sz = ffecom_concat_list_maxlen_ (catlist);
+    /* ~~Kludge! */
+    assert (sz != FFETARGET_charactersizeNONE);
+
+    {
+      tree hook;
+
+      hook = ffebld_nonter_hook (expr);
+      assert (hook);
+      assert (TREE_CODE (hook) == TREE_VEC);
+      assert (TREE_VEC_LENGTH (hook) == 3);
+      length_array = lengths = TREE_VEC_ELT (hook, 0);
+      item_array = items = TREE_VEC_ELT (hook, 1);
+      temporary = TREE_VEC_ELT (hook, 2);
+    }
+
+    known_length = ffecom_f2c_ftnlen_zero_node;
+
+    for (i = 0; i < count; ++i)
+      {
+	if ((i == count)
+	    && (length == NULL))
+	  ffecom_char_args_with_null_ (&citem, &clength,
+				       ffecom_concat_list_expr_ (catlist, i));
+	else
+	  ffecom_char_args_ (&citem, &clength,
+			     ffecom_concat_list_expr_ (catlist, i));
+	if ((citem == error_mark_node)
+	    || (clength == error_mark_node))
+	  {
+	    ffecom_concat_list_kill_ (catlist);
+	    *length = error_mark_node;
+	    return error_mark_node;
+	  }
+
+	items
+	  = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (items),
+		      ffecom_modify (void_type_node,
+				     ffecom_2 (ARRAY_REF,
+		     TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item_array))),
+					       item_array,
+					       build_int_2 (i, 0)),
+				     citem),
+		      items);
+	clength = ffecom_save_tree (clength);
+	if (length != NULL)
+	  known_length
+	    = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
+			known_length,
+			clength);
+	lengths
+	  = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (lengths),
+		      ffecom_modify (void_type_node,
+				     ffecom_2 (ARRAY_REF,
+		   TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (length_array))),
+					       length_array,
+					       build_int_2 (i, 0)),
+				     clength),
+		      lengths);
+      }
+
+    temporary = ffecom_1 (ADDR_EXPR,
+			  build_pointer_type (TREE_TYPE (temporary)),
+			  temporary);
+
+    item = build_tree_list (NULL_TREE, temporary);
+    TREE_CHAIN (item)
+      = build_tree_list (NULL_TREE,
+			 ffecom_1 (ADDR_EXPR,
+				   build_pointer_type (TREE_TYPE (items)),
+				   items));
+    TREE_CHAIN (TREE_CHAIN (item))
+      = build_tree_list (NULL_TREE,
+			 ffecom_1 (ADDR_EXPR,
+				   build_pointer_type (TREE_TYPE (lengths)),
+				   lengths));
+    TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item)))
+      = build_tree_list
+	(NULL_TREE,
+	 ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node,
+		   convert (ffecom_f2c_ftnlen_type_node,
+			    build_int_2 (count, 0))));
+    num = build_int_2 (sz, 0);
+    TREE_TYPE (num) = ffecom_f2c_ftnlen_type_node;
+    TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item))))
+      = build_tree_list (NULL_TREE, num);
+
+    item = ffecom_call_gfrt (FFECOM_gfrtCAT, item, NULL_TREE);
+    TREE_SIDE_EFFECTS (item) = 1;
+    item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (temporary),
+		     item,
+		     temporary);
+
+    if (length != NULL)
+      *length = known_length;
+  }
+
+  ffecom_concat_list_kill_ (catlist);
+  assert (item != NULL_TREE);
+  return item;
+}
+
+/* Generate call to run-time function.
+
+   The first arg is the GNU Fortran Run-Time function index, the second
+   arg is the list of arguments to pass to it.	Returned is the expression
+   (WITHOUT TREE_SIDE_EFFECTS set!) that makes the call and returns the
+   result (which may be void).	*/
+
+tree
+ffecom_call_gfrt (ffecomGfrt ix, tree args, tree hook)
+{
+  return ffecom_call_ (ffecom_gfrt_tree_ (ix),
+		       ffecom_gfrt_kindtype (ix),
+		       ffe_is_f2c_library () && ffecom_gfrt_complex_[ix],
+		       NULL_TREE, args, NULL_TREE, NULL,
+		       NULL, NULL_TREE, TRUE, hook);
+}
+
+/* Transform constant-union to tree.  */
+
+tree
+ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
+		      ffeinfoKindtype kt, tree tree_type)
+{
+  tree item;
+
+  switch (bt)
+    {
+    case FFEINFO_basictypeINTEGER:
+      {
+        HOST_WIDE_INT hi, lo;
+
+	switch (kt)
+	  {
+#if FFETARGET_okINTEGER1
+	  case FFEINFO_kindtypeINTEGER1:
+	    lo = ffebld_cu_val_integer1 (*cu);
+	    hi = (lo < 0) ? -1 : 0;
+	    break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	  case FFEINFO_kindtypeINTEGER2:
+	    lo = ffebld_cu_val_integer2 (*cu);
+	    hi = (lo < 0) ? -1 : 0;
+	    break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	  case FFEINFO_kindtypeINTEGER3:
+	    lo = ffebld_cu_val_integer3 (*cu);
+	    hi = (lo < 0) ? -1 : 0;
+	    break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	  case FFEINFO_kindtypeINTEGER4:
+#if HOST_BITS_PER_LONGLONG > HOST_BITS_PER_WIDE_INT
+	    {
+	      long long int big = ffebld_cu_val_integer4 (*cu);
+	      hi = (HOST_WIDE_INT) (big >> HOST_BITS_PER_WIDE_INT);
+	      lo = (HOST_WIDE_INT) big;
+	    }
+#else
+	    lo = ffebld_cu_val_integer4 (*cu);
+	    hi = (lo < 0) ? -1 : 0;
+#endif
+	    break;
+#endif
+
+	  default:
+	    assert ("bad INTEGER constant kind type" == NULL);
+	    /* Fall through. */
+	  case FFEINFO_kindtypeANY:
+	    return error_mark_node;
+	  }
+	item = build_int_2 (lo, hi);
+	TREE_TYPE (item) = tree_type;
+      }
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      {
+	int val;
+
+	switch (kt)
+	  {
+#if FFETARGET_okLOGICAL1
+	  case FFEINFO_kindtypeLOGICAL1:
+	    val = ffebld_cu_val_logical1 (*cu);
+	    break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	  case FFEINFO_kindtypeLOGICAL2:
+	    val = ffebld_cu_val_logical2 (*cu);
+	    break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	  case FFEINFO_kindtypeLOGICAL3:
+	    val = ffebld_cu_val_logical3 (*cu);
+	    break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	  case FFEINFO_kindtypeLOGICAL4:
+	    val = ffebld_cu_val_logical4 (*cu);
+	    break;
+#endif
+
+	  default:
+	    assert ("bad LOGICAL constant kind type" == NULL);
+	    /* Fall through. */
+	  case FFEINFO_kindtypeANY:
+	    return error_mark_node;
+	  }
+	item = build_int_2 (val, (val < 0) ? -1 : 0);
+	TREE_TYPE (item) = tree_type;
+      }
+      break;
+
+    case FFEINFO_basictypeREAL:
+      {
+	REAL_VALUE_TYPE val;
+
+	switch (kt)
+	  {
+#if FFETARGET_okREAL1
+	  case FFEINFO_kindtypeREAL1:
+	    val = ffetarget_value_real1 (ffebld_cu_val_real1 (*cu));
+	    break;
+#endif
+
+#if FFETARGET_okREAL2
+	  case FFEINFO_kindtypeREAL2:
+	    val = ffetarget_value_real2 (ffebld_cu_val_real2 (*cu));
+	    break;
+#endif
+
+#if FFETARGET_okREAL3
+	  case FFEINFO_kindtypeREAL3:
+	    val = ffetarget_value_real3 (ffebld_cu_val_real3 (*cu));
+	    break;
+#endif
+
+	  default:
+	    assert ("bad REAL constant kind type" == NULL);
+	    /* Fall through. */
+	  case FFEINFO_kindtypeANY:
+	    return error_mark_node;
+	  }
+	item = build_real (tree_type, val);
+      }
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      {
+	REAL_VALUE_TYPE real;
+	REAL_VALUE_TYPE imag;
+	tree el_type = ffecom_tree_type[FFEINFO_basictypeREAL][kt];
+
+	switch (kt)
+	  {
+#if FFETARGET_okCOMPLEX1
+	  case FFEINFO_kindtypeREAL1:
+	    real = ffetarget_value_real1 (ffebld_cu_val_complex1 (*cu).real);
+	    imag = ffetarget_value_real1 (ffebld_cu_val_complex1 (*cu).imaginary);
+	    break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	  case FFEINFO_kindtypeREAL2:
+	    real = ffetarget_value_real2 (ffebld_cu_val_complex2 (*cu).real);
+	    imag = ffetarget_value_real2 (ffebld_cu_val_complex2 (*cu).imaginary);
+	    break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	  case FFEINFO_kindtypeREAL3:
+	    real = ffetarget_value_real3 (ffebld_cu_val_complex3 (*cu).real);
+	    imag = ffetarget_value_real3 (ffebld_cu_val_complex3 (*cu).imaginary);
+	    break;
+#endif
+
+	  default:
+	    assert ("bad REAL constant kind type" == NULL);
+	    /* Fall through. */
+	  case FFEINFO_kindtypeANY:
+	    return error_mark_node;
+	  }
+	item = ffecom_build_complex_constant_ (tree_type,
+					       build_real (el_type, real),
+					       build_real (el_type, imag));
+      }
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      {				/* Happens only in DATA and similar contexts. */
+	ffetargetCharacter1 val;
+
+	switch (kt)
+	  {
+#if FFETARGET_okCHARACTER1
+	  case FFEINFO_kindtypeLOGICAL1:
+	    val = ffebld_cu_val_character1 (*cu);
+	    break;
+#endif
+
+	  default:
+	    assert ("bad CHARACTER constant kind type" == NULL);
+	    /* Fall through. */
+	  case FFEINFO_kindtypeANY:
+	    return error_mark_node;
+	  }
+	item = build_string (ffetarget_length_character1 (val),
+			     ffetarget_text_character1 (val));
+	TREE_TYPE (item)
+	  = build_type_variant (build_array_type (char_type_node,
+						  build_range_type
+						  (integer_type_node,
+						   integer_one_node,
+						   build_int_2
+						(ffetarget_length_character1
+						 (val), 0))),
+				1, 0);
+      }
+      break;
+
+    case FFEINFO_basictypeHOLLERITH:
+      {
+	ffetargetHollerith h;
+
+	h = ffebld_cu_val_hollerith (*cu);
+
+	/* If not at least as wide as default INTEGER, widen it.  */
+	if (h.length >= FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE)
+	  item = build_string (h.length, h.text);
+	else
+	  {
+	    char str[FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE];
+
+	    memcpy (str, h.text, h.length);
+	    memset (&str[h.length], ' ',
+		    FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE
+		    - h.length);
+	    item = build_string (FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE,
+				 str);
+	  }
+	TREE_TYPE (item)
+	  = build_type_variant (build_array_type (char_type_node,
+						  build_range_type
+						  (integer_type_node,
+						   integer_one_node,
+						   build_int_2
+						   (h.length, 0))),
+				1, 0);
+      }
+      break;
+
+    case FFEINFO_basictypeTYPELESS:
+      {
+	ffetargetInteger1 ival;
+	ffetargetTypeless tless;
+	ffebad error;
+
+	tless = ffebld_cu_val_typeless (*cu);
+	error = ffetarget_convert_integer1_typeless (&ival, tless);
+	assert (error == FFEBAD);
+
+	item = build_int_2 ((int) ival, 0);
+      }
+      break;
+
+    default:
+      assert ("not yet on constant type" == NULL);
+      /* Fall through. */
+    case FFEINFO_basictypeANY:
+      return error_mark_node;
+    }
+
+  TREE_CONSTANT (item) = 1;
+
+  return item;
+}
+
+/* Transform constant-union to tree, with the type known.  */
+
+tree
+ffecom_constantunion_with_type (ffebldConstantUnion *cu, tree tree_type,
+				ffebldConst ct)
+{
+  tree item;
+
+  int val;
+
+  switch (ct)
+  {
+#if FFETARGET_okINTEGER1
+	  case  FFEBLD_constINTEGER1:
+	  val = ffebld_cu_val_integer1 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+		  break;
+#endif
+#if FFETARGET_okINTEGER2
+	  case  FFEBLD_constINTEGER2:
+		  val = ffebld_cu_val_integer2 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+		  break;
+#endif
+#if FFETARGET_okINTEGER3
+	  case  FFEBLD_constINTEGER3:
+		  val = ffebld_cu_val_integer3 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+		  break;
+#endif
+#if FFETARGET_okINTEGER4
+	  case  FFEBLD_constINTEGER4:
+#if HOST_BITS_PER_LONGLONG > HOST_BITS_PER_WIDE_INT
+		  {
+		    long long int big = ffebld_cu_val_integer4 (*cu);
+		    item = build_int_2 ((HOST_WIDE_INT) big,
+					(HOST_WIDE_INT)
+					(big >> HOST_BITS_PER_WIDE_INT));
+		  }
+#else
+		  val = ffebld_cu_val_integer4 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+#endif
+		  break;
+#endif
+#if FFETARGET_okLOGICAL1
+	  case  FFEBLD_constLOGICAL1:
+		  val = ffebld_cu_val_logical1 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+		  break;
+#endif
+#if FFETARGET_okLOGICAL2
+          case  FFEBLD_constLOGICAL2:
+		  val = ffebld_cu_val_logical2 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+		  break;
+#endif
+#if FFETARGET_okLOGICAL3
+	  case  FFEBLD_constLOGICAL3:
+		  val = ffebld_cu_val_logical3 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+		  break;
+#endif
+#if FFETARGET_okLOGICAL4
+	  case  FFEBLD_constLOGICAL4:
+		  val = ffebld_cu_val_logical4 (*cu);
+		  item = build_int_2 (val, (val < 0) ? -1 : 0);
+		  break;
+#endif
+	  default:
+		  assert ("constant type not supported"==NULL);
+		  return error_mark_node;
+		  break;
+  }
+
+  TREE_TYPE (item) = tree_type;
+
+  TREE_CONSTANT (item) = 1;
+
+  return item;
+}
+/* Transform expression into constant tree.
+
+   If the expression can be transformed into a tree that is constant,
+   that is done, and the tree returned.  Else NULL_TREE is returned.
+
+   That way, a caller can attempt to provide compile-time initialization
+   of a variable and, if that fails, *then* choose to start a new block
+   and resort to using temporaries, as appropriate.  */
+
+tree
+ffecom_const_expr (ffebld expr)
+{
+  if (! expr)
+    return integer_zero_node;
+
+  if (ffebld_op (expr) == FFEBLD_opANY)
+    return error_mark_node;
+
+  if (ffebld_arity (expr) == 0
+      && (ffebld_op (expr) != FFEBLD_opSYMTER
+	  || ffebld_where (expr) == FFEINFO_whereGLOBAL
+	  || ffebld_where (expr) == FFEINFO_whereINTRINSIC))
+    {
+      tree t;
+
+      t = ffecom_expr (expr);
+      assert (TREE_CONSTANT (t));
+      return t;
+    }
+
+  return NULL_TREE;
+}
+
+/* Handy way to make a field in a struct/union.  */
+
+tree
+ffecom_decl_field (tree context, tree prevfield, const char *name, tree type)
+{
+  tree field;
+
+  field = build_decl (FIELD_DECL, get_identifier (name), type);
+  DECL_CONTEXT (field) = context;
+  DECL_ALIGN (field) = 0;
+  DECL_USER_ALIGN (field) = 0;
+  if (prevfield != NULL_TREE)
+    TREE_CHAIN (prevfield) = field;
+
+  return field;
+}
+
+void
+ffecom_close_include (FILE *f)
+{
+  ffecom_close_include_ (f);
+}
+
+/* End a compound statement (block).  */
+
+tree
+ffecom_end_compstmt (void)
+{
+  return bison_rule_compstmt_ ();
+}
+
+/* ffecom_end_transition -- Perform end transition on all symbols
+
+   ffecom_end_transition();
+
+   Calls ffecom_sym_end_transition for each global and local symbol.  */
+
+void
+ffecom_end_transition (void)
+{
+  ffebld item;
+
+  if (ffe_is_ffedebug ())
+    fprintf (dmpout, "; end_stmt_transition\n");
+
+  ffecom_list_blockdata_ = NULL;
+  ffecom_list_common_ = NULL;
+
+  ffesymbol_drive (ffecom_sym_end_transition);
+  if (ffe_is_ffedebug ())
+    {
+      ffestorag_report ();
+    }
+
+  ffecom_start_progunit_ ();
+
+  for (item = ffecom_list_blockdata_;
+       item != NULL;
+       item = ffebld_trail (item))
+    {
+      ffebld callee;
+      ffesymbol s;
+      tree dt;
+      tree t;
+      tree var;
+      static int number = 0;
+
+      callee = ffebld_head (item);
+      s = ffebld_symter (callee);
+      t = ffesymbol_hook (s).decl_tree;
+      if (t == NULL_TREE)
+	{
+	  s = ffecom_sym_transform_ (s);
+	  t = ffesymbol_hook (s).decl_tree;
+	}
+
+      dt = build_pointer_type (TREE_TYPE (t));
+
+      var = build_decl (VAR_DECL,
+			ffecom_get_invented_identifier ("__g77_forceload_%d",
+							number++),
+			dt);
+      DECL_EXTERNAL (var) = 0;
+      TREE_STATIC (var) = 1;
+      TREE_PUBLIC (var) = 0;
+      DECL_INITIAL (var) = error_mark_node;
+      TREE_USED (var) = 1;
+
+      var = start_decl (var, FALSE);
+
+      t = ffecom_1 (ADDR_EXPR, dt, t);
+
+      finish_decl (var, t, FALSE);
+    }
+
+  /* This handles any COMMON areas that weren't referenced but have, for
+     example, important initial data.  */
+
+  for (item = ffecom_list_common_;
+       item != NULL;
+       item = ffebld_trail (item))
+    ffecom_transform_common_ (ffebld_symter (ffebld_head (item)));
+
+  ffecom_list_common_ = NULL;
+}
+
+/* ffecom_exec_transition -- Perform exec transition on all symbols
+
+   ffecom_exec_transition();
+
+   Calls ffecom_sym_exec_transition for each global and local symbol.
+   Make sure error updating not inhibited.  */
+
+void
+ffecom_exec_transition (void)
+{
+  bool inhibited;
+
+  if (ffe_is_ffedebug ())
+    fprintf (dmpout, "; exec_stmt_transition\n");
+
+  inhibited = ffebad_inhibit ();
+  ffebad_set_inhibit (FALSE);
+
+  ffesymbol_drive (ffecom_sym_exec_transition);	/* Don't retract! */
+  ffeequiv_exec_transition ();	/* Handle all pending EQUIVALENCEs. */
+  if (ffe_is_ffedebug ())
+    {
+      ffestorag_report ();
+    }
+
+  if (inhibited)
+    ffebad_set_inhibit (TRUE);
+}
+
+/* Handle assignment statement.
+
+   Convert dest and source using ffecom_expr, then join them
+   with an ASSIGN op and pass the whole thing to expand_expr_stmt.  */
+
+void
+ffecom_expand_let_stmt (ffebld dest, ffebld source)
+{
+  tree dest_tree;
+  tree dest_length;
+  tree source_tree;
+  tree expr_tree;
+
+  if (ffeinfo_basictype (ffebld_info (dest)) != FFEINFO_basictypeCHARACTER)
+    {
+      bool dest_used;
+      tree assign_temp;
+
+      /* This attempts to replicate the test below, but must not be
+	 true when the test below is false.  (Always err on the side
+	 of creating unused temporaries, to avoid ICEs.)  */
+      if (ffebld_op (dest) != FFEBLD_opSYMTER
+	  || ((dest_tree = ffesymbol_hook (ffebld_symter (dest)).decl_tree)
+	      && (TREE_CODE (dest_tree) != VAR_DECL
+		  || TREE_ADDRESSABLE (dest_tree))))
+	{
+	  ffecom_prepare_expr_ (source, dest);
+	  dest_used = TRUE;
+	}
+      else
+	{
+	  ffecom_prepare_expr_ (source, NULL);
+	  dest_used = FALSE;
+	}
+
+      ffecom_prepare_expr_w (NULL_TREE, dest);
+
+      /* For COMPLEX assignment like C1=C2, if partial overlap is possible,
+	 create a temporary through which the assignment is to take place,
+	 since MODIFY_EXPR doesn't handle partial overlap properly.  */
+      if (ffebld_basictype (dest) == FFEINFO_basictypeCOMPLEX
+	  && ffecom_possible_partial_overlap_ (dest, source))
+	{
+	  assign_temp = ffecom_make_tempvar ("complex_let",
+					     ffecom_tree_type
+					     [ffebld_basictype (dest)]
+					     [ffebld_kindtype (dest)],
+					     FFETARGET_charactersizeNONE,
+					     -1);
+	}
+      else
+	assign_temp = NULL_TREE;
+
+      ffecom_prepare_end ();
+
+      dest_tree = ffecom_expr_w (NULL_TREE, dest);
+      if (dest_tree == error_mark_node)
+	return;
+
+      if ((TREE_CODE (dest_tree) != VAR_DECL)
+	  || TREE_ADDRESSABLE (dest_tree))
+	source_tree = ffecom_expr_ (source, dest_tree, dest, &dest_used,
+				    FALSE, FALSE);
+      else
+	{
+	  assert (! dest_used);
+	  dest_used = FALSE;
+	  source_tree = ffecom_expr (source);
+	}
+      if (source_tree == error_mark_node)
+	return;
+
+      if (dest_used)
+	expr_tree = source_tree;
+      else if (assign_temp)
+	{
+	  expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
+				 assign_temp,
+				 source_tree);
+	  expand_expr_stmt (expr_tree);
+	  expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
+				 dest_tree,
+				 assign_temp);
+	}
+      else
+	expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
+			       dest_tree,
+			       source_tree);
+
+      expand_expr_stmt (expr_tree);
+      return;
+    }
+
+  ffecom_prepare_let_char_ (ffebld_size_known (dest), source);
+  ffecom_prepare_expr_w (NULL_TREE, dest);
+
+  ffecom_prepare_end ();
+
+  ffecom_char_args_ (&dest_tree, &dest_length, dest);
+  ffecom_let_char_ (dest_tree, dest_length, ffebld_size_known (dest),
+		    source);
+}
+
+/* ffecom_expr -- Transform expr into gcc tree
+
+   tree t;
+   ffebld expr;	 // FFE expression.
+   tree = ffecom_expr(expr);
+
+   Recursive descent on expr while making corresponding tree nodes and
+   attaching type info and such.  */
+
+tree
+ffecom_expr (ffebld expr)
+{
+  return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, FALSE, FALSE);
+}
+
+/* Like ffecom_expr, but return tree usable for assigned GOTO or FORMAT.  */
+
+tree
+ffecom_expr_assign (ffebld expr)
+{
+  return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, TRUE, FALSE);
+}
+
+/* Like ffecom_expr_rw, but return tree usable for ASSIGN.  */
+
+tree
+ffecom_expr_assign_w (ffebld expr)
+{
+  return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, TRUE, FALSE);
+}
+
+/* Transform expr for use as into read/write tree and stabilize the
+   reference.  Not for use on CHARACTER expressions.
+
+   Recursive descent on expr while making corresponding tree nodes and
+   attaching type info and such.  */
+
+tree
+ffecom_expr_rw (tree type, ffebld expr)
+{
+  assert (expr != NULL);
+  /* Different target types not yet supported.  */
+  assert (type == NULL_TREE || type == ffecom_type_expr (expr));
+
+  return stabilize_reference (ffecom_expr (expr));
+}
+
+/* Transform expr for use as into write tree and stabilize the
+   reference.  Not for use on CHARACTER expressions.
+
+   Recursive descent on expr while making corresponding tree nodes and
+   attaching type info and such.  */
+
+tree
+ffecom_expr_w (tree type, ffebld expr)
+{
+  assert (expr != NULL);
+  /* Different target types not yet supported.  */
+  assert (type == NULL_TREE || type == ffecom_type_expr (expr));
+
+  return stabilize_reference (ffecom_expr (expr));
+}
+
+/* Do global stuff.  */
+
+void
+ffecom_finish_compile (void)
+{
+  assert (ffecom_outer_function_decl_ == NULL_TREE);
+  assert (current_function_decl == NULL_TREE);
+
+  ffeglobal_drive (ffecom_finish_global_);
+}
+
+/* Public entry point for front end to access finish_decl.  */
+
+void
+ffecom_finish_decl (tree decl, tree init, bool is_top_level)
+{
+  assert (!is_top_level);
+  finish_decl (decl, init, FALSE);
+}
+
+/* Finish a program unit.  */
+
+void
+ffecom_finish_progunit (void)
+{
+  ffecom_end_compstmt ();
+
+  ffecom_previous_function_decl_ = current_function_decl;
+  ffecom_which_entrypoint_decl_ = NULL_TREE;
+
+  finish_function (0);
+}
+
+/* Wrapper for get_identifier.  pattern is sprintf-like.  */
+
+tree
+ffecom_get_invented_identifier (const char *pattern, ...)
+{
+  tree decl;
+  char *nam;
+  va_list ap;
+
+  va_start (ap, pattern);
+  if (vasprintf (&nam, pattern, ap) == 0)
+    abort ();
+  va_end (ap);
+  decl = get_identifier (nam);
+  free (nam);
+  IDENTIFIER_INVENTED (decl) = 1;
+  return decl;
+}
+
+ffeinfoBasictype
+ffecom_gfrt_basictype (ffecomGfrt gfrt)
+{
+  assert (gfrt < FFECOM_gfrt);
+
+  switch (ffecom_gfrt_type_[gfrt])
+    {
+    case FFECOM_rttypeVOID_:
+    case FFECOM_rttypeVOIDSTAR_:
+      return FFEINFO_basictypeNONE;
+
+    case FFECOM_rttypeFTNINT_:
+      return FFEINFO_basictypeINTEGER;
+
+    case FFECOM_rttypeINTEGER_:
+      return FFEINFO_basictypeINTEGER;
+
+    case FFECOM_rttypeLONGINT_:
+      return FFEINFO_basictypeINTEGER;
+
+    case FFECOM_rttypeLOGICAL_:
+      return FFEINFO_basictypeLOGICAL;
+
+    case FFECOM_rttypeREAL_F2C_:
+    case FFECOM_rttypeREAL_GNU_:
+      return FFEINFO_basictypeREAL;
+
+    case FFECOM_rttypeCOMPLEX_F2C_:
+    case FFECOM_rttypeCOMPLEX_GNU_:
+      return FFEINFO_basictypeCOMPLEX;
+
+    case FFECOM_rttypeDOUBLE_:
+    case FFECOM_rttypeDOUBLEREAL_:
+      return FFEINFO_basictypeREAL;
+
+    case FFECOM_rttypeDBLCMPLX_F2C_:
+    case FFECOM_rttypeDBLCMPLX_GNU_:
+      return FFEINFO_basictypeCOMPLEX;
+
+    case FFECOM_rttypeCHARACTER_:
+      return FFEINFO_basictypeCHARACTER;
+
+    default:
+      return FFEINFO_basictypeANY;
+    }
+}
+
+ffeinfoKindtype
+ffecom_gfrt_kindtype (ffecomGfrt gfrt)
+{
+  assert (gfrt < FFECOM_gfrt);
+
+  switch (ffecom_gfrt_type_[gfrt])
+    {
+    case FFECOM_rttypeVOID_:
+    case FFECOM_rttypeVOIDSTAR_:
+      return FFEINFO_kindtypeNONE;
+
+    case FFECOM_rttypeFTNINT_:
+      return FFEINFO_kindtypeINTEGER1;
+
+    case FFECOM_rttypeINTEGER_:
+      return FFEINFO_kindtypeINTEGER1;
+
+    case FFECOM_rttypeLONGINT_:
+      return FFEINFO_kindtypeINTEGER4;
+
+    case FFECOM_rttypeLOGICAL_:
+      return FFEINFO_kindtypeLOGICAL1;
+
+    case FFECOM_rttypeREAL_F2C_:
+    case FFECOM_rttypeREAL_GNU_:
+      return FFEINFO_kindtypeREAL1;
+
+    case FFECOM_rttypeCOMPLEX_F2C_:
+    case FFECOM_rttypeCOMPLEX_GNU_:
+      return FFEINFO_kindtypeREAL1;
+
+    case FFECOM_rttypeDOUBLE_:
+    case FFECOM_rttypeDOUBLEREAL_:
+      return FFEINFO_kindtypeREAL2;
+
+    case FFECOM_rttypeDBLCMPLX_F2C_:
+    case FFECOM_rttypeDBLCMPLX_GNU_:
+      return FFEINFO_kindtypeREAL2;
+
+    case FFECOM_rttypeCHARACTER_:
+      return FFEINFO_kindtypeCHARACTER1;
+
+    default:
+      return FFEINFO_kindtypeANY;
+    }
+}
+
+void
+ffecom_init_0 (void)
+{
+  tree endlink;
+  int i;
+  int j;
+  tree t;
+  tree field;
+  ffetype type;
+  ffetype base_type;
+  tree double_ftype_double, double_ftype_double_double;
+  tree float_ftype_float, float_ftype_float_float;
+  tree ldouble_ftype_ldouble, ldouble_ftype_ldouble_ldouble;
+  tree ffecom_tree_ptr_to_fun_type_void;
+
+  /* This block of code comes from the now-obsolete cktyps.c.  It checks
+     whether the compiler environment is buggy in known ways, some of which
+     would, if not explicitly checked here, result in subtle bugs in g77.  */
+
+  if (ffe_is_do_internal_checks ())
+    {
+      static const char names[][12]
+	=
+      {"bar", "bletch", "foo", "foobar"};
+      const char *name;
+      unsigned long ul;
+      double fl;
+
+      name = bsearch ("foo", &names[0], ARRAY_SIZE (names), sizeof (names[0]),
+		      (int (*)(const void *, const void *)) strcmp);
+      if (name != &names[2][0])
+	{
+	  assert ("bsearch doesn't work, #define FFEPROJ_BSEARCH 0 in proj.h"
+		  == NULL);
+	  abort ();
+	}
+
+      ul = strtoul ("123456789", NULL, 10);
+      if (ul != 123456789L)
+	{
+	  assert ("strtoul doesn't have enough range, #define FFEPROJ_STRTOUL 0\
+ in proj.h" == NULL);
+	  abort ();
+	}
+
+      fl = atof ("56.789");
+      if ((fl < 56.788) || (fl > 56.79))
+	{
+	  assert ("atof not type double, fix your #include <stdio.h>"
+		  == NULL);
+	  abort ();
+	}
+    }
+
+  ffecom_outer_function_decl_ = NULL_TREE;
+  current_function_decl = NULL_TREE;
+  named_labels = NULL_TREE;
+  current_binding_level = NULL_BINDING_LEVEL;
+  free_binding_level = NULL_BINDING_LEVEL;
+  /* Make the binding_level structure for global names.  */
+  pushlevel (0);
+  global_binding_level = current_binding_level;
+  current_binding_level->prep_state = 2;
+
+  build_common_tree_nodes (1);
+
+  /* Define `int' and `char' first so that dbx will output them first.  */
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("int"),
+			integer_type_node));
+  /* CHARACTER*1 is unsigned in ICHAR contexts.  */
+  char_type_node = make_unsigned_type (CHAR_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("char"),
+			char_type_node));
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("long int"),
+			long_integer_type_node));
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned int"),
+			unsigned_type_node));
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("long unsigned int"),
+			long_unsigned_type_node));
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("long long int"),
+			long_long_integer_type_node));
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("long long unsigned int"),
+			long_long_unsigned_type_node));
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("short int"),
+			short_integer_type_node));
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("short unsigned int"),
+			short_unsigned_type_node));
+
+  /* Set the sizetype before we make other types.  This *should* be the
+     first type we create.  */
+
+  set_sizetype
+    (TREE_TYPE (IDENTIFIER_GLOBAL_VALUE (get_identifier (SIZE_TYPE))));
+  ffecom_typesize_pointer_
+    = TREE_INT_CST_LOW (TYPE_SIZE (sizetype)) / BITS_PER_UNIT;
+
+  build_common_tree_nodes_2 (0);
+
+  /* Define both `signed char' and `unsigned char'.  */
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("signed char"),
+			signed_char_type_node));
+
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"),
+			unsigned_char_type_node));
+
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("float"),
+			float_type_node));
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("double"),
+			double_type_node));
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("long double"),
+			long_double_type_node));
+
+  /* For now, override what build_common_tree_nodes has done.  */
+  complex_integer_type_node = ffecom_make_complex_type_ (integer_type_node);
+  complex_float_type_node = ffecom_make_complex_type_ (float_type_node);
+  complex_double_type_node = ffecom_make_complex_type_ (double_type_node);
+  complex_long_double_type_node
+    = ffecom_make_complex_type_ (long_double_type_node);
+
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("complex int"),
+			complex_integer_type_node));
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("complex float"),
+			complex_float_type_node));
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("complex double"),
+			complex_double_type_node));
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("complex long double"),
+			complex_long_double_type_node));
+
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("void"),
+			void_type_node));
+  /* We are not going to have real types in C with less than byte alignment,
+     so we might as well not have any types that claim to have it.  */
+  TYPE_ALIGN (void_type_node) = BITS_PER_UNIT;
+  TYPE_USER_ALIGN (void_type_node) = 0;
+
+  string_type_node = build_pointer_type (char_type_node);
+
+  ffecom_tree_fun_type_void
+    = build_function_type (void_type_node, NULL_TREE);
+
+  ffecom_tree_ptr_to_fun_type_void
+    = build_pointer_type (ffecom_tree_fun_type_void);
+
+  endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
+
+  t = tree_cons (NULL_TREE, float_type_node, endlink);
+  float_ftype_float = build_function_type (float_type_node, t);
+  t = tree_cons (NULL_TREE, float_type_node, t);
+  float_ftype_float_float = build_function_type (float_type_node, t);
+
+  t = tree_cons (NULL_TREE, double_type_node, endlink);
+  double_ftype_double = build_function_type (double_type_node, t);
+  t = tree_cons (NULL_TREE, double_type_node, t);
+  double_ftype_double_double = build_function_type (double_type_node, t);
+
+  t = tree_cons (NULL_TREE, long_double_type_node, endlink);
+  ldouble_ftype_ldouble = build_function_type (long_double_type_node, t);
+  t = tree_cons (NULL_TREE, long_double_type_node, t);
+  ldouble_ftype_ldouble_ldouble = build_function_type (long_double_type_node,
+                                                       t);
+
+  for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i)
+    for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j)
+      {
+	ffecom_tree_type[i][j] = NULL_TREE;
+	ffecom_tree_fun_type[i][j] = NULL_TREE;
+	ffecom_tree_ptr_to_fun_type[i][j] = NULL_TREE;
+	ffecom_f2c_typecode_[i][j] = -1;
+      }
+
+  /* Set up standard g77 types.  Note that INTEGER and LOGICAL are set
+     to size FLOAT_TYPE_SIZE because they have to be the same size as
+     REAL, which also is FLOAT_TYPE_SIZE, according to the standard.
+     Compiler options and other such stuff that change the ways these
+     types are set should not affect this particular setup.  */
+
+  ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER1]
+    = t = make_signed_type (FLOAT_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("integer"),
+			t));
+  type = ffetype_new ();
+  base_type = type;
+  ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER1,
+		    type);
+  ffetype_set_ams (type,
+		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+  ffetype_set_star (base_type,
+		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+		    type);
+  ffetype_set_kind (base_type, 1, type);
+  ffecom_typesize_integer1_ = ffetype_size (type);
+  assert (ffetype_size (type) == sizeof (ffetargetInteger1));
+
+  ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER1]
+    = t = make_unsigned_type (FLOAT_TYPE_SIZE);	/* HOLLERITH means unsigned. */
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned"),
+			t));
+
+  ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER2]
+    = t = make_signed_type (CHAR_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("byte"),
+			t));
+  type = ffetype_new ();
+  ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER2,
+		    type);
+  ffetype_set_ams (type,
+		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+  ffetype_set_star (base_type,
+		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+		    type);
+  ffetype_set_kind (base_type, 3, type);
+  assert (ffetype_size (type) == sizeof (ffetargetInteger2));
+
+  ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER2]
+    = t = make_unsigned_type (CHAR_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned byte"),
+			t));
+
+  ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER3]
+    = t = make_signed_type (CHAR_TYPE_SIZE * 2);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("word"),
+			t));
+  type = ffetype_new ();
+  ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER3,
+		    type);
+  ffetype_set_ams (type,
+		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+  ffetype_set_star (base_type,
+		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+		    type);
+  ffetype_set_kind (base_type, 6, type);
+  assert (ffetype_size (type) == sizeof (ffetargetInteger3));
+
+  ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER3]
+    = t = make_unsigned_type (CHAR_TYPE_SIZE * 2);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned word"),
+			t));
+
+  ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER4]
+    = t = make_signed_type (FLOAT_TYPE_SIZE * 2);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("integer4"),
+			t));
+  type = ffetype_new ();
+  ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER4,
+		    type);
+  ffetype_set_ams (type,
+		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+  ffetype_set_star (base_type,
+		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+		    type);
+  ffetype_set_kind (base_type, 2, type);
+  assert (ffetype_size (type) == sizeof (ffetargetInteger4));
+
+  ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER4]
+    = t = make_unsigned_type (FLOAT_TYPE_SIZE * 2);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned4"),
+			t));
+
+#if 0
+  if (ffe_is_do_internal_checks ()
+      && LONG_TYPE_SIZE != FLOAT_TYPE_SIZE
+      && LONG_TYPE_SIZE != CHAR_TYPE_SIZE
+      && LONG_TYPE_SIZE != SHORT_TYPE_SIZE
+      && LONG_TYPE_SIZE != LONG_LONG_TYPE_SIZE)
+    {
+      fprintf (stderr, "Sorry, no g77 support for LONG_TYPE_SIZE (%d bits) yet.\n",
+	       LONG_TYPE_SIZE);
+    }
+#endif
+
+  ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL1]
+    = t = make_signed_type (FLOAT_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("logical"),
+			t));
+  type = ffetype_new ();
+  base_type = type;
+  ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL1,
+		    type);
+  ffetype_set_ams (type,
+		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+  ffetype_set_star (base_type,
+		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+		    type);
+  ffetype_set_kind (base_type, 1, type);
+  assert (ffetype_size (type) == sizeof (ffetargetLogical1));
+
+  ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL2]
+    = t = make_signed_type (CHAR_TYPE_SIZE);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("logical2"),
+			t));
+  type = ffetype_new ();
+  ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL2,
+		    type);
+  ffetype_set_ams (type,
+		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+  ffetype_set_star (base_type,
+		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+		    type);
+  ffetype_set_kind (base_type, 3, type);
+  assert (ffetype_size (type) == sizeof (ffetargetLogical2));
+
+  ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL3]
+    = t = make_signed_type (CHAR_TYPE_SIZE * 2);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("logical3"),
+			t));
+  type = ffetype_new ();
+  ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL3,
+		    type);
+  ffetype_set_ams (type,
+		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+  ffetype_set_star (base_type,
+		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+		    type);
+  ffetype_set_kind (base_type, 6, type);
+  assert (ffetype_size (type) == sizeof (ffetargetLogical3));
+
+  ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL4]
+    = t = make_signed_type (FLOAT_TYPE_SIZE * 2);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("logical4"),
+			t));
+  type = ffetype_new ();
+  ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL4,
+		    type);
+  ffetype_set_ams (type,
+		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+  ffetype_set_star (base_type,
+		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+		    type);
+  ffetype_set_kind (base_type, 2, type);
+  assert (ffetype_size (type) == sizeof (ffetargetLogical4));
+
+  ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1]
+    = t = make_node (REAL_TYPE);
+  TYPE_PRECISION (t) = FLOAT_TYPE_SIZE;
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("real"),
+			t));
+  layout_type (t);
+  type = ffetype_new ();
+  base_type = type;
+  ffeinfo_set_type (FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL1,
+		    type);
+  ffetype_set_ams (type,
+		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+  ffetype_set_star (base_type,
+		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+		    type);
+  ffetype_set_kind (base_type, 1, type);
+  ffecom_f2c_typecode_[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1]
+    = FFETARGET_f2cTYREAL;
+  assert (ffetype_size (type) == sizeof (ffetargetReal1));
+
+  ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREALDOUBLE]
+    = t = make_node (REAL_TYPE);
+  TYPE_PRECISION (t) = FLOAT_TYPE_SIZE * 2;	/* Always twice REAL. */
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("double precision"),
+			t));
+  layout_type (t);
+  type = ffetype_new ();
+  ffeinfo_set_type (FFEINFO_basictypeREAL, FFEINFO_kindtypeREALDOUBLE,
+		    type);
+  ffetype_set_ams (type,
+		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+  ffetype_set_star (base_type,
+		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+		    type);
+  ffetype_set_kind (base_type, 2, type);
+  ffecom_f2c_typecode_[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL2]
+    = FFETARGET_f2cTYDREAL;
+  assert (ffetype_size (type) == sizeof (ffetargetReal2));
+
+  ffecom_tree_type[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREAL1]
+    = t = ffecom_make_complex_type_ (ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1]);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("complex"),
+			t));
+  type = ffetype_new ();
+  base_type = type;
+  ffeinfo_set_type (FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL1,
+		    type);
+  ffetype_set_ams (type,
+		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+  ffetype_set_star (base_type,
+		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+		    type);
+  ffetype_set_kind (base_type, 1, type);
+  ffecom_f2c_typecode_[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREAL1]
+    = FFETARGET_f2cTYCOMPLEX;
+  assert (ffetype_size (type) == sizeof (ffetargetComplex1));
+
+  ffecom_tree_type[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREALDOUBLE]
+    = t = ffecom_make_complex_type_ (ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL2]);
+  pushdecl (build_decl (TYPE_DECL, get_identifier ("double complex"),
+			t));
+  type = ffetype_new ();
+  ffeinfo_set_type (FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREALDOUBLE,
+		    type);
+  ffetype_set_ams (type,
+		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+  ffetype_set_star (base_type,
+		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
+		    type);
+  ffetype_set_kind (base_type, 2,
+		    type);
+  ffecom_f2c_typecode_[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREAL2]
+    = FFETARGET_f2cTYDCOMPLEX;
+  assert (ffetype_size (type) == sizeof (ffetargetComplex2));
+
+  /* Make function and ptr-to-function types for non-CHARACTER types. */
+
+  for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i)
+    for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j)
+      {
+	if ((t = ffecom_tree_type[i][j]) != NULL_TREE)
+	  {
+	    if (i == FFEINFO_basictypeINTEGER)
+	      {
+		/* Figure out the smallest INTEGER type that can hold
+		   a pointer on this machine. */
+		if (GET_MODE_SIZE (TYPE_MODE (t))
+		    >= GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
+		  {
+		    if ((ffecom_pointer_kind_ == FFEINFO_kindtypeNONE)
+			|| (GET_MODE_SIZE (TYPE_MODE (ffecom_tree_type[i][ffecom_pointer_kind_]))
+			    > GET_MODE_SIZE (TYPE_MODE (t))))
+		      ffecom_pointer_kind_ = j;
+		  }
+	      }
+	    else if (i == FFEINFO_basictypeCOMPLEX)
+	      t = void_type_node;
+	    /* For f2c compatibility, REAL functions are really
+	       implemented as DOUBLE PRECISION.  */
+	    else if ((i == FFEINFO_basictypeREAL)
+		     && (j == FFEINFO_kindtypeREAL1))
+	      t = ffecom_tree_type
+		[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL2];
+
+	    t = ffecom_tree_fun_type[i][j] = build_function_type (t,
+								  NULL_TREE);
+	    ffecom_tree_ptr_to_fun_type[i][j] = build_pointer_type (t);
+	  }
+      }
+
+  /* Set up pointer types.  */
+
+  if (ffecom_pointer_kind_ == FFEINFO_basictypeNONE)
+    fatal_error ("no INTEGER type can hold a pointer on this configuration");
+  else if (0 && ffe_is_do_internal_checks ())
+    fprintf (stderr, "Pointer type kt=%d\n", ffecom_pointer_kind_);
+  ffetype_set_kind (ffeinfo_type (FFEINFO_basictypeINTEGER,
+				  FFEINFO_kindtypeINTEGERDEFAULT),
+		    7,
+		    ffeinfo_type (FFEINFO_basictypeINTEGER,
+				  ffecom_pointer_kind_));
+
+  if (ffe_is_ugly_assign ())
+    ffecom_label_kind_ = ffecom_pointer_kind_;	/* Require ASSIGN etc to this. */
+  else
+    ffecom_label_kind_ = FFEINFO_kindtypeINTEGERDEFAULT;
+  if (0 && ffe_is_do_internal_checks ())
+    fprintf (stderr, "Label type kt=%d\n", ffecom_label_kind_);
+
+  ffecom_integer_type_node
+    = ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER1];
+  ffecom_integer_zero_node = convert (ffecom_integer_type_node,
+				      integer_zero_node);
+  ffecom_integer_one_node = convert (ffecom_integer_type_node,
+				     integer_one_node);
+
+  /* Yes, the "FLOAT_TYPE_SIZE" references below are intentional.
+     Turns out that by TYLONG, runtime/libI77/lio.h really means
+     "whatever size an ftnint is".  For consistency and sanity,
+     com.h and runtime/f2c.h.in agree that flag, ftnint, and ftlen
+     all are INTEGER, which we also make out of whatever back-end
+     integer type is FLOAT_TYPE_SIZE bits wide.  This change, from
+     LONG_TYPE_SIZE, for TYLONG and TYLOGICAL, was necessary to
+     accommodate machines like the Alpha.  Note that this suggests
+     f2c and libf2c are missing a distinction perhaps needed on
+     some machines between "int" and "long int".  -- burley 0.5.5 950215 */
+
+  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, FLOAT_TYPE_SIZE,
+			    FFETARGET_f2cTYLONG);
+  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, SHORT_TYPE_SIZE,
+			    FFETARGET_f2cTYSHORT);
+  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, CHAR_TYPE_SIZE,
+			    FFETARGET_f2cTYINT1);
+  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, LONG_LONG_TYPE_SIZE,
+			    FFETARGET_f2cTYQUAD);
+  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, FLOAT_TYPE_SIZE,
+			    FFETARGET_f2cTYLOGICAL);
+  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, SHORT_TYPE_SIZE,
+			    FFETARGET_f2cTYLOGICAL2);
+  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, CHAR_TYPE_SIZE,
+			    FFETARGET_f2cTYLOGICAL1);
+  /* ~~~Not really such a type in libf2c, e.g. I/O support?  */
+  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, LONG_LONG_TYPE_SIZE,
+			    FFETARGET_f2cTYQUAD);
+
+  /* CHARACTER stuff is all special-cased, so it is not handled in the above
+     loop.  CHARACTER items are built as arrays of unsigned char.  */
+
+  ffecom_tree_type[FFEINFO_basictypeCHARACTER]
+    [FFEINFO_kindtypeCHARACTER1] = t = char_type_node;
+  type = ffetype_new ();
+  base_type = type;
+  ffeinfo_set_type (FFEINFO_basictypeCHARACTER,
+		    FFEINFO_kindtypeCHARACTER1,
+		    type);
+  ffetype_set_ams (type,
+		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
+		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
+  ffetype_set_kind (base_type, 1, type);
+  assert (ffetype_size (type)
+	  == sizeof (((ffetargetCharacter1) { 0, NULL }).text[0]));
+
+  ffecom_tree_fun_type[FFEINFO_basictypeCHARACTER]
+    [FFEINFO_kindtypeCHARACTER1] = ffecom_tree_fun_type_void;
+  ffecom_tree_ptr_to_fun_type[FFEINFO_basictypeCHARACTER]
+    [FFEINFO_kindtypeCHARACTER1]
+    = ffecom_tree_ptr_to_fun_type_void;
+  ffecom_f2c_typecode_[FFEINFO_basictypeCHARACTER][FFEINFO_kindtypeCHARACTER1]
+    = FFETARGET_f2cTYCHAR;
+
+  ffecom_f2c_typecode_[FFEINFO_basictypeANY][FFEINFO_kindtypeANY]
+    = 0;
+
+  /* Make multi-return-value type and fields. */
+
+  ffecom_multi_type_node_ = make_node (UNION_TYPE);
+
+  field = NULL_TREE;
+
+  for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i)
+    for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j)
+      {
+	char name[30];
+
+	if (ffecom_tree_type[i][j] == NULL_TREE)
+	  continue;		/* Not supported. */
+	sprintf (&name[0], "bt_%s_kt_%s",
+		 ffeinfo_basictype_string ((ffeinfoBasictype) i),
+		 ffeinfo_kindtype_string ((ffeinfoKindtype) j));
+	ffecom_multi_fields_[i][j] = build_decl (FIELD_DECL,
+						 get_identifier (name),
+						 ffecom_tree_type[i][j]);
+	DECL_CONTEXT (ffecom_multi_fields_[i][j])
+	  = ffecom_multi_type_node_;
+	DECL_ALIGN (ffecom_multi_fields_[i][j]) = 0;
+	DECL_USER_ALIGN (ffecom_multi_fields_[i][j]) = 0;
+	TREE_CHAIN (ffecom_multi_fields_[i][j]) = field;
+	field = ffecom_multi_fields_[i][j];
+      }
+
+  TYPE_FIELDS (ffecom_multi_type_node_) = field;
+  layout_type (ffecom_multi_type_node_);
+
+  /* Subroutines usually return integer because they might have alternate
+     returns. */
+
+  ffecom_tree_subr_type
+    = build_function_type (integer_type_node, NULL_TREE);
+  ffecom_tree_ptr_to_subr_type
+    = build_pointer_type (ffecom_tree_subr_type);
+  ffecom_tree_blockdata_type
+    = build_function_type (void_type_node, NULL_TREE);
+
+  builtin_function ("__builtin_atanf", float_ftype_float,
+		    BUILT_IN_ATANF, BUILT_IN_NORMAL, "atanf", NULL_TREE);
+  builtin_function ("__builtin_atan", double_ftype_double,
+		    BUILT_IN_ATAN, BUILT_IN_NORMAL, "atan", NULL_TREE);
+  builtin_function ("__builtin_atanl", ldouble_ftype_ldouble,
+		    BUILT_IN_ATANL, BUILT_IN_NORMAL, "atanl", NULL_TREE);
+
+  builtin_function ("__builtin_atan2f", float_ftype_float_float,
+		    BUILT_IN_ATAN2F, BUILT_IN_NORMAL, "atan2f", NULL_TREE);
+  builtin_function ("__builtin_atan2", double_ftype_double_double,
+		    BUILT_IN_ATAN2, BUILT_IN_NORMAL, "atan2", NULL_TREE);
+  builtin_function ("__builtin_atan2l", ldouble_ftype_ldouble_ldouble,
+		    BUILT_IN_ATAN2L, BUILT_IN_NORMAL, "atan2l", NULL_TREE);
+
+  builtin_function ("__builtin_cosf", float_ftype_float,
+		    BUILT_IN_COSF, BUILT_IN_NORMAL, "cosf", NULL_TREE);
+  builtin_function ("__builtin_cos", double_ftype_double,
+		    BUILT_IN_COS, BUILT_IN_NORMAL, "cos", NULL_TREE);
+  builtin_function ("__builtin_cosl", ldouble_ftype_ldouble,
+		    BUILT_IN_COSL, BUILT_IN_NORMAL, "cosl", NULL_TREE);
+
+  builtin_function ("__builtin_expf", float_ftype_float,
+		    BUILT_IN_EXPF, BUILT_IN_NORMAL, "expf", NULL_TREE);
+  builtin_function ("__builtin_exp", double_ftype_double,
+		    BUILT_IN_EXP, BUILT_IN_NORMAL, "exp", NULL_TREE);
+  builtin_function ("__builtin_expl", ldouble_ftype_ldouble,
+		    BUILT_IN_EXPL, BUILT_IN_NORMAL, "expl", NULL_TREE);
+
+  builtin_function ("__builtin_floorf", float_ftype_float,
+		    BUILT_IN_FLOORF, BUILT_IN_NORMAL, "floorf", NULL_TREE);
+  builtin_function ("__builtin_floor", double_ftype_double,
+		    BUILT_IN_FLOOR, BUILT_IN_NORMAL, "floor", NULL_TREE);
+  builtin_function ("__builtin_floorl", ldouble_ftype_ldouble,
+		    BUILT_IN_FLOORL, BUILT_IN_NORMAL, "floorl", NULL_TREE);
+
+  builtin_function ("__builtin_fmodf", float_ftype_float_float,
+		    BUILT_IN_FMODF, BUILT_IN_NORMAL, "fmodf", NULL_TREE);
+  builtin_function ("__builtin_fmod", double_ftype_double_double,
+		    BUILT_IN_FMOD, BUILT_IN_NORMAL, "fmod", NULL_TREE);
+  builtin_function ("__builtin_fmodl", ldouble_ftype_ldouble_ldouble,
+		    BUILT_IN_FMODL, BUILT_IN_NORMAL, "fmodl", NULL_TREE);
+
+  builtin_function ("__builtin_logf", float_ftype_float,
+		    BUILT_IN_LOGF, BUILT_IN_NORMAL, "logf", NULL_TREE);
+  builtin_function ("__builtin_log", double_ftype_double,
+		    BUILT_IN_LOG, BUILT_IN_NORMAL, "log", NULL_TREE);
+  builtin_function ("__builtin_logl", ldouble_ftype_ldouble,
+		    BUILT_IN_LOGL, BUILT_IN_NORMAL, "logl", NULL_TREE);
+
+  builtin_function ("__builtin_powf", float_ftype_float_float,
+		    BUILT_IN_POWF, BUILT_IN_NORMAL, "powf", NULL_TREE);
+  builtin_function ("__builtin_pow", double_ftype_double_double,
+		    BUILT_IN_POW, BUILT_IN_NORMAL, "pow", NULL_TREE);
+  builtin_function ("__builtin_powl", ldouble_ftype_ldouble_ldouble,
+		    BUILT_IN_POWL, BUILT_IN_NORMAL, "powl", NULL_TREE);
+
+  builtin_function ("__builtin_sinf", float_ftype_float,
+		    BUILT_IN_SINF, BUILT_IN_NORMAL, "sinf", NULL_TREE);
+  builtin_function ("__builtin_sin", double_ftype_double,
+		    BUILT_IN_SIN, BUILT_IN_NORMAL, "sin", NULL_TREE);
+  builtin_function ("__builtin_sinl", ldouble_ftype_ldouble,
+		    BUILT_IN_SINL, BUILT_IN_NORMAL, "sinl", NULL_TREE);
+
+  builtin_function ("__builtin_sqrtf", float_ftype_float,
+		    BUILT_IN_SQRTF, BUILT_IN_NORMAL, "sqrtf", NULL_TREE);
+  builtin_function ("__builtin_sqrt", double_ftype_double,
+		    BUILT_IN_SQRT, BUILT_IN_NORMAL, "sqrt", NULL_TREE);
+  builtin_function ("__builtin_sqrtl", ldouble_ftype_ldouble,
+		    BUILT_IN_SQRTL, BUILT_IN_NORMAL, "sqrtl", NULL_TREE);
+
+  builtin_function ("__builtin_tanf", float_ftype_float,
+		    BUILT_IN_TANF, BUILT_IN_NORMAL, "tanf", NULL_TREE);
+  builtin_function ("__builtin_tan", double_ftype_double,
+		    BUILT_IN_TAN, BUILT_IN_NORMAL, "tan", NULL_TREE);
+  builtin_function ("__builtin_tanl", ldouble_ftype_ldouble,
+		    BUILT_IN_TANL, BUILT_IN_NORMAL, "tanl", NULL_TREE);
+
+  pedantic_lvalues = FALSE;
+
+  ffecom_f2c_make_type_ (&ffecom_f2c_integer_type_node,
+			 FFECOM_f2cINTEGER,
+			 "integer");
+  ffecom_f2c_make_type_ (&ffecom_f2c_address_type_node,
+			 FFECOM_f2cADDRESS,
+			 "address");
+  ffecom_f2c_make_type_ (&ffecom_f2c_real_type_node,
+			 FFECOM_f2cREAL,
+			 "real");
+  ffecom_f2c_make_type_ (&ffecom_f2c_doublereal_type_node,
+			 FFECOM_f2cDOUBLEREAL,
+			 "doublereal");
+  ffecom_f2c_make_type_ (&ffecom_f2c_complex_type_node,
+			 FFECOM_f2cCOMPLEX,
+			 "complex");
+  ffecom_f2c_make_type_ (&ffecom_f2c_doublecomplex_type_node,
+			 FFECOM_f2cDOUBLECOMPLEX,
+			 "doublecomplex");
+  ffecom_f2c_make_type_ (&ffecom_f2c_longint_type_node,
+			 FFECOM_f2cLONGINT,
+			 "longint");
+  ffecom_f2c_make_type_ (&ffecom_f2c_logical_type_node,
+			 FFECOM_f2cLOGICAL,
+			 "logical");
+  ffecom_f2c_make_type_ (&ffecom_f2c_flag_type_node,
+			 FFECOM_f2cFLAG,
+			 "flag");
+  ffecom_f2c_make_type_ (&ffecom_f2c_ftnlen_type_node,
+			 FFECOM_f2cFTNLEN,
+			 "ftnlen");
+  ffecom_f2c_make_type_ (&ffecom_f2c_ftnint_type_node,
+			 FFECOM_f2cFTNINT,
+			 "ftnint");
+
+  ffecom_f2c_ftnlen_zero_node
+    = convert (ffecom_f2c_ftnlen_type_node, integer_zero_node);
+
+  ffecom_f2c_ftnlen_one_node
+    = convert (ffecom_f2c_ftnlen_type_node, integer_one_node);
+
+  ffecom_f2c_ftnlen_two_node = build_int_2 (2, 0);
+  TREE_TYPE (ffecom_f2c_ftnlen_two_node) = ffecom_integer_type_node;
+
+  ffecom_f2c_ptr_to_ftnlen_type_node
+    = build_pointer_type (ffecom_f2c_ftnlen_type_node);
+
+  ffecom_f2c_ptr_to_ftnint_type_node
+    = build_pointer_type (ffecom_f2c_ftnint_type_node);
+
+  ffecom_f2c_ptr_to_integer_type_node
+    = build_pointer_type (ffecom_f2c_integer_type_node);
+
+  ffecom_f2c_ptr_to_real_type_node
+    = build_pointer_type (ffecom_f2c_real_type_node);
+
+  ffecom_float_zero_ = build_real (float_type_node, dconst0);
+  ffecom_double_zero_ = build_real (double_type_node, dconst0);
+  ffecom_float_half_ = build_real (float_type_node, dconsthalf);
+  ffecom_double_half_ = build_real (double_type_node, dconsthalf);
+
+  /* Do "extern int xargc;".  */
+
+  ffecom_tree_xargc_ = build_decl (VAR_DECL,
+				   get_identifier ("f__xargc"),
+				   integer_type_node);
+  DECL_EXTERNAL (ffecom_tree_xargc_) = 1;
+  TREE_STATIC (ffecom_tree_xargc_) = 1;
+  TREE_PUBLIC (ffecom_tree_xargc_) = 1;
+  ffecom_tree_xargc_ = start_decl (ffecom_tree_xargc_, FALSE);
+  finish_decl (ffecom_tree_xargc_, NULL_TREE, FALSE);
+
+#if 0	/* This is being fixed, and seems to be working now. */
+  if ((FLOAT_TYPE_SIZE != 32)
+      || (TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (null_pointer_node))) != 32))
+    {
+      warning ("configuration: REAL, INTEGER, and LOGICAL are %d bits wide,",
+	       (int) FLOAT_TYPE_SIZE);
+      warning ("and pointers are %d bits wide, but g77 doesn't yet work",
+	  (int) TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (null_pointer_node))));
+      warning ("properly unless they all are 32 bits wide");
+      warning ("Please keep this in mind before you report bugs.");
+    }
+#endif
+
+#if 0	/* Code in ste.c that would crash has been commented out. */
+  if (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node)
+      < TYPE_PRECISION (string_type_node))
+    /* I/O will probably crash.  */
+    warning ("configuration: char * holds %d bits, but ftnlen only %d",
+	     TYPE_PRECISION (string_type_node),
+	     TYPE_PRECISION (ffecom_f2c_ftnlen_type_node));
+#endif
+
+#if 0	/* ASSIGN-related stuff has been changed to accommodate this. */
+  if (TYPE_PRECISION (ffecom_integer_type_node)
+      < TYPE_PRECISION (string_type_node))
+    /* ASSIGN 10 TO I will crash.  */
+    warning ("configuration: char * holds %d bits, but INTEGER only %d --\n\
+ ASSIGN statement might fail",
+	     TYPE_PRECISION (string_type_node),
+	     TYPE_PRECISION (ffecom_integer_type_node));
+#endif
+}
+
+/* ffecom_init_2 -- Initialize
+
+   ffecom_init_2();  */
+
+void
+ffecom_init_2 (void)
+{
+  assert (ffecom_outer_function_decl_ == NULL_TREE);
+  assert (current_function_decl == NULL_TREE);
+  assert (ffecom_which_entrypoint_decl_ == NULL_TREE);
+
+  ffecom_master_arglist_ = NULL;
+  ++ffecom_num_fns_;
+  ffecom_primary_entry_ = NULL;
+  ffecom_is_altreturning_ = FALSE;
+  ffecom_func_result_ = NULL_TREE;
+  ffecom_multi_retval_ = NULL_TREE;
+}
+
+/* ffecom_list_expr -- Transform list of exprs into gcc tree
+
+   tree t;
+   ffebld expr;	 // FFE opITEM list.
+   tree = ffecom_list_expr(expr);
+
+   List of actual args is transformed into corresponding gcc backend list.  */
+
+tree
+ffecom_list_expr (ffebld expr)
+{
+  tree list;
+  tree *plist = &list;
+  tree trail = NULL_TREE;	/* Append char length args here. */
+  tree *ptrail = &trail;
+  tree length;
+
+  while (expr != NULL)
+    {
+      tree texpr = ffecom_arg_expr (ffebld_head (expr), &length);
+
+      if (texpr == error_mark_node)
+	return error_mark_node;
+
+      *plist = build_tree_list (NULL_TREE, texpr);
+      plist = &TREE_CHAIN (*plist);
+      expr = ffebld_trail (expr);
+      if (length != NULL_TREE)
+	{
+	  *ptrail = build_tree_list (NULL_TREE, length);
+	  ptrail = &TREE_CHAIN (*ptrail);
+	}
+    }
+
+  *plist = trail;
+
+  return list;
+}
+
+/* ffecom_list_ptr_to_expr -- Transform list of exprs into gcc tree
+
+   tree t;
+   ffebld expr;	 // FFE opITEM list.
+   tree = ffecom_list_ptr_to_expr(expr);
+
+   List of actual args is transformed into corresponding gcc backend list for
+   use in calling an external procedure (vs. a statement function).  */
+
+tree
+ffecom_list_ptr_to_expr (ffebld expr)
+{
+  tree list;
+  tree *plist = &list;
+  tree trail = NULL_TREE;	/* Append char length args here. */
+  tree *ptrail = &trail;
+  tree length;
+
+  while (expr != NULL)
+    {
+      tree texpr = ffecom_arg_ptr_to_expr (ffebld_head (expr), &length);
+
+      if (texpr == error_mark_node)
+	return error_mark_node;
+
+      *plist = build_tree_list (NULL_TREE, texpr);
+      plist = &TREE_CHAIN (*plist);
+      expr = ffebld_trail (expr);
+      if (length != NULL_TREE)
+	{
+	  *ptrail = build_tree_list (NULL_TREE, length);
+	  ptrail = &TREE_CHAIN (*ptrail);
+	}
+    }
+
+  *plist = trail;
+
+  return list;
+}
+
+/* Obtain gcc's LABEL_DECL tree for label.  */
+
+tree
+ffecom_lookup_label (ffelab label)
+{
+  tree glabel;
+
+  if (ffelab_hook (label) == NULL_TREE)
+    {
+      char labelname[16];
+
+      switch (ffelab_type (label))
+	{
+	case FFELAB_typeLOOPEND:
+	case FFELAB_typeNOTLOOP:
+	case FFELAB_typeENDIF:
+	  sprintf (labelname, "%" ffelabValue_f "u", ffelab_value (label));
+	  glabel = build_decl (LABEL_DECL, get_identifier (labelname),
+			       void_type_node);
+	  DECL_CONTEXT (glabel) = current_function_decl;
+	  DECL_MODE (glabel) = VOIDmode;
+	  break;
+
+	case FFELAB_typeFORMAT:
+	  glabel = build_decl (VAR_DECL,
+			       ffecom_get_invented_identifier
+			       ("__g77_format_%d", (int) ffelab_value (label)),
+			       build_type_variant (build_array_type
+						   (char_type_node,
+						    NULL_TREE),
+						   1, 0));
+	  TREE_CONSTANT (glabel) = 1;
+	  TREE_STATIC (glabel) = 1;
+	  DECL_CONTEXT (glabel) = current_function_decl;
+	  DECL_INITIAL (glabel) = NULL;
+	  make_decl_rtl (glabel, NULL);
+	  expand_decl (glabel);
+
+	  ffecom_save_tree_forever (glabel);
+
+	  break;
+
+	case FFELAB_typeANY:
+	  glabel = error_mark_node;
+	  break;
+
+	default:
+	  assert ("bad label type" == NULL);
+	  glabel = NULL;
+	  break;
+	}
+      ffelab_set_hook (label, glabel);
+    }
+  else
+    {
+      glabel = ffelab_hook (label);
+    }
+
+  return glabel;
+}
+
+/* Stabilizes the arguments.  Don't use this if the lhs and rhs come from
+   a single source specification (as in the fourth argument of MVBITS).
+   If the type is NULL_TREE, the type of lhs is used to make the type of
+   the MODIFY_EXPR.  */
+
+tree
+ffecom_modify (tree newtype, tree lhs, tree rhs)
+{
+  if (lhs == error_mark_node || rhs == error_mark_node)
+    return error_mark_node;
+
+  if (newtype == NULL_TREE)
+    newtype = TREE_TYPE (lhs);
+
+  if (TREE_SIDE_EFFECTS (lhs))
+    lhs = stabilize_reference (lhs);
+
+  return ffecom_2s (MODIFY_EXPR, newtype, lhs, rhs);
+}
+
+/* Register source file name.  */
+
+void
+ffecom_file (const char *name)
+{
+  ffecom_file_ (name);
+}
+
+/* ffecom_notify_init_storage -- An aggregate storage is now fully init'ed
+
+   ffestorag st;
+   ffecom_notify_init_storage(st);
+
+   Gets called when all possible units in an aggregate storage area (a LOCAL
+   with equivalences or a COMMON) have been initialized.  The initialization
+   info either is in ffestorag_init or, if that is NULL,
+   ffestorag_accretion:
+
+   ffestorag_init may contain an opCONTER or opARRTER.	opCONTER may occur
+   even for an array if the array is one element in length!
+
+   ffestorag_accretion will contain an opACCTER.  It is much like an
+   opARRTER except it has an ffebit object in it instead of just a size.
+   The back end can use the info in the ffebit object, if it wants, to
+   reduce the amount of actual initialization, but in any case it should
+   kill the ffebit object when done.  Also, set accretion to NULL but
+   init to a non-NULL value.
+
+   After performing initialization, DO NOT set init to NULL, because that'll
+   tell the front end it is ok for more initialization to happen.  Instead,
+   set init to an opANY expression or some such thing that you can use to
+   tell that you've already initialized the object.
+
+   27-Oct-91  JCB  1.1
+      Support two-pass FFE.  */
+
+void
+ffecom_notify_init_storage (ffestorag st)
+{
+  ffebld init;			/* The initialization expression. */
+
+  if (ffestorag_init (st) == NULL)
+    {
+      init = ffestorag_accretion (st);
+      assert (init != NULL);
+      ffestorag_set_accretion (st, NULL);
+      ffestorag_set_accretes (st, 0);
+      ffestorag_set_init (st, init);
+    }
+}
+
+/* ffecom_notify_init_symbol -- A symbol is now fully init'ed
+
+   ffesymbol s;
+   ffecom_notify_init_symbol(s);
+
+   Gets called when all possible units in a symbol (not placed in COMMON
+   or involved in EQUIVALENCE, unless it as yet has no ffestorag object)
+   have been initialized.  The initialization info either is in
+   ffesymbol_init or, if that is NULL, ffesymbol_accretion:
+
+   ffesymbol_init may contain an opCONTER or opARRTER.	opCONTER may occur
+   even for an array if the array is one element in length!
+
+   ffesymbol_accretion will contain an opACCTER.  It is much like an
+   opARRTER except it has an ffebit object in it instead of just a size.
+   The back end can use the info in the ffebit object, if it wants, to
+   reduce the amount of actual initialization, but in any case it should
+   kill the ffebit object when done.  Also, set accretion to NULL but
+   init to a non-NULL value.
+
+   After performing initialization, DO NOT set init to NULL, because that'll
+   tell the front end it is ok for more initialization to happen.  Instead,
+   set init to an opANY expression or some such thing that you can use to
+   tell that you've already initialized the object.
+
+   27-Oct-91  JCB  1.1
+      Support two-pass FFE.  */
+
+void
+ffecom_notify_init_symbol (ffesymbol s)
+{
+  ffebld init;			/* The initialization expression. */
+
+  if (ffesymbol_storage (s) == NULL)
+    return;			/* Do nothing until COMMON/EQUIVALENCE
+				   possibilities checked. */
+
+  if ((ffesymbol_init (s) == NULL)
+      && ((init = ffesymbol_accretion (s)) != NULL))
+    {
+      ffesymbol_set_accretion (s, NULL);
+      ffesymbol_set_accretes (s, 0);
+      ffesymbol_set_init (s, init);
+    }
+}
+
+/* ffecom_notify_primary_entry -- Learn which is the primary entry point
+
+   ffesymbol s;
+   ffecom_notify_primary_entry(s);
+
+   Gets called when implicit or explicit PROGRAM statement seen or when
+   FUNCTION, SUBROUTINE, or BLOCK DATA statement seen, with the primary
+   global symbol that serves as the entry point.  */
+
+void
+ffecom_notify_primary_entry (ffesymbol s)
+{
+  ffecom_primary_entry_ = s;
+  ffecom_primary_entry_kind_ = ffesymbol_kind (s);
+
+  if ((ffecom_primary_entry_kind_ == FFEINFO_kindFUNCTION)
+      || (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE))
+    ffecom_primary_entry_is_proc_ = TRUE;
+  else
+    ffecom_primary_entry_is_proc_ = FALSE;
+
+  if (!ffe_is_silent ())
+    {
+      if (ffecom_primary_entry_kind_ == FFEINFO_kindPROGRAM)
+	fprintf (stderr, "%s:\n", ffesymbol_text (s));
+      else
+	fprintf (stderr, "  %s:\n", ffesymbol_text (s));
+    }
+
+  if (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE)
+    {
+      ffebld list;
+      ffebld arg;
+
+      for (list = ffesymbol_dummyargs (s);
+	   list != NULL;
+	   list = ffebld_trail (list))
+	{
+	  arg = ffebld_head (list);
+	  if (ffebld_op (arg) == FFEBLD_opSTAR)
+	    {
+	      ffecom_is_altreturning_ = TRUE;
+	      break;
+	    }
+	}
+    }
+}
+
+FILE *
+ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c)
+{
+  return ffecom_open_include_ (name, l, c);
+}
+
+/* ffecom_ptr_to_expr -- Transform expr into gcc tree with & in front
+
+   tree t;
+   ffebld expr;	 // FFE expression.
+   tree = ffecom_ptr_to_expr(expr);
+
+   Like ffecom_expr, but sticks address-of in front of most things.  */
+
+tree
+ffecom_ptr_to_expr (ffebld expr)
+{
+  tree item;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  ffesymbol s;
+
+  assert (expr != NULL);
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opSYMTER:
+      s = ffebld_symter (expr);
+      if (ffesymbol_where (s) == FFEINFO_whereINTRINSIC)
+	{
+	  ffecomGfrt ix;
+
+	  ix = ffeintrin_gfrt_indirect (ffebld_symter_implementation (expr));
+	  assert (ix != FFECOM_gfrt);
+	  if ((item = ffecom_gfrt_[ix]) == NULL_TREE)
+	    {
+	      ffecom_make_gfrt_ (ix);
+	      item = ffecom_gfrt_[ix];
+	    }
+	}
+      else
+	{
+	  item = ffesymbol_hook (s).decl_tree;
+	  if (item == NULL_TREE)
+	    {
+	      s = ffecom_sym_transform_ (s);
+	      item = ffesymbol_hook (s).decl_tree;
+	    }
+	}
+      assert (item != NULL);
+      if (item == error_mark_node)
+	return item;
+      if (!ffesymbol_hook (s).addr)
+	item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)),
+			 item);
+      return item;
+
+    case FFEBLD_opARRAYREF:
+      return ffecom_arrayref_ (NULL_TREE, expr, 1);
+
+    case FFEBLD_opCONTER:
+
+      bt = ffeinfo_basictype (ffebld_info (expr));
+      kt = ffeinfo_kindtype (ffebld_info (expr));
+
+      item = ffecom_constantunion (&ffebld_constant_union
+				   (ffebld_conter (expr)), bt, kt,
+				   ffecom_tree_type[bt][kt]);
+      if (item == error_mark_node)
+	return error_mark_node;
+      item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)),
+		       item);
+      return item;
+
+    case FFEBLD_opANY:
+      return error_mark_node;
+
+    default:
+      bt = ffeinfo_basictype (ffebld_info (expr));
+      kt = ffeinfo_kindtype (ffebld_info (expr));
+
+      item = ffecom_expr (expr);
+      if (item == error_mark_node)
+	return error_mark_node;
+
+      /* The back end currently optimizes a bit too zealously for us, in that
+	 we fail JCB001 if the following block of code is omitted.  It checks
+	 to see if the transformed expression is a symbol or array reference,
+	 and encloses it in a SAVE_EXPR if that is the case.  */
+
+      STRIP_NOPS (item);
+      if ((TREE_CODE (item) == VAR_DECL)
+	  || (TREE_CODE (item) == PARM_DECL)
+	  || (TREE_CODE (item) == RESULT_DECL)
+	  || (TREE_CODE (item) == INDIRECT_REF)
+	  || (TREE_CODE (item) == ARRAY_REF)
+	  || (TREE_CODE (item) == COMPONENT_REF)
+#ifdef OFFSET_REF
+	  || (TREE_CODE (item) == OFFSET_REF)
+#endif
+	  || (TREE_CODE (item) == BUFFER_REF)
+	  || (TREE_CODE (item) == REALPART_EXPR)
+	  || (TREE_CODE (item) == IMAGPART_EXPR))
+	{
+	  item = ffecom_save_tree (item);
+	}
+
+      item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)),
+		       item);
+      return item;
+    }
+
+  assert ("fall-through error" == NULL);
+  return error_mark_node;
+}
+
+/* Obtain a temp var with given data type.
+
+   size is FFETARGET_charactersizeNONE for a non-CHARACTER type
+   or >= 0 for a CHARACTER type.
+
+   elements is -1 for a scalar or > 0 for an array of type.  */
+
+tree
+ffecom_make_tempvar (const char *commentary, tree type,
+		     ffetargetCharacterSize size, int elements)
+{
+  tree t;
+  static int mynumber;
+
+  assert (current_binding_level->prep_state < 2);
+
+  if (type == error_mark_node)
+    return error_mark_node;
+
+  if (size != FFETARGET_charactersizeNONE)
+    type = build_array_type (type,
+			     build_range_type (ffecom_f2c_ftnlen_type_node,
+					       ffecom_f2c_ftnlen_one_node,
+					       build_int_2 (size, 0)));
+  if (elements != -1)
+    type = build_array_type (type,
+			     build_range_type (integer_type_node,
+					       integer_zero_node,
+					       build_int_2 (elements - 1,
+							    0)));
+  t = build_decl (VAR_DECL,
+		  ffecom_get_invented_identifier ("__g77_%s_%d",
+						  commentary,
+						  mynumber++),
+		  type);
+
+  t = start_decl (t, FALSE);
+  finish_decl (t, NULL_TREE, FALSE);
+
+  return t;
+}
+
+/* Prepare argument pointer to expression.
+
+   Like ffecom_prepare_expr, except for expressions to be evaluated
+   via ffecom_arg_ptr_to_expr.  */
+
+void
+ffecom_prepare_arg_ptr_to_expr (ffebld expr)
+{
+  /* ~~For now, it seems to be the same thing.  */
+  ffecom_prepare_expr (expr);
+  return;
+}
+
+/* End of preparations.  */
+
+bool
+ffecom_prepare_end (void)
+{
+  int prep_state = current_binding_level->prep_state;
+
+  assert (prep_state < 2);
+  current_binding_level->prep_state = 2;
+
+  return (prep_state == 1) ? TRUE : FALSE;
+}
+
+/* Prepare expression.
+
+   This is called before any code is generated for the current block.
+   It scans the expression, declares any temporaries that might be needed
+   during evaluation of the expression, and stores those temporaries in
+   the appropriate "hook" fields of the expression.  `dest', if not NULL,
+   specifies the destination that ffecom_expr_ will see, in case that
+   helps avoid generating unused temporaries.
+
+   ~~Improve to avoid allocating unused temporaries by taking `dest'
+   into account vis-a-vis aliasing requirements of complex/character
+   functions.  */
+
+void
+ffecom_prepare_expr_ (ffebld expr, ffebld dest UNUSED)
+{
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  ffetargetCharacterSize sz;
+  tree tempvar = NULL_TREE;
+
+  assert (current_binding_level->prep_state < 2);
+
+  if (! expr)
+    return;
+
+  bt = ffeinfo_basictype (ffebld_info (expr));
+  kt = ffeinfo_kindtype (ffebld_info (expr));
+  sz = ffeinfo_size (ffebld_info (expr));
+
+  /* Generate whatever temporaries are needed to represent the result
+     of the expression.  */
+
+  if (bt == FFEINFO_basictypeCHARACTER)
+    {
+      while (ffebld_op (expr) == FFEBLD_opPAREN)
+	expr = ffebld_left (expr);
+    }
+
+  switch (ffebld_op (expr))
+    {
+    default:
+      /* Don't make temps for SYMTER, CONTER, etc.  */
+      if (ffebld_arity (expr) == 0)
+	break;
+
+      switch (bt)
+	{
+	case FFEINFO_basictypeCOMPLEX:
+	  if (ffebld_op (expr) == FFEBLD_opFUNCREF)
+	    {
+	      ffesymbol s;
+
+	      if (ffebld_op (ffebld_left (expr)) != FFEBLD_opSYMTER)
+		break;
+
+	      s = ffebld_symter (ffebld_left (expr));
+	      if (ffesymbol_where (s) == FFEINFO_whereCONSTANT
+		  || (ffesymbol_where (s) != FFEINFO_whereINTRINSIC
+		      && ! ffesymbol_is_f2c (s))
+		  || (ffesymbol_where (s) == FFEINFO_whereINTRINSIC
+		      && ! ffe_is_f2c_library ()))
+		break;
+	    }
+	  else if (ffebld_op (expr) == FFEBLD_opPOWER)
+	    {
+	      /* Requires special treatment.  There's no POW_CC function
+		 in libg2c, so POW_ZZ is used, which means we always
+		 need a double-complex temp, not a single-complex.  */
+	      kt = FFEINFO_kindtypeREAL2;
+	    }
+	  else if (ffebld_op (expr) != FFEBLD_opDIVIDE)
+	    /* The other ops don't need temps for complex operands.  */
+	    break;
+
+	  /* ~~~Avoid making temps for some intrinsics, such as AIMAG(C),
+	     REAL(C).  See 19990325-0.f, routine `check', for cases.  */
+	  tempvar = ffecom_make_tempvar ("complex",
+					 ffecom_tree_type
+					 [FFEINFO_basictypeCOMPLEX][kt],
+					 FFETARGET_charactersizeNONE,
+					 -1);
+	  break;
+
+	case FFEINFO_basictypeCHARACTER:
+	  if (ffebld_op (expr) != FFEBLD_opFUNCREF)
+	    break;
+
+	  if (sz == FFETARGET_charactersizeNONE)
+	    /* ~~Kludge alert!  This should someday be fixed. */
+	    sz = 24;
+
+	  tempvar = ffecom_make_tempvar ("char", char_type_node, sz, -1);
+	  break;
+
+	default:
+	  break;
+	}
+      break;
+
+    case FFEBLD_opCONCATENATE:
+      {
+	/* This gets special handling, because only one set of temps
+	   is needed for a tree of these -- the tree is treated as
+	   a flattened list of concatenations when generating code.  */
+
+	ffecomConcatList_ catlist;
+	tree ltmp, itmp, result;
+	int count;
+	int i;
+
+	catlist = ffecom_concat_list_new_ (expr, FFETARGET_charactersizeNONE);
+	count = ffecom_concat_list_count_ (catlist);
+
+	if (count >= 2)
+	  {
+	    ltmp
+	      = ffecom_make_tempvar ("concat_len",
+				     ffecom_f2c_ftnlen_type_node,
+				     FFETARGET_charactersizeNONE, count);
+	    itmp
+	      = ffecom_make_tempvar ("concat_item",
+				     ffecom_f2c_address_type_node,
+				     FFETARGET_charactersizeNONE, count);
+	    result
+	      = ffecom_make_tempvar ("concat_res",
+				     char_type_node,
+				     ffecom_concat_list_maxlen_ (catlist),
+				     -1);
+
+	    tempvar = make_tree_vec (3);
+	    TREE_VEC_ELT (tempvar, 0) = ltmp;
+	    TREE_VEC_ELT (tempvar, 1) = itmp;
+	    TREE_VEC_ELT (tempvar, 2) = result;
+	  }
+
+	for (i = 0; i < count; ++i)
+	  ffecom_prepare_arg_ptr_to_expr (ffecom_concat_list_expr_ (catlist,
+								    i));
+
+	ffecom_concat_list_kill_ (catlist);
+
+	if (tempvar)
+	  {
+	    ffebld_nonter_set_hook (expr, tempvar);
+	    current_binding_level->prep_state = 1;
+	  }
+      }
+      return;
+
+    case FFEBLD_opCONVERT:
+      if (bt == FFEINFO_basictypeCHARACTER
+	  && ((ffebld_size_known (ffebld_left (expr))
+	       == FFETARGET_charactersizeNONE)
+	      || (ffebld_size_known (ffebld_left (expr)) >= sz)))
+	tempvar = ffecom_make_tempvar ("convert", char_type_node, sz, -1);
+      break;
+    }
+
+  if (tempvar)
+    {
+      ffebld_nonter_set_hook (expr, tempvar);
+      current_binding_level->prep_state = 1;
+    }
+
+  /* Prepare subexpressions for this expr.  */
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opPERCENT_LOC:
+      ffecom_prepare_ptr_to_expr (ffebld_left (expr));
+      break;
+
+    case FFEBLD_opPERCENT_VAL:
+    case FFEBLD_opPERCENT_REF:
+      ffecom_prepare_expr (ffebld_left (expr));
+      break;
+
+    case FFEBLD_opPERCENT_DESCR:
+      ffecom_prepare_arg_ptr_to_expr (ffebld_left (expr));
+      break;
+
+    case FFEBLD_opITEM:
+      {
+	ffebld item;
+
+	for (item = expr;
+	     item != NULL;
+	     item = ffebld_trail (item))
+	  if (ffebld_head (item) != NULL)
+	    ffecom_prepare_expr (ffebld_head (item));
+      }
+      break;
+
+    default:
+      /* Need to handle character conversion specially.  */
+      switch (ffebld_arity (expr))
+	{
+	case 2:
+	  ffecom_prepare_expr (ffebld_left (expr));
+	  ffecom_prepare_expr (ffebld_right (expr));
+	  break;
+
+	case 1:
+	  ffecom_prepare_expr (ffebld_left (expr));
+	  break;
+
+	default:
+	  break;
+	}
+    }
+
+  return;
+}
+
+/* Prepare expression for reading and writing.
+
+   Like ffecom_prepare_expr, except for expressions to be evaluated
+   via ffecom_expr_rw.  */
+
+void
+ffecom_prepare_expr_rw (tree type, ffebld expr)
+{
+  /* This is all we support for now.  */
+  assert (type == NULL_TREE || type == ffecom_type_expr (expr));
+
+  /* ~~For now, it seems to be the same thing.  */
+  ffecom_prepare_expr (expr);
+  return;
+}
+
+/* Prepare expression for writing.
+
+   Like ffecom_prepare_expr, except for expressions to be evaluated
+   via ffecom_expr_w.  */
+
+void
+ffecom_prepare_expr_w (tree type, ffebld expr)
+{
+  /* This is all we support for now.  */
+  assert (type == NULL_TREE || type == ffecom_type_expr (expr));
+
+  /* ~~For now, it seems to be the same thing.  */
+  ffecom_prepare_expr (expr);
+  return;
+}
+
+/* Prepare expression for returning.
+
+   Like ffecom_prepare_expr, except for expressions to be evaluated
+   via ffecom_return_expr.  */
+
+void
+ffecom_prepare_return_expr (ffebld expr)
+{
+  assert (current_binding_level->prep_state < 2);
+
+  if (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE
+      && ffecom_is_altreturning_
+      && expr != NULL)
+    ffecom_prepare_expr (expr);
+}
+
+/* Prepare pointer to expression.
+
+   Like ffecom_prepare_expr, except for expressions to be evaluated
+   via ffecom_ptr_to_expr.  */
+
+void
+ffecom_prepare_ptr_to_expr (ffebld expr)
+{
+  /* ~~For now, it seems to be the same thing.  */
+  ffecom_prepare_expr (expr);
+  return;
+}
+
+/* Transform expression into constant pointer-to-expression tree.
+
+   If the expression can be transformed into a pointer-to-expression tree
+   that is constant, that is done, and the tree returned.  Else NULL_TREE
+   is returned.
+
+   That way, a caller can attempt to provide compile-time initialization
+   of a variable and, if that fails, *then* choose to start a new block
+   and resort to using temporaries, as appropriate.  */
+
+tree
+ffecom_ptr_to_const_expr (ffebld expr)
+{
+  if (! expr)
+    return integer_zero_node;
+
+  if (ffebld_op (expr) == FFEBLD_opANY)
+    return error_mark_node;
+
+  if (ffebld_arity (expr) == 0
+      && (ffebld_op (expr) != FFEBLD_opSYMTER
+	  || ffebld_where (expr) == FFEINFO_whereCOMMON
+	  || ffebld_where (expr) == FFEINFO_whereGLOBAL
+	  || ffebld_where (expr) == FFEINFO_whereINTRINSIC))
+    {
+      tree t;
+
+      t = ffecom_ptr_to_expr (expr);
+      assert (TREE_CONSTANT (t));
+      return t;
+    }
+
+  return NULL_TREE;
+}
+
+/* ffecom_return_expr -- Returns return-value expr given alt return expr
+
+   tree rtn;  // NULL_TREE means use expand_null_return()
+   ffebld expr;	 // NULL if no alt return expr to RETURN stmt
+   rtn = ffecom_return_expr(expr);
+
+   Based on the program unit type and other info (like return function
+   type, return master function type when alternate ENTRY points,
+   whether subroutine has any alternate RETURN points, etc), returns the
+   appropriate expression to be returned to the caller, or NULL_TREE
+   meaning no return value or the caller expects it to be returned somewhere
+   else (which is handled by other parts of this module).  */
+
+tree
+ffecom_return_expr (ffebld expr)
+{
+  tree rtn;
+
+  switch (ffecom_primary_entry_kind_)
+    {
+    case FFEINFO_kindPROGRAM:
+    case FFEINFO_kindBLOCKDATA:
+      rtn = NULL_TREE;
+      break;
+
+    case FFEINFO_kindSUBROUTINE:
+      if (!ffecom_is_altreturning_)
+	rtn = NULL_TREE;	/* No alt returns, never an expr. */
+      else if (expr == NULL)
+	rtn = integer_zero_node;
+      else
+	rtn = ffecom_expr (expr);
+      break;
+
+    case FFEINFO_kindFUNCTION:
+      if ((ffecom_multi_retval_ != NULL_TREE)
+	  || (ffesymbol_basictype (ffecom_primary_entry_)
+	      == FFEINFO_basictypeCHARACTER)
+	  || ((ffesymbol_basictype (ffecom_primary_entry_)
+	       == FFEINFO_basictypeCOMPLEX)
+	      && (ffecom_num_entrypoints_ == 0)
+	      && ffesymbol_is_f2c (ffecom_primary_entry_)))
+	{			/* Value is returned by direct assignment
+				   into (implicit) dummy. */
+	  rtn = NULL_TREE;
+	  break;
+	}
+      rtn = ffecom_func_result_;
+#if 0
+      /* Spurious error if RETURN happens before first reference!  So elide
+	 this code.  In particular, for debugging registry, rtn should always
+	 be non-null after all, but TREE_USED won't be set until we encounter
+	 a reference in the code.  Perfectly okay (but weird) code that,
+	 e.g., has "GOTO 20;10 RETURN;20 RTN=0;GOTO 10", would result in
+	 this diagnostic for no reason.  Have people use -O -Wuninitialized
+	 and leave it to the back end to find obviously weird cases.  */
+
+      /* Used to "assert(rtn != NULL_TREE);" here, but it's kind of a valid
+	 situation; if the return value has never been referenced, it won't
+	 have a tree under 2pass mode. */
+      if ((rtn == NULL_TREE)
+	  || !TREE_USED (rtn))
+	{
+	  ffebad_start (FFEBAD_RETURN_VALUE_UNSET);
+	  ffebad_here (0, ffesymbol_where_line (ffecom_primary_entry_),
+		       ffesymbol_where_column (ffecom_primary_entry_));
+	  ffebad_string (ffesymbol_text (ffesymbol_funcresult
+					 (ffecom_primary_entry_)));
+	  ffebad_finish ();
+	}
+#endif
+      break;
+
+    default:
+      assert ("bad unit kind" == NULL);
+    case FFEINFO_kindANY:
+      rtn = error_mark_node;
+      break;
+    }
+
+  return rtn;
+}
+
+/* Do save_expr only if tree is not error_mark_node.  */
+
+tree
+ffecom_save_tree (tree t)
+{
+  return save_expr (t);
+}
+
+/* Start a compound statement (block).  */
+
+void
+ffecom_start_compstmt (void)
+{
+  bison_rule_pushlevel_ ();
+}
+
+/* Public entry point for front end to access start_decl.  */
+
+tree
+ffecom_start_decl (tree decl, bool is_initialized)
+{
+  DECL_INITIAL (decl) = is_initialized ? error_mark_node : NULL_TREE;
+  return start_decl (decl, FALSE);
+}
+
+/* ffecom_sym_commit -- Symbol's state being committed to reality
+
+   ffesymbol s;
+   ffecom_sym_commit(s);
+
+   Does whatever the backend needs when a symbol is committed after having
+   been backtrackable for a period of time.  */
+
+void
+ffecom_sym_commit (ffesymbol s UNUSED)
+{
+  assert (!ffesymbol_retractable ());
+}
+
+/* ffecom_sym_end_transition -- Perform end transition on all symbols
+
+   ffecom_sym_end_transition();
+
+   Does backend-specific stuff and also calls ffest_sym_end_transition
+   to do the necessary FFE stuff.
+
+   Backtracking is never enabled when this fn is called, so don't worry
+   about it.  */
+
+ffesymbol
+ffecom_sym_end_transition (ffesymbol s)
+{
+  ffestorag st;
+
+  assert (!ffesymbol_retractable ());
+
+  s = ffest_sym_end_transition (s);
+
+  if ((ffesymbol_kind (s) == FFEINFO_kindBLOCKDATA)
+      && (ffesymbol_where (s) == FFEINFO_whereGLOBAL))
+    {
+      ffecom_list_blockdata_
+	= ffebld_new_item (ffebld_new_symter (s, FFEINTRIN_genNONE,
+					      FFEINTRIN_specNONE,
+					      FFEINTRIN_impNONE),
+			   ffecom_list_blockdata_);
+    }
+
+  /* This is where we finally notice that a symbol has partial initialization
+     and finalize it. */
+
+  if (ffesymbol_accretion (s) != NULL)
+    {
+      assert (ffesymbol_init (s) == NULL);
+      ffecom_notify_init_symbol (s);
+    }
+  else if (((st = ffesymbol_storage (s)) != NULL)
+	   && ((st = ffestorag_parent (st)) != NULL)
+	   && (ffestorag_accretion (st) != NULL))
+    {
+      assert (ffestorag_init (st) == NULL);
+      ffecom_notify_init_storage (st);
+    }
+
+  if ((ffesymbol_kind (s) == FFEINFO_kindCOMMON)
+      && (ffesymbol_where (s) == FFEINFO_whereLOCAL)
+      && (ffesymbol_storage (s) != NULL))
+    {
+      ffecom_list_common_
+	= ffebld_new_item (ffebld_new_symter (s, FFEINTRIN_genNONE,
+					      FFEINTRIN_specNONE,
+					      FFEINTRIN_impNONE),
+			   ffecom_list_common_);
+    }
+
+  return s;
+}
+
+/* ffecom_sym_exec_transition -- Perform exec transition on all symbols
+
+   ffecom_sym_exec_transition();
+
+   Does backend-specific stuff and also calls ffest_sym_exec_transition
+   to do the necessary FFE stuff.
+
+   See the long-winded description in ffecom_sym_learned for info
+   on handling the situation where backtracking is inhibited.  */
+
+ffesymbol
+ffecom_sym_exec_transition (ffesymbol s)
+{
+  s = ffest_sym_exec_transition (s);
+
+  return s;
+}
+
+/* ffecom_sym_learned -- Initial or more info gained on symbol after exec
+
+   ffesymbol s;
+   s = ffecom_sym_learned(s);
+
+   Called when a new symbol is seen after the exec transition or when more
+   info (perhaps) is gained for an UNCERTAIN symbol.  The symbol state when
+   it arrives here is that all its latest info is updated already, so its
+   state may be UNCERTAIN or UNDERSTOOD, it might already have the hook
+   field filled in if its gone through here or exec_transition first, and
+   so on.
+
+   The backend probably wants to check ffesymbol_retractable() to see if
+   backtracking is in effect.  If so, the FFE's changes to the symbol may
+   be retracted (undone) or committed (ratified), at which time the
+   appropriate ffecom_sym_retract or _commit function will be called
+   for that function.
+
+   If the backend has its own backtracking mechanism, great, use it so that
+   committal is a simple operation.  Though it doesn't make much difference,
+   I suppose: the reason for tentative symbol evolution in the FFE is to
+   enable error detection in weird incorrect statements early and to disable
+   incorrect error detection on a correct statement.  The backend is not
+   likely to introduce any information that'll get involved in these
+   considerations, so it is probably just fine that the implementation
+   model for this fn and for _exec_transition is to not do anything
+   (besides the required FFE stuff) if ffesymbol_retractable() returns TRUE
+   and instead wait until ffecom_sym_commit is called (which it never
+   will be as long as we're using ambiguity-detecting statement analysis in
+   the FFE, which we are initially to shake out the code, but don't depend
+   on this), otherwise go ahead and do whatever is needed.
+
+   In essence, then, when this fn and _exec_transition get called while
+   backtracking is enabled, a general mechanism would be to flag which (or
+   both) of these were called (and in what order? neat question as to what
+   might happen that I'm too lame to think through right now) and then when
+   _commit is called reproduce the original calling sequence, if any, for
+   the two fns (at which point backtracking will, of course, be disabled).  */
+
+ffesymbol
+ffecom_sym_learned (ffesymbol s)
+{
+  ffestorag_exec_layout (s);
+
+  return s;
+}
+
+/* ffecom_sym_retract -- Symbol's state being retracted from reality
+
+   ffesymbol s;
+   ffecom_sym_retract(s);
+
+   Does whatever the backend needs when a symbol is retracted after having
+   been backtrackable for a period of time.  */
+
+void
+ffecom_sym_retract (ffesymbol s UNUSED)
+{
+  assert (!ffesymbol_retractable ());
+
+#if 0				/* GCC doesn't commit any backtrackable sins,
+				   so nothing needed here. */
+  switch (ffesymbol_hook (s).state)
+    {
+    case 0:			/* nothing happened yet. */
+      break;
+
+    case 1:			/* exec transition happened. */
+      break;
+
+    case 2:			/* learned happened. */
+      break;
+
+    case 3:			/* learned then exec. */
+      break;
+
+    case 4:			/* exec then learned. */
+      break;
+
+    default:
+      assert ("bad hook state" == NULL);
+      break;
+    }
+#endif
+}
+
+/* Create temporary gcc label.  */
+
+tree
+ffecom_temp_label (void)
+{
+  tree glabel;
+  static int mynumber = 0;
+
+  glabel = build_decl (LABEL_DECL,
+		       ffecom_get_invented_identifier ("__g77_label_%d",
+						       mynumber++),
+		       void_type_node);
+  DECL_CONTEXT (glabel) = current_function_decl;
+  DECL_MODE (glabel) = VOIDmode;
+
+  return glabel;
+}
+
+/* Return an expression that is usable as an arg in a conditional context
+   (IF, DO WHILE, .NOT., and so on).
+
+   Use the one provided for the back end as of >2.6.0.  */
+
+tree
+ffecom_truth_value (tree expr)
+{
+  return ffe_truthvalue_conversion (expr);
+}
+
+/* Return the inversion of a truth value (the inversion of what
+   ffecom_truth_value builds).
+
+   Apparently invert_truthvalue, which is properly in the back end, is
+   enough for now, so just use it.  */
+
+tree
+ffecom_truth_value_invert (tree expr)
+{
+  return invert_truthvalue (ffecom_truth_value (expr));
+}
+
+/* Return the tree that is the type of the expression, as would be
+   returned in TREE_TYPE(ffecom_expr(expr)), without otherwise
+   transforming the expression, generating temporaries, etc.  */
+
+tree
+ffecom_type_expr (ffebld expr)
+{
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  tree tree_type;
+
+  assert (expr != NULL);
+
+  bt = ffeinfo_basictype (ffebld_info (expr));
+  kt = ffeinfo_kindtype (ffebld_info (expr));
+  tree_type = ffecom_tree_type[bt][kt];
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opCONTER:
+    case FFEBLD_opSYMTER:
+    case FFEBLD_opARRAYREF:
+    case FFEBLD_opUPLUS:
+    case FFEBLD_opPAREN:
+    case FFEBLD_opUMINUS:
+    case FFEBLD_opADD:
+    case FFEBLD_opSUBTRACT:
+    case FFEBLD_opMULTIPLY:
+    case FFEBLD_opDIVIDE:
+    case FFEBLD_opPOWER:
+    case FFEBLD_opNOT:
+    case FFEBLD_opFUNCREF:
+    case FFEBLD_opSUBRREF:
+    case FFEBLD_opAND:
+    case FFEBLD_opOR:
+    case FFEBLD_opXOR:
+    case FFEBLD_opNEQV:
+    case FFEBLD_opEQV:
+    case FFEBLD_opCONVERT:
+    case FFEBLD_opLT:
+    case FFEBLD_opLE:
+    case FFEBLD_opEQ:
+    case FFEBLD_opNE:
+    case FFEBLD_opGT:
+    case FFEBLD_opGE:
+    case FFEBLD_opPERCENT_LOC:
+      return tree_type;
+
+    case FFEBLD_opACCTER:
+    case FFEBLD_opARRTER:
+    case FFEBLD_opITEM:
+    case FFEBLD_opSTAR:
+    case FFEBLD_opBOUNDS:
+    case FFEBLD_opREPEAT:
+    case FFEBLD_opLABTER:
+    case FFEBLD_opLABTOK:
+    case FFEBLD_opIMPDO:
+    case FFEBLD_opCONCATENATE:
+    case FFEBLD_opSUBSTR:
+    default:
+      assert ("bad op for ffecom_type_expr" == NULL);
+      /* Fall through. */
+    case FFEBLD_opANY:
+      return error_mark_node;
+    }
+}
+
+/* Return PARM_DECL for arg#1 of master fn containing alternate ENTRY points
+
+   If the PARM_DECL already exists, return it, else create it.	It's an
+   integer_type_node argument for the master function that implements a
+   subroutine or function with more than one entrypoint and is bound at
+   run time with the entrypoint number (0 for SUBROUTINE/FUNCTION, 1 for
+   first ENTRY statement, and so on).  */
+
+tree
+ffecom_which_entrypoint_decl (void)
+{
+  assert (ffecom_which_entrypoint_decl_ != NULL_TREE);
+
+  return ffecom_which_entrypoint_decl_;
+}
+
+/* The following sections consists of private and public functions
+   that have the same names and perform roughly the same functions
+   as counterparts in the C front end.  Changes in the C front end
+   might affect how things should be done here.  Only functions
+   needed by the back end should be public here; the rest should
+   be private (static in the C sense).  Functions needed by other
+   g77 front-end modules should be accessed by them via public
+   ffecom_* names, which should themselves call private versions
+   in this section so the private versions are easy to recognize
+   when upgrading to a new gcc and finding interesting changes
+   in the front end.
+
+   Functions named after rule "foo:" in c-parse.y are named
+   "bison_rule_foo_" so they are easy to find.  */
+
+static void
+bison_rule_pushlevel_ (void)
+{
+  emit_line_note (input_location);
+  pushlevel (0);
+  clear_last_expr ();
+  expand_start_bindings (0);
+}
+
+static tree
+bison_rule_compstmt_ (void)
+{
+  tree t;
+  int keep = kept_level_p ();
+
+  /* Make the temps go away.  */
+  if (! keep)
+    current_binding_level->names = NULL_TREE;
+
+  emit_line_note (input_location);
+  expand_end_bindings (getdecls (), keep, 0);
+  t = poplevel (keep, 1, 0);
+
+  return t;
+}
+
+/* Return a definition for a builtin function named NAME and whose data type
+   is TYPE.  TYPE should be a function type with argument types.
+   FUNCTION_CODE tells later passes how to compile calls to this function.
+   See tree.h for its possible values.
+
+   If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
+   the name to be called if we can't opencode the function.  If
+   ATTRS is nonzero, use that for the function's attribute list.  */
+
+tree
+builtin_function (const char *name, tree type, int function_code,
+		  enum built_in_class class, const char *library_name,
+		  tree attrs ATTRIBUTE_UNUSED)
+{
+  tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
+  DECL_EXTERNAL (decl) = 1;
+  TREE_PUBLIC (decl) = 1;
+  if (library_name)
+    SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
+  make_decl_rtl (decl, NULL);
+  pushdecl (decl);
+  DECL_BUILT_IN_CLASS (decl) = class;
+  DECL_FUNCTION_CODE (decl) = function_code;
+
+  return decl;
+}
+
+/* Handle when a new declaration NEWDECL
+   has the same name as an old one OLDDECL
+   in the same binding contour.
+   Prints an error message if appropriate.
+
+   If safely possible, alter OLDDECL to look like NEWDECL, and return 1.
+   Otherwise, return 0.  */
+
+static int
+duplicate_decls (tree newdecl, tree olddecl)
+{
+  int types_match = 1;
+  int new_is_definition = (TREE_CODE (newdecl) == FUNCTION_DECL
+			   && DECL_INITIAL (newdecl) != 0);
+  tree oldtype = TREE_TYPE (olddecl);
+  tree newtype = TREE_TYPE (newdecl);
+
+  if (olddecl == newdecl)
+    return 1;
+
+  if (TREE_CODE (newtype) == ERROR_MARK
+      || TREE_CODE (oldtype) == ERROR_MARK)
+    types_match = 0;
+
+  /* New decl is completely inconsistent with the old one =>
+     tell caller to replace the old one.
+     This is always an error except in the case of shadowing a builtin.  */
+  if (TREE_CODE (olddecl) != TREE_CODE (newdecl))
+    return 0;
+
+  /* For real parm decl following a forward decl,
+     return 1 so old decl will be reused.  */
+  if (types_match && TREE_CODE (newdecl) == PARM_DECL
+      && TREE_ASM_WRITTEN (olddecl) && ! TREE_ASM_WRITTEN (newdecl))
+    return 1;
+
+  /* The new declaration is the same kind of object as the old one.
+     The declarations may partially match.  Print warnings if they don't
+     match enough.  Ultimately, copy most of the information from the new
+     decl to the old one, and keep using the old one.  */
+
+  if (TREE_CODE (olddecl) == FUNCTION_DECL
+      && DECL_BUILT_IN (olddecl))
+    {
+      /* A function declaration for a built-in function.  */
+      if (!TREE_PUBLIC (newdecl))
+	return 0;
+      else if (!types_match)
+	{
+	  /* Accept the return type of the new declaration if same modes.  */
+	  tree oldreturntype = TREE_TYPE (TREE_TYPE (olddecl));
+	  tree newreturntype = TREE_TYPE (TREE_TYPE (newdecl));
+
+	  if (TYPE_MODE (oldreturntype) == TYPE_MODE (newreturntype))
+	    {
+	      /* Function types may be shared, so we can't just modify
+		 the return type of olddecl's function type.  */
+	      tree newtype
+		= build_function_type (newreturntype,
+				       TYPE_ARG_TYPES (TREE_TYPE (olddecl)));
+
+	      types_match = 1;
+	      if (types_match)
+		TREE_TYPE (olddecl) = newtype;
+	    }
+	}
+      if (!types_match)
+	return 0;
+    }
+  else if (TREE_CODE (olddecl) == FUNCTION_DECL
+	   && DECL_SOURCE_LINE (olddecl) == 0)
+    {
+      /* A function declaration for a predeclared function
+	 that isn't actually built in.  */
+      if (!TREE_PUBLIC (newdecl))
+	return 0;
+      else if (!types_match)
+	{
+	  /* If the types don't match, preserve volatility indication.
+	     Later on, we will discard everything else about the
+	     default declaration.  */
+	  TREE_THIS_VOLATILE (newdecl) |= TREE_THIS_VOLATILE (olddecl);
+	}
+    }
+
+  /* Copy all the DECL_... slots specified in the new decl
+     except for any that we copy here from the old type.
+
+     Past this point, we don't change OLDTYPE and NEWTYPE
+     even if we change the types of NEWDECL and OLDDECL.  */
+
+  if (types_match)
+    {
+      /* Merge the data types specified in the two decls.  */
+      if (TREE_CODE (newdecl) != FUNCTION_DECL || !DECL_BUILT_IN (olddecl))
+	TREE_TYPE (newdecl)
+	  = TREE_TYPE (olddecl)
+	    = TREE_TYPE (newdecl);
+
+      /* Lay the type out, unless already done.  */
+      if (oldtype != TREE_TYPE (newdecl))
+	{
+	  if (TREE_TYPE (newdecl) != error_mark_node)
+	    layout_type (TREE_TYPE (newdecl));
+	  if (TREE_CODE (newdecl) != FUNCTION_DECL
+	      && TREE_CODE (newdecl) != TYPE_DECL
+	      && TREE_CODE (newdecl) != CONST_DECL)
+	    layout_decl (newdecl, 0);
+	}
+      else
+	{
+	  /* Since the type is OLDDECL's, make OLDDECL's size go with.  */
+	  DECL_SIZE (newdecl) = DECL_SIZE (olddecl);
+	  DECL_SIZE_UNIT (newdecl) = DECL_SIZE_UNIT (olddecl);
+	  if (TREE_CODE (olddecl) != FUNCTION_DECL)
+	    if (DECL_ALIGN (olddecl) > DECL_ALIGN (newdecl))
+	      {
+		DECL_ALIGN (newdecl) = DECL_ALIGN (olddecl);
+		DECL_USER_ALIGN (newdecl) |= DECL_USER_ALIGN (olddecl);
+	      }
+	}
+
+      /* Keep the old rtl since we can safely use it.  */
+      COPY_DECL_RTL (olddecl, newdecl);
+
+      /* Merge the type qualifiers.  */
+      if (TREE_READONLY (newdecl))
+	TREE_READONLY (olddecl) = 1;
+      if (TREE_THIS_VOLATILE (newdecl))
+	{
+	  TREE_THIS_VOLATILE (olddecl) = 1;
+	  if (TREE_CODE (newdecl) == VAR_DECL)
+	    make_var_volatile (newdecl);
+	}
+
+      /* Keep source location of definition rather than declaration.
+	 Likewise, keep decl at outer scope.  */
+      if ((DECL_INITIAL (newdecl) == 0 && DECL_INITIAL (olddecl) != 0)
+	  || (DECL_CONTEXT (newdecl) != 0 && DECL_CONTEXT (olddecl) == 0))
+	{
+	  DECL_SOURCE_LOCATION (newdecl) = DECL_SOURCE_LOCATION (olddecl);
+
+	  if (DECL_CONTEXT (olddecl) == 0
+	      && TREE_CODE (newdecl) != FUNCTION_DECL)
+	    DECL_CONTEXT (newdecl) = 0;
+	}
+
+      /* Merge the unused-warning information.  */
+      if (DECL_IN_SYSTEM_HEADER (olddecl))
+	DECL_IN_SYSTEM_HEADER (newdecl) = 1;
+      else if (DECL_IN_SYSTEM_HEADER (newdecl))
+	DECL_IN_SYSTEM_HEADER (olddecl) = 1;
+
+      /* Merge the initialization information.  */
+      if (DECL_INITIAL (newdecl) == 0)
+	DECL_INITIAL (newdecl) = DECL_INITIAL (olddecl);
+
+      /* Merge the section attribute.
+	 We want to issue an error if the sections conflict but that must be
+	 done later in decl_attributes since we are called before attributes
+	 are assigned.  */
+      if (DECL_SECTION_NAME (newdecl) == NULL_TREE)
+	DECL_SECTION_NAME (newdecl) = DECL_SECTION_NAME (olddecl);
+
+      /* Copy the assembler name.  */
+      COPY_DECL_ASSEMBLER_NAME (olddecl, newdecl);
+
+      if (TREE_CODE (newdecl) == FUNCTION_DECL)
+	{
+	  DECL_STATIC_CONSTRUCTOR(newdecl) |= DECL_STATIC_CONSTRUCTOR(olddecl);
+	  DECL_STATIC_DESTRUCTOR (newdecl) |= DECL_STATIC_DESTRUCTOR (olddecl);
+	  TREE_THIS_VOLATILE (newdecl) |= TREE_THIS_VOLATILE (olddecl);
+	  TREE_READONLY (newdecl) |= TREE_READONLY (olddecl);
+	  DECL_IS_MALLOC (newdecl) |= DECL_IS_MALLOC (olddecl);
+	  DECL_IS_PURE (newdecl) |= DECL_IS_PURE (olddecl);
+	}
+    }
+  /* If cannot merge, then use the new type and qualifiers,
+     and don't preserve the old rtl.  */
+  else
+    {
+      TREE_TYPE (olddecl) = TREE_TYPE (newdecl);
+      TREE_READONLY (olddecl) = TREE_READONLY (newdecl);
+      TREE_THIS_VOLATILE (olddecl) = TREE_THIS_VOLATILE (newdecl);
+      TREE_SIDE_EFFECTS (olddecl) = TREE_SIDE_EFFECTS (newdecl);
+    }
+
+  /* Merge the storage class information.  */
+  /* For functions, static overrides non-static.  */
+  if (TREE_CODE (newdecl) == FUNCTION_DECL)
+    {
+      TREE_PUBLIC (newdecl) &= TREE_PUBLIC (olddecl);
+      /* This is since we don't automatically
+	 copy the attributes of NEWDECL into OLDDECL.  */
+      TREE_PUBLIC (olddecl) = TREE_PUBLIC (newdecl);
+      /* If this clears `static', clear it in the identifier too.  */
+      if (! TREE_PUBLIC (olddecl))
+	TREE_PUBLIC (DECL_NAME (olddecl)) = 0;
+    }
+  if (DECL_EXTERNAL (newdecl))
+    {
+      TREE_STATIC (newdecl) = TREE_STATIC (olddecl);
+      DECL_EXTERNAL (newdecl) = DECL_EXTERNAL (olddecl);
+      /* An extern decl does not override previous storage class.  */
+      TREE_PUBLIC (newdecl) = TREE_PUBLIC (olddecl);
+    }
+  else
+    {
+      TREE_STATIC (olddecl) = TREE_STATIC (newdecl);
+      TREE_PUBLIC (olddecl) = TREE_PUBLIC (newdecl);
+    }
+
+  /* If either decl says `inline', this fn is inline,
+     unless its definition was passed already.  */
+  if (DECL_INLINE (newdecl) && DECL_INITIAL (olddecl) == 0)
+    DECL_INLINE (olddecl) = 1;
+  DECL_INLINE (newdecl) = DECL_INLINE (olddecl);
+
+  /* Get rid of any built-in function if new arg types don't match it
+     or if we have a function definition.  */
+  if (TREE_CODE (newdecl) == FUNCTION_DECL
+      && DECL_BUILT_IN (olddecl)
+      && (!types_match || new_is_definition))
+    {
+      TREE_TYPE (olddecl) = TREE_TYPE (newdecl);
+      DECL_BUILT_IN_CLASS (olddecl) = NOT_BUILT_IN;
+    }
+
+  /* If redeclaring a builtin function, and not a definition,
+     it stays built in.
+     Also preserve various other info from the definition.  */
+  if (TREE_CODE (newdecl) == FUNCTION_DECL && !new_is_definition)
+    {
+      if (DECL_BUILT_IN (olddecl))
+	{
+	  DECL_BUILT_IN_CLASS (newdecl) = DECL_BUILT_IN_CLASS (olddecl);
+	  DECL_FUNCTION_CODE (newdecl) = DECL_FUNCTION_CODE (olddecl);
+	}
+
+      DECL_RESULT (newdecl) = DECL_RESULT (olddecl);
+      DECL_INITIAL (newdecl) = DECL_INITIAL (olddecl);
+      DECL_SAVED_INSNS (newdecl) = DECL_SAVED_INSNS (olddecl);
+      DECL_ARGUMENTS (newdecl) = DECL_ARGUMENTS (olddecl);
+    }
+
+  /* Copy most of the decl-specific fields of NEWDECL into OLDDECL.
+     But preserve olddecl's DECL_UID.  */
+  {
+    register unsigned olddecl_uid = DECL_UID (olddecl);
+
+    memcpy ((char *) olddecl + sizeof (struct tree_common),
+	    (char *) newdecl + sizeof (struct tree_common),
+	    sizeof (struct tree_decl) - sizeof (struct tree_common));
+    DECL_UID (olddecl) = olddecl_uid;
+  }
+
+  return 1;
+}
+
+/* Finish processing of a declaration;
+   install its initial value.
+   If the length of an array type is not known before,
+   it must be determined now, from the initial value, or it is an error.  */
+
+static void
+finish_decl (tree decl, tree init, bool is_top_level)
+{
+  register tree type = TREE_TYPE (decl);
+  int was_incomplete = (DECL_SIZE (decl) == 0);
+  bool at_top_level = (current_binding_level == global_binding_level);
+  bool top_level = is_top_level || at_top_level;
+
+  /* Caller should pass TRUE for is_top_level only if we wouldn't be at top
+     level anyway.  */
+  assert (!is_top_level || !at_top_level);
+
+  if (TREE_CODE (decl) == PARM_DECL)
+    assert (init == NULL_TREE);
+  /* Remember that PARM_DECL doesn't have a DECL_INITIAL field per se -- it
+     overlaps DECL_ARG_TYPE.  */
+  else if (init == NULL_TREE)
+    assert (DECL_INITIAL (decl) == NULL_TREE);
+  else
+    assert (DECL_INITIAL (decl) == error_mark_node);
+
+  if (init != NULL_TREE)
+    {
+      if (TREE_CODE (decl) != TYPE_DECL)
+	DECL_INITIAL (decl) = init;
+      else
+	{
+	  /* typedef foo = bar; store the type of bar as the type of foo.  */
+	  TREE_TYPE (decl) = TREE_TYPE (init);
+	  DECL_INITIAL (decl) = init = 0;
+	}
+    }
+
+  /* Deduce size of array from initialization, if not already known */
+
+  if (TREE_CODE (type) == ARRAY_TYPE
+      && TYPE_DOMAIN (type) == 0
+      && TREE_CODE (decl) != TYPE_DECL)
+    {
+      assert (top_level);
+      assert (was_incomplete);
+
+      layout_decl (decl, 0);
+    }
+
+  if (TREE_CODE (decl) == VAR_DECL)
+    {
+      if (DECL_SIZE (decl) == NULL_TREE
+	  && TYPE_SIZE (TREE_TYPE (decl)) != NULL_TREE)
+	layout_decl (decl, 0);
+
+      if (DECL_SIZE (decl) == NULL_TREE
+	  && (TREE_STATIC (decl)
+	      ?
+      /* A static variable with an incomplete type is an error if it is
+	 initialized. Also if it is not file scope. Otherwise, let it
+	 through, but if it is not `extern' then it may cause an error
+	 message later.  */
+	      (DECL_INITIAL (decl) != 0 || DECL_CONTEXT (decl) != 0)
+	      :
+      /* An automatic variable with an incomplete type is an error.  */
+	      !DECL_EXTERNAL (decl)))
+	{
+	  assert ("storage size not known" == NULL);
+	  abort ();
+	}
+
+      if ((DECL_EXTERNAL (decl) || TREE_STATIC (decl))
+	  && (DECL_SIZE (decl) != 0)
+	  && (TREE_CODE (DECL_SIZE (decl)) != INTEGER_CST))
+	{
+	  assert ("storage size not constant" == NULL);
+	  abort ();
+	}
+    }
+
+  /* Output the assembler code and/or RTL code for variables and functions,
+     unless the type is an undefined structure or union. If not, it will get
+     done when the type is completed.  */
+
+  if (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL)
+    {
+      rest_of_decl_compilation (decl, NULL,
+				DECL_CONTEXT (decl) == 0,
+				0);
+
+      if (DECL_CONTEXT (decl) != 0)
+	{
+	  /* Recompute the RTL of a local array now if it used to be an
+	     incomplete type.  */
+	  if (was_incomplete
+	      && !TREE_STATIC (decl) && !DECL_EXTERNAL (decl))
+	    {
+	      /* If we used it already as memory, it must stay in memory.  */
+	      TREE_ADDRESSABLE (decl) = TREE_USED (decl);
+	      /* If it's still incomplete now, no init will save it.  */
+	      if (DECL_SIZE (decl) == 0)
+		DECL_INITIAL (decl) = 0;
+	      expand_decl (decl);
+	    }
+	  /* Compute and store the initial value.  */
+	  if (TREE_CODE (decl) != FUNCTION_DECL)
+	    expand_decl_init (decl);
+	}
+    }
+  else if (TREE_CODE (decl) == TYPE_DECL)
+    {
+      rest_of_decl_compilation (decl, NULL,
+				DECL_CONTEXT (decl) == 0,
+				0);
+    }
+
+  /* At the end of a declaration, throw away any variable type sizes of types
+     defined inside that declaration.  There is no use computing them in the
+     following function definition.  */
+  if (current_binding_level == global_binding_level)
+    get_pending_sizes ();
+}
+
+/* Finish up a function declaration and compile that function
+   all the way to assembler language output.  The free the storage
+   for the function definition.
+
+   This is called after parsing the body of the function definition.
+
+   NESTED is nonzero if the function being finished is nested in another.  */
+
+static void
+finish_function (int nested)
+{
+  register tree fndecl = current_function_decl;
+
+  assert (fndecl != NULL_TREE);
+  if (TREE_CODE (fndecl) != ERROR_MARK)
+    {
+      if (nested)
+	assert (DECL_CONTEXT (fndecl) != NULL_TREE);
+      else
+	assert (DECL_CONTEXT (fndecl) == NULL_TREE);
+    }
+
+/*  TREE_READONLY (fndecl) = 1;
+    This caused &foo to be of type ptr-to-const-function
+    which then got a warning when stored in a ptr-to-function variable.  */
+
+  poplevel (1, 0, 1);
+
+  if (TREE_CODE (fndecl) != ERROR_MARK)
+    {
+      BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
+
+      /* Must mark the RESULT_DECL as being in this function.  */
+
+      DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
+
+      /* Obey `register' declarations if `setjmp' is called in this fn.  */
+      /* Generate rtl for function exit.  */
+      expand_function_end ();
+
+      /* If this is a nested function, protect the local variables in the stack
+	 above us from being collected while we're compiling this function.  */
+      if (nested)
+	ggc_push_context ();
+
+      /* Run the optimizers and output the assembler code for this function.  */
+      rest_of_compilation (fndecl);
+
+      /* Undo the GC context switch.  */
+      if (nested)
+	ggc_pop_context ();
+    }
+
+  if (TREE_CODE (fndecl) != ERROR_MARK
+      && !nested
+      && DECL_SAVED_INSNS (fndecl) == 0)
+    {
+      /* Stop pointing to the local nodes about to be freed.  */
+      /* But DECL_INITIAL must remain nonzero so we know this was an actual
+	 function definition.  */
+      /* For a nested function, this is done in pop_f_function_context.  */
+      /* If rest_of_compilation set this to 0, leave it 0.  */
+      if (DECL_INITIAL (fndecl) != 0)
+	DECL_INITIAL (fndecl) = error_mark_node;
+      DECL_ARGUMENTS (fndecl) = 0;
+    }
+
+  if (!nested)
+    {
+      /* Let the error reporting routines know that we're outside a function.
+	 For a nested function, this value is used in pop_c_function_context
+	 and then reset via pop_function_context.  */
+      ffecom_outer_function_decl_ = current_function_decl = NULL;
+    }
+}
+
+/* Plug-in replacement for identifying the name of a decl and, for a
+   function, what we call it in diagnostics.  For now, "program unit"
+   should suffice, since it's a bit of a hassle to figure out which
+   of several kinds of things it is.  Note that it could conceivably
+   be a statement function, which probably isn't really a program unit
+   per se, but if that comes up, it should be easy to check (being a
+   nested function and all).  */
+
+static const char *
+ffe_printable_name (tree decl, int v)
+{
+  /* Just to keep GCC quiet about the unused variable.
+     In theory, differing values of V should produce different
+     output.  */
+  switch (v)
+    {
+    default:
+      if (TREE_CODE (decl) == ERROR_MARK)
+	return "erroneous code";
+      return IDENTIFIER_POINTER (DECL_NAME (decl));
+    }
+}
+
+/* g77's function to print out name of current function that caused
+   an error.  */
+
+static void
+ffe_print_error_function (diagnostic_context *context __attribute__((unused)),
+			  const char *file)
+{
+  static ffeglobal last_g = NULL;
+  static ffesymbol last_s = NULL;
+  ffeglobal g;
+  ffesymbol s;
+  const char *kind;
+
+  if ((ffecom_primary_entry_ == NULL)
+      || (ffesymbol_global (ffecom_primary_entry_) == NULL))
+    {
+      g = NULL;
+      s = NULL;
+      kind = NULL;
+    }
+  else
+    {
+      g = ffesymbol_global (ffecom_primary_entry_);
+      if (ffecom_nested_entry_ == NULL)
+	{
+	  s = ffecom_primary_entry_;
+	  kind = _(ffeinfo_kind_message (ffesymbol_kind (s)));
+	}
+      else
+	{
+	  s = ffecom_nested_entry_;
+	  kind = _("In statement function");
+	}
+    }
+
+  if ((last_g != g) || (last_s != s))
+    {
+      if (file)
+	fprintf (stderr, "%s: ", file);
+
+      if (s == NULL)
+	fprintf (stderr, _("Outside of any program unit:\n"));
+      else
+	{
+	  const char *name = ffesymbol_text (s);
+
+	  fprintf (stderr, "%s `%s':\n", kind, name);
+	}
+
+      last_g = g;
+      last_s = s;
+    }
+}
+
+/* Similar to `lookup_name' but look only at current binding level.  */
+
+static tree
+lookup_name_current_level (tree name)
+{
+  register tree t;
+
+  if (current_binding_level == global_binding_level)
+    return IDENTIFIER_GLOBAL_VALUE (name);
+
+  if (IDENTIFIER_LOCAL_VALUE (name) == 0)
+    return 0;
+
+  for (t = current_binding_level->names; t; t = TREE_CHAIN (t))
+    if (DECL_NAME (t) == name)
+      break;
+
+  return t;
+}
+
+/* Create a new `struct f_binding_level'.  */
+
+static struct f_binding_level *
+make_binding_level (void)
+{
+  /* NOSTRICT */
+  return ggc_alloc (sizeof (struct f_binding_level));
+}
+
+/* Save and restore the variables in this file and elsewhere
+   that keep track of the progress of compilation of the current function.
+   Used for nested functions.  */
+
+struct f_function
+{
+  struct f_function *next;
+  tree named_labels;
+  tree shadowed_labels;
+  struct f_binding_level *binding_level;
+};
+
+struct f_function *f_function_chain;
+
+/* Restore the variables used during compilation of a C function.  */
+
+static void
+pop_f_function_context (void)
+{
+  struct f_function *p = f_function_chain;
+  tree link;
+
+  /* Bring back all the labels that were shadowed.  */
+  for (link = shadowed_labels; link; link = TREE_CHAIN (link))
+    if (DECL_NAME (TREE_VALUE (link)) != 0)
+      IDENTIFIER_LABEL_VALUE (DECL_NAME (TREE_VALUE (link)))
+	= TREE_VALUE (link);
+
+  if (current_function_decl != error_mark_node
+      && DECL_SAVED_INSNS (current_function_decl) == 0)
+    {
+      /* Stop pointing to the local nodes about to be freed.  */
+      /* But DECL_INITIAL must remain nonzero so we know this was an actual
+	 function definition.  */
+      DECL_INITIAL (current_function_decl) = error_mark_node;
+      DECL_ARGUMENTS (current_function_decl) = 0;
+    }
+
+  pop_function_context ();
+
+  f_function_chain = p->next;
+
+  named_labels = p->named_labels;
+  shadowed_labels = p->shadowed_labels;
+  current_binding_level = p->binding_level;
+
+  free (p);
+}
+
+/* Save and reinitialize the variables
+   used during compilation of a C function.  */
+
+static void
+push_f_function_context (void)
+{
+  struct f_function *p = xmalloc (sizeof (struct f_function));
+
+  push_function_context ();
+
+  p->next = f_function_chain;
+  f_function_chain = p;
+
+  p->named_labels = named_labels;
+  p->shadowed_labels = shadowed_labels;
+  p->binding_level = current_binding_level;
+}
+
+static void
+push_parm_decl (tree parm)
+{
+  int old_immediate_size_expand = immediate_size_expand;
+
+  /* Don't try computing parm sizes now -- wait till fn is called.  */
+
+  immediate_size_expand = 0;
+
+  /* Fill in arg stuff.  */
+
+  DECL_ARG_TYPE (parm) = TREE_TYPE (parm);
+  DECL_ARG_TYPE_AS_WRITTEN (parm) = TREE_TYPE (parm);
+  TREE_READONLY (parm) = 1;	/* All implementation args are read-only. */
+
+  parm = pushdecl (parm);
+
+  immediate_size_expand = old_immediate_size_expand;
+
+  finish_decl (parm, NULL_TREE, FALSE);
+}
+
+/* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL, if appropriate.  */
+
+static tree
+pushdecl_top_level (tree x)
+{
+  register tree t;
+  register struct f_binding_level *b = current_binding_level;
+  register tree f = current_function_decl;
+
+  current_binding_level = global_binding_level;
+  current_function_decl = NULL_TREE;
+  t = pushdecl (x);
+  current_binding_level = b;
+  current_function_decl = f;
+  return t;
+}
+
+/* Store the list of declarations of the current level.
+   This is done for the parameter declarations of a function being defined,
+   after they are modified in the light of any missing parameters.  */
+
+static tree
+storedecls (tree decls)
+{
+  return current_binding_level->names = decls;
+}
+
+/* Store the parameter declarations into the current function declaration.
+   This is called after parsing the parameter declarations, before
+   digesting the body of the function.
+
+   For an old-style definition, modify the function's type
+   to specify at least the number of arguments.  */
+
+static void
+store_parm_decls (int is_main_program UNUSED)
+{
+  register tree fndecl = current_function_decl;
+
+  if (fndecl == error_mark_node)
+    return;
+
+  /* This is a chain of PARM_DECLs from old-style parm declarations.  */
+  DECL_ARGUMENTS (fndecl) = storedecls (nreverse (getdecls ()));
+
+  /* Initialize the RTL code for the function.  */
+  init_function_start (fndecl);
+
+  /* Set up parameters and prepare for return, for the function.  */
+  expand_function_start (fndecl, 0);
+}
+
+static tree
+start_decl (tree decl, bool is_top_level)
+{
+  register tree tem;
+  bool at_top_level = (current_binding_level == global_binding_level);
+  bool top_level = is_top_level || at_top_level;
+
+  /* Caller should pass TRUE for is_top_level only if we wouldn't be at top
+     level anyway.  */
+  assert (!is_top_level || !at_top_level);
+
+  if (DECL_INITIAL (decl) != NULL_TREE)
+    {
+      assert (DECL_INITIAL (decl) == error_mark_node);
+      assert (!DECL_EXTERNAL (decl));
+    }
+  else if (top_level)
+    assert ((TREE_STATIC (decl) == 1) || DECL_EXTERNAL (decl) == 1);
+
+  /* For Fortran, we by default put things in .common when possible.  */
+  DECL_COMMON (decl) = 1;
+
+  /* Add this decl to the current binding level. TEM may equal DECL or it may
+     be a previous decl of the same name.  */
+  if (is_top_level)
+    tem = pushdecl_top_level (decl);
+  else
+    tem = pushdecl (decl);
+
+  /* For a local variable, define the RTL now.  */
+  if (!top_level
+  /* But not if this is a duplicate decl and we preserved the rtl from the
+     previous one (which may or may not happen).  */
+      && !DECL_RTL_SET_P (tem))
+    {
+      if (TYPE_SIZE (TREE_TYPE (tem)) != 0)
+	expand_decl (tem);
+      else if (TREE_CODE (TREE_TYPE (tem)) == ARRAY_TYPE
+	       && DECL_INITIAL (tem) != 0)
+	expand_decl (tem);
+    }
+
+  return tem;
+}
+
+/* Create the FUNCTION_DECL for a function definition.
+   DECLSPECS and DECLARATOR are the parts of the declaration;
+   they describe the function's name and the type it returns,
+   but twisted together in a fashion that parallels the syntax of C.
+
+   This function creates a binding context for the function body
+   as well as setting up the FUNCTION_DECL in current_function_decl.
+
+   Returns 1 on success.  If the DECLARATOR is not suitable for a function
+   (it defines a datum instead), we return 0, which tells
+   ffe_parse_file to report a parse error.
+
+   NESTED is nonzero for a function nested within another function.  */
+
+static void
+start_function (tree name, tree type, int nested, int public)
+{
+  tree decl1;
+  tree restype;
+  int old_immediate_size_expand = immediate_size_expand;
+
+  named_labels = 0;
+  shadowed_labels = 0;
+
+  /* Don't expand any sizes in the return type of the function.  */
+  immediate_size_expand = 0;
+
+  if (nested)
+    {
+      assert (!public);
+      assert (current_function_decl != NULL_TREE);
+      assert (DECL_CONTEXT (current_function_decl) == NULL_TREE);
+    }
+  else
+    {
+      assert (current_function_decl == NULL_TREE);
+    }
+
+  if (TREE_CODE (type) == ERROR_MARK)
+    decl1 = current_function_decl = error_mark_node;
+  else
+    {
+      decl1 = build_decl (FUNCTION_DECL,
+			  name,
+			  type);
+      TREE_PUBLIC (decl1) = public ? 1 : 0;
+      if (nested)
+	DECL_INLINE (decl1) = 1;
+      TREE_STATIC (decl1) = 1;
+      DECL_EXTERNAL (decl1) = 0;
+
+      announce_function (decl1);
+
+      /* Make the init_value nonzero so pushdecl knows this is not tentative.
+	 error_mark_node is replaced below (in poplevel) with the BLOCK.  */
+      DECL_INITIAL (decl1) = error_mark_node;
+
+      /* Record the decl so that the function name is defined. If we already have
+	 a decl for this name, and it is a FUNCTION_DECL, use the old decl.  */
+
+      current_function_decl = pushdecl (decl1);
+    }
+
+  if (!nested)
+    ffecom_outer_function_decl_ = current_function_decl;
+
+  pushlevel (0);
+  current_binding_level->prep_state = 2;
+
+  if (TREE_CODE (current_function_decl) != ERROR_MARK)
+    {
+      make_decl_rtl (current_function_decl, NULL);
+
+      restype = TREE_TYPE (TREE_TYPE (current_function_decl));
+      DECL_RESULT (current_function_decl)
+	= build_decl (RESULT_DECL, NULL_TREE, restype);
+    }
+
+  if (!nested && (TREE_CODE (current_function_decl) != ERROR_MARK))
+    TREE_ADDRESSABLE (current_function_decl) = 1;
+
+  immediate_size_expand = old_immediate_size_expand;
+}
+
+/* Here are the public functions the GNU back end needs.  */
+
+tree
+convert (tree type, tree expr)
+{
+  register tree e = expr;
+  register enum tree_code code = TREE_CODE (type);
+
+  if (type == TREE_TYPE (e)
+      || TREE_CODE (e) == ERROR_MARK)
+    return e;
+  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (e)))
+    return fold (build1 (NOP_EXPR, type, e));
+  if (TREE_CODE (TREE_TYPE (e)) == ERROR_MARK
+      || code == ERROR_MARK)
+    return error_mark_node;
+  if (TREE_CODE (TREE_TYPE (e)) == VOID_TYPE)
+    {
+      assert ("void value not ignored as it ought to be" == NULL);
+      return error_mark_node;
+    }
+  if (code == VOID_TYPE)
+    return build1 (CONVERT_EXPR, type, e);
+  if ((code != RECORD_TYPE)
+      && (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE))
+    e = ffecom_1 (REALPART_EXPR, TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e))),
+		  e);
+  if (code == INTEGER_TYPE || code == ENUMERAL_TYPE)
+    return fold (convert_to_integer (type, e));
+  if (code == POINTER_TYPE)
+    return fold (convert_to_pointer (type, e));
+  if (code == REAL_TYPE)
+    return fold (convert_to_real (type, e));
+  if (code == COMPLEX_TYPE)
+    return fold (convert_to_complex (type, e));
+  if (code == RECORD_TYPE)
+    return fold (ffecom_convert_to_complex_ (type, e));
+
+  assert ("conversion to non-scalar type requested" == NULL);
+  return error_mark_node;
+}
+
+/* Return the list of declarations of the current level.
+   Note that this list is in reverse order unless/until
+   you nreverse it; and when you do nreverse it, you must
+   store the result back using `storedecls' or you will lose.  */
+
+tree
+getdecls (void)
+{
+  return current_binding_level->names;
+}
+
+/* Nonzero if we are currently in the global binding level.  */
+
+int
+global_bindings_p (void)
+{
+  return current_binding_level == global_binding_level;
+}
+
+static void
+ffecom_init_decl_processing (void)
+{
+  malloc_init ();
+
+  ffe_init_0 ();
+}
+
+/* Delete the node BLOCK from the current binding level.
+   This is used for the block inside a stmt expr ({...})
+   so that the block can be reinserted where appropriate.  */
+
+static void
+delete_block (tree block)
+{
+  tree t;
+  if (current_binding_level->blocks == block)
+    current_binding_level->blocks = TREE_CHAIN (block);
+  for (t = current_binding_level->blocks; t;)
+    {
+      if (TREE_CHAIN (t) == block)
+	TREE_CHAIN (t) = TREE_CHAIN (block);
+      else
+	t = TREE_CHAIN (t);
+    }
+  TREE_CHAIN (block) = NULL;
+  /* Clear TREE_USED which is always set by poplevel.
+     The flag is set again if insert_block is called.  */
+  TREE_USED (block) = 0;
+}
+
+void
+insert_block (tree block)
+{
+  TREE_USED (block) = 1;
+  current_binding_level->blocks
+    = chainon (current_binding_level->blocks, block);
+}
+
+/* Each front end provides its own.  */
+static bool ffe_init (void);
+static void ffe_finish (void);
+static bool ffe_post_options (const char **);
+static void ffe_print_identifier (FILE *, tree, int);
+
+struct language_function GTY(())
+{
+  int unused;
+};
+
+#undef  LANG_HOOKS_NAME
+#define LANG_HOOKS_NAME			"GNU F77"
+#undef  LANG_HOOKS_INIT
+#define LANG_HOOKS_INIT			ffe_init
+#undef  LANG_HOOKS_FINISH
+#define LANG_HOOKS_FINISH		ffe_finish
+#undef  LANG_HOOKS_INIT_OPTIONS
+#define LANG_HOOKS_INIT_OPTIONS		ffe_init_options
+#undef  LANG_HOOKS_HANDLE_OPTION
+#define LANG_HOOKS_HANDLE_OPTION	ffe_handle_option
+#undef  LANG_HOOKS_POST_OPTIONS
+#define LANG_HOOKS_POST_OPTIONS		ffe_post_options
+#undef  LANG_HOOKS_PARSE_FILE
+#define LANG_HOOKS_PARSE_FILE		ffe_parse_file
+#undef  LANG_HOOKS_MARK_ADDRESSABLE
+#define LANG_HOOKS_MARK_ADDRESSABLE	ffe_mark_addressable
+#undef  LANG_HOOKS_PRINT_IDENTIFIER
+#define LANG_HOOKS_PRINT_IDENTIFIER	ffe_print_identifier
+#undef  LANG_HOOKS_DECL_PRINTABLE_NAME
+#define LANG_HOOKS_DECL_PRINTABLE_NAME	ffe_printable_name
+#undef  LANG_HOOKS_PRINT_ERROR_FUNCTION
+#define LANG_HOOKS_PRINT_ERROR_FUNCTION ffe_print_error_function
+#undef  LANG_HOOKS_TRUTHVALUE_CONVERSION
+#define LANG_HOOKS_TRUTHVALUE_CONVERSION ffe_truthvalue_conversion
+
+#undef  LANG_HOOKS_TYPE_FOR_MODE
+#define LANG_HOOKS_TYPE_FOR_MODE	ffe_type_for_mode
+#undef  LANG_HOOKS_TYPE_FOR_SIZE
+#define LANG_HOOKS_TYPE_FOR_SIZE	ffe_type_for_size
+#undef  LANG_HOOKS_SIGNED_TYPE
+#define LANG_HOOKS_SIGNED_TYPE		ffe_signed_type
+#undef  LANG_HOOKS_UNSIGNED_TYPE
+#define LANG_HOOKS_UNSIGNED_TYPE	ffe_unsigned_type
+#undef  LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
+#define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE ffe_signed_or_unsigned_type
+
+/* We do not wish to use alias-set based aliasing at all.  Used in the
+   extreme (every object with its own set, with equivalences recorded) it
+   might be helpful, but there are problems when it comes to inlining.  We
+   get on ok with flag_argument_noalias, and alias-set aliasing does
+   currently limit how stack slots can be reused, which is a lose.  */
+#undef LANG_HOOKS_GET_ALIAS_SET
+#define LANG_HOOKS_GET_ALIAS_SET hook_get_alias_set_0
+
+const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
+
+/* Table indexed by tree code giving a string containing a character
+   classifying the tree code.  Possibilities are
+   t, d, s, c, r, <, 1, 2 and e.  See tree.def for details.  */
+
+#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
+
+const char tree_code_type[] = {
+#include "tree.def"
+};
+#undef DEFTREECODE
+
+/* Table indexed by tree code giving number of expression
+   operands beyond the fixed part of the node structure.
+   Not used for types or decls.  */
+
+#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
+
+const unsigned char tree_code_length[] = {
+#include "tree.def"
+};
+#undef DEFTREECODE
+
+/* Names of tree components.
+   Used for printing out the tree and error messages.  */
+#define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
+
+const char *const tree_code_name[] = {
+#include "tree.def"
+};
+#undef DEFTREECODE
+
+static bool
+ffe_post_options (const char **pfilename)
+{
+  const char *filename = *pfilename;
+
+  /* Open input file.  */
+  if (filename == 0 || !strcmp (filename, "-"))
+    {
+      finput = stdin;
+      filename = "stdin";
+    }
+  else
+    finput = fopen (filename, "r");
+
+  if (finput == 0)
+    fatal_error ("can't open %s: %m", filename);
+
+  return false;
+}
+
+
+static bool
+ffe_init (void)
+{
+#ifdef IO_BUFFER_SIZE
+  setvbuf (finput, xmalloc (IO_BUFFER_SIZE), _IOFBF, IO_BUFFER_SIZE);
+#endif
+
+  ffecom_init_decl_processing ();
+
+  /* If the file is output from cpp, it should contain a first line
+     `# 1 "real-filename"', and the current design of gcc (toplev.c
+     in particular and the way it sets up information relied on by
+     INCLUDE) requires that we read this now, and store the
+     "real-filename" info in master_input_filename.  Ask the lexer
+     to try doing this.  */
+  ffelex_hash_kludge (finput);
+
+  push_srcloc (input_filename, 0);
+
+  /* FIXME: The ffelex_hash_kludge code needs to be cleaned up to
+     set the new file name.  Maybe in ffe_post_options.  */
+  return true;
+}
+
+static void
+ffe_finish (void)
+{
+  ffe_terminate_0 ();
+
+  if (ffe_is_ffedebug ())
+    malloc_pool_display (malloc_pool_image ());
+
+  fclose (finput);
+}
+
+static bool
+ffe_mark_addressable (tree exp)
+{
+  register tree x = exp;
+  while (1)
+    switch (TREE_CODE (x))
+      {
+      case ADDR_EXPR:
+      case COMPONENT_REF:
+      case ARRAY_REF:
+	x = TREE_OPERAND (x, 0);
+	break;
+
+      case CONSTRUCTOR:
+	TREE_ADDRESSABLE (x) = 1;
+	return true;
+
+      case VAR_DECL:
+      case CONST_DECL:
+      case PARM_DECL:
+      case RESULT_DECL:
+	if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x)
+	    && DECL_NONLOCAL (x))
+	  {
+	    if (TREE_PUBLIC (x))
+	      {
+		assert ("address of global register var requested" == NULL);
+		return false;
+	      }
+	    assert ("address of register variable requested" == NULL);
+	  }
+	else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x))
+	  {
+	    if (TREE_PUBLIC (x))
+	      {
+		assert ("address of global register var requested" == NULL);
+		return false;
+	      }
+	    assert ("address of register var requested" == NULL);
+	  }
+	put_var_into_stack (x, /*rescan=*/true);
+
+	/* drops in */
+      case FUNCTION_DECL:
+	TREE_ADDRESSABLE (x) = 1;
+#if 0				/* poplevel deals with this now.  */
+	if (DECL_CONTEXT (x) == 0)
+	  TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (x)) = 1;
+#endif
+
+      default:
+	return true;
+      }
+}
+
+/* Exit a binding level.
+   Pop the level off, and restore the state of the identifier-decl mappings
+   that were in effect when this level was entered.
+
+   If KEEP is nonzero, this level had explicit declarations, so
+   and create a "block" (a BLOCK node) for the level
+   to record its declarations and subblocks for symbol table output.
+
+   If FUNCTIONBODY is nonzero, this level is the body of a function,
+   so create a block as if KEEP were set and also clear out all
+   label names.
+
+   If REVERSE is nonzero, reverse the order of decls before putting
+   them into the BLOCK.  */
+
+tree
+poplevel (int keep, int reverse, int functionbody)
+{
+  register tree link;
+  /* The chain of decls was accumulated in reverse order.
+     Put it into forward order, just for cleanliness.  */
+  tree decls;
+  tree subblocks = current_binding_level->blocks;
+  tree block = 0;
+  tree decl;
+  int block_previously_created;
+
+  /* Get the decls in the order they were written.
+     Usually current_binding_level->names is in reverse order.
+     But parameter decls were previously put in forward order.  */
+
+  if (reverse)
+    current_binding_level->names
+      = decls = nreverse (current_binding_level->names);
+  else
+    decls = current_binding_level->names;
+
+  /* Output any nested inline functions within this block
+     if they weren't already output.  */
+
+  for (decl = decls; decl; decl = TREE_CHAIN (decl))
+    if (TREE_CODE (decl) == FUNCTION_DECL
+	&& ! TREE_ASM_WRITTEN (decl)
+	&& DECL_INITIAL (decl) != 0
+	&& TREE_ADDRESSABLE (decl))
+      {
+	/* If this decl was copied from a file-scope decl
+	   on account of a block-scope extern decl,
+	   propagate TREE_ADDRESSABLE to the file-scope decl.
+
+	   DECL_ABSTRACT_ORIGIN can be set to itself if warn_return_type is
+	   true, since then the decl goes through save_for_inline_copying.  */
+	if (DECL_ABSTRACT_ORIGIN (decl) != 0
+	    && DECL_ABSTRACT_ORIGIN (decl) != decl)
+	  TREE_ADDRESSABLE (DECL_ABSTRACT_ORIGIN (decl)) = 1;
+	else if (DECL_SAVED_INSNS (decl) != 0)
+	  {
+	    push_function_context ();
+	    output_inline_function (decl);
+	    pop_function_context ();
+	  }
+      }
+
+  /* If there were any declarations or structure tags in that level,
+     or if this level is a function body,
+     create a BLOCK to record them for the life of this function.  */
+
+  block = 0;
+  block_previously_created = (current_binding_level->this_block != 0);
+  if (block_previously_created)
+    block = current_binding_level->this_block;
+  else if (keep || functionbody)
+    block = make_node (BLOCK);
+  if (block != 0)
+    {
+      BLOCK_VARS (block) = decls;
+      BLOCK_SUBBLOCKS (block) = subblocks;
+    }
+
+  /* In each subblock, record that this is its superior.  */
+
+  for (link = subblocks; link; link = TREE_CHAIN (link))
+    BLOCK_SUPERCONTEXT (link) = block;
+
+  /* Clear out the meanings of the local variables of this level.  */
+
+  for (link = decls; link; link = TREE_CHAIN (link))
+    {
+      if (DECL_NAME (link) != 0)
+	{
+	  /* If the ident. was used or addressed via a local extern decl,
+	     don't forget that fact.  */
+	  if (DECL_EXTERNAL (link))
+	    {
+	      if (TREE_USED (link))
+		TREE_USED (DECL_NAME (link)) = 1;
+	      if (TREE_ADDRESSABLE (link))
+		TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (link)) = 1;
+	    }
+	  IDENTIFIER_LOCAL_VALUE (DECL_NAME (link)) = 0;
+	}
+    }
+
+  /* If the level being exited is the top level of a function,
+     check over all the labels, and clear out the current
+     (function local) meanings of their names.  */
+
+  if (functionbody)
+    {
+      /* If this is the top level block of a function,
+	 the vars are the function's parameters.
+	 Don't leave them in the BLOCK because they are
+	 found in the FUNCTION_DECL instead.  */
+
+      BLOCK_VARS (block) = 0;
+    }
+
+  /* Pop the current level, and free the structure for reuse.  */
+
+  {
+    register struct f_binding_level *level = current_binding_level;
+    current_binding_level = current_binding_level->level_chain;
+
+    level->level_chain = free_binding_level;
+    free_binding_level = level;
+  }
+
+  /* Dispose of the block that we just made inside some higher level.  */
+  if (functionbody
+      && current_function_decl != error_mark_node)
+    DECL_INITIAL (current_function_decl) = block;
+  else if (block)
+    {
+      if (!block_previously_created)
+	current_binding_level->blocks
+	  = chainon (current_binding_level->blocks, block);
+    }
+  /* If we did not make a block for the level just exited,
+     any blocks made for inner levels
+     (since they cannot be recorded as subblocks in that level)
+     must be carried forward so they will later become subblocks
+     of something else.  */
+  else if (subblocks)
+    current_binding_level->blocks
+      = chainon (current_binding_level->blocks, subblocks);
+
+  if (block)
+    TREE_USED (block) = 1;
+  return block;
+}
+
+static void
+ffe_print_identifier (FILE *file, tree node, int indent)
+{
+  print_node (file, "global", IDENTIFIER_GLOBAL_VALUE (node), indent + 4);
+  print_node (file, "local", IDENTIFIER_LOCAL_VALUE (node), indent + 4);
+}
+
+/* Record a decl-node X as belonging to the current lexical scope.
+   Check for errors (such as an incompatible declaration for the same
+   name already seen in the same scope).
+
+   Returns either X or an old decl for the same name.
+   If an old decl is returned, it may have been smashed
+   to agree with what X says.  */
+
+tree
+pushdecl (tree x)
+{
+  register tree t;
+  register tree name = DECL_NAME (x);
+  register struct f_binding_level *b = current_binding_level;
+
+  if ((TREE_CODE (x) == FUNCTION_DECL)
+      && (DECL_INITIAL (x) == 0)
+      && DECL_EXTERNAL (x))
+    DECL_CONTEXT (x) = NULL_TREE;
+  else
+    DECL_CONTEXT (x) = current_function_decl;
+
+  if (name)
+    {
+      if (IDENTIFIER_INVENTED (name))
+	{
+	  DECL_ARTIFICIAL (x) = 1;
+	  DECL_IN_SYSTEM_HEADER (x) = 1;
+	}
+
+      t = lookup_name_current_level (name);
+
+      assert ((t == NULL_TREE) || (DECL_CONTEXT (x) == NULL_TREE));
+
+      /* Don't push non-parms onto list for parms until we understand
+	 why we're doing this and whether it works.  */
+
+      assert ((b == global_binding_level)
+	      || !ffecom_transform_only_dummies_
+	      || TREE_CODE (x) == PARM_DECL);
+
+      if ((t != NULL_TREE) && duplicate_decls (x, t))
+	return t;
+
+      /* If we are processing a typedef statement, generate a whole new
+	 ..._TYPE node (which will be just an variant of the existing
+	 ..._TYPE node with identical properties) and then install the
+	 TYPE_DECL node generated to represent the typedef name as the
+	 TYPE_NAME of this brand new (duplicate) ..._TYPE node.
+
+	 The whole point here is to end up with a situation where each and every
+	 ..._TYPE node the compiler creates will be uniquely associated with
+	 AT MOST one node representing a typedef name. This way, even though
+	 the compiler substitutes corresponding ..._TYPE nodes for TYPE_DECL
+	 (i.e. "typedef name") nodes very early on, later parts of the
+	 compiler can always do the reverse translation and get back the
+	 corresponding typedef name.  For example, given:
+
+	 typedef struct S MY_TYPE; MY_TYPE object;
+
+	 Later parts of the compiler might only know that `object' was of type
+	 `struct S' if it were not for code just below.  With this code
+	 however, later parts of the compiler see something like:
+
+	 struct S' == struct S typedef struct S' MY_TYPE; struct S' object;
+
+	 And they can then deduce (from the node for type struct S') that the
+	 original object declaration was:
+
+	 MY_TYPE object;
+
+	 Being able to do this is important for proper support of protoize, and
+	 also for generating precise symbolic debugging information which
+	 takes full account of the programmer's (typedef) vocabulary.
+
+	 Obviously, we don't want to generate a duplicate ..._TYPE node if the
+	 TYPE_DECL node that we are now processing really represents a
+	 standard built-in type.
+
+	 Since all standard types are effectively declared at line zero in the
+	 source file, we can easily check to see if we are working on a
+	 standard type by checking the current value of lineno.  */
+
+      if (TREE_CODE (x) == TYPE_DECL)
+	{
+	  if (DECL_SOURCE_LINE (x) == 0)
+	    {
+	      if (TYPE_NAME (TREE_TYPE (x)) == 0)
+		TYPE_NAME (TREE_TYPE (x)) = x;
+	    }
+	  else if (TREE_TYPE (x) != error_mark_node)
+	    {
+	      tree tt = TREE_TYPE (x);
+
+	      tt = build_type_copy (tt);
+	      TYPE_NAME (tt) = x;
+	      TREE_TYPE (x) = tt;
+	    }
+	}
+
+      /* This name is new in its binding level. Install the new declaration
+	 and return it.  */
+      if (b == global_binding_level)
+	IDENTIFIER_GLOBAL_VALUE (name) = x;
+      else
+	IDENTIFIER_LOCAL_VALUE (name) = x;
+    }
+
+  /* Put decls on list in reverse order. We will reverse them later if
+     necessary.  */
+  TREE_CHAIN (x) = b->names;
+  b->names = x;
+
+  return x;
+}
+
+/* Nonzero if the current level needs to have a BLOCK made.  */
+
+static int
+kept_level_p (void)
+{
+  tree decl;
+
+  for (decl = current_binding_level->names;
+       decl;
+       decl = TREE_CHAIN (decl))
+    {
+      if (TREE_USED (decl) || TREE_CODE (decl) != VAR_DECL
+	  || (DECL_NAME (decl) && ! DECL_ARTIFICIAL (decl)))
+	/* Currently, there aren't supposed to be non-artificial names
+	   at other than the top block for a function -- they're
+	   believed to always be temps.  But it's wise to check anyway.  */
+	return 1;
+    }
+  return 0;
+}
+
+/* Enter a new binding level.
+   If TAG_TRANSPARENT is nonzero, do so only for the name space of variables,
+   not for that of tags.  */
+
+void
+pushlevel (int tag_transparent)
+{
+  register struct f_binding_level *newlevel = NULL_BINDING_LEVEL;
+
+  assert (! tag_transparent);
+
+  if (current_binding_level == global_binding_level)
+    {
+      named_labels = 0;
+    }
+
+  /* Reuse or create a struct for this binding level.  */
+
+  if (free_binding_level)
+    {
+      newlevel = free_binding_level;
+      free_binding_level = free_binding_level->level_chain;
+    }
+  else
+    {
+      newlevel = make_binding_level ();
+    }
+
+  /* Add this level to the front of the chain (stack) of levels that
+     are active.  */
+
+  *newlevel = clear_binding_level;
+  newlevel->level_chain = current_binding_level;
+  current_binding_level = newlevel;
+}
+
+/* Set the BLOCK node for the innermost scope
+   (the one we are currently in).  */
+
+void
+set_block (tree block)
+{
+  current_binding_level->this_block = block;
+  current_binding_level->names = chainon (current_binding_level->names,
+					  BLOCK_VARS (block));
+  current_binding_level->blocks = chainon (current_binding_level->blocks,
+					   BLOCK_SUBBLOCKS (block));
+}
+
+static tree
+ffe_signed_or_unsigned_type (int unsignedp, tree type)
+{
+  tree type2;
+
+  if (! INTEGRAL_TYPE_P (type))
+    return type;
+  if (TYPE_PRECISION (type) == TYPE_PRECISION (signed_char_type_node))
+    return unsignedp ? unsigned_char_type_node : signed_char_type_node;
+  if (TYPE_PRECISION (type) == TYPE_PRECISION (integer_type_node))
+    return unsignedp ? unsigned_type_node : integer_type_node;
+  if (TYPE_PRECISION (type) == TYPE_PRECISION (short_integer_type_node))
+    return unsignedp ? short_unsigned_type_node : short_integer_type_node;
+  if (TYPE_PRECISION (type) == TYPE_PRECISION (long_integer_type_node))
+    return unsignedp ? long_unsigned_type_node : long_integer_type_node;
+  if (TYPE_PRECISION (type) == TYPE_PRECISION (long_long_integer_type_node))
+    return (unsignedp ? long_long_unsigned_type_node
+	    : long_long_integer_type_node);
+
+  type2 = ffe_type_for_size (TYPE_PRECISION (type), unsignedp);
+  if (type2 == NULL_TREE)
+    return type;
+
+  return type2;
+}
+
+static tree
+ffe_signed_type (tree type)
+{
+  tree type1 = TYPE_MAIN_VARIANT (type);
+  ffeinfoKindtype kt;
+  tree type2;
+
+  if (type1 == unsigned_char_type_node || type1 == char_type_node)
+    return signed_char_type_node;
+  if (type1 == unsigned_type_node)
+    return integer_type_node;
+  if (type1 == short_unsigned_type_node)
+    return short_integer_type_node;
+  if (type1 == long_unsigned_type_node)
+    return long_integer_type_node;
+  if (type1 == long_long_unsigned_type_node)
+    return long_long_integer_type_node;
+#if 0	/* gcc/c-* files only */
+  if (type1 == unsigned_intDI_type_node)
+    return intDI_type_node;
+  if (type1 == unsigned_intSI_type_node)
+    return intSI_type_node;
+  if (type1 == unsigned_intHI_type_node)
+    return intHI_type_node;
+  if (type1 == unsigned_intQI_type_node)
+    return intQI_type_node;
+#endif
+
+  type2 = ffe_type_for_size (TYPE_PRECISION (type1), 0);
+  if (type2 != NULL_TREE)
+    return type2;
+
+  for (kt = 0; kt < ARRAY_SIZE (ffecom_tree_type[0]); ++kt)
+    {
+      type2 = ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt];
+
+      if (type1 == type2)
+	return ffecom_tree_type[FFEINFO_basictypeINTEGER][kt];
+    }
+
+  return type;
+}
+
+/* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
+   or validate its data type for an `if' or `while' statement or ?..: exp.
+
+   This preparation consists of taking the ordinary
+   representation of an expression expr and producing a valid tree
+   boolean expression describing whether expr is nonzero.  We could
+   simply always do build_binary_op (NE_EXPR, expr, integer_zero_node, 1),
+   but we optimize comparisons, &&, ||, and !.
+
+   The resulting type should always be `integer_type_node'.  */
+
+static tree
+ffe_truthvalue_conversion (tree expr)
+{
+  if (TREE_CODE (expr) == ERROR_MARK)
+    return expr;
+
+#if 0 /* This appears to be wrong for C++.  */
+  /* These really should return error_mark_node after 2.4 is stable.
+     But not all callers handle ERROR_MARK properly.  */
+  switch (TREE_CODE (TREE_TYPE (expr)))
+    {
+    case RECORD_TYPE:
+      error ("struct type value used where scalar is required");
+      return integer_zero_node;
+
+    case UNION_TYPE:
+      error ("union type value used where scalar is required");
+      return integer_zero_node;
+
+    case ARRAY_TYPE:
+      error ("array type value used where scalar is required");
+      return integer_zero_node;
+
+    default:
+      break;
+    }
+#endif /* 0 */
+
+  switch (TREE_CODE (expr))
+    {
+      /* It is simpler and generates better code to have only TRUTH_*_EXPR
+	 or comparison expressions as truth values at this level.  */
+#if 0
+    case COMPONENT_REF:
+      /* A one-bit unsigned bit-field is already acceptable.  */
+      if (1 == TREE_INT_CST_LOW (DECL_SIZE (TREE_OPERAND (expr, 1)))
+	  && TREE_UNSIGNED (TREE_OPERAND (expr, 1)))
+	return expr;
+      break;
+#endif
+
+    case EQ_EXPR:
+      /* It is simpler and generates better code to have only TRUTH_*_EXPR
+	 or comparison expressions as truth values at this level.  */
+#if 0
+      if (integer_zerop (TREE_OPERAND (expr, 1)))
+	return build_unary_op (TRUTH_NOT_EXPR, TREE_OPERAND (expr, 0), 0);
+#endif
+    case NE_EXPR: case LE_EXPR: case GE_EXPR: case LT_EXPR: case GT_EXPR:
+    case TRUTH_ANDIF_EXPR:
+    case TRUTH_ORIF_EXPR:
+    case TRUTH_AND_EXPR:
+    case TRUTH_OR_EXPR:
+    case TRUTH_XOR_EXPR:
+      TREE_TYPE (expr) = integer_type_node;
+      return expr;
+
+    case ERROR_MARK:
+      return expr;
+
+    case INTEGER_CST:
+      return integer_zerop (expr) ? integer_zero_node : integer_one_node;
+
+    case REAL_CST:
+      return real_zerop (expr) ? integer_zero_node : integer_one_node;
+
+    case ADDR_EXPR:
+      if (TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 0)))
+	return build (COMPOUND_EXPR, integer_type_node,
+		      TREE_OPERAND (expr, 0), integer_one_node);
+      else
+	return integer_one_node;
+
+    case COMPLEX_EXPR:
+      return ffecom_2 ((TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 1))
+			? TRUTH_OR_EXPR : TRUTH_ORIF_EXPR),
+		       integer_type_node,
+		       ffe_truthvalue_conversion (TREE_OPERAND (expr, 0)),
+		       ffe_truthvalue_conversion (TREE_OPERAND (expr, 1)));
+
+    case NEGATE_EXPR:
+    case ABS_EXPR:
+    case FLOAT_EXPR:
+      /* These don't change whether an object is nonzero or zero.  */
+      return ffe_truthvalue_conversion (TREE_OPERAND (expr, 0));
+
+    case LROTATE_EXPR:
+    case RROTATE_EXPR:
+      /* These don't change whether an object is zero or nonzero, but
+	 we can't ignore them if their second arg has side-effects.  */
+      if (TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 1)))
+	return build (COMPOUND_EXPR, integer_type_node, TREE_OPERAND (expr, 1),
+		      ffe_truthvalue_conversion (TREE_OPERAND (expr, 0)));
+      else
+	return ffe_truthvalue_conversion (TREE_OPERAND (expr, 0));
+
+    case COND_EXPR:
+      {
+	/* Distribute the conversion into the arms of a COND_EXPR.  */
+	tree arg1 = TREE_OPERAND (expr, 1);
+	tree arg2 = TREE_OPERAND (expr, 2);
+	if (! VOID_TYPE_P (TREE_TYPE (arg1)))
+	  arg1 = ffe_truthvalue_conversion (arg1);
+	if (! VOID_TYPE_P (TREE_TYPE (arg2)))
+	  arg2 = ffe_truthvalue_conversion (arg2);
+	return fold (build (COND_EXPR, integer_type_node,
+			    TREE_OPERAND (expr, 0), arg1, arg2));
+      }
+
+    case CONVERT_EXPR:
+      /* Don't cancel the effect of a CONVERT_EXPR from a REFERENCE_TYPE,
+	 since that affects how `default_conversion' will behave.  */
+      if (TREE_CODE (TREE_TYPE (expr)) == REFERENCE_TYPE
+	  || TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) == REFERENCE_TYPE)
+	break;
+      /* fall through... */
+    case NOP_EXPR:
+      /* If this is widening the argument, we can ignore it.  */
+      if (TYPE_PRECISION (TREE_TYPE (expr))
+	  >= TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (expr, 0))))
+	return ffe_truthvalue_conversion (TREE_OPERAND (expr, 0));
+      break;
+
+    case MINUS_EXPR:
+      /* With IEEE arithmetic, x - x may not equal 0, so we can't optimize
+	 this case.  */
+      if (TARGET_FLOAT_FORMAT == IEEE_FLOAT_FORMAT
+	  && TREE_CODE (TREE_TYPE (expr)) == REAL_TYPE)
+	break;
+      /* fall through... */
+    case BIT_XOR_EXPR:
+      /* This and MINUS_EXPR can be changed into a comparison of the
+	 two objects.  */
+      if (TREE_TYPE (TREE_OPERAND (expr, 0))
+	  == TREE_TYPE (TREE_OPERAND (expr, 1)))
+	return ffecom_2 (NE_EXPR, integer_type_node,
+			 TREE_OPERAND (expr, 0),
+			 TREE_OPERAND (expr, 1));
+      return ffecom_2 (NE_EXPR, integer_type_node,
+		       TREE_OPERAND (expr, 0),
+		       fold (build1 (NOP_EXPR,
+				     TREE_TYPE (TREE_OPERAND (expr, 0)),
+				     TREE_OPERAND (expr, 1))));
+
+    case BIT_AND_EXPR:
+      if (integer_onep (TREE_OPERAND (expr, 1)))
+	return expr;
+      break;
+
+    case MODIFY_EXPR:
+#if 0				/* No such thing in Fortran. */
+      if (warn_parentheses && C_EXP_ORIGINAL_CODE (expr) == MODIFY_EXPR)
+	warning ("suggest parentheses around assignment used as truth value");
+#endif
+      break;
+
+    default:
+      break;
+    }
+
+  if (TREE_CODE (TREE_TYPE (expr)) == COMPLEX_TYPE)
+    return (ffecom_2
+	    ((TREE_SIDE_EFFECTS (expr)
+	      ? TRUTH_OR_EXPR : TRUTH_ORIF_EXPR),
+	     integer_type_node,
+	     ffe_truthvalue_conversion (ffecom_1 (REALPART_EXPR,
+						  TREE_TYPE (TREE_TYPE (expr)),
+						  expr)),
+	     ffe_truthvalue_conversion (ffecom_1 (IMAGPART_EXPR,
+						  TREE_TYPE (TREE_TYPE (expr)),
+						  expr))));
+
+  return ffecom_2 (NE_EXPR, integer_type_node,
+		   expr,
+		   convert (TREE_TYPE (expr), integer_zero_node));
+}
+
+static tree
+ffe_type_for_mode (enum machine_mode mode, int unsignedp)
+{
+  int i;
+  int j;
+  tree t;
+
+  if (mode == TYPE_MODE (integer_type_node))
+    return unsignedp ? unsigned_type_node : integer_type_node;
+
+  if (mode == TYPE_MODE (signed_char_type_node))
+    return unsignedp ? unsigned_char_type_node : signed_char_type_node;
+
+  if (mode == TYPE_MODE (short_integer_type_node))
+    return unsignedp ? short_unsigned_type_node : short_integer_type_node;
+
+  if (mode == TYPE_MODE (long_integer_type_node))
+    return unsignedp ? long_unsigned_type_node : long_integer_type_node;
+
+  if (mode == TYPE_MODE (long_long_integer_type_node))
+    return unsignedp ? long_long_unsigned_type_node : long_long_integer_type_node;
+
+#if HOST_BITS_PER_WIDE_INT >= 64
+  if (mode == TYPE_MODE (intTI_type_node))
+    return unsignedp ? unsigned_intTI_type_node : intTI_type_node;
+#endif
+
+  if (mode == TYPE_MODE (float_type_node))
+    return float_type_node;
+
+  if (mode == TYPE_MODE (double_type_node))
+    return double_type_node;
+
+  if (mode == TYPE_MODE (long_double_type_node))
+    return long_double_type_node;
+
+ if (mode == TYPE_MODE (build_pointer_type (char_type_node)))
+    return build_pointer_type (char_type_node);
+
+  if (mode == TYPE_MODE (build_pointer_type (integer_type_node)))
+    return build_pointer_type (integer_type_node);
+
+  for (i = 0; ((size_t) i) < ARRAY_SIZE (ffecom_tree_type); ++i)
+    for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j)
+      {
+	if (((t = ffecom_tree_type[i][j]) != NULL_TREE)
+	    && (mode == TYPE_MODE (t)))
+	  {
+	    if ((i == FFEINFO_basictypeINTEGER) && unsignedp)
+	      return ffecom_tree_type[FFEINFO_basictypeHOLLERITH][j];
+	    else
+	      return t;
+	  }
+      }
+
+  return 0;
+}
+
+static tree
+ffe_type_for_size (unsigned bits, int unsignedp)
+{
+  ffeinfoKindtype kt;
+  tree type_node;
+
+  if (bits == TYPE_PRECISION (integer_type_node))
+    return unsignedp ? unsigned_type_node : integer_type_node;
+
+  if (bits == TYPE_PRECISION (signed_char_type_node))
+    return unsignedp ? unsigned_char_type_node : signed_char_type_node;
+
+  if (bits == TYPE_PRECISION (short_integer_type_node))
+    return unsignedp ? short_unsigned_type_node : short_integer_type_node;
+
+  if (bits == TYPE_PRECISION (long_integer_type_node))
+    return unsignedp ? long_unsigned_type_node : long_integer_type_node;
+
+  if (bits == TYPE_PRECISION (long_long_integer_type_node))
+    return (unsignedp ? long_long_unsigned_type_node
+	    : long_long_integer_type_node);
+
+  for (kt = 0; kt < ARRAY_SIZE (ffecom_tree_type[0]); ++kt)
+    {
+      type_node = ffecom_tree_type[FFEINFO_basictypeINTEGER][kt];
+
+      if ((type_node != NULL_TREE) && (bits == TYPE_PRECISION (type_node)))
+	return unsignedp ? ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt]
+	  : type_node;
+    }
+
+  return 0;
+}
+
+static tree
+ffe_unsigned_type (tree type)
+{
+  tree type1 = TYPE_MAIN_VARIANT (type);
+  ffeinfoKindtype kt;
+  tree type2;
+
+  if (type1 == signed_char_type_node || type1 == char_type_node)
+    return unsigned_char_type_node;
+  if (type1 == integer_type_node)
+    return unsigned_type_node;
+  if (type1 == short_integer_type_node)
+    return short_unsigned_type_node;
+  if (type1 == long_integer_type_node)
+    return long_unsigned_type_node;
+  if (type1 == long_long_integer_type_node)
+    return long_long_unsigned_type_node;
+#if 0	/* gcc/c-* files only */
+  if (type1 == intDI_type_node)
+    return unsigned_intDI_type_node;
+  if (type1 == intSI_type_node)
+    return unsigned_intSI_type_node;
+  if (type1 == intHI_type_node)
+    return unsigned_intHI_type_node;
+  if (type1 == intQI_type_node)
+    return unsigned_intQI_type_node;
+#endif
+
+  type2 = ffe_type_for_size (TYPE_PRECISION (type1), 1);
+  if (type2 != NULL_TREE)
+    return type2;
+
+  for (kt = 0; kt < ARRAY_SIZE (ffecom_tree_type[0]); ++kt)
+    {
+      type2 = ffecom_tree_type[FFEINFO_basictypeINTEGER][kt];
+
+      if (type1 == type2)
+	return ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt];
+    }
+
+  return type;
+}
+
+/* From gcc/cccp.c, the code to handle -I.  */
+
+/* Skip leading "./" from a directory name.
+   This may yield the empty string, which represents the current directory.  */
+
+static const char *
+skip_redundant_dir_prefix (const char *dir)
+{
+  while (dir[0] == '.' && dir[1] == '/')
+    for (dir += 2; *dir == '/'; dir++)
+      continue;
+  if (dir[0] == '.' && !dir[1])
+    dir++;
+  return dir;
+}
+
+/* The file_name_map structure holds a mapping of file names for a
+   particular directory.  This mapping is read from the file named
+   FILE_NAME_MAP_FILE in that directory.  Such a file can be used to
+   map filenames on a file system with severe filename restrictions,
+   such as DOS.  The format of the file name map file is just a series
+   of lines with two tokens on each line.  The first token is the name
+   to map, and the second token is the actual name to use.  */
+
+struct file_name_map
+{
+  struct file_name_map *map_next;
+  char *map_from;
+  char *map_to;
+};
+
+#define FILE_NAME_MAP_FILE "header.gcc"
+
+/* Current maximum length of directory names in the search path
+   for include files.  (Altered as we get more of them.)  */
+
+static int max_include_len = 0;
+
+struct file_name_list
+  {
+    struct file_name_list *next;
+    const char *fname;
+    /* Mapping of file names for this directory.  */
+    struct file_name_map *name_map;
+    /* Nonzero if name_map is valid.  */
+    int got_name_map;
+  };
+
+static struct file_name_list *include = NULL;	/* First dir to search */
+static struct file_name_list *last_include = NULL;	/* Last in chain */
+
+/* I/O buffer structure.
+   The `fname' field is nonzero for source files and #include files
+   and for the dummy text used for -D and -U.
+   It is zero for rescanning results of macro expansion
+   and for expanding macro arguments.  */
+#define INPUT_STACK_MAX 400
+static struct file_buf {
+  const char *fname;
+  /* Filename specified with #line command.  */
+  const char *nominal_fname;
+  /* Record where in the search path this file was found.
+     For #include_next.  */
+  struct file_name_list *dir;
+  ffewhereLine line;
+  ffewhereColumn column;
+} instack[INPUT_STACK_MAX];
+
+static int last_error_tick = 0;	   /* Incremented each time we print it.  */
+
+/* Current nesting level of input sources.
+   `instack[indepth]' is the level currently being read.  */
+static int indepth = -1;
+
+typedef struct file_buf FILE_BUF;
+
+/* Nonzero means -I- has been seen,
+   so don't look for #include "foo" the source-file directory.  */
+static int ignore_srcdir;
+
+#ifndef INCLUDE_LEN_FUDGE
+#define INCLUDE_LEN_FUDGE 0
+#endif
+
+static void append_include_chain (struct file_name_list *first,
+				  struct file_name_list *last);
+static FILE *open_include_file (char *filename,
+				struct file_name_list *searchptr);
+static void print_containing_files (ffebadSeverity sev);
+static char *read_filename_string (int ch, FILE *f);
+static struct file_name_map *read_name_map (const char *dirname);
+
+/* Append a chain of `struct file_name_list's
+   to the end of the main include chain.
+   FIRST is the beginning of the chain to append, and LAST is the end.  */
+
+static void
+append_include_chain (struct file_name_list *first,
+		      struct file_name_list *last)
+{
+  struct file_name_list *dir;
+
+  if (!first || !last)
+    return;
+
+  if (include == 0)
+    include = first;
+  else
+    last_include->next = first;
+
+  for (dir = first; ; dir = dir->next) {
+    int len = strlen (dir->fname) + INCLUDE_LEN_FUDGE;
+    if (len > max_include_len)
+      max_include_len = len;
+    if (dir == last)
+      break;
+  }
+
+  last->next = NULL;
+  last_include = last;
+}
+
+/* Try to open include file FILENAME.  SEARCHPTR is the directory
+   being tried from the include file search path.  This function maps
+   filenames on file systems based on information read by
+   read_name_map.  */
+
+static FILE *
+open_include_file (char *filename, struct file_name_list *searchptr)
+{
+  register struct file_name_map *map;
+  register char *from;
+  char *p, *dir;
+
+  if (searchptr && ! searchptr->got_name_map)
+    {
+      searchptr->name_map = read_name_map (searchptr->fname
+					   ? searchptr->fname : ".");
+      searchptr->got_name_map = 1;
+    }
+
+  /* First check the mapping for the directory we are using.  */
+  if (searchptr && searchptr->name_map)
+    {
+      from = filename;
+      if (searchptr->fname)
+	from += strlen (searchptr->fname) + 1;
+      for (map = searchptr->name_map; map; map = map->map_next)
+	{
+	  if (! strcmp (map->map_from, from))
+	    {
+	      /* Found a match.  */
+	      return fopen (map->map_to, "r");
+	    }
+	}
+    }
+
+  /* Try to find a mapping file for the particular directory we are
+     looking in.  Thus #include <sys/types.h> will look up sys/types.h
+     in /usr/include/header.gcc and look up types.h in
+     /usr/include/sys/header.gcc.  */
+  p = strrchr (filename, '/');
+#ifdef DIR_SEPARATOR
+  if (! p) p = strrchr (filename, DIR_SEPARATOR);
+  else {
+    char *tmp = strrchr (filename, DIR_SEPARATOR);
+    if (tmp != NULL && tmp > p) p = tmp;
+  }
+#endif
+  if (! p)
+    p = filename;
+  if (searchptr
+      && searchptr->fname
+      && strlen (searchptr->fname) == (size_t) (p - filename)
+      && ! strncmp (searchptr->fname, filename, (int) (p - filename)))
+    {
+      /* FILENAME is in SEARCHPTR, which we've already checked.  */
+      return fopen (filename, "r");
+    }
+
+  if (p == filename)
+    {
+      from = filename;
+      map = read_name_map (".");
+    }
+  else
+    {
+      dir = xmalloc (p - filename + 1);
+      memcpy (dir, filename, p - filename);
+      dir[p - filename] = '\0';
+      from = p + 1;
+      map = read_name_map (dir);
+      free (dir);
+    }
+  for (; map; map = map->map_next)
+    if (! strcmp (map->map_from, from))
+      return fopen (map->map_to, "r");
+
+  return fopen (filename, "r");
+}
+
+/* Print the file names and line numbers of the #include
+   commands which led to the current file.  */
+
+static void
+print_containing_files (ffebadSeverity sev)
+{
+  FILE_BUF *ip = NULL;
+  int i;
+  int first = 1;
+  const char *str1;
+  const char *str2;
+
+  /* If stack of files hasn't changed since we last printed
+     this info, don't repeat it.  */
+  if (last_error_tick == input_file_stack_tick)
+    return;
+
+  for (i = indepth; i >= 0; i--)
+    if (instack[i].fname != NULL) {
+      ip = &instack[i];
+      break;
+    }
+
+  /* Give up if we don't find a source file.  */
+  if (ip == NULL)
+    return;
+
+  /* Find the other, outer source files.  */
+  for (i--; i >= 0; i--)
+    if (instack[i].fname != NULL)
+      {
+	ip = &instack[i];
+	if (first)
+	  {
+	    first = 0;
+	    str1 = "In file included";
+	  }
+	else
+	  {
+	    str1 = "...          ...";
+	  }
+
+	if (i == 1)
+	  str2 = ":";
+	else
+	  str2 = "";
+
+	/* xgettext:no-c-format */
+	ffebad_start_msg ("%A from %B at %0%C", sev);
+	ffebad_here (0, ip->line, ip->column);
+	ffebad_string (str1);
+	ffebad_string (ip->nominal_fname);
+	ffebad_string (str2);
+	ffebad_finish ();
+      }
+
+  /* Record we have printed the status as of this time.  */
+  last_error_tick = input_file_stack_tick;
+}
+
+/* Read a space delimited string of unlimited length from a stdio
+   file.  */
+
+static char *
+read_filename_string (int ch, FILE *f)
+{
+  char *alloc, *set;
+  int len;
+
+  len = 20;
+  set = alloc = xmalloc (len + 1);
+  if (! ISSPACE (ch))
+    {
+      *set++ = ch;
+      while ((ch = getc (f)) != EOF && ! ISSPACE (ch))
+	{
+	  if (set - alloc == len)
+	    {
+	      len *= 2;
+	      alloc = xrealloc (alloc, len + 1);
+	      set = alloc + len / 2;
+	    }
+	  *set++ = ch;
+	}
+    }
+  *set = '\0';
+  ungetc (ch, f);
+  return alloc;
+}
+
+/* Read the file name map file for DIRNAME.  */
+
+static struct file_name_map *
+read_name_map (const char *dirname)
+{
+  /* This structure holds a linked list of file name maps, one per
+     directory.  */
+  struct file_name_map_list
+    {
+      struct file_name_map_list *map_list_next;
+      char *map_list_name;
+      struct file_name_map *map_list_map;
+    };
+  static struct file_name_map_list *map_list;
+  register struct file_name_map_list *map_list_ptr;
+  char *name;
+  FILE *f;
+  size_t dirlen;
+  int separator_needed;
+
+  dirname = skip_redundant_dir_prefix (dirname);
+
+  for (map_list_ptr = map_list; map_list_ptr;
+       map_list_ptr = map_list_ptr->map_list_next)
+    if (! strcmp (map_list_ptr->map_list_name, dirname))
+      return map_list_ptr->map_list_map;
+
+  map_list_ptr = xmalloc (sizeof (struct file_name_map_list));
+  map_list_ptr->map_list_name = xstrdup (dirname);
+  map_list_ptr->map_list_map = NULL;
+
+  dirlen = strlen (dirname);
+  separator_needed = dirlen != 0 && dirname[dirlen - 1] != '/';
+  if (separator_needed)
+    name = concat (dirname, "/", FILE_NAME_MAP_FILE, NULL);
+  else
+    name = concat (dirname, FILE_NAME_MAP_FILE, NULL);
+  f = fopen (name, "r");
+  free (name);
+  if (!f)
+    map_list_ptr->map_list_map = NULL;
+  else
+    {
+      int ch;
+
+      while ((ch = getc (f)) != EOF)
+	{
+	  char *from, *to;
+	  struct file_name_map *ptr;
+
+	  if (ISSPACE (ch))
+	    continue;
+	  from = read_filename_string (ch, f);
+	  while ((ch = getc (f)) != EOF && ISSPACE (ch) && ch != '\n')
+	    ;
+	  to = read_filename_string (ch, f);
+
+	  ptr = xmalloc (sizeof (struct file_name_map));
+	  ptr->map_from = from;
+
+	  /* Make the real filename absolute.  */
+	  if (*to == '/')
+	    ptr->map_to = to;
+	  else
+	    {
+	      if (separator_needed)
+		ptr->map_to = concat (dirname, "/", to, NULL);
+	      else
+		ptr->map_to = concat (dirname, to, NULL);
+	      free (to);
+	    }
+
+	  ptr->map_next = map_list_ptr->map_list_map;
+	  map_list_ptr->map_list_map = ptr;
+
+	  while ((ch = getc (f)) != '\n')
+	    if (ch == EOF)
+	      break;
+	}
+      fclose (f);
+    }
+
+  map_list_ptr->map_list_next = map_list;
+  map_list = map_list_ptr;
+
+  return map_list_ptr->map_list_map;
+}
+
+static void
+ffecom_file_ (const char *name)
+{
+  FILE_BUF *fp;
+
+  /* Do partial setup of input buffer for the sake of generating
+     early #line directives (when -g is in effect).  */
+
+  fp = &instack[++indepth];
+  memset (fp, 0, sizeof (FILE_BUF));
+  if (name == NULL)
+    name = "";
+  fp->nominal_fname = fp->fname = name;
+}
+
+static void
+ffecom_close_include_ (FILE *f)
+{
+  fclose (f);
+
+  indepth--;
+  input_file_stack_tick++;
+
+  ffewhere_line_kill (instack[indepth].line);
+  ffewhere_column_kill (instack[indepth].column);
+}
+
+void
+ffecom_decode_include_option (const char *dir)
+{
+  if (! ignore_srcdir && !strcmp (dir, "-"))
+    ignore_srcdir = 1;
+  else
+    {
+      struct file_name_list *dirtmp
+	= xmalloc (sizeof (struct file_name_list));
+      dirtmp->next = 0;		/* New one goes on the end */
+      dirtmp->fname = dir;
+      dirtmp->got_name_map = 0;
+      append_include_chain (dirtmp, dirtmp);
+    }
+}
+
+/* Open INCLUDEd file.  */
+
+static FILE *
+ffecom_open_include_ (char *name, ffewhereLine l, ffewhereColumn c)
+{
+  char *fbeg = name;
+  size_t flen = strlen (fbeg);
+  struct file_name_list *search_start = include; /* Chain of dirs to search */
+  struct file_name_list dsp[1];	/* First in chain, if #include "..." */
+  struct file_name_list *searchptr = 0;
+  char *fname;		/* Dynamically allocated fname buffer */
+  FILE *f;
+  FILE_BUF *fp;
+
+  if (flen == 0)
+    return NULL;
+
+  dsp[0].fname = NULL;
+
+  /* If -I- was specified, don't search current dir, only spec'd ones. */
+  if (!ignore_srcdir)
+    {
+      for (fp = &instack[indepth]; fp >= instack; fp--)
+	{
+	  int n;
+	  char *ep;
+	  const char *nam;
+
+	  if ((nam = fp->nominal_fname) != NULL)
+	    {
+	      /* Found a named file.  Figure out dir of the file,
+		 and put it in front of the search list.  */
+	      dsp[0].next = search_start;
+	      search_start = dsp;
+#ifndef VMS
+	      ep = strrchr (nam, '/');
+#ifdef DIR_SEPARATOR
+	    if (ep == NULL) ep = strrchr (nam, DIR_SEPARATOR);
+	    else {
+	      char *tmp = strrchr (nam, DIR_SEPARATOR);
+	      if (tmp != NULL && tmp > ep) ep = tmp;
+	    }
+#endif
+#else				/* VMS */
+	      ep = strrchr (nam, ']');
+	      if (ep == NULL) ep = strrchr (nam, '>');
+	      if (ep == NULL) ep = strrchr (nam, ':');
+	      if (ep != NULL) ep++;
+#endif				/* VMS */
+	      if (ep != NULL)
+		{
+		  n = ep - nam;
+		  fname = xmalloc (n + 1);
+		  strncpy (fname, nam, n);
+		  fname[n] = '\0';
+		  dsp[0].fname = fname;
+		  if (n + INCLUDE_LEN_FUDGE > max_include_len)
+		    max_include_len = n + INCLUDE_LEN_FUDGE;
+		}
+	      else
+		dsp[0].fname = NULL; /* Current directory */
+	      dsp[0].got_name_map = 0;
+	      break;
+	    }
+	}
+    }
+
+  /* Allocate this permanently, because it gets stored in the definitions
+     of macros.  */
+  fname = xmalloc (max_include_len + flen + 4);
+  /* + 2 above for slash and terminating null.  */
+  /* + 2 added for '.h' on VMS (to support '#include filename') (NOT USED
+     for g77 yet).  */
+
+  /* If specified file name is absolute, just open it.  */
+
+  if (*fbeg == '/'
+#ifdef DIR_SEPARATOR
+      || *fbeg == DIR_SEPARATOR
+#endif
+      )
+    {
+      strncpy (fname, (char *) fbeg, flen);
+      fname[flen] = 0;
+      f = open_include_file (fname, NULL);
+    }
+  else
+    {
+      f = NULL;
+
+      /* Search directory path, trying to open the file.
+	 Copy each filename tried into FNAME.  */
+
+      for (searchptr = search_start; searchptr; searchptr = searchptr->next)
+	{
+	  if (searchptr->fname)
+	    {
+	      /* The empty string in a search path is ignored.
+		 This makes it possible to turn off entirely
+		 a standard piece of the list.  */
+	      if (searchptr->fname[0] == 0)
+		continue;
+	      strcpy (fname, skip_redundant_dir_prefix (searchptr->fname));
+	      if (fname[0] && fname[strlen (fname) - 1] != '/')
+		strcat (fname, "/");
+	      fname[strlen (fname) + flen] = 0;
+	    }
+	  else
+	    fname[0] = 0;
+
+	  strncat (fname, fbeg, flen);
+#ifdef VMS
+	  /* Change this 1/2 Unix 1/2 VMS file specification into a
+	     full VMS file specification */
+	  if (searchptr->fname && (searchptr->fname[0] != 0))
+	    {
+	      /* Fix up the filename */
+	      hack_vms_include_specification (fname);
+	    }
+	  else
+	    {
+	      /* This is a normal VMS filespec, so use it unchanged.  */
+	      strncpy (fname, (char *) fbeg, flen);
+	      fname[flen] = 0;
+#if 0	/* Not for g77.  */
+	      /* if it's '#include filename', add the missing .h */
+	      if (strchr (fname, '.') == NULL)
+		strcat (fname, ".h");
+#endif
+	    }
+#endif /* VMS */
+	  f = open_include_file (fname, searchptr);
+#ifdef EACCES
+	  if (f == NULL && errno == EACCES)
+	    {
+	      print_containing_files (FFEBAD_severityWARNING);
+	      /* xgettext:no-c-format */
+	      ffebad_start_msg ("At %0, INCLUDE file %A exists, but is not readable",
+				FFEBAD_severityWARNING);
+	      ffebad_string (fname);
+	      ffebad_here (0, l, c);
+	      ffebad_finish ();
+	    }
+#endif
+	  if (f != NULL)
+	    break;
+	}
+    }
+
+  if (f == NULL)
+    {
+      /* A file that was not found.  */
+
+      strncpy (fname, (char *) fbeg, flen);
+      fname[flen] = 0;
+      print_containing_files (ffebad_severity (FFEBAD_OPEN_INCLUDE));
+      ffebad_start (FFEBAD_OPEN_INCLUDE);
+      ffebad_here (0, l, c);
+      ffebad_string (fname);
+      ffebad_finish ();
+    }
+
+  if (dsp[0].fname != NULL)
+    free ((char *) dsp[0].fname);
+
+  if (f == NULL)
+    return NULL;
+
+  if (indepth >= (INPUT_STACK_MAX - 1))
+    {
+      print_containing_files (FFEBAD_severityFATAL);
+      /* xgettext:no-c-format */
+      ffebad_start_msg ("At %0, INCLUDE nesting too deep",
+			FFEBAD_severityFATAL);
+      ffebad_string (fname);
+      ffebad_here (0, l, c);
+      ffebad_finish ();
+      return NULL;
+    }
+
+  instack[indepth].line = ffewhere_line_use (l);
+  instack[indepth].column = ffewhere_column_use (c);
+
+  fp = &instack[indepth + 1];
+  memset (fp, 0, sizeof (FILE_BUF));
+  fp->nominal_fname = fp->fname = fname;
+  fp->dir = searchptr;
+
+  indepth++;
+  input_file_stack_tick++;
+
+  return f;
+}
+
+/**INDENT* (Do not reformat this comment even with -fca option.)
+   Data-gathering files: Given the source file listed below, compiled with
+   f2c I obtained the output file listed after that, and from the output
+   file I derived the above code.
+
+-------- (begin input file to f2c)
+	implicit none
+	character*10 A1,A2
+	complex C1,C2
+	integer I1,I2
+	real R1,R2
+	double precision D1,D2
+C
+	call getem(A1,A2,C1,C2,I1,I2,R1,R2,D1,D2)
+c /
+	call fooI(I1/I2)
+	call fooR(R1/I1)
+	call fooD(D1/I1)
+	call fooC(C1/I1)
+	call fooR(R1/R2)
+	call fooD(R1/D1)
+	call fooD(D1/D2)
+	call fooD(D1/R1)
+	call fooC(C1/C2)
+	call fooC(C1/R1)
+	call fooZ(C1/D1)
+c **
+	call fooI(I1**I2)
+	call fooR(R1**I1)
+	call fooD(D1**I1)
+	call fooC(C1**I1)
+	call fooR(R1**R2)
+	call fooD(R1**D1)
+	call fooD(D1**D2)
+	call fooD(D1**R1)
+	call fooC(C1**C2)
+	call fooC(C1**R1)
+	call fooZ(C1**D1)
+c FFEINTRIN_impABS
+	call fooR(ABS(R1))
+c FFEINTRIN_impACOS
+	call fooR(ACOS(R1))
+c FFEINTRIN_impAIMAG
+	call fooR(AIMAG(C1))
+c FFEINTRIN_impAINT
+	call fooR(AINT(R1))
+c FFEINTRIN_impALOG
+	call fooR(ALOG(R1))
+c FFEINTRIN_impALOG10
+	call fooR(ALOG10(R1))
+c FFEINTRIN_impAMAX0
+	call fooR(AMAX0(I1,I2))
+c FFEINTRIN_impAMAX1
+	call fooR(AMAX1(R1,R2))
+c FFEINTRIN_impAMIN0
+	call fooR(AMIN0(I1,I2))
+c FFEINTRIN_impAMIN1
+	call fooR(AMIN1(R1,R2))
+c FFEINTRIN_impAMOD
+	call fooR(AMOD(R1,R2))
+c FFEINTRIN_impANINT
+	call fooR(ANINT(R1))
+c FFEINTRIN_impASIN
+	call fooR(ASIN(R1))
+c FFEINTRIN_impATAN
+	call fooR(ATAN(R1))
+c FFEINTRIN_impATAN2
+	call fooR(ATAN2(R1,R2))
+c FFEINTRIN_impCABS
+	call fooR(CABS(C1))
+c FFEINTRIN_impCCOS
+	call fooC(CCOS(C1))
+c FFEINTRIN_impCEXP
+	call fooC(CEXP(C1))
+c FFEINTRIN_impCHAR
+	call fooA(CHAR(I1))
+c FFEINTRIN_impCLOG
+	call fooC(CLOG(C1))
+c FFEINTRIN_impCONJG
+	call fooC(CONJG(C1))
+c FFEINTRIN_impCOS
+	call fooR(COS(R1))
+c FFEINTRIN_impCOSH
+	call fooR(COSH(R1))
+c FFEINTRIN_impCSIN
+	call fooC(CSIN(C1))
+c FFEINTRIN_impCSQRT
+	call fooC(CSQRT(C1))
+c FFEINTRIN_impDABS
+	call fooD(DABS(D1))
+c FFEINTRIN_impDACOS
+	call fooD(DACOS(D1))
+c FFEINTRIN_impDASIN
+	call fooD(DASIN(D1))
+c FFEINTRIN_impDATAN
+	call fooD(DATAN(D1))
+c FFEINTRIN_impDATAN2
+	call fooD(DATAN2(D1,D2))
+c FFEINTRIN_impDCOS
+	call fooD(DCOS(D1))
+c FFEINTRIN_impDCOSH
+	call fooD(DCOSH(D1))
+c FFEINTRIN_impDDIM
+	call fooD(DDIM(D1,D2))
+c FFEINTRIN_impDEXP
+	call fooD(DEXP(D1))
+c FFEINTRIN_impDIM
+	call fooR(DIM(R1,R2))
+c FFEINTRIN_impDINT
+	call fooD(DINT(D1))
+c FFEINTRIN_impDLOG
+	call fooD(DLOG(D1))
+c FFEINTRIN_impDLOG10
+	call fooD(DLOG10(D1))
+c FFEINTRIN_impDMAX1
+	call fooD(DMAX1(D1,D2))
+c FFEINTRIN_impDMIN1
+	call fooD(DMIN1(D1,D2))
+c FFEINTRIN_impDMOD
+	call fooD(DMOD(D1,D2))
+c FFEINTRIN_impDNINT
+	call fooD(DNINT(D1))
+c FFEINTRIN_impDPROD
+	call fooD(DPROD(R1,R2))
+c FFEINTRIN_impDSIGN
+	call fooD(DSIGN(D1,D2))
+c FFEINTRIN_impDSIN
+	call fooD(DSIN(D1))
+c FFEINTRIN_impDSINH
+	call fooD(DSINH(D1))
+c FFEINTRIN_impDSQRT
+	call fooD(DSQRT(D1))
+c FFEINTRIN_impDTAN
+	call fooD(DTAN(D1))
+c FFEINTRIN_impDTANH
+	call fooD(DTANH(D1))
+c FFEINTRIN_impEXP
+	call fooR(EXP(R1))
+c FFEINTRIN_impIABS
+	call fooI(IABS(I1))
+c FFEINTRIN_impICHAR
+	call fooI(ICHAR(A1))
+c FFEINTRIN_impIDIM
+	call fooI(IDIM(I1,I2))
+c FFEINTRIN_impIDNINT
+	call fooI(IDNINT(D1))
+c FFEINTRIN_impINDEX
+	call fooI(INDEX(A1,A2))
+c FFEINTRIN_impISIGN
+	call fooI(ISIGN(I1,I2))
+c FFEINTRIN_impLEN
+	call fooI(LEN(A1))
+c FFEINTRIN_impLGE
+	call fooL(LGE(A1,A2))
+c FFEINTRIN_impLGT
+	call fooL(LGT(A1,A2))
+c FFEINTRIN_impLLE
+	call fooL(LLE(A1,A2))
+c FFEINTRIN_impLLT
+	call fooL(LLT(A1,A2))
+c FFEINTRIN_impMAX0
+	call fooI(MAX0(I1,I2))
+c FFEINTRIN_impMAX1
+	call fooI(MAX1(R1,R2))
+c FFEINTRIN_impMIN0
+	call fooI(MIN0(I1,I2))
+c FFEINTRIN_impMIN1
+	call fooI(MIN1(R1,R2))
+c FFEINTRIN_impMOD
+	call fooI(MOD(I1,I2))
+c FFEINTRIN_impNINT
+	call fooI(NINT(R1))
+c FFEINTRIN_impSIGN
+	call fooR(SIGN(R1,R2))
+c FFEINTRIN_impSIN
+	call fooR(SIN(R1))
+c FFEINTRIN_impSINH
+	call fooR(SINH(R1))
+c FFEINTRIN_impSQRT
+	call fooR(SQRT(R1))
+c FFEINTRIN_impTAN
+	call fooR(TAN(R1))
+c FFEINTRIN_impTANH
+	call fooR(TANH(R1))
+c FFEINTRIN_imp_CMPLX_C
+	call fooC(cmplx(C1,C2))
+c FFEINTRIN_imp_CMPLX_D
+	call fooZ(cmplx(D1,D2))
+c FFEINTRIN_imp_CMPLX_I
+	call fooC(cmplx(I1,I2))
+c FFEINTRIN_imp_CMPLX_R
+	call fooC(cmplx(R1,R2))
+c FFEINTRIN_imp_DBLE_C
+	call fooD(dble(C1))
+c FFEINTRIN_imp_DBLE_D
+	call fooD(dble(D1))
+c FFEINTRIN_imp_DBLE_I
+	call fooD(dble(I1))
+c FFEINTRIN_imp_DBLE_R
+	call fooD(dble(R1))
+c FFEINTRIN_imp_INT_C
+	call fooI(int(C1))
+c FFEINTRIN_imp_INT_D
+	call fooI(int(D1))
+c FFEINTRIN_imp_INT_I
+	call fooI(int(I1))
+c FFEINTRIN_imp_INT_R
+	call fooI(int(R1))
+c FFEINTRIN_imp_REAL_C
+	call fooR(real(C1))
+c FFEINTRIN_imp_REAL_D
+	call fooR(real(D1))
+c FFEINTRIN_imp_REAL_I
+	call fooR(real(I1))
+c FFEINTRIN_imp_REAL_R
+	call fooR(real(R1))
+c
+c FFEINTRIN_imp_INT_D:
+c
+c FFEINTRIN_specIDINT
+	call fooI(IDINT(D1))
+c
+c FFEINTRIN_imp_INT_R:
+c
+c FFEINTRIN_specIFIX
+	call fooI(IFIX(R1))
+c FFEINTRIN_specINT
+	call fooI(INT(R1))
+c
+c FFEINTRIN_imp_REAL_D:
+c
+c FFEINTRIN_specSNGL
+	call fooR(SNGL(D1))
+c
+c FFEINTRIN_imp_REAL_I:
+c
+c FFEINTRIN_specFLOAT
+	call fooR(FLOAT(I1))
+c FFEINTRIN_specREAL
+	call fooR(REAL(I1))
+c
+	end
+-------- (end input file to f2c)
+
+-------- (begin output from providing above input file as input to:
+--------  `f2c | gcc -E -C - | sed -e "s:/[*]*://:g" -e "s:[*]*[/]://:g" \
+--------     -e "s:^#.*$::g"')
+
+//  -- translated by f2c (version 19950223).
+   You must link the resulting object file with the libraries:
+        -lf2c -lm   (in that order)
+//
+
+
+// f2c.h  --  Standard Fortran to C header file //
+
+///  barf  [ba:rf]  2.  "He suggested using FORTRAN, and everybody barfed."
+
+        - From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) //
+
+
+
+
+// F2C_INTEGER will normally be `int' but would be `long' on 16-bit systems //
+// we assume short, float are OK //
+typedef long int // long int // integer;
+typedef char *address;
+typedef short int shortint;
+typedef float real;
+typedef double doublereal;
+typedef struct { real r, i; } complex;
+typedef struct { doublereal r, i; } doublecomplex;
+typedef long int // long int // logical;
+typedef short int shortlogical;
+typedef char logical1;
+typedef char integer1;
+// typedef long long longint; // // system-dependent //
+
+
+
+
+// Extern is for use with -E //
+
+
+
+
+// I/O stuff //
+
+
+
+
+
+
+
+
+typedef long int // int or long int // flag;
+typedef long int // int or long int // ftnlen;
+typedef long int // int or long int // ftnint;
+
+
+//external read, write//
+typedef struct
+{       flag cierr;
+        ftnint ciunit;
+        flag ciend;
+        char *cifmt;
+        ftnint cirec;
+} cilist;
+
+//internal read, write//
+typedef struct
+{       flag icierr;
+        char *iciunit;
+        flag iciend;
+        char *icifmt;
+        ftnint icirlen;
+        ftnint icirnum;
+} icilist;
+
+//open//
+typedef struct
+{       flag oerr;
+        ftnint ounit;
+        char *ofnm;
+        ftnlen ofnmlen;
+        char *osta;
+        char *oacc;
+        char *ofm;
+        ftnint orl;
+        char *oblnk;
+} olist;
+
+//close//
+typedef struct
+{       flag cerr;
+        ftnint cunit;
+        char *csta;
+} cllist;
+
+//rewind, backspace, endfile//
+typedef struct
+{       flag aerr;
+        ftnint aunit;
+} alist;
+
+// inquire //
+typedef struct
+{       flag inerr;
+        ftnint inunit;
+        char *infile;
+        ftnlen infilen;
+        ftnint  *inex;  //parameters in standard's order//
+        ftnint  *inopen;
+        ftnint  *innum;
+        ftnint  *innamed;
+        char    *inname;
+        ftnlen  innamlen;
+        char    *inacc;
+        ftnlen  inacclen;
+        char    *inseq;
+        ftnlen  inseqlen;
+        char    *indir;
+        ftnlen  indirlen;
+        char    *infmt;
+        ftnlen  infmtlen;
+        char    *inform;
+        ftnint  informlen;
+        char    *inunf;
+        ftnlen  inunflen;
+        ftnint  *inrecl;
+        ftnint  *innrec;
+        char    *inblank;
+        ftnlen  inblanklen;
+} inlist;
+
+
+
+union Multitype {       // for multiple entry points //
+        integer1 g;
+        shortint h;
+        integer i;
+        // longint j; //
+        real r;
+        doublereal d;
+        complex c;
+        doublecomplex z;
+        };
+
+typedef union Multitype Multitype;
+
+typedef long Long;      // No longer used; formerly in Namelist //
+
+struct Vardesc {        // for Namelist //
+        char *name;
+        char *addr;
+        ftnlen *dims;
+        int  type;
+        };
+typedef struct Vardesc Vardesc;
+
+struct Namelist {
+        char *name;
+        Vardesc **vars;
+        int nvars;
+        };
+typedef struct Namelist Namelist;
+
+
+
+
+
+
+
+
+// procedure parameter types for -A and -C++ //
+
+
+
+
+typedef int // Unknown procedure type // (*U_fp)();
+typedef shortint (*J_fp)();
+typedef integer (*I_fp)();
+typedef real (*R_fp)();
+typedef doublereal (*D_fp)(), (*E_fp)();
+typedef // Complex // void  (*C_fp)();
+typedef // Double Complex // void  (*Z_fp)();
+typedef logical (*L_fp)();
+typedef shortlogical (*K_fp)();
+typedef // Character // void  (*H_fp)();
+typedef // Subroutine // int (*S_fp)();
+
+// E_fp is for real functions when -R is not specified //
+typedef void  C_f;      // complex function //
+typedef void  H_f;      // character function //
+typedef void  Z_f;      // double complex function //
+typedef doublereal E_f; // real function with -R not specified //
+
+// undef any lower-case symbols that your C compiler predefines, e.g.: //
+
+
+// (No such symbols should be defined in a strict ANSI C compiler.
+   We can avoid trouble with f2c-translated code by using
+   gcc -ansi.) //
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+// Main program // MAIN__()
+{
+    // System generated locals //
+    integer i__1;
+    real r__1, r__2;
+    doublereal d__1, d__2;
+    complex q__1;
+    doublecomplex z__1, z__2, z__3;
+    logical L__1;
+    char ch__1[1];
+
+    // Builtin functions //
+    void c_div();
+    integer pow_ii();
+    double pow_ri(), pow_di();
+    void pow_ci();
+    double pow_dd();
+    void pow_zz();
+    double acos(), r_imag(), r_int(), log(), r_lg10(), r_mod(), r_nint(),
+            asin(), atan(), atan2(), c_abs();
+    void c_cos(), c_exp(), c_log(), r_cnjg();
+    double cos(), cosh();
+    void c_sin(), c_sqrt();
+    double d_dim(), exp(), r_dim(), d_int(), d_lg10(), d_mod(), d_nint(),
+            d_sign(), sin(), sinh(), sqrt(), tan(), tanh();
+    integer i_dim(), i_dnnt(), i_indx(), i_sign(), i_len();
+    logical l_ge(), l_gt(), l_le(), l_lt();
+    integer i_nint();
+    double r_sign();
+
+    // Local variables //
+    extern // Subroutine // int fooa_(), fooc_(), food_(), fooi_(), foor_(),
+            fool_(), fooz_(), getem_();
+    static char a1[10], a2[10];
+    static complex c1, c2;
+    static doublereal d1, d2;
+    static integer i1, i2;
+    static real r1, r2;
+
+
+    getem_(a1, a2, &c1, &c2, &i1, &i2, &r1, &r2, &d1, &d2, 10L, 10L);
+// / //
+    i__1 = i1 / i2;
+    fooi_(&i__1);
+    r__1 = r1 / i1;
+    foor_(&r__1);
+    d__1 = d1 / i1;
+    food_(&d__1);
+    d__1 = (doublereal) i1;
+    q__1.r = c1.r / d__1, q__1.i = c1.i / d__1;
+    fooc_(&q__1);
+    r__1 = r1 / r2;
+    foor_(&r__1);
+    d__1 = r1 / d1;
+    food_(&d__1);
+    d__1 = d1 / d2;
+    food_(&d__1);
+    d__1 = d1 / r1;
+    food_(&d__1);
+    c_div(&q__1, &c1, &c2);
+    fooc_(&q__1);
+    q__1.r = c1.r / r1, q__1.i = c1.i / r1;
+    fooc_(&q__1);
+    z__1.r = c1.r / d1, z__1.i = c1.i / d1;
+    fooz_(&z__1);
+// ** //
+    i__1 = pow_ii(&i1, &i2);
+    fooi_(&i__1);
+    r__1 = pow_ri(&r1, &i1);
+    foor_(&r__1);
+    d__1 = pow_di(&d1, &i1);
+    food_(&d__1);
+    pow_ci(&q__1, &c1, &i1);
+    fooc_(&q__1);
+    d__1 = (doublereal) r1;
+    d__2 = (doublereal) r2;
+    r__1 = pow_dd(&d__1, &d__2);
+    foor_(&r__1);
+    d__2 = (doublereal) r1;
+    d__1 = pow_dd(&d__2, &d1);
+    food_(&d__1);
+    d__1 = pow_dd(&d1, &d2);
+    food_(&d__1);
+    d__2 = (doublereal) r1;
+    d__1 = pow_dd(&d1, &d__2);
+    food_(&d__1);
+    z__2.r = c1.r, z__2.i = c1.i;
+    z__3.r = c2.r, z__3.i = c2.i;
+    pow_zz(&z__1, &z__2, &z__3);
+    q__1.r = z__1.r, q__1.i = z__1.i;
+    fooc_(&q__1);
+    z__2.r = c1.r, z__2.i = c1.i;
+    z__3.r = r1, z__3.i = 0.;
+    pow_zz(&z__1, &z__2, &z__3);
+    q__1.r = z__1.r, q__1.i = z__1.i;
+    fooc_(&q__1);
+    z__2.r = c1.r, z__2.i = c1.i;
+    z__3.r = d1, z__3.i = 0.;
+    pow_zz(&z__1, &z__2, &z__3);
+    fooz_(&z__1);
+// FFEINTRIN_impABS //
+    r__1 = (doublereal)((  r1  ) >= 0 ? (  r1  ) : -(  r1  ))  ;
+    foor_(&r__1);
+// FFEINTRIN_impACOS //
+    r__1 = acos(r1);
+    foor_(&r__1);
+// FFEINTRIN_impAIMAG //
+    r__1 = r_imag(&c1);
+    foor_(&r__1);
+// FFEINTRIN_impAINT //
+    r__1 = r_int(&r1);
+    foor_(&r__1);
+// FFEINTRIN_impALOG //
+    r__1 = log(r1);
+    foor_(&r__1);
+// FFEINTRIN_impALOG10 //
+    r__1 = r_lg10(&r1);
+    foor_(&r__1);
+// FFEINTRIN_impAMAX0 //
+    r__1 = (real) (( i1 ) >= ( i2 ) ? ( i1 ) : ( i2 )) ;
+    foor_(&r__1);
+// FFEINTRIN_impAMAX1 //
+    r__1 = (doublereal)((  r1  ) >= (  r2  ) ? (  r1  ) : (  r2  ))  ;
+    foor_(&r__1);
+// FFEINTRIN_impAMIN0 //
+    r__1 = (real) (( i1 ) <= ( i2 ) ? ( i1 ) : ( i2 )) ;
+    foor_(&r__1);
+// FFEINTRIN_impAMIN1 //
+    r__1 = (doublereal)((  r1  ) <= (  r2  ) ? (  r1  ) : (  r2  ))  ;
+    foor_(&r__1);
+// FFEINTRIN_impAMOD //
+    r__1 = r_mod(&r1, &r2);
+    foor_(&r__1);
+// FFEINTRIN_impANINT //
+    r__1 = r_nint(&r1);
+    foor_(&r__1);
+// FFEINTRIN_impASIN //
+    r__1 = asin(r1);
+    foor_(&r__1);
+// FFEINTRIN_impATAN //
+    r__1 = atan(r1);
+    foor_(&r__1);
+// FFEINTRIN_impATAN2 //
+    r__1 = atan2(r1, r2);
+    foor_(&r__1);
+// FFEINTRIN_impCABS //
+    r__1 = c_abs(&c1);
+    foor_(&r__1);
+// FFEINTRIN_impCCOS //
+    c_cos(&q__1, &c1);
+    fooc_(&q__1);
+// FFEINTRIN_impCEXP //
+    c_exp(&q__1, &c1);
+    fooc_(&q__1);
+// FFEINTRIN_impCHAR //
+    *(unsigned char *)&ch__1[0] = i1;
+    fooa_(ch__1, 1L);
+// FFEINTRIN_impCLOG //
+    c_log(&q__1, &c1);
+    fooc_(&q__1);
+// FFEINTRIN_impCONJG //
+    r_cnjg(&q__1, &c1);
+    fooc_(&q__1);
+// FFEINTRIN_impCOS //
+    r__1 = cos(r1);
+    foor_(&r__1);
+// FFEINTRIN_impCOSH //
+    r__1 = cosh(r1);
+    foor_(&r__1);
+// FFEINTRIN_impCSIN //
+    c_sin(&q__1, &c1);
+    fooc_(&q__1);
+// FFEINTRIN_impCSQRT //
+    c_sqrt(&q__1, &c1);
+    fooc_(&q__1);
+// FFEINTRIN_impDABS //
+    d__1 = (( d1 ) >= 0 ? ( d1 ) : -( d1 )) ;
+    food_(&d__1);
+// FFEINTRIN_impDACOS //
+    d__1 = acos(d1);
+    food_(&d__1);
+// FFEINTRIN_impDASIN //
+    d__1 = asin(d1);
+    food_(&d__1);
+// FFEINTRIN_impDATAN //
+    d__1 = atan(d1);
+    food_(&d__1);
+// FFEINTRIN_impDATAN2 //
+    d__1 = atan2(d1, d2);
+    food_(&d__1);
+// FFEINTRIN_impDCOS //
+    d__1 = cos(d1);
+    food_(&d__1);
+// FFEINTRIN_impDCOSH //
+    d__1 = cosh(d1);
+    food_(&d__1);
+// FFEINTRIN_impDDIM //
+    d__1 = d_dim(&d1, &d2);
+    food_(&d__1);
+// FFEINTRIN_impDEXP //
+    d__1 = exp(d1);
+    food_(&d__1);
+// FFEINTRIN_impDIM //
+    r__1 = r_dim(&r1, &r2);
+    foor_(&r__1);
+// FFEINTRIN_impDINT //
+    d__1 = d_int(&d1);
+    food_(&d__1);
+// FFEINTRIN_impDLOG //
+    d__1 = log(d1);
+    food_(&d__1);
+// FFEINTRIN_impDLOG10 //
+    d__1 = d_lg10(&d1);
+    food_(&d__1);
+// FFEINTRIN_impDMAX1 //
+    d__1 = (( d1 ) >= ( d2 ) ? ( d1 ) : ( d2 )) ;
+    food_(&d__1);
+// FFEINTRIN_impDMIN1 //
+    d__1 = (( d1 ) <= ( d2 ) ? ( d1 ) : ( d2 )) ;
+    food_(&d__1);
+// FFEINTRIN_impDMOD //
+    d__1 = d_mod(&d1, &d2);
+    food_(&d__1);
+// FFEINTRIN_impDNINT //
+    d__1 = d_nint(&d1);
+    food_(&d__1);
+// FFEINTRIN_impDPROD //
+    d__1 = (doublereal) r1 * r2;
+    food_(&d__1);
+// FFEINTRIN_impDSIGN //
+    d__1 = d_sign(&d1, &d2);
+    food_(&d__1);
+// FFEINTRIN_impDSIN //
+    d__1 = sin(d1);
+    food_(&d__1);
+// FFEINTRIN_impDSINH //
+    d__1 = sinh(d1);
+    food_(&d__1);
+// FFEINTRIN_impDSQRT //
+    d__1 = sqrt(d1);
+    food_(&d__1);
+// FFEINTRIN_impDTAN //
+    d__1 = tan(d1);
+    food_(&d__1);
+// FFEINTRIN_impDTANH //
+    d__1 = tanh(d1);
+    food_(&d__1);
+// FFEINTRIN_impEXP //
+    r__1 = exp(r1);
+    foor_(&r__1);
+// FFEINTRIN_impIABS //
+    i__1 = (( i1 ) >= 0 ? ( i1 ) : -( i1 )) ;
+    fooi_(&i__1);
+// FFEINTRIN_impICHAR //
+    i__1 = *(unsigned char *)a1;
+    fooi_(&i__1);
+// FFEINTRIN_impIDIM //
+    i__1 = i_dim(&i1, &i2);
+    fooi_(&i__1);
+// FFEINTRIN_impIDNINT //
+    i__1 = i_dnnt(&d1);
+    fooi_(&i__1);
+// FFEINTRIN_impINDEX //
+    i__1 = i_indx(a1, a2, 10L, 10L);
+    fooi_(&i__1);
+// FFEINTRIN_impISIGN //
+    i__1 = i_sign(&i1, &i2);
+    fooi_(&i__1);
+// FFEINTRIN_impLEN //
+    i__1 = i_len(a1, 10L);
+    fooi_(&i__1);
+// FFEINTRIN_impLGE //
+    L__1 = l_ge(a1, a2, 10L, 10L);
+    fool_(&L__1);
+// FFEINTRIN_impLGT //
+    L__1 = l_gt(a1, a2, 10L, 10L);
+    fool_(&L__1);
+// FFEINTRIN_impLLE //
+    L__1 = l_le(a1, a2, 10L, 10L);
+    fool_(&L__1);
+// FFEINTRIN_impLLT //
+    L__1 = l_lt(a1, a2, 10L, 10L);
+    fool_(&L__1);
+// FFEINTRIN_impMAX0 //
+    i__1 = (( i1 ) >= ( i2 ) ? ( i1 ) : ( i2 )) ;
+    fooi_(&i__1);
+// FFEINTRIN_impMAX1 //
+    i__1 = (integer) (doublereal)((  r1  ) >= (  r2  ) ? (  r1  ) : (  r2  ))  ;
+    fooi_(&i__1);
+// FFEINTRIN_impMIN0 //
+    i__1 = (( i1 ) <= ( i2 ) ? ( i1 ) : ( i2 )) ;
+    fooi_(&i__1);
+// FFEINTRIN_impMIN1 //
+    i__1 = (integer) (doublereal)((  r1  ) <= (  r2  ) ? (  r1  ) : (  r2  ))  ;
+    fooi_(&i__1);
+// FFEINTRIN_impMOD //
+    i__1 = i1 % i2;
+    fooi_(&i__1);
+// FFEINTRIN_impNINT //
+    i__1 = i_nint(&r1);
+    fooi_(&i__1);
+// FFEINTRIN_impSIGN //
+    r__1 = r_sign(&r1, &r2);
+    foor_(&r__1);
+// FFEINTRIN_impSIN //
+    r__1 = sin(r1);
+    foor_(&r__1);
+// FFEINTRIN_impSINH //
+    r__1 = sinh(r1);
+    foor_(&r__1);
+// FFEINTRIN_impSQRT //
+    r__1 = sqrt(r1);
+    foor_(&r__1);
+// FFEINTRIN_impTAN //
+    r__1 = tan(r1);
+    foor_(&r__1);
+// FFEINTRIN_impTANH //
+    r__1 = tanh(r1);
+    foor_(&r__1);
+// FFEINTRIN_imp_CMPLX_C //
+    r__1 = c1.r;
+    r__2 = c2.r;
+    q__1.r = r__1, q__1.i = r__2;
+    fooc_(&q__1);
+// FFEINTRIN_imp_CMPLX_D //
+    z__1.r = d1, z__1.i = d2;
+    fooz_(&z__1);
+// FFEINTRIN_imp_CMPLX_I //
+    r__1 = (real) i1;
+    r__2 = (real) i2;
+    q__1.r = r__1, q__1.i = r__2;
+    fooc_(&q__1);
+// FFEINTRIN_imp_CMPLX_R //
+    q__1.r = r1, q__1.i = r2;
+    fooc_(&q__1);
+// FFEINTRIN_imp_DBLE_C //
+    d__1 = (doublereal) c1.r;
+    food_(&d__1);
+// FFEINTRIN_imp_DBLE_D //
+    d__1 = d1;
+    food_(&d__1);
+// FFEINTRIN_imp_DBLE_I //
+    d__1 = (doublereal) i1;
+    food_(&d__1);
+// FFEINTRIN_imp_DBLE_R //
+    d__1 = (doublereal) r1;
+    food_(&d__1);
+// FFEINTRIN_imp_INT_C //
+    i__1 = (integer) c1.r;
+    fooi_(&i__1);
+// FFEINTRIN_imp_INT_D //
+    i__1 = (integer) d1;
+    fooi_(&i__1);
+// FFEINTRIN_imp_INT_I //
+    i__1 = i1;
+    fooi_(&i__1);
+// FFEINTRIN_imp_INT_R //
+    i__1 = (integer) r1;
+    fooi_(&i__1);
+// FFEINTRIN_imp_REAL_C //
+    r__1 = c1.r;
+    foor_(&r__1);
+// FFEINTRIN_imp_REAL_D //
+    r__1 = (real) d1;
+    foor_(&r__1);
+// FFEINTRIN_imp_REAL_I //
+    r__1 = (real) i1;
+    foor_(&r__1);
+// FFEINTRIN_imp_REAL_R //
+    r__1 = r1;
+    foor_(&r__1);
+
+// FFEINTRIN_imp_INT_D: //
+
+// FFEINTRIN_specIDINT //
+    i__1 = (integer) d1;
+    fooi_(&i__1);
+
+// FFEINTRIN_imp_INT_R: //
+
+// FFEINTRIN_specIFIX //
+    i__1 = (integer) r1;
+    fooi_(&i__1);
+// FFEINTRIN_specINT //
+    i__1 = (integer) r1;
+    fooi_(&i__1);
+
+// FFEINTRIN_imp_REAL_D: //
+
+// FFEINTRIN_specSNGL //
+    r__1 = (real) d1;
+    foor_(&r__1);
+
+// FFEINTRIN_imp_REAL_I: //
+
+// FFEINTRIN_specFLOAT //
+    r__1 = (real) i1;
+    foor_(&r__1);
+// FFEINTRIN_specREAL //
+    r__1 = (real) i1;
+    foor_(&r__1);
+
+} // MAIN__ //
+
+-------- (end output file from f2c)
+
+*/
+
+#include "gt-f-com.h"
+#include "gtype-f.h"
diff --git a/gcc/f/com.h b/gcc/f/com.h
new file mode 100644
index 00000000000..d23db6687a2
--- /dev/null
+++ b/gcc/f/com.h
@@ -0,0 +1,290 @@
+/* com.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995, 1996, 1997, 2000, 2003, 2004
+   Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      com.c
+
+   Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef GCC_F_COM_H
+#define GCC_F_COM_H
+
+/* Simple definitions and enumerations. */
+
+#define FFECOM_dimensionsMAX 7	/* Max # dimensions (quick hack). */
+
+#define FFECOM_SIZE_UNIT "byte"	/* Singular form. */
+#define FFECOM_SIZE_UNITS "bytes"	/* Plural form. */
+
+#define FFECOM_constantNULL NULL_TREE
+#define FFECOM_nonterNULL NULL_TREE
+#define FFECOM_globalNULL NULL_TREE
+#define FFECOM_labelNULL NULL_TREE
+#define FFECOM_storageNULL NULL_TREE
+#define FFECOM_symbolNULL ffecom_symbol_null_
+
+/* Shorthand for types used in f2c.h and that g77 perhaps allows some
+   flexibility regarding in the section below.  I.e. the actual numbers
+   below aren't important, as long as they're unique.  */
+
+#define FFECOM_f2ccodeCHAR 1
+#define FFECOM_f2ccodeSHORT 2
+#define FFECOM_f2ccodeINT 3
+#define FFECOM_f2ccodeLONG 4
+#define FFECOM_f2ccodeLONGLONG 5
+#define FFECOM_f2ccodeCHARPTR 6		/* char * */
+#define FFECOM_f2ccodeFLOAT 7
+#define FFECOM_f2ccodeDOUBLE 8
+#define FFECOM_f2ccodeLONGDOUBLE 9
+#define FFECOM_f2ccodeTWOREALS 10
+#define FFECOM_f2ccodeTWODOUBLEREALS 11
+
+#if FFECOM_DETERMINE_TYPES	/* only for com.c and configure */
+
+/* Begin f2c.h information.  This must match the info in the f2c.h used
+   to build the libf2c with which g77-generated code is linked, or there
+   will probably be bugs, some of them difficult to detect or even trigger.  */
+
+/* The C front-end provides __g77_integer and __g77_uinteger types so that
+   the appropriately-sized signed and unsigned integer types are available
+   for libf2c.  If you change this, also the definitions of those types
+   in ../c-decl.c. */
+#define FFECOM_f2cINTEGER			\
+  (LONG_TYPE_SIZE == FLOAT_TYPE_SIZE		\
+   ? FFECOM_f2ccodeLONG				\
+   : (INT_TYPE_SIZE == FLOAT_TYPE_SIZE		\
+      ? FFECOM_f2ccodeINT			\
+      : (abort (), -1)))
+
+#define FFECOM_f2cLOGICAL FFECOM_f2cINTEGER
+
+/* The C front-end provides __g77_longint and __g77_ulongint types so that
+   the appropriately-sized signed and unsigned integer types are available
+   for libf2c.  If you change this, also the definitions of those types
+   in ../c-decl.c. */
+#define FFECOM_f2cLONGINT				\
+ (LONG_TYPE_SIZE == (FLOAT_TYPE_SIZE * 2)		\
+  ? FFECOM_f2ccodeLONG					\
+  : (LONG_LONG_TYPE_SIZE == (FLOAT_TYPE_SIZE * 2)	\
+     ? FFECOM_f2ccodeLONGLONG				\
+     : (abort (), -1)))
+
+#define FFECOM_f2cADDRESS FFECOM_f2ccodeCHARPTR
+#define FFECOM_f2cSHORTINT FFECOM_f2ccodeSHORT
+#define FFECOM_f2cREAL FFECOM_f2ccodeFLOAT
+#define FFECOM_f2cDOUBLEREAL FFECOM_f2ccodeDOUBLE
+#define FFECOM_f2cCOMPLEX FFECOM_f2ccodeTWOREALS
+#define FFECOM_f2cDOUBLECOMPLEX FFECOM_f2ccodeTWODOUBLEREALS
+#define FFECOM_f2cSHORTLOGICAL FFECOM_f2ccodeSHORT
+#define FFECOM_f2cLOGICAL1 FFECOM_f2ccodeCHAR
+#define FFECOM_f2cINTEGER1 FFECOM_f2ccodeCHAR
+
+/* These must be f2c's INTEGER type, to match runtime/f2c.h.in.  */
+
+#define FFECOM_f2cFLAG FFECOM_f2cINTEGER
+#define FFECOM_f2cFTNINT FFECOM_f2cINTEGER
+#define FFECOM_f2cFTNLEN FFECOM_f2cINTEGER
+
+#endif	/* #if FFECOM_DETERMINE_TYPES */
+
+/* Everything else in f2c.h, specifically the structures used in
+   interfacing compiled code with the library, must remain exactly
+   as delivered, or g77 internals (mostly com.c and ste.c) must
+   be modified accordingly to compensate.  Or there will be...trouble.  */
+
+typedef enum
+  {
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) CODE,
+#include "com-rt.def"
+#undef DEFGFRT
+    FFECOM_gfrt
+  } ffecomGfrt;
+
+/* Typedefs. */
+
+#ifndef TREE_CODE
+#include "tree.h"
+#endif
+
+typedef tree ffecomConstant;
+typedef tree ffecomNonter;
+typedef tree ffecomLabel;
+typedef tree ffecomGlobal;
+typedef tree ffecomStorage;
+typedef struct _ffecom_symbol_ ffecomSymbol;
+
+struct _ffecom_symbol_
+  {
+    tree decl_tree;
+    tree length_tree;		/* For CHARACTER dummies. */
+    tree vardesc_tree;		/* For NAMELIST. */
+    tree assign_tree;		/* For ASSIGN'ed vars. */
+    bool addr;			/* Is address of item instead of item. */
+  };
+
+/* Include files needed by this one. */
+
+#include "bld.h"
+#include "info.h"
+#include "lab.h"
+#include "storag.h"
+#include "symbol.h"
+
+extern int global_bindings_p (void);
+extern tree getdecls (void);
+extern void pushlevel (int);
+extern tree poplevel (int,int, int);
+extern void insert_block (tree);
+extern void set_block (tree);
+extern tree pushdecl (tree);
+
+/* Global objects accessed by users of this module. */
+
+extern GTY(()) tree string_type_node;
+extern GTY(()) tree ffecom_integer_type_node;
+extern GTY(()) tree ffecom_integer_zero_node;
+extern GTY(()) tree ffecom_integer_one_node;
+extern GTY(()) tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype];
+extern ffecomSymbol ffecom_symbol_null_;
+extern ffeinfoKindtype ffecom_pointer_kind_;
+extern ffeinfoKindtype ffecom_label_kind_;
+
+extern int ffecom_f2c_typecode_[FFEINFO_basictype][FFEINFO_kindtype];
+extern GTY(()) tree ffecom_f2c_integer_type_node;
+extern GTY(()) tree ffecom_f2c_address_type_node;
+extern GTY(()) tree ffecom_f2c_real_type_node;
+extern GTY(()) tree ffecom_f2c_doublereal_type_node;
+extern GTY(()) tree ffecom_f2c_complex_type_node;
+extern GTY(()) tree ffecom_f2c_doublecomplex_type_node;
+extern GTY(()) tree ffecom_f2c_longint_type_node;
+extern GTY(()) tree ffecom_f2c_logical_type_node;
+extern GTY(()) tree ffecom_f2c_flag_type_node;
+extern GTY(()) tree ffecom_f2c_ftnlen_type_node;
+extern GTY(()) tree ffecom_f2c_ftnlen_zero_node;
+extern GTY(()) tree ffecom_f2c_ftnlen_one_node;
+extern GTY(()) tree ffecom_f2c_ftnlen_two_node;
+extern GTY(()) tree ffecom_f2c_ptr_to_ftnlen_type_node;
+extern GTY(()) tree ffecom_f2c_ftnint_type_node;
+extern GTY(()) tree ffecom_f2c_ptr_to_ftnint_type_node;
+
+/* Declare functions with prototypes. */
+
+tree ffecom_1 (enum tree_code code, tree type, tree node);
+tree ffecom_1_fn (tree node);
+tree ffecom_2 (enum tree_code code, tree type, tree node1, tree node2);
+bool ffecom_2pass_advise_entrypoint (ffesymbol entry);
+void ffecom_2pass_do_entrypoint (ffesymbol entry);
+tree ffecom_2s (enum tree_code code, tree type, tree node1, tree node2);
+tree ffecom_3 (enum tree_code code, tree type, tree node1, tree node2,
+	       tree node3);
+tree ffecom_3s (enum tree_code code, tree type, tree node1, tree node2,
+		tree node3);
+tree ffecom_arg_expr (ffebld expr, tree *length);
+tree ffecom_arg_ptr_to_const_expr (ffebld expr, tree *length);
+tree ffecom_arg_ptr_to_expr (ffebld expr, tree *length);
+tree ffecom_call_gfrt (ffecomGfrt ix, tree args, tree hook);
+tree ffecom_constantunion_with_type (ffebldConstantUnion *cu, 
+		            tree tree_type,ffebldConst ct);
+tree ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
+			   ffeinfoKindtype kt, tree tree_type);
+tree ffecom_const_expr (ffebld expr);
+tree ffecom_decl_field (tree context, tree prevfield, const char *name,
+			tree type);
+void ffecom_close_include (FILE *f);
+void ffecom_decode_include_option (const char *dir);
+tree ffecom_end_compstmt (void);
+void ffecom_end_transition (void);
+void ffecom_exec_transition (void);
+void ffecom_expand_let_stmt (ffebld dest, ffebld source);
+tree ffecom_expr (ffebld expr);
+tree ffecom_expr_assign (ffebld expr);
+tree ffecom_expr_assign_w (ffebld expr);
+tree ffecom_expr_rw (tree type, ffebld expr);
+tree ffecom_expr_w (tree type, ffebld expr);
+void ffecom_finish_compile (void);
+void ffecom_finish_decl (tree decl, tree init, bool is_top_level);
+void ffecom_finish_progunit (void);
+tree ffecom_get_invented_identifier (const char *pattern, ...)
+  ATTRIBUTE_PRINTF_1;
+ffeinfoBasictype ffecom_gfrt_basictype (ffecomGfrt ix);
+ffeinfoKindtype ffecom_gfrt_kindtype (ffecomGfrt ix);
+void ffecom_init_0 (void);
+void ffecom_init_2 (void);
+tree ffecom_list_expr (ffebld list);
+tree ffecom_list_ptr_to_expr (ffebld list);
+tree ffecom_lookup_label (ffelab label);
+tree ffecom_make_tempvar (const char *commentary, tree type,
+			  ffetargetCharacterSize size, int elements);
+tree ffecom_modify (tree newtype, tree lhs, tree rhs);
+void ffecom_save_tree_forever (tree t);
+void ffecom_file (const char *name);
+void ffecom_notify_init_storage (ffestorag st);
+void ffecom_notify_init_symbol (ffesymbol s);
+void ffecom_notify_primary_entry (ffesymbol fn);
+FILE *ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c);
+void ffecom_prepare_arg_ptr_to_expr (ffebld expr);
+bool ffecom_prepare_end (void);
+void ffecom_prepare_expr_ (ffebld expr, ffebld dest);
+void ffecom_prepare_expr_rw (tree type, ffebld expr);
+void ffecom_prepare_expr_w (tree type, ffebld expr);
+void ffecom_prepare_ptr_to_expr (ffebld expr);
+void ffecom_prepare_return_expr (ffebld expr);
+tree ffecom_ptr_to_const_expr (ffebld expr);
+tree ffecom_ptr_to_expr (ffebld expr);
+tree ffecom_return_expr (ffebld expr);
+tree ffecom_save_tree (tree t);
+void ffecom_start_compstmt (void);
+tree ffecom_start_decl (tree decl, bool is_init);
+void ffecom_sym_commit (ffesymbol s);
+ffesymbol ffecom_sym_end_transition (ffesymbol s);
+ffesymbol ffecom_sym_exec_transition (ffesymbol s);
+ffesymbol ffecom_sym_learned (ffesymbol s);
+void ffecom_sym_retract (ffesymbol s);
+tree ffecom_temp_label (void);
+tree ffecom_truth_value (tree expr);
+tree ffecom_truth_value_invert (tree expr);
+tree ffecom_type_expr (ffebld expr);
+tree ffecom_which_entrypoint_decl (void);
+void ffe_parse_file (int);
+
+/* Define macros. */
+
+#define ffecom_f2c_typecode(bt,kt) ffecom_f2c_typecode_[(bt)][(kt)]
+#define ffecom_label_kind() ffecom_label_kind_
+#define ffecom_pointer_kind() ffecom_pointer_kind_
+#define ffecom_prepare_expr(e) ffecom_prepare_expr_ ((e), NULL)
+
+#define ffecom_init_1()
+#define ffecom_init_3()
+#define ffecom_init_4()
+#define ffecom_terminate_0()
+#define ffecom_terminate_1()
+#define ffecom_terminate_2()
+#define ffecom_terminate_3()
+#define ffecom_terminate_4()
+
+/* End of #include file. */
+
+#endif /* ! GCC_F_COM_H */
diff --git a/gcc/f/config-lang.in b/gcc/f/config-lang.in
new file mode 100644
index 00000000000..92ba5cca73e
--- /dev/null
+++ b/gcc/f/config-lang.in
@@ -0,0 +1,36 @@
+# Top level configure fragment for GNU FORTRAN.
+#   Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002 Free Software Foundation, Inc.
+
+#This file is part of GNU Fortran.
+
+#GNU Fortran is free software; you can redistribute it and/or modify
+#it under the terms of the GNU General Public License as published by
+#the Free Software Foundation; either version 2, or (at your option)
+#any later version.
+
+#GNU Fortran is distributed in the hope that it will be useful,
+#but WITHOUT ANY WARRANTY; without even the implied warranty of
+#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#GNU General Public License for more details.
+
+#You should have received a copy of the GNU General Public License
+#along with GNU Fortran; see the file COPYING.  If not, write to
+#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+#02111-1307, USA.
+
+# Configure looks for the existence of this file to auto-config each language.
+# We define several parameters used by configure:
+#
+# language	- name of language as it would appear in $(LANGUAGES)
+# compilers	- value to add to $(COMPILERS)
+# stagestuff	- files to add to $(STAGESTUFF)
+
+language="f77"
+
+compilers="f771\$(exeext)"
+
+stagestuff="g77\$(exeext) g77-cross\$(exeext) f771\$(exeext)"
+
+target_libs=target-libf2c
+
+gtfiles="\$(srcdir)/f/com.c \$(srcdir)/f/com.h \$(srcdir)/f/ste.c \$(srcdir)/f/where.h \$(srcdir)/f/where.c \$(srcdir)/f/lex.c"
diff --git a/gcc/f/data.c b/gcc/f/data.c
new file mode 100644
index 00000000000..2040f0ab6dc
--- /dev/null
+++ b/gcc/f/data.c
@@ -0,0 +1,1877 @@
+/* data.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1996, 2002, 2003 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Related Modules:
+
+   Description:
+      Do the tough things for DATA statement (and INTEGER FOO/.../-style
+      initializations), like implied-DO and suchlike.
+
+   Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "data.h"
+#include "bit.h"
+#include "bld.h"
+#include "com.h"
+#include "expr.h"
+#include "global.h"
+#include "malloc.h"
+#include "st.h"
+#include "storag.h"
+#include "top.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+/* I picked this value as one that, when plugged into a couple of small
+   but nearly identical test cases I have called BIG-0.f and BIG-1.f,
+   causes BIG-1.f to take about 10 times as long (elapsed) to compile
+   (in f771 only) as BIG-0.f.  These test cases differ in that BIG-0.f
+   doesn't put the one initialized variable in a common area that has
+   a large uninitialized array in it, while BIG-1.f does.  The size of
+   the array is this many elements, as long as they all are INTEGER
+   type.  Note that, as of 0.5.18, sparse cases are better handled,
+   so BIG-2.f now is used; it provides nonzero initial
+   values for all elements of the same array BIG-0 has.  */
+#ifndef FFEDATA_sizeTOO_BIG_INIT_
+#define FFEDATA_sizeTOO_BIG_INIT_ 75*1024
+#endif
+
+/* Internal typedefs. */
+
+typedef struct _ffedata_convert_cache_ *ffedataConvertCache_;
+typedef struct _ffedata_impdo_ *ffedataImpdo_;
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffedata_convert_cache_
+  {
+    ffebld converted;		/* Results of converting expr to following
+				   type. */
+    ffeinfoBasictype basic_type;
+    ffeinfoKindtype kind_type;
+    ffetargetCharacterSize size;
+    ffeinfoRank rank;
+  };
+
+struct _ffedata_impdo_
+  {
+    ffedataImpdo_ outer;	/* Enclosing IMPDO construct. */
+    ffebld outer_list;		/* Item after my IMPDO on the outer list. */
+    ffebld my_list;		/* Beginning of list in my IMPDO. */
+    ffesymbol itervar;		/* Iteration variable. */
+    ffetargetIntegerDefault increment;
+    ffetargetIntegerDefault final;
+  };
+
+/* Static objects accessed by functions in this module. */
+
+static ffedataImpdo_ ffedata_stack_ = NULL;
+static ffebld ffedata_list_ = NULL;
+static bool ffedata_reinit_;	/* value_ should report REINIT error. */
+static bool ffedata_reported_error_;	/* Error has been reported. */
+static ffesymbol ffedata_symbol_ = NULL;	/* Symbol being initialized. */
+static ffeinfoBasictype ffedata_basictype_;	/* Info on symbol. */
+static ffeinfoKindtype ffedata_kindtype_;
+static ffestorag ffedata_storage_;	/* If non-NULL, inits go into this parent. */
+static ffeinfoBasictype ffedata_storage_bt_;	/* Info on storage. */
+static ffeinfoKindtype ffedata_storage_kt_;
+static ffetargetOffset ffedata_storage_size_;	/* Size of entire storage. */
+static ffetargetAlign ffedata_storage_units_;	/* #units per storage unit. */
+static ffetargetOffset ffedata_arraysize_;	/* Size of array being
+						   inited. */
+static ffetargetOffset ffedata_expected_;	/* Number of elements to
+						   init. */
+static ffetargetOffset ffedata_number_;	/* #elements inited so far. */
+static ffetargetOffset ffedata_offset_;	/* Offset of next element. */
+static ffetargetOffset ffedata_symbolsize_;	/* Size of entire sym. */
+static ffetargetCharacterSize ffedata_size_;	/* Size of an element. */
+static ffetargetCharacterSize ffedata_charexpected_;	/* #char to init. */
+static ffetargetCharacterSize ffedata_charnumber_;	/* #chars inited. */
+static ffetargetCharacterSize ffedata_charoffset_;	/* Offset of next char. */
+static ffedataConvertCache_ ffedata_convert_cache_;	/* Fewer conversions. */
+static int ffedata_convert_cache_max_ = 0;	/* #entries available. */
+static int ffedata_convert_cache_use_ = 0;	/* #entries in use. */
+
+/* Static functions (internal). */
+
+static bool ffedata_advance_ (void);
+static ffebld ffedata_convert_ (ffebld source, ffelexToken source_token,
+	    ffelexToken dest_token, ffeinfoBasictype bt, ffeinfoKindtype kt,
+				ffeinfoRank rk, ffetargetCharacterSize sz);
+static ffetargetInteger1 ffedata_eval_integer1_ (ffebld expr);
+static ffetargetOffset ffedata_eval_offset_ (ffebld subscripts,
+					     ffebld dims);
+static ffetargetCharacterSize ffedata_eval_substr_begin_ (ffebld expr);
+static ffetargetCharacterSize ffedata_eval_substr_end_ (ffebld expr,
+		    ffetargetCharacterSize min, ffetargetCharacterSize max);
+static void ffedata_gather_ (ffestorag mst, ffestorag st);
+static void ffedata_pop_ (void);
+static void ffedata_push_ (void);
+static bool ffedata_value_ (ffebld value, ffelexToken token);
+
+/* Internal macros. */
+
+
+/* ffedata_begin -- Initialize with list of targets
+
+   ffebld list;
+   ffedata_begin(list);	 // ITEM... list of SYMTERs, ARRAYs, SUBSTRs, ...
+
+   Remember the list.  After this call, 0...n calls to ffedata_value must
+   follow, and then a single call to ffedata_end.  */
+
+void
+ffedata_begin (ffebld list)
+{
+  assert (ffedata_list_ == NULL);
+  ffedata_list_ = list;
+  ffedata_symbol_ = NULL;
+  ffedata_reported_error_ = FALSE;
+  ffedata_reinit_ = FALSE;
+  ffedata_advance_ ();
+}
+
+/* ffedata_end -- End of initialization sequence
+
+   if (ffedata_end(FALSE))
+       // everything's ok
+
+   Make sure the end of the list is valid here.	 */
+
+bool
+ffedata_end (bool reported_error, ffelexToken t)
+{
+  reported_error |= ffedata_reported_error_;
+
+  /* If still targets to initialize, too few initializers, so complain. */
+
+  if ((ffedata_symbol_ != NULL) && !reported_error)
+    {
+      reported_error = TRUE;
+      ffebad_start (FFEBAD_DATA_TOOFEW);
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_string (ffesymbol_text (ffedata_symbol_));
+      ffebad_finish ();
+    }
+
+  /* Pop off any impdo stacks (present only if ffedata_symbol_ != NULL). */
+
+  while (ffedata_stack_ != NULL)
+    ffedata_pop_ ();
+
+  if (ffedata_list_ != NULL)
+    {
+      assert (reported_error);
+      ffedata_list_ = NULL;
+    }
+
+  return TRUE;
+}
+
+/* ffedata_gather -- Gather previously disparate initializations into one place
+
+   ffestorag st;  // A typeCBLOCK or typeLOCAL aggregate.
+   ffedata_gather(st);
+
+   Prior to this call, st has no init or accretion info, but (presumably
+   at least one of) its subordinate storage areas has init or accretion
+   info.  After this call, none of the subordinate storage areas has inits,
+   because they've all been moved into the newly created init/accretion
+   info for st.	 During this call, conflicting inits produce only one
+   error message.  */
+
+void
+ffedata_gather (ffestorag st)
+{
+  ffesymbol s;
+  ffebld b;
+
+  /* Prepare info on the storage area we're putting init info into. */
+
+  ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_,
+			    &ffedata_storage_units_, ffestorag_basictype (st),
+			    ffestorag_kindtype (st));
+  ffedata_storage_size_ = ffestorag_size (st) / ffedata_storage_units_;
+  assert (ffestorag_size (st) % ffedata_storage_units_ == 0);
+
+  /* If a CBLOCK, gather all the init info for its explicit members. */
+
+  if ((ffestorag_type (st) == FFESTORAG_typeCBLOCK)
+      && (ffestorag_symbol (st) != NULL))
+    {
+      s = ffestorag_symbol (st);
+      for (b = ffesymbol_commonlist (s); b != NULL; b = ffebld_trail (b))
+	ffedata_gather_ (st,
+			 ffesymbol_storage (ffebld_symter (ffebld_head (b))));
+    }
+
+  /* For CBLOCK or LOCAL, gather all the init info for equivalenced members. */
+
+  ffestorag_drive (ffestorag_list_equivs (st), ffedata_gather_, st);
+}
+
+/* ffedata_value -- Provide some number of initial values
+
+   ffebld value;
+   ffelexToken t;  // Points to the value.
+   if (ffedata_value(1,value,t))
+       // Everything's ok
+
+   Makes sure the value is ok, then remembers it according to the list
+   provided to ffedata_begin.  As many instances of the value may be
+   supplied as desired, as indicated by the first argument.  */
+
+bool
+ffedata_value (ffetargetIntegerDefault rpt, ffebld value, ffelexToken token)
+{
+  ffetargetIntegerDefault i;
+
+  /* Maybe ignore zero values, to speed up compiling, even though we lose
+     checking for multiple initializations for now.  */
+
+  if (!ffe_is_zeros ()
+      && (value != NULL)
+      && (ffebld_op (value) == FFEBLD_opCONTER)
+      && ffebld_constant_is_zero (ffebld_conter (value)))
+    value = NULL;
+  else if ((value != NULL)
+	   && (ffebld_op (value) == FFEBLD_opANY))
+    value = NULL;
+  else
+    {
+      /* Must be a constant. */
+      assert (value != NULL);
+      assert (ffebld_op (value) == FFEBLD_opCONTER);
+    }
+
+  /* Later we can optimize certain cases by seeing that the target array can
+     take some number of values, and provide this number to _value_. */
+
+  if (rpt == 1)
+    ffedata_convert_cache_use_ = -1;	/* Don't bother caching. */
+  else
+    ffedata_convert_cache_use_ = 0;	/* Maybe use the cache. */
+
+  for (i = 0; i < rpt; ++i)
+    {
+      if ((ffedata_symbol_ != NULL)
+	  && !ffesymbol_is_init (ffedata_symbol_))
+	{
+	  ffesymbol_signal_change (ffedata_symbol_);
+	  ffesymbol_update_init (ffedata_symbol_);
+	  if (1 || ffe_is_90 ())
+	    ffesymbol_update_save (ffedata_symbol_);
+#if FFEGLOBAL_ENABLED
+	  if (ffesymbol_common (ffedata_symbol_) != NULL)
+	    ffeglobal_init_common (ffesymbol_common (ffedata_symbol_),
+				   token);
+#endif
+	  ffesymbol_signal_unreported (ffedata_symbol_);
+	}
+      if (!ffedata_value_ (value, token))
+	return FALSE;
+    }
+
+  return TRUE;
+}
+
+/* ffedata_advance_ -- Advance initialization target to next item in list
+
+   if (ffedata_advance_())
+       // everything's ok
+
+   Sets common info to characterize the next item in the list.	Handles
+   IMPDO constructs accordingly.  Does not handle advances within a single
+   item, as in the common extension "DATA CHARTYPE/33,34,35/", where
+   CHARTYPE is CHARACTER*3, for example.  */
+
+static bool
+ffedata_advance_ (void)
+{
+  ffebld next;
+
+  /* Come here after handling an IMPDO. */
+
+tail_recurse:			/* :::::::::::::::::::: */
+
+  /* Assume we're not going to find a new target for now. */
+
+  ffedata_symbol_ = NULL;
+
+  /* If at the end of the list, we're done. */
+
+  if (ffedata_list_ == NULL)
+    {
+      ffetargetIntegerDefault newval;
+
+      if (ffedata_stack_ == NULL)
+	return TRUE;		/* No IMPDO in progress, we is done! */
+
+      /* Iterate the IMPDO. */
+
+      newval = ffesymbol_value (ffedata_stack_->itervar)
+	+ ffedata_stack_->increment;
+
+      /* See if we're still in the loop. */
+
+      if (((ffedata_stack_->increment > 0)
+	   ? newval > ffedata_stack_->final
+	   : newval < ffedata_stack_->final)
+	  || (((ffesymbol_value (ffedata_stack_->itervar) < 0)
+	       == (ffedata_stack_->increment < 0))
+	      && ((ffesymbol_value (ffedata_stack_->itervar) < 0)
+		  != (newval < 0))))	/* Overflow/underflow? */
+	{			/* Done with the loop. */
+	  ffedata_list_ = ffedata_stack_->outer_list;	/* Restore list. */
+	  ffedata_pop_ ();	/* Pop me off the impdo stack. */
+	}
+      else
+	{			/* Still in the loop, reset the list and
+				   update the iter var. */
+	  ffedata_list_ = ffedata_stack_->my_list;	/* Reset list. */
+	  ffesymbol_set_value (ffedata_stack_->itervar, newval);
+	}
+      goto tail_recurse;	/* :::::::::::::::::::: */
+    }
+
+  /* Move to the next item in the list. */
+
+  next = ffebld_head (ffedata_list_);
+  ffedata_list_ = ffebld_trail (ffedata_list_);
+
+  /* Really shouldn't happen. */
+
+  if (next == NULL)
+    return TRUE;
+
+  /* See what kind of target this is. */
+
+  switch (ffebld_op (next))
+    {
+    case FFEBLD_opSYMTER:	/* Simple reference to scalar or array. */
+      ffedata_symbol_ = ffebld_symter (next);
+      ffedata_storage_ = (ffesymbol_storage (ffedata_symbol_) == NULL) ? NULL
+	: ffestorag_parent (ffesymbol_storage (ffedata_symbol_));
+      if (ffedata_storage_ != NULL)
+	{
+	  ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_,
+				    &ffedata_storage_units_,
+				    ffestorag_basictype (ffedata_storage_),
+				    ffestorag_kindtype (ffedata_storage_));
+	  ffedata_storage_size_ = ffestorag_size (ffedata_storage_)
+	    / ffedata_storage_units_;
+	  assert (ffestorag_size (ffedata_storage_) % ffedata_storage_units_ == 0);
+	}
+
+      if ((ffesymbol_init (ffedata_symbol_) != NULL)
+	  || (ffesymbol_accretion (ffedata_symbol_) != NULL)
+	  || ((ffedata_storage_ != NULL)
+	      && (ffestorag_init (ffedata_storage_) != NULL)))
+	{
+#if 0
+	  ffebad_start (FFEBAD_DATA_REINIT);
+	  ffest_ffebad_here_current_stmt (0);
+	  ffebad_string (ffesymbol_text (ffedata_symbol_));
+	  ffebad_finish ();
+	  ffedata_reported_error_ = TRUE;
+	  return FALSE;
+#else
+	  ffedata_reinit_ = TRUE;
+	  return TRUE;
+#endif
+	}
+      ffedata_basictype_ = ffesymbol_basictype (ffedata_symbol_);
+      ffedata_kindtype_ = ffesymbol_kindtype (ffedata_symbol_);
+      if (ffesymbol_rank (ffedata_symbol_) == 0)
+	ffedata_arraysize_ = 1;
+      else
+	{
+	  ffebld size = ffesymbol_arraysize (ffedata_symbol_);
+
+	  assert (size != NULL);
+	  assert (ffebld_op (size) == FFEBLD_opCONTER);
+	  assert (ffeinfo_basictype (ffebld_info (size))
+		  == FFEINFO_basictypeINTEGER);
+	  assert (ffeinfo_kindtype (ffebld_info (size))
+		  == FFEINFO_kindtypeINTEGERDEFAULT);
+	  ffedata_arraysize_ = ffebld_constant_integerdefault (ffebld_conter
+							       (size));
+	}
+      ffedata_expected_ = ffedata_arraysize_;
+      ffedata_number_ = 0;
+      ffedata_offset_ = 0;
+      ffedata_size_ = (ffedata_basictype_ == FFEINFO_basictypeCHARACTER)
+	? ffesymbol_size (ffedata_symbol_) : 1;
+      ffedata_symbolsize_ = ffedata_size_ * ffedata_arraysize_;
+      ffedata_charexpected_ = ffedata_size_;
+      ffedata_charnumber_ = 0;
+      ffedata_charoffset_ = 0;
+      break;
+
+    case FFEBLD_opARRAYREF:	/* Reference to element of array. */
+      ffedata_symbol_ = ffebld_symter (ffebld_left (next));
+      ffedata_storage_ = (ffesymbol_storage (ffedata_symbol_) == NULL) ? NULL
+	: ffestorag_parent (ffesymbol_storage (ffedata_symbol_));
+      if (ffedata_storage_ != NULL)
+	{
+	  ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_,
+				    &ffedata_storage_units_,
+				    ffestorag_basictype (ffedata_storage_),
+				    ffestorag_kindtype (ffedata_storage_));
+	  ffedata_storage_size_ = ffestorag_size (ffedata_storage_)
+	    / ffedata_storage_units_;
+	  assert (ffestorag_size (ffedata_storage_) % ffedata_storage_units_ == 0);
+	}
+
+      if ((ffesymbol_init (ffedata_symbol_) != NULL)
+	  || ((ffedata_storage_ != NULL)
+	      && (ffestorag_init (ffedata_storage_) != NULL)))
+	{
+#if 0
+	  ffebad_start (FFEBAD_DATA_REINIT);
+	  ffest_ffebad_here_current_stmt (0);
+	  ffebad_string (ffesymbol_text (ffedata_symbol_));
+	  ffebad_finish ();
+	  ffedata_reported_error_ = TRUE;
+	  return FALSE;
+#else
+	  ffedata_reinit_ = TRUE;
+	  return TRUE;
+#endif
+	}
+      ffedata_basictype_ = ffesymbol_basictype (ffedata_symbol_);
+      ffedata_kindtype_ = ffesymbol_kindtype (ffedata_symbol_);
+      if (ffesymbol_rank (ffedata_symbol_) == 0)
+	ffedata_arraysize_ = 1;	/* Shouldn't happen in this case... */
+      else
+	{
+	  ffebld size = ffesymbol_arraysize (ffedata_symbol_);
+
+	  assert (size != NULL);
+	  assert (ffebld_op (size) == FFEBLD_opCONTER);
+	  assert (ffeinfo_basictype (ffebld_info (size))
+		  == FFEINFO_basictypeINTEGER);
+	  assert (ffeinfo_kindtype (ffebld_info (size))
+		  == FFEINFO_kindtypeINTEGERDEFAULT);
+	  ffedata_arraysize_ = ffebld_constant_integerdefault (ffebld_conter
+							       (size));
+	}
+      ffedata_expected_ = 1;
+      ffedata_number_ = 0;
+      ffedata_offset_ = ffedata_eval_offset_ (ffebld_right (next),
+					  ffesymbol_dims (ffedata_symbol_));
+      ffedata_size_ = (ffedata_basictype_ == FFEINFO_basictypeCHARACTER)
+	? ffesymbol_size (ffedata_symbol_) : 1;
+      ffedata_symbolsize_ = ffedata_size_ * ffedata_arraysize_;
+      ffedata_charexpected_ = ffedata_size_;
+      ffedata_charnumber_ = 0;
+      ffedata_charoffset_ = 0;
+      break;
+
+    case FFEBLD_opSUBSTR:	/* Substring reference to scalar or array
+				   element. */
+      {
+	bool arrayref = ffebld_op (ffebld_left (next)) == FFEBLD_opARRAYREF;
+	ffebld colon = ffebld_right (next);
+
+	assert (colon != NULL);
+
+	ffedata_symbol_ = ffebld_symter (ffebld_left (arrayref
+					      ? ffebld_left (next) : next));
+	ffedata_storage_ = (ffesymbol_storage (ffedata_symbol_) == NULL) ? NULL
+	  : ffestorag_parent (ffesymbol_storage (ffedata_symbol_));
+	if (ffedata_storage_ != NULL)
+	  {
+	    ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_,
+				      &ffedata_storage_units_,
+				      ffestorag_basictype (ffedata_storage_),
+				      ffestorag_kindtype (ffedata_storage_));
+	    ffedata_storage_size_ = ffestorag_size (ffedata_storage_)
+	      / ffedata_storage_units_;
+	    assert (ffestorag_size (ffedata_storage_) % ffedata_storage_units_ == 0);
+	  }
+
+	if ((ffesymbol_init (ffedata_symbol_) != NULL)
+	    || ((ffedata_storage_ != NULL)
+		&& (ffestorag_init (ffedata_storage_) != NULL)))
+	  {
+#if 0
+	    ffebad_start (FFEBAD_DATA_REINIT);
+	    ffest_ffebad_here_current_stmt (0);
+	    ffebad_string (ffesymbol_text (ffedata_symbol_));
+	    ffebad_finish ();
+	    ffedata_reported_error_ = TRUE;
+	    return FALSE;
+#else
+	    ffedata_reinit_ = TRUE;
+	    return TRUE;
+#endif
+	  }
+	ffedata_basictype_ = ffesymbol_basictype (ffedata_symbol_);
+	ffedata_kindtype_ = ffesymbol_kindtype (ffedata_symbol_);
+	if (ffesymbol_rank (ffedata_symbol_) == 0)
+	  ffedata_arraysize_ = 1;
+	else
+	  {
+	    ffebld size = ffesymbol_arraysize (ffedata_symbol_);
+
+	    assert (size != NULL);
+	    assert (ffebld_op (size) == FFEBLD_opCONTER);
+	    assert (ffeinfo_basictype (ffebld_info (size))
+		    == FFEINFO_basictypeINTEGER);
+	    assert (ffeinfo_kindtype (ffebld_info (size))
+		    == FFEINFO_kindtypeINTEGERDEFAULT);
+	    ffedata_arraysize_ = ffebld_constant_integerdefault (ffebld_conter
+								 (size));
+	  }
+	ffedata_expected_ = arrayref ? 1 : ffedata_arraysize_;
+	ffedata_number_ = 0;
+	ffedata_offset_ = arrayref ? ffedata_eval_offset_ (ffebld_right
+		(ffebld_left (next)), ffesymbol_dims (ffedata_symbol_)) : 0;
+	ffedata_size_ = ffesymbol_size (ffedata_symbol_);
+	ffedata_symbolsize_ = ffedata_size_ * ffedata_arraysize_;
+	ffedata_charnumber_ = 0;
+	ffedata_charoffset_ = ffedata_eval_substr_begin_ (ffebld_head (colon));
+	ffedata_charexpected_ = ffedata_eval_substr_end_ (ffebld_head
+				(ffebld_trail (colon)), ffedata_charoffset_,
+				   ffedata_size_) - ffedata_charoffset_ + 1;
+      }
+      break;
+
+    case FFEBLD_opIMPDO:	/* Implied-DO construct. */
+      {
+	ffebld itervar;
+	ffebld start;
+	ffebld end;
+	ffebld incr;
+	ffebld item = ffebld_right (next);
+
+	itervar = ffebld_head (item);
+	item = ffebld_trail (item);
+	start = ffebld_head (item);
+	item = ffebld_trail (item);
+	end = ffebld_head (item);
+	item = ffebld_trail (item);
+	incr = ffebld_head (item);
+
+	ffedata_push_ ();
+	ffedata_stack_->outer_list = ffedata_list_;
+	ffedata_stack_->my_list = ffedata_list_ = ffebld_left (next);
+
+	assert (ffeinfo_basictype (ffebld_info (itervar))
+		== FFEINFO_basictypeINTEGER);
+	assert (ffeinfo_kindtype (ffebld_info (itervar))
+		== FFEINFO_kindtypeINTEGERDEFAULT);
+	ffedata_stack_->itervar = ffebld_symter (itervar);
+	if (ffeinfo_basictype (ffebld_info (start)) != FFEINFO_basictypeINTEGER)
+	  {
+	    ffebad_start (FFEBAD_DATA_EVAL);
+	    ffest_ffebad_here_current_stmt (0);
+	    ffebad_finish ();
+	    ffedata_pop_ ();
+	    ffedata_reported_error_ = TRUE;
+	    return FALSE;
+	  }
+	assert (ffeinfo_basictype (ffebld_info (start))
+		== FFEINFO_basictypeINTEGER);
+	assert (ffeinfo_kindtype (ffebld_info (start))
+		== FFEINFO_kindtypeINTEGERDEFAULT);
+	ffesymbol_set_value (ffedata_stack_->itervar, ffedata_eval_integer1_ (start));
+	if (ffeinfo_basictype (ffebld_info (end)) != FFEINFO_basictypeINTEGER)
+	  {
+	    ffebad_start (FFEBAD_DATA_EVAL);
+	    ffest_ffebad_here_current_stmt (0);
+	    ffebad_finish ();
+	    ffedata_pop_ ();
+	    ffedata_reported_error_ = TRUE;
+	    return FALSE;
+	  }
+	assert (ffeinfo_basictype (ffebld_info (end))
+		== FFEINFO_basictypeINTEGER);
+	assert (ffeinfo_kindtype (ffebld_info (end))
+		== FFEINFO_kindtypeINTEGERDEFAULT);
+	ffedata_stack_->final = ffedata_eval_integer1_ (end);
+
+	if (incr == NULL)
+	  ffedata_stack_->increment = 1;
+	else
+	  {
+	    if (ffeinfo_basictype (ffebld_info (incr)) != FFEINFO_basictypeINTEGER)
+	      {
+		ffebad_start (FFEBAD_DATA_EVAL);
+		ffest_ffebad_here_current_stmt (0);
+		ffebad_finish ();
+		ffedata_pop_ ();
+		ffedata_reported_error_ = TRUE;
+		return FALSE;
+	      }
+	    assert (ffeinfo_basictype (ffebld_info (incr))
+		    == FFEINFO_basictypeINTEGER);
+	    assert (ffeinfo_kindtype (ffebld_info (incr))
+		    == FFEINFO_kindtypeINTEGERDEFAULT);
+	    ffedata_stack_->increment = ffedata_eval_integer1_ (incr);
+	    if (ffedata_stack_->increment == 0)
+	      {
+		ffebad_start (FFEBAD_DATA_ZERO);
+		ffest_ffebad_here_current_stmt (0);
+		ffebad_string (ffesymbol_text (ffedata_stack_->itervar));
+		ffebad_finish ();
+		ffedata_pop_ ();
+		ffedata_reported_error_ = TRUE;
+		return FALSE;
+	      }
+	  }
+
+	if ((ffedata_stack_->increment > 0)
+	    ? ffesymbol_value (ffedata_stack_->itervar)
+	    > ffedata_stack_->final
+	    : ffesymbol_value (ffedata_stack_->itervar)
+	    < ffedata_stack_->final)
+	  {
+	    ffedata_reported_error_ = TRUE;
+	    ffebad_start (FFEBAD_DATA_EMPTY);
+	    ffest_ffebad_here_current_stmt (0);
+	    ffebad_string (ffesymbol_text (ffedata_stack_->itervar));
+	    ffebad_finish ();
+	    ffedata_pop_ ();
+	    return FALSE;
+	  }
+      }
+      goto tail_recurse;	/* :::::::::::::::::::: */
+
+    case FFEBLD_opANY:
+      ffedata_reported_error_ = TRUE;
+      return FALSE;
+
+    default:
+      assert ("bad op" == NULL);
+      break;
+    }
+
+  return TRUE;
+}
+
+/* ffedata_convert_ -- Convert source expression to given type using cache
+
+   ffebld source;
+   ffelexToken source_token;
+   ffelexToken dest_token;  // Any appropriate token for "destination".
+   ffeinfoBasictype bt;
+   ffeinfoKindtype kt;
+   ffetargetCharactersize sz;
+   source = ffedata_convert_(source,source_token,dest_token,bt,kt,sz);
+
+   Like ffeexpr_convert, but calls it only if necessary (if the converted
+   expression doesn't already exist in the cache) and then puts the result
+   in the cache.  */
+
+static ffebld
+ffedata_convert_ (ffebld source, ffelexToken source_token,
+		  ffelexToken dest_token, ffeinfoBasictype bt,
+		  ffeinfoKindtype kt, ffeinfoRank rk,
+		  ffetargetCharacterSize sz)
+{
+  ffebld converted;
+  int i;
+  int max;
+  ffedataConvertCache_ cache;
+
+  for (i = 0; i < ffedata_convert_cache_use_; ++i)
+    if ((bt == ffedata_convert_cache_[i].basic_type)
+	&& (kt == ffedata_convert_cache_[i].kind_type)
+	&& (sz == ffedata_convert_cache_[i].size)
+	&& (rk == ffedata_convert_cache_[i].rank))
+      return ffedata_convert_cache_[i].converted;
+
+  converted = ffeexpr_convert (source, source_token, dest_token, bt, kt, rk,
+			       sz, FFEEXPR_contextDATA);
+
+  if (ffedata_convert_cache_use_ >= ffedata_convert_cache_max_)
+    {
+      if (ffedata_convert_cache_max_ == 0)
+	max = 4;
+      else
+	max = ffedata_convert_cache_max_ << 1;
+
+      if (max > ffedata_convert_cache_max_)
+	{
+	  cache = malloc_new_ks (malloc_pool_image (),
+				 "FFEDATA cache", max * sizeof (*cache));
+	  if (ffedata_convert_cache_max_ != 0)
+	    {
+	      memcpy (cache, ffedata_convert_cache_,
+		      ffedata_convert_cache_max_ * sizeof (*cache));
+	      malloc_kill_ks (malloc_pool_image (), ffedata_convert_cache_,
+			      ffedata_convert_cache_max_ * sizeof (*cache));
+	    }
+	  ffedata_convert_cache_ = cache;
+	  ffedata_convert_cache_max_ = max;
+	}
+      else
+	return converted;	/* In case int overflows! */
+    }
+
+  i = ffedata_convert_cache_use_++;
+
+  ffedata_convert_cache_[i].converted = converted;
+  ffedata_convert_cache_[i].basic_type = bt;
+  ffedata_convert_cache_[i].kind_type = kt;
+  ffedata_convert_cache_[i].size = sz;
+  ffedata_convert_cache_[i].rank = rk;
+
+  return converted;
+}
+
+/* ffedata_eval_integer1_ -- Evaluate expression
+
+   ffetargetIntegerDefault result;
+   ffebld expr;	 // must be kindtypeINTEGER1.
+
+   result = ffedata_eval_integer1_(expr);
+
+   Evalues the expression (which yields a kindtypeINTEGER1 result) and
+   returns the result.	*/
+
+static ffetargetIntegerDefault
+ffedata_eval_integer1_ (ffebld expr)
+{
+  ffetargetInteger1 result;
+  ffebad error;
+
+  assert (expr != NULL);
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opCONTER:
+      return ffebld_constant_integer1 (ffebld_conter (expr));
+
+    case FFEBLD_opSYMTER:
+      return ffesymbol_value (ffebld_symter (expr));
+
+    case FFEBLD_opUPLUS:
+      return ffedata_eval_integer1_ (ffebld_left (expr));
+
+    case FFEBLD_opUMINUS:
+      error = ffetarget_uminus_integer1 (&result,
+			       ffedata_eval_integer1_ (ffebld_left (expr)));
+      break;
+
+    case FFEBLD_opADD:
+      error = ffetarget_add_integer1 (&result,
+				ffedata_eval_integer1_ (ffebld_left (expr)),
+			      ffedata_eval_integer1_ (ffebld_right (expr)));
+      break;
+
+    case FFEBLD_opSUBTRACT:
+      error = ffetarget_subtract_integer1 (&result,
+				ffedata_eval_integer1_ (ffebld_left (expr)),
+			      ffedata_eval_integer1_ (ffebld_right (expr)));
+      break;
+
+    case FFEBLD_opMULTIPLY:
+      error = ffetarget_multiply_integer1 (&result,
+				ffedata_eval_integer1_ (ffebld_left (expr)),
+			      ffedata_eval_integer1_ (ffebld_right (expr)));
+      break;
+
+    case FFEBLD_opDIVIDE:
+      error = ffetarget_divide_integer1 (&result,
+				ffedata_eval_integer1_ (ffebld_left (expr)),
+			      ffedata_eval_integer1_ (ffebld_right (expr)));
+      break;
+
+    case FFEBLD_opPOWER:
+      {
+	ffebld r = ffebld_right (expr);
+
+	if ((ffeinfo_basictype (ffebld_info (r)) != FFEINFO_basictypeINTEGER)
+	    || (ffeinfo_kindtype (ffebld_info (r)) != FFEINFO_kindtypeINTEGERDEFAULT))
+	  error = FFEBAD_DATA_EVAL;
+	else
+	  error = ffetarget_power_integerdefault_integerdefault (&result,
+				ffedata_eval_integer1_ (ffebld_left (expr)),
+						ffedata_eval_integer1_ (r));
+      }
+      break;
+
+#if 0				/* Only for character basictype. */
+    case FFEBLD_opCONCATENATE:
+      error =;
+      break;
+#endif
+
+    case FFEBLD_opNOT:
+      error = ffetarget_not_integer1 (&result,
+			       ffedata_eval_integer1_ (ffebld_left (expr)));
+      break;
+
+#if 0				/* Only for logical basictype. */
+    case FFEBLD_opLT:
+      error =;
+      break;
+
+    case FFEBLD_opLE:
+      error =;
+      break;
+
+    case FFEBLD_opEQ:
+      error =;
+      break;
+
+    case FFEBLD_opNE:
+      error =;
+      break;
+
+    case FFEBLD_opGT:
+      error =;
+      break;
+
+    case FFEBLD_opGE:
+      error =;
+      break;
+#endif
+
+    case FFEBLD_opAND:
+      error = ffetarget_and_integer1 (&result,
+				ffedata_eval_integer1_ (ffebld_left (expr)),
+			      ffedata_eval_integer1_ (ffebld_right (expr)));
+      break;
+
+    case FFEBLD_opOR:
+      error = ffetarget_or_integer1 (&result,
+				ffedata_eval_integer1_ (ffebld_left (expr)),
+			      ffedata_eval_integer1_ (ffebld_right (expr)));
+      break;
+
+    case FFEBLD_opXOR:
+      error = ffetarget_xor_integer1 (&result,
+				ffedata_eval_integer1_ (ffebld_left (expr)),
+			      ffedata_eval_integer1_ (ffebld_right (expr)));
+      break;
+
+    case FFEBLD_opEQV:
+      error = ffetarget_eqv_integer1 (&result,
+				ffedata_eval_integer1_ (ffebld_left (expr)),
+			      ffedata_eval_integer1_ (ffebld_right (expr)));
+      break;
+
+    case FFEBLD_opNEQV:
+      error = ffetarget_neqv_integer1 (&result,
+				ffedata_eval_integer1_ (ffebld_left (expr)),
+			      ffedata_eval_integer1_ (ffebld_right (expr)));
+      break;
+
+    case FFEBLD_opPAREN:
+      return ffedata_eval_integer1_ (ffebld_left (expr));
+
+#if 0				/* ~~ no idea how to do this */
+    case FFEBLD_opPERCENT_LOC:
+      error =;
+      break;
+#endif
+
+#if 0				/* not allowed by ANSI, but perhaps as an
+				   extension someday? */
+    case FFEBLD_opCONVERT:
+      switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+	{
+	case FFEINFO_basictypeINTEGER:
+	  switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	    {
+	    default:
+	      error = FFEBAD_DATA_EVAL;
+	      break;
+	    }
+	  break;
+
+	case FFEINFO_basictypeREAL:
+	  switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	    {
+	    default:
+	      error = FFEBAD_DATA_EVAL;
+	      break;
+	    }
+	  break;
+	}
+      break;
+#endif
+
+#if 0				/* not valid ops */
+    case FFEBLD_opREPEAT:
+      error =;
+      break;
+
+    case FFEBLD_opBOUNDS:
+      error =;
+      break;
+#endif
+
+#if 0				/* not allowed by ANSI, but perhaps as an
+				   extension someday? */
+    case FFEBLD_opFUNCREF:
+      error =;
+      break;
+#endif
+
+#if 0				/* not valid ops */
+    case FFEBLD_opSUBRREF:
+      error =;
+      break;
+
+    case FFEBLD_opARRAYREF:
+      error =;
+      break;
+#endif
+
+#if 0				/* not valid for integer1 */
+    case FFEBLD_opSUBSTR:
+      error =;
+      break;
+#endif
+
+    default:
+      error = FFEBAD_DATA_EVAL;
+      break;
+    }
+
+  if (error != FFEBAD)
+    {
+      ffebad_start (error);
+      ffest_ffebad_here_current_stmt (0);
+      ffebad_finish ();
+      result = 0;
+    }
+
+  return result;
+}
+
+/* ffedata_eval_offset_ -- Evaluate offset info array
+
+   ffetargetOffset offset;  // 0...max-1.
+   ffebld subscripts;  // an opITEM list of subscript exprs.
+   ffebld dims;	 // an opITEM list of opBOUNDS exprs.
+
+   result = ffedata_eval_offset_(expr);
+
+   Evalues the expression (which yields a kindtypeINTEGER1 result) and
+   returns the result.	*/
+
+static ffetargetOffset
+ffedata_eval_offset_ (ffebld subscripts, ffebld dims)
+{
+  ffetargetIntegerDefault offset = 0;
+  ffetargetIntegerDefault width = 1;
+  ffetargetIntegerDefault value;
+  ffetargetIntegerDefault lowbound;
+  ffetargetIntegerDefault highbound;
+  ffetargetOffset final;
+  ffebld subscript;
+  ffebld dim;
+  ffebld low;
+  ffebld high;
+  int rank = 0;
+  bool ok;
+
+  while (subscripts != NULL)
+    {
+      ffeinfoKindtype sub_kind, low_kind, hi_kind;
+      ffebld sub1, low1, hi1;
+
+      ++rank;
+      assert (dims != NULL);
+
+      subscript = ffebld_head (subscripts);
+      dim = ffebld_head (dims);
+
+      assert (ffeinfo_basictype (ffebld_info (subscript)) == FFEINFO_basictypeINTEGER);
+      if (ffebld_op (subscript) == FFEBLD_opCONTER)
+	{
+	  /* Force to default - it's a constant expression !  */
+	  sub_kind = ffeinfo_kindtype (ffebld_info (subscript));
+	  sub1 = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val (
+		   sub_kind == FFEINFO_kindtypeINTEGER2 ? subscript->u.conter.expr->u.integer2 :
+		   sub_kind == FFEINFO_kindtypeINTEGER3 ? subscript->u.conter.expr->u.integer3 :
+		   sub_kind == FFEINFO_kindtypeINTEGER4 ? subscript->u.conter.expr->u.integer4 :
+			subscript->u.conter.expr->u.integer1), NULL);
+	  value = ffedata_eval_integer1_ (sub1);
+	}
+      else
+	value = ffedata_eval_integer1_ (subscript);
+
+      assert (ffebld_op (dim) == FFEBLD_opBOUNDS);
+      low = ffebld_left (dim);
+      high = ffebld_right (dim);
+
+      if (low == NULL)
+	lowbound = 1;
+      else
+	{
+	  assert (ffeinfo_basictype (ffebld_info (low)) == FFEINFO_basictypeINTEGER);
+	  if (ffebld_op (low) == FFEBLD_opCONTER)
+	    {
+	      /* Force to default - it's a constant expression !  */
+	      low_kind = ffeinfo_kindtype (ffebld_info (low));
+	      low1 = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val (
+			low_kind == FFEINFO_kindtypeINTEGER2 ? low->u.conter.expr->u.integer2 :
+			low_kind == FFEINFO_kindtypeINTEGER3 ? low->u.conter.expr->u.integer3 :
+			low_kind == FFEINFO_kindtypeINTEGER4 ? low->u.conter.expr->u.integer4 :
+				low->u.conter.expr->u.integer1), NULL);
+	       lowbound = ffedata_eval_integer1_ (low1);
+	     }
+	   else
+	     lowbound = ffedata_eval_integer1_ (low);
+	}
+
+      assert (ffeinfo_basictype (ffebld_info (high)) == FFEINFO_basictypeINTEGER);
+      if (ffebld_op (high) == FFEBLD_opCONTER)
+	{
+	  /* Force to default - it's a constant expression !  */
+	  hi_kind = ffeinfo_kindtype (ffebld_info (high));
+	  hi1 = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val (
+		   hi_kind == FFEINFO_kindtypeINTEGER2 ? high->u.conter.expr->u.integer2 :
+		   hi_kind == FFEINFO_kindtypeINTEGER3 ? high->u.conter.expr->u.integer3 :
+		   hi_kind == FFEINFO_kindtypeINTEGER4 ? high->u.conter.expr->u.integer4 :
+			high->u.conter.expr->u.integer1), NULL);
+	  highbound = ffedata_eval_integer1_ (hi1);
+	}
+      else
+	highbound = ffedata_eval_integer1_ (high);
+
+      if ((value < lowbound) || (value > highbound))
+	{
+	  char rankstr[10];
+
+	  sprintf (rankstr, "%d", rank);
+	  value = lowbound;
+	  ffebad_start (FFEBAD_DATA_SUBSCRIPT);
+	  ffebad_string (ffesymbol_text (ffedata_symbol_));
+	  ffebad_string (rankstr);
+	  ffebad_finish ();
+	}
+
+      subscripts = ffebld_trail (subscripts);
+      dims = ffebld_trail (dims);
+
+      offset += width * (value - lowbound);
+      if (subscripts != NULL)
+	width *= highbound - lowbound + 1;
+    }
+
+  assert (dims == NULL);
+
+  ok = ffetarget_offset (&final, offset);
+  assert (ok);
+
+  return final;
+}
+
+/* ffedata_eval_substr_begin_ -- Evaluate begin-point of substr reference
+
+   ffetargetCharacterSize beginpoint;
+   ffebld endval;  // head(colon).
+
+   beginpoint = ffedata_eval_substr_end_(endval);
+
+   If beginval is NULL, returns 0.  Otherwise makes sure beginval is
+   kindtypeINTEGERDEFAULT, makes sure its value is > 0,
+   and returns its value minus one, or issues an error message.	 */
+
+static ffetargetCharacterSize
+ffedata_eval_substr_begin_ (ffebld expr)
+{
+  ffetargetIntegerDefault val;
+
+  if (expr == NULL)
+    return 0;
+
+  assert (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeINTEGER);
+  assert (ffeinfo_kindtype (ffebld_info (expr)) == FFEINFO_kindtypeINTEGERDEFAULT);
+
+  val = ffedata_eval_integer1_ (expr);
+
+  if (val < 1)
+    {
+      val = 1;
+      ffebad_start (FFEBAD_DATA_RANGE);
+      ffest_ffebad_here_current_stmt (0);
+      ffebad_string (ffesymbol_text (ffedata_symbol_));
+      ffebad_finish ();
+      ffedata_reported_error_ = TRUE;
+    }
+
+  return val - 1;
+}
+
+/* ffedata_eval_substr_end_ -- Evaluate end-point of substr reference
+
+   ffetargetCharacterSize endpoint;
+   ffebld endval;  // head(trail(colon)).
+   ffetargetCharacterSize min;	// beginpoint of substr reference.
+   ffetargetCharacterSize max;	// size of entity.
+
+   endpoint = ffedata_eval_substr_end_(endval,dflt);
+
+   If endval is NULL, returns max.  Otherwise makes sure endval is
+   kindtypeINTEGERDEFAULT, makes sure its value is > min and <= max,
+   and returns its value minus one, or issues an error message.	 */
+
+static ffetargetCharacterSize
+ffedata_eval_substr_end_ (ffebld expr, ffetargetCharacterSize min,
+			  ffetargetCharacterSize max)
+{
+  ffetargetIntegerDefault val;
+
+  if (expr == NULL)
+    return max - 1;
+
+  assert (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeINTEGER);
+  assert (ffeinfo_kindtype (ffebld_info (expr)) == FFEINFO_kindtypeINTEGER1);
+
+  val = ffedata_eval_integer1_ (expr);
+
+  if ((val < (ffetargetIntegerDefault) min)
+      || (val > (ffetargetIntegerDefault) max))
+    {
+      val = 1;
+      ffebad_start (FFEBAD_DATA_RANGE);
+      ffest_ffebad_here_current_stmt (0);
+      ffebad_string (ffesymbol_text (ffedata_symbol_));
+      ffebad_finish ();
+      ffedata_reported_error_ = TRUE;
+    }
+
+  return val - 1;
+}
+
+/* ffedata_gather_ -- Gather initial values for sym into master sym inits
+
+   ffestorag mst;  // A typeCBLOCK or typeLOCAL aggregate.
+   ffestorag st;  // A typeCOMMON or typeEQUIV member.
+   ffedata_gather_(mst,st);
+
+   If st has any initialization info, transfer that info into mst and
+   clear st's info.  */
+
+static void
+ffedata_gather_ (ffestorag mst, ffestorag st)
+{
+  ffesymbol s;
+  ffesymbol s_whine;		/* Symbol to complain about in diagnostics. */
+  ffebld b;
+  ffetargetOffset offset;
+  ffetargetOffset units_expected;
+  ffebitCount actual;
+  ffebldConstantArray array;
+  ffebld accter;
+  ffetargetCopyfunc fn;
+  void *ptr1;
+  void *ptr2;
+  size_t size;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  ffeinfoBasictype ign_bt;
+  ffeinfoKindtype ign_kt;
+  ffetargetAlign units;
+  ffebit bits;
+  ffetargetOffset source_offset;
+  bool whine = FALSE;
+
+  if (st == NULL)
+    return;			/* Nothing to do. */
+
+  s = ffestorag_symbol (st);
+
+  assert (s != NULL);		/* Must have a corresponding symbol (else how
+				   inited?). */
+  assert (ffestorag_init (st) == NULL);	/* No init info on storage itself. */
+  assert (ffestorag_accretion (st) == NULL);
+
+  if ((((b = ffesymbol_init (s)) == NULL)
+       && ((b = ffesymbol_accretion (s)) == NULL))
+      || (ffebld_op (b) == FFEBLD_opANY)
+      || ((ffebld_op (b) == FFEBLD_opCONVERT)
+	  && (ffebld_op (ffebld_left (b)) == FFEBLD_opANY)))
+    return;			/* Nothing to do. */
+
+  /* b now holds the init/accretion expr. */
+
+  ffesymbol_set_init (s, NULL);
+  ffesymbol_set_accretion (s, NULL);
+  ffesymbol_set_accretes (s, 0);
+
+  s_whine = ffestorag_symbol (mst);
+  if (s_whine == NULL)
+    s_whine = s;
+
+  /* Make sure we haven't fully accreted during an array init. */
+
+  if (ffestorag_init (mst) != NULL)
+    {
+      ffebad_start (FFEBAD_DATA_MULTIPLE);
+      ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ());
+      ffebad_string (ffesymbol_text (s_whine));
+      ffebad_finish ();
+      return;
+    }
+
+  bt = ffeinfo_basictype (ffebld_info (b));
+  kt = ffeinfo_kindtype (ffebld_info (b));
+
+  /* Calculate offset for aggregate area. */
+
+  ffedata_charexpected_ = (bt == FFEINFO_basictypeCHARACTER)
+    ? ffebld_size (b) : 1;
+  ffetarget_aggregate_info (&ign_bt, &ign_kt, &units, bt,
+			    kt);/* Find out unit size of source datum. */
+  assert (units % ffedata_storage_units_ == 0);
+  units_expected = ffedata_charexpected_ * units / ffedata_storage_units_;
+  offset = (ffestorag_offset (st) - ffestorag_offset (mst))
+    / ffedata_storage_units_;
+
+  /* Does an accretion array exist?  If not, create it. */
+
+  if (ffestorag_accretion (mst) == NULL)
+    {
+#if FFEDATA_sizeTOO_BIG_INIT_ != 0
+      if (ffedata_storage_size_ >= FFEDATA_sizeTOO_BIG_INIT_)
+	{
+	  char bignum[40];
+
+	  sprintf (&bignum[0], "%ld", (long) ffedata_storage_size_);
+	  ffebad_start (FFEBAD_TOO_BIG_INIT);
+	  ffebad_here (0, ffesymbol_where_line (s_whine),
+		       ffesymbol_where_column (s_whine));
+	  ffebad_string (ffesymbol_text (s_whine));
+	  ffebad_string (bignum);
+	  ffebad_finish ();
+	}
+#endif
+      array = ffebld_constantarray_new (ffedata_storage_bt_,
+				ffedata_storage_kt_, ffedata_storage_size_);
+      accter = ffebld_new_accter (array, ffebit_new (ffe_pool_program_unit (),
+						     ffedata_storage_size_));
+      ffebld_set_info (accter, ffeinfo_new
+		       (ffedata_storage_bt_,
+			ffedata_storage_kt_,
+			1,
+			FFEINFO_kindENTITY,
+			FFEINFO_whereCONSTANT,
+			(ffedata_basictype_ == FFEINFO_basictypeCHARACTER)
+			? 1 : FFETARGET_charactersizeNONE));
+      ffestorag_set_accretion (mst, accter);
+      ffestorag_set_accretes (mst, ffedata_storage_size_);
+    }
+  else
+    {
+      accter = ffestorag_accretion (mst);
+      assert (ffedata_storage_size_ == (ffetargetOffset) ffebld_accter_size (accter));
+      array = ffebld_accter (accter);
+    }
+
+  /* Put value in accretion array at desired offset. */
+
+  fn = ffetarget_aggregate_ptr_memcpy (ffedata_storage_bt_, ffedata_storage_kt_,
+				       bt, kt);
+
+  switch (ffebld_op (b))
+    {
+    case FFEBLD_opCONTER:
+      ffebld_constantarray_prepare (&ptr1, &ptr2, &size, array, ffedata_storage_bt_,
+				    ffedata_storage_kt_, offset,
+			   ffebld_constant_ptr_to_union (ffebld_conter (b)),
+				    bt, kt);
+      (*fn) (ptr1, ptr2, size);	/* Does the appropriate memcpy-like
+				   operation. */
+      ffebit_count (ffebld_accter_bits (accter),
+		    offset, FALSE, units_expected, &actual);	/* How many FALSE? */
+      if (units_expected != (ffetargetOffset) actual)
+	{
+	  ffebad_start (FFEBAD_DATA_MULTIPLE);
+	  ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ());
+	  ffebad_string (ffesymbol_text (s));
+	  ffebad_finish ();
+	}
+      ffestorag_set_accretes (mst,
+			      ffestorag_accretes (mst)
+			      - actual);	/* Decrement # of values
+						   actually accreted. */
+      ffebit_set (ffebld_accter_bits (accter), offset, 1, units_expected);
+
+      /* If done accreting for this storage area, establish as initialized. */
+
+      if (ffestorag_accretes (mst) == 0)
+	{
+	  ffestorag_set_init (mst, accter);
+	  ffestorag_set_accretion (mst, NULL);
+	  ffebit_kill (ffebld_accter_bits (ffestorag_init (mst)));
+	  ffebld_set_op (ffestorag_init (mst), FFEBLD_opARRTER);
+	  ffebld_set_arrter (ffestorag_init (mst),
+			     ffebld_accter (ffestorag_init (mst)));
+	  ffebld_arrter_set_size (ffestorag_init (mst),
+				  ffedata_storage_size_);
+	  ffebld_arrter_set_pad (ffestorag_init (mst), 0);
+	  ffecom_notify_init_storage (mst);
+	}
+
+      return;
+
+    case FFEBLD_opARRTER:
+      ffebld_constantarray_preparray (&ptr1, &ptr2, &size, array, ffedata_storage_bt_,
+			     ffedata_storage_kt_, offset, ffebld_arrter (b),
+				      bt, kt);
+      size *= ffebld_arrter_size (b);
+      units_expected *= ffebld_arrter_size (b);
+      (*fn) (ptr1, ptr2, size);	/* Does the appropriate memcpy-like
+				   operation. */
+      ffebit_count (ffebld_accter_bits (accter),
+		    offset, FALSE, units_expected, &actual);	/* How many FALSE? */
+      if (units_expected != (ffetargetOffset) actual)
+	{
+	  ffebad_start (FFEBAD_DATA_MULTIPLE);
+	  ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ());
+	  ffebad_string (ffesymbol_text (s));
+	  ffebad_finish ();
+	}
+      ffestorag_set_accretes (mst,
+			      ffestorag_accretes (mst)
+			      - actual);	/* Decrement # of values
+						   actually accreted. */
+      ffebit_set (ffebld_accter_bits (accter), offset, 1, units_expected);
+
+      /* If done accreting for this storage area, establish as initialized. */
+
+      if (ffestorag_accretes (mst) == 0)
+	{
+	  ffestorag_set_init (mst, accter);
+	  ffestorag_set_accretion (mst, NULL);
+	  ffebit_kill (ffebld_accter_bits (ffestorag_init (mst)));
+	  ffebld_set_op (ffestorag_init (mst), FFEBLD_opARRTER);
+	  ffebld_set_arrter (ffestorag_init (mst),
+			     ffebld_accter (ffestorag_init (mst)));
+	  ffebld_arrter_set_size (ffestorag_init (mst),
+				  ffedata_storage_size_);
+	  ffebld_arrter_set_pad (ffestorag_init (mst), 0);
+	  ffecom_notify_init_storage (mst);
+	}
+
+      return;
+
+    case FFEBLD_opACCTER:
+      ffebld_constantarray_preparray (&ptr1, &ptr2, &size, array, ffedata_storage_bt_,
+			     ffedata_storage_kt_, offset, ffebld_accter (b),
+				      bt, kt);
+      bits = ffebld_accter_bits (b);
+      source_offset = 0;
+
+      for (;;)
+	{
+	  ffetargetOffset unexp;
+	  ffetargetOffset siz;
+	  ffebitCount length;
+	  bool value;
+
+	  ffebit_test (bits, source_offset, &value, &length);
+	  if (length == 0)
+	    break;		/* Exit the loop early. */
+	  siz = size * length;
+	  unexp = units_expected * length;
+	  if (value)
+	    {
+	      (*fn) (ptr1, ptr2, siz);	/* Does memcpy-like operation. */
+	      ffebit_count (ffebld_accter_bits (accter),	/* How many FALSE? */
+			    offset, FALSE, unexp, &actual);
+	      if (!whine && (unexp != (ffetargetOffset) actual))
+		{
+		  whine = TRUE;	/* Don't whine more than once for one gather. */
+		  ffebad_start (FFEBAD_DATA_MULTIPLE);
+		  ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ());
+		  ffebad_string (ffesymbol_text (s));
+		  ffebad_finish ();
+		}
+	      ffestorag_set_accretes (mst,
+				      ffestorag_accretes (mst)
+				      - actual);	/* Decrement # of values
+							   actually accreted. */
+	      ffebit_set (ffebld_accter_bits (accter), offset, 1, unexp);
+	    }
+	  source_offset += length;
+	  offset += unexp;
+	  ptr1 = ((char *) ptr1) + siz;
+	  ptr2 = ((char *) ptr2) + siz;
+	}
+
+      /* If done accreting for this storage area, establish as initialized. */
+
+      if (ffestorag_accretes (mst) == 0)
+	{
+	  ffestorag_set_init (mst, accter);
+	  ffestorag_set_accretion (mst, NULL);
+	  ffebit_kill (ffebld_accter_bits (ffestorag_init (mst)));
+	  ffebld_set_op (ffestorag_init (mst), FFEBLD_opARRTER);
+	  ffebld_set_arrter (ffestorag_init (mst),
+			     ffebld_accter (ffestorag_init (mst)));
+	  ffebld_arrter_set_size (ffestorag_init (mst),
+				  ffedata_storage_size_);
+	  ffebld_arrter_set_pad (ffestorag_init (mst), 0);
+	  ffecom_notify_init_storage (mst);
+	}
+
+      return;
+
+    default:
+      assert ("bad init op in gather_" == NULL);
+      return;
+    }
+}
+
+/* ffedata_pop_ -- Pop an impdo stack entry
+
+   ffedata_pop_();  */
+
+static void
+ffedata_pop_ (void)
+{
+  ffedataImpdo_ victim = ffedata_stack_;
+
+  assert (victim != NULL);
+
+  ffedata_stack_ = ffedata_stack_->outer;
+
+  malloc_kill_ks (ffe_pool_program_unit (), victim, sizeof (*victim));
+}
+
+/* ffedata_push_ -- Push an impdo stack entry
+
+   ffedata_push_();  */
+
+static void
+ffedata_push_ (void)
+{
+  ffedataImpdo_ baby;
+
+  baby = malloc_new_ks (ffe_pool_program_unit (), "ffedataImpdo_", sizeof (*baby));
+
+  baby->outer = ffedata_stack_;
+  ffedata_stack_ = baby;
+}
+
+/* ffedata_value_ -- Provide an initial value
+
+   ffebld value;
+   ffelexToken t;  // Points to the value.
+   if (ffedata_value(value,t))
+       // Everything's ok
+
+   Makes sure the value is ok, then remembers it according to the list
+   provided to ffedata_begin.  */
+
+static bool
+ffedata_value_ (ffebld value, ffelexToken token)
+{
+
+  /* If already reported an error, don't do anything. */
+
+  if (ffedata_reported_error_)
+    return FALSE;
+
+  /* If the value is an error marker, remember we've seen one and do nothing
+     else. */
+
+  if ((value != NULL)
+      && (ffebld_op (value) == FFEBLD_opANY))
+    {
+      ffedata_reported_error_ = TRUE;
+      return FALSE;
+    }
+
+  /* If too many values (no more targets), complain. */
+
+  if (ffedata_symbol_ == NULL)
+    {
+      ffebad_start (FFEBAD_DATA_TOOMANY);
+      ffebad_here (0, ffelex_token_where_line (token),
+		   ffelex_token_where_column (token));
+      ffebad_finish ();
+      ffedata_reported_error_ = TRUE;
+      return FALSE;
+    }
+
+  /* If ffedata_advance_ wanted to register a complaint, do it now
+     that we have the token to point at instead of just the start
+     of the whole statement.  */
+
+  if (ffedata_reinit_)
+    {
+      ffebad_start (FFEBAD_DATA_REINIT);
+      ffebad_here (0, ffelex_token_where_line (token),
+		   ffelex_token_where_column (token));
+      ffebad_string (ffesymbol_text (ffedata_symbol_));
+      ffebad_finish ();
+      ffedata_reported_error_ = TRUE;
+      return FALSE;
+    }
+
+#if FFEGLOBAL_ENABLED
+  if (ffesymbol_common (ffedata_symbol_) != NULL)
+    ffeglobal_init_common (ffesymbol_common (ffedata_symbol_), token);
+#endif
+
+  /* Convert value to desired type. */
+
+  if (value != NULL)
+    {
+      if (ffedata_convert_cache_use_ == -1)
+	value = ffeexpr_convert
+	  (value, token, NULL, ffedata_basictype_,
+	   ffedata_kindtype_, 0,
+	   (ffedata_basictype_ == FFEINFO_basictypeCHARACTER)
+	   ? ffedata_charexpected_ : FFETARGET_charactersizeNONE,
+	   FFEEXPR_contextDATA);
+      else				/* Use the cache. */
+	value = ffedata_convert_
+	  (value, token, NULL, ffedata_basictype_,
+	   ffedata_kindtype_, 0,
+	   (ffedata_basictype_ == FFEINFO_basictypeCHARACTER)
+	   ? ffedata_charexpected_ : FFETARGET_charactersizeNONE);
+    }
+
+  /* If we couldn't, bug out. */
+
+  if ((value != NULL) && (ffebld_op (value) == FFEBLD_opANY))
+    {
+      ffedata_reported_error_ = TRUE;
+      return FALSE;
+    }
+
+  /* Handle the case where initializes go to a parent's storage area. */
+
+  if (ffedata_storage_ != NULL)
+    {
+      ffetargetOffset offset;
+      ffetargetOffset units_expected;
+      ffebitCount actual;
+      ffebldConstantArray array;
+      ffebld accter;
+      ffetargetCopyfunc fn;
+      void *ptr1;
+      void *ptr2;
+      size_t size;
+      ffeinfoBasictype ign_bt;
+      ffeinfoKindtype ign_kt;
+      ffetargetAlign units;
+
+      /* Make sure we haven't fully accreted during an array init. */
+
+      if (ffestorag_init (ffedata_storage_) != NULL)
+	{
+	  ffebad_start (FFEBAD_DATA_MULTIPLE);
+	  ffebad_here (0, ffelex_token_where_line (token),
+		       ffelex_token_where_column (token));
+	  ffebad_string (ffesymbol_text (ffedata_symbol_));
+	  ffebad_finish ();
+	  ffedata_reported_error_ = TRUE;
+	  return FALSE;
+	}
+
+      /* Calculate offset. */
+
+      offset = ffedata_offset_ * ffedata_size_ + ffedata_charoffset_;
+
+      /* Is offset within range?  If not, whine, but don't do anything else. */
+
+      if (offset + ffedata_charexpected_ - 1 > ffedata_symbolsize_)
+	{
+	  ffebad_start (FFEBAD_DATA_RANGE);
+	  ffest_ffebad_here_current_stmt (0);
+	  ffebad_string (ffesymbol_text (ffedata_symbol_));
+	  ffebad_finish ();
+	  ffedata_reported_error_ = TRUE;
+	  return FALSE;
+	}
+
+      /* Now calculate offset for aggregate area. */
+
+      ffetarget_aggregate_info (&ign_bt, &ign_kt, &units, ffedata_basictype_,
+				ffedata_kindtype_);	/* Find out unit size of
+							   source datum. */
+      assert (units % ffedata_storage_units_ == 0);
+      units_expected = ffedata_charexpected_ * units / ffedata_storage_units_;
+      offset *= units / ffedata_storage_units_;
+      offset += (ffestorag_offset (ffesymbol_storage (ffedata_symbol_))
+		 - ffestorag_offset (ffedata_storage_))
+	/ ffedata_storage_units_;
+
+      assert (offset + units_expected - 1 <= ffedata_storage_size_);
+
+      /* Does an accretion array exist?	 If not, create it. */
+
+      if (value != NULL)
+	{
+	  if (ffestorag_accretion (ffedata_storage_) == NULL)
+	    {
+#if FFEDATA_sizeTOO_BIG_INIT_ != 0
+	      if (ffedata_storage_size_ >= FFEDATA_sizeTOO_BIG_INIT_)
+		{
+		  char bignum[40];
+
+		  sprintf (&bignum[0], "%ld", (long) ffedata_storage_size_);
+		  ffebad_start (FFEBAD_TOO_BIG_INIT);
+		  ffebad_here (0, ffelex_token_where_line (token),
+			       ffelex_token_where_column (token));
+		  ffebad_string (ffesymbol_text (ffedata_symbol_));
+		  ffebad_string (bignum);
+		  ffebad_finish ();
+		}
+#endif
+	      array = ffebld_constantarray_new
+		(ffedata_storage_bt_, ffedata_storage_kt_,
+		 ffedata_storage_size_);
+	      accter = ffebld_new_accter (array,
+					  ffebit_new (ffe_pool_program_unit (),
+						      ffedata_storage_size_));
+	      ffebld_set_info (accter, ffeinfo_new
+			       (ffedata_storage_bt_,
+				ffedata_storage_kt_,
+				1,
+				FFEINFO_kindENTITY,
+				FFEINFO_whereCONSTANT,
+				(ffedata_basictype_
+				 == FFEINFO_basictypeCHARACTER)
+				? 1 : FFETARGET_charactersizeNONE));
+	      ffestorag_set_accretion (ffedata_storage_, accter);
+	      ffestorag_set_accretes (ffedata_storage_, ffedata_storage_size_);
+	    }
+	  else
+	    {
+	      accter = ffestorag_accretion (ffedata_storage_);
+	      assert (ffedata_storage_size_ == (ffetargetOffset) ffebld_accter_size (accter));
+	      array = ffebld_accter (accter);
+	    }
+
+	  /* Put value in accretion array at desired offset. */
+
+	  fn = ffetarget_aggregate_ptr_memcpy
+	    (ffedata_storage_bt_, ffedata_storage_kt_,
+	     ffedata_basictype_, ffedata_kindtype_);
+	  ffebld_constantarray_prepare
+	    (&ptr1, &ptr2, &size, array, ffedata_storage_bt_,
+	     ffedata_storage_kt_, offset,
+	     ffebld_constant_ptr_to_union (ffebld_conter (value)),
+	     ffedata_basictype_, ffedata_kindtype_);
+	  (*fn) (ptr1, ptr2, size);	/* Does the appropriate memcpy-like
+					   operation. */
+	  ffebit_count (ffebld_accter_bits (accter),
+			offset, FALSE, units_expected,
+			&actual);	/* How many FALSE? */
+	  if (units_expected != (ffetargetOffset) actual)
+	    {
+	      ffebad_start (FFEBAD_DATA_MULTIPLE);
+	      ffebad_here (0, ffelex_token_where_line (token),
+			   ffelex_token_where_column (token));
+	      ffebad_string (ffesymbol_text (ffedata_symbol_));
+	      ffebad_finish ();
+	    }
+	  ffestorag_set_accretes (ffedata_storage_,
+				  ffestorag_accretes (ffedata_storage_)
+				  - actual);	/* Decrement # of values
+						   actually accreted. */
+	  ffebit_set (ffebld_accter_bits (accter), offset,
+		      1, units_expected);
+
+	  /* If done accreting for this storage area, establish as
+	     initialized. */
+
+	  if (ffestorag_accretes (ffedata_storage_) == 0)
+	    {
+	      ffestorag_set_init (ffedata_storage_, accter);
+	      ffestorag_set_accretion (ffedata_storage_, NULL);
+	      ffebit_kill (ffebld_accter_bits
+			   (ffestorag_init (ffedata_storage_)));
+	      ffebld_set_op (ffestorag_init (ffedata_storage_),
+			     FFEBLD_opARRTER);
+	      ffebld_set_arrter
+		(ffestorag_init (ffedata_storage_),
+		 ffebld_accter (ffestorag_init (ffedata_storage_)));
+	      ffebld_arrter_set_size (ffestorag_init (ffedata_storage_),
+				      ffedata_storage_size_);
+	      ffebld_arrter_set_pad (ffestorag_init (ffedata_storage_),
+				     0);
+	      ffecom_notify_init_storage (ffedata_storage_);
+	    }
+	}
+
+      /* If still accreting, adjust specs accordingly and return. */
+
+      if (++ffedata_number_ < ffedata_expected_)
+	{
+	  ++ffedata_offset_;
+	  return TRUE;
+	}
+
+      return ffedata_advance_ ();
+    }
+
+  /* Figure out where the value goes -- in an accretion array or directly
+     into the final initial-value slot for the symbol. */
+
+  if ((ffedata_number_ != 0)
+      || (ffedata_arraysize_ > 1)
+      || (ffedata_charnumber_ != 0)
+      || (ffedata_size_ > ffedata_charexpected_))
+    {				/* Accrete this value. */
+      ffetargetOffset offset;
+      ffebitCount actual;
+      ffebldConstantArray array;
+      ffebld accter = NULL;
+
+      /* Calculate offset. */
+
+      offset = ffedata_offset_ * ffedata_size_ + ffedata_charoffset_;
+
+      /* Is offset within range?  If not, whine, but don't do anything else. */
+
+      if (offset + ffedata_charexpected_ - 1 > ffedata_symbolsize_)
+	{
+	  ffebad_start (FFEBAD_DATA_RANGE);
+	  ffest_ffebad_here_current_stmt (0);
+	  ffebad_string (ffesymbol_text (ffedata_symbol_));
+	  ffebad_finish ();
+	  ffedata_reported_error_ = TRUE;
+	  return FALSE;
+	}
+
+      /* Does an accretion array exist?	 If not, create it. */
+
+      if (value != NULL)
+	{
+	  if (ffesymbol_accretion (ffedata_symbol_) == NULL)
+	    {
+#if FFEDATA_sizeTOO_BIG_INIT_ != 0
+	      if (ffedata_symbolsize_ >= FFEDATA_sizeTOO_BIG_INIT_ )
+		{
+		  char bignum[40];
+
+		  sprintf (&bignum[0], "%ld", (long) ffedata_symbolsize_);
+		  ffebad_start (FFEBAD_TOO_BIG_INIT);
+		  ffebad_here (0, ffelex_token_where_line (token),
+			       ffelex_token_where_column (token));
+		  ffebad_string (ffesymbol_text (ffedata_symbol_));
+		  ffebad_string (bignum);
+		  ffebad_finish ();
+		}
+#endif
+	      array = ffebld_constantarray_new
+		(ffedata_basictype_, ffedata_kindtype_,
+		 ffedata_symbolsize_);
+	      accter = ffebld_new_accter (array,
+					  ffebit_new (ffe_pool_program_unit (),
+						      ffedata_symbolsize_));
+	      ffebld_set_info (accter, ffeinfo_new
+			       (ffedata_basictype_,
+				ffedata_kindtype_,
+				1,
+				FFEINFO_kindENTITY,
+				FFEINFO_whereCONSTANT,
+				(ffedata_basictype_
+				 == FFEINFO_basictypeCHARACTER)
+				? 1 : FFETARGET_charactersizeNONE));
+	      ffesymbol_set_accretion (ffedata_symbol_, accter);
+	      ffesymbol_set_accretes (ffedata_symbol_, ffedata_symbolsize_);
+	    }
+	  else
+	    {
+	      accter = ffesymbol_accretion (ffedata_symbol_);
+	      assert (ffedata_symbolsize_
+		      == (ffetargetOffset) ffebld_accter_size (accter));
+	      array = ffebld_accter (accter);
+	    }
+
+	  /* Put value in accretion array at desired offset. */
+
+	  ffebld_constantarray_put
+	    (array, ffedata_basictype_, ffedata_kindtype_,
+	     offset, ffebld_constant_union (ffebld_conter (value)));
+	  ffebit_count (ffebld_accter_bits (accter), offset, FALSE,
+			ffedata_charexpected_,
+			&actual);	/* How many FALSE? */
+	  if (actual != (unsigned long int) ffedata_charexpected_)
+	    {
+	      ffebad_start (FFEBAD_DATA_MULTIPLE);
+	      ffebad_here (0, ffelex_token_where_line (token),
+			   ffelex_token_where_column (token));
+	      ffebad_string (ffesymbol_text (ffedata_symbol_));
+	      ffebad_finish ();
+	    }
+	  ffesymbol_set_accretes (ffedata_symbol_,
+				  ffesymbol_accretes (ffedata_symbol_)
+				  - actual);	/* Decrement # of values
+						   actually accreted. */
+	  ffebit_set (ffebld_accter_bits (accter), offset,
+		      1, ffedata_charexpected_);
+	  ffesymbol_signal_unreported (ffedata_symbol_);
+	}
+
+      /* If still accreting, adjust specs accordingly and return. */
+
+      if (++ffedata_number_ < ffedata_expected_)
+	{
+	  ++ffedata_offset_;
+	  return TRUE;
+	}
+
+      /* Else, if done accreting for this symbol, establish as initialized. */
+
+      if ((value != NULL)
+	  && (ffesymbol_accretes (ffedata_symbol_) == 0))
+	{
+	  ffesymbol_set_init (ffedata_symbol_, accter);
+	  ffesymbol_set_accretion (ffedata_symbol_, NULL);
+	  ffebit_kill (ffebld_accter_bits (ffesymbol_init (ffedata_symbol_)));
+	  ffebld_set_op (ffesymbol_init (ffedata_symbol_), FFEBLD_opARRTER);
+	  ffebld_set_arrter (ffesymbol_init (ffedata_symbol_),
+			  ffebld_accter (ffesymbol_init (ffedata_symbol_)));
+	  ffebld_arrter_set_size (ffesymbol_init (ffedata_symbol_),
+				  ffedata_symbolsize_);
+	  ffebld_arrter_set_pad (ffestorag_init (ffedata_symbol_), 0);
+	  ffecom_notify_init_symbol (ffedata_symbol_);
+	}
+    }
+  else if (value != NULL)
+    {
+      /* Simple, direct, one-shot assignment. */
+      ffesymbol_set_init (ffedata_symbol_, value);
+      ffecom_notify_init_symbol (ffedata_symbol_);
+    }
+
+  /* Call on advance function to get next target in list. */
+
+  return ffedata_advance_ ();
+}
diff --git a/gcc/f/data.h b/gcc/f/data.h
new file mode 100644
index 00000000000..a99369d0b04
--- /dev/null
+++ b/gcc/f/data.h
@@ -0,0 +1,74 @@
+/* data.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      data.c
+
+   Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef GCC_F_DATA_H
+#define GCC_F_DATA_H
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+
+/* Include files needed by this one. */
+
+#include "bld.h"
+#include "lex.h"
+#include "storag.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+void ffedata_begin (ffebld list);
+bool ffedata_end (bool report_errors, ffelexToken t);
+void ffedata_gather (ffestorag st);
+bool ffedata_value (ffetargetIntegerDefault rpt, ffebld value,
+		    ffelexToken value_token);
+
+/* Define macros. */
+
+#define ffedata_init_0()
+#define ffedata_init_1()
+#define ffedata_init_2()
+#define ffedata_init_3()
+#define ffedata_init_4()
+#define ffedata_terminate_0()
+#define ffedata_terminate_1()
+#define ffedata_terminate_2()
+#define ffedata_terminate_3()
+#define ffedata_terminate_4()
+
+/* End of #include file. */
+
+#endif /* ! GCC_F_DATA_H */
diff --git a/gcc/f/equiv.c b/gcc/f/equiv.c
new file mode 100644
index 00000000000..bd7ac6d4d24
--- /dev/null
+++ b/gcc/f/equiv.c
@@ -0,0 +1,1484 @@
+/* equiv.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1996, 1997, 1998, 2003
+   Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Related Modules:
+      None
+
+   Description:
+      Handles the EQUIVALENCE relationships in a program unit.
+
+   Modifications:
+*/
+
+#define FFEEQUIV_DEBUG 0
+
+/* Include files. */
+
+#include "proj.h"
+#include "equiv.h"
+#include "bad.h"
+#include "bld.h"
+#include "com.h"
+#include "data.h"
+#include "global.h"
+#include "lex.h"
+#include "malloc.h"
+#include "symbol.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffeequiv_list_
+  {
+    ffeequiv first;
+    ffeequiv last;
+  };
+
+/* Static objects accessed by functions in this module. */
+
+static struct _ffeequiv_list_ ffeequiv_list_;
+
+/* Static functions (internal). */
+
+static void ffeequiv_destroy_ (ffeequiv eq);
+static void ffeequiv_layout_local_ (ffeequiv eq);
+static bool ffeequiv_offset_ (ffetargetOffset *offset, ffesymbol s,
+			      ffebld expr, bool subtract,
+			      ffetargetOffset adjust, bool no_precede);
+
+/* Internal macros. */
+
+
+static void
+ffeequiv_destroy_ (ffeequiv victim)
+{
+  ffebld list;
+  ffebld item;
+  ffebld expr;
+
+  for (list = victim->list; list != NULL; list = ffebld_trail (list))
+    {
+      for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
+	{
+	  ffesymbol sym;
+
+	  expr = ffebld_head (item);
+	  sym = ffeequiv_symbol (expr);
+	  if (sym == NULL)
+	    continue;
+	  if (ffesymbol_equiv (sym) != NULL)
+	    ffesymbol_set_equiv (sym, NULL);
+	}
+    }
+  ffeequiv_kill (victim);
+}
+
+/* ffeequiv_layout_local_ -- Lay out storage for local equivalenced vars
+
+   ffeequiv eq;
+   ffeequiv_layout_local_(eq);
+
+   Makes a single master ffestorag object that contains all the vars
+   in the equivalence, and makes subordinate ffestorag objects for the
+   vars with the correct offsets.
+
+   The resulting var offsets are relative not necessarily to 0 -- the
+   are relative to the offset of the master area, which might be 0 or
+   negative, but should never be positive.  */
+
+static void
+ffeequiv_layout_local_ (ffeequiv eq)
+{
+  ffestorag st;			/* Equivalence storage area. */
+  ffebld list;			/* List of list of equivalences. */
+  ffebld item;			/* List of equivalences. */
+  ffebld root_exp;		/* Expression for root sym. */
+  ffestorag root_st;		/* Storage for root. */
+  ffesymbol root_sym;		/* Root itself. */
+  ffebld rooted_exp;		/* Expression for rooted sym in an eqlist. */
+  ffestorag rooted_st;		/* Storage for rooted. */
+  ffesymbol rooted_sym;		/* Rooted symbol itself. */
+  ffetargetOffset eqlist_offset;/* Offset for eqlist from rooted sym. */
+  ffetargetAlign alignment;
+  ffetargetAlign modulo;
+  ffetargetAlign pad;
+  ffetargetOffset size;
+  ffetargetOffset num_elements;
+  bool new_storage;		/* Established new storage info. */
+  bool need_storage;		/* Have need for more storage info. */
+  bool init;
+
+  assert (eq != NULL);
+
+  if (ffeequiv_common (eq) != NULL)
+    {				/* Put in common due to programmer error. */
+      ffeequiv_destroy_ (eq);
+      return;
+    }
+
+  /* Find the symbol for the first valid item in the list of lists, use that
+     as the root symbol.  Doesn't matter if it won't end up at the beginning
+     of the list, though.  */
+
+#if FFEEQUIV_DEBUG
+  fprintf (stderr, "Equiv1:\n");
+#endif
+
+  root_sym = NULL;
+  root_exp = NULL;
+
+  for (list = ffeequiv_list (eq);
+       list != NULL;
+       list = ffebld_trail (list))
+    {				/* For every equivalence list in the list of
+				   equivs */
+      for (item = ffebld_head (list);
+	   item != NULL;
+	   item = ffebld_trail (item))
+	{			/* For every equivalence item in the list */
+	  ffetargetOffset ign;	/* Ignored. */
+
+	  root_exp = ffebld_head (item);
+	  root_sym = ffeequiv_symbol (root_exp);
+	  if (root_sym == NULL)
+	    continue;		/* Ignore me. */
+
+	  assert (ffesymbol_storage (root_sym) == NULL);	/* No storage yet. */
+
+	  if (!ffeequiv_offset_ (&ign, root_sym, root_exp, FALSE, 0, FALSE))
+	    {
+	      /* We can't just eliminate this one symbol from the list
+		 of candidates, because it might be the only one that
+		 ties all these equivs together.  So just destroy the
+		 whole list.  */
+
+	      ffeequiv_destroy_ (eq);
+	      return;
+	    }
+
+	  break;	/* Use first valid eqv expr for root exp/sym. */
+	}
+      if (root_sym != NULL)
+	break;
+    }
+
+  if (root_sym == NULL)
+    {
+      ffeequiv_destroy_ (eq);
+      return;
+    }
+
+
+#if FFEEQUIV_DEBUG
+  fprintf (stderr, "  Root: `%s'\n", ffesymbol_text (root_sym));
+#endif
+
+  /* We've got work to do, so make the LOCAL storage object that'll hold all
+     the equivalenced vars inside it. */
+
+  st = ffestorag_new (ffestorag_list_master ());
+  ffestorag_set_parent (st, NULL);	/* Initializations happen here. */
+  ffestorag_set_init (st, NULL);
+  ffestorag_set_accretion (st, NULL);
+  ffestorag_set_offset (st, 0);		/* Assume equiv will be at root offset 0 for now. */
+  ffestorag_set_alignment (st, 1);
+  ffestorag_set_modulo (st, 0);
+  ffestorag_set_type (st, FFESTORAG_typeLOCAL);
+  ffestorag_set_basictype (st, ffesymbol_basictype (root_sym));
+  ffestorag_set_kindtype (st, ffesymbol_kindtype (root_sym));
+  ffestorag_set_typesymbol (st, root_sym);
+  ffestorag_set_is_save (st, ffeequiv_is_save (eq));
+  if (ffesymbol_is_save (root_sym))
+    ffestorag_update_save (st);
+  ffestorag_set_is_init (st, ffeequiv_is_init (eq));
+  if (ffesymbol_is_init (root_sym))
+    ffestorag_update_init (st);
+  ffestorag_set_symbol (st, root_sym);	/* Assume this will be the root until
+					   we know better (used only to generate
+					   the internal name for the aggregate area,
+					   e.g. for debugging). */
+
+  /* Make the EQUIV storage object for the root symbol. */
+
+  if (ffesymbol_rank (root_sym) == 0)
+    num_elements = 1;
+  else
+    num_elements = ffebld_constant_integerdefault (ffebld_conter
+						(ffesymbol_arraysize (root_sym)));
+  ffetarget_layout (ffesymbol_text (root_sym), &alignment, &modulo, &size,
+		    ffesymbol_basictype (root_sym), ffesymbol_kindtype (root_sym),
+		    ffesymbol_size (root_sym), num_elements);
+  ffestorag_set_size (st, size);	/* Set initial size of aggregate area. */
+
+  pad = ffetarget_align (ffestorag_ptr_to_alignment (st),
+			 ffestorag_ptr_to_modulo (st), 0, alignment,
+			 modulo);
+  assert (pad == 0);
+
+  root_st = ffestorag_new (ffestorag_list_equivs (st));
+  ffestorag_set_parent (root_st, st);	/* Initializations happen there. */
+  ffestorag_set_init (root_st, NULL);
+  ffestorag_set_accretion (root_st, NULL);
+  ffestorag_set_symbol (root_st, root_sym);
+  ffestorag_set_size (root_st, size);
+  ffestorag_set_offset (root_st, 0);	/* Will not change; always 0 relative to itself! */
+  ffestorag_set_alignment (root_st, alignment);
+  ffestorag_set_modulo (root_st, modulo);
+  ffestorag_set_type (root_st, FFESTORAG_typeEQUIV);
+  ffestorag_set_basictype (root_st, ffesymbol_basictype (root_sym));
+  ffestorag_set_kindtype (root_st, ffesymbol_kindtype (root_sym));
+  ffestorag_set_typesymbol (root_st, root_sym);
+  ffestorag_set_is_save (root_st, FALSE);	/* Assume FALSE, then... */
+  if (ffestorag_is_save (st))	/* ...update to TRUE if needed. */
+    ffestorag_update_save (root_st);
+  ffestorag_set_is_init (root_st, FALSE);	/* Assume FALSE, then... */
+  if (ffestorag_is_init (st))	/* ...update to TRUE if needed. */
+    ffestorag_update_init (root_st);
+  ffesymbol_set_storage (root_sym, root_st);
+  ffesymbol_signal_unreported (root_sym);
+  init = ffesymbol_is_init (root_sym);
+
+  /* Now that we know the root (offset=0) symbol, revisit all the lists and
+     do the actual storage allocation.	Keep doing this until we've gone
+     through them all without making any new storage objects. */
+
+  do
+    {
+      new_storage = FALSE;
+      need_storage = FALSE;
+      for (list = ffeequiv_list (eq);
+	   list != NULL;
+	   list = ffebld_trail (list))
+	{			/* For every equivalence list in the list of
+				   equivs */
+	  /* Now find a "rooted" symbol in this list.  That is, find the
+	     first item we can that is valid and whose symbol already
+	     has a storage area, because that means we know where it
+	     belongs in the equivalence area and can then allocate the
+	     rest of the items in the list accordingly.  */
+
+	  rooted_sym = NULL;
+	  rooted_exp = NULL;
+	  eqlist_offset = 0;
+
+	  for (item = ffebld_head (list);
+	       item != NULL;
+	       item = ffebld_trail (item))
+	    {			/* For every equivalence item in the list */
+	      rooted_exp = ffebld_head (item);
+	      rooted_sym = ffeequiv_symbol (rooted_exp);
+	      if ((rooted_sym == NULL)
+		  || ((rooted_st = ffesymbol_storage (rooted_sym)) == NULL))
+		{
+		  rooted_sym = NULL;
+		  continue;	/* Ignore me. */
+		}
+
+	      need_storage = TRUE;	/* Somebody is likely to need
+					   storage. */
+
+#if FFEEQUIV_DEBUG
+	      fprintf (stderr, "  Rooted: `%s' at %" ffetargetOffset_f "d\n",
+		       ffesymbol_text (rooted_sym),
+		       ffestorag_offset (rooted_st));
+#endif
+
+	      /* The offset of this symbol from the equiv's root symbol
+		 is already known, and the size of this symbol is already
+		 incorporated in the size of the equiv's aggregate area.
+		 What we now determine is the offset of this equivalence
+		 _list_ from the equiv's root symbol.
+
+		 For example, if we know that A is at offset 16 from the
+		 root symbol, given EQUIVALENCE (B(24),A(2)), we're looking
+		 at A(2), meaning that the offset for this equivalence list
+		 is 20 (4 bytes beyond the beginning of A, assuming typical
+		 array types, dimensions, and type info).  */
+
+	      if (!ffeequiv_offset_ (&eqlist_offset, rooted_sym, rooted_exp, FALSE,
+				     ffestorag_offset (rooted_st), FALSE))
+
+		{	/* Can't use this one. */
+		  ffesymbol_set_equiv (rooted_sym, NULL);/* Equiv area slated for
+							    death. */
+		  rooted_sym = NULL;
+		  continue;		/* Something's wrong with eqv expr, try another. */
+		}
+
+#if FFEEQUIV_DEBUG
+	      fprintf (stderr, "  Eqlist offset: %" ffetargetOffset_f "d\n",
+		       eqlist_offset);
+#endif
+
+	      break;
+	    }
+
+	  /* If no rooted symbol, it means this list has no roots -- yet.
+	     So, forget this list this time around, but we'll get back
+	     to it after the outer loop iterates at least one more time,
+	     and, ultimately, it will have a root.  */
+
+	  if (rooted_sym == NULL)
+	    {
+#if FFEEQUIV_DEBUG
+	      fprintf (stderr, "No roots.\n");
+#endif
+	      continue;
+	    }
+
+	  /* We now have a rooted symbol/expr and the offset of this equivalence
+	     list from the root symbol.  The other expressions in this
+	     list all identify an initial storage unit that must have the
+	     same offset. */
+
+	  for (item = ffebld_head (list);
+	       item != NULL;
+	       item = ffebld_trail (item))
+	    {			/* For every equivalence item in the list */
+	      ffebld item_exp;			/* Expression for equivalence. */
+	      ffestorag item_st;		/* Storage for var. */
+	      ffesymbol item_sym;		/* Var itself. */
+	      ffetargetOffset item_offset;	/* Offset for var from root. */
+	      ffetargetOffset new_size;
+
+	      item_exp = ffebld_head (item);
+	      item_sym = ffeequiv_symbol (item_exp);
+	      if ((item_sym == NULL)
+		  || (ffesymbol_equiv (item_sym) == NULL))
+		continue;	/* Ignore me. */
+
+	      if (item_sym == rooted_sym)
+		continue;	/* Rooted sym already set up. */
+
+	      if (!ffeequiv_offset_ (&item_offset, item_sym, item_exp, TRUE,
+				     eqlist_offset, FALSE))
+		{
+		  ffesymbol_set_equiv (item_sym, NULL);	/* Don't bother with me anymore. */
+		  continue;
+		}
+
+#if FFEEQUIV_DEBUG
+	      fprintf (stderr, "  Item `%s' at %" ffetargetOffset_f "d",
+		       ffesymbol_text (item_sym), item_offset);
+#endif
+
+	      if (ffesymbol_rank (item_sym) == 0)
+		num_elements = 1;
+	      else
+		num_elements = ffebld_constant_integerdefault (ffebld_conter
+						(ffesymbol_arraysize (item_sym)));
+	      ffetarget_layout (ffesymbol_text (item_sym), &alignment, &modulo,
+				&size, ffesymbol_basictype (item_sym),
+				ffesymbol_kindtype (item_sym), ffesymbol_size (item_sym),
+				num_elements);
+	      pad = ffetarget_align (ffestorag_ptr_to_alignment (st),
+				     ffestorag_ptr_to_modulo (st),
+				     item_offset, alignment, modulo);
+	      if (pad != 0)
+		{
+		  ffebad_start (FFEBAD_EQUIV_ALIGN);
+		  ffebad_string (ffesymbol_text (item_sym));
+		  ffebad_finish ();
+		  ffesymbol_set_equiv (item_sym, NULL);	/* Don't bother with me anymore. */
+		  continue;
+		}
+
+	      /* If the variable's offset is less than the offset for the
+		 aggregate storage area, it means it has to expand backwards
+		 -- i.e. the new known starting point of the area precedes the
+		 old one.  This can't happen with COMMON areas (the standard,
+		 and common sense, disallow it), but it is normal for local
+		 EQUIVALENCE areas.
+
+		 Also handle choosing the "documented" rooted symbol for this
+		 area here.  It's the symbol at the bottom (lowest offset)
+		 of the aggregate area, with ties going to the name that would
+		 sort to the top of the list of ties.  */
+
+	      if (item_offset == ffestorag_offset (st))
+		{
+		  if ((item_sym != ffestorag_symbol (st))
+		      && (strcmp (ffesymbol_text (item_sym),
+				  ffesymbol_text (ffestorag_symbol (st)))
+			  < 0))
+		    ffestorag_set_symbol (st, item_sym);
+		}
+	      else if (item_offset < ffestorag_offset (st))
+		{
+		  /* Increase size of equiv area to start for lower offset
+		     relative to root symbol.  */
+		  if (! ffetarget_offset_add (&new_size,
+					      ffestorag_offset (st)
+					      - item_offset,
+					      ffestorag_size (st)))
+		    ffetarget_offset_overflow (ffesymbol_text (s));
+		  else
+		    ffestorag_set_size (st, new_size);
+
+		  ffestorag_set_symbol (st, item_sym);
+		  ffestorag_set_offset (st, item_offset);
+
+#if FFEEQUIV_DEBUG
+		  fprintf (stderr, " [eq offset=%" ffetargetOffset_f
+			   "d, size=%" ffetargetOffset_f "d]",
+			   item_offset, new_size);
+#endif
+		}
+
+	      if ((item_st = ffesymbol_storage (item_sym)) == NULL)
+		{		/* Create new ffestorag object, extend equiv
+				   area. */
+#if FFEEQUIV_DEBUG
+		  fprintf (stderr, ".\n");
+#endif
+		  new_storage = TRUE;
+		  item_st = ffestorag_new (ffestorag_list_equivs (st));
+		  ffestorag_set_parent (item_st, st);	/* Initializations
+							   happen there. */
+		  ffestorag_set_init (item_st, NULL);
+		  ffestorag_set_accretion (item_st, NULL);
+		  ffestorag_set_symbol (item_st, item_sym);
+		  ffestorag_set_size (item_st, size);
+		  ffestorag_set_offset (item_st, item_offset);
+		  ffestorag_set_alignment (item_st, alignment);
+		  ffestorag_set_modulo (item_st, modulo);
+		  ffestorag_set_type (item_st, FFESTORAG_typeEQUIV);
+		  ffestorag_set_basictype (item_st, ffesymbol_basictype (item_sym));
+		  ffestorag_set_kindtype (item_st, ffesymbol_kindtype (item_sym));
+		  ffestorag_set_typesymbol (item_st, item_sym);
+		  ffestorag_set_is_save (item_st, FALSE);	/* Assume FALSE... */
+		  if (ffestorag_is_save (st))	/* ...update TRUE */
+		    ffestorag_update_save (item_st);	/* if needed. */
+		  ffestorag_set_is_init (item_st, FALSE);	/* Assume FALSE... */
+		  if (ffestorag_is_init (st))	/* ...update TRUE */
+		    ffestorag_update_init (item_st);	/* if needed. */
+		  ffesymbol_set_storage (item_sym, item_st);
+		  ffesymbol_signal_unreported (item_sym);
+		  if (ffesymbol_is_init (item_sym))
+		    init = TRUE;
+
+		  /* Determine new size of equiv area, complain if overflow.  */
+
+		  if (!ffetarget_offset_add (&size, item_offset, size)
+		      || !ffetarget_offset_add (&size, -ffestorag_offset (st), size))
+		    ffetarget_offset_overflow (ffesymbol_text (s));
+		  else if (size > ffestorag_size (st))
+		    ffestorag_set_size (st, size);
+		  ffestorag_update (st, item_sym, ffesymbol_basictype (item_sym),
+				    ffesymbol_kindtype (item_sym));
+		}
+	      else
+		{
+#if FFEEQUIV_DEBUG
+		  fprintf (stderr, " (was %" ffetargetOffset_f "d).\n",
+			   ffestorag_offset (item_st));
+#endif
+		  /* Make sure offset agrees with known offset. */
+		  if (item_offset != ffestorag_offset (item_st))
+		    {
+		      char io1[40];
+		      char io2[40];
+
+		      sprintf (&io1[0], "%" ffetargetOffset_f "d", item_offset);
+		      sprintf (&io2[0], "%" ffetargetOffset_f "d", ffestorag_offset (item_st));
+		      ffebad_start (FFEBAD_EQUIV_MISMATCH);
+		      ffebad_string (ffesymbol_text (item_sym));
+		      ffebad_string (ffesymbol_text (root_sym));
+		      ffebad_string (io1);
+		      ffebad_string (io2);
+		      ffebad_finish ();
+		    }
+		}
+	      ffesymbol_set_equiv (item_sym, NULL);	/* Don't bother with me anymore. */
+	    }			/* (For every equivalence item in the list) */
+	  ffebld_set_head (list, NULL);	/* Don't do this list again. */
+	}			/* (For every equivalence list in the list of
+				   equivs) */
+    } while (new_storage && need_storage);
+
+  ffesymbol_set_equiv (root_sym, NULL);	/* This one has storage now. */
+
+  ffeequiv_kill (eq);		/* Fully processed, no longer needed. */
+
+  /* If the offset for this storage area is zero (it cannot be positive),
+     that means the alignment/modulo info is already correct.  Otherwise,
+     the alignment info is correct, but the modulo info reflects a
+     zero offset, so fix it.  */
+
+  if (ffestorag_offset (st) < 0)
+    {
+      /* Calculate the initial padding necessary to preserve
+	 the alignment/modulo requirements for the storage area.
+	 These requirements are themselves kept track of in the
+	 record for the storage area as a whole, but really pertain
+	 to offset 0 of that area, which is where the root symbol
+	 was originally placed.
+
+	 The goal here is to have the offset and size for the area
+	 faithfully reflect the area itself, not extra requirements
+	 like alignment.  So to meet the alignment requirements,
+	 the modulo for the area should be set as if the area had an
+	 alignment requirement of alignment/0 and was aligned/padded
+	 downward to meet the alignment requirements of the area at
+	 offset zero, the amount of padding needed being the desired
+	 value for the modulo of the area.  */
+
+      alignment = ffestorag_alignment (st);
+      modulo = ffestorag_modulo (st);
+
+      /* Since we want to move the whole area *down* (lower memory
+	 addresses) as required by the alignment/modulo paid, negate
+	 the offset to ffetarget_align, which assumes aligning *up*
+	 is desired.  */
+      pad = ffetarget_align (&alignment, &modulo,
+			     - ffestorag_offset (st),
+			     alignment, 0);
+      ffestorag_set_modulo (st, pad);
+    }
+
+  if (init)
+    ffedata_gather (st);	/* Gather subordinate inits into one init. */
+}
+
+/* ffeequiv_offset_ -- Determine offset from start of symbol
+
+   ffetargetOffset offset;
+   ffesymbol s;	 // Symbol for error reporting.
+   ffebld expr;	 // opSUBSTR, opARRAYREF, opSYMTER, opANY.
+   bool subtract;  // FALSE means add to adjust, TRUE means subtract from it.
+   ffetargetOffset adjust;  // Helps keep answer in pos range (unsigned).
+   if (!ffeequiv_offset_(&offset,s,expr,subtract,adjust))
+       // error doing the calculation, message already printed
+
+   Returns the offset represented by the SUBSTR, ARRAYREF, or SUBSTR/ARRAYREF
+   combination added-to/subtracted-from the adjustment specified.  If there
+   is an error of some kind, returns FALSE, else returns TRUE.	Note that
+   only the first storage unit specified is considered; A(1:1) and A(1:2000)
+   have the same first storage unit and so return the same offset.  */
+
+static bool
+ffeequiv_offset_ (ffetargetOffset *offset, ffesymbol s UNUSED,
+		  ffebld expr, bool subtract, ffetargetOffset adjust,
+		  bool no_precede)
+{
+  ffetargetIntegerDefault value = 0;
+  ffetargetOffset cval;		/* Converted value. */
+  ffesymbol sym;
+
+  if (expr == NULL)
+    return FALSE;
+
+again:				/* :::::::::::::::::::: */
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opANY:
+      return FALSE;
+
+    case FFEBLD_opSYMTER:
+      {
+	ffetargetOffset size;	/* Size of a single unit. */
+	ffetargetAlign a;	/* Ignored. */
+	ffetargetAlign m;	/* Ignored. */
+
+	sym = ffebld_symter (expr);
+	if (ffesymbol_basictype (sym) == FFEINFO_basictypeANY)
+	  return FALSE;
+
+	ffetarget_layout (ffesymbol_text (sym), &a, &m, &size,
+			  ffesymbol_basictype (sym),
+			  ffesymbol_kindtype (sym), 1, 1);
+
+	if (value < 0)
+	  {			/* Really invalid, as in A(-2:5), but in case
+				   it's wanted.... */
+	    if (!ffetarget_offset (&cval, -value))
+	      return FALSE;
+
+	    if (!ffetarget_offset_multiply (&cval, cval, size))
+	      return FALSE;
+
+	    if (subtract)
+	      return ffetarget_offset_add (offset, cval, adjust);
+
+	    if (no_precede && (cval > adjust))
+	      {
+	      neg:		/* :::::::::::::::::::: */
+		ffebad_start (FFEBAD_COMMON_NEG);
+		ffebad_string (ffesymbol_text (sym));
+		ffebad_finish ();
+		return FALSE;
+	      }
+	    return ffetarget_offset_add (offset, -cval, adjust);
+	  }
+
+	if (!ffetarget_offset (&cval, value))
+	  return FALSE;
+
+	if (!ffetarget_offset_multiply (&cval, cval, size))
+	  return FALSE;
+
+	if (!subtract)
+	  return ffetarget_offset_add (offset, cval, adjust);
+
+	if (no_precede && (cval > adjust))
+	  goto neg;		/* :::::::::::::::::::: */
+
+	return ffetarget_offset_add (offset, -cval, adjust);
+      }
+
+    case FFEBLD_opARRAYREF:
+      {
+	ffebld symexp = ffebld_left (expr);
+	ffebld subscripts = ffebld_right (expr);
+	ffebld dims;
+	ffetargetIntegerDefault width;
+	ffetargetIntegerDefault arrayval;
+	ffetargetIntegerDefault lowbound;
+	ffetargetIntegerDefault highbound;
+	ffebld subscript;
+	ffebld dim;
+	ffebld low;
+	ffebld high;
+	int rank = 0;
+
+	if (ffebld_op (symexp) != FFEBLD_opSYMTER)
+	  return FALSE;
+
+	sym = ffebld_symter (symexp);
+	if (ffesymbol_basictype (sym) == FFEINFO_basictypeANY)
+	  return FALSE;
+
+	if (ffesymbol_size (sym) == FFETARGET_charactersizeNONE)
+	  width = 1;
+	else
+	  width = ffesymbol_size (sym);
+	dims = ffesymbol_dims (sym);
+
+	while (subscripts != NULL)
+	  {
+	    ++rank;
+	    if (dims == NULL)
+	      {
+		ffebad_start (FFEBAD_EQUIV_MANY);
+		ffebad_string (ffesymbol_text (sym));
+		ffebad_finish ();
+		return FALSE;
+	      }
+
+	    subscript = ffebld_head (subscripts);
+	    dim = ffebld_head (dims);
+
+	    if (ffebld_op (subscript) == FFEBLD_opANY)
+	      return FALSE;
+
+	    assert (ffebld_op (subscript) == FFEBLD_opCONTER);
+	    assert (ffeinfo_basictype (ffebld_info (subscript))
+		    == FFEINFO_basictypeINTEGER);
+	    assert (ffeinfo_kindtype (ffebld_info (subscript))
+		    == FFEINFO_kindtypeINTEGERDEFAULT);
+	    arrayval = ffebld_constant_integerdefault (ffebld_conter
+						       (subscript));
+
+	    if (ffebld_op (dim) == FFEBLD_opANY)
+	      return FALSE;
+
+	    assert (ffebld_op (dim) == FFEBLD_opBOUNDS);
+	    low = ffebld_left (dim);
+	    high = ffebld_right (dim);
+
+	    if (low == NULL)
+	      lowbound = 1;
+	    else
+	      {
+		if (ffebld_op (low) == FFEBLD_opANY)
+		  return FALSE;
+
+		assert (ffebld_op (low) == FFEBLD_opCONTER);
+		assert (ffeinfo_basictype (ffebld_info (low))
+			== FFEINFO_basictypeINTEGER);
+		assert (ffeinfo_kindtype (ffebld_info (low))
+			== FFEINFO_kindtypeINTEGERDEFAULT);
+		lowbound
+		  = ffebld_constant_integerdefault (ffebld_conter (low));
+	      }
+
+	    if (ffebld_op (high) == FFEBLD_opANY)
+	      return FALSE;
+
+	    assert (ffebld_op (high) == FFEBLD_opCONTER);
+	    assert (ffeinfo_basictype (ffebld_info (high))
+		    == FFEINFO_basictypeINTEGER);
+	    assert (ffeinfo_kindtype (ffebld_info (high))
+		    == FFEINFO_kindtypeINTEGER1);
+	    highbound
+	      = ffebld_constant_integerdefault (ffebld_conter (high));
+
+	    if ((arrayval < lowbound) || (arrayval > highbound))
+	      {
+		char rankstr[10];
+
+		sprintf (rankstr, "%d", rank);
+		ffebad_start (FFEBAD_EQUIV_SUBSCRIPT);
+		ffebad_string (ffesymbol_text (sym));
+		ffebad_string (rankstr);
+		ffebad_finish ();
+	      }
+
+	    subscripts = ffebld_trail (subscripts);
+	    dims = ffebld_trail (dims);
+
+	    value += width * (arrayval - lowbound);
+	    if (subscripts != NULL)
+	      width *= highbound - lowbound + 1;
+	  }
+
+	if (dims != NULL)
+	  {
+	    ffebad_start (FFEBAD_EQUIV_FEW);
+	    ffebad_string (ffesymbol_text (sym));
+	    ffebad_finish ();
+	    return FALSE;
+	  }
+
+	expr = symexp;
+      }
+      goto again;		/* :::::::::::::::::::: */
+
+    case FFEBLD_opSUBSTR:
+      {
+	ffebld begin = ffebld_head (ffebld_right (expr));
+
+	expr = ffebld_left (expr);
+	if (ffebld_op (expr) == FFEBLD_opANY)
+	  return FALSE;
+	if (ffebld_op (expr) == FFEBLD_opARRAYREF)
+	  sym = ffebld_symter (ffebld_left (expr));
+	else if (ffebld_op (expr) == FFEBLD_opSYMTER)
+	  sym = ffebld_symter (expr);
+	else
+	  sym = NULL;
+
+	if ((sym != NULL)
+	    && (ffesymbol_basictype (sym) == FFEINFO_basictypeANY))
+	  return FALSE;
+
+	if (begin == NULL)
+	  value = 0;
+	else
+	  {
+	    if (ffebld_op (begin) == FFEBLD_opANY)
+	      return FALSE;
+	    assert (ffebld_op (begin) == FFEBLD_opCONTER);
+	    assert (ffeinfo_basictype (ffebld_info (begin))
+		    == FFEINFO_basictypeINTEGER);
+	    assert (ffeinfo_kindtype (ffebld_info (begin))
+		    == FFEINFO_kindtypeINTEGERDEFAULT);
+
+	    value = ffebld_constant_integerdefault (ffebld_conter (begin));
+
+	    if ((value < 1)
+		|| ((sym != NULL)
+		    && (value > ffesymbol_size (sym))))
+	      {
+		ffebad_start (FFEBAD_EQUIV_RANGE);
+		ffebad_string (ffesymbol_text (sym));
+		ffebad_finish ();
+	      }
+
+	    --value;
+	  }
+	if ((sym != NULL)
+	    && (ffesymbol_basictype (sym) != FFEINFO_basictypeCHARACTER))
+	  {
+	    ffebad_start (FFEBAD_EQUIV_SUBSTR);
+	    ffebad_string (ffesymbol_text (sym));
+	    ffebad_finish ();
+	    value = 0;
+	  }
+      }
+      goto again;		/* :::::::::::::::::::: */
+
+    default:
+      assert ("bad op" == NULL);
+      return FALSE;
+    }
+
+}
+
+/* ffeequiv_add -- Add list of equivalences to list of lists for eq object
+
+   ffeequiv eq;
+   ffebld list;
+   ffelexToken t;  // points to first item in equivalence list
+   ffeequiv_add(eq,list,t);
+
+   Check the list to make sure only one common symbol is involved (even
+   if multiple times) and agrees with the common symbol for the equivalence
+   object (or it has no common symbol until now).  Prepend (or append, it
+   doesn't matter) the list to the list of lists for the equivalence object.
+   Otherwise report an error and return.  */
+
+void
+ffeequiv_add (ffeequiv eq, ffebld list, ffelexToken t)
+{
+  ffebld item;
+  ffesymbol symbol;
+  ffesymbol common = ffeequiv_common (eq);
+
+  for (item = list; item != NULL; item = ffebld_trail (item))
+    {
+      symbol = ffeequiv_symbol (ffebld_head (item));
+
+      if (ffesymbol_common (symbol) != NULL)	/* Is symbol known in COMMON yet? */
+	{
+	  if (common == NULL)
+	    common = ffesymbol_common (symbol);
+	  else if (common != ffesymbol_common (symbol))
+	    {
+	      /* Yes, and symbol disagrees with others on the COMMON area. */
+	      ffebad_start (FFEBAD_EQUIV_COMMON);
+	      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	      ffebad_string (ffesymbol_text (common));
+	      ffebad_string (ffesymbol_text (ffesymbol_common (symbol)));
+	      ffebad_finish ();
+	      return;
+	    }
+	}
+    }
+
+  if ((common != NULL)
+      && (ffeequiv_common (eq) == NULL))	/* Is COMMON involved already? */
+    ffeequiv_set_common (eq, common);	/* No, but it is now. */
+
+  for (item = list; item != NULL; item = ffebld_trail (item))
+    {
+      symbol = ffeequiv_symbol (ffebld_head (item));
+
+      if (ffesymbol_equiv (symbol) == NULL)
+	ffesymbol_set_equiv (symbol, eq);
+      else
+	assert (ffesymbol_equiv (symbol) == eq);
+
+      if (ffesymbol_common (symbol) == NULL)	/* Is symbol in a COMMON
+						   area? */
+	{			/* No (at least not yet). */
+	  if (ffesymbol_is_save (symbol))
+	    ffeequiv_update_save (eq);	/* EQUIVALENCE has >=1 SAVEd entity. */
+	  if (ffesymbol_is_init (symbol))
+	    ffeequiv_update_init (eq);	/* EQUIVALENCE has >=1 init'd entity. */
+	  continue;		/* Nothing more to do here. */
+	}
+
+#if FFEGLOBAL_ENABLED
+      if (ffesymbol_is_init (symbol))
+	ffeglobal_init_common (ffesymbol_common (symbol), t);
+#endif
+
+      if (ffesymbol_is_save (ffesymbol_common (symbol)))
+	ffeequiv_update_save (eq);	/* EQUIVALENCE is in a SAVEd COMMON block. */
+      if (ffesymbol_is_init (ffesymbol_common (symbol)))
+	ffeequiv_update_init (eq);	/* EQUIVALENCE is in a init'd COMMON block. */
+    }
+
+  ffeequiv_set_list (eq, ffebld_new_item (list, ffeequiv_list (eq)));
+}
+
+/* ffeequiv_exec_transition -- Do the hard work on all the equivalence objects
+
+   ffeequiv_exec_transition();	*/
+
+void
+ffeequiv_exec_transition (void)
+{
+  while (ffeequiv_list_.first != (ffeequiv) &ffeequiv_list_.first)
+    ffeequiv_layout_local_ (ffeequiv_list_.first);
+}
+
+/* ffeequiv_init_2 -- Initialize for new program unit
+
+   ffeequiv_init_2();
+
+   Initializes the list of equivalences.  */
+
+void
+ffeequiv_init_2 (void)
+{
+  ffeequiv_list_.first = (ffeequiv) &ffeequiv_list_.first;
+  ffeequiv_list_.last = (ffeequiv) &ffeequiv_list_.first;
+}
+
+/* ffeequiv_kill -- Kill equivalence object after removing from list
+
+   ffeequiv eq;
+   ffeequiv_kill(eq);
+
+   Removes equivalence object from master list, then kills it.	*/
+
+void
+ffeequiv_kill (ffeequiv victim)
+{
+  victim->next->previous = victim->previous;
+  victim->previous->next = victim->next;
+  if (ffe_is_do_internal_checks ())
+    {
+      ffebld list;
+      ffebld item;
+      ffebld expr;
+
+      /* Assert that nobody our victim points to still points to it.  */
+
+      assert ((victim->common == NULL)
+	      || (ffesymbol_equiv (victim->common) == NULL));
+
+      for (list = victim->list; list != NULL; list = ffebld_trail (list))
+	{
+	  for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
+	    {
+	      ffesymbol sym;
+
+	      expr = ffebld_head (item);
+	      sym = ffeequiv_symbol (expr);
+	      if (sym == NULL)
+		continue;
+	      assert (ffesymbol_equiv (sym) != victim);
+	    }
+	}
+    }
+  malloc_kill_ks (ffe_pool_program_unit (), victim, sizeof (*victim));
+}
+
+/* ffeequiv_layout_cblock -- Lay out storage for common area
+
+   ffestorag st;
+   if (ffeequiv_layout_cblock(st))
+       // at least one equiv'd symbol has init/accretion expr.
+
+   Now that the explicitly COMMONed variables in the common area (whose
+   ffestorag object is passed) have been laid out, lay out the storage
+   for all variables equivalenced into the area by making subordinate
+   ffestorag objects for them.	*/
+
+bool
+ffeequiv_layout_cblock (ffestorag st)
+{
+  ffesymbol s = ffestorag_symbol (st);	/* CBLOCK symbol. */
+  ffebld list;			/* List of explicit common vars, in order, in
+				   s. */
+  ffebld item;			/* List of list of equivalences in a given
+				   explicit common var. */
+  ffebld root;			/* Expression for (1st) explicit common var
+				   in list of eqs. */
+  ffestorag rst;		/* Storage for root. */
+  ffetargetOffset root_offset;	/* Offset for root into common area. */
+  ffesymbol sr;			/* Root itself. */
+  ffeequiv seq;			/* Its equivalence object, if any. */
+  ffebld var;			/* Expression for equivalence. */
+  ffestorag vst;		/* Storage for var. */
+  ffetargetOffset var_offset;	/* Offset for var into common area. */
+  ffesymbol sv;			/* Var itself. */
+  ffebld altroot;		/* Alternate root. */
+  ffesymbol altrootsym;		/* Alternate root symbol. */
+  ffetargetAlign alignment;
+  ffetargetAlign modulo;
+  ffetargetAlign pad;
+  ffetargetOffset size;
+  ffetargetOffset num_elements;
+  bool new_storage;		/* Established new storage info. */
+  bool need_storage;		/* Have need for more storage info. */
+  bool ok;
+  bool init = FALSE;
+
+  assert (st != NULL);
+  assert (ffestorag_type (st) == FFESTORAG_typeCBLOCK);
+  assert (ffesymbol_kind (ffestorag_symbol (st)) == FFEINFO_kindCOMMON);
+
+  for (list = ffesymbol_commonlist (ffestorag_symbol (st));
+       list != NULL;
+       list = ffebld_trail (list))
+    {				/* For every variable in the common area */
+      assert (ffebld_op (ffebld_head (list)) == FFEBLD_opSYMTER);
+      sr = ffebld_symter (ffebld_head (list));
+      if ((seq = ffesymbol_equiv (sr)) == NULL)
+	continue;		/* No equivalences to process. */
+      rst = ffesymbol_storage (sr);
+      if (rst == NULL)
+	{
+	  assert (ffesymbol_kind (sr) == FFEINFO_kindANY);
+	  continue;
+	}
+      ffesymbol_set_equiv (sr, NULL);	/* Cancel ref to equiv obj. */
+      do
+	{
+	  new_storage = FALSE;
+	  need_storage = FALSE;
+	  for (item = ffeequiv_list (seq);	/* Get list of equivs. */
+	       item != NULL;
+	       item = ffebld_trail (item))
+	    {			/* For every eqv list in the list of equivs
+				   for the variable */
+	      altroot = NULL;
+	      altrootsym = NULL;
+	      for (root = ffebld_head (item);
+		   root != NULL;
+		   root = ffebld_trail (root))
+		{		/* For every equivalence item in the list */
+		  sv = ffeequiv_symbol (ffebld_head (root));
+		  if (sv == sr)
+		    break;	/* Found first mention of "rooted" symbol. */
+		  if (ffesymbol_storage (sv) != NULL)
+		    {
+		      altroot = root;	/* If no mention, use this guy
+					   instead. */
+		      altrootsym = sv;
+		    }
+		}
+	      if (root != NULL)
+		{
+		  root = ffebld_head (root);	/* Lose its opITEM. */
+		  ok = ffeequiv_offset_ (&root_offset, sr, root, FALSE,
+					 ffestorag_offset (rst), TRUE);
+		  /* Equiv point prior to start of common area? */
+		}
+	      else if (altroot != NULL)
+		{
+		  /* Equiv point prior to start of common area? */
+		  root = ffebld_head (altroot);
+		  ok = ffeequiv_offset_ (&root_offset, altrootsym, root,
+					 FALSE,
+			 ffestorag_offset (ffesymbol_storage (altrootsym)),
+					 TRUE);
+		  ffesymbol_set_equiv (altrootsym, NULL);
+		}
+	      else
+		/* No rooted symbol in list of equivalences! */
+		{		/* Assume this was due to opANY and ignore
+				   this list for now. */
+		  need_storage = TRUE;
+		  continue;
+		}
+
+	      /* We now know the root symbol and the operating offset of that
+		 root into the common area.  The other expressions in the
+		 list all identify an initial storage unit that must have the
+		 same offset. */
+
+	      for (var = ffebld_head (item);
+		   var != NULL;
+		   var = ffebld_trail (var))
+		{		/* For every equivalence item in the list */
+		  if (ffebld_head (var) == root)
+		    continue;	/* Except root, of course. */
+		  sv = ffeequiv_symbol (ffebld_head (var));
+		  if (sv == NULL)
+		    continue;	/* Except erroneous stuff (opANY). */
+		  ffesymbol_set_equiv (sv, NULL);	/* Don't need this ref
+							   anymore. */
+		  if (!ok
+		      || !ffeequiv_offset_ (&var_offset, sv,
+					    ffebld_head (var), TRUE,
+					    root_offset, TRUE))
+		    continue;	/* Can't do negative offset wrt COMMON. */
+
+		  if (ffesymbol_rank (sv) == 0)
+		    num_elements = 1;
+		  else
+		    num_elements = ffebld_constant_integerdefault
+		      (ffebld_conter (ffesymbol_arraysize (sv)));
+		  ffetarget_layout (ffesymbol_text (sv), &alignment,
+				    &modulo, &size,
+				    ffesymbol_basictype (sv),
+				    ffesymbol_kindtype (sv),
+				    ffesymbol_size (sv), num_elements);
+		  pad = ffetarget_align (ffestorag_ptr_to_alignment (st),
+					 ffestorag_ptr_to_modulo (st),
+					 var_offset, alignment, modulo);
+		  if (pad != 0)
+		    {
+		      ffebad_start (FFEBAD_EQUIV_ALIGN);
+		      ffebad_string (ffesymbol_text (sv));
+		      ffebad_finish ();
+		      continue;
+		    }
+
+		  if ((vst = ffesymbol_storage (sv)) == NULL)
+		    {		/* Create new ffestorag object, extend
+				   cblock. */
+		      new_storage = TRUE;
+		      vst = ffestorag_new (ffestorag_list_equivs (st));
+		      ffestorag_set_parent (vst, st);	/* Initializations
+							   happen there. */
+		      ffestorag_set_init (vst, NULL);
+		      ffestorag_set_accretion (vst, NULL);
+		      ffestorag_set_symbol (vst, sv);
+		      ffestorag_set_size (vst, size);
+		      ffestorag_set_offset (vst, var_offset);
+		      ffestorag_set_alignment (vst, alignment);
+		      ffestorag_set_modulo (vst, modulo);
+		      ffestorag_set_type (vst, FFESTORAG_typeEQUIV);
+		      ffestorag_set_basictype (vst, ffesymbol_basictype (sv));
+		      ffestorag_set_kindtype (vst, ffesymbol_kindtype (sv));
+		      ffestorag_set_typesymbol (vst, sv);
+		      ffestorag_set_is_save (vst, FALSE);	/* Assume FALSE... */
+		      if (ffestorag_is_save (st))	/* ...update TRUE */
+			ffestorag_update_save (vst);	/* if needed. */
+		      ffestorag_set_is_init (vst, FALSE);	/* Assume FALSE... */
+		      if (ffestorag_is_init (st))	/* ...update TRUE */
+			ffestorag_update_init (vst);	/* if needed. */
+		      if (!ffetarget_offset_add (&size, var_offset, size))
+			/* Find one size of common block, complain if
+			   overflow. */
+			ffetarget_offset_overflow (ffesymbol_text (s));
+		      else if (size > ffestorag_size (st))
+			/* Extend common. */
+			ffestorag_set_size (st, size);
+		      ffesymbol_set_storage (sv, vst);
+		      ffesymbol_set_common (sv, s);
+		      ffesymbol_signal_unreported (sv);
+		      ffestorag_update (st, sv, ffesymbol_basictype (sv),
+					ffesymbol_kindtype (sv));
+		      if (ffesymbol_is_init (sv))
+			init = TRUE;
+		    }
+		  else
+		    {
+		      /* Make sure offset agrees with known offset. */
+		      if (var_offset != ffestorag_offset (vst))
+			{
+			  char io1[40];
+			  char io2[40];
+
+			  sprintf (&io1[0], "%" ffetargetOffset_f "d", var_offset);
+			  sprintf (&io2[0], "%" ffetargetOffset_f "d", ffestorag_offset (vst));
+			  ffebad_start (FFEBAD_EQUIV_MISMATCH);
+			  ffebad_string (ffesymbol_text (sv));
+			  ffebad_string (ffesymbol_text (s));
+			  ffebad_string (io1);
+			  ffebad_string (io2);
+			  ffebad_finish ();
+			}
+		    }
+		}		/* (For every equivalence item in the list) */
+	    }			/* (For every eqv list in the list of equivs
+				   for the variable) */
+	}
+      while (new_storage && need_storage);
+
+      ffeequiv_kill (seq);	/* Kill equiv obj. */
+    }				/* (For every variable in the common area) */
+
+  return init;
+}
+
+/* ffeequiv_merge -- Merge two equivalence objects, return the merged result
+
+   ffeequiv eq1;
+   ffeequiv eq2;
+   ffelexToken t;  // points to current equivalence item forcing the merge.
+   eq1 = ffeequiv_merge(eq1,eq2,t);
+
+   If the two equivalence objects can be merged, they are, all the
+   ffesymbols in their lists of lists are adjusted to point to the merged
+   equivalence object, and the merged object is returned.
+
+   Otherwise, the two equivalence objects have different non-NULL common
+   symbols, so the merge cannot take place.  An error message is issued and
+   NULL is returned.  */
+
+ffeequiv
+ffeequiv_merge (ffeequiv eq1, ffeequiv eq2, ffelexToken t)
+{
+  ffebld list;
+  ffebld eqs;
+  ffesymbol symbol;
+  ffebld last = NULL;
+
+  /* If both equivalence objects point to different common-based symbols,
+     complain.	Of course, one or both might have NULL common symbols now,
+     and get COMMONed later, but the COMMON statement handler checks for
+     this. */
+
+  if ((ffeequiv_common (eq1) != NULL) && (ffeequiv_common (eq2) != NULL)
+      && (ffeequiv_common (eq1) != ffeequiv_common (eq2)))
+    {
+      ffebad_start (FFEBAD_EQUIV_COMMON);
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_string (ffesymbol_text (ffeequiv_common (eq1)));
+      ffebad_string (ffesymbol_text (ffeequiv_common (eq2)));
+      ffebad_finish ();
+      return NULL;
+    }
+
+  /* Make eq1 the new, merged object (arbitrarily). */
+
+  if (ffeequiv_common (eq1) == NULL)
+    ffeequiv_set_common (eq1, ffeequiv_common (eq2));
+
+  /* If the victim object has any init'ed entities, so does the new object. */
+
+  if (eq2->is_init)
+    eq1->is_init = TRUE;
+
+#if FFEGLOBAL_ENABLED
+  if (eq1->is_init && (ffeequiv_common (eq1) != NULL))
+    ffeglobal_init_common (ffeequiv_common (eq1), t);
+#endif
+
+  /* If the victim object has any SAVEd entities, then the new object has
+     some. */
+
+  if (ffeequiv_is_save (eq2))
+    ffeequiv_update_save (eq1);
+
+  /* If the victim object has any init'd entities, then the new object has
+     some. */
+
+  if (ffeequiv_is_init (eq2))
+    ffeequiv_update_init (eq1);
+
+  /* Adjust all the symbols in the list of lists of equivalences for the
+     victim equivalence object so they point to the new merged object
+     instead. */
+
+  for (list = ffeequiv_list (eq2); list != NULL; list = ffebld_trail (list))
+    {
+      for (eqs = ffebld_head (list); eqs != NULL; eqs = ffebld_trail (eqs))
+	{
+	  symbol = ffeequiv_symbol (ffebld_head (eqs));
+	  if (ffesymbol_equiv (symbol) == eq2)
+	    ffesymbol_set_equiv (symbol, eq1);
+	  else
+	    assert (ffesymbol_equiv (symbol) == eq1);	/* Can see a sym > once. */
+	}
+
+      /* For convenience, remember where the last ITEM in the outer list is. */
+
+      if (ffebld_trail (list) == NULL)
+	{
+	  last = list;
+	  break;
+	}
+    }
+
+  /* Append the list of lists in the new, merged object to the list of lists
+     in the victim object, then use the new combined list in the new merged
+     object. */
+
+  ffebld_set_trail (last, ffeequiv_list (eq1));
+  ffeequiv_set_list (eq1, ffeequiv_list (eq2));
+
+  /* Unlink and kill the victim object. */
+
+  ffeequiv_kill (eq2);
+
+  return eq1;			/* Return the new merged object. */
+}
+
+/* ffeequiv_new -- Create new equivalence object, put in list
+
+   ffeequiv eq;
+   eq = ffeequiv_new();
+
+   Creates a new equivalence object and adds it to the list of equivalence
+   objects.  */
+
+ffeequiv
+ffeequiv_new (void)
+{
+  ffeequiv eq;
+
+  eq = malloc_new_ks (ffe_pool_program_unit (), "ffeequiv", sizeof (*eq));
+  eq->next = (ffeequiv) &ffeequiv_list_.first;
+  eq->previous = ffeequiv_list_.last;
+  ffeequiv_set_common (eq, NULL);	/* No COMMON area yet. */
+  ffeequiv_set_list (eq, NULL);	/* No list of lists of equivalences yet. */
+  ffeequiv_set_is_save (eq, FALSE);
+  ffeequiv_set_is_init (eq, FALSE);
+  eq->next->previous = eq;
+  eq->previous->next = eq;
+
+  return eq;
+}
+
+/* ffeequiv_symbol -- Return symbol for equivalence expression
+
+   ffesymbol symbol;
+   ffebld expr;
+   symbol = ffeequiv_symbol(expr);
+
+   Finds the terminal SYMTER in an equivalence expression and returns the
+   ffesymbol for it.  */
+
+ffesymbol
+ffeequiv_symbol (ffebld expr)
+{
+  assert (expr != NULL);
+
+again:				/* :::::::::::::::::::: */
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opARRAYREF:
+    case FFEBLD_opSUBSTR:
+      expr = ffebld_left (expr);
+      goto again;		/* :::::::::::::::::::: */
+
+    case FFEBLD_opSYMTER:
+      return ffebld_symter (expr);
+
+    case FFEBLD_opANY:
+      return NULL;
+
+    default:
+      assert ("bad eq expr" == NULL);
+      return NULL;
+    }
+}
+
+/* ffeequiv_update_init -- Update the INIT flag for the area to TRUE
+
+   ffeequiv eq;
+   ffeequiv_update_init(eq);
+
+   If the INIT flag for the <eq> object is already set, return.	 Else,
+   set it TRUE and call ffe*_update_init for all objects contained in
+   this one.  */
+
+void
+ffeequiv_update_init (ffeequiv eq)
+{
+  ffebld list;			/* Current list in list of lists. */
+  ffebld item;			/* Current item in current list. */
+  ffebld expr;			/* Expression in head of current item. */
+
+  if (eq->is_init)
+    return;
+
+  eq->is_init = TRUE;
+
+  if ((eq->common != NULL)
+      && !ffesymbol_is_init (eq->common))
+    ffesymbol_update_init (eq->common);	/* Shouldn't be needed. */
+
+  for (list = eq->list; list != NULL; list = ffebld_trail (list))
+    {
+      for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
+	{
+	  expr = ffebld_head (item);
+
+	again:			/* :::::::::::::::::::: */
+
+	  switch (ffebld_op (expr))
+	    {
+	    case FFEBLD_opANY:
+	      break;
+
+	    case FFEBLD_opSYMTER:
+	      if (!ffesymbol_is_init (ffebld_symter (expr)))
+		ffesymbol_update_init (ffebld_symter (expr));
+	      break;
+
+	    case FFEBLD_opARRAYREF:
+	      expr = ffebld_left (expr);
+	      goto again;	/* :::::::::::::::::::: */
+
+	    case FFEBLD_opSUBSTR:
+	      expr = ffebld_left (expr);
+	      goto again;	/* :::::::::::::::::::: */
+
+	    default:
+	      assert ("bad op for ffeequiv_update_init" == NULL);
+	      break;
+	    }
+	}
+    }
+}
+
+/* ffeequiv_update_save -- Update the SAVE flag for the area to TRUE
+
+   ffeequiv eq;
+   ffeequiv_update_save(eq);
+
+   If the SAVE flag for the <eq> object is already set, return.	 Else,
+   set it TRUE and call ffe*_update_save for all objects contained in
+   this one.  */
+
+void
+ffeequiv_update_save (ffeequiv eq)
+{
+  ffebld list;			/* Current list in list of lists. */
+  ffebld item;			/* Current item in current list. */
+  ffebld expr;			/* Expression in head of current item. */
+
+  if (eq->is_save)
+    return;
+
+  eq->is_save = TRUE;
+
+  if ((eq->common != NULL)
+      && !ffesymbol_is_save (eq->common))
+    ffesymbol_update_save (eq->common);	/* Shouldn't be needed. */
+
+  for (list = eq->list; list != NULL; list = ffebld_trail (list))
+    {
+      for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
+	{
+	  expr = ffebld_head (item);
+
+	again:			/* :::::::::::::::::::: */
+
+	  switch (ffebld_op (expr))
+	    {
+	    case FFEBLD_opANY:
+	      break;
+
+	    case FFEBLD_opSYMTER:
+	      if (!ffesymbol_is_save (ffebld_symter (expr)))
+		ffesymbol_update_save (ffebld_symter (expr));
+	      break;
+
+	    case FFEBLD_opARRAYREF:
+	      expr = ffebld_left (expr);
+	      goto again;	/* :::::::::::::::::::: */
+
+	    case FFEBLD_opSUBSTR:
+	      expr = ffebld_left (expr);
+	      goto again;	/* :::::::::::::::::::: */
+
+	    default:
+	      assert ("bad op for ffeequiv_update_save" == NULL);
+	      break;
+	    }
+	}
+    }
+}
diff --git a/gcc/f/equiv.h b/gcc/f/equiv.h
new file mode 100644
index 00000000000..59abfc875ca
--- /dev/null
+++ b/gcc/f/equiv.h
@@ -0,0 +1,100 @@
+/* equiv.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      equiv.c
+
+   Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef GCC_F_EQUIV_H
+#define GCC_F_EQUIV_H
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+typedef struct _ffeequiv_ *ffeequiv;
+
+/* Include files needed by this one. */
+
+#include "bld.h"
+#include "lex.h"
+#include "storag.h"
+#include "symbol.h"
+
+/* Structure definitions. */
+
+struct _ffeequiv_
+  {
+    ffeequiv next;
+    ffeequiv previous;
+    ffesymbol common;		/* Common area for this equiv, if any. */
+    ffebld list;		/* List of lists of equiv exprs. */
+    bool is_save;		/* Any SAVEd members? */
+    bool is_init;		/* Any initialized members? */
+  };
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+void ffeequiv_add (ffeequiv eq, ffebld list, ffelexToken t);
+void ffeequiv_exec_transition (void);
+void ffeequiv_init_2 (void);
+void ffeequiv_kill (ffeequiv victim);
+bool ffeequiv_layout_cblock (ffestorag st);
+ffeequiv ffeequiv_merge (ffeequiv eq1, ffeequiv eq2, ffelexToken t);
+ffeequiv ffeequiv_new (void);
+ffesymbol ffeequiv_symbol (ffebld expr);
+void ffeequiv_update_init (ffeequiv eq);
+void ffeequiv_update_save (ffeequiv eq);
+
+/* Define macros. */
+
+#define ffeequiv_common(e) ((e)->common)
+#define ffeequiv_init_0()
+#define ffeequiv_init_1()
+#define ffeequiv_init_3()
+#define ffeequiv_init_4()
+#define ffeequiv_is_init(e) ((e)->is_init)
+#define ffeequiv_is_save(e) ((e)->is_save)
+#define ffeequiv_list(e) ((e)->list)
+#define ffeequiv_next(e) ((e)->next)
+#define ffeequiv_previous(e) ((e)->previous)
+#define ffeequiv_set_common(e,c) ((e)->common = (c))
+#define ffeequiv_set_init(e,i) ((e)->init = (i))
+#define ffeequiv_set_is_init(e,in) ((e)->is_init = (in))
+#define ffeequiv_set_is_save(e,sa) ((e)->is_save = (sa))
+#define ffeequiv_set_list(e,l) ((e)->list = (l))
+#define ffeequiv_terminate_0()
+#define ffeequiv_terminate_1()
+#define ffeequiv_terminate_2()
+#define ffeequiv_terminate_3()
+#define ffeequiv_terminate_4()
+
+/* End of #include file. */
+
+#endif /* ! GCC_F_EQUIV_H */
diff --git a/gcc/f/expr.c b/gcc/f/expr.c
new file mode 100644
index 00000000000..ef7661dc3ec
--- /dev/null
+++ b/gcc/f/expr.c
@@ -0,0 +1,18571 @@
+/* expr.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1996, 1997, 1998, 2001, 2002, 2003
+   Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Related Modules:
+      None.
+
+   Description:
+      Handles syntactic and semantic analysis of Fortran expressions.
+
+   Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "expr.h"
+#include "bad.h"
+#include "bld.h"
+#include "com.h"
+#include "global.h"
+#include "implic.h"
+#include "intrin.h"
+#include "info.h"
+#include "lex.h"
+#include "malloc.h"
+#include "src.h"
+#include "st.h"
+#include "symbol.h"
+#include "str.h"
+#include "target.h"
+#include "where.h"
+#include "real.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+  {
+    FFEEXPR_exprtypeUNKNOWN_,
+    FFEEXPR_exprtypeOPERAND_,
+    FFEEXPR_exprtypeUNARY_,
+    FFEEXPR_exprtypeBINARY_,
+    FFEEXPR_exprtype_
+  } ffeexprExprtype_;
+
+typedef enum
+  {
+    FFEEXPR_operatorPOWER_,
+    FFEEXPR_operatorMULTIPLY_,
+    FFEEXPR_operatorDIVIDE_,
+    FFEEXPR_operatorADD_,
+    FFEEXPR_operatorSUBTRACT_,
+    FFEEXPR_operatorCONCATENATE_,
+    FFEEXPR_operatorLT_,
+    FFEEXPR_operatorLE_,
+    FFEEXPR_operatorEQ_,
+    FFEEXPR_operatorNE_,
+    FFEEXPR_operatorGT_,
+    FFEEXPR_operatorGE_,
+    FFEEXPR_operatorNOT_,
+    FFEEXPR_operatorAND_,
+    FFEEXPR_operatorOR_,
+    FFEEXPR_operatorXOR_,
+    FFEEXPR_operatorEQV_,
+    FFEEXPR_operatorNEQV_,
+    FFEEXPR_operator_
+  } ffeexprOperator_;
+
+typedef enum
+  {
+    FFEEXPR_operatorprecedenceHIGHEST_ = 1,
+    FFEEXPR_operatorprecedencePOWER_ = 1,
+    FFEEXPR_operatorprecedenceMULTIPLY_ = 2,
+    FFEEXPR_operatorprecedenceDIVIDE_ = 2,
+    FFEEXPR_operatorprecedenceADD_ = 3,
+    FFEEXPR_operatorprecedenceSUBTRACT_ = 3,
+    FFEEXPR_operatorprecedenceLOWARITH_ = 3,
+    FFEEXPR_operatorprecedenceCONCATENATE_ = 3,
+    FFEEXPR_operatorprecedenceLT_ = 4,
+    FFEEXPR_operatorprecedenceLE_ = 4,
+    FFEEXPR_operatorprecedenceEQ_ = 4,
+    FFEEXPR_operatorprecedenceNE_ = 4,
+    FFEEXPR_operatorprecedenceGT_ = 4,
+    FFEEXPR_operatorprecedenceGE_ = 4,
+    FFEEXPR_operatorprecedenceNOT_ = 5,
+    FFEEXPR_operatorprecedenceAND_ = 6,
+    FFEEXPR_operatorprecedenceOR_ = 7,
+    FFEEXPR_operatorprecedenceXOR_ = 8,
+    FFEEXPR_operatorprecedenceEQV_ = 8,
+    FFEEXPR_operatorprecedenceNEQV_ = 8,
+    FFEEXPR_operatorprecedenceLOWEST_ = 8,
+    FFEEXPR_operatorprecedence_
+  } ffeexprOperatorPrecedence_;
+
+#define FFEEXPR_operatorassociativityL2R_ TRUE
+#define FFEEXPR_operatorassociativityR2L_ FALSE
+#define FFEEXPR_operatorassociativityPOWER_ FFEEXPR_operatorassociativityR2L_
+#define FFEEXPR_operatorassociativityMULTIPLY_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityDIVIDE_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityADD_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativitySUBTRACT_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityCONCATENATE_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityLT_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityLE_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityEQ_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityNE_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityGT_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityGE_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityNOT_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityAND_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityOR_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityXOR_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityEQV_ FFEEXPR_operatorassociativityL2R_
+#define FFEEXPR_operatorassociativityNEQV_ FFEEXPR_operatorassociativityL2R_
+
+typedef enum
+  {
+    FFEEXPR_parentypeFUNCTION_,
+    FFEEXPR_parentypeSUBROUTINE_,
+    FFEEXPR_parentypeARRAY_,
+    FFEEXPR_parentypeSUBSTRING_,
+    FFEEXPR_parentypeFUNSUBSTR_,/* Ambig: check for colon after first expr. */
+    FFEEXPR_parentypeEQUIVALENCE_,	/* Ambig: ARRAY_ or SUBSTRING_. */
+    FFEEXPR_parentypeANY_,	/* Allow basically anything. */
+    FFEEXPR_parentype_
+  } ffeexprParenType_;
+
+typedef enum
+  {
+    FFEEXPR_percentNONE_,
+    FFEEXPR_percentLOC_,
+    FFEEXPR_percentVAL_,
+    FFEEXPR_percentREF_,
+    FFEEXPR_percentDESCR_,
+    FFEEXPR_percent_
+  } ffeexprPercent_;
+
+/* Internal typedefs. */
+
+typedef struct _ffeexpr_expr_ *ffeexprExpr_;
+typedef bool ffeexprOperatorAssociativity_;
+typedef struct _ffeexpr_stack_ *ffeexprStack_;
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffeexpr_expr_
+  {
+    ffeexprExpr_ previous;
+    ffelexToken token;
+    ffeexprExprtype_ type;
+    union
+      {
+	struct
+	  {
+	    ffeexprOperator_ op;
+	    ffeexprOperatorPrecedence_ prec;
+	    ffeexprOperatorAssociativity_ as;
+	  }
+	operator;
+	ffebld operand;
+      }
+    u;
+  };
+
+struct _ffeexpr_stack_
+  {
+    ffeexprStack_ previous;
+    mallocPool pool;
+    ffeexprContext context;
+    ffeexprCallback callback;
+    ffelexToken first_token;
+    ffeexprExpr_ exprstack;
+    ffelexToken tokens[10];	/* Used in certain cases, like (unary)
+				   open-paren. */
+    ffebld expr;		/* For first of
+				   complex/implied-do/substring/array-elements
+				   / actual-args expression. */
+    ffebld bound_list;		/* For tracking dimension bounds list of
+				   array. */
+    ffebldListBottom bottom;	/* For building lists. */
+    ffeinfoRank rank;		/* For elements in an array reference. */
+    bool constant;		/* TRUE while elements seen so far are
+				   constants. */
+    bool immediate;		/* TRUE while elements seen so far are
+				   immediate/constants. */
+    ffebld next_dummy;		/* Next SFUNC dummy arg in arg list. */
+    ffebldListLength num_args;	/* Number of dummy args expected in arg list. */
+    bool is_rhs;		/* TRUE if rhs context, FALSE otherwise. */
+    ffeexprPercent_ percent;	/* Current %FOO keyword. */
+  };
+
+struct _ffeexpr_find_
+  {
+    ffelexToken t;
+    ffelexHandler after;
+    int level;
+  };
+
+/* Static objects accessed by functions in this module. */
+
+static ffeexprStack_ ffeexpr_stack_;	/* Expression stack for semantic. */
+static ffelexToken ffeexpr_tokens_[10];	/* Scratchpad tokens for syntactic. */
+static ffestrOther ffeexpr_current_dotdot_;	/* Current .FOO. keyword. */
+static long ffeexpr_hollerith_count_;	/* ffeexpr_token_number_ and caller. */
+static int ffeexpr_level_;	/* Level of DATA implied-DO construct. */
+static bool ffeexpr_is_substr_ok_;	/* If OPEN_PAREN as binary "op" ok. */
+static struct _ffeexpr_find_ ffeexpr_find_;
+
+/* Static functions (internal). */
+
+static ffelexHandler ffeexpr_cb_close_paren_ (ffelexToken ft, ffebld expr,
+					      ffelexToken t);
+static ffelexHandler ffeexpr_cb_close_paren_ambig_ (ffelexToken ft,
+						    ffebld expr,
+						    ffelexToken t);
+static ffelexHandler ffeexpr_cb_close_paren_ambig_1_ (ffelexToken t);
+static ffelexHandler ffeexpr_cb_close_paren_c_ (ffelexToken ft,
+						ffebld expr, ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_c_ (ffelexToken ft, ffebld expr,
+					  ffelexToken t);
+static ffelexHandler ffeexpr_cb_close_paren_ci_ (ffelexToken ft,
+						 ffebld expr, ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_ci_ (ffelexToken ft, ffebld expr,
+					   ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_i_ (ffelexToken ft, ffebld expr,
+					  ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_i_1_ (ffelexToken ft, ffebld expr,
+					    ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_i_2_ (ffelexToken ft, ffebld expr,
+					    ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_i_3_ (ffelexToken ft, ffebld expr,
+					    ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_i_4_ (ffelexToken ft, ffebld expr,
+					    ffelexToken t);
+static ffelexHandler ffeexpr_cb_comma_i_5_ (ffelexToken t);
+static ffelexHandler ffeexpr_cb_end_loc_ (ffelexToken ft, ffebld expr,
+					  ffelexToken t);
+static ffelexHandler ffeexpr_cb_end_notloc_ (ffelexToken ft, ffebld expr,
+					     ffelexToken t);
+static ffelexHandler ffeexpr_cb_end_notloc_1_ (ffelexToken t);
+static ffesymbol ffeexpr_check_impctrl_ (ffesymbol s);
+static void ffeexpr_check_impdo_ (ffebld list, ffelexToken list_t,
+				  ffebld dovar, ffelexToken dovar_t);
+static void ffeexpr_update_impdo_ (ffebld expr, ffebld dovar);
+static void ffeexpr_update_impdo_sym_ (ffebld expr, ffesymbol dovar);
+static ffeexprContext ffeexpr_context_outer_ (ffeexprStack_ s);
+static ffeexprExpr_ ffeexpr_expr_new_ (void);
+static void ffeexpr_fulfill_call_ (ffebld *expr, ffelexToken t);
+static bool ffeexpr_isdigits_ (const char *p);
+static ffelexHandler ffeexpr_token_first_lhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_lhs_1_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_rhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_rhs_1_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_rhs_2_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_rhs_3_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_rhs_4_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_rhs_5_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_first_rhs_6_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_namelist_ (ffelexToken t);
+static void ffeexpr_expr_kill_ (ffeexprExpr_ e);
+static void ffeexpr_exprstack_push_ (ffeexprExpr_ e);
+static void ffeexpr_exprstack_push_binary_ (ffeexprExpr_ e);
+static void ffeexpr_exprstack_push_operand_ (ffeexprExpr_ e);
+static void ffeexpr_exprstack_push_unary_ (ffeexprExpr_ e);
+static void ffeexpr_reduce_ (void);
+static ffebld ffeexpr_reduced_bool1_ (ffebld reduced, ffeexprExpr_ op,
+				      ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_bool2_ (ffebld reduced, ffeexprExpr_ l,
+				      ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_concatenate_ (ffebld reduced, ffeexprExpr_ l,
+					    ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_eqop2_ (ffebld reduced, ffeexprExpr_ l,
+				      ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_math1_ (ffebld reduced, ffeexprExpr_ op,
+				      ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_math2_ (ffebld reduced, ffeexprExpr_ l,
+				      ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_power_ (ffebld reduced, ffeexprExpr_ l,
+				      ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_relop2_ (ffebld reduced, ffeexprExpr_ l,
+				       ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_ugly1_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_ugly1log_ (ffebld reduced, ffeexprExpr_ op,
+					 ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_ugly2_ (ffebld reduced, ffeexprExpr_ l,
+				      ffeexprExpr_ op, ffeexprExpr_ r);
+static ffebld ffeexpr_reduced_ugly2log_ (ffebld reduced, ffeexprExpr_ l,
+					 ffeexprExpr_ op, ffeexprExpr_ r,
+					 bool *);
+static ffelexHandler ffeexpr_find_close_paren_ (ffelexToken t,
+						ffelexHandler after);
+static ffelexHandler ffeexpr_nil_finished_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_rhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_end_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_swallow_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_real_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_real_exponent_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_real_exp_sign_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_number_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_number_exponent_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_number_exp_sign_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_number_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_number_per_exp_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_number_real_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_num_per_exp_sign_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_number_real_exp_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_num_real_exp_sn_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_binary_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_binary_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_binary_end_per_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_binary_sw_per_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_quote_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_apostrophe_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_apos_char_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_name_rhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_name_apos_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_name_apos_name_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_percent_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_percent_name_ (ffelexToken t);
+static ffelexHandler ffeexpr_nil_substrp_ (ffelexToken t);
+static ffelexHandler ffeexpr_finished_ (ffelexToken t);
+static ffebld ffeexpr_finished_ambig_ (ffelexToken t, ffebld expr);
+static ffelexHandler ffeexpr_token_lhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_rhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_binary_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_end_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_swallow_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_real_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_real_exponent_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_real_exp_sign_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_number_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_number_exponent_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_number_exp_sign_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_number_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_number_per_exp_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_number_real_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_num_per_exp_sign_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_number_real_exp_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_num_real_exp_sn_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_binary_period_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_binary_end_per_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_binary_sw_per_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_quote_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_apostrophe_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_apos_char_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_name_lhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_name_arg_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_name_rhs_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_name_apos_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_name_apos_name_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_percent_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_percent_name_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_arguments_ (ffelexToken ft, ffebld expr,
+					       ffelexToken t);
+static ffelexHandler ffeexpr_token_elements_ (ffelexToken ft, ffebld expr,
+					      ffelexToken t);
+static ffelexHandler ffeexpr_token_equivalence_ (ffelexToken ft, ffebld expr,
+						 ffelexToken t);
+static ffelexHandler ffeexpr_token_substring_ (ffelexToken ft, ffebld expr,
+					       ffelexToken t);
+static ffelexHandler ffeexpr_token_substring_1_ (ffelexToken ft, ffebld expr,
+						 ffelexToken t);
+static ffelexHandler ffeexpr_token_substrp_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_intrincheck_ (ffelexToken t);
+static ffelexHandler ffeexpr_token_funsubstr_ (ffelexToken ft, ffebld expr,
+					       ffelexToken t);
+static ffelexHandler ffeexpr_token_anything_ (ffelexToken ft, ffebld expr,
+					      ffelexToken t);
+static void ffeexpr_make_float_const_ (char exp_letter, ffelexToken integer,
+	    ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
+		    ffelexToken exponent_sign, ffelexToken exponent_digits);
+static ffesymbol ffeexpr_declare_unadorned_ (ffelexToken t, bool maybe_intrin);
+static ffesymbol ffeexpr_sym_impdoitem_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_lhs_call_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_lhs_data_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_lhs_equivalence_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_lhs_extfunc_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_lhs_impdoctrl_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_lhs_parameter_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_rhs_actualarg_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_rhs_dimlist_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_sym_rhs_let_ (ffesymbol s, ffelexToken t);
+static ffesymbol ffeexpr_declare_parenthesized_ (ffelexToken t,
+						 bool maybe_intrin,
+					     ffeexprParenType_ *paren_type);
+static ffesymbol ffeexpr_paren_rhs_let_ (ffesymbol s, ffelexToken t);
+
+/* Internal macros. */
+
+#define ffeexpr_paren_lhs_let_(s,t) ffeexpr_sym_rhs_let_(s,t)
+#define ffeexpr_sym_lhs_let_(s,t) ffeexpr_sym_rhs_let_(s,t)
+
+/* ffeexpr_collapse_convert -- Collapse convert expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_convert(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_convert (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebldConstantUnion u;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  ffetargetCharacterSize sz;
+  ffetargetCharacterSize sz2;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      sz = FFETARGET_charactersizeNONE;
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error = ffetarget_convert_integer1_integer2
+		    (ffebld_cu_ptr_integer1 (u),
+		     ffebld_constant_integer2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error = ffetarget_convert_integer1_integer3
+		    (ffebld_cu_ptr_integer1 (u),
+		     ffebld_constant_integer3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error = ffetarget_convert_integer1_integer4
+		    (ffebld_cu_ptr_integer1 (u),
+		     ffebld_constant_integer4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER1/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeREAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okREAL1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_integer1_real1
+		    (ffebld_cu_ptr_integer1 (u),
+		     ffebld_constant_real1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_integer1_real2
+		    (ffebld_cu_ptr_integer1 (u),
+		     ffebld_constant_real2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_integer1_real3
+		    (ffebld_cu_ptr_integer1 (u),
+		     ffebld_constant_real3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER1/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCOMPLEX:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okCOMPLEX1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_integer1_complex1
+		    (ffebld_cu_ptr_integer1 (u),
+		     ffebld_constant_complex1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_integer1_complex2
+		    (ffebld_cu_ptr_integer1 (u),
+		     ffebld_constant_complex2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_integer1_complex3
+		    (ffebld_cu_ptr_integer1 (u),
+		     ffebld_constant_complex3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER1/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeLOGICAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okLOGICAL1
+		case FFEINFO_kindtypeLOGICAL1:
+		  error = ffetarget_convert_integer1_logical1
+		    (ffebld_cu_ptr_integer1 (u),
+		     ffebld_constant_logical1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+		case FFEINFO_kindtypeLOGICAL2:
+		  error = ffetarget_convert_integer1_logical2
+		    (ffebld_cu_ptr_integer1 (u),
+		     ffebld_constant_logical2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+		case FFEINFO_kindtypeLOGICAL3:
+		  error = ffetarget_convert_integer1_logical3
+		    (ffebld_cu_ptr_integer1 (u),
+		     ffebld_constant_logical3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+		case FFEINFO_kindtypeLOGICAL4:
+		  error = ffetarget_convert_integer1_logical4
+		    (ffebld_cu_ptr_integer1 (u),
+		     ffebld_constant_logical4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER1/LOGICAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_integer1_character1
+		(ffebld_cu_ptr_integer1 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_integer1_hollerith
+		(ffebld_cu_ptr_integer1 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_integer1_typeless
+		(ffebld_cu_ptr_integer1 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("INTEGER1 bad type" == NULL);
+	      break;
+	    }
+
+	  /* If conversion operation is not implemented, return original expr.  */
+	  if (error == FFEBAD_NOCANDO)
+	    return expr;
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_integer1_val
+	     (ffebld_cu_val_integer1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error = ffetarget_convert_integer2_integer1
+		    (ffebld_cu_ptr_integer2 (u),
+		     ffebld_constant_integer1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error = ffetarget_convert_integer2_integer3
+		    (ffebld_cu_ptr_integer2 (u),
+		     ffebld_constant_integer3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error = ffetarget_convert_integer2_integer4
+		    (ffebld_cu_ptr_integer2 (u),
+		     ffebld_constant_integer4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER2/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeREAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okREAL1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_integer2_real1
+		    (ffebld_cu_ptr_integer2 (u),
+		     ffebld_constant_real1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_integer2_real2
+		    (ffebld_cu_ptr_integer2 (u),
+		     ffebld_constant_real2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_integer2_real3
+		    (ffebld_cu_ptr_integer2 (u),
+		     ffebld_constant_real3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER2/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCOMPLEX:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okCOMPLEX1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_integer2_complex1
+		    (ffebld_cu_ptr_integer2 (u),
+		     ffebld_constant_complex1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_integer2_complex2
+		    (ffebld_cu_ptr_integer2 (u),
+		     ffebld_constant_complex2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_integer2_complex3
+		    (ffebld_cu_ptr_integer2 (u),
+		     ffebld_constant_complex3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER2/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeLOGICAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okLOGICAL1
+		case FFEINFO_kindtypeLOGICAL1:
+		  error = ffetarget_convert_integer2_logical1
+		    (ffebld_cu_ptr_integer2 (u),
+		     ffebld_constant_logical1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+		case FFEINFO_kindtypeLOGICAL2:
+		  error = ffetarget_convert_integer2_logical2
+		    (ffebld_cu_ptr_integer2 (u),
+		     ffebld_constant_logical2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+		case FFEINFO_kindtypeLOGICAL3:
+		  error = ffetarget_convert_integer2_logical3
+		    (ffebld_cu_ptr_integer2 (u),
+		     ffebld_constant_logical3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+		case FFEINFO_kindtypeLOGICAL4:
+		  error = ffetarget_convert_integer2_logical4
+		    (ffebld_cu_ptr_integer2 (u),
+		     ffebld_constant_logical4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER2/LOGICAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_integer2_character1
+		(ffebld_cu_ptr_integer2 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_integer2_hollerith
+		(ffebld_cu_ptr_integer2 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_integer2_typeless
+		(ffebld_cu_ptr_integer2 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("INTEGER2 bad type" == NULL);
+	      break;
+	    }
+
+	  /* If conversion operation is not implemented, return original expr.  */
+	  if (error == FFEBAD_NOCANDO)
+	    return expr;
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_integer2_val
+	     (ffebld_cu_val_integer2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error = ffetarget_convert_integer3_integer1
+		    (ffebld_cu_ptr_integer3 (u),
+		     ffebld_constant_integer1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error = ffetarget_convert_integer3_integer2
+		    (ffebld_cu_ptr_integer3 (u),
+		     ffebld_constant_integer2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error = ffetarget_convert_integer3_integer4
+		    (ffebld_cu_ptr_integer3 (u),
+		     ffebld_constant_integer4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER3/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeREAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okREAL1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_integer3_real1
+		    (ffebld_cu_ptr_integer3 (u),
+		     ffebld_constant_real1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_integer3_real2
+		    (ffebld_cu_ptr_integer3 (u),
+		     ffebld_constant_real2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_integer3_real3
+		    (ffebld_cu_ptr_integer3 (u),
+		     ffebld_constant_real3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER3/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCOMPLEX:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okCOMPLEX1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_integer3_complex1
+		    (ffebld_cu_ptr_integer3 (u),
+		     ffebld_constant_complex1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_integer3_complex2
+		    (ffebld_cu_ptr_integer3 (u),
+		     ffebld_constant_complex2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_integer3_complex3
+		    (ffebld_cu_ptr_integer3 (u),
+		     ffebld_constant_complex3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER3/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeLOGICAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okLOGICAL1
+		case FFEINFO_kindtypeLOGICAL1:
+		  error = ffetarget_convert_integer3_logical1
+		    (ffebld_cu_ptr_integer3 (u),
+		     ffebld_constant_logical1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+		case FFEINFO_kindtypeLOGICAL2:
+		  error = ffetarget_convert_integer3_logical2
+		    (ffebld_cu_ptr_integer3 (u),
+		     ffebld_constant_logical2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+		case FFEINFO_kindtypeLOGICAL3:
+		  error = ffetarget_convert_integer3_logical3
+		    (ffebld_cu_ptr_integer3 (u),
+		     ffebld_constant_logical3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+		case FFEINFO_kindtypeLOGICAL4:
+		  error = ffetarget_convert_integer3_logical4
+		    (ffebld_cu_ptr_integer3 (u),
+		     ffebld_constant_logical4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER3/LOGICAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_integer3_character1
+		(ffebld_cu_ptr_integer3 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_integer3_hollerith
+		(ffebld_cu_ptr_integer3 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_integer3_typeless
+		(ffebld_cu_ptr_integer3 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("INTEGER3 bad type" == NULL);
+	      break;
+	    }
+
+	  /* If conversion operation is not implemented, return original expr.  */
+	  if (error == FFEBAD_NOCANDO)
+	    return expr;
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_integer3_val
+	     (ffebld_cu_val_integer3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error = ffetarget_convert_integer4_integer1
+		    (ffebld_cu_ptr_integer4 (u),
+		     ffebld_constant_integer1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error = ffetarget_convert_integer4_integer2
+		    (ffebld_cu_ptr_integer4 (u),
+		     ffebld_constant_integer2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error = ffetarget_convert_integer4_integer3
+		    (ffebld_cu_ptr_integer4 (u),
+		     ffebld_constant_integer3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER4/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeREAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okREAL1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_integer4_real1
+		    (ffebld_cu_ptr_integer4 (u),
+		     ffebld_constant_real1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_integer4_real2
+		    (ffebld_cu_ptr_integer4 (u),
+		     ffebld_constant_real2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_integer4_real3
+		    (ffebld_cu_ptr_integer4 (u),
+		     ffebld_constant_real3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER4/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCOMPLEX:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okCOMPLEX1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_integer4_complex1
+		    (ffebld_cu_ptr_integer4 (u),
+		     ffebld_constant_complex1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_integer4_complex2
+		    (ffebld_cu_ptr_integer4 (u),
+		     ffebld_constant_complex2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_integer4_complex3
+		    (ffebld_cu_ptr_integer4 (u),
+		     ffebld_constant_complex3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER3/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeLOGICAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okLOGICAL1
+		case FFEINFO_kindtypeLOGICAL1:
+		  error = ffetarget_convert_integer4_logical1
+		    (ffebld_cu_ptr_integer4 (u),
+		     ffebld_constant_logical1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+		case FFEINFO_kindtypeLOGICAL2:
+		  error = ffetarget_convert_integer4_logical2
+		    (ffebld_cu_ptr_integer4 (u),
+		     ffebld_constant_logical2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+		case FFEINFO_kindtypeLOGICAL3:
+		  error = ffetarget_convert_integer4_logical3
+		    (ffebld_cu_ptr_integer4 (u),
+		     ffebld_constant_logical3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+		case FFEINFO_kindtypeLOGICAL4:
+		  error = ffetarget_convert_integer4_logical4
+		    (ffebld_cu_ptr_integer4 (u),
+		     ffebld_constant_logical4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("INTEGER4/LOGICAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_integer4_character1
+		(ffebld_cu_ptr_integer4 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_integer4_hollerith
+		(ffebld_cu_ptr_integer4 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_integer4_typeless
+		(ffebld_cu_ptr_integer4 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("INTEGER4 bad type" == NULL);
+	      break;
+	    }
+
+	  /* If conversion operation is not implemented, return original expr.  */
+	  if (error == FFEBAD_NOCANDO)
+	    return expr;
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_integer4_val
+	     (ffebld_cu_val_integer4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      sz = FFETARGET_charactersizeNONE;
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeLOGICAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okLOGICAL2
+		case FFEINFO_kindtypeLOGICAL2:
+		  error = ffetarget_convert_logical1_logical2
+		    (ffebld_cu_ptr_logical1 (u),
+		     ffebld_constant_logical2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+		case FFEINFO_kindtypeLOGICAL3:
+		  error = ffetarget_convert_logical1_logical3
+		    (ffebld_cu_ptr_logical1 (u),
+		     ffebld_constant_logical3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+		case FFEINFO_kindtypeLOGICAL4:
+		  error = ffetarget_convert_logical1_logical4
+		    (ffebld_cu_ptr_logical1 (u),
+		     ffebld_constant_logical4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("LOGICAL1/LOGICAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error = ffetarget_convert_logical1_integer1
+		    (ffebld_cu_ptr_logical1 (u),
+		     ffebld_constant_integer1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error = ffetarget_convert_logical1_integer2
+		    (ffebld_cu_ptr_logical1 (u),
+		     ffebld_constant_integer2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error = ffetarget_convert_logical1_integer3
+		    (ffebld_cu_ptr_logical1 (u),
+		     ffebld_constant_integer3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error = ffetarget_convert_logical1_integer4
+		    (ffebld_cu_ptr_logical1 (u),
+		     ffebld_constant_integer4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("LOGICAL1/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_logical1_character1
+		(ffebld_cu_ptr_logical1 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_logical1_hollerith
+		(ffebld_cu_ptr_logical1 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_logical1_typeless
+		(ffebld_cu_ptr_logical1 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("LOGICAL1 bad type" == NULL);
+	      break;
+	    }
+
+	  /* If conversion operation is not implemented, return original expr.  */
+	  if (error == FFEBAD_NOCANDO)
+	    return expr;
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logical1_val
+	     (ffebld_cu_val_logical1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeLOGICAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okLOGICAL1
+		case FFEINFO_kindtypeLOGICAL1:
+		  error = ffetarget_convert_logical2_logical1
+		    (ffebld_cu_ptr_logical2 (u),
+		     ffebld_constant_logical1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+		case FFEINFO_kindtypeLOGICAL3:
+		  error = ffetarget_convert_logical2_logical3
+		    (ffebld_cu_ptr_logical2 (u),
+		     ffebld_constant_logical3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+		case FFEINFO_kindtypeLOGICAL4:
+		  error = ffetarget_convert_logical2_logical4
+		    (ffebld_cu_ptr_logical2 (u),
+		     ffebld_constant_logical4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("LOGICAL2/LOGICAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error = ffetarget_convert_logical2_integer1
+		    (ffebld_cu_ptr_logical2 (u),
+		     ffebld_constant_integer1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error = ffetarget_convert_logical2_integer2
+		    (ffebld_cu_ptr_logical2 (u),
+		     ffebld_constant_integer2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error = ffetarget_convert_logical2_integer3
+		    (ffebld_cu_ptr_logical2 (u),
+		     ffebld_constant_integer3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error = ffetarget_convert_logical2_integer4
+		    (ffebld_cu_ptr_logical2 (u),
+		     ffebld_constant_integer4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("LOGICAL2/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_logical2_character1
+		(ffebld_cu_ptr_logical2 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_logical2_hollerith
+		(ffebld_cu_ptr_logical2 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_logical2_typeless
+		(ffebld_cu_ptr_logical2 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("LOGICAL2 bad type" == NULL);
+	      break;
+	    }
+
+	  /* If conversion operation is not implemented, return original expr.  */
+	  if (error == FFEBAD_NOCANDO)
+	    return expr;
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logical2_val
+	     (ffebld_cu_val_logical2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeLOGICAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okLOGICAL1
+		case FFEINFO_kindtypeLOGICAL1:
+		  error = ffetarget_convert_logical3_logical1
+		    (ffebld_cu_ptr_logical3 (u),
+		     ffebld_constant_logical1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+		case FFEINFO_kindtypeLOGICAL2:
+		  error = ffetarget_convert_logical3_logical2
+		    (ffebld_cu_ptr_logical3 (u),
+		     ffebld_constant_logical2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+		case FFEINFO_kindtypeLOGICAL4:
+		  error = ffetarget_convert_logical3_logical4
+		    (ffebld_cu_ptr_logical3 (u),
+		     ffebld_constant_logical4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("LOGICAL3/LOGICAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error = ffetarget_convert_logical3_integer1
+		    (ffebld_cu_ptr_logical3 (u),
+		     ffebld_constant_integer1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error = ffetarget_convert_logical3_integer2
+		    (ffebld_cu_ptr_logical3 (u),
+		     ffebld_constant_integer2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error = ffetarget_convert_logical3_integer3
+		    (ffebld_cu_ptr_logical3 (u),
+		     ffebld_constant_integer3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error = ffetarget_convert_logical3_integer4
+		    (ffebld_cu_ptr_logical3 (u),
+		     ffebld_constant_integer4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("LOGICAL3/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_logical3_character1
+		(ffebld_cu_ptr_logical3 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_logical3_hollerith
+		(ffebld_cu_ptr_logical3 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_logical3_typeless
+		(ffebld_cu_ptr_logical3 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("LOGICAL3 bad type" == NULL);
+	      break;
+	    }
+
+	  /* If conversion operation is not implemented, return original expr.  */
+	  if (error == FFEBAD_NOCANDO)
+	    return expr;
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logical3_val
+	     (ffebld_cu_val_logical3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeLOGICAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okLOGICAL1
+		case FFEINFO_kindtypeLOGICAL1:
+		  error = ffetarget_convert_logical4_logical1
+		    (ffebld_cu_ptr_logical4 (u),
+		     ffebld_constant_logical1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+		case FFEINFO_kindtypeLOGICAL2:
+		  error = ffetarget_convert_logical4_logical2
+		    (ffebld_cu_ptr_logical4 (u),
+		     ffebld_constant_logical2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+		case FFEINFO_kindtypeLOGICAL3:
+		  error = ffetarget_convert_logical4_logical3
+		    (ffebld_cu_ptr_logical4 (u),
+		     ffebld_constant_logical3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("LOGICAL4/LOGICAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error = ffetarget_convert_logical4_integer1
+		    (ffebld_cu_ptr_logical4 (u),
+		     ffebld_constant_integer1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error = ffetarget_convert_logical4_integer2
+		    (ffebld_cu_ptr_logical4 (u),
+		     ffebld_constant_integer2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error = ffetarget_convert_logical4_integer3
+		    (ffebld_cu_ptr_logical4 (u),
+		     ffebld_constant_integer3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error = ffetarget_convert_logical4_integer4
+		    (ffebld_cu_ptr_logical4 (u),
+		     ffebld_constant_integer4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("LOGICAL4/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_logical4_character1
+		(ffebld_cu_ptr_logical4 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_logical4_hollerith
+		(ffebld_cu_ptr_logical4 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_logical4_typeless
+		(ffebld_cu_ptr_logical4 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("LOGICAL4 bad type" == NULL);
+	      break;
+	    }
+
+	  /* If conversion operation is not implemented, return original expr.  */
+	  if (error == FFEBAD_NOCANDO)
+	    return expr;
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logical4_val
+	     (ffebld_cu_val_logical4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad logical kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      sz = FFETARGET_charactersizeNONE;
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error = ffetarget_convert_real1_integer1
+		    (ffebld_cu_ptr_real1 (u),
+		     ffebld_constant_integer1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error = ffetarget_convert_real1_integer2
+		    (ffebld_cu_ptr_real1 (u),
+		     ffebld_constant_integer2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error = ffetarget_convert_real1_integer3
+		    (ffebld_cu_ptr_real1 (u),
+		     ffebld_constant_integer3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error = ffetarget_convert_real1_integer4
+		    (ffebld_cu_ptr_real1 (u),
+		     ffebld_constant_integer4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL1/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeREAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okREAL2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_real1_real2
+		    (ffebld_cu_ptr_real1 (u),
+		     ffebld_constant_real2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_real1_real3
+		    (ffebld_cu_ptr_real1 (u),
+		     ffebld_constant_real3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL1/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCOMPLEX:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okCOMPLEX1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_real1_complex1
+		    (ffebld_cu_ptr_real1 (u),
+		     ffebld_constant_complex1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_real1_complex2
+		    (ffebld_cu_ptr_real1 (u),
+		     ffebld_constant_complex2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_real1_complex3
+		    (ffebld_cu_ptr_real1 (u),
+		     ffebld_constant_complex3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL1/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_real1_character1
+		(ffebld_cu_ptr_real1 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_real1_hollerith
+		(ffebld_cu_ptr_real1 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_real1_typeless
+		(ffebld_cu_ptr_real1 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("REAL1 bad type" == NULL);
+	      break;
+	    }
+
+	  /* If conversion operation is not implemented, return original expr.  */
+	  if (error == FFEBAD_NOCANDO)
+	    return expr;
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_real1_val
+	     (ffebld_cu_val_real1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error = ffetarget_convert_real2_integer1
+		    (ffebld_cu_ptr_real2 (u),
+		     ffebld_constant_integer1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error = ffetarget_convert_real2_integer2
+		    (ffebld_cu_ptr_real2 (u),
+		     ffebld_constant_integer2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error = ffetarget_convert_real2_integer3
+		    (ffebld_cu_ptr_real2 (u),
+		     ffebld_constant_integer3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error = ffetarget_convert_real2_integer4
+		    (ffebld_cu_ptr_real2 (u),
+		     ffebld_constant_integer4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL2/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeREAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okREAL1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_real2_real1
+		    (ffebld_cu_ptr_real2 (u),
+		     ffebld_constant_real1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_real2_real3
+		    (ffebld_cu_ptr_real2 (u),
+		     ffebld_constant_real3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL2/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCOMPLEX:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okCOMPLEX1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_real2_complex1
+		    (ffebld_cu_ptr_real2 (u),
+		     ffebld_constant_complex1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_real2_complex2
+		    (ffebld_cu_ptr_real2 (u),
+		     ffebld_constant_complex2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_real2_complex3
+		    (ffebld_cu_ptr_real2 (u),
+		     ffebld_constant_complex3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL2/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_real2_character1
+		(ffebld_cu_ptr_real2 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_real2_hollerith
+		(ffebld_cu_ptr_real2 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_real2_typeless
+		(ffebld_cu_ptr_real2 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("REAL2 bad type" == NULL);
+	      break;
+	    }
+
+	  /* If conversion operation is not implemented, return original expr.  */
+	  if (error == FFEBAD_NOCANDO)
+	    return expr;
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_real2_val
+	     (ffebld_cu_val_real2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error = ffetarget_convert_real3_integer1
+		    (ffebld_cu_ptr_real3 (u),
+		     ffebld_constant_integer1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error = ffetarget_convert_real3_integer2
+		    (ffebld_cu_ptr_real3 (u),
+		     ffebld_constant_integer2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error = ffetarget_convert_real3_integer3
+		    (ffebld_cu_ptr_real3 (u),
+		     ffebld_constant_integer3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error = ffetarget_convert_real3_integer4
+		    (ffebld_cu_ptr_real3 (u),
+		     ffebld_constant_integer4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL3/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeREAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okREAL1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_real3_real1
+		    (ffebld_cu_ptr_real3 (u),
+		     ffebld_constant_real1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_real3_real2
+		    (ffebld_cu_ptr_real3 (u),
+		     ffebld_constant_real2 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL3/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCOMPLEX:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okCOMPLEX1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_real3_complex1
+		    (ffebld_cu_ptr_real3 (u),
+		     ffebld_constant_complex1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_real3_complex2
+		    (ffebld_cu_ptr_real3 (u),
+		     ffebld_constant_complex2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_real3_complex3
+		    (ffebld_cu_ptr_real3 (u),
+		     ffebld_constant_complex3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("REAL3/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_real3_character1
+		(ffebld_cu_ptr_real3 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_real3_hollerith
+		(ffebld_cu_ptr_real3 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_real3_typeless
+		(ffebld_cu_ptr_real3 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("REAL3 bad type" == NULL);
+	      break;
+	    }
+
+	  /* If conversion operation is not implemented, return original expr.  */
+	  if (error == FFEBAD_NOCANDO)
+	    return expr;
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_real3_val
+	     (ffebld_cu_val_real3 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      sz = FFETARGET_charactersizeNONE;
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error = ffetarget_convert_complex1_integer1
+		    (ffebld_cu_ptr_complex1 (u),
+		     ffebld_constant_integer1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error = ffetarget_convert_complex1_integer2
+		    (ffebld_cu_ptr_complex1 (u),
+		     ffebld_constant_integer2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error = ffetarget_convert_complex1_integer3
+		    (ffebld_cu_ptr_complex1 (u),
+		     ffebld_constant_integer3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error = ffetarget_convert_complex1_integer4
+		    (ffebld_cu_ptr_complex1 (u),
+		     ffebld_constant_integer4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX1/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeREAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okREAL1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_complex1_real1
+		    (ffebld_cu_ptr_complex1 (u),
+		     ffebld_constant_real1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_complex1_real2
+		    (ffebld_cu_ptr_complex1 (u),
+		     ffebld_constant_real2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_complex1_real3
+		    (ffebld_cu_ptr_complex1 (u),
+		     ffebld_constant_real3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX1/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCOMPLEX:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okCOMPLEX2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_complex1_complex2
+		    (ffebld_cu_ptr_complex1 (u),
+		     ffebld_constant_complex2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_complex1_complex3
+		    (ffebld_cu_ptr_complex1 (u),
+		     ffebld_constant_complex3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX1/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_complex1_character1
+		(ffebld_cu_ptr_complex1 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_complex1_hollerith
+		(ffebld_cu_ptr_complex1 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_complex1_typeless
+		(ffebld_cu_ptr_complex1 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("COMPLEX1 bad type" == NULL);
+	      break;
+	    }
+
+	  /* If conversion operation is not implemented, return original expr.  */
+	  if (error == FFEBAD_NOCANDO)
+	    return expr;
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_complex1_val
+	     (ffebld_cu_val_complex1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error = ffetarget_convert_complex2_integer1
+		    (ffebld_cu_ptr_complex2 (u),
+		     ffebld_constant_integer1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error = ffetarget_convert_complex2_integer2
+		    (ffebld_cu_ptr_complex2 (u),
+		     ffebld_constant_integer2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error = ffetarget_convert_complex2_integer3
+		    (ffebld_cu_ptr_complex2 (u),
+		     ffebld_constant_integer3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error = ffetarget_convert_complex2_integer4
+		    (ffebld_cu_ptr_complex2 (u),
+		     ffebld_constant_integer4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX2/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeREAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okREAL1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_complex2_real1
+		    (ffebld_cu_ptr_complex2 (u),
+		     ffebld_constant_real1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_complex2_real2
+		    (ffebld_cu_ptr_complex2 (u),
+		     ffebld_constant_real2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_complex2_real3
+		    (ffebld_cu_ptr_complex2 (u),
+		     ffebld_constant_real3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX2/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCOMPLEX:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okCOMPLEX1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_complex2_complex1
+		    (ffebld_cu_ptr_complex2 (u),
+		     ffebld_constant_complex1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_complex2_complex3
+		    (ffebld_cu_ptr_complex2 (u),
+		     ffebld_constant_complex3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX2/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_complex2_character1
+		(ffebld_cu_ptr_complex2 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_complex2_hollerith
+		(ffebld_cu_ptr_complex2 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_complex2_typeless
+		(ffebld_cu_ptr_complex2 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("COMPLEX2 bad type" == NULL);
+	      break;
+	    }
+
+	  /* If conversion operation is not implemented, return original expr.  */
+	  if (error == FFEBAD_NOCANDO)
+	    return expr;
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_complex2_val
+	     (ffebld_cu_val_complex2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error = ffetarget_convert_complex3_integer1
+		    (ffebld_cu_ptr_complex3 (u),
+		     ffebld_constant_integer1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error = ffetarget_convert_complex3_integer2
+		    (ffebld_cu_ptr_complex3 (u),
+		     ffebld_constant_integer2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error = ffetarget_convert_complex3_integer3
+		    (ffebld_cu_ptr_complex3 (u),
+		     ffebld_constant_integer3 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error = ffetarget_convert_complex3_integer4
+		    (ffebld_cu_ptr_complex3 (u),
+		     ffebld_constant_integer4 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX3/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeREAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okREAL1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_complex3_real1
+		    (ffebld_cu_ptr_complex3 (u),
+		     ffebld_constant_real1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_complex3_real2
+		    (ffebld_cu_ptr_complex3 (u),
+		     ffebld_constant_real2 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okREAL3
+		case FFEINFO_kindtypeREAL3:
+		  error = ffetarget_convert_complex3_real3
+		    (ffebld_cu_ptr_complex3 (u),
+		     ffebld_constant_real3 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX3/REAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCOMPLEX:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okCOMPLEX1
+		case FFEINFO_kindtypeREAL1:
+		  error = ffetarget_convert_complex3_complex1
+		    (ffebld_cu_ptr_complex3 (u),
+		     ffebld_constant_complex1 (ffebld_conter (l)));
+		  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+		case FFEINFO_kindtypeREAL2:
+		  error = ffetarget_convert_complex3_complex2
+		    (ffebld_cu_ptr_complex3 (u),
+		     ffebld_constant_complex2 (ffebld_conter (l)));
+		  break;
+#endif
+
+		default:
+		  assert ("COMPLEX3/COMPLEX bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      error = ffetarget_convert_complex3_character1
+		(ffebld_cu_ptr_complex3 (u),
+		 ffebld_constant_character1 (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error = ffetarget_convert_complex3_hollerith
+		(ffebld_cu_ptr_complex3 (u),
+		 ffebld_constant_hollerith (ffebld_conter (l)));
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error = ffetarget_convert_complex3_typeless
+		(ffebld_cu_ptr_complex3 (u),
+		 ffebld_constant_typeless (ffebld_conter (l)));
+	      break;
+
+	    default:
+	      assert ("COMPLEX3 bad type" == NULL);
+	      break;
+	    }
+
+	  /* If conversion operation is not implemented, return original expr.  */
+	  if (error == FFEBAD_NOCANDO)
+	    return expr;
+
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_complex3_val
+	     (ffebld_cu_val_complex3 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      if ((sz = ffebld_size (expr)) == FFETARGET_charactersizeNONE)
+	return expr;
+      kt = ffeinfo_kindtype (ffebld_info (expr));
+      switch (kt)
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  switch (ffeinfo_basictype (ffebld_info (l)))
+	    {
+	    case FFEINFO_basictypeCHARACTER:
+	      if ((sz2 = ffebld_size (l)) == FFETARGET_charactersizeNONE)
+		return expr;
+	      assert (kt == ffeinfo_kindtype (ffebld_info (l)));
+	      assert (sz2 == ffetarget_length_character1
+		      (ffebld_constant_character1
+		       (ffebld_conter (l))));
+	      error
+		= ffetarget_convert_character1_character1
+		(ffebld_cu_ptr_character1 (u), sz,
+		 ffebld_constant_character1 (ffebld_conter (l)),
+		 ffebld_constant_pool ());
+	      break;
+
+	    case FFEINFO_basictypeINTEGER:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okINTEGER1
+		case FFEINFO_kindtypeINTEGER1:
+		  error
+		    = ffetarget_convert_character1_integer1
+		      (ffebld_cu_ptr_character1 (u),
+		       sz,
+		       ffebld_constant_integer1 (ffebld_conter (l)),
+		       ffebld_constant_pool ());
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+		case FFEINFO_kindtypeINTEGER2:
+		  error
+		    = ffetarget_convert_character1_integer2
+		      (ffebld_cu_ptr_character1 (u),
+		       sz,
+		       ffebld_constant_integer2 (ffebld_conter (l)),
+		       ffebld_constant_pool ());
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+		case FFEINFO_kindtypeINTEGER3:
+		  error
+		    = ffetarget_convert_character1_integer3
+		      (ffebld_cu_ptr_character1 (u),
+		       sz,
+		       ffebld_constant_integer3 (ffebld_conter (l)),
+		       ffebld_constant_pool ());
+		  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+		case FFEINFO_kindtypeINTEGER4:
+		  error
+		    = ffetarget_convert_character1_integer4
+		      (ffebld_cu_ptr_character1 (u),
+		       sz,
+		       ffebld_constant_integer4 (ffebld_conter (l)),
+		       ffebld_constant_pool ());
+		  break;
+#endif
+
+		default:
+		  assert ("CHARACTER1/INTEGER bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeLOGICAL:
+	      switch (ffeinfo_kindtype (ffebld_info (l)))
+		{
+#if FFETARGET_okLOGICAL1
+		case FFEINFO_kindtypeLOGICAL1:
+		  error
+		    = ffetarget_convert_character1_logical1
+		      (ffebld_cu_ptr_character1 (u),
+		       sz,
+		       ffebld_constant_logical1 (ffebld_conter (l)),
+		       ffebld_constant_pool ());
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+		case FFEINFO_kindtypeLOGICAL2:
+		  error
+		    = ffetarget_convert_character1_logical2
+		      (ffebld_cu_ptr_character1 (u),
+		       sz,
+		       ffebld_constant_logical2 (ffebld_conter (l)),
+		       ffebld_constant_pool ());
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+		case FFEINFO_kindtypeLOGICAL3:
+		  error
+		    = ffetarget_convert_character1_logical3
+		      (ffebld_cu_ptr_character1 (u),
+		       sz,
+		       ffebld_constant_logical3 (ffebld_conter (l)),
+		       ffebld_constant_pool ());
+		  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+		case FFEINFO_kindtypeLOGICAL4:
+		  error
+		    = ffetarget_convert_character1_logical4
+		      (ffebld_cu_ptr_character1 (u),
+		       sz,
+		       ffebld_constant_logical4 (ffebld_conter (l)),
+		       ffebld_constant_pool ());
+		  break;
+#endif
+
+		default:
+		  assert ("CHARACTER1/LOGICAL bad source kind type" == NULL);
+		  break;
+		}
+	      break;
+
+	    case FFEINFO_basictypeHOLLERITH:
+	      error
+		= ffetarget_convert_character1_hollerith
+		(ffebld_cu_ptr_character1 (u),
+		 sz,
+		 ffebld_constant_hollerith (ffebld_conter (l)),
+		 ffebld_constant_pool ());
+	      break;
+
+	    case FFEINFO_basictypeTYPELESS:
+	      error
+		= ffetarget_convert_character1_typeless
+		(ffebld_cu_ptr_character1 (u),
+		 sz,
+		 ffebld_constant_typeless (ffebld_conter (l)),
+		 ffebld_constant_pool ());
+	      break;
+
+	    default:
+	      assert ("CHARACTER1 bad type" == NULL);
+	    }
+
+	  expr
+	    = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_character1_val
+	     (ffebld_cu_val_character1 (u)),
+	     expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    sz));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      assert (t != NULL);
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_paren -- Collapse paren expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_paren(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_paren (ffebld expr, ffelexToken t UNUSED)
+{
+  ffebld r;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  ffetargetCharacterSize len;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  r = ffebld_left (expr);
+
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  bt = ffeinfo_basictype (ffebld_info (r));
+  kt = ffeinfo_kindtype (ffebld_info (r));
+  len = ffebld_size (r);
+
+  expr = ffebld_new_conter_with_orig (ffebld_constant_copy (ffebld_conter (r)),
+				      expr);
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    len));
+
+  return expr;
+}
+
+/* ffeexpr_collapse_uplus -- Collapse uplus expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_uplus(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_uplus (ffebld expr, ffelexToken t UNUSED)
+{
+  ffebld r;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  ffetargetCharacterSize len;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  r = ffebld_left (expr);
+
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  bt = ffeinfo_basictype (ffebld_info (r));
+  kt = ffeinfo_kindtype (ffebld_info (r));
+  len = ffebld_size (r);
+
+  expr = ffebld_new_conter_with_orig (ffebld_constant_copy (ffebld_conter (r)),
+				      expr);
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    len));
+
+  return expr;
+}
+
+/* ffeexpr_collapse_uminus -- Collapse uminus expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_uminus(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_uminus (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld r;
+  ffebldConstantUnion u;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  r = ffebld_left (expr);
+
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_uminus_integer1 (ffebld_cu_ptr_integer1 (u),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+					(ffebld_cu_val_integer1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_uminus_integer2 (ffebld_cu_ptr_integer2 (u),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+					(ffebld_cu_val_integer2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_uminus_integer3 (ffebld_cu_ptr_integer3 (u),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+					(ffebld_cu_val_integer3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_uminus_integer4 (ffebld_cu_ptr_integer4 (u),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+					(ffebld_cu_val_integer4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_uminus_real1 (ffebld_cu_ptr_real1 (u),
+				 ffebld_constant_real1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
+					   (ffebld_cu_val_real1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_uminus_real2 (ffebld_cu_ptr_real2 (u),
+				 ffebld_constant_real2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
+					   (ffebld_cu_val_real2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_uminus_real3 (ffebld_cu_ptr_real3 (u),
+				 ffebld_constant_real3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
+					   (ffebld_cu_val_real3 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_uminus_complex1 (ffebld_cu_ptr_complex1 (u),
+			      ffebld_constant_complex1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
+					(ffebld_cu_val_complex1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_uminus_complex2 (ffebld_cu_ptr_complex2 (u),
+			      ffebld_constant_complex2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
+					(ffebld_cu_val_complex2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_uminus_complex3 (ffebld_cu_ptr_complex3 (u),
+			      ffebld_constant_complex3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
+					(ffebld_cu_val_complex3 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_not -- Collapse not expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_not(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_not (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld r;
+  ffebldConstantUnion u;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  r = ffebld_left (expr);
+
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_not_integer1 (ffebld_cu_ptr_integer1 (u),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+					(ffebld_cu_val_integer1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_not_integer2 (ffebld_cu_ptr_integer2 (u),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+					(ffebld_cu_val_integer2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_not_integer3 (ffebld_cu_ptr_integer3 (u),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+					(ffebld_cu_val_integer3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_not_integer4 (ffebld_cu_ptr_integer4 (u),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+					(ffebld_cu_val_integer4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  error = ffetarget_not_logical1 (ffebld_cu_ptr_logical1 (u),
+			      ffebld_constant_logical1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
+					(ffebld_cu_val_logical1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  error = ffetarget_not_logical2 (ffebld_cu_ptr_logical2 (u),
+			      ffebld_constant_logical2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
+					(ffebld_cu_val_logical2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  error = ffetarget_not_logical3 (ffebld_cu_ptr_logical3 (u),
+			      ffebld_constant_logical3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
+					(ffebld_cu_val_logical3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  error = ffetarget_not_logical4 (ffebld_cu_ptr_logical4 (u),
+			      ffebld_constant_logical4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
+					(ffebld_cu_val_logical4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad logical kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_add -- Collapse add expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_add(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_add (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  ffebldConstantUnion u;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_add_integer1 (ffebld_cu_ptr_integer1 (u),
+			       ffebld_constant_integer1 (ffebld_conter (l)),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+					(ffebld_cu_val_integer1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_add_integer2 (ffebld_cu_ptr_integer2 (u),
+			       ffebld_constant_integer2 (ffebld_conter (l)),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+					(ffebld_cu_val_integer2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_add_integer3 (ffebld_cu_ptr_integer3 (u),
+			       ffebld_constant_integer3 (ffebld_conter (l)),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+					(ffebld_cu_val_integer3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_add_integer4 (ffebld_cu_ptr_integer4 (u),
+			       ffebld_constant_integer4 (ffebld_conter (l)),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+					(ffebld_cu_val_integer4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_add_real1 (ffebld_cu_ptr_real1 (u),
+				  ffebld_constant_real1 (ffebld_conter (l)),
+				 ffebld_constant_real1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
+					   (ffebld_cu_val_real1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_add_real2 (ffebld_cu_ptr_real2 (u),
+				  ffebld_constant_real2 (ffebld_conter (l)),
+				 ffebld_constant_real2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
+					   (ffebld_cu_val_real2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_add_real3 (ffebld_cu_ptr_real3 (u),
+				  ffebld_constant_real3 (ffebld_conter (l)),
+				 ffebld_constant_real3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
+					   (ffebld_cu_val_real3 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_add_complex1 (ffebld_cu_ptr_complex1 (u),
+			       ffebld_constant_complex1 (ffebld_conter (l)),
+			      ffebld_constant_complex1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
+					(ffebld_cu_val_complex1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_add_complex2 (ffebld_cu_ptr_complex2 (u),
+			       ffebld_constant_complex2 (ffebld_conter (l)),
+			      ffebld_constant_complex2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
+					(ffebld_cu_val_complex2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_add_complex3 (ffebld_cu_ptr_complex3 (u),
+			       ffebld_constant_complex3 (ffebld_conter (l)),
+			      ffebld_constant_complex3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
+					(ffebld_cu_val_complex3 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_subtract -- Collapse subtract expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_subtract(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_subtract (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  ffebldConstantUnion u;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_subtract_integer1 (ffebld_cu_ptr_integer1 (u),
+			       ffebld_constant_integer1 (ffebld_conter (l)),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+					(ffebld_cu_val_integer1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_subtract_integer2 (ffebld_cu_ptr_integer2 (u),
+			       ffebld_constant_integer2 (ffebld_conter (l)),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+					(ffebld_cu_val_integer2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_subtract_integer3 (ffebld_cu_ptr_integer3 (u),
+			       ffebld_constant_integer3 (ffebld_conter (l)),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+					(ffebld_cu_val_integer3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_subtract_integer4 (ffebld_cu_ptr_integer4 (u),
+			       ffebld_constant_integer4 (ffebld_conter (l)),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+					(ffebld_cu_val_integer4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_subtract_real1 (ffebld_cu_ptr_real1 (u),
+				  ffebld_constant_real1 (ffebld_conter (l)),
+				 ffebld_constant_real1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
+					   (ffebld_cu_val_real1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_subtract_real2 (ffebld_cu_ptr_real2 (u),
+				  ffebld_constant_real2 (ffebld_conter (l)),
+				 ffebld_constant_real2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
+					   (ffebld_cu_val_real2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_subtract_real3 (ffebld_cu_ptr_real3 (u),
+				  ffebld_constant_real3 (ffebld_conter (l)),
+				 ffebld_constant_real3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
+					   (ffebld_cu_val_real3 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_subtract_complex1 (ffebld_cu_ptr_complex1 (u),
+			       ffebld_constant_complex1 (ffebld_conter (l)),
+			      ffebld_constant_complex1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
+					(ffebld_cu_val_complex1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_subtract_complex2 (ffebld_cu_ptr_complex2 (u),
+			       ffebld_constant_complex2 (ffebld_conter (l)),
+			      ffebld_constant_complex2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
+					(ffebld_cu_val_complex2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_subtract_complex3 (ffebld_cu_ptr_complex3 (u),
+			       ffebld_constant_complex3 (ffebld_conter (l)),
+			      ffebld_constant_complex3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
+					(ffebld_cu_val_complex3 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_multiply -- Collapse multiply expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_multiply(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_multiply (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  ffebldConstantUnion u;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_multiply_integer1 (ffebld_cu_ptr_integer1 (u),
+			       ffebld_constant_integer1 (ffebld_conter (l)),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+					(ffebld_cu_val_integer1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_multiply_integer2 (ffebld_cu_ptr_integer2 (u),
+			       ffebld_constant_integer2 (ffebld_conter (l)),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+					(ffebld_cu_val_integer2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_multiply_integer3 (ffebld_cu_ptr_integer3 (u),
+			       ffebld_constant_integer3 (ffebld_conter (l)),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+					(ffebld_cu_val_integer3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_multiply_integer4 (ffebld_cu_ptr_integer4 (u),
+			       ffebld_constant_integer4 (ffebld_conter (l)),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+					(ffebld_cu_val_integer4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_multiply_real1 (ffebld_cu_ptr_real1 (u),
+				  ffebld_constant_real1 (ffebld_conter (l)),
+				 ffebld_constant_real1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
+					   (ffebld_cu_val_real1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_multiply_real2 (ffebld_cu_ptr_real2 (u),
+				  ffebld_constant_real2 (ffebld_conter (l)),
+				 ffebld_constant_real2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
+					   (ffebld_cu_val_real2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_multiply_real3 (ffebld_cu_ptr_real3 (u),
+				  ffebld_constant_real3 (ffebld_conter (l)),
+				 ffebld_constant_real3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
+					   (ffebld_cu_val_real3 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_multiply_complex1 (ffebld_cu_ptr_complex1 (u),
+			       ffebld_constant_complex1 (ffebld_conter (l)),
+			      ffebld_constant_complex1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
+					(ffebld_cu_val_complex1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_multiply_complex2 (ffebld_cu_ptr_complex2 (u),
+			       ffebld_constant_complex2 (ffebld_conter (l)),
+			      ffebld_constant_complex2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
+					(ffebld_cu_val_complex2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_multiply_complex3 (ffebld_cu_ptr_complex3 (u),
+			       ffebld_constant_complex3 (ffebld_conter (l)),
+			      ffebld_constant_complex3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
+					(ffebld_cu_val_complex3 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_divide -- Collapse divide expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_divide(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_divide (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  ffebldConstantUnion u;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_divide_integer1 (ffebld_cu_ptr_integer1 (u),
+			       ffebld_constant_integer1 (ffebld_conter (l)),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+					(ffebld_cu_val_integer1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_divide_integer2 (ffebld_cu_ptr_integer2 (u),
+			       ffebld_constant_integer2 (ffebld_conter (l)),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+					(ffebld_cu_val_integer2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_divide_integer3 (ffebld_cu_ptr_integer3 (u),
+			       ffebld_constant_integer3 (ffebld_conter (l)),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+					(ffebld_cu_val_integer3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_divide_integer4 (ffebld_cu_ptr_integer4 (u),
+			       ffebld_constant_integer4 (ffebld_conter (l)),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+					(ffebld_cu_val_integer4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_divide_real1 (ffebld_cu_ptr_real1 (u),
+				  ffebld_constant_real1 (ffebld_conter (l)),
+				 ffebld_constant_real1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
+					   (ffebld_cu_val_real1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_divide_real2 (ffebld_cu_ptr_real2 (u),
+				  ffebld_constant_real2 (ffebld_conter (l)),
+				 ffebld_constant_real2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
+					   (ffebld_cu_val_real2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_divide_real3 (ffebld_cu_ptr_real3 (u),
+				  ffebld_constant_real3 (ffebld_conter (l)),
+				 ffebld_constant_real3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
+					   (ffebld_cu_val_real3 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_divide_complex1 (ffebld_cu_ptr_complex1 (u),
+			       ffebld_constant_complex1 (ffebld_conter (l)),
+			      ffebld_constant_complex1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
+					(ffebld_cu_val_complex1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_divide_complex2 (ffebld_cu_ptr_complex2 (u),
+			       ffebld_constant_complex2 (ffebld_conter (l)),
+			      ffebld_constant_complex2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
+					(ffebld_cu_val_complex2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_divide_complex3 (ffebld_cu_ptr_complex3 (u),
+			       ffebld_constant_complex3 (ffebld_conter (l)),
+			      ffebld_constant_complex3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
+					(ffebld_cu_val_complex3 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_power -- Collapse power expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_power(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_power (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  ffebldConstantUnion u;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  if ((ffeinfo_basictype (ffebld_info (r)) != FFEINFO_basictypeINTEGER)
+  || (ffeinfo_kindtype (ffebld_info (r)) != FFEINFO_kindtypeINTEGERDEFAULT))
+    return expr;
+
+  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+	case FFEINFO_kindtypeINTEGERDEFAULT:
+	  error = ffetarget_power_integerdefault_integerdefault
+	    (ffebld_cu_ptr_integerdefault (u),
+	     ffebld_constant_integerdefault (ffebld_conter (l)),
+	     ffebld_constant_integerdefault (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_integerdefault_val
+	     (ffebld_cu_val_integerdefault (u)), expr);
+	  break;
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+	case FFEINFO_kindtypeREALDEFAULT:
+	  error = ffetarget_power_realdefault_integerdefault
+	    (ffebld_cu_ptr_realdefault (u),
+	     ffebld_constant_realdefault (ffebld_conter (l)),
+	     ffebld_constant_integerdefault (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_realdefault_val
+	     (ffebld_cu_val_realdefault (u)), expr);
+	  break;
+
+	case FFEINFO_kindtypeREALDOUBLE:
+	  error = ffetarget_power_realdouble_integerdefault
+	    (ffebld_cu_ptr_realdouble (u),
+	     ffebld_constant_realdouble (ffebld_conter (l)),
+	     ffebld_constant_integerdefault (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_realdouble_val
+	     (ffebld_cu_val_realdouble (u)), expr);
+	  break;
+
+#if FFETARGET_okREALQUAD
+	case FFEINFO_kindtypeREALQUAD:
+	  error = ffetarget_power_realquad_integerdefault
+	    (ffebld_cu_ptr_realquad (u),
+	     ffebld_constant_realquad (ffebld_conter (l)),
+	     ffebld_constant_integerdefault (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_realquad_val
+	     (ffebld_cu_val_realquad (u)), expr);
+	  break;
+#endif
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+	case FFEINFO_kindtypeREALDEFAULT:
+	  error = ffetarget_power_complexdefault_integerdefault
+	    (ffebld_cu_ptr_complexdefault (u),
+	     ffebld_constant_complexdefault (ffebld_conter (l)),
+	     ffebld_constant_integerdefault (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_complexdefault_val
+	     (ffebld_cu_val_complexdefault (u)), expr);
+	  break;
+
+#if FFETARGET_okCOMPLEXDOUBLE
+	case FFEINFO_kindtypeREALDOUBLE:
+	  error = ffetarget_power_complexdouble_integerdefault
+	    (ffebld_cu_ptr_complexdouble (u),
+	     ffebld_constant_complexdouble (ffebld_conter (l)),
+	     ffebld_constant_integerdefault (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_complexdouble_val
+	     (ffebld_cu_val_complexdouble (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEXQUAD
+	case FFEINFO_kindtypeREALQUAD:
+	  error = ffetarget_power_complexquad_integerdefault
+	    (ffebld_cu_ptr_complexquad (u),
+	     ffebld_constant_complexquad (ffebld_conter (l)),
+	     ffebld_constant_integerdefault (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_complexquad_val
+	     (ffebld_cu_val_complexquad (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t),
+		   ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_concatenate -- Collapse concatenate expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_concatenate(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_concatenate (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  ffebldConstantUnion u;
+  ffeinfoKindtype kt;
+  ffetargetCharacterSize len;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (ffeinfo_basictype (ffebld_info (expr)))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  error = ffetarget_concatenate_character1 (ffebld_cu_ptr_character1 (u),
+			     ffebld_constant_character1 (ffebld_conter (l)),
+			     ffebld_constant_character1 (ffebld_conter (r)),
+				   ffebld_constant_pool (), &len);
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_character1_val
+				      (ffebld_cu_val_character1 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (FFEINFO_basictypeCHARACTER,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    len));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_eq -- Collapse eq expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_eq(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_eq (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  bool val;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_eq_integer1 (&val,
+			       ffebld_constant_integer1 (ffebld_conter (l)),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_eq_integer2 (&val,
+			       ffebld_constant_integer2 (ffebld_conter (l)),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_eq_integer3 (&val,
+			       ffebld_constant_integer3 (ffebld_conter (l)),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_eq_integer4 (&val,
+			       ffebld_constant_integer4 (ffebld_conter (l)),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_eq_real1 (&val,
+				  ffebld_constant_real1 (ffebld_conter (l)),
+				 ffebld_constant_real1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_eq_real2 (&val,
+				  ffebld_constant_real2 (ffebld_conter (l)),
+				 ffebld_constant_real2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_eq_real3 (&val,
+				  ffebld_constant_real3 (ffebld_conter (l)),
+				 ffebld_constant_real3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_eq_complex1 (&val,
+			       ffebld_constant_complex1 (ffebld_conter (l)),
+			      ffebld_constant_complex1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_eq_complex2 (&val,
+			       ffebld_constant_complex2 (ffebld_conter (l)),
+			      ffebld_constant_complex2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_eq_complex3 (&val,
+			       ffebld_constant_complex3 (ffebld_conter (l)),
+			      ffebld_constant_complex3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  error = ffetarget_eq_character1 (&val,
+			     ffebld_constant_character1 (ffebld_conter (l)),
+			    ffebld_constant_character1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (FFEINFO_basictypeLOGICAL,
+		    FFEINFO_kindtypeLOGICALDEFAULT,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_ne -- Collapse ne expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_ne(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_ne (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  bool val;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_ne_integer1 (&val,
+			       ffebld_constant_integer1 (ffebld_conter (l)),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_ne_integer2 (&val,
+			       ffebld_constant_integer2 (ffebld_conter (l)),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_ne_integer3 (&val,
+			       ffebld_constant_integer3 (ffebld_conter (l)),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_ne_integer4 (&val,
+			       ffebld_constant_integer4 (ffebld_conter (l)),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_ne_real1 (&val,
+				  ffebld_constant_real1 (ffebld_conter (l)),
+				 ffebld_constant_real1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_ne_real2 (&val,
+				  ffebld_constant_real2 (ffebld_conter (l)),
+				 ffebld_constant_real2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_ne_real3 (&val,
+				  ffebld_constant_real3 (ffebld_conter (l)),
+				 ffebld_constant_real3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCOMPLEX:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_ne_complex1 (&val,
+			       ffebld_constant_complex1 (ffebld_conter (l)),
+			      ffebld_constant_complex1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_ne_complex2 (&val,
+			       ffebld_constant_complex2 (ffebld_conter (l)),
+			      ffebld_constant_complex2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_ne_complex3 (&val,
+			       ffebld_constant_complex3 (ffebld_conter (l)),
+			      ffebld_constant_complex3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad complex kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  error = ffetarget_ne_character1 (&val,
+			     ffebld_constant_character1 (ffebld_conter (l)),
+			    ffebld_constant_character1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (FFEINFO_basictypeLOGICAL,
+		    FFEINFO_kindtypeLOGICALDEFAULT,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_ge -- Collapse ge expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_ge(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_ge (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  bool val;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_ge_integer1 (&val,
+			       ffebld_constant_integer1 (ffebld_conter (l)),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_ge_integer2 (&val,
+			       ffebld_constant_integer2 (ffebld_conter (l)),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_ge_integer3 (&val,
+			       ffebld_constant_integer3 (ffebld_conter (l)),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_ge_integer4 (&val,
+			       ffebld_constant_integer4 (ffebld_conter (l)),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_ge_real1 (&val,
+				  ffebld_constant_real1 (ffebld_conter (l)),
+				 ffebld_constant_real1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_ge_real2 (&val,
+				  ffebld_constant_real2 (ffebld_conter (l)),
+				 ffebld_constant_real2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_ge_real3 (&val,
+				  ffebld_constant_real3 (ffebld_conter (l)),
+				 ffebld_constant_real3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  error = ffetarget_ge_character1 (&val,
+			     ffebld_constant_character1 (ffebld_conter (l)),
+			    ffebld_constant_character1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (FFEINFO_basictypeLOGICAL,
+		    FFEINFO_kindtypeLOGICALDEFAULT,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_gt -- Collapse gt expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_gt(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_gt (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  bool val;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_gt_integer1 (&val,
+			       ffebld_constant_integer1 (ffebld_conter (l)),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_gt_integer2 (&val,
+			       ffebld_constant_integer2 (ffebld_conter (l)),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_gt_integer3 (&val,
+			       ffebld_constant_integer3 (ffebld_conter (l)),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_gt_integer4 (&val,
+			       ffebld_constant_integer4 (ffebld_conter (l)),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_gt_real1 (&val,
+				  ffebld_constant_real1 (ffebld_conter (l)),
+				 ffebld_constant_real1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_gt_real2 (&val,
+				  ffebld_constant_real2 (ffebld_conter (l)),
+				 ffebld_constant_real2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_gt_real3 (&val,
+				  ffebld_constant_real3 (ffebld_conter (l)),
+				 ffebld_constant_real3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  error = ffetarget_gt_character1 (&val,
+			     ffebld_constant_character1 (ffebld_conter (l)),
+			    ffebld_constant_character1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (FFEINFO_basictypeLOGICAL,
+		    FFEINFO_kindtypeLOGICALDEFAULT,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_le -- Collapse le expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_le(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_le (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  bool val;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_le_integer1 (&val,
+			       ffebld_constant_integer1 (ffebld_conter (l)),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_le_integer2 (&val,
+			       ffebld_constant_integer2 (ffebld_conter (l)),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_le_integer3 (&val,
+			       ffebld_constant_integer3 (ffebld_conter (l)),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_le_integer4 (&val,
+			       ffebld_constant_integer4 (ffebld_conter (l)),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_le_real1 (&val,
+				  ffebld_constant_real1 (ffebld_conter (l)),
+				 ffebld_constant_real1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_le_real2 (&val,
+				  ffebld_constant_real2 (ffebld_conter (l)),
+				 ffebld_constant_real2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_le_real3 (&val,
+				  ffebld_constant_real3 (ffebld_conter (l)),
+				 ffebld_constant_real3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  error = ffetarget_le_character1 (&val,
+			     ffebld_constant_character1 (ffebld_conter (l)),
+			    ffebld_constant_character1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (FFEINFO_basictypeLOGICAL,
+		    FFEINFO_kindtypeLOGICALDEFAULT,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_lt -- Collapse lt expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_lt(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_lt (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  bool val;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_lt_integer1 (&val,
+			       ffebld_constant_integer1 (ffebld_conter (l)),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_lt_integer2 (&val,
+			       ffebld_constant_integer2 (ffebld_conter (l)),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_lt_integer3 (&val,
+			       ffebld_constant_integer3 (ffebld_conter (l)),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_lt_integer4 (&val,
+			       ffebld_constant_integer4 (ffebld_conter (l)),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeREAL:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okREAL1
+	case FFEINFO_kindtypeREAL1:
+	  error = ffetarget_lt_real1 (&val,
+				  ffebld_constant_real1 (ffebld_conter (l)),
+				 ffebld_constant_real1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL2
+	case FFEINFO_kindtypeREAL2:
+	  error = ffetarget_lt_real2 (&val,
+				  ffebld_constant_real2 (ffebld_conter (l)),
+				 ffebld_constant_real2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+#if FFETARGET_okREAL3
+	case FFEINFO_kindtypeREAL3:
+	  error = ffetarget_lt_real3 (&val,
+				  ffebld_constant_real3 (ffebld_conter (l)),
+				 ffebld_constant_real3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad real kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  error = ffetarget_lt_character1 (&val,
+			     ffebld_constant_character1 (ffebld_conter (l)),
+			    ffebld_constant_character1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig
+	    (ffebld_constant_new_logicaldefault (val), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (FFEINFO_basictypeLOGICAL,
+		    FFEINFO_kindtypeLOGICALDEFAULT,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_and -- Collapse and expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_and(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_and (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  ffebldConstantUnion u;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_and_integer1 (ffebld_cu_ptr_integer1 (u),
+			       ffebld_constant_integer1 (ffebld_conter (l)),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+					(ffebld_cu_val_integer1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_and_integer2 (ffebld_cu_ptr_integer2 (u),
+			       ffebld_constant_integer2 (ffebld_conter (l)),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+					(ffebld_cu_val_integer2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_and_integer3 (ffebld_cu_ptr_integer3 (u),
+			       ffebld_constant_integer3 (ffebld_conter (l)),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+					(ffebld_cu_val_integer3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_and_integer4 (ffebld_cu_ptr_integer4 (u),
+			       ffebld_constant_integer4 (ffebld_conter (l)),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+					(ffebld_cu_val_integer4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  error = ffetarget_and_logical1 (ffebld_cu_ptr_logical1 (u),
+			       ffebld_constant_logical1 (ffebld_conter (l)),
+			      ffebld_constant_logical1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
+					(ffebld_cu_val_logical1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  error = ffetarget_and_logical2 (ffebld_cu_ptr_logical2 (u),
+			       ffebld_constant_logical2 (ffebld_conter (l)),
+			      ffebld_constant_logical2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
+					(ffebld_cu_val_logical2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  error = ffetarget_and_logical3 (ffebld_cu_ptr_logical3 (u),
+			       ffebld_constant_logical3 (ffebld_conter (l)),
+			      ffebld_constant_logical3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
+					(ffebld_cu_val_logical3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  error = ffetarget_and_logical4 (ffebld_cu_ptr_logical4 (u),
+			       ffebld_constant_logical4 (ffebld_conter (l)),
+			      ffebld_constant_logical4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
+					(ffebld_cu_val_logical4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad logical kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_or -- Collapse or expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_or(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_or (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  ffebldConstantUnion u;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_or_integer1 (ffebld_cu_ptr_integer1 (u),
+			       ffebld_constant_integer1 (ffebld_conter (l)),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+					(ffebld_cu_val_integer1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_or_integer2 (ffebld_cu_ptr_integer2 (u),
+			       ffebld_constant_integer2 (ffebld_conter (l)),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+					(ffebld_cu_val_integer2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_or_integer3 (ffebld_cu_ptr_integer3 (u),
+			       ffebld_constant_integer3 (ffebld_conter (l)),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+					(ffebld_cu_val_integer3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_or_integer4 (ffebld_cu_ptr_integer4 (u),
+			       ffebld_constant_integer4 (ffebld_conter (l)),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+					(ffebld_cu_val_integer4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  error = ffetarget_or_logical1 (ffebld_cu_ptr_logical1 (u),
+			       ffebld_constant_logical1 (ffebld_conter (l)),
+			      ffebld_constant_logical1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
+					(ffebld_cu_val_logical1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  error = ffetarget_or_logical2 (ffebld_cu_ptr_logical2 (u),
+			       ffebld_constant_logical2 (ffebld_conter (l)),
+			      ffebld_constant_logical2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
+					(ffebld_cu_val_logical2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  error = ffetarget_or_logical3 (ffebld_cu_ptr_logical3 (u),
+			       ffebld_constant_logical3 (ffebld_conter (l)),
+			      ffebld_constant_logical3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
+					(ffebld_cu_val_logical3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  error = ffetarget_or_logical4 (ffebld_cu_ptr_logical4 (u),
+			       ffebld_constant_logical4 (ffebld_conter (l)),
+			      ffebld_constant_logical4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
+					(ffebld_cu_val_logical4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad logical kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_xor -- Collapse xor expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_xor(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_xor (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  ffebldConstantUnion u;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_xor_integer1 (ffebld_cu_ptr_integer1 (u),
+			       ffebld_constant_integer1 (ffebld_conter (l)),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+					(ffebld_cu_val_integer1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_xor_integer2 (ffebld_cu_ptr_integer2 (u),
+			       ffebld_constant_integer2 (ffebld_conter (l)),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+					(ffebld_cu_val_integer2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_xor_integer3 (ffebld_cu_ptr_integer3 (u),
+			       ffebld_constant_integer3 (ffebld_conter (l)),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+					(ffebld_cu_val_integer3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_xor_integer4 (ffebld_cu_ptr_integer4 (u),
+			       ffebld_constant_integer4 (ffebld_conter (l)),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+					(ffebld_cu_val_integer4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  error = ffetarget_xor_logical1 (ffebld_cu_ptr_logical1 (u),
+			       ffebld_constant_logical1 (ffebld_conter (l)),
+			      ffebld_constant_logical1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
+					(ffebld_cu_val_logical1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  error = ffetarget_xor_logical2 (ffebld_cu_ptr_logical2 (u),
+			       ffebld_constant_logical2 (ffebld_conter (l)),
+			      ffebld_constant_logical2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
+					(ffebld_cu_val_logical2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  error = ffetarget_xor_logical3 (ffebld_cu_ptr_logical3 (u),
+			       ffebld_constant_logical3 (ffebld_conter (l)),
+			      ffebld_constant_logical3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
+					(ffebld_cu_val_logical3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  error = ffetarget_xor_logical4 (ffebld_cu_ptr_logical4 (u),
+			       ffebld_constant_logical4 (ffebld_conter (l)),
+			      ffebld_constant_logical4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
+					(ffebld_cu_val_logical4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad logical kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_eqv -- Collapse eqv expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_eqv(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_eqv (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  ffebldConstantUnion u;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_eqv_integer1 (ffebld_cu_ptr_integer1 (u),
+			       ffebld_constant_integer1 (ffebld_conter (l)),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+					(ffebld_cu_val_integer1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_eqv_integer2 (ffebld_cu_ptr_integer2 (u),
+			       ffebld_constant_integer2 (ffebld_conter (l)),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+					(ffebld_cu_val_integer2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_eqv_integer3 (ffebld_cu_ptr_integer3 (u),
+			       ffebld_constant_integer3 (ffebld_conter (l)),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+					(ffebld_cu_val_integer3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_eqv_integer4 (ffebld_cu_ptr_integer4 (u),
+			       ffebld_constant_integer4 (ffebld_conter (l)),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+					(ffebld_cu_val_integer4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  error = ffetarget_eqv_logical1 (ffebld_cu_ptr_logical1 (u),
+			       ffebld_constant_logical1 (ffebld_conter (l)),
+			      ffebld_constant_logical1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
+					(ffebld_cu_val_logical1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  error = ffetarget_eqv_logical2 (ffebld_cu_ptr_logical2 (u),
+			       ffebld_constant_logical2 (ffebld_conter (l)),
+			      ffebld_constant_logical2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
+					(ffebld_cu_val_logical2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  error = ffetarget_eqv_logical3 (ffebld_cu_ptr_logical3 (u),
+			       ffebld_constant_logical3 (ffebld_conter (l)),
+			      ffebld_constant_logical3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
+					(ffebld_cu_val_logical3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  error = ffetarget_eqv_logical4 (ffebld_cu_ptr_logical4 (u),
+			       ffebld_constant_logical4 (ffebld_conter (l)),
+			      ffebld_constant_logical4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
+					(ffebld_cu_val_logical4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad logical kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_neqv -- Collapse neqv expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_neqv(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_neqv (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  ffebldConstantUnion u;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+  if (ffebld_op (r) != FFEBLD_opCONTER)
+    return expr;
+
+  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeINTEGER:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okINTEGER1
+	case FFEINFO_kindtypeINTEGER1:
+	  error = ffetarget_neqv_integer1 (ffebld_cu_ptr_integer1 (u),
+			       ffebld_constant_integer1 (ffebld_conter (l)),
+			      ffebld_constant_integer1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
+					(ffebld_cu_val_integer1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER2
+	case FFEINFO_kindtypeINTEGER2:
+	  error = ffetarget_neqv_integer2 (ffebld_cu_ptr_integer2 (u),
+			       ffebld_constant_integer2 (ffebld_conter (l)),
+			      ffebld_constant_integer2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
+					(ffebld_cu_val_integer2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER3
+	case FFEINFO_kindtypeINTEGER3:
+	  error = ffetarget_neqv_integer3 (ffebld_cu_ptr_integer3 (u),
+			       ffebld_constant_integer3 (ffebld_conter (l)),
+			      ffebld_constant_integer3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
+					(ffebld_cu_val_integer3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okINTEGER4
+	case FFEINFO_kindtypeINTEGER4:
+	  error = ffetarget_neqv_integer4 (ffebld_cu_ptr_integer4 (u),
+			       ffebld_constant_integer4 (ffebld_conter (l)),
+			      ffebld_constant_integer4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
+					(ffebld_cu_val_integer4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad integer kind type" == NULL);
+	  break;
+	}
+      break;
+
+    case FFEINFO_basictypeLOGICAL:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okLOGICAL1
+	case FFEINFO_kindtypeLOGICAL1:
+	  error = ffetarget_neqv_logical1 (ffebld_cu_ptr_logical1 (u),
+			       ffebld_constant_logical1 (ffebld_conter (l)),
+			      ffebld_constant_logical1 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
+					(ffebld_cu_val_logical1 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL2
+	case FFEINFO_kindtypeLOGICAL2:
+	  error = ffetarget_neqv_logical2 (ffebld_cu_ptr_logical2 (u),
+			       ffebld_constant_logical2 (ffebld_conter (l)),
+			      ffebld_constant_logical2 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
+					(ffebld_cu_val_logical2 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL3
+	case FFEINFO_kindtypeLOGICAL3:
+	  error = ffetarget_neqv_logical3 (ffebld_cu_ptr_logical3 (u),
+			       ffebld_constant_logical3 (ffebld_conter (l)),
+			      ffebld_constant_logical3 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
+					(ffebld_cu_val_logical3 (u)), expr);
+	  break;
+#endif
+
+#if FFETARGET_okLOGICAL4
+	case FFEINFO_kindtypeLOGICAL4:
+	  error = ffetarget_neqv_logical4 (ffebld_cu_ptr_logical4 (u),
+			       ffebld_constant_logical4 (ffebld_conter (l)),
+			      ffebld_constant_logical4 (ffebld_conter (r)));
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
+					(ffebld_cu_val_logical4 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad logical kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    FFETARGET_charactersizeNONE));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_collapse_symter -- Collapse symter expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_symter(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_symter (ffebld expr, ffelexToken t UNUSED)
+{
+  ffebld r;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  ffetargetCharacterSize len;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  if ((r = ffesymbol_init (ffebld_symter (expr))) == NULL)
+    return expr;		/* A PARAMETER lhs in progress. */
+
+  switch (ffebld_op (r))
+    {
+    case FFEBLD_opCONTER:
+      break;
+
+    case FFEBLD_opANY:
+      return r;
+
+    default:
+      return expr;
+    }
+
+  bt = ffeinfo_basictype (ffebld_info (r));
+  kt = ffeinfo_kindtype (ffebld_info (r));
+  len = ffebld_size (r);
+
+  expr = ffebld_new_conter_with_orig (ffebld_constant_copy (ffebld_conter (r)),
+				      expr);
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (bt,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    len));
+
+  return expr;
+}
+
+/* ffeexpr_collapse_funcref -- Collapse funcref expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_funcref(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_funcref (ffebld expr, ffelexToken t UNUSED)
+{
+  return expr;			/* ~~someday go ahead and collapse these,
+				   though not required */
+}
+
+/* ffeexpr_collapse_arrayref -- Collapse arrayref expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_arrayref(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_arrayref (ffebld expr, ffelexToken t UNUSED)
+{
+  return expr;
+}
+
+/* ffeexpr_collapse_substr -- Collapse substr expr
+
+   ffebld expr;
+   ffelexToken token;
+   expr = ffeexpr_collapse_substr(expr,token);
+
+   If the result of the expr is a constant, replaces the expr with the
+   computed constant.  */
+
+ffebld
+ffeexpr_collapse_substr (ffebld expr, ffelexToken t)
+{
+  ffebad error = FFEBAD;
+  ffebld l;
+  ffebld r;
+  ffebld start;
+  ffebld stop;
+  ffebldConstantUnion u;
+  ffeinfoKindtype kt;
+  ffetargetCharacterSize len;
+  ffetargetIntegerDefault first;
+  ffetargetIntegerDefault last;
+
+  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
+    return expr;
+
+  l = ffebld_left (expr);
+  r = ffebld_right (expr);	/* opITEM. */
+
+  if (ffebld_op (l) != FFEBLD_opCONTER)
+    return expr;
+
+  kt = ffeinfo_kindtype (ffebld_info (l));
+  len = ffebld_size (l);
+
+  start = ffebld_head (r);
+  stop = ffebld_head (ffebld_trail (r));
+  if (start == NULL)
+    first = 1;
+  else
+    {
+      if ((ffebld_op (start) != FFEBLD_opCONTER)
+	  || (ffeinfo_basictype (ffebld_info (start)) != FFEINFO_basictypeINTEGER)
+	  || (ffeinfo_kindtype (ffebld_info (start))
+	      != FFEINFO_kindtypeINTEGERDEFAULT))
+	return expr;
+      first = ffebld_constant_integerdefault (ffebld_conter (start));
+    }
+  if (stop == NULL)
+    last = len;
+  else
+    {
+      if ((ffebld_op (stop) != FFEBLD_opCONTER)
+      || (ffeinfo_basictype (ffebld_info (stop)) != FFEINFO_basictypeINTEGER)
+	  || (ffeinfo_kindtype (ffebld_info (stop))
+	      != FFEINFO_kindtypeINTEGERDEFAULT))
+	return expr;
+      last = ffebld_constant_integerdefault (ffebld_conter (stop));
+    }
+
+  /* Handle problems that should have already been diagnosed, but
+     left in the expression tree.  */
+
+  if (first <= 0)
+    first = 1;
+  if (last < first)
+    last = first + len - 1;
+
+  if ((first == 1) && (last == len))
+    {				/* Same as original. */
+      expr = ffebld_new_conter_with_orig (ffebld_constant_copy
+					  (ffebld_conter (l)), expr);
+      ffebld_set_info (expr, ffeinfo_new
+		       (FFEINFO_basictypeCHARACTER,
+			kt,
+			0,
+			FFEINFO_kindENTITY,
+			FFEINFO_whereCONSTANT,
+			len));
+
+      return expr;
+    }
+
+  switch (ffeinfo_basictype (ffebld_info (expr)))
+    {
+    case FFEINFO_basictypeANY:
+      return expr;
+
+    case FFEINFO_basictypeCHARACTER:
+      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
+	{
+#if FFETARGET_okCHARACTER1
+	case FFEINFO_kindtypeCHARACTER1:
+	  error = ffetarget_substr_character1 (ffebld_cu_ptr_character1 (u),
+		ffebld_constant_character1 (ffebld_conter (l)), first, last,
+				   ffebld_constant_pool (), &len);
+	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_character1_val
+				      (ffebld_cu_val_character1 (u)), expr);
+	  break;
+#endif
+
+	default:
+	  assert ("bad character kind type" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad type" == NULL);
+      return expr;
+    }
+
+  ffebld_set_info (expr, ffeinfo_new
+		   (FFEINFO_basictypeCHARACTER,
+		    kt,
+		    0,
+		    FFEINFO_kindENTITY,
+		    FFEINFO_whereCONSTANT,
+		    len));
+
+  if ((error != FFEBAD)
+      && ffebad_start (error))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  return expr;
+}
+
+/* ffeexpr_convert -- Convert source expression to given type
+
+   ffebld source;
+   ffelexToken source_token;
+   ffelexToken dest_token;  // Any appropriate token for "destination".
+   ffeinfoBasictype bt;
+   ffeinfoKindtype kt;
+   ffetargetCharactersize sz;
+   ffeexprContext context;  // Mainly LET or DATA.
+   source = ffeexpr_convert(source,source_token,dest_token,bt,kt,sz,context);
+
+   If the expression conforms, returns the source expression.  Otherwise
+   returns source wrapped in a convert node doing the conversion, or
+   ANY wrapped in convert if there is a conversion error (and issues an
+   error message).  Be sensitive to the context for certain aspects of
+   the conversion.  */
+
+ffebld
+ffeexpr_convert (ffebld source, ffelexToken source_token, ffelexToken dest_token,
+		 ffeinfoBasictype bt, ffeinfoKindtype kt, ffeinfoRank rk,
+		 ffetargetCharacterSize sz, ffeexprContext context)
+{
+  bool bad;
+  ffeinfo info;
+  ffeinfoWhere wh;
+
+  info = ffebld_info (source);
+  if ((bt != ffeinfo_basictype (info))
+      || (kt != ffeinfo_kindtype (info))
+      || (rk != 0)		/* Can't convert from or to arrays yet. */
+      || (ffeinfo_rank (info) != 0)
+      || (sz != ffebld_size_known (source)))
+#if 0	/* Nobody seems to need this spurious CONVERT node. */
+      || ((context != FFEEXPR_contextLET)
+	  && (bt == FFEINFO_basictypeCHARACTER)
+	  && (sz == FFETARGET_charactersizeNONE)))
+#endif
+    {
+      switch (ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  switch (bt)
+	    {
+	    case FFEINFO_basictypeLOGICAL:
+	      bad = FALSE;
+	      break;
+
+	    case FFEINFO_basictypeINTEGER:
+	      bad = !ffe_is_ugly_logint ();
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      bad = ffe_is_pedantic ()
+		|| !(ffe_is_ugly_init ()
+		     && (context == FFEEXPR_contextDATA));
+	      break;
+
+	    default:
+	      bad = TRUE;
+	      break;
+	    }
+	  break;
+
+	case FFEINFO_basictypeINTEGER:
+	  switch (bt)
+	    {
+	    case FFEINFO_basictypeINTEGER:
+	    case FFEINFO_basictypeREAL:
+	    case FFEINFO_basictypeCOMPLEX:
+	      bad = FALSE;
+	      break;
+
+	    case FFEINFO_basictypeLOGICAL:
+	      bad = !ffe_is_ugly_logint ();
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      bad = ffe_is_pedantic ()
+		|| !(ffe_is_ugly_init ()
+		     && (context == FFEEXPR_contextDATA));
+	      break;
+
+	    default:
+	      bad = TRUE;
+	      break;
+	    }
+	  break;
+
+	case FFEINFO_basictypeREAL:
+	case FFEINFO_basictypeCOMPLEX:
+	  switch (bt)
+	    {
+	    case FFEINFO_basictypeINTEGER:
+	    case FFEINFO_basictypeREAL:
+	    case FFEINFO_basictypeCOMPLEX:
+	      bad = FALSE;
+	      break;
+
+	    case FFEINFO_basictypeCHARACTER:
+	      bad = TRUE;
+	      break;
+
+	    default:
+	      bad = TRUE;
+	      break;
+	    }
+	  break;
+
+	case FFEINFO_basictypeCHARACTER:
+	  bad = (bt != FFEINFO_basictypeCHARACTER)
+	    && (ffe_is_pedantic ()
+		|| (bt != FFEINFO_basictypeINTEGER)
+		|| !(ffe_is_ugly_init ()
+		     && (context == FFEEXPR_contextDATA)));
+	  break;
+
+	case FFEINFO_basictypeTYPELESS:
+	case FFEINFO_basictypeHOLLERITH:
+	  bad = ffe_is_pedantic ()
+	    || !(ffe_is_ugly_init ()
+		 && ((context == FFEEXPR_contextDATA)
+		     || (context == FFEEXPR_contextLET)));
+	  break;
+
+	default:
+	  bad = TRUE;
+	  break;
+	}
+
+      if (!bad && ((rk != 0) || (ffeinfo_rank (info) != 0)))
+	bad = TRUE;
+
+      if (bad && (bt != FFEINFO_basictypeANY) && (kt != FFEINFO_kindtypeANY)
+	  && (ffeinfo_basictype (info) != FFEINFO_basictypeANY)
+	  && (ffeinfo_kindtype (info) != FFEINFO_kindtypeANY)
+	  && (ffeinfo_where (info) != FFEINFO_whereANY))
+	{
+	  if (ffebad_start (FFEBAD_BAD_TYPES))
+	    {
+	      if (dest_token == NULL)
+		ffebad_here (0, ffewhere_line_unknown (),
+			     ffewhere_column_unknown ());
+	      else
+		ffebad_here (0, ffelex_token_where_line (dest_token),
+			     ffelex_token_where_column (dest_token));
+	      assert (source_token != NULL);
+	      ffebad_here (1, ffelex_token_where_line (source_token),
+			   ffelex_token_where_column (source_token));
+	      ffebad_finish ();
+	    }
+
+	  source = ffebld_new_any ();
+	  ffebld_set_info (source, ffeinfo_new_any ());
+	}
+      else
+	{
+	  switch (ffeinfo_where (info))
+	    {
+	    case FFEINFO_whereCONSTANT:
+	      wh = FFEINFO_whereCONSTANT;
+	      break;
+
+	    case FFEINFO_whereIMMEDIATE:
+	      wh = FFEINFO_whereIMMEDIATE;
+	      break;
+
+	    default:
+	      wh = FFEINFO_whereFLEETING;
+	      break;
+	    }
+	  source = ffebld_new_convert (source);
+	  ffebld_set_info (source, ffeinfo_new
+			   (bt,
+			    kt,
+			    0,
+			    FFEINFO_kindENTITY,
+			    wh,
+			    sz));
+	  source = ffeexpr_collapse_convert (source, source_token);
+	}
+    }
+
+  return source;
+}
+
+/* ffeexpr_convert_expr -- Convert source expr to conform to dest expr
+
+   ffebld source;
+   ffebld dest;
+   ffelexToken source_token;
+   ffelexToken dest_token;
+   ffeexprContext context;
+   source = ffeexpr_convert_expr(source,source_token,dest,dest_token,context);
+
+   If the expressions conform, returns the source expression.  Otherwise
+   returns source wrapped in a convert node doing the conversion, or
+   ANY wrapped in convert if there is a conversion error (and issues an
+   error message).  Be sensitive to the context, such as LET or DATA.  */
+
+ffebld
+ffeexpr_convert_expr (ffebld source, ffelexToken source_token, ffebld dest,
+		      ffelexToken dest_token, ffeexprContext context)
+{
+  ffeinfo info;
+
+  info = ffebld_info (dest);
+  return ffeexpr_convert (source, source_token, dest_token,
+			  ffeinfo_basictype (info),
+			  ffeinfo_kindtype (info),
+			  ffeinfo_rank (info),
+			  ffebld_size_known (dest),
+			  context);
+}
+
+/* ffeexpr_convert_to_sym -- Convert source expression to conform to symbol
+
+   ffebld source;
+   ffesymbol dest;
+   ffelexToken source_token;
+   ffelexToken dest_token;
+   source = ffeexpr_convert_to_sym(source,source_token,dest,dest_token);
+
+   If the expressions conform, returns the source expression.  Otherwise
+   returns source wrapped in a convert node doing the conversion, or
+   ANY wrapped in convert if there is a conversion error (and issues an
+   error message).  */
+
+ffebld
+ffeexpr_convert_to_sym (ffebld source, ffelexToken source_token,
+			ffesymbol dest, ffelexToken dest_token)
+{
+  return ffeexpr_convert (source, source_token, dest_token, ffesymbol_basictype (dest),
+    ffesymbol_kindtype (dest), ffesymbol_rank (dest), ffesymbol_size (dest),
+			  FFEEXPR_contextLET);
+}
+
+/* Initializes the module.  */
+
+void
+ffeexpr_init_2 (void)
+{
+  ffeexpr_stack_ = NULL;
+  ffeexpr_level_ = 0;
+}
+
+/* ffeexpr_lhs -- Begin processing left-hand-side-context expression
+
+   Prepares cluster for delivery of lexer tokens representing an expression
+   in a left-hand-side context (A in A=B, for example).	 ffebld is used
+   to build expressions in the given pool.  The appropriate lexer-token
+   handling routine within ffeexpr is returned.	 When the end of the
+   expression is detected, mycallbackroutine is called with the resulting
+   single ffebld object specifying the entire expression and the first
+   lexer token that is not considered part of the expression.  This caller-
+   supplied routine itself returns a lexer-token handling routine.  Thus,
+   if necessary, ffeexpr can return several tokens as end-of-expression
+   tokens if it needs to scan forward more than one in any instance.  */
+
+ffelexHandler
+ffeexpr_lhs (mallocPool pool, ffeexprContext context, ffeexprCallback callback)
+{
+  ffeexprStack_ s;
+
+  ffebld_pool_push (pool);
+  s = malloc_new_ks (ffe_pool_program_unit (), "FFEEXPR stack", sizeof (*s));
+  s->previous = ffeexpr_stack_;
+  s->pool = pool;
+  s->context = context;
+  s->callback = callback;
+  s->first_token = NULL;
+  s->exprstack = NULL;
+  s->is_rhs = FALSE;
+  ffeexpr_stack_ = s;
+  return (ffelexHandler) ffeexpr_token_first_lhs_;
+}
+
+/* ffeexpr_rhs -- Begin processing right-hand-side-context expression
+
+   return ffeexpr_rhs(malloc_pool_image(),mycallbackroutine);  // to lexer.
+
+   Prepares cluster for delivery of lexer tokens representing an expression
+   in a right-hand-side context (B in A=B, for example).  ffebld is used
+   to build expressions in the given pool.  The appropriate lexer-token
+   handling routine within ffeexpr is returned.	 When the end of the
+   expression is detected, mycallbackroutine is called with the resulting
+   single ffebld object specifying the entire expression and the first
+   lexer token that is not considered part of the expression.  This caller-
+   supplied routine itself returns a lexer-token handling routine.  Thus,
+   if necessary, ffeexpr can return several tokens as end-of-expression
+   tokens if it needs to scan forward more than one in any instance.  */
+
+ffelexHandler
+ffeexpr_rhs (mallocPool pool, ffeexprContext context, ffeexprCallback callback)
+{
+  ffeexprStack_ s;
+
+  ffebld_pool_push (pool);
+  s = malloc_new_ks (ffe_pool_program_unit (), "FFEEXPR stack", sizeof (*s));
+  s->previous = ffeexpr_stack_;
+  s->pool = pool;
+  s->context = context;
+  s->callback = callback;
+  s->first_token = NULL;
+  s->exprstack = NULL;
+  s->is_rhs = TRUE;
+  ffeexpr_stack_ = s;
+  return (ffelexHandler) ffeexpr_token_first_rhs_;
+}
+
+/* ffeexpr_cb_close_paren_ -- OPEN_PAREN expr
+
+   Pass it to ffeexpr_rhs as the callback routine.
+
+   Makes sure the end token is close-paren and swallows it, else issues
+   an error message and doesn't swallow the token (passing it along instead).
+   In either case wraps up subexpression construction by enclosing the
+   ffebld expression in a paren.  */
+
+static ffelexHandler
+ffeexpr_cb_close_paren_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  ffeexprExpr_ e;
+
+  if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
+    {
+      /* Oops, naughty user didn't specify the close paren! */
+
+      if (ffest_ffebad_start (FFEBAD_MISSING_CLOSE_PAREN))
+	{
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+		       ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+	  ffebad_finish ();
+	}
+
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeOPERAND_;
+      e->u.operand = ffebld_new_any ();
+      ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+      ffeexpr_exprstack_push_operand_ (e);
+
+      return
+	(ffelexHandler) ffeexpr_find_close_paren_ (t,
+						   (ffelexHandler)
+						   ffeexpr_token_binary_);
+    }
+
+  if (expr->op == FFEBLD_opIMPDO)
+    {
+      if (ffest_ffebad_start (FFEBAD_IMPDO_PAREN))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+		       ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+	  ffebad_finish ();
+	}
+    }
+  else
+    {
+      expr = ffebld_new_paren (expr);
+      ffebld_set_info (expr, ffeinfo_use (ffebld_info (ffebld_left (expr))));
+    }
+
+  /* Now push the (parenthesized) expression as an operand onto the
+     expression stack. */
+
+  e = ffeexpr_expr_new_ ();
+  e->type = FFEEXPR_exprtypeOPERAND_;
+  e->u.operand = expr;
+  e->u.operand = ffeexpr_collapse_paren (e->u.operand, ft);
+  e->token = ffeexpr_stack_->tokens[0];
+  ffeexpr_exprstack_push_operand_ (e);
+
+  return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_cb_close_paren_ambig_ -- OPEN_PAREN expr
+
+   Pass it to ffeexpr_rhs as the callback routine.
+
+   We get here in the READ/BACKEND/ENDFILE/REWIND case "READ(expr)"
+   with the next token in t.  If the next token is possibly a binary
+   operator, continue processing the outer expression.	If the next
+   token is COMMA, then the expression is a unit specifier, and
+   parentheses should not be added to it because it surrounds the
+   I/O control list that starts with the unit specifier (and continues
+   on from here -- we haven't seen the CLOSE_PAREN that matches the
+   OPEN_PAREN, it is up to the callback function to expect to see it
+   at some point).  In this case, we notify the callback function that
+   the COMMA is inside, not outside, the parens by wrapping the expression
+   in an opITEM (with a NULL trail) -- the callback function presumably
+   unwraps it after seeing this kludgey indicator.
+
+   If the next token is CLOSE_PAREN, then we go to the _1_ state to
+   decide what to do with the token after that.
+
+   15-Feb-91  JCB  1.1
+      Use an extra state for the CLOSE_PAREN case to make READ &co really
+      work right.  */
+
+static ffelexHandler
+ffeexpr_cb_close_paren_ambig_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  ffeexprCallback callback;
+  ffeexprStack_ s;
+
+  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+    {				/* Need to see the next token before we
+				   decide anything. */
+      ffeexpr_stack_->expr = expr;
+      ffeexpr_tokens_[0] = ffelex_token_use (ft);
+      ffeexpr_tokens_[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_cb_close_paren_ambig_1_;
+    }
+
+  expr = ffeexpr_finished_ambig_ (ft, expr);
+
+  /* Let the callback function handle the case where t isn't COMMA. */
+
+  /* Here is a kludge whereby we tell the callback function the OPEN_PAREN
+     that preceded the expression starts a list of expressions, and the expr
+     hasn't been wrapped in a corresponding (and possibly collapsed) opPAREN
+     node.  The callback function should extract the real expr from the head
+     of this opITEM node after testing it. */
+
+  expr = ffebld_new_item (expr, NULL);
+
+  ffebld_pool_pop ();
+  callback = ffeexpr_stack_->callback;
+  ffelex_token_kill (ffeexpr_stack_->first_token);
+  s = ffeexpr_stack_->previous;
+  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_, sizeof (*ffeexpr_stack_));
+  ffeexpr_stack_ = s;
+  return (ffelexHandler) (*callback) (ft, expr, t);
+}
+
+/* ffeexpr_cb_close_paren_ambig_1_ -- OPEN_PAREN expr CLOSE_PAREN
+
+   See ffeexpr_cb_close_paren_ambig_.
+
+   We get here in the READ/BACKEND/ENDFILE/REWIND case "READ(expr)"
+   with the next token in t.  If the next token is possibly a binary
+   operator, continue processing the outer expression.	If the next
+   token is COMMA, the expression is a parenthesized format specifier.
+   If the next token is not EOS or SEMICOLON, then because it is not a
+   binary operator (it is NAME, OPEN_PAREN, &c), the expression is
+   a unit specifier, and parentheses should not be added to it because
+   they surround the I/O control list that consists of only the unit
+   specifier.  If the next token is EOS or SEMICOLON, the statement
+   must be disambiguated by looking at the type of the expression -- a
+   character expression is a parenthesized format specifier, while a
+   non-character expression is a unit specifier.
+
+   Another issue is how to do the callback so the recipient of the
+   next token knows how to handle it if it is a COMMA.	In all other
+   cases, disambiguation is straightforward: the same approach as the
+   above is used.
+
+   EXTENSION: in COMMA case, if not pedantic, use same disambiguation
+   as for EOS/SEMICOLON case; f2c allows "READ (cilist) [[,]iolist]"
+   and apparently other compilers do, as well, and some code out there
+   uses this "feature".
+
+   19-Feb-91  JCB  1.1
+      Extend to allow COMMA as nondisambiguating by itself.  Remember
+      to not try and check info field for opSTAR, since that expr doesn't
+      have a valid info field.	*/
+
+static ffelexHandler
+ffeexpr_cb_close_paren_ambig_1_ (ffelexToken t)
+{
+  ffeexprCallback callback;
+  ffeexprStack_ s;
+  ffelexHandler next;
+  ffelexToken orig_ft = ffeexpr_tokens_[0];	/* In case callback clobbers
+						   these. */
+  ffelexToken orig_t = ffeexpr_tokens_[1];
+  ffebld expr = ffeexpr_stack_->expr;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:	/* Subexpr is parenthesized format specifier. */
+      if (ffe_is_pedantic ())
+	goto pedantic_comma;	/* :::::::::::::::::::: */
+      /* Fall through. */
+    case FFELEX_typeEOS:	/* Ambiguous; use type of expr to
+				   disambiguate. */
+    case FFELEX_typeSEMICOLON:
+      if ((expr == NULL) || (ffebld_op (expr) == FFEBLD_opANY)
+	  || (ffebld_op (expr) == FFEBLD_opSTAR)
+	  || (ffeinfo_basictype (ffebld_info (expr))
+	      != FFEINFO_basictypeCHARACTER))
+	break;			/* Not a valid CHARACTER entity, can't be a
+				   format spec. */
+      /* Fall through. */
+    default:			/* Binary op (we assume; error otherwise);
+				   format specifier. */
+
+    pedantic_comma:		/* :::::::::::::::::::: */
+
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextFILENUMAMBIG:
+	  ffeexpr_stack_->context = FFEEXPR_contextFILENUM;
+	  break;
+
+	case FFEEXPR_contextFILEUNITAMBIG:
+	  ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
+	  break;
+
+	default:
+	  assert ("bad context" == NULL);
+	  break;
+	}
+
+      ffeexpr_stack_->tokens[0] = ffelex_token_use (ffeexpr_stack_->first_token);
+      next = (ffelexHandler) ffeexpr_cb_close_paren_ (orig_ft, expr, orig_t);
+      ffelex_token_kill (orig_ft);
+      ffelex_token_kill (orig_t);
+      return (ffelexHandler) (*next) (t);
+
+    case FFELEX_typeOPEN_PAREN:/* Non-binary op; beginning of I/O list. */
+    case FFELEX_typeNAME:
+      break;
+    }
+
+  expr = ffeexpr_finished_ambig_ (orig_ft, expr);
+
+  /* Here is a kludge whereby we tell the callback function the OPEN_PAREN
+     that preceded the expression starts a list of expressions, and the expr
+     hasn't been wrapped in a corresponding (and possibly collapsed) opPAREN
+     node.  The callback function should extract the real expr from the head
+     of this opITEM node after testing it. */
+
+  expr = ffebld_new_item (expr, NULL);
+
+  ffebld_pool_pop ();
+  callback = ffeexpr_stack_->callback;
+  ffelex_token_kill (ffeexpr_stack_->first_token);
+  s = ffeexpr_stack_->previous;
+  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_, sizeof (*ffeexpr_stack_));
+  ffeexpr_stack_ = s;
+  next = (ffelexHandler) (*callback) (orig_ft, expr, orig_t);
+  ffelex_token_kill (orig_ft);
+  ffelex_token_kill (orig_t);
+  return (ffelexHandler) (*next) (t);
+}
+
+/* ffeexpr_cb_close_paren_c_ -- OPEN_PAREN expr (possible complex)
+
+   Pass it to ffeexpr_rhs as the callback routine.
+
+   Makes sure the end token is close-paren and swallows it, or a comma
+   and handles complex/implied-do possibilities, else issues
+   an error message and doesn't swallow the token (passing it along instead).  */
+
+static ffelexHandler
+ffeexpr_cb_close_paren_c_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  /* First check to see if this is a possible complex entity.  It is if the
+     token is a comma. */
+
+  if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+    {
+      ffeexpr_stack_->tokens[1] = ffelex_token_use (ft);
+      ffeexpr_stack_->expr = expr;
+      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+				FFEEXPR_contextPAREN_, ffeexpr_cb_comma_c_);
+    }
+
+  return (ffelexHandler) ffeexpr_cb_close_paren_ (ft, expr, t);
+}
+
+/* ffeexpr_cb_comma_c_ -- OPEN_PAREN expr COMMA expr
+
+   Pass it to ffeexpr_rhs as the callback routine.
+
+   If this token is not a comma, we have a complex constant (or an attempt
+   at one), so handle it accordingly, displaying error messages if the token
+   is not a close-paren.  */
+
+static ffelexHandler
+ffeexpr_cb_comma_c_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  ffeexprExpr_ e;
+  ffeinfoBasictype lty = (ffeexpr_stack_->expr == NULL)
+    ? FFEINFO_basictypeNONE : ffeinfo_basictype (ffebld_info (ffeexpr_stack_->expr));
+  ffeinfoBasictype rty = (expr == NULL)
+    ? FFEINFO_basictypeNONE : ffeinfo_basictype (ffebld_info (expr));
+  ffeinfoKindtype lkt;
+  ffeinfoKindtype rkt;
+  ffeinfoKindtype nkt;
+  bool ok = TRUE;
+  ffebld orig;
+
+  if ((ffeexpr_stack_->expr == NULL)
+      || (ffebld_op (ffeexpr_stack_->expr) != FFEBLD_opCONTER)
+      || (((orig = ffebld_conter_orig (ffeexpr_stack_->expr)) != NULL)
+	  && (((ffebld_op (orig) != FFEBLD_opUMINUS)
+	       && (ffebld_op (orig) != FFEBLD_opUPLUS))
+	      || (ffebld_conter_orig (ffebld_left (orig)) != NULL)))
+      || ((lty != FFEINFO_basictypeINTEGER)
+	  && (lty != FFEINFO_basictypeREAL)))
+    {
+      if ((lty != FFEINFO_basictypeANY)
+	  && ffebad_start (FFEBAD_INVALID_COMPLEX_PART))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[1]),
+		     ffelex_token_where_column (ffeexpr_stack_->tokens[1]));
+	  ffebad_string ("Real");
+	  ffebad_finish ();
+	}
+      ok = FALSE;
+    }
+  if ((expr == NULL)
+      || (ffebld_op (expr) != FFEBLD_opCONTER)
+      || (((orig = ffebld_conter_orig (expr)) != NULL)
+	  && (((ffebld_op (orig) != FFEBLD_opUMINUS)
+	       && (ffebld_op (orig) != FFEBLD_opUPLUS))
+	      || (ffebld_conter_orig (ffebld_left (orig)) != NULL)))
+      || ((rty != FFEINFO_basictypeINTEGER)
+	  && (rty != FFEINFO_basictypeREAL)))
+    {
+      if ((rty != FFEINFO_basictypeANY)
+	  && ffebad_start (FFEBAD_INVALID_COMPLEX_PART))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ft),
+		       ffelex_token_where_column (ft));
+	  ffebad_string ("Imaginary");
+	  ffebad_finish ();
+	}
+      ok = FALSE;
+    }
+
+  ffelex_token_kill (ffeexpr_stack_->tokens[1]);
+
+  /* Push the (parenthesized) expression as an operand onto the expression
+     stack. */
+
+  e = ffeexpr_expr_new_ ();
+  e->type = FFEEXPR_exprtypeOPERAND_;
+  e->token = ffeexpr_stack_->tokens[0];
+
+  if (ok)
+    {
+      if (lty == FFEINFO_basictypeINTEGER)
+	lkt = FFEINFO_kindtypeREALDEFAULT;
+      else
+	lkt = ffeinfo_kindtype (ffebld_info (ffeexpr_stack_->expr));
+      if (rty == FFEINFO_basictypeINTEGER)
+	rkt = FFEINFO_kindtypeREALDEFAULT;
+      else
+	rkt = ffeinfo_kindtype (ffebld_info (expr));
+
+      nkt = ffeinfo_kindtype_max (FFEINFO_basictypeCOMPLEX, lkt, rkt);
+      ffeexpr_stack_->expr = ffeexpr_convert (ffeexpr_stack_->expr,
+		       ffeexpr_stack_->tokens[1], ffeexpr_stack_->tokens[0],
+		 FFEINFO_basictypeREAL, nkt, 0, FFETARGET_charactersizeNONE,
+					      FFEEXPR_contextLET);
+      expr = ffeexpr_convert (expr,
+		       ffeexpr_stack_->tokens[1], ffeexpr_stack_->tokens[0],
+		 FFEINFO_basictypeREAL, nkt, 0, FFETARGET_charactersizeNONE,
+			      FFEEXPR_contextLET);
+    }
+  else
+    nkt = FFEINFO_kindtypeANY;
+
+  switch (nkt)
+    {
+#if FFETARGET_okCOMPLEX1
+    case FFEINFO_kindtypeREAL1:
+      e->u.operand = ffebld_new_conter (ffebld_constant_new_complex1
+	      (ffebld_conter (ffeexpr_stack_->expr), ffebld_conter (expr)));
+      ffebld_set_info (e->u.operand,
+		       ffeinfo_new (FFEINFO_basictypeCOMPLEX, nkt, 0,
+				  FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+				    FFETARGET_charactersizeNONE));
+      break;
+#endif
+
+#if FFETARGET_okCOMPLEX2
+    case FFEINFO_kindtypeREAL2:
+      e->u.operand = ffebld_new_conter (ffebld_constant_new_complex2
+	      (ffebld_conter (ffeexpr_stack_->expr), ffebld_conter (expr)));
+      ffebld_set_info (e->u.operand,
+		       ffeinfo_new (FFEINFO_basictypeCOMPLEX, nkt, 0,
+				  FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+				    FFETARGET_charactersizeNONE));
+      break;
+#endif
+
+#if FFETARGET_okCOMPLEX3
+    case FFEINFO_kindtypeREAL3:
+      e->u.operand = ffebld_new_conter (ffebld_constant_new_complex3
+	      (ffebld_conter (ffeexpr_stack_->expr), ffebld_conter (expr)));
+      ffebld_set_info (e->u.operand,
+		       ffeinfo_new (FFEINFO_basictypeCOMPLEX, nkt, 0,
+				  FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+				    FFETARGET_charactersizeNONE));
+      break;
+#endif
+
+    default:
+      if (ffebad_start ((nkt == FFEINFO_kindtypeREALDOUBLE)
+			? FFEBAD_BAD_DBLCMPLX : FFEBAD_BAD_COMPLEX))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+		     ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+	  ffebad_finish ();
+	}
+      /* Fall through. */
+    case FFEINFO_kindtypeANY:
+      e->u.operand = ffebld_new_any ();
+      ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+      break;
+    }
+  ffeexpr_exprstack_push_operand_ (e);
+
+  /* Now, if the token is a close parenthese, we're in great shape so return
+     the next handler. */
+
+  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+    return (ffelexHandler) ffeexpr_token_binary_;
+
+  /* Oops, naughty user didn't specify the close paren! */
+
+  if (ffest_ffebad_start (FFEBAD_MISSING_CLOSE_PAREN))
+    {
+      ffebad_here (0, ffelex_token_where_line (t),
+		   ffelex_token_where_column (t));
+      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+		   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+      ffebad_finish ();
+    }
+
+  return
+    (ffelexHandler) ffeexpr_find_close_paren_ (t,
+					       (ffelexHandler)
+					       ffeexpr_token_binary_);
+}
+
+/* ffeexpr_cb_close_paren_ci_ -- OPEN_PAREN expr (possible complex or
+				    implied-DO construct)
+
+   Pass it to ffeexpr_rhs as the callback routine.
+
+   Makes sure the end token is close-paren and swallows it, or a comma
+   and handles complex/implied-do possibilities, else issues
+   an error message and doesn't swallow the token (passing it along instead).  */
+
+static ffelexHandler
+ffeexpr_cb_close_paren_ci_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  ffeexprContext ctx;
+
+  /* First check to see if this is a possible complex or implied-DO entity.
+     It is if the token is a comma. */
+
+  if (ffelex_token_type (t) == FFELEX_typeCOMMA)
+    {
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextIOLIST:
+	case FFEEXPR_contextIMPDOITEM_:
+	  ctx = FFEEXPR_contextIMPDOITEM_;
+	  break;
+
+	case FFEEXPR_contextIOLISTDF:
+	case FFEEXPR_contextIMPDOITEMDF_:
+	  ctx = FFEEXPR_contextIMPDOITEMDF_;
+	  break;
+
+	default:
+	  assert ("bad context" == NULL);
+	  ctx = FFEEXPR_contextIMPDOITEM_;
+	  break;
+	}
+
+      ffeexpr_stack_->tokens[0] = ffelex_token_use (ft);
+      ffeexpr_stack_->expr = expr;
+      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					  ctx, ffeexpr_cb_comma_ci_);
+    }
+
+  ffeexpr_stack_->tokens[0] = ffelex_token_use (ffeexpr_stack_->first_token);
+  return (ffelexHandler) ffeexpr_cb_close_paren_ (ft, expr, t);
+}
+
+/* ffeexpr_cb_comma_ci_ -- OPEN_PAREN expr COMMA expr
+
+   Pass it to ffeexpr_rhs as the callback routine.
+
+   If this token is not a comma, we have a complex constant (or an attempt
+   at one), so handle it accordingly, displaying error messages if the token
+   is not a close-paren.  If we have a comma here, it is an attempt at an
+   implied-DO, so start making a list accordingly.  Oh, it might be an
+   equal sign also, meaning an implied-DO with only one item in its list.  */
+
+static ffelexHandler
+ffeexpr_cb_comma_ci_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  ffebld fexpr;
+
+  /* First check to see if this is a possible complex constant.	 It is if the
+     token is not a comma or an equals sign, in which case it should be a
+     close-paren. */
+
+  if ((ffelex_token_type (t) != FFELEX_typeCOMMA)
+      && (ffelex_token_type (t) != FFELEX_typeEQUALS))
+    {
+      ffeexpr_stack_->tokens[1] = ffeexpr_stack_->tokens[0];
+      ffeexpr_stack_->tokens[0] = ffelex_token_use (ffeexpr_stack_->first_token);
+      return (ffelexHandler) ffeexpr_cb_comma_c_ (ft, expr, t);
+    }
+
+  /* Here we have either EQUALS or COMMA, meaning we are in an implied-DO
+     construct.	 Make a list and handle accordingly. */
+
+  ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+  fexpr = ffeexpr_stack_->expr;
+  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+  ffebld_append_item (&ffeexpr_stack_->bottom, fexpr);
+  return (ffelexHandler) ffeexpr_cb_comma_i_1_ (ft, expr, t);
+}
+
+/* ffeexpr_cb_comma_i_ -- OPEN_PAREN expr
+
+   Pass it to ffeexpr_rhs as the callback routine.
+
+   Handle first item in an implied-DO construct.  */
+
+static ffelexHandler
+ffeexpr_cb_comma_i_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typeCOMMA)
+    {
+      if (ffest_ffebad_start (FFEBAD_BAD_IMPDO))
+	{
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
+		   ffelex_token_where_column (ffeexpr_stack_->first_token));
+	  ffebad_finish ();
+	}
+      ffebld_end_list (&ffeexpr_stack_->bottom);
+      ffeexpr_stack_->expr = ffebld_new_any ();
+      ffebld_set_info (ffeexpr_stack_->expr, ffeinfo_new_any ());
+      if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
+	return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t);
+      return (ffelexHandler) ffeexpr_cb_comma_i_5_;
+    }
+
+  return (ffelexHandler) ffeexpr_cb_comma_i_1_ (ft, expr, t);
+}
+
+/* ffeexpr_cb_comma_i_1_ -- OPEN_PAREN expr
+
+   Pass it to ffeexpr_rhs as the callback routine.
+
+   Handle first item in an implied-DO construct.  */
+
+static ffelexHandler
+ffeexpr_cb_comma_i_1_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  ffeexprContext ctxi;
+  ffeexprContext ctxc;
+
+  switch (ffeexpr_stack_->context)
+    {
+    case FFEEXPR_contextDATA:
+    case FFEEXPR_contextDATAIMPDOITEM_:
+      ctxi = FFEEXPR_contextDATAIMPDOITEM_;
+      ctxc = FFEEXPR_contextDATAIMPDOCTRL_;
+      break;
+
+    case FFEEXPR_contextIOLIST:
+    case FFEEXPR_contextIMPDOITEM_:
+      ctxi = FFEEXPR_contextIMPDOITEM_;
+      ctxc = FFEEXPR_contextIMPDOCTRL_;
+      break;
+
+    case FFEEXPR_contextIOLISTDF:
+    case FFEEXPR_contextIMPDOITEMDF_:
+      ctxi = FFEEXPR_contextIMPDOITEMDF_;
+      ctxc = FFEEXPR_contextIMPDOCTRL_;
+      break;
+
+    default:
+      assert ("bad context" == NULL);
+      ctxi = FFEEXPR_context;
+      ctxc = FFEEXPR_context;
+      break;
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+      if (ffeexpr_stack_->is_rhs)
+	return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					    ctxi, ffeexpr_cb_comma_i_1_);
+      return (ffelexHandler) ffeexpr_lhs (ffeexpr_stack_->pool,
+					  ctxi, ffeexpr_cb_comma_i_1_);
+
+    case FFELEX_typeEQUALS:
+      ffebld_end_list (&ffeexpr_stack_->bottom);
+
+      /* Complain if implied-DO variable in list of items to be read.  */
+
+      if ((ctxc == FFEEXPR_contextIMPDOCTRL_) && !ffeexpr_stack_->is_rhs)
+	ffeexpr_check_impdo_ (ffeexpr_stack_->expr,
+			      ffeexpr_stack_->first_token, expr, ft);
+
+      /* Set doiter flag for all appropriate SYMTERs.  */
+
+      ffeexpr_update_impdo_ (ffeexpr_stack_->expr, expr);
+
+      ffeexpr_stack_->expr = ffebld_new_impdo (ffeexpr_stack_->expr, NULL);
+      ffebld_set_info (ffeexpr_stack_->expr,
+		       ffeinfo_new (FFEINFO_basictypeNONE,
+				    FFEINFO_kindtypeNONE,
+				    0,
+				    FFEINFO_kindNONE,
+				    FFEINFO_whereNONE,
+				    FFETARGET_charactersizeNONE));
+      ffebld_init_list (&(ffebld_right (ffeexpr_stack_->expr)),
+			&ffeexpr_stack_->bottom);
+      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					  ctxc, ffeexpr_cb_comma_i_2_);
+
+    default:
+      if (ffest_ffebad_start (FFEBAD_BAD_IMPDO))
+	{
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
+		   ffelex_token_where_column (ffeexpr_stack_->first_token));
+	  ffebad_finish ();
+	}
+      ffebld_end_list (&ffeexpr_stack_->bottom);
+      ffeexpr_stack_->expr = ffebld_new_any ();
+      ffebld_set_info (ffeexpr_stack_->expr, ffeinfo_new_any ());
+      if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
+	return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t);
+      return (ffelexHandler) ffeexpr_cb_comma_i_5_;
+    }
+}
+
+/* ffeexpr_cb_comma_i_2_ -- OPEN_PAREN expr-list EQUALS expr
+
+   Pass it to ffeexpr_rhs as the callback routine.
+
+   Handle start-value in an implied-DO construct.  */
+
+static ffelexHandler
+ffeexpr_cb_comma_i_2_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+  ffeexprContext ctx;
+
+  switch (ffeexpr_stack_->context)
+    {
+    case FFEEXPR_contextDATA:
+    case FFEEXPR_contextDATAIMPDOITEM_:
+      ctx = FFEEXPR_contextDATAIMPDOCTRL_;
+      break;
+
+    case FFEEXPR_contextIOLIST:
+    case FFEEXPR_contextIOLISTDF:
+    case FFEEXPR_contextIMPDOITEM_:
+    case FFEEXPR_contextIMPDOITEMDF_:
+      ctx = FFEEXPR_contextIMPDOCTRL_;
+      break;
+
+    default:
+      assert ("bad context" == NULL);
+      ctx = FFEEXPR_context;
+      break;
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					  ctx, ffeexpr_cb_comma_i_3_);
+      break;
+
+    default:
+      if (ffest_ffebad_start (FFEBAD_BAD_IMPDO))
+	{
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
+		   ffelex_token_where_column (ffeexpr_stack_->first_token));
+	  ffebad_finish ();
+	}
+      ffebld_end_list (&ffeexpr_stack_->bottom);
+      ffeexpr_stack_->expr = ffebld_new_any ();
+      ffebld_set_info (ffeexpr_stack_->expr, ffeinfo_new_any ());
+      if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
+	return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t);
+      return (ffelexHandler) ffeexpr_cb_comma_i_5_;
+    }
+}
+
+/* ffeexpr_cb_comma_i_3_ -- OPEN_PAREN expr-list EQUALS expr COMMA expr
+
+   Pass it to ffeexpr_rhs as the callback routine.
+
+   Handle end-value in an implied-DO construct.	 */
+
+static ffelexHandler
+ffeexpr_cb_comma_i_3_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+  ffeexprContext ctx;
+
+  switch (ffeexpr_stack_->context)
+    {
+    case FFEEXPR_contextDATA:
+    case FFEEXPR_contextDATAIMPDOITEM_:
+      ctx = FFEEXPR_contextDATAIMPDOCTRL_;
+      break;
+
+    case FFEEXPR_contextIOLIST:
+    case FFEEXPR_contextIOLISTDF:
+    case FFEEXPR_contextIMPDOITEM_:
+    case FFEEXPR_contextIMPDOITEMDF_:
+      ctx = FFEEXPR_contextIMPDOCTRL_;
+      break;
+
+    default:
+      assert ("bad context" == NULL);
+      ctx = FFEEXPR_context;
+      break;
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					  ctx, ffeexpr_cb_comma_i_4_);
+      break;
+
+    case FFELEX_typeCLOSE_PAREN:
+      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+      return (ffelexHandler) ffeexpr_cb_comma_i_4_ (NULL, NULL, t);
+      break;
+
+    default:
+      if (ffest_ffebad_start (FFEBAD_BAD_IMPDO))
+	{
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
+		   ffelex_token_where_column (ffeexpr_stack_->first_token));
+	  ffebad_finish ();
+	}
+      ffebld_end_list (&ffeexpr_stack_->bottom);
+      ffeexpr_stack_->expr = ffebld_new_any ();
+      ffebld_set_info (ffeexpr_stack_->expr, ffeinfo_new_any ());
+      if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
+	return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t);
+      return (ffelexHandler) ffeexpr_cb_comma_i_5_;
+    }
+}
+
+/* ffeexpr_cb_comma_i_4_ -- OPEN_PAREN expr-list EQUALS expr COMMA expr
+			       [COMMA expr]
+
+   Pass it to ffeexpr_rhs as the callback routine.
+
+   Handle incr-value in an implied-DO construct.  */
+
+static ffelexHandler
+ffeexpr_cb_comma_i_4_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCLOSE_PAREN:
+      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+      ffebld_end_list (&ffeexpr_stack_->bottom);
+      {
+	ffebld item;
+
+	for (item = ffebld_left (ffeexpr_stack_->expr);
+	     item != NULL;
+	     item = ffebld_trail (item))
+	  if (ffebld_op (ffebld_head (item)) == FFEBLD_opANY)
+	    goto replace_with_any;	/* :::::::::::::::::::: */
+
+	for (item = ffebld_right (ffeexpr_stack_->expr);
+	     item != NULL;
+	     item = ffebld_trail (item))
+	  if ((ffebld_head (item) != NULL)	/* Increment may be NULL. */
+	      && (ffebld_op (ffebld_head (item)) == FFEBLD_opANY))
+	    goto replace_with_any;	/* :::::::::::::::::::: */
+      }
+      break;
+
+    default:
+      if (ffest_ffebad_start (FFEBAD_BAD_IMPDO))
+	{
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
+		   ffelex_token_where_column (ffeexpr_stack_->first_token));
+	  ffebad_finish ();
+	}
+      ffebld_end_list (&ffeexpr_stack_->bottom);
+
+    replace_with_any:		/* :::::::::::::::::::: */
+
+      ffeexpr_stack_->expr = ffebld_new_any ();
+      ffebld_set_info (ffeexpr_stack_->expr, ffeinfo_new_any ());
+      break;
+    }
+
+  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+    return (ffelexHandler) ffeexpr_cb_comma_i_5_;
+  return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t);
+}
+
+/* ffeexpr_cb_comma_i_5_ -- OPEN_PAREN expr-list EQUALS expr COMMA expr
+			       [COMMA expr] CLOSE_PAREN
+
+   Pass it to ffeexpr_rhs as the callback routine.
+
+   Collects token following implied-DO construct for callback function.	 */
+
+static ffelexHandler
+ffeexpr_cb_comma_i_5_ (ffelexToken t)
+{
+  ffeexprCallback callback;
+  ffeexprStack_ s;
+  ffelexHandler next;
+  ffelexToken ft;
+  ffebld expr;
+  bool terminate;
+
+  switch (ffeexpr_stack_->context)
+    {
+    case FFEEXPR_contextDATA:
+    case FFEEXPR_contextDATAIMPDOITEM_:
+      terminate = TRUE;
+      break;
+
+    case FFEEXPR_contextIOLIST:
+    case FFEEXPR_contextIOLISTDF:
+    case FFEEXPR_contextIMPDOITEM_:
+    case FFEEXPR_contextIMPDOITEMDF_:
+      terminate = FALSE;
+      break;
+
+    default:
+      assert ("bad context" == NULL);
+      terminate = FALSE;
+      break;
+    }
+
+  ffebld_pool_pop ();
+  callback = ffeexpr_stack_->callback;
+  ft = ffeexpr_stack_->first_token;
+  expr = ffeexpr_stack_->expr;
+  s = ffeexpr_stack_->previous;
+  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_,
+		  sizeof (*ffeexpr_stack_));
+  ffeexpr_stack_ = s;
+  next = (ffelexHandler) (*callback) (ft, expr, t);
+  ffelex_token_kill (ft);
+  if (terminate)
+    {
+      ffesymbol_drive_sfnames (ffeexpr_check_impctrl_);
+      --ffeexpr_level_;
+      if (ffeexpr_level_ == 0)
+	ffe_terminate_4 ();
+    }
+  return (ffelexHandler) next;
+}
+
+/* ffeexpr_cb_end_loc_ -- Handle end of %LOC subexpression
+
+   Makes sure the end token is close-paren and swallows it, else issues
+   an error message and doesn't swallow the token (passing it along instead).
+   In either case wraps up subexpression construction by enclosing the
+   ffebld expression in a %LOC.	 */
+
+static ffelexHandler
+ffeexpr_cb_end_loc_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
+{
+  ffeexprExpr_ e;
+
+  /* First push the (%LOC) expression as an operand onto the expression
+     stack. */
+
+  e = ffeexpr_expr_new_ ();
+  e->type = FFEEXPR_exprtypeOPERAND_;
+  e->token = ffeexpr_stack_->tokens[0];
+  e->u.operand = ffebld_new_percent_loc (expr);
+  ffebld_set_info (e->u.operand,
+		   ffeinfo_new (FFEINFO_basictypeINTEGER,
+				ffecom_pointer_kind (),
+				0,
+				FFEINFO_kindENTITY,
+				FFEINFO_whereFLEETING,
+				FFETARGET_charactersizeNONE));
+#if 0				/* ~~ */
+  e->u.operand = ffeexpr_collapse_percent_loc (e->u.operand, ft);
+#endif
+  ffeexpr_exprstack_push_operand_ (e);
+
+  /* Now, if the token is a close parenthese, we're in great shape so return
+     the next handler. */
+
+  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+    {
+      ffelex_token_kill (ffeexpr_stack_->tokens[1]);
+      return (ffelexHandler) ffeexpr_token_binary_;
+    }
+
+  /* Oops, naughty user didn't specify the close paren! */
+
+  if (ffest_ffebad_start (FFEBAD_MISSING_CLOSE_PAREN))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[1]),
+		   ffelex_token_where_column (ffeexpr_stack_->tokens[1]));
+      ffebad_finish ();
+    }
+
+  ffelex_token_kill (ffeexpr_stack_->tokens[1]);
+  return
+    (ffelexHandler) ffeexpr_find_close_paren_ (t,
+					       (ffelexHandler)
+					       ffeexpr_token_binary_);
+}
+
+/* ffeexpr_cb_end_notloc_ -- PERCENT NAME(VAL,REF,DESCR) OPEN_PAREN expr
+
+   Should be CLOSE_PAREN, and make sure expr isn't a %(VAL,REF,DESCR).  */
+
+static ffelexHandler
+ffeexpr_cb_end_notloc_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  ffeexprExpr_ e;
+  ffebldOp op;
+
+  /* If expression is itself a %(VAL,REF,DESCR), complain and strip off all
+     such things until the lowest-level expression is reached.  */
+
+  op = ffebld_op (expr);
+  if ((op == FFEBLD_opPERCENT_VAL) || (op == FFEBLD_opPERCENT_REF)
+      || (op == FFEBLD_opPERCENT_DESCR))
+    {
+      if (ffebad_start (FFEBAD_NESTED_PERCENT))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ft),
+		       ffelex_token_where_column (ft));
+	  ffebad_finish ();
+	}
+
+      do
+	{
+	  expr = ffebld_left (expr);
+	  op = ffebld_op (expr);
+	}
+      while ((op == FFEBLD_opPERCENT_VAL) || (op == FFEBLD_opPERCENT_REF)
+	     || (op == FFEBLD_opPERCENT_DESCR));
+    }
+
+  /* Push the expression as an operand onto the expression stack. */
+
+  e = ffeexpr_expr_new_ ();
+  e->type = FFEEXPR_exprtypeOPERAND_;
+  e->token = ffeexpr_stack_->tokens[0];
+  switch (ffeexpr_stack_->percent)
+    {
+    case FFEEXPR_percentVAL_:
+      e->u.operand = ffebld_new_percent_val (expr);
+      break;
+
+    case FFEEXPR_percentREF_:
+      e->u.operand = ffebld_new_percent_ref (expr);
+      break;
+
+    case FFEEXPR_percentDESCR_:
+      e->u.operand = ffebld_new_percent_descr (expr);
+      break;
+
+    default:
+      assert ("%lossage" == NULL);
+      e->u.operand = expr;
+      break;
+    }
+  ffebld_set_info (e->u.operand, ffebld_info (expr));
+#if 0				/* ~~ */
+  e->u.operand = ffeexpr_collapse_percent_ ? ? ? (e->u.operand, ft);
+#endif
+  ffeexpr_exprstack_push_operand_ (e);
+
+  /* Now, if the token is a close parenthese, we're in great shape so return
+     the next handler. */
+
+  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+    return (ffelexHandler) ffeexpr_cb_end_notloc_1_;
+
+  /* Oops, naughty user didn't specify the close paren! */
+
+  if (ffest_ffebad_start (FFEBAD_MISSING_CLOSE_PAREN))
+    {
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[1]),
+		   ffelex_token_where_column (ffeexpr_stack_->tokens[1]));
+      ffebad_finish ();
+    }
+
+  ffebld_set_op (e->u.operand, FFEBLD_opPERCENT_LOC);
+
+  switch (ffeexpr_stack_->context)
+    {
+    case FFEEXPR_contextACTUALARG_:
+      ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+      break;
+
+    case FFEEXPR_contextINDEXORACTUALARG_:
+      ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+      break;
+
+    case FFEEXPR_contextSFUNCDEFACTUALARG_:
+      ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+      break;
+
+    case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+      ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+      break;
+
+    default:
+      assert ("bad context?!?!" == NULL);
+      break;
+    }
+
+  ffelex_token_kill (ffeexpr_stack_->tokens[1]);
+  return
+    (ffelexHandler) ffeexpr_find_close_paren_ (t,
+					       (ffelexHandler)
+					       ffeexpr_cb_end_notloc_1_);
+}
+
+/* ffeexpr_cb_end_notloc_1_ -- PERCENT NAME(VAL,REF,DESCR) OPEN_PAREN expr
+   CLOSE_PAREN
+
+   Should be COMMA or CLOSE_PAREN, else change back to %LOC.  */
+
+static ffelexHandler
+ffeexpr_cb_end_notloc_1_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCLOSE_PAREN:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextACTUALARG_:
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	  break;
+
+	case FFEEXPR_contextINDEXORACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextACTUALARG_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARG_;
+	  break;
+
+	default:
+	  assert ("bad context?!?!" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      if (ffebad_start (FFEBAD_INVALID_PERCENT))
+	{
+	  ffebad_here (0,
+		       ffelex_token_where_line (ffeexpr_stack_->first_token),
+		   ffelex_token_where_column (ffeexpr_stack_->first_token));
+	  ffebad_string (ffelex_token_text (ffeexpr_stack_->tokens[1]));
+	  ffebad_finish ();
+	}
+
+      ffebld_set_op (ffeexpr_stack_->exprstack->u.operand,
+		     FFEBLD_opPERCENT_LOC);
+
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextINDEXORACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+	  break;
+
+	default:
+	  assert ("bad context?!?!" == NULL);
+	  break;
+	}
+    }
+
+  ffelex_token_kill (ffeexpr_stack_->tokens[1]);
+  return
+    (ffelexHandler) ffeexpr_token_binary_ (t);
+}
+
+/* Process DATA implied-DO iterator variables as this implied-DO level
+   terminates.  At this point, ffeexpr_level_ == 1 when we see the
+   last right-paren in "DATA (A(I),I=1,10)/.../".  */
+
+static ffesymbol
+ffeexpr_check_impctrl_ (ffesymbol s)
+{
+  assert (s != NULL);
+  assert (ffesymbol_sfdummyparent (s) != NULL);
+
+  switch (ffesymbol_state (s))
+    {
+    case FFESYMBOL_stateNONE:	/* Used as iterator already. Now let symbol
+				   be used as iterator at any level at or
+				   innermore than the outermost of the
+				   current level and the symbol's current
+				   level. */
+      if (ffeexpr_level_ < ffesymbol_maxentrynum (s))
+	{
+	  ffesymbol_signal_change (s);
+	  ffesymbol_set_maxentrynum (s, ffeexpr_level_);
+	  ffesymbol_signal_unreported (s);
+	}
+      break;
+
+    case FFESYMBOL_stateSEEN:	/* Seen already in this or other implied-DO.
+				   Error if at outermost level, else it can
+				   still become an iterator. */
+      if ((ffeexpr_level_ == 1)
+	  && ffebad_start (FFEBAD_BAD_IMPDCL))
+	{
+	  ffebad_string (ffesymbol_text (s));
+	  ffebad_here (0, ffesymbol_where_line (s), ffesymbol_where_column (s));
+	  ffebad_finish ();
+	}
+      break;
+
+    case FFESYMBOL_stateUNCERTAIN:	/* Iterator. */
+      assert (ffeexpr_level_ <= ffesymbol_maxentrynum (s));
+      ffesymbol_signal_change (s);
+      ffesymbol_set_state (s, FFESYMBOL_stateNONE);
+      ffesymbol_signal_unreported (s);
+      break;
+
+    case FFESYMBOL_stateUNDERSTOOD:
+      break;			/* ANY. */
+
+    default:
+      assert ("Sasha Foo!!" == NULL);
+      break;
+    }
+
+  return s;
+}
+
+/* Issue diagnostic if implied-DO variable appears in list of lhs
+   expressions (as in "READ *, (I,I=1,10)").  */
+
+static void
+ffeexpr_check_impdo_ (ffebld list, ffelexToken list_t,
+		      ffebld dovar, ffelexToken dovar_t)
+{
+  ffebld item;
+  ffesymbol dovar_sym;
+  int itemnum;
+
+  if (ffebld_op (dovar) != FFEBLD_opSYMTER)
+    return;			/* Presumably opANY. */
+
+  dovar_sym = ffebld_symter (dovar);
+
+  for (itemnum = 1; list != NULL; list = ffebld_trail (list), ++itemnum)
+    {
+      if (((item = ffebld_head (list)) != NULL)
+	  && (ffebld_op (item) == FFEBLD_opSYMTER)
+	  && (ffebld_symter (item) == dovar_sym))
+	{
+	  char itemno[20];
+
+	  sprintf (&itemno[0], "%d", itemnum);
+	  if (ffebad_start (FFEBAD_DOITER_IMPDO))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (list_t),
+			   ffelex_token_where_column (list_t));
+	      ffebad_here (1, ffelex_token_where_line (dovar_t),
+			   ffelex_token_where_column (dovar_t));
+	      ffebad_string (ffesymbol_text (dovar_sym));
+	      ffebad_string (itemno);
+	      ffebad_finish ();
+	    }
+	}
+    }
+}
+
+/* Decorate any SYMTERs referencing the DO variable with the "doiter"
+   flag.  */
+
+static void
+ffeexpr_update_impdo_ (ffebld list, ffebld dovar)
+{
+  ffesymbol dovar_sym;
+
+  if (ffebld_op (dovar) != FFEBLD_opSYMTER)
+    return;			/* Presumably opANY. */
+
+  dovar_sym = ffebld_symter (dovar);
+
+  ffeexpr_update_impdo_sym_ (list, dovar_sym);	/* Recurse! */
+}
+
+/* Recursive function to update any expr so SYMTERs have "doiter" flag
+   if they refer to the given variable.	 */
+
+static void
+ffeexpr_update_impdo_sym_ (ffebld expr, ffesymbol dovar)
+{
+  tail_recurse:			/* :::::::::::::::::::: */
+
+  if (expr == NULL)
+    return;
+
+  switch (ffebld_op (expr))
+    {
+    case FFEBLD_opSYMTER:
+      if (ffebld_symter (expr) == dovar)
+	ffebld_symter_set_is_doiter (expr, TRUE);
+      break;
+
+    case FFEBLD_opITEM:
+      ffeexpr_update_impdo_sym_ (ffebld_head (expr), dovar);
+      expr = ffebld_trail (expr);
+      goto tail_recurse;	/* :::::::::::::::::::: */
+
+    default:
+      break;
+    }
+
+  switch (ffebld_arity (expr))
+    {
+    case 2:
+      ffeexpr_update_impdo_sym_ (ffebld_left (expr), dovar);
+      expr = ffebld_right (expr);
+      goto tail_recurse;	/* :::::::::::::::::::: */
+
+    case 1:
+      expr = ffebld_left (expr);
+      goto tail_recurse;	/* :::::::::::::::::::: */
+
+    default:
+      break;
+    }
+
+  return;
+}
+
+/* ffeexpr_context_outer_ -- Determine context of stack entry, skipping PARENs
+
+   if (ffeexpr_context_outer_(ffeexpr_stack_) == FFEEXPR_contextIF)
+       // After zero or more PAREN_ contexts, an IF context exists  */
+
+static ffeexprContext
+ffeexpr_context_outer_ (ffeexprStack_ s)
+{
+  assert (s != NULL);
+
+  for (;;)
+    {
+      switch (s->context)
+	{
+	case FFEEXPR_contextPAREN_:
+	case FFEEXPR_contextPARENFILENUM_:
+	case FFEEXPR_contextPARENFILEUNIT_:
+	  break;
+
+	default:
+	  return s->context;
+	}
+      s = s->previous;
+      assert (s != NULL);
+    }
+}
+
+/* ffeexpr_percent_ -- Look up name in list of %FOO possibilities
+
+   ffeexprPercent_ p;
+   ffelexToken t;
+   p = ffeexpr_percent_(t);
+
+   Returns the identifier for the name, or the NONE identifier.	 */
+
+static ffeexprPercent_
+ffeexpr_percent_ (ffelexToken t)
+{
+  const char *p;
+
+  switch (ffelex_token_length (t))
+    {
+    case 3:
+      switch (*(p = ffelex_token_text (t)))
+	{
+	case FFESRC_CASE_MATCH_INIT ('L', 'l', match_3l, no_match_3):
+	  if ((ffesrc_char_match_noninit (*++p, 'O', 'o'))
+	      && (ffesrc_char_match_noninit (*++p, 'C', 'c')))
+	    return FFEEXPR_percentLOC_;
+	  return FFEEXPR_percentNONE_;
+
+	case FFESRC_CASE_MATCH_INIT ('R', 'r', match_3r, no_match_3):
+	  if ((ffesrc_char_match_noninit (*++p, 'E', 'e'))
+	      && (ffesrc_char_match_noninit (*++p, 'F', 'f')))
+	    return FFEEXPR_percentREF_;
+	  return FFEEXPR_percentNONE_;
+
+	case FFESRC_CASE_MATCH_INIT ('V', 'v', match_3v, no_match_3):
+	  if ((ffesrc_char_match_noninit (*++p, 'A', 'a'))
+	      && (ffesrc_char_match_noninit (*++p, 'L', 'l')))
+	    return FFEEXPR_percentVAL_;
+	  return FFEEXPR_percentNONE_;
+
+	default:
+	no_match_3:		/* :::::::::::::::::::: */
+	  return FFEEXPR_percentNONE_;
+	}
+
+    case 5:
+      if (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "DESCR",
+			    "descr", "Descr") == 0)
+	return FFEEXPR_percentDESCR_;
+      return FFEEXPR_percentNONE_;
+
+    default:
+      return FFEEXPR_percentNONE_;
+    }
+}
+
+/* ffeexpr_type_combine -- Binop combine types, check for mythical new COMPLEX
+
+   See prototype.
+
+   If combining the two basictype/kindtype pairs produces a COMPLEX with an
+   unsupported kind type, complain and use the default kind type for
+   COMPLEX.  */
+
+void
+ffeexpr_type_combine (ffeinfoBasictype *xnbt, ffeinfoKindtype *xnkt,
+		      ffeinfoBasictype lbt, ffeinfoKindtype lkt,
+		      ffeinfoBasictype rbt, ffeinfoKindtype rkt,
+		      ffelexToken t)
+{
+  ffeinfoBasictype nbt;
+  ffeinfoKindtype nkt;
+
+  nbt = ffeinfo_basictype_combine (lbt, rbt);
+  if ((nbt == FFEINFO_basictypeCOMPLEX)
+      && ((lbt == nbt) || (lbt == FFEINFO_basictypeREAL))
+      && ((rbt == nbt) || (rbt == FFEINFO_basictypeREAL)))
+    {
+      nkt = ffeinfo_kindtype_max (nbt, lkt, rkt);
+      if (ffe_is_pedantic_not_90 () && (nkt == FFEINFO_kindtypeREALDOUBLE))
+	nkt = FFEINFO_kindtypeNONE;	/* Force error. */
+      switch (nkt)
+	{
+#if FFETARGET_okCOMPLEX1
+	case FFEINFO_kindtypeREAL1:
+#endif
+#if FFETARGET_okCOMPLEX2
+	case FFEINFO_kindtypeREAL2:
+#endif
+#if FFETARGET_okCOMPLEX3
+	case FFEINFO_kindtypeREAL3:
+#endif
+	  break;		/* Fine and dandy. */
+
+	default:
+	  if (t != NULL)
+	    {
+	      ffebad_start ((nkt == FFEINFO_kindtypeREALDOUBLE)
+			    ? FFEBAD_BAD_DBLCMPLX : FFEBAD_BAD_COMPLEX);
+	      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	      ffebad_finish ();
+	    }
+	  nbt = FFEINFO_basictypeNONE;
+	  nkt = FFEINFO_kindtypeNONE;
+	  break;
+
+	case FFEINFO_kindtypeANY:
+	  nkt = FFEINFO_kindtypeREALDEFAULT;
+	  break;
+	}
+    }
+  else
+    {				/* The normal stuff. */
+      if (nbt == lbt)
+	{
+	  if (nbt == rbt)
+	    nkt = ffeinfo_kindtype_max (nbt, lkt, rkt);
+	  else
+	    nkt = lkt;
+	}
+      else if (nbt == rbt)
+	nkt = rkt;
+      else
+	{			/* Let the caller do the complaining. */
+	  nbt = FFEINFO_basictypeNONE;
+	  nkt = FFEINFO_kindtypeNONE;
+	}
+    }
+
+  /* Always a good idea to avoid aliasing problems.  */
+
+  *xnbt = nbt;
+  *xnkt = nkt;
+}
+
+/* ffeexpr_token_first_lhs_ -- First state for lhs expression
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Record line and column of first token in expression, then invoke the
+   initial-state lhs handler.  */
+
+static ffelexHandler
+ffeexpr_token_first_lhs_ (ffelexToken t)
+{
+  ffeexpr_stack_->first_token = ffelex_token_use (t);
+
+  /* When changing the list of valid initial lhs tokens, check whether to
+     update a corresponding list in ffeexpr_cb_close_paren_ambig_1_ for the
+     READ (expr) <token> case -- it assumes it knows which tokens <token> can
+     be to indicate an lhs (or implied DO), which right now is the set
+     {NAME,OPEN_PAREN}.
+
+     This comment also appears in ffeexpr_token_lhs_. */
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeOPEN_PAREN:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextDATA:
+	  ffe_init_4 ();
+	  ffeexpr_level_ = 1;	/* Level of DATA implied-DO construct. */
+	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+	  return (ffelexHandler) ffeexpr_lhs (ffeexpr_stack_->pool,
+			FFEEXPR_contextDATAIMPDOITEM_, ffeexpr_cb_comma_i_);
+
+	case FFEEXPR_contextDATAIMPDOITEM_:
+	  ++ffeexpr_level_;	/* Level of DATA implied-DO construct. */
+	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+	  return (ffelexHandler) ffeexpr_lhs (ffeexpr_stack_->pool,
+			FFEEXPR_contextDATAIMPDOITEM_, ffeexpr_cb_comma_i_);
+
+	case FFEEXPR_contextIOLIST:
+	case FFEEXPR_contextIMPDOITEM_:
+	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+	  return (ffelexHandler) ffeexpr_lhs (ffeexpr_stack_->pool,
+			    FFEEXPR_contextIMPDOITEM_, ffeexpr_cb_comma_i_);
+
+	case FFEEXPR_contextIOLISTDF:
+	case FFEEXPR_contextIMPDOITEMDF_:
+	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+	  return (ffelexHandler) ffeexpr_lhs (ffeexpr_stack_->pool,
+			  FFEEXPR_contextIMPDOITEMDF_, ffeexpr_cb_comma_i_);
+
+	case FFEEXPR_contextFILEEXTFUNC:
+	  assert (ffeexpr_stack_->exprstack == NULL);
+	  return (ffelexHandler) ffeexpr_token_first_lhs_1_;
+
+	default:
+	  break;
+	}
+      break;
+
+    case FFELEX_typeNAME:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextFILENAMELIST:
+	  assert (ffeexpr_stack_->exprstack == NULL);
+	  return (ffelexHandler) ffeexpr_token_namelist_;
+
+	case FFEEXPR_contextFILEEXTFUNC:
+	  assert (ffeexpr_stack_->exprstack == NULL);
+	  return (ffelexHandler) ffeexpr_token_first_lhs_1_;
+
+	default:
+	  break;
+	}
+      break;
+
+    default:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextFILEEXTFUNC:
+	  assert (ffeexpr_stack_->exprstack == NULL);
+	  return (ffelexHandler) ffeexpr_token_first_lhs_1_;
+
+	default:
+	  break;
+	}
+      break;
+    }
+
+  return (ffelexHandler) ffeexpr_token_lhs_ (t);
+}
+
+/* ffeexpr_token_first_lhs_1_ -- NAME
+
+   return ffeexpr_token_first_lhs_1_;  // to lexer
+
+   Handle NAME as an external function (USEROPEN= VXT extension to OPEN
+   statement).	*/
+
+static ffelexHandler
+ffeexpr_token_first_lhs_1_ (ffelexToken t)
+{
+  ffeexprCallback callback;
+  ffeexprStack_ s;
+  ffelexHandler next;
+  ffelexToken ft;
+  ffesymbol sy = NULL;
+  ffebld expr;
+
+  ffebld_pool_pop ();
+  callback = ffeexpr_stack_->callback;
+  ft = ffeexpr_stack_->first_token;
+  s = ffeexpr_stack_->previous;
+
+  if ((ffelex_token_type (ft) != FFELEX_typeNAME)
+      || (ffesymbol_attrs (sy = ffeexpr_declare_unadorned_ (ft, FALSE))
+	  & FFESYMBOL_attrANY))
+    {
+      if ((ffelex_token_type (ft) != FFELEX_typeNAME)
+	  || !(ffesymbol_attrs (sy) & FFESYMBOL_attrsANY))
+	{
+	  ffebad_start (FFEBAD_EXPR_WRONG);
+	  ffebad_here (0, ffelex_token_where_line (ft),
+		       ffelex_token_where_column (ft));
+	  ffebad_finish ();
+	}
+      expr = ffebld_new_any ();
+      ffebld_set_info (expr, ffeinfo_new_any ());
+    }
+  else
+    {
+      expr = ffebld_new_symter (sy, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
+				FFEINTRIN_impNONE);
+      ffebld_set_info (expr, ffesymbol_info (sy));
+    }
+
+  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_,
+		  sizeof (*ffeexpr_stack_));
+  ffeexpr_stack_ = s;
+
+  next = (ffelexHandler) (*callback) (ft, expr, t);
+  ffelex_token_kill (ft);
+  return (ffelexHandler) next;
+}
+
+/* ffeexpr_token_first_rhs_ -- First state for rhs expression
+
+   Record line and column of first token in expression, then invoke the
+   initial-state rhs handler.
+
+   19-Feb-91  JCB  1.1
+      Allow ASTERISK in PARENFILEUNIT_ case, but only on second level only
+      (i.e. only as in READ(*), not READ((*))).	 */
+
+static ffelexHandler
+ffeexpr_token_first_rhs_ (ffelexToken t)
+{
+  ffesymbol s;
+
+  ffeexpr_stack_->first_token = ffelex_token_use (t);
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeASTERISK:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextFILEFORMATNML:
+	  ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
+	  /* Fall through.  */
+	case FFEEXPR_contextFILEUNIT:
+	case FFEEXPR_contextDIMLIST:
+	case FFEEXPR_contextFILEFORMAT:
+	case FFEEXPR_contextCHARACTERSIZE:
+	  if (ffeexpr_stack_->previous != NULL)
+	    break;		/* Valid only on first level. */
+	  assert (ffeexpr_stack_->exprstack == NULL);
+	  return (ffelexHandler) ffeexpr_token_first_rhs_1_;
+
+	case FFEEXPR_contextPARENFILEUNIT_:
+	  if (ffeexpr_stack_->previous->previous != NULL)
+	    break;		/* Valid only on second level. */
+	  assert (ffeexpr_stack_->exprstack == NULL);
+	  return (ffelexHandler) ffeexpr_token_first_rhs_1_;
+
+	case FFEEXPR_contextACTUALARG_:
+	  if (ffeexpr_stack_->previous->context
+	      != FFEEXPR_contextSUBROUTINEREF)
+	    {
+	      ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+	      break;
+	    }
+	  assert (ffeexpr_stack_->exprstack == NULL);
+	  return (ffelexHandler) ffeexpr_token_first_rhs_3_;
+
+	case FFEEXPR_contextINDEXORACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+	  break;
+
+	default:
+	  break;
+	}
+      break;
+
+    case FFELEX_typeOPEN_PAREN:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextFILENUMAMBIG:
+	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					      FFEEXPR_contextPARENFILENUM_,
+					      ffeexpr_cb_close_paren_ambig_);
+
+	case FFEEXPR_contextFILEUNITAMBIG:
+	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					      FFEEXPR_contextPARENFILEUNIT_,
+					      ffeexpr_cb_close_paren_ambig_);
+
+	case FFEEXPR_contextIOLIST:
+	case FFEEXPR_contextIMPDOITEM_:
+	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					      FFEEXPR_contextIMPDOITEM_,
+					      ffeexpr_cb_close_paren_ci_);
+
+	case FFEEXPR_contextIOLISTDF:
+	case FFEEXPR_contextIMPDOITEMDF_:
+	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					      FFEEXPR_contextIMPDOITEMDF_,
+					      ffeexpr_cb_close_paren_ci_);
+
+	case FFEEXPR_contextFILEFORMATNML:
+	  ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
+	  break;
+
+	case FFEEXPR_contextACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextINDEXORACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+	  break;
+
+	default:
+	  break;
+	}
+      break;
+
+    case FFELEX_typeNUMBER:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextFILEFORMATNML:
+	  ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
+	  /* Fall through.  */
+	case FFEEXPR_contextFILEFORMAT:
+	  if (ffeexpr_stack_->previous != NULL)
+	    break;		/* Valid only on first level. */
+	  assert (ffeexpr_stack_->exprstack == NULL);
+	  return (ffelexHandler) ffeexpr_token_first_rhs_2_;
+
+	case FFEEXPR_contextACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextINDEXORACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+	  break;
+
+	default:
+	  break;
+	}
+      break;
+
+    case FFELEX_typeNAME:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextFILEFORMATNML:
+	  assert (ffeexpr_stack_->exprstack == NULL);
+	  s = ffesymbol_lookup_local (t);
+	  if ((s != NULL) && (ffesymbol_kind (s) == FFEINFO_kindNAMELIST))
+	    return (ffelexHandler) ffeexpr_token_namelist_;
+	  ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
+	  break;
+
+	default:
+	  break;
+	}
+      break;
+
+    case FFELEX_typePERCENT:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextACTUALARG_:
+	case FFEEXPR_contextINDEXORACTUALARG_:
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+	  return (ffelexHandler) ffeexpr_token_first_rhs_5_;
+
+	case FFEEXPR_contextFILEFORMATNML:
+	  ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
+	  break;
+
+	default:
+	  break;
+	}
+
+    default:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextINDEXORACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextFILEFORMATNML:
+	  ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
+	  break;
+
+	default:
+	  break;
+	}
+      break;
+    }
+
+  return (ffelexHandler) ffeexpr_token_rhs_ (t);
+}
+
+/* ffeexpr_token_first_rhs_1_ -- ASTERISK
+
+   return ffeexpr_token_first_rhs_1_;  // to lexer
+
+   Return STAR as expression.  */
+
+static ffelexHandler
+ffeexpr_token_first_rhs_1_ (ffelexToken t)
+{
+  ffebld expr;
+  ffeexprCallback callback;
+  ffeexprStack_ s;
+  ffelexHandler next;
+  ffelexToken ft;
+
+  expr = ffebld_new_star ();
+  ffebld_pool_pop ();
+  callback = ffeexpr_stack_->callback;
+  ft = ffeexpr_stack_->first_token;
+  s = ffeexpr_stack_->previous;
+  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_, sizeof (*ffeexpr_stack_));
+  ffeexpr_stack_ = s;
+  next = (ffelexHandler) (*callback) (ft, expr, t);
+  ffelex_token_kill (ft);
+  return (ffelexHandler) next;
+}
+
+/* ffeexpr_token_first_rhs_2_ -- NUMBER
+
+   return ffeexpr_token_first_rhs_2_;  // to lexer
+
+   Return NULL as expression; NUMBER as first (and only) token, unless the
+   current token is not a terminating token, in which case run normal
+   expression handling.	 */
+
+static ffelexHandler
+ffeexpr_token_first_rhs_2_ (ffelexToken t)
+{
+  ffeexprCallback callback;
+  ffeexprStack_ s;
+  ffelexHandler next;
+  ffelexToken ft;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCLOSE_PAREN:
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+      break;
+
+    default:
+      next = (ffelexHandler) ffeexpr_token_rhs_ (ffeexpr_stack_->first_token);
+      return (ffelexHandler) (*next) (t);
+    }
+
+  ffebld_pool_pop ();
+  callback = ffeexpr_stack_->callback;
+  ft = ffeexpr_stack_->first_token;
+  s = ffeexpr_stack_->previous;
+  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_,
+		  sizeof (*ffeexpr_stack_));
+  ffeexpr_stack_ = s;
+  next = (ffelexHandler) (*callback) (ft, NULL, t);
+  ffelex_token_kill (ft);
+  return (ffelexHandler) next;
+}
+
+/* ffeexpr_token_first_rhs_3_ -- ASTERISK
+
+   return ffeexpr_token_first_rhs_3_;  // to lexer
+
+   Expect NUMBER, make LABTOK (with copy of token if not inhibited after
+   confirming, else NULL).  */
+
+static ffelexHandler
+ffeexpr_token_first_rhs_3_ (ffelexToken t)
+{
+  ffelexHandler next;
+
+  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+    {				/* An error, but let normal processing handle
+				   it. */
+      next = (ffelexHandler) ffeexpr_token_rhs_ (ffeexpr_stack_->first_token);
+      return (ffelexHandler) (*next) (t);
+    }
+
+  /* Special case: when we see "*10" as an argument to a subroutine
+     reference, we confirm the current statement and, if not inhibited at
+     this point, put a copy of the token into a LABTOK node.  We do this
+     instead of just resolving the label directly via ffelab and putting it
+     into a LABTER simply to improve error reporting and consistency in
+     ffestc.  We put NULL in the LABTOK if we're still inhibited, so ffestb
+     doesn't have to worry about killing off any tokens when retracting. */
+
+  ffest_confirmed ();
+  if (ffest_is_inhibited ())
+    ffeexpr_stack_->expr = ffebld_new_labtok (NULL);
+  else
+    ffeexpr_stack_->expr = ffebld_new_labtok (ffelex_token_use (t));
+  ffebld_set_info (ffeexpr_stack_->expr,
+		   ffeinfo_new (FFEINFO_basictypeNONE,
+				FFEINFO_kindtypeNONE,
+				0,
+				FFEINFO_kindNONE,
+				FFEINFO_whereNONE,
+				FFETARGET_charactersizeNONE));
+
+  return (ffelexHandler) ffeexpr_token_first_rhs_4_;
+}
+
+/* ffeexpr_token_first_rhs_4_ -- ASTERISK NUMBER
+
+   return ffeexpr_token_first_rhs_4_;  // to lexer
+
+   Collect/flush appropriate stuff, send token to callback function.  */
+
+static ffelexHandler
+ffeexpr_token_first_rhs_4_ (ffelexToken t)
+{
+  ffebld expr;
+  ffeexprCallback callback;
+  ffeexprStack_ s;
+  ffelexHandler next;
+  ffelexToken ft;
+
+  expr = ffeexpr_stack_->expr;
+  ffebld_pool_pop ();
+  callback = ffeexpr_stack_->callback;
+  ft = ffeexpr_stack_->first_token;
+  s = ffeexpr_stack_->previous;
+  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_, sizeof (*ffeexpr_stack_));
+  ffeexpr_stack_ = s;
+  next = (ffelexHandler) (*callback) (ft, expr, t);
+  ffelex_token_kill (ft);
+  return (ffelexHandler) next;
+}
+
+/* ffeexpr_token_first_rhs_5_ -- PERCENT
+
+   Should be NAME, or pass through original mechanism.  If NAME is LOC,
+   pass through original mechanism, otherwise must be VAL, REF, or DESCR,
+   in which case handle the argument (in parentheses), etc.  */
+
+static ffelexHandler
+ffeexpr_token_first_rhs_5_ (ffelexToken t)
+{
+  ffelexHandler next;
+
+  if (ffelex_token_type (t) == FFELEX_typeNAME)
+    {
+      ffeexprPercent_ p = ffeexpr_percent_ (t);
+
+      switch (p)
+	{
+	case FFEEXPR_percentNONE_:
+	case FFEEXPR_percentLOC_:
+	  break;		/* Treat %LOC as any other expression. */
+
+	case FFEEXPR_percentVAL_:
+	case FFEEXPR_percentREF_:
+	case FFEEXPR_percentDESCR_:
+	  ffeexpr_stack_->percent = p;
+	  ffeexpr_stack_->tokens[0] = ffelex_token_use (t);
+	  return (ffelexHandler) ffeexpr_token_first_rhs_6_;
+
+	default:
+	  assert ("bad percent?!?" == NULL);
+	  break;
+	}
+    }
+
+  switch (ffeexpr_stack_->context)
+    {
+    case FFEEXPR_contextACTUALARG_:
+      ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+      break;
+
+    case FFEEXPR_contextINDEXORACTUALARG_:
+      ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+      break;
+
+    case FFEEXPR_contextSFUNCDEFACTUALARG_:
+      ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+      break;
+
+    case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+      ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+      break;
+
+    default:
+      assert ("bad context?!?!" == NULL);
+      break;
+    }
+
+  next = (ffelexHandler) ffeexpr_token_rhs_ (ffeexpr_stack_->first_token);
+  return (ffelexHandler) (*next) (t);
+}
+
+/* ffeexpr_token_first_rhs_6_ -- PERCENT NAME(VAL,REF,DESCR)
+
+   Should be OPEN_PAREN, or pass through original mechanism.  */
+
+static ffelexHandler
+ffeexpr_token_first_rhs_6_ (ffelexToken t)
+{
+  ffelexHandler next;
+  ffelexToken ft;
+
+  if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
+    {
+      ffeexpr_stack_->tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					  ffeexpr_stack_->context,
+					  ffeexpr_cb_end_notloc_);
+    }
+
+  switch (ffeexpr_stack_->context)
+    {
+    case FFEEXPR_contextACTUALARG_:
+      ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+      break;
+
+    case FFEEXPR_contextINDEXORACTUALARG_:
+      ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+      break;
+
+    case FFEEXPR_contextSFUNCDEFACTUALARG_:
+      ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+      break;
+
+    case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+      ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+      break;
+
+    default:
+      assert ("bad context?!?!" == NULL);
+      break;
+    }
+
+  ft = ffeexpr_stack_->tokens[0];
+  next = (ffelexHandler) ffeexpr_token_rhs_ (ffeexpr_stack_->first_token);
+  next = (ffelexHandler) (*next) (ft);
+  ffelex_token_kill (ft);
+  return (ffelexHandler) (*next) (t);
+}
+
+/* ffeexpr_token_namelist_ -- NAME
+
+   return ffeexpr_token_namelist_;  // to lexer
+
+   Make sure NAME was a valid namelist object, wrap it in a SYMTER and
+   return.  */
+
+static ffelexHandler
+ffeexpr_token_namelist_ (ffelexToken t)
+{
+  ffeexprCallback callback;
+  ffeexprStack_ s;
+  ffelexHandler next;
+  ffelexToken ft;
+  ffesymbol sy;
+  ffebld expr;
+
+  ffebld_pool_pop ();
+  callback = ffeexpr_stack_->callback;
+  ft = ffeexpr_stack_->first_token;
+  s = ffeexpr_stack_->previous;
+  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_, sizeof (*ffeexpr_stack_));
+  ffeexpr_stack_ = s;
+
+  sy = ffesymbol_lookup_local (ft);
+  if ((sy == NULL) || (ffesymbol_kind (sy) != FFEINFO_kindNAMELIST))
+    {
+      ffebad_start (FFEBAD_EXPR_WRONG);
+      ffebad_here (0, ffelex_token_where_line (ft),
+		   ffelex_token_where_column (ft));
+      ffebad_finish ();
+      expr = ffebld_new_any ();
+      ffebld_set_info (expr, ffeinfo_new_any ());
+    }
+  else
+    {
+      expr = ffebld_new_symter (sy, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
+				FFEINTRIN_impNONE);
+      ffebld_set_info (expr, ffesymbol_info (sy));
+    }
+  next = (ffelexHandler) (*callback) (ft, expr, t);
+  ffelex_token_kill (ft);
+  return (ffelexHandler) next;
+}
+
+/* ffeexpr_expr_kill_ -- Kill an existing internal expression object
+
+   ffeexprExpr_ e;
+   ffeexpr_expr_kill_(e);
+
+   Kills the ffewhere info, if necessary, then kills the object.  */
+
+static void
+ffeexpr_expr_kill_ (ffeexprExpr_ e)
+{
+  if (e->token != NULL)
+    ffelex_token_kill (e->token);
+  malloc_kill_ks (ffe_pool_program_unit (), e, sizeof (*e));
+}
+
+/* ffeexpr_expr_new_ -- Make a new internal expression object
+
+   ffeexprExpr_ e;
+   e = ffeexpr_expr_new_();
+
+   Allocates and initializes a new expression object, returns it.  */
+
+static ffeexprExpr_
+ffeexpr_expr_new_ (void)
+{
+  ffeexprExpr_ e;
+
+  e = malloc_new_ks (ffe_pool_program_unit (), "FFEEXPR expr", sizeof (*e));
+  e->previous = NULL;
+  e->type = FFEEXPR_exprtypeUNKNOWN_;
+  e->token = NULL;
+  return e;
+}
+
+/* Verify that call to global is valid, and register whatever
+   new information about a global might be discoverable by looking
+   at the call.  */
+
+static void
+ffeexpr_fulfill_call_ (ffebld *expr, ffelexToken t)
+{
+  int n_args;
+  ffebld list;
+  ffebld item;
+  ffesymbol s;
+
+  assert ((ffebld_op (*expr) == FFEBLD_opSUBRREF)
+	  || (ffebld_op (*expr) == FFEBLD_opFUNCREF));
+
+  if (ffebld_op (ffebld_left (*expr)) != FFEBLD_opSYMTER)
+    return;
+
+  if (ffesymbol_retractable ())
+    return;
+
+  s = ffebld_symter (ffebld_left (*expr));
+  if (ffesymbol_global (s) == NULL)
+    return;
+
+  for (n_args = 0, list = ffebld_right (*expr);
+       list != NULL;
+       list = ffebld_trail (list), ++n_args)
+    ;
+
+  if (ffeglobal_proc_ref_nargs (s, n_args, t))
+    {
+      ffeglobalArgSummary as;
+      ffeinfoBasictype bt;
+      ffeinfoKindtype kt;
+      bool array;
+      bool fail = FALSE;
+
+      for (n_args = 0, list = ffebld_right (*expr);
+	   list != NULL;
+	   list = ffebld_trail (list), ++n_args)
+	{
+	  item = ffebld_head (list);
+	  if (item != NULL)
+	    {
+	      bt = ffeinfo_basictype (ffebld_info (item));
+	      kt = ffeinfo_kindtype (ffebld_info (item));
+	      array = (ffeinfo_rank (ffebld_info (item)) > 0);
+	      switch (ffebld_op (item))
+		{
+		case FFEBLD_opLABTOK:
+		case FFEBLD_opLABTER:
+		  as = FFEGLOBAL_argsummaryALTRTN;
+		  break;
+
+#if 0
+		  /* No, %LOC(foo) is just like any INTEGER(KIND=7)
+		     expression, so don't treat it specially.  */
+		case FFEBLD_opPERCENT_LOC:
+		  as = FFEGLOBAL_argsummaryPTR;
+		  break;
+#endif
+
+		case FFEBLD_opPERCENT_VAL:
+		  as = FFEGLOBAL_argsummaryVAL;
+		  break;
+
+		case FFEBLD_opPERCENT_REF:
+		  as = FFEGLOBAL_argsummaryREF;
+		  break;
+
+		case FFEBLD_opPERCENT_DESCR:
+		  as = FFEGLOBAL_argsummaryDESCR;
+		  break;
+
+		case FFEBLD_opFUNCREF:
+#if 0
+		  /* No, LOC(foo) is just like any INTEGER(KIND=7)
+		     expression, so don't treat it specially.  */
+		  if ((ffebld_op (ffebld_left (item)) == FFEBLD_opSYMTER)
+		      && (ffesymbol_specific (ffebld_symter (ffebld_left (item)))
+			  == FFEINTRIN_specLOC))
+		    {
+		      as = FFEGLOBAL_argsummaryPTR;
+		      break;
+		    }
+#endif
+		  /* Fall through.  */
+		default:
+		  if (ffebld_op (item) == FFEBLD_opSYMTER)
+		    {
+		      as = FFEGLOBAL_argsummaryNONE;
+
+		      switch (ffeinfo_kind (ffebld_info (item)))
+			{
+			case FFEINFO_kindFUNCTION:
+			  as = FFEGLOBAL_argsummaryFUNC;
+			  break;
+
+			case FFEINFO_kindSUBROUTINE:
+			  as = FFEGLOBAL_argsummarySUBR;
+			  break;
+
+			case FFEINFO_kindNONE:
+			  as = FFEGLOBAL_argsummaryPROC;
+			  break;
+
+			default:
+			  break;
+			}
+
+		      if (as != FFEGLOBAL_argsummaryNONE)
+			break;
+		    }
+
+		  if (bt == FFEINFO_basictypeCHARACTER)
+		    as = FFEGLOBAL_argsummaryDESCR;
+		  else
+		    as = FFEGLOBAL_argsummaryREF;
+		  break;
+		}
+	    }
+	  else
+	    {
+	      array = FALSE;
+	      as = FFEGLOBAL_argsummaryNONE;
+	      bt = FFEINFO_basictypeNONE;
+	      kt = FFEINFO_kindtypeNONE;
+	    }
+
+	  if (! ffeglobal_proc_ref_arg (s, n_args, as, bt, kt, array, t))
+	    fail = TRUE;
+	}
+      if (! fail)
+	return;
+    }
+
+  *expr = ffebld_new_any ();
+  ffebld_set_info (*expr, ffeinfo_new_any ());
+}
+
+/* Check whether rest of string is all decimal digits.  */
+
+static bool
+ffeexpr_isdigits_ (const char *p)
+{
+  for (; *p != '\0'; ++p)
+    if (! ISDIGIT (*p))
+      return FALSE;
+  return TRUE;
+}
+
+/* ffeexpr_exprstack_push_ -- Push an arbitrary expression object onto the stack
+
+   ffeexprExpr_ e;
+   ffeexpr_exprstack_push_(e);
+
+   Pushes the expression onto the stack without any analysis of the existing
+   contents of the stack.  */
+
+static void
+ffeexpr_exprstack_push_ (ffeexprExpr_ e)
+{
+  e->previous = ffeexpr_stack_->exprstack;
+  ffeexpr_stack_->exprstack = e;
+}
+
+/* ffeexpr_exprstack_push_operand_ -- Push an operand onto the stack, reduce?
+
+   ffeexprExpr_ e;
+   ffeexpr_exprstack_push_operand_(e);
+
+   Pushes the expression already containing an operand (a constant, variable,
+   or more complicated expression that has already been fully resolved) after
+   analyzing the stack and checking for possible reduction (which will never
+   happen here since the highest precedence operator is ** and it has right-
+   to-left associativity).  */
+
+static void
+ffeexpr_exprstack_push_operand_ (ffeexprExpr_ e)
+{
+  ffeexpr_exprstack_push_ (e);
+}
+
+/* ffeexpr_exprstack_push_unary_ -- Push a unary operator onto the stack
+
+   ffeexprExpr_ e;
+   ffeexpr_exprstack_push_unary_(e);
+
+   Pushes the expression already containing a unary operator.  Reduction can
+   never happen since unary operators are themselves always R-L; that is, the
+   top of the expression stack is not an operand, in that it is either empty,
+   has a binary operator at the top, or a unary operator at the top.  In any
+   of these cases, reduction is impossible.  */
+
+static void
+ffeexpr_exprstack_push_unary_ (ffeexprExpr_ e)
+{
+  if ((ffe_is_pedantic ()
+       || ffe_is_warn_surprising ())
+      && (ffeexpr_stack_->exprstack != NULL)
+      && (ffeexpr_stack_->exprstack->type != FFEEXPR_exprtypeOPERAND_)
+      && (ffeexpr_stack_->exprstack->u.operator.prec
+	  <= FFEEXPR_operatorprecedenceLOWARITH_)
+      && (e->u.operator.prec <= FFEEXPR_operatorprecedenceLOWARITH_))
+    {
+      /* xgettext:no-c-format */
+      ffebad_start_msg ("Two arithmetic operators in a row at %0 and %1 -- use parentheses",
+			ffe_is_pedantic ()
+			? FFEBAD_severityPEDANTIC
+			: FFEBAD_severityWARNING);
+      ffebad_here (0,
+		  ffelex_token_where_line (ffeexpr_stack_->exprstack->token),
+	       ffelex_token_where_column (ffeexpr_stack_->exprstack->token));
+      ffebad_here (1,
+		   ffelex_token_where_line (e->token),
+		   ffelex_token_where_column (e->token));
+      ffebad_finish ();
+    }
+
+  ffeexpr_exprstack_push_ (e);
+}
+
+/* ffeexpr_exprstack_push_binary_ -- Push a binary operator onto the stack, reduce?
+
+   ffeexprExpr_ e;
+   ffeexpr_exprstack_push_binary_(e);
+
+   Pushes the expression already containing a binary operator after checking
+   whether reduction is possible.  If the stack is not empty, the top of the
+   stack must be an operand or syntactic analysis has failed somehow.  If
+   the operand is preceded by a unary operator of higher (or equal and L-R
+   associativity) precedence than the new binary operator, then reduce that
+   preceding operator and its operand(s) before pushing the new binary
+   operator.  */
+
+static void
+ffeexpr_exprstack_push_binary_ (ffeexprExpr_ e)
+{
+  ffeexprExpr_ ce;
+
+  if (ffe_is_warn_surprising ()
+      /* These next two are always true (see assertions below).  */
+      && (ffeexpr_stack_->exprstack != NULL)
+      && (ffeexpr_stack_->exprstack->type == FFEEXPR_exprtypeOPERAND_)
+      /* If the previous operator is a unary minus, and the binary op
+	 is of higher precedence, might not do what user expects,
+	 e.g. "-2**2" is "-(2**2)", i.e. "-4", not "(-2)**2", which would
+	 yield "4".  */
+      && (ffeexpr_stack_->exprstack->previous != NULL)
+      && (ffeexpr_stack_->exprstack->previous->type == FFEEXPR_exprtypeUNARY_)
+      && (ffeexpr_stack_->exprstack->previous->u.operator.op
+	  == FFEEXPR_operatorSUBTRACT_)
+      && (e->u.operator.prec
+	  < ffeexpr_stack_->exprstack->previous->u.operator.prec))
+    {
+      /* xgettext:no-c-format */
+      ffebad_start_msg ("Operator at %0 has lower precedence than that at %1 -- use parentheses", FFEBAD_severityWARNING);
+      ffebad_here (0,
+	 ffelex_token_where_line (ffeexpr_stack_->exprstack->previous->token),
+      ffelex_token_where_column (ffeexpr_stack_->exprstack->previous->token));
+      ffebad_here (1,
+		   ffelex_token_where_line (e->token),
+		   ffelex_token_where_column (e->token));
+      ffebad_finish ();
+    }
+
+again:
+  assert (ffeexpr_stack_->exprstack != NULL);
+  assert (ffeexpr_stack_->exprstack->type == FFEEXPR_exprtypeOPERAND_);
+  if ((ce = ffeexpr_stack_->exprstack->previous) != NULL)
+    {
+      assert (ce->type != FFEEXPR_exprtypeOPERAND_);
+      if ((ce->u.operator.prec < e->u.operator.prec)
+	  || ((ce->u.operator.prec == e->u.operator.prec)
+	      && (e->u.operator.as == FFEEXPR_operatorassociativityL2R_)))
+	{
+	  ffeexpr_reduce_ ();
+	  goto again;	/* :::::::::::::::::::: */
+	}
+    }
+
+  ffeexpr_exprstack_push_ (e);
+}
+
+/* ffeexpr_reduce_ -- Reduce highest operator w/operands on stack
+
+   ffeexpr_reduce_();
+
+   Converts operand binop operand or unop operand at top of stack to a
+   single operand having the appropriate ffebld expression, and makes
+   sure that the expression is proper (like not trying to add two character
+   variables, not trying to concatenate two numbers).  Also does the
+   requisite type-assignment.  */
+
+static void
+ffeexpr_reduce_ (void)
+{
+  ffeexprExpr_ operand;		/* This is B in -B or A+B. */
+  ffeexprExpr_ left_operand;	/* When operator is binary, this is A in A+B. */
+  ffeexprExpr_ operator;	/* This is + in A+B. */
+  ffebld reduced;		/* This is +(A,B) in A+B or u-(B) in -B. */
+  ffebldConstant constnode;	/* For checking magical numbers (where mag ==
+				   -mag). */
+  ffebld expr;
+  ffebld left_expr;
+  bool submag = FALSE;
+  bool bothlogical;
+
+  operand = ffeexpr_stack_->exprstack;
+  assert (operand != NULL);
+  assert (operand->type == FFEEXPR_exprtypeOPERAND_);
+  operator = operand->previous;
+  assert (operator != NULL);
+  assert (operator->type != FFEEXPR_exprtypeOPERAND_);
+  if (operator->type == FFEEXPR_exprtypeUNARY_)
+    {
+      expr = operand->u.operand;
+      switch (operator->u.operator.op)
+	{
+	case FFEEXPR_operatorADD_:
+	  reduced = ffebld_new_uplus (expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly1_ (reduced, operator, operand);
+	  reduced = ffeexpr_reduced_math1_ (reduced, operator, operand);
+	  reduced = ffeexpr_collapse_uplus (reduced, operator->token);
+	  break;
+
+	case FFEEXPR_operatorSUBTRACT_:
+	  submag = TRUE;	/* Ok to negate a magic number. */
+	  reduced = ffebld_new_uminus (expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly1_ (reduced, operator, operand);
+	  reduced = ffeexpr_reduced_math1_ (reduced, operator, operand);
+	  reduced = ffeexpr_collapse_uminus (reduced, operator->token);
+	  break;
+
+	case FFEEXPR_operatorNOT_:
+	  reduced = ffebld_new_not (expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly1log_ (reduced, operator, operand);
+	  reduced = ffeexpr_reduced_bool1_ (reduced, operator, operand);
+	  reduced = ffeexpr_collapse_not (reduced, operator->token);
+	  break;
+
+	default:
+	  assert ("unexpected unary op" != NULL);
+	  reduced = NULL;
+	  break;
+	}
+      if (!submag
+	  && (ffebld_op (expr) == FFEBLD_opCONTER)
+	  && (ffebld_conter_orig (expr) == NULL)
+	  && ffebld_constant_is_magical (constnode = ffebld_conter (expr)))
+	{
+	  ffetarget_integer_bad_magical (operand->token);
+	}
+      ffeexpr_stack_->exprstack = operator->previous;	/* Pops unary-op operand
+							   off stack. */
+      ffeexpr_expr_kill_ (operand);
+      operator->type = FFEEXPR_exprtypeOPERAND_;	/* Convert operator, but
+							   save */
+      operator->u.operand = reduced;	/* the line/column ffewhere info. */
+      ffeexpr_exprstack_push_operand_ (operator);	/* Push it back on
+							   stack. */
+    }
+  else
+    {
+      assert (operator->type == FFEEXPR_exprtypeBINARY_);
+      left_operand = operator->previous;
+      assert (left_operand != NULL);
+      assert (left_operand->type == FFEEXPR_exprtypeOPERAND_);
+      expr = operand->u.operand;
+      left_expr = left_operand->u.operand;
+      switch (operator->u.operator.op)
+	{
+	case FFEEXPR_operatorADD_:
+	  reduced = ffebld_new_add (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+					      operand);
+	  reduced = ffeexpr_reduced_math2_ (reduced, left_operand, operator,
+					    operand);
+	  reduced = ffeexpr_collapse_add (reduced, operator->token);
+	  break;
+
+	case FFEEXPR_operatorSUBTRACT_:
+	  submag = TRUE;	/* Just to pick the right error if magic
+				   number. */
+	  reduced = ffebld_new_subtract (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+					      operand);
+	  reduced = ffeexpr_reduced_math2_ (reduced, left_operand, operator,
+					    operand);
+	  reduced = ffeexpr_collapse_subtract (reduced, operator->token);
+	  break;
+
+	case FFEEXPR_operatorMULTIPLY_:
+	  reduced = ffebld_new_multiply (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+					      operand);
+	  reduced = ffeexpr_reduced_math2_ (reduced, left_operand, operator,
+					    operand);
+	  reduced = ffeexpr_collapse_multiply (reduced, operator->token);
+	  break;
+
+	case FFEEXPR_operatorDIVIDE_:
+	  reduced = ffebld_new_divide (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+					      operand);
+	  reduced = ffeexpr_reduced_math2_ (reduced, left_operand, operator,
+					    operand);
+	  reduced = ffeexpr_collapse_divide (reduced, operator->token);
+	  break;
+
+	case FFEEXPR_operatorPOWER_:
+	  reduced = ffebld_new_power (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+					      operand);
+	  reduced = ffeexpr_reduced_power_ (reduced, left_operand, operator,
+					    operand);
+	  reduced = ffeexpr_collapse_power (reduced, operator->token);
+	  break;
+
+	case FFEEXPR_operatorCONCATENATE_:
+	  reduced = ffebld_new_concatenate (left_expr, expr);
+	  reduced = ffeexpr_reduced_concatenate_ (reduced, left_operand, operator,
+						  operand);
+	  reduced = ffeexpr_collapse_concatenate (reduced, operator->token);
+	  break;
+
+	case FFEEXPR_operatorLT_:
+	  reduced = ffebld_new_lt (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+					      operand);
+	  reduced = ffeexpr_reduced_relop2_ (reduced, left_operand, operator,
+					     operand);
+	  reduced = ffeexpr_collapse_lt (reduced, operator->token);
+	  break;
+
+	case FFEEXPR_operatorLE_:
+	  reduced = ffebld_new_le (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+					      operand);
+	  reduced = ffeexpr_reduced_relop2_ (reduced, left_operand, operator,
+					     operand);
+	  reduced = ffeexpr_collapse_le (reduced, operator->token);
+	  break;
+
+	case FFEEXPR_operatorEQ_:
+	  reduced = ffebld_new_eq (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+					      operand);
+	  reduced = ffeexpr_reduced_eqop2_ (reduced, left_operand, operator,
+					    operand);
+	  reduced = ffeexpr_collapse_eq (reduced, operator->token);
+	  break;
+
+	case FFEEXPR_operatorNE_:
+	  reduced = ffebld_new_ne (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+					      operand);
+	  reduced = ffeexpr_reduced_eqop2_ (reduced, left_operand, operator,
+					    operand);
+	  reduced = ffeexpr_collapse_ne (reduced, operator->token);
+	  break;
+
+	case FFEEXPR_operatorGT_:
+	  reduced = ffebld_new_gt (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+					      operand);
+	  reduced = ffeexpr_reduced_relop2_ (reduced, left_operand, operator,
+					     operand);
+	  reduced = ffeexpr_collapse_gt (reduced, operator->token);
+	  break;
+
+	case FFEEXPR_operatorGE_:
+	  reduced = ffebld_new_ge (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
+					      operand);
+	  reduced = ffeexpr_reduced_relop2_ (reduced, left_operand, operator,
+					     operand);
+	  reduced = ffeexpr_collapse_ge (reduced, operator->token);
+	  break;
+
+	case FFEEXPR_operatorAND_:
+	  reduced = ffebld_new_and (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
+						 operand, &bothlogical);
+	  reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
+					    operand);
+	  reduced = ffeexpr_collapse_and (reduced, operator->token);
+	  if (ffe_is_ugly_logint() && bothlogical)
+	    reduced = ffeexpr_convert (reduced, left_operand->token,
+				       operator->token,
+				       FFEINFO_basictypeLOGICAL,
+				       FFEINFO_kindtypeLOGICALDEFAULT, 0,
+				       FFETARGET_charactersizeNONE,
+				       FFEEXPR_contextLET);
+	  break;
+
+	case FFEEXPR_operatorOR_:
+	  reduced = ffebld_new_or (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
+						 operand, &bothlogical);
+	  reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
+					    operand);
+	  reduced = ffeexpr_collapse_or (reduced, operator->token);
+	  if (ffe_is_ugly_logint() && bothlogical)
+	    reduced = ffeexpr_convert (reduced, left_operand->token,
+				       operator->token,
+				       FFEINFO_basictypeLOGICAL,
+				       FFEINFO_kindtypeLOGICALDEFAULT, 0,
+				       FFETARGET_charactersizeNONE,
+				       FFEEXPR_contextLET);
+	  break;
+
+	case FFEEXPR_operatorXOR_:
+	  reduced = ffebld_new_xor (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
+						 operand, &bothlogical);
+	  reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
+					    operand);
+	  reduced = ffeexpr_collapse_xor (reduced, operator->token);
+	  if (ffe_is_ugly_logint() && bothlogical)
+	    reduced = ffeexpr_convert (reduced, left_operand->token,
+				       operator->token,
+				       FFEINFO_basictypeLOGICAL,
+				       FFEINFO_kindtypeLOGICALDEFAULT, 0,
+				       FFETARGET_charactersizeNONE,
+				       FFEEXPR_contextLET);
+	  break;
+
+	case FFEEXPR_operatorEQV_:
+	  reduced = ffebld_new_eqv (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
+						 operand, NULL);
+	  reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
+					    operand);
+	  reduced = ffeexpr_collapse_eqv (reduced, operator->token);
+	  break;
+
+	case FFEEXPR_operatorNEQV_:
+	  reduced = ffebld_new_neqv (left_expr, expr);
+	  if (ffe_is_ugly_logint ())
+	    reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
+						 operand, NULL);
+	  reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
+					    operand);
+	  reduced = ffeexpr_collapse_neqv (reduced, operator->token);
+	  break;
+
+	default:
+	  assert ("bad bin op" == NULL);
+	  reduced = expr;
+	  break;
+	}
+      if ((ffebld_op (left_expr) == FFEBLD_opCONTER)
+	  && (ffebld_conter_orig (expr) == NULL)
+      && ffebld_constant_is_magical (constnode = ffebld_conter (left_expr)))
+	{
+	  if ((left_operand->previous != NULL)
+	      && (left_operand->previous->type != FFEEXPR_exprtypeOPERAND_)
+	      && (left_operand->previous->u.operator.op
+		  == FFEEXPR_operatorSUBTRACT_))
+	    {
+	      if (left_operand->previous->type == FFEEXPR_exprtypeUNARY_)
+		ffetarget_integer_bad_magical_precedence (left_operand->token,
+							  left_operand->previous->token,
+							  operator->token);
+	      else
+		ffetarget_integer_bad_magical_precedence_binary
+		  (left_operand->token,
+		   left_operand->previous->token,
+		   operator->token);
+	    }
+	  else
+	    ffetarget_integer_bad_magical (left_operand->token);
+	}
+      if ((ffebld_op (expr) == FFEBLD_opCONTER)
+	  && (ffebld_conter_orig (expr) == NULL)
+	  && ffebld_constant_is_magical (constnode = ffebld_conter (expr)))
+	{
+	  if (submag)
+	    ffetarget_integer_bad_magical_binary (operand->token,
+						  operator->token);
+	  else
+	    ffetarget_integer_bad_magical (operand->token);
+	}
+      ffeexpr_stack_->exprstack = left_operand->previous;	/* Pops binary-op
+								   operands off stack. */
+      ffeexpr_expr_kill_ (left_operand);
+      ffeexpr_expr_kill_ (operand);
+      operator->type = FFEEXPR_exprtypeOPERAND_;	/* Convert operator, but
+							   save */
+      operator->u.operand = reduced;	/* the line/column ffewhere info. */
+      ffeexpr_exprstack_push_operand_ (operator);	/* Push it back on
+							   stack. */
+    }
+}
+
+/* ffeexpr_reduced_bool1_ -- Wrap up reduction of NOT operator
+
+   reduced = ffeexpr_reduced_bool1_(reduced,op,r);
+
+   Makes sure the argument for reduced has basictype of
+   LOGICAL or (ugly) INTEGER.  If
+   argument has where of CONSTANT, assign where CONSTANT to
+   reduced, else assign where FLEETING.
+
+   If these requirements cannot be met, generate error message.	 */
+
+static ffebld
+ffeexpr_reduced_bool1_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r)
+{
+  ffeinfo rinfo, ninfo;
+  ffeinfoBasictype rbt;
+  ffeinfoKindtype rkt;
+  ffeinfoRank rrk;
+  ffeinfoKind rkd;
+  ffeinfoWhere rwh, nwh;
+
+  rinfo = ffebld_info (ffebld_left (reduced));
+  rbt = ffeinfo_basictype (rinfo);
+  rkt = ffeinfo_kindtype (rinfo);
+  rrk = ffeinfo_rank (rinfo);
+  rkd = ffeinfo_kind (rinfo);
+  rwh = ffeinfo_where (rinfo);
+
+  if (((rbt == FFEINFO_basictypeLOGICAL)
+       || (ffe_is_ugly_logint () && (rbt == FFEINFO_basictypeINTEGER)))
+      && (rrk == 0))
+    {
+      switch (rwh)
+	{
+	case FFEINFO_whereCONSTANT:
+	  nwh = FFEINFO_whereCONSTANT;
+	  break;
+
+	case FFEINFO_whereIMMEDIATE:
+	  nwh = FFEINFO_whereIMMEDIATE;
+	  break;
+
+	default:
+	  nwh = FFEINFO_whereFLEETING;
+	  break;
+	}
+
+      ninfo = ffeinfo_new (rbt, rkt, 0, FFEINFO_kindENTITY, nwh,
+			   FFETARGET_charactersizeNONE);
+      ffebld_set_info (reduced, ninfo);
+      return reduced;
+    }
+
+  if ((rbt != FFEINFO_basictypeLOGICAL)
+      && (!ffe_is_ugly_logint () || (rbt != FFEINFO_basictypeINTEGER)))
+    {
+      if ((rbt != FFEINFO_basictypeANY)
+	  && ffebad_start (FFEBAD_NOT_ARG_TYPE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_finish ();
+	}
+    }
+  else
+    {
+      if ((rkd != FFEINFO_kindANY)
+	  && ffebad_start (FFEBAD_NOT_ARG_KIND))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_string ("an array");
+	  ffebad_finish ();
+	}
+    }
+
+  reduced = ffebld_new_any ();
+  ffebld_set_info (reduced, ffeinfo_new_any ());
+  return reduced;
+}
+
+/* ffeexpr_reduced_bool2_ -- Wrap up reduction of boolean operators
+
+   reduced = ffeexpr_reduced_bool2_(reduced,l,op,r);
+
+   Makes sure the left and right arguments for reduced have basictype of
+   LOGICAL or (ugly) INTEGER.  Determine common basictype and
+   size for reduction (flag expression for combined hollerith/typeless
+   situations for later determination of effective basictype).	If both left
+   and right arguments have where of CONSTANT, assign where CONSTANT to
+   reduced, else assign where FLEETING.	 Create CONVERT ops for args where
+   needed.  Convert typeless
+   constants to the desired type/size explicitly.
+
+   If these requirements cannot be met, generate error message.	 */
+
+static ffebld
+ffeexpr_reduced_bool2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+			ffeexprExpr_ r)
+{
+  ffeinfo linfo, rinfo, ninfo;
+  ffeinfoBasictype lbt, rbt, nbt;
+  ffeinfoKindtype lkt, rkt, nkt;
+  ffeinfoRank lrk, rrk;
+  ffeinfoKind lkd, rkd;
+  ffeinfoWhere lwh, rwh, nwh;
+
+  linfo = ffebld_info (ffebld_left (reduced));
+  lbt = ffeinfo_basictype (linfo);
+  lkt = ffeinfo_kindtype (linfo);
+  lrk = ffeinfo_rank (linfo);
+  lkd = ffeinfo_kind (linfo);
+  lwh = ffeinfo_where (linfo);
+
+  rinfo = ffebld_info (ffebld_right (reduced));
+  rbt = ffeinfo_basictype (rinfo);
+  rkt = ffeinfo_kindtype (rinfo);
+  rrk = ffeinfo_rank (rinfo);
+  rkd = ffeinfo_kind (rinfo);
+  rwh = ffeinfo_where (rinfo);
+
+  ffeexpr_type_combine (&nbt, &nkt, lbt, lkt, rbt, rkt, op->token);
+
+  if (((nbt == FFEINFO_basictypeLOGICAL)
+       || (ffe_is_ugly_logint () && (nbt == FFEINFO_basictypeINTEGER)))
+      && (lrk == 0) && (rrk == 0))
+    {
+      switch (lwh)
+	{
+	case FFEINFO_whereCONSTANT:
+	  switch (rwh)
+	    {
+	    case FFEINFO_whereCONSTANT:
+	      nwh = FFEINFO_whereCONSTANT;
+	      break;
+
+	    case FFEINFO_whereIMMEDIATE:
+	      nwh = FFEINFO_whereIMMEDIATE;
+	      break;
+
+	    default:
+	      nwh = FFEINFO_whereFLEETING;
+	      break;
+	    }
+	  break;
+
+	case FFEINFO_whereIMMEDIATE:
+	  switch (rwh)
+	    {
+	    case FFEINFO_whereCONSTANT:
+	    case FFEINFO_whereIMMEDIATE:
+	      nwh = FFEINFO_whereIMMEDIATE;
+	      break;
+
+	    default:
+	      nwh = FFEINFO_whereFLEETING;
+	      break;
+	    }
+	  break;
+
+	default:
+	  nwh = FFEINFO_whereFLEETING;
+	  break;
+	}
+
+      ninfo = ffeinfo_new (nbt, nkt, 0, FFEINFO_kindENTITY, nwh,
+			   FFETARGET_charactersizeNONE);
+      ffebld_set_info (reduced, ninfo);
+      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+	      l->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
+						 FFEEXPR_contextLET));
+      ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+	      r->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
+						  FFEEXPR_contextLET));
+      return reduced;
+    }
+
+  if ((lbt != FFEINFO_basictypeLOGICAL)
+      && (!ffe_is_ugly_logint () || (lbt != FFEINFO_basictypeINTEGER)))
+    {
+      if ((rbt != FFEINFO_basictypeLOGICAL)
+	  && (!ffe_is_ugly_logint () || (rbt != FFEINFO_basictypeINTEGER)))
+	{
+	  if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
+	      && ffebad_start (FFEBAD_BOOL_ARGS_TYPE))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	      ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	      ffebad_finish ();
+	    }
+	}
+      else
+	{
+	  if ((lbt != FFEINFO_basictypeANY)
+	      && ffebad_start (FFEBAD_BOOL_ARG_TYPE))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	      ffebad_finish ();
+	    }
+	}
+    }
+  else if ((rbt != FFEINFO_basictypeLOGICAL)
+	   && (!ffe_is_ugly_logint () || (rbt != FFEINFO_basictypeINTEGER)))
+    {
+      if ((rbt != FFEINFO_basictypeANY)
+	  && ffebad_start (FFEBAD_BOOL_ARG_TYPE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_finish ();
+	}
+    }
+  else if (lrk != 0)
+    {
+      if ((lkd != FFEINFO_kindANY)
+	  && ffebad_start (FFEBAD_BOOL_ARG_KIND))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	  ffebad_string ("an array");
+	  ffebad_finish ();
+	}
+    }
+  else
+    {
+      if ((rkd != FFEINFO_kindANY)
+	  && ffebad_start (FFEBAD_BOOL_ARG_KIND))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_string ("an array");
+	  ffebad_finish ();
+	}
+    }
+
+  reduced = ffebld_new_any ();
+  ffebld_set_info (reduced, ffeinfo_new_any ());
+  return reduced;
+}
+
+/* ffeexpr_reduced_concatenate_ -- Wrap up reduction of concatenate operator
+
+   reduced = ffeexpr_reduced_concatenate_(reduced,l,op,r);
+
+   Makes sure the left and right arguments for reduced have basictype of
+   CHARACTER and kind of SCALAR, FUNCTION, or STATEMENT FUNCTION.  Assign
+   basictype of CHARACTER and kind of SCALAR to reduced.  Calculate effective
+   size of concatenation and assign that size to reduced.  If both left and
+   right arguments have where of CONSTANT, assign where CONSTANT to reduced,
+   else assign where FLEETING.
+
+   If these requirements cannot be met, generate error message using the
+   info in l, op, and r arguments and assign basictype, size, kind, and where
+   of ANY.  */
+
+static ffebld
+ffeexpr_reduced_concatenate_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+			      ffeexprExpr_ r)
+{
+  ffeinfo linfo, rinfo, ninfo;
+  ffeinfoBasictype lbt, rbt, nbt;
+  ffeinfoKindtype lkt, rkt, nkt;
+  ffeinfoRank lrk, rrk;
+  ffeinfoKind lkd, rkd, nkd;
+  ffeinfoWhere lwh, rwh, nwh;
+  ffetargetCharacterSize lszm, lszk, rszm, rszk, nszk;
+
+  linfo = ffebld_info (ffebld_left (reduced));
+  lbt = ffeinfo_basictype (linfo);
+  lkt = ffeinfo_kindtype (linfo);
+  lrk = ffeinfo_rank (linfo);
+  lkd = ffeinfo_kind (linfo);
+  lwh = ffeinfo_where (linfo);
+  lszk = ffeinfo_size (linfo);	/* Known size. */
+  lszm = ffebld_size_max (ffebld_left (reduced));
+
+  rinfo = ffebld_info (ffebld_right (reduced));
+  rbt = ffeinfo_basictype (rinfo);
+  rkt = ffeinfo_kindtype (rinfo);
+  rrk = ffeinfo_rank (rinfo);
+  rkd = ffeinfo_kind (rinfo);
+  rwh = ffeinfo_where (rinfo);
+  rszk = ffeinfo_size (rinfo);	/* Known size. */
+  rszm = ffebld_size_max (ffebld_right (reduced));
+
+  if ((lbt == FFEINFO_basictypeCHARACTER) && (rbt == FFEINFO_basictypeCHARACTER)
+      && (lkt == rkt) && (lrk == 0) && (rrk == 0)
+      && (((lszm != FFETARGET_charactersizeNONE)
+	   && (rszm != FFETARGET_charactersizeNONE))
+	  || (ffeexpr_context_outer_ (ffeexpr_stack_)
+	      == FFEEXPR_contextLET)
+	  || (ffeexpr_context_outer_ (ffeexpr_stack_)
+	      == FFEEXPR_contextSFUNCDEF)))
+    {
+      nbt = FFEINFO_basictypeCHARACTER;
+      nkd = FFEINFO_kindENTITY;
+      if ((lszk == FFETARGET_charactersizeNONE)
+	  || (rszk == FFETARGET_charactersizeNONE))
+	nszk = FFETARGET_charactersizeNONE;	/* Ok only in rhs of LET
+						   stmt. */
+      else
+	nszk = lszk + rszk;
+
+      switch (lwh)
+	{
+	case FFEINFO_whereCONSTANT:
+	  switch (rwh)
+	    {
+	    case FFEINFO_whereCONSTANT:
+	      nwh = FFEINFO_whereCONSTANT;
+	      break;
+
+	    case FFEINFO_whereIMMEDIATE:
+	      nwh = FFEINFO_whereIMMEDIATE;
+	      break;
+
+	    default:
+	      nwh = FFEINFO_whereFLEETING;
+	      break;
+	    }
+	  break;
+
+	case FFEINFO_whereIMMEDIATE:
+	  switch (rwh)
+	    {
+	    case FFEINFO_whereCONSTANT:
+	    case FFEINFO_whereIMMEDIATE:
+	      nwh = FFEINFO_whereIMMEDIATE;
+	      break;
+
+	    default:
+	      nwh = FFEINFO_whereFLEETING;
+	      break;
+	    }
+	  break;
+
+	default:
+	  nwh = FFEINFO_whereFLEETING;
+	  break;
+	}
+
+      nkt = lkt;
+      ninfo = ffeinfo_new (nbt, nkt, 0, nkd, nwh, nszk);
+      ffebld_set_info (reduced, ninfo);
+      return reduced;
+    }
+
+  if ((lbt != FFEINFO_basictypeCHARACTER) && (rbt != FFEINFO_basictypeCHARACTER))
+    {
+      if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
+	  && ffebad_start (FFEBAD_CONCAT_ARGS_TYPE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	  ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_finish ();
+	}
+    }
+  else if (lbt != FFEINFO_basictypeCHARACTER)
+    {
+      if ((lbt != FFEINFO_basictypeANY)
+	  && ffebad_start (FFEBAD_CONCAT_ARG_TYPE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	  ffebad_finish ();
+	}
+    }
+  else if (rbt != FFEINFO_basictypeCHARACTER)
+    {
+      if ((rbt != FFEINFO_basictypeANY)
+	  && ffebad_start (FFEBAD_CONCAT_ARG_TYPE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_finish ();
+	}
+    }
+  else if ((lrk != 0) || (lszm == FFETARGET_charactersizeNONE))
+    {
+      if ((lkd != FFEINFO_kindANY)
+	  && ffebad_start (FFEBAD_CONCAT_ARG_KIND))
+	{
+	  const char *what;
+
+	  if (lrk != 0)
+	    what = "an array";
+	  else
+	    what = "of indeterminate length";
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	  ffebad_string (what);
+	  ffebad_finish ();
+	}
+    }
+  else
+    {
+      if (ffebad_start (FFEBAD_CONCAT_ARG_KIND))
+	{
+	  const char *what;
+
+	  if (rrk != 0)
+	    what = "an array";
+	  else
+	    what = "of indeterminate length";
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_string (what);
+	  ffebad_finish ();
+	}
+    }
+
+  reduced = ffebld_new_any ();
+  ffebld_set_info (reduced, ffeinfo_new_any ());
+  return reduced;
+}
+
+/* ffeexpr_reduced_eqop2_ -- Wrap up reduction of EQ and NE operators
+
+   reduced = ffeexpr_reduced_eqop2_(reduced,l,op,r);
+
+   Makes sure the left and right arguments for reduced have basictype of
+   INTEGER, REAL, COMPLEX, or CHARACTER.  Determine common basictype and
+   size for reduction.	If both left
+   and right arguments have where of CONSTANT, assign where CONSTANT to
+   reduced, else assign where FLEETING.	 Create CONVERT ops for args where
+   needed.  Convert typeless
+   constants to the desired type/size explicitly.
+
+   If these requirements cannot be met, generate error message.	 */
+
+static ffebld
+ffeexpr_reduced_eqop2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+			ffeexprExpr_ r)
+{
+  ffeinfo linfo, rinfo, ninfo;
+  ffeinfoBasictype lbt, rbt, nbt;
+  ffeinfoKindtype lkt, rkt, nkt;
+  ffeinfoRank lrk, rrk;
+  ffeinfoKind lkd, rkd;
+  ffeinfoWhere lwh, rwh, nwh;
+  ffetargetCharacterSize lsz, rsz;
+
+  linfo = ffebld_info (ffebld_left (reduced));
+  lbt = ffeinfo_basictype (linfo);
+  lkt = ffeinfo_kindtype (linfo);
+  lrk = ffeinfo_rank (linfo);
+  lkd = ffeinfo_kind (linfo);
+  lwh = ffeinfo_where (linfo);
+  lsz = ffebld_size_known (ffebld_left (reduced));
+
+  rinfo = ffebld_info (ffebld_right (reduced));
+  rbt = ffeinfo_basictype (rinfo);
+  rkt = ffeinfo_kindtype (rinfo);
+  rrk = ffeinfo_rank (rinfo);
+  rkd = ffeinfo_kind (rinfo);
+  rwh = ffeinfo_where (rinfo);
+  rsz = ffebld_size_known (ffebld_right (reduced));
+
+  ffeexpr_type_combine (&nbt, &nkt, lbt, lkt, rbt, rkt, op->token);
+
+  if (((nbt == FFEINFO_basictypeINTEGER) || (nbt == FFEINFO_basictypeREAL)
+       || (nbt == FFEINFO_basictypeCOMPLEX) || (nbt == FFEINFO_basictypeCHARACTER))
+      && (lrk == 0) && (rrk == 0))
+    {
+      switch (lwh)
+	{
+	case FFEINFO_whereCONSTANT:
+	  switch (rwh)
+	    {
+	    case FFEINFO_whereCONSTANT:
+	      nwh = FFEINFO_whereCONSTANT;
+	      break;
+
+	    case FFEINFO_whereIMMEDIATE:
+	      nwh = FFEINFO_whereIMMEDIATE;
+	      break;
+
+	    default:
+	      nwh = FFEINFO_whereFLEETING;
+	      break;
+	    }
+	  break;
+
+	case FFEINFO_whereIMMEDIATE:
+	  switch (rwh)
+	    {
+	    case FFEINFO_whereCONSTANT:
+	    case FFEINFO_whereIMMEDIATE:
+	      nwh = FFEINFO_whereIMMEDIATE;
+	      break;
+
+	    default:
+	      nwh = FFEINFO_whereFLEETING;
+	      break;
+	    }
+	  break;
+
+	default:
+	  nwh = FFEINFO_whereFLEETING;
+	  break;
+	}
+
+      if ((lsz != FFETARGET_charactersizeNONE)
+	  && (rsz != FFETARGET_charactersizeNONE))
+	lsz = rsz = (lsz > rsz) ? lsz : rsz;
+
+      ninfo = ffeinfo_new (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICALDEFAULT,
+		   0, FFEINFO_kindENTITY, nwh, FFETARGET_charactersizeNONE);
+      ffebld_set_info (reduced, ninfo);
+      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+				      l->token, op->token, nbt, nkt, 0, lsz,
+						 FFEEXPR_contextLET));
+      ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+				      r->token, op->token, nbt, nkt, 0, rsz,
+						  FFEEXPR_contextLET));
+      return reduced;
+    }
+
+  if ((lbt == FFEINFO_basictypeLOGICAL)
+      && (rbt == FFEINFO_basictypeLOGICAL))
+    {
+      /* xgettext:no-c-format */
+      if (ffebad_start_msg ("Use .EQV./.NEQV. instead of .EQ./.NE. at %0 for LOGICAL operands at %1 and %2",
+			    FFEBAD_severityFATAL))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	  ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_finish ();
+	}
+    }
+  else if ((lbt != FFEINFO_basictypeINTEGER) && (lbt != FFEINFO_basictypeREAL)
+      && (lbt != FFEINFO_basictypeCOMPLEX) && (lbt != FFEINFO_basictypeCHARACTER))
+    {
+      if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
+	  && (rbt != FFEINFO_basictypeCOMPLEX) && (rbt != FFEINFO_basictypeCHARACTER))
+	{
+	  if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
+	      && ffebad_start (FFEBAD_EQOP_ARGS_TYPE))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	      ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	      ffebad_finish ();
+	    }
+	}
+      else
+	{
+	  if ((lbt != FFEINFO_basictypeANY)
+	      && ffebad_start (FFEBAD_EQOP_ARG_TYPE))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	      ffebad_finish ();
+	    }
+	}
+    }
+  else if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
+	   && (rbt != FFEINFO_basictypeCOMPLEX) && (rbt != FFEINFO_basictypeCHARACTER))
+    {
+      if ((rbt != FFEINFO_basictypeANY)
+	  && ffebad_start (FFEBAD_EQOP_ARG_TYPE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_finish ();
+	}
+    }
+  else if (lrk != 0)
+    {
+      if ((lkd != FFEINFO_kindANY)
+	  && ffebad_start (FFEBAD_EQOP_ARG_KIND))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	  ffebad_string ("an array");
+	  ffebad_finish ();
+	}
+    }
+  else
+    {
+      if ((rkd != FFEINFO_kindANY)
+	  && ffebad_start (FFEBAD_EQOP_ARG_KIND))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_string ("an array");
+	  ffebad_finish ();
+	}
+    }
+
+  reduced = ffebld_new_any ();
+  ffebld_set_info (reduced, ffeinfo_new_any ());
+  return reduced;
+}
+
+/* ffeexpr_reduced_math1_ -- Wrap up reduction of + - unary operators
+
+   reduced = ffeexpr_reduced_math1_(reduced,op,r);
+
+   Makes sure the argument for reduced has basictype of
+   INTEGER, REAL, or COMPLEX.  If the argument has where of CONSTANT,
+   assign where CONSTANT to
+   reduced, else assign where FLEETING.
+
+   If these requirements cannot be met, generate error message.	 */
+
+static ffebld
+ffeexpr_reduced_math1_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r)
+{
+  ffeinfo rinfo, ninfo;
+  ffeinfoBasictype rbt;
+  ffeinfoKindtype rkt;
+  ffeinfoRank rrk;
+  ffeinfoKind rkd;
+  ffeinfoWhere rwh, nwh;
+
+  rinfo = ffebld_info (ffebld_left (reduced));
+  rbt = ffeinfo_basictype (rinfo);
+  rkt = ffeinfo_kindtype (rinfo);
+  rrk = ffeinfo_rank (rinfo);
+  rkd = ffeinfo_kind (rinfo);
+  rwh = ffeinfo_where (rinfo);
+
+  if (((rbt == FFEINFO_basictypeINTEGER) || (rbt == FFEINFO_basictypeREAL)
+       || (rbt == FFEINFO_basictypeCOMPLEX)) && (rrk == 0))
+    {
+      switch (rwh)
+	{
+	case FFEINFO_whereCONSTANT:
+	  nwh = FFEINFO_whereCONSTANT;
+	  break;
+
+	case FFEINFO_whereIMMEDIATE:
+	  nwh = FFEINFO_whereIMMEDIATE;
+	  break;
+
+	default:
+	  nwh = FFEINFO_whereFLEETING;
+	  break;
+	}
+
+      ninfo = ffeinfo_new (rbt, rkt, 0, FFEINFO_kindENTITY, nwh,
+			   FFETARGET_charactersizeNONE);
+      ffebld_set_info (reduced, ninfo);
+      return reduced;
+    }
+
+  if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
+      && (rbt != FFEINFO_basictypeCOMPLEX))
+    {
+      if ((rbt != FFEINFO_basictypeANY)
+	  && ffebad_start (FFEBAD_MATH_ARG_TYPE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_finish ();
+	}
+    }
+  else
+    {
+      if ((rkd != FFEINFO_kindANY)
+	  && ffebad_start (FFEBAD_MATH_ARG_KIND))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_string ("an array");
+	  ffebad_finish ();
+	}
+    }
+
+  reduced = ffebld_new_any ();
+  ffebld_set_info (reduced, ffeinfo_new_any ());
+  return reduced;
+}
+
+/* ffeexpr_reduced_math2_ -- Wrap up reduction of + - * / operators
+
+   reduced = ffeexpr_reduced_math2_(reduced,l,op,r);
+
+   Makes sure the left and right arguments for reduced have basictype of
+   INTEGER, REAL, or COMPLEX.  Determine common basictype and
+   size for reduction (flag expression for combined hollerith/typeless
+   situations for later determination of effective basictype).	If both left
+   and right arguments have where of CONSTANT, assign where CONSTANT to
+   reduced, else assign where FLEETING.	 Create CONVERT ops for args where
+   needed.  Convert typeless
+   constants to the desired type/size explicitly.
+
+   If these requirements cannot be met, generate error message.	 */
+
+static ffebld
+ffeexpr_reduced_math2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+			ffeexprExpr_ r)
+{
+  ffeinfo linfo, rinfo, ninfo;
+  ffeinfoBasictype lbt, rbt, nbt;
+  ffeinfoKindtype lkt, rkt, nkt;
+  ffeinfoRank lrk, rrk;
+  ffeinfoKind lkd, rkd;
+  ffeinfoWhere lwh, rwh, nwh;
+
+  linfo = ffebld_info (ffebld_left (reduced));
+  lbt = ffeinfo_basictype (linfo);
+  lkt = ffeinfo_kindtype (linfo);
+  lrk = ffeinfo_rank (linfo);
+  lkd = ffeinfo_kind (linfo);
+  lwh = ffeinfo_where (linfo);
+
+  rinfo = ffebld_info (ffebld_right (reduced));
+  rbt = ffeinfo_basictype (rinfo);
+  rkt = ffeinfo_kindtype (rinfo);
+  rrk = ffeinfo_rank (rinfo);
+  rkd = ffeinfo_kind (rinfo);
+  rwh = ffeinfo_where (rinfo);
+
+  ffeexpr_type_combine (&nbt, &nkt, lbt, lkt, rbt, rkt, op->token);
+
+  if (((nbt == FFEINFO_basictypeINTEGER) || (nbt == FFEINFO_basictypeREAL)
+       || (nbt == FFEINFO_basictypeCOMPLEX)) && (lrk == 0) && (rrk == 0))
+    {
+      switch (lwh)
+	{
+	case FFEINFO_whereCONSTANT:
+	  switch (rwh)
+	    {
+	    case FFEINFO_whereCONSTANT:
+	      nwh = FFEINFO_whereCONSTANT;
+	      break;
+
+	    case FFEINFO_whereIMMEDIATE:
+	      nwh = FFEINFO_whereIMMEDIATE;
+	      break;
+
+	    default:
+	      nwh = FFEINFO_whereFLEETING;
+	      break;
+	    }
+	  break;
+
+	case FFEINFO_whereIMMEDIATE:
+	  switch (rwh)
+	    {
+	    case FFEINFO_whereCONSTANT:
+	    case FFEINFO_whereIMMEDIATE:
+	      nwh = FFEINFO_whereIMMEDIATE;
+	      break;
+
+	    default:
+	      nwh = FFEINFO_whereFLEETING;
+	      break;
+	    }
+	  break;
+
+	default:
+	  nwh = FFEINFO_whereFLEETING;
+	  break;
+	}
+
+      ninfo = ffeinfo_new (nbt, nkt, 0, FFEINFO_kindENTITY, nwh,
+			   FFETARGET_charactersizeNONE);
+      ffebld_set_info (reduced, ninfo);
+      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+	      l->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
+						 FFEEXPR_contextLET));
+      ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+	      r->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
+						  FFEEXPR_contextLET));
+      return reduced;
+    }
+
+  if ((lbt != FFEINFO_basictypeINTEGER) && (lbt != FFEINFO_basictypeREAL)
+      && (lbt != FFEINFO_basictypeCOMPLEX))
+    {
+      if ((rbt != FFEINFO_basictypeINTEGER)
+      && (rbt != FFEINFO_basictypeREAL) && (rbt != FFEINFO_basictypeCOMPLEX))
+	{
+	  if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
+	      && ffebad_start (FFEBAD_MATH_ARGS_TYPE))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	      ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	      ffebad_finish ();
+	    }
+	}
+      else
+	{
+	  if ((lbt != FFEINFO_basictypeANY)
+	      && ffebad_start (FFEBAD_MATH_ARG_TYPE))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	      ffebad_finish ();
+	    }
+	}
+    }
+  else if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
+	   && (rbt != FFEINFO_basictypeCOMPLEX))
+    {
+      if ((rbt != FFEINFO_basictypeANY)
+	  && ffebad_start (FFEBAD_MATH_ARG_TYPE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_finish ();
+	}
+    }
+  else if (lrk != 0)
+    {
+      if ((lkd != FFEINFO_kindANY)
+	  && ffebad_start (FFEBAD_MATH_ARG_KIND))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	  ffebad_string ("an array");
+	  ffebad_finish ();
+	}
+    }
+  else
+    {
+      if ((rkd != FFEINFO_kindANY)
+	  && ffebad_start (FFEBAD_MATH_ARG_KIND))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_string ("an array");
+	  ffebad_finish ();
+	}
+    }
+
+  reduced = ffebld_new_any ();
+  ffebld_set_info (reduced, ffeinfo_new_any ());
+  return reduced;
+}
+
+/* ffeexpr_reduced_power_ -- Wrap up reduction of ** operator
+
+   reduced = ffeexpr_reduced_power_(reduced,l,op,r);
+
+   Makes sure the left and right arguments for reduced have basictype of
+   INTEGER, REAL, or COMPLEX.  Determine common basictype and
+   size for reduction (flag expression for combined hollerith/typeless
+   situations for later determination of effective basictype).	If both left
+   and right arguments have where of CONSTANT, assign where CONSTANT to
+   reduced, else assign where FLEETING.	 Create CONVERT ops for args where
+   needed.  Note that real**int or complex**int
+   comes out as int = real**int etc with no conversions.
+
+   If these requirements cannot be met, generate error message using the
+   info in l, op, and r arguments and assign basictype, size, kind, and where
+   of ANY.  */
+
+static ffebld
+ffeexpr_reduced_power_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+			ffeexprExpr_ r)
+{
+  ffeinfo linfo, rinfo, ninfo;
+  ffeinfoBasictype lbt, rbt, nbt;
+  ffeinfoKindtype lkt, rkt, nkt;
+  ffeinfoRank lrk, rrk;
+  ffeinfoKind lkd, rkd;
+  ffeinfoWhere lwh, rwh, nwh;
+
+  linfo = ffebld_info (ffebld_left (reduced));
+  lbt = ffeinfo_basictype (linfo);
+  lkt = ffeinfo_kindtype (linfo);
+  lrk = ffeinfo_rank (linfo);
+  lkd = ffeinfo_kind (linfo);
+  lwh = ffeinfo_where (linfo);
+
+  rinfo = ffebld_info (ffebld_right (reduced));
+  rbt = ffeinfo_basictype (rinfo);
+  rkt = ffeinfo_kindtype (rinfo);
+  rrk = ffeinfo_rank (rinfo);
+  rkd = ffeinfo_kind (rinfo);
+  rwh = ffeinfo_where (rinfo);
+
+  if ((rbt == FFEINFO_basictypeINTEGER)
+      && ((lbt == FFEINFO_basictypeREAL)
+	  || (lbt == FFEINFO_basictypeCOMPLEX)))
+    {
+      nbt = lbt;
+      nkt = ffeinfo_kindtype_max (nbt, lkt, FFEINFO_kindtypeREALDEFAULT);
+      if (nkt != FFEINFO_kindtypeREALDEFAULT)
+	{
+	  nkt = ffeinfo_kindtype_max (nbt, lkt, FFEINFO_kindtypeREALDOUBLE);
+	  if (nkt != FFEINFO_kindtypeREALDOUBLE)
+	    nkt = FFEINFO_kindtypeREALDOUBLE;	/* Highest kt we can power! */
+	}
+      if (rkt == FFEINFO_kindtypeINTEGER4)
+	{
+	  /* xgettext:no-c-format */
+	  ffebad_start_msg ("Unsupported operand for ** at %1 -- converting to default INTEGER",
+			    FFEBAD_severityWARNING);
+	  ffebad_here (0, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_finish ();
+	}
+      if (rkt != FFEINFO_kindtypeINTEGERDEFAULT)
+	{
+	  ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+						      r->token, op->token,
+		FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGERDEFAULT, 0,
+						FFETARGET_charactersizeNONE,
+						      FFEEXPR_contextLET));
+	  rkt = FFEINFO_kindtypeINTEGERDEFAULT;
+	}
+    }
+  else
+    {
+      ffeexpr_type_combine (&nbt, &nkt, lbt, lkt, rbt, rkt, op->token);
+
+#if 0	/* INTEGER4**INTEGER4 works now. */
+      if ((nbt == FFEINFO_basictypeINTEGER)
+	  && (nkt != FFEINFO_kindtypeINTEGERDEFAULT))
+	nkt = FFEINFO_kindtypeINTEGERDEFAULT;	/* Highest kt we can power! */
+#endif
+      if (((nbt == FFEINFO_basictypeREAL)
+	   || (nbt == FFEINFO_basictypeCOMPLEX))
+	  && (nkt != FFEINFO_kindtypeREALDEFAULT))
+	{
+	  nkt = ffeinfo_kindtype_max (nbt, nkt, FFEINFO_kindtypeREALDOUBLE);
+	  if (nkt != FFEINFO_kindtypeREALDOUBLE)
+	    nkt = FFEINFO_kindtypeREALDOUBLE;	/* Highest kt we can power! */
+	}
+      /* else Gonna turn into an error below. */
+    }
+
+  if (((nbt == FFEINFO_basictypeINTEGER) || (nbt == FFEINFO_basictypeREAL)
+       || (nbt == FFEINFO_basictypeCOMPLEX)) && (lrk == 0) && (rrk == 0))
+    {
+      switch (lwh)
+	{
+	case FFEINFO_whereCONSTANT:
+	  switch (rwh)
+	    {
+	    case FFEINFO_whereCONSTANT:
+	      nwh = FFEINFO_whereCONSTANT;
+	      break;
+
+	    case FFEINFO_whereIMMEDIATE:
+	      nwh = FFEINFO_whereIMMEDIATE;
+	      break;
+
+	    default:
+	      nwh = FFEINFO_whereFLEETING;
+	      break;
+	    }
+	  break;
+
+	case FFEINFO_whereIMMEDIATE:
+	  switch (rwh)
+	    {
+	    case FFEINFO_whereCONSTANT:
+	    case FFEINFO_whereIMMEDIATE:
+	      nwh = FFEINFO_whereIMMEDIATE;
+	      break;
+
+	    default:
+	      nwh = FFEINFO_whereFLEETING;
+	      break;
+	    }
+	  break;
+
+	default:
+	  nwh = FFEINFO_whereFLEETING;
+	  break;
+	}
+
+      ninfo = ffeinfo_new (nbt, nkt, 0, FFEINFO_kindENTITY, nwh,
+			   FFETARGET_charactersizeNONE);
+      ffebld_set_info (reduced, ninfo);
+      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+	      l->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
+						 FFEEXPR_contextLET));
+      if (rbt != FFEINFO_basictypeINTEGER)
+	ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+	      r->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
+						    FFEEXPR_contextLET));
+      return reduced;
+    }
+
+  if ((lbt != FFEINFO_basictypeINTEGER) && (lbt != FFEINFO_basictypeREAL)
+      && (lbt != FFEINFO_basictypeCOMPLEX))
+    {
+      if ((rbt != FFEINFO_basictypeINTEGER)
+      && (rbt != FFEINFO_basictypeREAL) && (rbt != FFEINFO_basictypeCOMPLEX))
+	{
+	  if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
+	      && ffebad_start (FFEBAD_MATH_ARGS_TYPE))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	      ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	      ffebad_finish ();
+	    }
+	}
+      else
+	{
+	  if ((lbt != FFEINFO_basictypeANY)
+	      && ffebad_start (FFEBAD_MATH_ARG_TYPE))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	      ffebad_finish ();
+	    }
+	}
+    }
+  else if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
+	   && (rbt != FFEINFO_basictypeCOMPLEX))
+    {
+      if ((rbt != FFEINFO_basictypeANY)
+	  && ffebad_start (FFEBAD_MATH_ARG_TYPE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_finish ();
+	}
+    }
+  else if (lrk != 0)
+    {
+      if ((lkd != FFEINFO_kindANY)
+	  && ffebad_start (FFEBAD_MATH_ARG_KIND))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	  ffebad_string ("an array");
+	  ffebad_finish ();
+	}
+    }
+  else
+    {
+      if ((rkd != FFEINFO_kindANY)
+	  && ffebad_start (FFEBAD_MATH_ARG_KIND))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_string ("an array");
+	  ffebad_finish ();
+	}
+    }
+
+  reduced = ffebld_new_any ();
+  ffebld_set_info (reduced, ffeinfo_new_any ());
+  return reduced;
+}
+
+/* ffeexpr_reduced_relop2_ -- Wrap up reduction of LT, LE, GE, and GT operators
+
+   reduced = ffeexpr_reduced_relop2_(reduced,l,op,r);
+
+   Makes sure the left and right arguments for reduced have basictype of
+   INTEGER, REAL, or CHARACTER.	 Determine common basictype and
+   size for reduction.	If both left
+   and right arguments have where of CONSTANT, assign where CONSTANT to
+   reduced, else assign where FLEETING.	 Create CONVERT ops for args where
+   needed.  Convert typeless
+   constants to the desired type/size explicitly.
+
+   If these requirements cannot be met, generate error message.	 */
+
+static ffebld
+ffeexpr_reduced_relop2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+			 ffeexprExpr_ r)
+{
+  ffeinfo linfo, rinfo, ninfo;
+  ffeinfoBasictype lbt, rbt, nbt;
+  ffeinfoKindtype lkt, rkt, nkt;
+  ffeinfoRank lrk, rrk;
+  ffeinfoKind lkd, rkd;
+  ffeinfoWhere lwh, rwh, nwh;
+  ffetargetCharacterSize lsz, rsz;
+
+  linfo = ffebld_info (ffebld_left (reduced));
+  lbt = ffeinfo_basictype (linfo);
+  lkt = ffeinfo_kindtype (linfo);
+  lrk = ffeinfo_rank (linfo);
+  lkd = ffeinfo_kind (linfo);
+  lwh = ffeinfo_where (linfo);
+  lsz = ffebld_size_known (ffebld_left (reduced));
+
+  rinfo = ffebld_info (ffebld_right (reduced));
+  rbt = ffeinfo_basictype (rinfo);
+  rkt = ffeinfo_kindtype (rinfo);
+  rrk = ffeinfo_rank (rinfo);
+  rkd = ffeinfo_kind (rinfo);
+  rwh = ffeinfo_where (rinfo);
+  rsz = ffebld_size_known (ffebld_right (reduced));
+
+  ffeexpr_type_combine (&nbt, &nkt, lbt, lkt, rbt, rkt, op->token);
+
+  if (((nbt == FFEINFO_basictypeINTEGER) || (nbt == FFEINFO_basictypeREAL)
+       || (nbt == FFEINFO_basictypeCHARACTER))
+      && (lrk == 0) && (rrk == 0))
+    {
+      switch (lwh)
+	{
+	case FFEINFO_whereCONSTANT:
+	  switch (rwh)
+	    {
+	    case FFEINFO_whereCONSTANT:
+	      nwh = FFEINFO_whereCONSTANT;
+	      break;
+
+	    case FFEINFO_whereIMMEDIATE:
+	      nwh = FFEINFO_whereIMMEDIATE;
+	      break;
+
+	    default:
+	      nwh = FFEINFO_whereFLEETING;
+	      break;
+	    }
+	  break;
+
+	case FFEINFO_whereIMMEDIATE:
+	  switch (rwh)
+	    {
+	    case FFEINFO_whereCONSTANT:
+	    case FFEINFO_whereIMMEDIATE:
+	      nwh = FFEINFO_whereIMMEDIATE;
+	      break;
+
+	    default:
+	      nwh = FFEINFO_whereFLEETING;
+	      break;
+	    }
+	  break;
+
+	default:
+	  nwh = FFEINFO_whereFLEETING;
+	  break;
+	}
+
+      if ((lsz != FFETARGET_charactersizeNONE)
+	  && (rsz != FFETARGET_charactersizeNONE))
+	lsz = rsz = (lsz > rsz) ? lsz : rsz;
+
+      ninfo = ffeinfo_new (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICALDEFAULT,
+		   0, FFEINFO_kindENTITY, nwh, FFETARGET_charactersizeNONE);
+      ffebld_set_info (reduced, ninfo);
+      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+				      l->token, op->token, nbt, nkt, 0, lsz,
+						 FFEEXPR_contextLET));
+      ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+				      r->token, op->token, nbt, nkt, 0, rsz,
+						  FFEEXPR_contextLET));
+      return reduced;
+    }
+
+  if ((lbt != FFEINFO_basictypeINTEGER) && (lbt != FFEINFO_basictypeREAL)
+      && (lbt != FFEINFO_basictypeCHARACTER))
+    {
+      if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
+	  && (rbt != FFEINFO_basictypeCHARACTER))
+	{
+	  if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
+	      && ffebad_start (FFEBAD_RELOP_ARGS_TYPE))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	      ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	      ffebad_finish ();
+	    }
+	}
+      else
+	{
+	  if ((lbt != FFEINFO_basictypeANY)
+	      && ffebad_start (FFEBAD_RELOP_ARG_TYPE))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	      ffebad_finish ();
+	    }
+	}
+    }
+  else if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
+	   && (rbt != FFEINFO_basictypeCHARACTER))
+    {
+      if ((rbt != FFEINFO_basictypeANY)
+	  && ffebad_start (FFEBAD_RELOP_ARG_TYPE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_finish ();
+	}
+    }
+  else if (lrk != 0)
+    {
+      if ((lkd != FFEINFO_kindANY)
+	  && ffebad_start (FFEBAD_RELOP_ARG_KIND))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
+	  ffebad_string ("an array");
+	  ffebad_finish ();
+	}
+    }
+  else
+    {
+      if ((rkd != FFEINFO_kindANY)
+	  && ffebad_start (FFEBAD_RELOP_ARG_KIND))
+	{
+	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
+	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
+	  ffebad_string ("an array");
+	  ffebad_finish ();
+	}
+    }
+
+  reduced = ffebld_new_any ();
+  ffebld_set_info (reduced, ffeinfo_new_any ());
+  return reduced;
+}
+
+/* ffeexpr_reduced_ugly1_ -- Deal with TYPELESS, HOLLERITH, and LOGICAL
+
+   reduced = ffeexpr_reduced_ugly1_(reduced,op,r);
+
+   Sigh.  */
+
+static ffebld
+ffeexpr_reduced_ugly1_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r)
+{
+  ffeinfo rinfo;
+  ffeinfoBasictype rbt;
+  ffeinfoKindtype rkt;
+  ffeinfoRank rrk;
+  ffeinfoKind rkd;
+  ffeinfoWhere rwh;
+
+  rinfo = ffebld_info (ffebld_left (reduced));
+  rbt = ffeinfo_basictype (rinfo);
+  rkt = ffeinfo_kindtype (rinfo);
+  rrk = ffeinfo_rank (rinfo);
+  rkd = ffeinfo_kind (rinfo);
+  rwh = ffeinfo_where (rinfo);
+
+  if ((rbt == FFEINFO_basictypeTYPELESS)
+      || (rbt == FFEINFO_basictypeHOLLERITH))
+    {
+      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+			      r->token, op->token, FFEINFO_basictypeINTEGER,
+					  FFEINFO_kindtypeINTEGERDEFAULT, 0,
+						 FFETARGET_charactersizeNONE,
+						 FFEEXPR_contextLET));
+      rinfo = ffebld_info (ffebld_left (reduced));
+      rbt = FFEINFO_basictypeINTEGER;
+      rkt = FFEINFO_kindtypeINTEGERDEFAULT;
+      rrk = 0;
+      rkd = FFEINFO_kindENTITY;
+      rwh = ffeinfo_where (rinfo);
+    }
+
+  if (rbt == FFEINFO_basictypeLOGICAL)
+    {
+      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+			      r->token, op->token, FFEINFO_basictypeINTEGER,
+					  FFEINFO_kindtypeINTEGERDEFAULT, 0,
+						 FFETARGET_charactersizeNONE,
+						 FFEEXPR_contextLET));
+    }
+
+  return reduced;
+}
+
+/* ffeexpr_reduced_ugly1log_ -- Deal with TYPELESS and HOLLERITH
+
+   reduced = ffeexpr_reduced_ugly1log_(reduced,op,r);
+
+   Sigh.  */
+
+static ffebld
+ffeexpr_reduced_ugly1log_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r)
+{
+  ffeinfo rinfo;
+  ffeinfoBasictype rbt;
+  ffeinfoKindtype rkt;
+  ffeinfoRank rrk;
+  ffeinfoKind rkd;
+  ffeinfoWhere rwh;
+
+  rinfo = ffebld_info (ffebld_left (reduced));
+  rbt = ffeinfo_basictype (rinfo);
+  rkt = ffeinfo_kindtype (rinfo);
+  rrk = ffeinfo_rank (rinfo);
+  rkd = ffeinfo_kind (rinfo);
+  rwh = ffeinfo_where (rinfo);
+
+  if ((rbt == FFEINFO_basictypeTYPELESS)
+      || (rbt == FFEINFO_basictypeHOLLERITH))
+    {
+      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+			   r->token, op->token, FFEINFO_basictypeLOGICAL, 0,
+					     FFEINFO_kindtypeLOGICALDEFAULT,
+						 FFETARGET_charactersizeNONE,
+						 FFEEXPR_contextLET));
+      rinfo = ffebld_info (ffebld_left (reduced));
+      rbt = FFEINFO_basictypeLOGICAL;
+      rkt = FFEINFO_kindtypeLOGICALDEFAULT;
+      rrk = 0;
+      rkd = FFEINFO_kindENTITY;
+      rwh = ffeinfo_where (rinfo);
+    }
+
+  return reduced;
+}
+
+/* ffeexpr_reduced_ugly2_ -- Deal with TYPELESS, HOLLERITH, and LOGICAL
+
+   reduced = ffeexpr_reduced_ugly2_(reduced,l,op,r);
+
+   Sigh.  */
+
+static ffebld
+ffeexpr_reduced_ugly2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+			ffeexprExpr_ r)
+{
+  ffeinfo linfo, rinfo;
+  ffeinfoBasictype lbt, rbt;
+  ffeinfoKindtype lkt, rkt;
+  ffeinfoRank lrk, rrk;
+  ffeinfoKind lkd, rkd;
+  ffeinfoWhere lwh, rwh;
+
+  linfo = ffebld_info (ffebld_left (reduced));
+  lbt = ffeinfo_basictype (linfo);
+  lkt = ffeinfo_kindtype (linfo);
+  lrk = ffeinfo_rank (linfo);
+  lkd = ffeinfo_kind (linfo);
+  lwh = ffeinfo_where (linfo);
+
+  rinfo = ffebld_info (ffebld_right (reduced));
+  rbt = ffeinfo_basictype (rinfo);
+  rkt = ffeinfo_kindtype (rinfo);
+  rrk = ffeinfo_rank (rinfo);
+  rkd = ffeinfo_kind (rinfo);
+  rwh = ffeinfo_where (rinfo);
+
+  if ((lbt == FFEINFO_basictypeTYPELESS)
+      || (lbt == FFEINFO_basictypeHOLLERITH))
+    {
+      if ((rbt == FFEINFO_basictypeTYPELESS)
+	  || (rbt == FFEINFO_basictypeHOLLERITH))
+	{
+	  ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+			      l->token, op->token, FFEINFO_basictypeINTEGER,
+					  FFEINFO_kindtypeINTEGERDEFAULT, 0,
+						FFETARGET_charactersizeNONE,
+						     FFEEXPR_contextLET));
+	  ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+			   r->token, op->token, FFEINFO_basictypeINTEGER, 0,
+					     FFEINFO_kindtypeINTEGERDEFAULT,
+						FFETARGET_charactersizeNONE,
+						      FFEEXPR_contextLET));
+	  linfo = ffebld_info (ffebld_left (reduced));
+	  rinfo = ffebld_info (ffebld_right (reduced));
+	  lbt = rbt = FFEINFO_basictypeINTEGER;
+	  lkt = rkt = FFEINFO_kindtypeINTEGERDEFAULT;
+	  lrk = rrk = 0;
+	  lkd = rkd = FFEINFO_kindENTITY;
+	  lwh = ffeinfo_where (linfo);
+	  rwh = ffeinfo_where (rinfo);
+	}
+      else
+	{
+	  ffebld_set_left (reduced, ffeexpr_convert_expr (ffebld_left (reduced),
+				 l->token, ffebld_right (reduced), r->token,
+						       FFEEXPR_contextLET));
+	  linfo = ffebld_info (ffebld_left (reduced));
+	  lbt = ffeinfo_basictype (linfo);
+	  lkt = ffeinfo_kindtype (linfo);
+	  lrk = ffeinfo_rank (linfo);
+	  lkd = ffeinfo_kind (linfo);
+	  lwh = ffeinfo_where (linfo);
+	}
+    }
+  else
+    {
+      if ((rbt == FFEINFO_basictypeTYPELESS)
+	  || (rbt == FFEINFO_basictypeHOLLERITH))
+	{
+	  ffebld_set_right (reduced, ffeexpr_convert_expr (ffebld_right (reduced),
+				  r->token, ffebld_left (reduced), l->token,
+						       FFEEXPR_contextLET));
+	  rinfo = ffebld_info (ffebld_right (reduced));
+	  rbt = ffeinfo_basictype (rinfo);
+	  rkt = ffeinfo_kindtype (rinfo);
+	  rrk = ffeinfo_rank (rinfo);
+	  rkd = ffeinfo_kind (rinfo);
+	  rwh = ffeinfo_where (rinfo);
+	}
+      /* else Leave it alone. */
+    }
+
+  if (lbt == FFEINFO_basictypeLOGICAL)
+    {
+      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+			      l->token, op->token, FFEINFO_basictypeINTEGER,
+					  FFEINFO_kindtypeINTEGERDEFAULT, 0,
+						 FFETARGET_charactersizeNONE,
+						 FFEEXPR_contextLET));
+    }
+
+  if (rbt == FFEINFO_basictypeLOGICAL)
+    {
+      ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+			      r->token, op->token, FFEINFO_basictypeINTEGER,
+					  FFEINFO_kindtypeINTEGERDEFAULT, 0,
+						FFETARGET_charactersizeNONE,
+						  FFEEXPR_contextLET));
+    }
+
+  return reduced;
+}
+
+/* ffeexpr_reduced_ugly2log_ -- Deal with TYPELESS and HOLLERITH
+
+   reduced = ffeexpr_reduced_ugly2log_(reduced,l,op,r);
+
+   Sigh.  */
+
+static ffebld
+ffeexpr_reduced_ugly2log_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
+			   ffeexprExpr_ r, bool *bothlogical)
+{
+  ffeinfo linfo, rinfo;
+  ffeinfoBasictype lbt, rbt;
+  ffeinfoKindtype lkt, rkt;
+  ffeinfoRank lrk, rrk;
+  ffeinfoKind lkd, rkd;
+  ffeinfoWhere lwh, rwh;
+
+  linfo = ffebld_info (ffebld_left (reduced));
+  lbt = ffeinfo_basictype (linfo);
+  lkt = ffeinfo_kindtype (linfo);
+  lrk = ffeinfo_rank (linfo);
+  lkd = ffeinfo_kind (linfo);
+  lwh = ffeinfo_where (linfo);
+
+  rinfo = ffebld_info (ffebld_right (reduced));
+  rbt = ffeinfo_basictype (rinfo);
+  rkt = ffeinfo_kindtype (rinfo);
+  rrk = ffeinfo_rank (rinfo);
+  rkd = ffeinfo_kind (rinfo);
+  rwh = ffeinfo_where (rinfo);
+
+  if ((lbt == FFEINFO_basictypeTYPELESS)
+      || (lbt == FFEINFO_basictypeHOLLERITH))
+    {
+      if ((rbt == FFEINFO_basictypeTYPELESS)
+	  || (rbt == FFEINFO_basictypeHOLLERITH))
+	{
+	  ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
+			      l->token, op->token, FFEINFO_basictypeLOGICAL,
+					  FFEINFO_kindtypeLOGICALDEFAULT, 0,
+						FFETARGET_charactersizeNONE,
+						     FFEEXPR_contextLET));
+	  ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
+			      r->token, op->token, FFEINFO_basictypeLOGICAL,
+					  FFEINFO_kindtypeLOGICALDEFAULT, 0,
+						FFETARGET_charactersizeNONE,
+						      FFEEXPR_contextLET));
+	  linfo = ffebld_info (ffebld_left (reduced));
+	  rinfo = ffebld_info (ffebld_right (reduced));
+	  lbt = rbt = FFEINFO_basictypeLOGICAL;
+	  lkt = rkt = FFEINFO_kindtypeLOGICALDEFAULT;
+	  lrk = rrk = 0;
+	  lkd = rkd = FFEINFO_kindENTITY;
+	  lwh = ffeinfo_where (linfo);
+	  rwh = ffeinfo_where (rinfo);
+	}
+      else
+	{
+	  ffebld_set_left (reduced, ffeexpr_convert_expr (ffebld_left (reduced),
+				 l->token, ffebld_right (reduced), r->token,
+						       FFEEXPR_contextLET));
+	  linfo = ffebld_info (ffebld_left (reduced));
+	  lbt = ffeinfo_basictype (linfo);
+	  lkt = ffeinfo_kindtype (linfo);
+	  lrk = ffeinfo_rank (linfo);
+	  lkd = ffeinfo_kind (linfo);
+	  lwh = ffeinfo_where (linfo);
+	}
+    }
+  else
+    {
+      if ((rbt == FFEINFO_basictypeTYPELESS)
+	  || (rbt == FFEINFO_basictypeHOLLERITH))
+	{
+	  ffebld_set_right (reduced, ffeexpr_convert_expr (ffebld_right (reduced),
+				  r->token, ffebld_left (reduced), l->token,
+						       FFEEXPR_contextLET));
+	  rinfo = ffebld_info (ffebld_right (reduced));
+	  rbt = ffeinfo_basictype (rinfo);
+	  rkt = ffeinfo_kindtype (rinfo);
+	  rrk = ffeinfo_rank (rinfo);
+	  rkd = ffeinfo_kind (rinfo);
+	  rwh = ffeinfo_where (rinfo);
+	}
+      /* else Leave it alone. */
+    }
+
+  if (lbt == FFEINFO_basictypeLOGICAL)
+    {
+      ffebld_set_left (reduced,
+		       ffeexpr_convert (ffebld_left (reduced),
+					l->token, op->token,
+					FFEINFO_basictypeINTEGER,
+					FFEINFO_kindtypeINTEGERDEFAULT, 0,
+					FFETARGET_charactersizeNONE,
+					FFEEXPR_contextLET));
+    }
+
+  if (rbt == FFEINFO_basictypeLOGICAL)
+    {
+      ffebld_set_right (reduced,
+			ffeexpr_convert (ffebld_right (reduced),
+					 r->token, op->token,
+					 FFEINFO_basictypeINTEGER,
+					 FFEINFO_kindtypeINTEGERDEFAULT, 0,
+					 FFETARGET_charactersizeNONE,
+					 FFEEXPR_contextLET));
+    }
+
+  if (bothlogical != NULL)
+    *bothlogical = (lbt == FFEINFO_basictypeLOGICAL
+		    && rbt == FFEINFO_basictypeLOGICAL);
+
+  return reduced;
+}
+
+/* Fumble through tokens until a nonmatching CLOSE_PAREN, EOS, or SEMICOLON
+   is found.
+
+   The idea is to process the tokens as they would be done by normal
+   expression processing, with the key things being telling the lexer
+   when hollerith/character constants are about to happen, until the
+   true closing token is found.  */
+
+static ffelexHandler
+ffeexpr_find_close_paren_ (ffelexToken t,
+			   ffelexHandler after)
+{
+  ffeexpr_find_.after = after;
+  ffeexpr_find_.level = 1;
+  return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+}
+
+static ffelexHandler
+ffeexpr_nil_finished_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCLOSE_PAREN:
+      if (--ffeexpr_find_.level == 0)
+	return (ffelexHandler) ffeexpr_find_.after;
+      return (ffelexHandler) ffeexpr_nil_binary_;
+
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLON:
+    case FFELEX_typeEQUALS:
+    case FFELEX_typePOINTS:
+      return (ffelexHandler) ffeexpr_nil_rhs_;
+
+    default:
+      if (--ffeexpr_find_.level == 0)
+	return (ffelexHandler) ffeexpr_find_.after (t);
+      return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+    }
+}
+
+static ffelexHandler
+ffeexpr_nil_rhs_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeQUOTE:
+      if (ffe_is_vxt ())
+	return (ffelexHandler) ffeexpr_nil_quote_;
+      ffelex_set_expecting_hollerith (-1, '\"',
+				      ffelex_token_where_line (t),
+				      ffelex_token_where_column (t));
+      return (ffelexHandler) ffeexpr_nil_apostrophe_;
+
+    case FFELEX_typeAPOSTROPHE:
+      ffelex_set_expecting_hollerith (-1, '\'',
+				      ffelex_token_where_line (t),
+				      ffelex_token_where_column (t));
+      return (ffelexHandler) ffeexpr_nil_apostrophe_;
+
+    case FFELEX_typePERCENT:
+      return (ffelexHandler) ffeexpr_nil_percent_;
+
+    case FFELEX_typeOPEN_PAREN:
+      ++ffeexpr_find_.level;
+      return (ffelexHandler) ffeexpr_nil_rhs_;
+
+    case FFELEX_typePLUS:
+    case FFELEX_typeMINUS:
+      return (ffelexHandler) ffeexpr_nil_rhs_;
+
+    case FFELEX_typePERIOD:
+      return (ffelexHandler) ffeexpr_nil_period_;
+
+    case FFELEX_typeNUMBER:
+      ffeexpr_hollerith_count_ = atol (ffelex_token_text (t));
+      if (ffeexpr_hollerith_count_ > 0)
+	ffelex_set_expecting_hollerith (ffeexpr_hollerith_count_,
+					'\0',
+					ffelex_token_where_line (t),
+					ffelex_token_where_column (t));
+      return (ffelexHandler) ffeexpr_nil_number_;
+
+    case FFELEX_typeNAME:
+    case FFELEX_typeNAMES:
+      return (ffelexHandler) ffeexpr_nil_name_rhs_;
+
+    case FFELEX_typeASTERISK:
+    case FFELEX_typeSLASH:
+    case FFELEX_typePOWER:
+    case FFELEX_typeCONCAT:
+    case FFELEX_typeREL_EQ:
+    case FFELEX_typeREL_NE:
+    case FFELEX_typeREL_LE:
+    case FFELEX_typeREL_GE:
+      return (ffelexHandler) ffeexpr_nil_rhs_;
+
+    default:
+      return (ffelexHandler) ffeexpr_nil_finished_ (t);
+    }
+}
+
+static ffelexHandler
+ffeexpr_nil_period_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+    case FFELEX_typeNAMES:
+      ffeexpr_current_dotdot_ = ffestr_other (t);
+      switch (ffeexpr_current_dotdot_)
+	{
+	case FFESTR_otherNone:
+	  return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+
+	case FFESTR_otherTRUE:
+	case FFESTR_otherFALSE:
+	case FFESTR_otherNOT:
+	  return (ffelexHandler) ffeexpr_nil_end_period_;
+
+	default:
+	  return (ffelexHandler) ffeexpr_nil_swallow_period_;
+	}
+      break;			/* Nothing really reaches here. */
+
+    case FFELEX_typeNUMBER:
+      return (ffelexHandler) ffeexpr_nil_real_;
+
+    default:
+      return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+    }
+}
+
+static ffelexHandler
+ffeexpr_nil_end_period_ (ffelexToken t)
+{
+  switch (ffeexpr_current_dotdot_)
+    {
+    case FFESTR_otherNOT:
+      if (ffelex_token_type (t) != FFELEX_typePERIOD)
+	return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+      return (ffelexHandler) ffeexpr_nil_rhs_;
+
+    case FFESTR_otherTRUE:
+    case FFESTR_otherFALSE:
+      if (ffelex_token_type (t) != FFELEX_typePERIOD)
+	return (ffelexHandler) ffeexpr_nil_binary_ (t);
+      return (ffelexHandler) ffeexpr_nil_binary_;
+
+    default:
+      assert ("Bad [nil] unary dotdot in ffeexpr_current_dotdot_" == NULL);
+      exit (0);
+      return NULL;
+    }
+}
+
+static ffelexHandler
+ffeexpr_nil_swallow_period_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typePERIOD)
+    return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+  return (ffelexHandler) ffeexpr_nil_rhs_;
+}
+
+static ffelexHandler
+ffeexpr_nil_real_ (ffelexToken t)
+{
+  char d;
+  const char *p;
+
+  if (((ffelex_token_type (t) != FFELEX_typeNAME)
+       && (ffelex_token_type (t) != FFELEX_typeNAMES))
+      || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+				     'D', 'd')
+	     || ffesrc_char_match_init (d, 'E', 'e')
+	     || ffesrc_char_match_init (d, 'Q', 'q')))
+	   && ffeexpr_isdigits_ (++p)))
+    return (ffelexHandler) ffeexpr_nil_binary_ (t);
+
+  if (*p == '\0')
+    return (ffelexHandler) ffeexpr_nil_real_exponent_;
+  return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+static ffelexHandler
+ffeexpr_nil_real_exponent_ (ffelexToken t)
+{
+  if ((ffelex_token_type (t) != FFELEX_typePLUS)
+      && (ffelex_token_type (t) != FFELEX_typeMINUS))
+    return (ffelexHandler) ffeexpr_nil_binary_ (t);
+
+  return (ffelexHandler) ffeexpr_nil_real_exp_sign_;
+}
+
+static ffelexHandler
+ffeexpr_nil_real_exp_sign_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+    return (ffelexHandler) ffeexpr_nil_binary_ (t);
+  return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+static ffelexHandler
+ffeexpr_nil_number_ (ffelexToken t)
+{
+  char d;
+  const char *p;
+
+  if (ffeexpr_hollerith_count_ > 0)
+    ffelex_set_expecting_hollerith (0, '\0',
+				    ffewhere_line_unknown (),
+				    ffewhere_column_unknown ());
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+    case FFELEX_typeNAMES:
+      if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+				   'D', 'd')
+	   || ffesrc_char_match_init (d, 'E', 'e')
+	   || ffesrc_char_match_init (d, 'Q', 'q'))
+	  && ffeexpr_isdigits_ (++p))
+	{
+	  if (*p == '\0')
+	    {
+	      ffeexpr_find_.t = ffelex_token_use (t);
+	      return (ffelexHandler) ffeexpr_nil_number_exponent_;
+	    }
+	  return (ffelexHandler) ffeexpr_nil_binary_;
+	}
+      break;
+
+    case FFELEX_typePERIOD:
+      ffeexpr_find_.t = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_nil_number_period_;
+
+    case FFELEX_typeHOLLERITH:
+      return (ffelexHandler) ffeexpr_nil_binary_;
+
+    default:
+      break;
+    }
+  return (ffelexHandler) ffeexpr_nil_binary_ (t);
+}
+
+/* Expects ffeexpr_find_.t.  */
+
+static ffelexHandler
+ffeexpr_nil_number_exponent_ (ffelexToken t)
+{
+  ffelexHandler nexthandler;
+
+  if ((ffelex_token_type (t) != FFELEX_typePLUS)
+      && (ffelex_token_type (t) != FFELEX_typeMINUS))
+    {
+      nexthandler
+	= (ffelexHandler) ffeexpr_nil_binary_ (ffeexpr_find_.t);
+      ffelex_token_kill (ffeexpr_find_.t);
+      return (ffelexHandler) (*nexthandler) (t);
+    }
+
+  ffelex_token_kill (ffeexpr_find_.t);
+  return (ffelexHandler) ffeexpr_nil_number_exp_sign_;
+}
+
+static ffelexHandler
+ffeexpr_nil_number_exp_sign_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+    return (ffelexHandler) ffeexpr_nil_binary_ (t);
+
+  return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+/* Expects ffeexpr_find_.t.  */
+
+static ffelexHandler
+ffeexpr_nil_number_period_ (ffelexToken t)
+{
+  ffelexHandler nexthandler;
+  char d;
+  const char *p;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+    case FFELEX_typeNAMES:
+      if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+				   'D', 'd')
+	   || ffesrc_char_match_init (d, 'E', 'e')
+	   || ffesrc_char_match_init (d, 'Q', 'q'))
+	  && ffeexpr_isdigits_ (++p))
+	{
+	  if (*p == '\0')
+	    return (ffelexHandler) ffeexpr_nil_number_per_exp_;
+	  ffelex_token_kill (ffeexpr_find_.t);
+	  return (ffelexHandler) ffeexpr_nil_binary_;
+	}
+      nexthandler
+	= (ffelexHandler) ffeexpr_nil_binary_ (ffeexpr_find_.t);
+      ffelex_token_kill (ffeexpr_find_.t);
+      return (ffelexHandler) (*nexthandler) (t);
+
+    case FFELEX_typeNUMBER:
+      ffelex_token_kill (ffeexpr_find_.t);
+      return (ffelexHandler) ffeexpr_nil_number_real_;
+
+    default:
+      break;
+    }
+  ffelex_token_kill (ffeexpr_find_.t);
+  return (ffelexHandler) ffeexpr_nil_binary_ (t);
+}
+
+/* Expects ffeexpr_find_.t.  */
+
+static ffelexHandler
+ffeexpr_nil_number_per_exp_ (ffelexToken t)
+{
+  if ((ffelex_token_type (t) != FFELEX_typePLUS)
+      && (ffelex_token_type (t) != FFELEX_typeMINUS))
+    {
+      ffelexHandler nexthandler;
+
+      nexthandler
+	= (ffelexHandler) ffeexpr_nil_binary_ (ffeexpr_find_.t);
+      ffelex_token_kill (ffeexpr_find_.t);
+      return (ffelexHandler) (*nexthandler) (t);
+    }
+
+  ffelex_token_kill (ffeexpr_find_.t);
+  return (ffelexHandler) ffeexpr_nil_num_per_exp_sign_;
+}
+
+static ffelexHandler
+ffeexpr_nil_number_real_ (ffelexToken t)
+{
+  char d;
+  const char *p;
+
+  if (((ffelex_token_type (t) != FFELEX_typeNAME)
+       && (ffelex_token_type (t) != FFELEX_typeNAMES))
+      || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+				     'D', 'd')
+	     || ffesrc_char_match_init (d, 'E', 'e')
+	     || ffesrc_char_match_init (d, 'Q', 'q')))
+	   && ffeexpr_isdigits_ (++p)))
+    return (ffelexHandler) ffeexpr_nil_binary_ (t);
+
+  if (*p == '\0')
+    return (ffelexHandler) ffeexpr_nil_number_real_exp_;
+
+  return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+static ffelexHandler
+ffeexpr_nil_num_per_exp_sign_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+    return (ffelexHandler) ffeexpr_nil_binary_ (t);
+  return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+static ffelexHandler
+ffeexpr_nil_number_real_exp_ (ffelexToken t)
+{
+  if ((ffelex_token_type (t) != FFELEX_typePLUS)
+      && (ffelex_token_type (t) != FFELEX_typeMINUS))
+    return (ffelexHandler) ffeexpr_nil_binary_ (t);
+  return (ffelexHandler) ffeexpr_nil_num_real_exp_sn_;
+}
+
+static ffelexHandler
+ffeexpr_nil_num_real_exp_sn_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+    return (ffelexHandler) ffeexpr_nil_binary_ (t);
+  return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+static ffelexHandler
+ffeexpr_nil_binary_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typePLUS:
+    case FFELEX_typeMINUS:
+    case FFELEX_typeASTERISK:
+    case FFELEX_typeSLASH:
+    case FFELEX_typePOWER:
+    case FFELEX_typeCONCAT:
+    case FFELEX_typeOPEN_ANGLE:
+    case FFELEX_typeCLOSE_ANGLE:
+    case FFELEX_typeREL_EQ:
+    case FFELEX_typeREL_NE:
+    case FFELEX_typeREL_GE:
+    case FFELEX_typeREL_LE:
+      return (ffelexHandler) ffeexpr_nil_rhs_;
+
+    case FFELEX_typePERIOD:
+      return (ffelexHandler) ffeexpr_nil_binary_period_;
+
+    default:
+      return (ffelexHandler) ffeexpr_nil_finished_ (t);
+    }
+}
+
+static ffelexHandler
+ffeexpr_nil_binary_period_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+    case FFELEX_typeNAMES:
+      ffeexpr_current_dotdot_ = ffestr_other (t);
+      switch (ffeexpr_current_dotdot_)
+	{
+	case FFESTR_otherTRUE:
+	case FFESTR_otherFALSE:
+	case FFESTR_otherNOT:
+	  return (ffelexHandler) ffeexpr_nil_binary_sw_per_;
+
+	default:
+	  return (ffelexHandler) ffeexpr_nil_binary_end_per_;
+	}
+      break;			/* Nothing really reaches here. */
+
+    default:
+      return (ffelexHandler) ffeexpr_nil_binary_ (t);
+    }
+}
+
+static ffelexHandler
+ffeexpr_nil_binary_end_per_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typePERIOD)
+    return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+  return (ffelexHandler) ffeexpr_nil_rhs_;
+}
+
+static ffelexHandler
+ffeexpr_nil_binary_sw_per_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typePERIOD)
+    return (ffelexHandler) ffeexpr_nil_binary_ (t);
+  return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+static ffelexHandler
+ffeexpr_nil_quote_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+    return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+  return (ffelexHandler) ffeexpr_nil_binary_;
+}
+
+static ffelexHandler
+ffeexpr_nil_apostrophe_ (ffelexToken t)
+{
+  assert (ffelex_token_type (t) == FFELEX_typeCHARACTER);
+  return (ffelexHandler) ffeexpr_nil_apos_char_;
+}
+
+static ffelexHandler
+ffeexpr_nil_apos_char_ (ffelexToken t)
+{
+  char c;
+
+  if ((ffelex_token_type (t) == FFELEX_typeNAME)
+      || (ffelex_token_type (t) == FFELEX_typeNAMES))
+    {
+      if ((ffelex_token_length (t) == 1)
+	  && (ffesrc_char_match_init ((c = ffelex_token_text (t)[0]),
+				      'B', 'b')
+	      || ffesrc_char_match_init (c, 'O', 'o')
+	      || ffesrc_char_match_init (c, 'X', 'x')
+	      || ffesrc_char_match_init (c, 'Z', 'z')))
+	return (ffelexHandler) ffeexpr_nil_binary_;
+    }
+  if ((ffelex_token_type (t) == FFELEX_typeNAME)
+      || (ffelex_token_type (t) == FFELEX_typeNAMES))
+    return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+  return (ffelexHandler) ffeexpr_nil_substrp_ (t);
+}
+
+static ffelexHandler
+ffeexpr_nil_name_rhs_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeQUOTE:
+    case FFELEX_typeAPOSTROPHE:
+      ffelex_set_hexnum (TRUE);
+      return (ffelexHandler) ffeexpr_nil_name_apos_;
+
+    case FFELEX_typeOPEN_PAREN:
+      ++ffeexpr_find_.level;
+      return (ffelexHandler) ffeexpr_nil_rhs_;
+
+    default:
+      return (ffelexHandler) ffeexpr_nil_binary_ (t);
+    }
+}
+
+static ffelexHandler
+ffeexpr_nil_name_apos_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) == FFELEX_typeNAME)
+    return (ffelexHandler) ffeexpr_nil_name_apos_name_;
+  return (ffelexHandler) ffeexpr_nil_binary_ (t);
+}
+
+static ffelexHandler
+ffeexpr_nil_name_apos_name_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeAPOSTROPHE:
+    case FFELEX_typeQUOTE:
+      return (ffelexHandler) ffeexpr_nil_finished_;
+
+    default:
+      return (ffelexHandler) ffeexpr_nil_finished_ (t);
+    }
+}
+
+static ffelexHandler
+ffeexpr_nil_percent_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+    case FFELEX_typeNAMES:
+      ffeexpr_stack_->percent = ffeexpr_percent_ (t);
+      ffeexpr_find_.t = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_nil_percent_name_;
+
+    default:
+      return (ffelexHandler) ffeexpr_nil_rhs_ (t);
+    }
+}
+
+/* Expects ffeexpr_find_.t.  */
+
+static ffelexHandler
+ffeexpr_nil_percent_name_ (ffelexToken t)
+{
+  ffelexHandler nexthandler;
+
+  if (ffelex_token_type (t) != FFELEX_typeOPEN_PAREN)
+    {
+      nexthandler
+	= (ffelexHandler) ffeexpr_nil_rhs_ (ffeexpr_find_.t);
+      ffelex_token_kill (ffeexpr_find_.t);
+      return (ffelexHandler) (*nexthandler) (t);
+    }
+
+  ffelex_token_kill (ffeexpr_find_.t);
+  ++ffeexpr_find_.level;
+  return (ffelexHandler) ffeexpr_nil_rhs_;
+}
+
+static ffelexHandler
+ffeexpr_nil_substrp_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typeOPEN_PAREN)
+    return (ffelexHandler) ffeexpr_nil_binary_ (t);
+
+  ++ffeexpr_find_.level;
+  return (ffelexHandler) ffeexpr_nil_rhs_;
+}
+
+/* ffeexpr_finished_ -- Reduce expression stack to one expr, finish
+
+   ffelexToken t;
+   return ffeexpr_finished_(t);
+
+   Reduces expression stack to one (or zero) elements by repeatedly reducing
+   the top operator on the stack (or, if the top element on the stack is
+   itself an operator, issuing an error message and discarding it).  Calls
+   finishing routine with the expression, returning the ffelexHandler it
+   returns to the caller.  */
+
+static ffelexHandler
+ffeexpr_finished_ (ffelexToken t)
+{
+  ffeexprExpr_ operand;		/* This is B in -B or A+B. */
+  ffebld expr;
+  ffeexprCallback callback;
+  ffeexprStack_ s;
+  ffebldConstant constnode;	/* For detecting magical number. */
+  ffelexToken ft;		/* Temporary copy of first token in
+				   expression. */
+  ffelexHandler next;
+  ffeinfo info;
+  bool error = FALSE;
+
+  while (((operand = ffeexpr_stack_->exprstack) != NULL)
+	 && ((operand->previous != NULL) || (operand->type != FFEEXPR_exprtypeOPERAND_)))
+    {
+      if (operand->type == FFEEXPR_exprtypeOPERAND_)
+	ffeexpr_reduce_ ();
+      else
+	{
+	  if (ffest_ffebad_start (FFEBAD_MISSING_OPERAND_FOR_OPERATOR))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (t),
+			   ffelex_token_where_column (t));
+	      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->exprstack->token),
+	      ffelex_token_where_column (ffeexpr_stack_->exprstack->token));
+	      ffebad_finish ();
+	    }
+	  ffeexpr_stack_->exprstack = operand->previous;	/* Pop the useless
+								   operator. */
+	  ffeexpr_expr_kill_ (operand);
+	}
+    }
+
+  assert ((operand == NULL) || (operand->previous == NULL));
+
+  ffebld_pool_pop ();
+  if (operand == NULL)
+    expr = NULL;
+  else
+    {
+      expr = operand->u.operand;
+      info = ffebld_info (expr);
+      if ((ffebld_op (expr) == FFEBLD_opCONTER)
+	  && (ffebld_conter_orig (expr) == NULL)
+	  && ffebld_constant_is_magical (constnode = ffebld_conter (expr)))
+	{
+	  ffetarget_integer_bad_magical (operand->token);
+	}
+      ffeexpr_expr_kill_ (operand);
+      ffeexpr_stack_->exprstack = NULL;
+    }
+
+  ft = ffeexpr_stack_->first_token;
+
+again:				/* :::::::::::::::::::: */
+  switch (ffeexpr_stack_->context)
+    {
+    case FFEEXPR_contextLET:
+    case FFEEXPR_contextSFUNCDEF:
+      error = (expr == NULL)
+	|| (ffeinfo_rank (info) != 0);
+      break;
+
+    case FFEEXPR_contextPAREN_:
+      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+	break;
+      switch (ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	default:
+	  break;
+	}
+      break;
+
+    case FFEEXPR_contextPARENFILENUM_:
+      if (ffelex_token_type (t) != FFELEX_typeCOMMA)
+	ffeexpr_stack_->context = FFEEXPR_contextPAREN_;
+      else
+	ffeexpr_stack_->context = FFEEXPR_contextFILENUM;
+      goto again;		/* :::::::::::::::::::: */
+
+    case FFEEXPR_contextPARENFILEUNIT_:
+      if (ffelex_token_type (t) != FFELEX_typeCOMMA)
+	ffeexpr_stack_->context = FFEEXPR_contextPAREN_;
+      else
+	ffeexpr_stack_->context = FFEEXPR_contextFILEUNIT;
+      goto again;		/* :::::::::::::::::::: */
+
+    case FFEEXPR_contextACTUALARGEXPR_:
+    case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  if (!ffe_is_ugly_args ()
+	      && ffebad_start (FFEBAD_ACTUALARG))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (ft),
+			   ffelex_token_where_column (ft));
+	      ffebad_finish ();
+	    }
+	  break;
+
+	default:
+	  break;
+	}
+      error = (expr != NULL) && (ffeinfo_rank (info) != 0);
+      break;
+
+    case FFEEXPR_contextACTUALARG_:
+    case FFEEXPR_contextSFUNCDEFACTUALARG_:
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+#if 0				/* Should never get here. */
+	  expr = ffeexpr_convert (expr, ft, ft,
+				  FFEINFO_basictypeINTEGER,
+				  FFEINFO_kindtypeINTEGERDEFAULT,
+				  0,
+				  FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+#else
+	  assert ("why hollerith/typeless in actualarg_?" == NULL);
+#endif
+	  break;
+
+	default:
+	  break;
+	}
+      switch ((expr == NULL) ? FFEBLD_opANY : ffebld_op (expr))
+	{
+	case FFEBLD_opSYMTER:
+	case FFEBLD_opPERCENT_LOC:
+	case FFEBLD_opPERCENT_VAL:
+	case FFEBLD_opPERCENT_REF:
+	case FFEBLD_opPERCENT_DESCR:
+	  error = FALSE;
+	  break;
+
+	default:
+	  error = (expr != NULL) && (ffeinfo_rank (info) != 0);
+	  break;
+	}
+      {
+	ffesymbol s;
+	ffeinfoWhere where;
+	ffeinfoKind kind;
+
+	if (!error
+	    && (expr != NULL)
+	    && (ffebld_op (expr) == FFEBLD_opSYMTER)
+	    && ((s = ffebld_symter (expr)), (where = ffesymbol_where (s)),
+		(where == FFEINFO_whereINTRINSIC)
+		|| (where == FFEINFO_whereGLOBAL)
+		|| ((where == FFEINFO_whereDUMMY)
+		    && ((kind = ffesymbol_kind (s)),
+			(kind == FFEINFO_kindFUNCTION)
+			|| (kind == FFEINFO_kindSUBROUTINE))))
+	    && !ffesymbol_explicitwhere (s))
+	  {
+	    ffebad_start (where == FFEINFO_whereINTRINSIC
+			  ? FFEBAD_NEED_INTRINSIC : FFEBAD_NEED_EXTERNAL);
+	    ffebad_here (0, ffelex_token_where_line (ft),
+			 ffelex_token_where_column (ft));
+	    ffebad_string (ffesymbol_text (s));
+	    ffebad_finish ();
+	    ffesymbol_signal_change (s);
+	    ffesymbol_set_explicitwhere (s, TRUE);
+	    ffesymbol_signal_unreported (s);
+	  }
+      }
+      break;
+
+    case FFEEXPR_contextINDEX_:
+    case FFEEXPR_contextSFUNCDEFINDEX_:
+      if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
+	break;
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeNONE:
+	  error = FALSE;
+	  break;
+
+	case FFEINFO_basictypeLOGICAL:
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  /* Fall through. */
+	case FFEINFO_basictypeREAL:
+	case FFEINFO_basictypeCOMPLEX:
+	  if (ffe_is_pedantic ())
+	    {
+	      error = TRUE;
+	      break;
+	    }
+	  /* Fall through. */
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  error = FALSE;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	case FFEINFO_basictypeINTEGER:
+	  /* Specifically, allow INTEGER(KIND=2), aka INTEGER*8, through
+	     unmolested.  Leave it to downstream to handle kinds.  */
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      break;			/* expr==NULL ok for substring; element case
+				   caught by callback. */
+
+    case FFEEXPR_contextRETURN:
+      if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
+	break;
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeNONE:
+	  error = FALSE;
+	  break;
+
+	case FFEINFO_basictypeLOGICAL:
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  /* Fall through. */
+	case FFEINFO_basictypeREAL:
+	case FFEINFO_basictypeCOMPLEX:
+	  if (ffe_is_pedantic ())
+	    {
+	      error = TRUE;
+	      break;
+	    }
+	  /* Fall through. */
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  error = FALSE;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      break;
+
+    case FFEEXPR_contextDO:
+      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+	break;
+      switch (ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  error = !ffe_is_ugly_logint ();
+	  if (!ffeexpr_stack_->is_rhs)
+	    break;		/* Don't convert lhs variable. */
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+				  ffeinfo_kindtype (ffebld_info (expr)), 0,
+				  FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  if (!ffeexpr_stack_->is_rhs)
+	    {
+	      error = TRUE;
+	      break;		/* Don't convert lhs variable. */
+	    }
+	  break;
+
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeREAL:
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      if (!ffeexpr_stack_->is_rhs
+	  && (ffebld_op (expr) != FFEBLD_opSYMTER))
+	error = TRUE;
+      break;
+
+    case FFEEXPR_contextDOWHILE:
+    case FFEEXPR_contextIF:
+      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+	break;
+      switch (ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeINTEGER:
+	  error = FALSE;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  /* Fall through. */
+	case FFEINFO_basictypeLOGICAL:
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  error = FALSE;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      break;
+
+    case FFEEXPR_contextASSIGN:
+    case FFEEXPR_contextAGOTO:
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeINTEGER:
+	  error = (ffeinfo_kindtype (info) != ffecom_label_kind ());
+	  break;
+
+	case FFEINFO_basictypeLOGICAL:
+	  error = !ffe_is_ugly_logint ()
+	    || (ffeinfo_kindtype (info) != ffecom_label_kind ());
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      if ((expr == NULL) || (ffeinfo_rank (info) != 0)
+	  || (ffebld_op (expr) != FFEBLD_opSYMTER))
+	error = TRUE;
+      break;
+
+    case FFEEXPR_contextCGOTO:
+    case FFEEXPR_contextFORMAT:
+    case FFEEXPR_contextDIMLIST:
+    case FFEEXPR_contextFILENUM:	/* See equiv code in _ambig_. */
+      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+	break;
+      switch (ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  /* Fall through. */
+	case FFEINFO_basictypeREAL:
+	case FFEINFO_basictypeCOMPLEX:
+	  if (ffe_is_pedantic ())
+	    {
+	      error = TRUE;
+	      break;
+	    }
+	  /* Fall through. */
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  error = FALSE;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      break;
+
+    case FFEEXPR_contextARITHIF:
+      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+	break;
+      switch (ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  if (ffe_is_pedantic ())
+	    {
+	      error = TRUE;
+	      break;
+	    }
+	  /* Fall through. */
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  /* Fall through. */
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeREAL:
+	  error = FALSE;
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      break;
+
+    case FFEEXPR_contextSTOP:
+      if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
+	break;
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeINTEGER:
+	  error = (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT);
+	  break;
+
+	case FFEINFO_basictypeCHARACTER:
+	  error = (ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT);
+	  break;
+
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  error = FALSE;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	case FFEINFO_basictypeNONE:
+	  error = FALSE;
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      if ((expr != NULL) && ((ffebld_op (expr) != FFEBLD_opCONTER)
+			     || (ffebld_conter_orig (expr) != NULL)))
+	error = TRUE;
+      break;
+
+    case FFEEXPR_contextINCLUDE:
+      error = (expr == NULL) || (ffeinfo_rank (info) != 0)
+	|| (ffeinfo_basictype (info) != FFEINFO_basictypeCHARACTER)
+	|| (ffebld_op (expr) != FFEBLD_opCONTER)
+	|| (ffebld_conter_orig (expr) != NULL);
+      break;
+
+    case FFEEXPR_contextSELECTCASE:
+      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+	break;
+      switch (ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeCHARACTER:
+	case FFEINFO_basictypeLOGICAL:
+	  error = FALSE;
+	  break;
+
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  error = FALSE;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      break;
+
+    case FFEEXPR_contextCASE:
+      if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
+	break;
+      switch ((expr == NULL) ? FFEINFO_basictypeINTEGER
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeCHARACTER:
+	case FFEINFO_basictypeLOGICAL:
+	  error = FALSE;
+	  break;
+
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  error = FALSE;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      if ((expr != NULL) && (ffebld_op (expr) != FFEBLD_opCONTER))
+	error = TRUE;
+      break;
+
+    case FFEEXPR_contextCHARACTERSIZE:
+    case FFEEXPR_contextKINDTYPE:
+    case FFEEXPR_contextDIMLISTCOMMON:
+      if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
+	break;
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  /* Fall through. */
+	case FFEINFO_basictypeREAL:
+	case FFEINFO_basictypeCOMPLEX:
+	  if (ffe_is_pedantic ())
+	    {
+	      error = TRUE;
+	      break;
+	    }
+	  /* Fall through. */
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  error = FALSE;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      if ((expr != NULL) && (ffebld_op (expr) != FFEBLD_opCONTER))
+	error = TRUE;
+      break;
+
+    case FFEEXPR_contextEQVINDEX_:
+      if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
+	break;
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeNONE:
+	  error = FALSE;
+	  break;
+
+	case FFEINFO_basictypeLOGICAL:
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  /* Fall through. */
+	case FFEINFO_basictypeREAL:
+	case FFEINFO_basictypeCOMPLEX:
+	  if (ffe_is_pedantic ())
+	    {
+	      error = TRUE;
+	      break;
+	    }
+	  /* Fall through. */
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  error = FALSE;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      if ((expr != NULL) && (ffebld_op (expr) != FFEBLD_opCONTER))
+	error = TRUE;
+      break;
+
+    case FFEEXPR_contextPARAMETER:
+      if (ffeexpr_stack_->is_rhs)
+	error = (expr == NULL) || (ffeinfo_rank (info) != 0)
+	  || (ffebld_op (expr) != FFEBLD_opCONTER);
+      else
+	error = (expr == NULL) || (ffeinfo_rank (info) != 0)
+	  || (ffebld_op (expr) != FFEBLD_opSYMTER);
+      break;
+
+    case FFEEXPR_contextINDEXORACTUALARG_:
+      if (ffelex_token_type (t) == FFELEX_typeCOLON)
+	ffeexpr_stack_->context = FFEEXPR_contextINDEX_;
+      else
+	ffeexpr_stack_->context = FFEEXPR_contextACTUALARG_;
+      goto again;		/* :::::::::::::::::::: */
+
+    case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+      if (ffelex_token_type (t) == FFELEX_typeCOLON)
+	ffeexpr_stack_->context = FFEEXPR_contextINDEX_;
+      else
+	ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+      goto again;		/* :::::::::::::::::::: */
+
+    case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+      if (ffelex_token_type (t) == FFELEX_typeCOLON)
+	ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEX_;
+      else
+	ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARG_;
+      goto again;		/* :::::::::::::::::::: */
+
+    case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+      if (ffelex_token_type (t) == FFELEX_typeCOLON)
+	ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEX_;
+      else
+	ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+      goto again;		/* :::::::::::::::::::: */
+
+    case FFEEXPR_contextIMPDOCTRL_:
+      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+	break;
+      if (!ffeexpr_stack_->is_rhs
+	  && (ffebld_op (expr) != FFEBLD_opSYMTER))
+	error = TRUE;
+      switch (ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  if (! ffe_is_ugly_logint ())
+	    error = TRUE;
+	  if (! ffeexpr_stack_->is_rhs)
+	    break;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+				  ffeinfo_kindtype (info), 0,
+				  FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  break;
+
+	case FFEINFO_basictypeREAL:
+	  if (!ffeexpr_stack_->is_rhs
+	      && ffe_is_warn_surprising ()
+	      && !error)
+	    {
+	      ffebad_start (FFEBAD_DO_REAL);	/* See error message!!! */
+	      ffebad_here (0, ffelex_token_where_line (ft),
+			   ffelex_token_where_column (ft));
+	      ffebad_string (ffelex_token_text (ft));
+	      ffebad_finish ();
+	    }
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      break;
+
+    case FFEEXPR_contextDATAIMPDOCTRL_:
+      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+	break;
+      if (ffeexpr_stack_->is_rhs)
+	{
+	  if ((ffebld_op (expr) != FFEBLD_opCONTER)
+	      && (ffeinfo_where (info) != FFEINFO_whereIMMEDIATE))
+	    error = TRUE;
+	}
+      else if ((ffebld_op (expr) != FFEBLD_opSYMTER)
+	       || (ffeinfo_where (info) != FFEINFO_whereIMMEDIATE))
+	error = TRUE;
+      switch (ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  if (! ffeexpr_stack_->is_rhs)
+	    break;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+				  ffeinfo_kindtype (info), 0,
+				  FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  /* Fall through.  */
+	case FFEINFO_basictypeINTEGER:
+	  if (ffeexpr_stack_->is_rhs
+	      && (ffeinfo_kindtype (ffebld_info (expr))
+		  != FFEINFO_kindtypeINTEGERDEFAULT))
+	    expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+				    FFEINFO_kindtypeINTEGERDEFAULT, 0,
+				    FFETARGET_charactersizeNONE,
+				    FFEEXPR_contextLET);
+	  break;
+
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	case FFEINFO_basictypeREAL:
+	  if (!ffeexpr_stack_->is_rhs
+	      && ffe_is_warn_surprising ()
+	      && !error)
+	    {
+	      ffebad_start (FFEBAD_DO_REAL);	/* See error message!!! */
+	      ffebad_here (0, ffelex_token_where_line (ft),
+			   ffelex_token_where_column (ft));
+	      ffebad_string (ffelex_token_text (ft));
+	      ffebad_finish ();
+	    }
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      break;
+
+    case FFEEXPR_contextIMPDOITEM_:
+      if (ffelex_token_type (t) == FFELEX_typeEQUALS)
+	{
+	  ffeexpr_stack_->is_rhs = FALSE;
+	  ffeexpr_stack_->context = FFEEXPR_contextIMPDOCTRL_;
+	  goto again;		/* :::::::::::::::::::: */
+	}
+      /* Fall through. */
+    case FFEEXPR_contextIOLIST:
+    case FFEEXPR_contextFILEVXTCODE:
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	default:
+	  break;
+	}
+      error = (expr == NULL)
+	|| ((ffeinfo_rank (info) != 0)
+	    && ((ffebld_op (expr) != FFEBLD_opSYMTER)
+		|| (ffesymbol_arraysize (ffebld_symter (expr)) == NULL)
+		|| (ffebld_op (ffesymbol_arraysize (ffebld_symter (expr)))
+		    == FFEBLD_opSTAR)));	/* Bad if null expr, or if
+						   array that is not a SYMTER
+						   (can't happen yet, I
+						   think) or has a NULL or
+						   STAR (assumed) array
+						   size. */
+      break;
+
+    case FFEEXPR_contextIMPDOITEMDF_:
+      if (ffelex_token_type (t) == FFELEX_typeEQUALS)
+	{
+	  ffeexpr_stack_->is_rhs = FALSE;
+	  ffeexpr_stack_->context = FFEEXPR_contextIMPDOCTRL_;
+	  goto again;		/* :::::::::::::::::::: */
+	}
+      /* Fall through. */
+    case FFEEXPR_contextIOLISTDF:
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	default:
+	  break;
+	}
+      error
+	= (expr == NULL)
+	  || ((ffeinfo_basictype (info) == FFEINFO_basictypeCHARACTER)
+	      && (ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT))
+	    || ((ffeinfo_rank (info) != 0)
+		&& ((ffebld_op (expr) != FFEBLD_opSYMTER)
+		    || (ffesymbol_arraysize (ffebld_symter (expr)) == NULL)
+		    || (ffebld_op (ffesymbol_arraysize (ffebld_symter (expr)))
+			== FFEBLD_opSTAR)));	/* Bad if null expr,
+						   non-default-kindtype
+						   character expr, or if
+						   array that is not a SYMTER
+						   (can't happen yet, I
+						   think) or has a NULL or
+						   STAR (assumed) array
+						   size. */
+      break;
+
+    case FFEEXPR_contextDATAIMPDOITEM_:
+      error = (expr == NULL)
+	|| (ffebld_op (expr) != FFEBLD_opARRAYREF)
+	|| ((ffeinfo_where (info) != FFEINFO_whereFLEETING_CADDR)
+	    && (ffeinfo_where (info) != FFEINFO_whereFLEETING_IADDR));
+      break;
+
+    case FFEEXPR_contextDATAIMPDOINDEX_:
+      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+	break;
+      switch (ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  /* Fall through. */
+	case FFEINFO_basictypeREAL:
+	case FFEINFO_basictypeCOMPLEX:
+	  if (ffe_is_pedantic ())
+	    {
+	      error = TRUE;
+	      break;
+	    }
+	  /* Fall through. */
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  error = FALSE;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      if ((ffeinfo_where (info) != FFEINFO_whereCONSTANT)
+	  && (ffeinfo_where (info) != FFEINFO_whereIMMEDIATE))
+	error = TRUE;
+      break;
+
+    case FFEEXPR_contextDATA:
+      if (expr == NULL)
+	error = TRUE;
+      else if (ffeexpr_stack_->is_rhs)
+	error = (ffebld_op (expr) != FFEBLD_opCONTER);
+      else if (ffebld_op (expr) == FFEBLD_opSYMTER)
+	error = FALSE;
+      else
+	error = (ffeinfo_where (info) != FFEINFO_whereFLEETING_CADDR);
+      break;
+
+    case FFEEXPR_contextINITVAL:
+      error = (expr == NULL) || (ffebld_op (expr) != FFEBLD_opCONTER);
+      break;
+
+    case FFEEXPR_contextEQUIVALENCE:
+      if (expr == NULL)
+	error = TRUE;
+      else if (ffebld_op (expr) == FFEBLD_opSYMTER)
+	error = FALSE;
+      else
+	error = (ffeinfo_where (info) != FFEINFO_whereFLEETING_CADDR);
+      break;
+
+    case FFEEXPR_contextFILEASSOC:
+    case FFEEXPR_contextFILEINT:
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeINTEGER:
+	  /* Maybe this should be supported someday, but, right now,
+	     g77 can't generate a call to libf2c to write to an
+	     integer other than the default size.  */
+	  error = ((! ffeexpr_stack_->is_rhs)
+		   && ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT);
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      if ((expr == NULL) || (ffeinfo_rank (info) != 0))
+	error = TRUE;
+      break;
+
+    case FFEEXPR_contextFILEDFINT:
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeINTEGER:
+	  error = (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT);
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      if ((expr == NULL) || (ffeinfo_rank (info) != 0))
+	error = TRUE;
+      break;
+
+    case FFEEXPR_contextFILELOG:
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  error = FALSE;
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      if ((expr == NULL) || (ffeinfo_rank (info) != 0))
+	error = TRUE;
+      break;
+
+    case FFEEXPR_contextFILECHAR:
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeCHARACTER:
+	  error = FALSE;
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      if ((expr == NULL) || (ffeinfo_rank (info) != 0))
+	error = TRUE;
+      break;
+
+    case FFEEXPR_contextFILENUMCHAR:
+      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+	break;
+      switch (ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  /* Fall through. */
+	case FFEINFO_basictypeREAL:
+	case FFEINFO_basictypeCOMPLEX:
+	  if (ffe_is_pedantic ())
+	    {
+	      error = TRUE;
+	      break;
+	    }
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeCHARACTER:
+	  error = FALSE;
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      break;
+
+    case FFEEXPR_contextFILEDFCHAR:
+      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
+	break;
+      switch (ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeCHARACTER:
+	  error
+	    = (ffeinfo_kindtype (info)
+	       != FFEINFO_kindtypeCHARACTERDEFAULT);
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      if (!ffeexpr_stack_->is_rhs
+	  && (ffebld_op (expr) == FFEBLD_opSUBSTR))
+	error = TRUE;
+      break;
+
+    case FFEEXPR_contextFILEUNIT:	/* See equiv code in _ambig_. */
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  if ((error = (ffeinfo_rank (info) != 0)))
+	    break;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  /* Fall through. */
+	case FFEINFO_basictypeREAL:
+	case FFEINFO_basictypeCOMPLEX:
+	  if ((error = (ffeinfo_rank (info) != 0)))
+	    break;
+	  if (ffe_is_pedantic ())
+	    {
+	      error = TRUE;
+	      break;
+	    }
+	  /* Fall through. */
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  if ((error = (ffeinfo_rank (info) != 0)))
+	    break;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	case FFEINFO_basictypeCHARACTER:
+	  switch (ffebld_op (expr))
+	    {			/* As if _lhs had been called instead of
+				   _rhs. */
+	    case FFEBLD_opSYMTER:
+	      error
+		= (ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereCONSTANT);
+	      break;
+
+	    case FFEBLD_opSUBSTR:
+	      error = (ffeinfo_where (ffebld_info (expr))
+		       == FFEINFO_whereCONSTANT_SUBOBJECT);
+	      break;
+
+	    case FFEBLD_opARRAYREF:
+	      error = FALSE;
+	      break;
+
+	    default:
+	      error = TRUE;
+	      break;
+	    }
+	  if (!error
+	   && ((ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT)
+	       || ((ffeinfo_rank (info) != 0)
+		   && ((ffebld_op (expr) != FFEBLD_opSYMTER)
+		     || (ffesymbol_arraysize (ffebld_symter (expr)) == NULL)
+		  || (ffebld_op (ffesymbol_arraysize (ffebld_symter (expr)))
+		      == FFEBLD_opSTAR)))))	/* Bad if
+						   non-default-kindtype
+						   character expr, or if
+						   array that is not a SYMTER
+						   (can't happen yet, I
+						   think), or has a NULL or
+						   STAR (assumed) array
+						   size. */
+	    error = TRUE;
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      break;
+
+    case FFEEXPR_contextFILEFORMAT:
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeINTEGER:
+	  error = (expr == NULL)
+	    || ((ffeinfo_rank (info) != 0) ?
+		ffe_is_pedantic ()	/* F77 C5. */
+		: (bool) (ffeinfo_kindtype (info) != ffecom_label_kind ()))
+	    || (ffebld_op (expr) != FFEBLD_opSYMTER);
+	  break;
+
+	case FFEINFO_basictypeLOGICAL:
+	case FFEINFO_basictypeREAL:
+	case FFEINFO_basictypeCOMPLEX:
+	  /* F77 C5 -- must be an array of hollerith.  */
+	  error
+	    = ffe_is_pedantic ()
+	      || (ffeinfo_rank (info) == 0);
+	  break;
+
+	case FFEINFO_basictypeCHARACTER:
+	  if ((ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT)
+	      || ((ffeinfo_rank (info) != 0)
+		  && ((ffebld_op (expr) != FFEBLD_opSYMTER)
+		      || (ffesymbol_arraysize (ffebld_symter (expr)) == NULL)
+		      || (ffebld_op (ffesymbol_arraysize (ffebld_symter (expr)))
+			  == FFEBLD_opSTAR))))	/* Bad if
+						   non-default-kindtype
+						   character expr, or if
+						   array that is not a SYMTER
+						   (can't happen yet, I
+						   think), or has a NULL or
+						   STAR (assumed) array
+						   size. */
+	    error = TRUE;
+	  else
+	    error = FALSE;
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      break;
+
+    case FFEEXPR_contextLOC_:
+      /* See also ffeintrin_check_loc_.  */
+      if ((expr == NULL)
+	  || (ffeinfo_kind (info) != FFEINFO_kindENTITY)
+	  || ((ffebld_op (expr) != FFEBLD_opSYMTER)
+	      && (ffebld_op (expr) != FFEBLD_opSUBSTR)
+	      && (ffebld_op (expr) != FFEBLD_opARRAYREF)))
+	error = TRUE;
+      break;
+
+    default:
+      error = FALSE;
+      break;
+    }
+
+  if (error && ((expr == NULL) || (ffebld_op (expr) != FFEBLD_opANY)))
+    {
+      ffebad_start (FFEBAD_EXPR_WRONG);
+      ffebad_here (0, ffelex_token_where_line (ft),
+		   ffelex_token_where_column (ft));
+      ffebad_finish ();
+      expr = ffebld_new_any ();
+      ffebld_set_info (expr, ffeinfo_new_any ());
+    }
+
+  callback = ffeexpr_stack_->callback;
+  s = ffeexpr_stack_->previous;
+  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_,
+		  sizeof (*ffeexpr_stack_));
+  ffeexpr_stack_ = s;
+  next = (ffelexHandler) (*callback) (ft, expr, t);
+  ffelex_token_kill (ft);
+  return (ffelexHandler) next;
+}
+
+/* ffeexpr_finished_ambig_ -- Check validity of ambiguous unit/form spec
+
+   ffebld expr;
+   expr = ffeexpr_finished_ambig_(expr);
+
+   Replicates a bit of ffeexpr_finished_'s task when in a context
+   of UNIT or FORMAT.  */
+
+static ffebld
+ffeexpr_finished_ambig_ (ffelexToken ft, ffebld expr)
+{
+  ffeinfo info = ffebld_info (expr);
+  bool error;
+
+  switch (ffeexpr_stack_->context)
+    {
+    case FFEEXPR_contextFILENUMAMBIG:	/* Same as FILENUM in _finished_. */
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  /* Fall through. */
+	case FFEINFO_basictypeREAL:
+	case FFEINFO_basictypeCOMPLEX:
+	  if (ffe_is_pedantic ())
+	    {
+	      error = TRUE;
+	      break;
+	    }
+	  /* Fall through. */
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  error = FALSE;
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      if ((expr == NULL) || (ffeinfo_rank (info) != 0))
+	error = TRUE;
+      break;
+
+    case FFEEXPR_contextFILEUNITAMBIG:	/* Same as FILEUNIT in _finished_. */
+      if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
+	{
+	  error = FALSE;
+	  break;
+	}
+      switch ((expr == NULL) ? FFEINFO_basictypeNONE
+	      : ffeinfo_basictype (info))
+	{
+	case FFEINFO_basictypeLOGICAL:
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
+	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  /* Fall through. */
+	case FFEINFO_basictypeREAL:
+	case FFEINFO_basictypeCOMPLEX:
+	  if (ffe_is_pedantic ())
+	    {
+	      error = TRUE;
+	      break;
+	    }
+	  /* Fall through. */
+	case FFEINFO_basictypeINTEGER:
+	case FFEINFO_basictypeHOLLERITH:
+	case FFEINFO_basictypeTYPELESS:
+	  error = (ffeinfo_rank (info) != 0);
+	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
+	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
+				  FFEEXPR_contextLET);
+	  break;
+
+	case FFEINFO_basictypeCHARACTER:
+	  switch (ffebld_op (expr))
+	    {			/* As if _lhs had been called instead of
+				   _rhs. */
+	    case FFEBLD_opSYMTER:
+	      error
+		= (ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereCONSTANT);
+	      break;
+
+	    case FFEBLD_opSUBSTR:
+	      error = (ffeinfo_where (ffebld_info (expr))
+		       == FFEINFO_whereCONSTANT_SUBOBJECT);
+	      break;
+
+	    case FFEBLD_opARRAYREF:
+	      error = FALSE;
+	      break;
+
+	    default:
+	      error = TRUE;
+	      break;
+	    }
+	  break;
+
+	default:
+	  error = TRUE;
+	  break;
+	}
+      break;
+
+    default:
+      assert ("bad context" == NULL);
+      error = TRUE;
+      break;
+    }
+
+  if (error && ((expr == NULL) || (ffebld_op (expr) != FFEBLD_opANY)))
+    {
+      ffebad_start (FFEBAD_EXPR_WRONG);
+      ffebad_here (0, ffelex_token_where_line (ft),
+		   ffelex_token_where_column (ft));
+      ffebad_finish ();
+      expr = ffebld_new_any ();
+      ffebld_set_info (expr, ffeinfo_new_any ());
+    }
+
+  return expr;
+}
+
+/* ffeexpr_token_lhs_ -- Initial state for lhs expression
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Basically a smaller version of _rhs_; keep them both in sync, of course.  */
+
+static ffelexHandler
+ffeexpr_token_lhs_ (ffelexToken t)
+{
+
+  /* When changing the list of valid initial lhs tokens, check whether to
+     update a corresponding list in ffeexpr_cb_close_paren_ambig_1_ for the
+     READ (expr) <token> case -- it assumes it knows which tokens <token> can
+     be to indicate an lhs (or implied DO), which right now is the set
+     {NAME,OPEN_PAREN}.
+
+     This comment also appears in ffeexpr_token_first_lhs_. */
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+    case FFELEX_typeNAMES:
+      ffeexpr_tokens_[0] = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_token_name_lhs_;
+
+    default:
+      return (ffelexHandler) ffeexpr_finished_ (t);
+    }
+}
+
+/* ffeexpr_token_rhs_ -- Initial state for rhs expression
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   The initial state and the post-binary-operator state are the same and
+   both handled here, with the expression stack used to distinguish
+   between them.  Binary operators are invalid here; unary operators,
+   constants, subexpressions, and name references are valid.  */
+
+static ffelexHandler
+ffeexpr_token_rhs_ (ffelexToken t)
+{
+  ffeexprExpr_ e;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeQUOTE:
+      if (ffe_is_vxt ())
+	{
+	  ffeexpr_tokens_[0] = ffelex_token_use (t);
+	  return (ffelexHandler) ffeexpr_token_quote_;
+	}
+      ffeexpr_tokens_[0] = ffelex_token_use (t);
+      ffelex_set_expecting_hollerith (-1, '\"',
+				      ffelex_token_where_line (t),
+				      ffelex_token_where_column (t));
+      /* Don't have to unset this one. */
+      return (ffelexHandler) ffeexpr_token_apostrophe_;
+
+    case FFELEX_typeAPOSTROPHE:
+      ffeexpr_tokens_[0] = ffelex_token_use (t);
+      ffelex_set_expecting_hollerith (-1, '\'',
+				      ffelex_token_where_line (t),
+				      ffelex_token_where_column (t));
+      /* Don't have to unset this one. */
+      return (ffelexHandler) ffeexpr_token_apostrophe_;
+
+    case FFELEX_typePERCENT:
+      ffeexpr_tokens_[0] = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_token_percent_;
+
+    case FFELEX_typeOPEN_PAREN:
+      ffeexpr_stack_->tokens[0] = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					  FFEEXPR_contextPAREN_,
+					  ffeexpr_cb_close_paren_c_);
+
+    case FFELEX_typePLUS:
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeUNARY_;
+      e->token = ffelex_token_use (t);
+      e->u.operator.op = FFEEXPR_operatorADD_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceADD_;
+      e->u.operator.as = FFEEXPR_operatorassociativityADD_;
+      ffeexpr_exprstack_push_unary_ (e);
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+    case FFELEX_typeMINUS:
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeUNARY_;
+      e->token = ffelex_token_use (t);
+      e->u.operator.op = FFEEXPR_operatorSUBTRACT_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceSUBTRACT_;
+      e->u.operator.as = FFEEXPR_operatorassociativitySUBTRACT_;
+      ffeexpr_exprstack_push_unary_ (e);
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+    case FFELEX_typePERIOD:
+      ffeexpr_tokens_[0] = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_token_period_;
+
+    case FFELEX_typeNUMBER:
+      ffeexpr_tokens_[0] = ffelex_token_use (t);
+      ffeexpr_hollerith_count_ = atol (ffelex_token_text (t));
+      if (ffeexpr_hollerith_count_ > 0)
+	ffelex_set_expecting_hollerith (ffeexpr_hollerith_count_,
+					'\0',
+					ffelex_token_where_line (t),
+					ffelex_token_where_column (t));
+      return (ffelexHandler) ffeexpr_token_number_;
+
+    case FFELEX_typeNAME:
+    case FFELEX_typeNAMES:
+      ffeexpr_tokens_[0] = ffelex_token_use (t);
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextACTUALARG_:
+	case FFEEXPR_contextINDEXORACTUALARG_:
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+	  return (ffelexHandler) ffeexpr_token_name_arg_;
+
+	default:
+	  return (ffelexHandler) ffeexpr_token_name_rhs_;
+	}
+
+    case FFELEX_typeASTERISK:
+    case FFELEX_typeSLASH:
+    case FFELEX_typePOWER:
+    case FFELEX_typeCONCAT:
+    case FFELEX_typeREL_EQ:
+    case FFELEX_typeREL_NE:
+    case FFELEX_typeREL_LE:
+    case FFELEX_typeREL_GE:
+      if (ffest_ffebad_start (FFEBAD_MISSING_FIRST_BINARY_OPERAND))
+	{
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_finish ();
+	}
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+#if 0
+    case FFELEX_typeEQUALS:
+    case FFELEX_typePOINTS:
+    case FFELEX_typeCLOSE_ANGLE:
+    case FFELEX_typeCLOSE_PAREN:
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLON:
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+#endif
+    default:
+      return (ffelexHandler) ffeexpr_finished_ (t);
+    }
+}
+
+/* ffeexpr_token_period_ -- Rhs PERIOD
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Handle a period detected at rhs (expecting unary op or operand) state.
+   Must begin a floating-point value (as in .12) or a dot-dot name, of
+   which only .NOT., .TRUE., and .FALSE. are truly valid.  Other sort-of-
+   valid names represent binary operators, which are invalid here because
+   there isn't an operand at the top of the stack.  */
+
+static ffelexHandler
+ffeexpr_token_period_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+    case FFELEX_typeNAMES:
+      ffeexpr_current_dotdot_ = ffestr_other (t);
+      switch (ffeexpr_current_dotdot_)
+	{
+	case FFESTR_otherNone:
+	  if (ffest_ffebad_start (FFEBAD_IGNORING_PERIOD))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+			   ffelex_token_where_column (ffeexpr_tokens_[0]));
+	      ffebad_finish ();
+	    }
+	  ffelex_token_kill (ffeexpr_tokens_[0]);
+	  return (ffelexHandler) ffeexpr_token_rhs_ (t);
+
+	case FFESTR_otherTRUE:
+	case FFESTR_otherFALSE:
+	case FFESTR_otherNOT:
+	  ffeexpr_tokens_[1] = ffelex_token_use (t);
+	  return (ffelexHandler) ffeexpr_token_end_period_;
+
+	default:
+	  if (ffest_ffebad_start (FFEBAD_MISSING_FIRST_BINARY_OPERAND))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (t),
+			   ffelex_token_where_column (t));
+	      ffebad_finish ();
+	    }
+	  ffelex_token_kill (ffeexpr_tokens_[0]);
+	  return (ffelexHandler) ffeexpr_token_swallow_period_;
+	}
+      break;			/* Nothing really reaches here. */
+
+    case FFELEX_typeNUMBER:
+      ffeexpr_tokens_[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_token_real_;
+
+    default:
+      if (ffest_ffebad_start (FFEBAD_IGNORING_PERIOD))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+		       ffelex_token_where_column (ffeexpr_tokens_[0]));
+	  ffebad_finish ();
+	}
+      ffelex_token_kill (ffeexpr_tokens_[0]);
+      return (ffelexHandler) ffeexpr_token_rhs_ (t);
+    }
+}
+
+/* ffeexpr_token_end_period_ -- Rhs PERIOD NAME(NOT, TRUE, or FALSE)
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Expecting a period to close a .NOT, .TRUE, or .FALSE at rhs (unary op
+   or operator) state.	If period isn't found, issue a diagnostic but
+   pretend we saw one.	ffeexpr_current_dotdot_ must already contained the
+   dotdot representation of the name in between the two PERIOD tokens.	*/
+
+static ffelexHandler
+ffeexpr_token_end_period_ (ffelexToken t)
+{
+  ffeexprExpr_ e;
+
+  if (ffelex_token_type (t) != FFELEX_typePERIOD)
+    {
+      if (ffest_ffebad_start (FFEBAD_INSERTING_PERIOD))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+		       ffelex_token_where_column (ffeexpr_tokens_[0]));
+	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_string (ffelex_token_text (ffeexpr_tokens_[1]));
+	  ffebad_finish ();
+	}
+    }
+
+  ffelex_token_kill (ffeexpr_tokens_[1]);	/* Kill "NOT"/"TRUE"/"FALSE"
+						   token. */
+
+  e = ffeexpr_expr_new_ ();
+  e->token = ffeexpr_tokens_[0];
+
+  switch (ffeexpr_current_dotdot_)
+    {
+    case FFESTR_otherNOT:
+      e->type = FFEEXPR_exprtypeUNARY_;
+      e->u.operator.op = FFEEXPR_operatorNOT_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceNOT_;
+      e->u.operator.as = FFEEXPR_operatorassociativityNOT_;
+      ffeexpr_exprstack_push_unary_ (e);
+      if (ffelex_token_type (t) != FFELEX_typePERIOD)
+	return (ffelexHandler) ffeexpr_token_rhs_ (t);
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+    case FFESTR_otherTRUE:
+      e->type = FFEEXPR_exprtypeOPERAND_;
+      e->u.operand
+	= ffebld_new_conter (ffebld_constant_new_logicaldefault (TRUE));
+      ffebld_set_info (e->u.operand,
+      ffeinfo_new (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICALDEFAULT,
+		   0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
+      ffeexpr_exprstack_push_operand_ (e);
+      if (ffelex_token_type (t) != FFELEX_typePERIOD)
+	return (ffelexHandler) ffeexpr_token_binary_ (t);
+      return (ffelexHandler) ffeexpr_token_binary_;
+
+    case FFESTR_otherFALSE:
+      e->type = FFEEXPR_exprtypeOPERAND_;
+      e->u.operand
+	= ffebld_new_conter (ffebld_constant_new_logicaldefault (FALSE));
+      ffebld_set_info (e->u.operand,
+      ffeinfo_new (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICALDEFAULT,
+		   0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
+      ffeexpr_exprstack_push_operand_ (e);
+      if (ffelex_token_type (t) != FFELEX_typePERIOD)
+	return (ffelexHandler) ffeexpr_token_binary_ (t);
+      return (ffelexHandler) ffeexpr_token_binary_;
+
+    default:
+      assert ("Bad unary dotdot in ffeexpr_current_dotdot_" == NULL);
+      exit (0);
+      return NULL;
+    }
+}
+
+/* ffeexpr_token_swallow_period_ -- Rhs PERIOD NAME(not NOT, TRUE, or FALSE)
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   A diagnostic has already been issued; just swallow a period if there is
+   one, then continue with ffeexpr_token_rhs_.	*/
+
+static ffelexHandler
+ffeexpr_token_swallow_period_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typePERIOD)
+    return (ffelexHandler) ffeexpr_token_rhs_ (t);
+
+  return (ffelexHandler) ffeexpr_token_rhs_;
+}
+
+/* ffeexpr_token_real_ -- Rhs PERIOD NUMBER
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   After a period and a string of digits, check next token for possible
+   exponent designation (D, E, or Q as first/only character) and continue
+   real-number handling accordingly.  Else form basic real constant, push
+   onto expression stack, and enter binary state using current token (which,
+   if it is a name not beginning with D, E, or Q, will certainly result
+   in an error, but that's not for this routine to deal with).	*/
+
+static ffelexHandler
+ffeexpr_token_real_ (ffelexToken t)
+{
+  char d;
+  const char *p;
+
+  if (((ffelex_token_type (t) != FFELEX_typeNAME)
+       && (ffelex_token_type (t) != FFELEX_typeNAMES))
+      || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+				     'D', 'd')
+	     || ffesrc_char_match_init (d, 'E', 'e')
+	     || ffesrc_char_match_init (d, 'Q', 'q')))
+	   && ffeexpr_isdigits_ (++p)))
+    {
+#if 0
+      /* This code has been removed because it seems inconsistent to
+	 produce a diagnostic in this case, but not all of the other
+	 ones that look for an exponent and cannot recognize one.  */
+      if (((ffelex_token_type (t) == FFELEX_typeNAME)
+	   || (ffelex_token_type (t) == FFELEX_typeNAMES))
+	  && ffest_ffebad_start (FFEBAD_INVALID_EXPONENT))
+	{
+	  char bad[2];
+
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (ffeexpr_tokens_[0]),
+		       ffelex_token_where_column (ffeexpr_tokens_[0]));
+	  bad[0] = *(p - 1);
+	  bad[1] = '\0';
+	  ffebad_string (bad);
+	  ffebad_finish ();
+	}
+#endif
+      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'), NULL,
+				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+				 NULL, NULL, NULL);
+
+      ffelex_token_kill (ffeexpr_tokens_[0]);
+      ffelex_token_kill (ffeexpr_tokens_[1]);
+      return (ffelexHandler) ffeexpr_token_binary_ (t);
+    }
+
+  /* Just exponent character by itself?	 In which case, PLUS or MINUS must
+     surely be next, followed by a NUMBER token. */
+
+  if (*p == '\0')
+    {
+      ffeexpr_tokens_[2] = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_token_real_exponent_;
+    }
+
+  ffeexpr_make_float_const_ (d, NULL, ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+			     t, NULL, NULL);
+
+  ffelex_token_kill (ffeexpr_tokens_[0]);
+  ffelex_token_kill (ffeexpr_tokens_[1]);
+  return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_real_exponent_ -- Rhs PERIOD NUMBER NAME(D, E, or Q)
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Ensures this token is PLUS or MINUS, preserves it, goes to final state
+   for real number (exponent digits).  Else issues diagnostic, assumes a
+   zero exponent field for number, passes token on to binary state as if
+   previous token had been "E0" instead of "E", for example.  */
+
+static ffelexHandler
+ffeexpr_token_real_exponent_ (ffelexToken t)
+{
+  if ((ffelex_token_type (t) != FFELEX_typePLUS)
+      && (ffelex_token_type (t) != FFELEX_typeMINUS))
+    {
+      if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[2]),
+		       ffelex_token_where_column (ffeexpr_tokens_[2]));
+	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_finish ();
+	}
+
+      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'), NULL,
+				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+				 NULL, NULL, NULL);
+
+      ffelex_token_kill (ffeexpr_tokens_[0]);
+      ffelex_token_kill (ffeexpr_tokens_[1]);
+      ffelex_token_kill (ffeexpr_tokens_[2]);
+      return (ffelexHandler) ffeexpr_token_binary_ (t);
+    }
+
+  ffeexpr_tokens_[3] = ffelex_token_use (t);
+  return (ffelexHandler) ffeexpr_token_real_exp_sign_;
+}
+
+/* ffeexpr_token_real_exp_sign_ -- Rhs PERIOD NUMBER NAME(D,E,Q) PLUS/MINUS
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Make sure token is a NUMBER, make a real constant out of all we have and
+   push it onto the expression stack.  Else issue diagnostic and pretend
+   exponent field was a zero.  */
+
+static ffelexHandler
+ffeexpr_token_real_exp_sign_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+    {
+      if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[2]),
+		       ffelex_token_where_column (ffeexpr_tokens_[2]));
+	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_finish ();
+	}
+
+      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'), NULL,
+				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+				 NULL, NULL, NULL);
+
+      ffelex_token_kill (ffeexpr_tokens_[0]);
+      ffelex_token_kill (ffeexpr_tokens_[1]);
+      ffelex_token_kill (ffeexpr_tokens_[2]);
+      ffelex_token_kill (ffeexpr_tokens_[3]);
+      return (ffelexHandler) ffeexpr_token_binary_ (t);
+    }
+
+  ffeexpr_make_float_const_ (ffelex_token_text (ffeexpr_tokens_[2])[0], NULL,
+		 ffeexpr_tokens_[0], ffeexpr_tokens_[1], ffeexpr_tokens_[2],
+			     ffeexpr_tokens_[3], t);
+
+  ffelex_token_kill (ffeexpr_tokens_[0]);
+  ffelex_token_kill (ffeexpr_tokens_[1]);
+  ffelex_token_kill (ffeexpr_tokens_[2]);
+  ffelex_token_kill (ffeexpr_tokens_[3]);
+  return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_number_ -- Rhs NUMBER
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   If the token is a period, we may have a floating-point number, or an
+   integer followed by a dotdot binary operator.  If the token is a name
+   beginning with D, E, or Q, we definitely have a floating-point number.
+   If the token is a hollerith constant, that's what we've got, so push
+   it onto the expression stack and continue with the binary state.
+
+   Otherwise, we have an integer followed by something the binary state
+   should be able to swallow.  */
+
+static ffelexHandler
+ffeexpr_token_number_ (ffelexToken t)
+{
+  ffeexprExpr_ e;
+  ffeinfo ni;
+  char d;
+  const char *p;
+
+  if (ffeexpr_hollerith_count_ > 0)
+    ffelex_set_expecting_hollerith (0, '\0',
+				    ffewhere_line_unknown (),
+				    ffewhere_column_unknown ());
+
+  /* See if we've got a floating-point number here. */
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+    case FFELEX_typeNAMES:
+      if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+				   'D', 'd')
+	   || ffesrc_char_match_init (d, 'E', 'e')
+	   || ffesrc_char_match_init (d, 'Q', 'q'))
+	  && ffeexpr_isdigits_ (++p))
+	{
+
+	  /* Just exponent character by itself?	 In which case, PLUS or MINUS
+	     must surely be next, followed by a NUMBER token. */
+
+	  if (*p == '\0')
+	    {
+	      ffeexpr_tokens_[1] = ffelex_token_use (t);
+	      return (ffelexHandler) ffeexpr_token_number_exponent_;
+	    }
+	  ffeexpr_make_float_const_ (d, ffeexpr_tokens_[0], NULL, NULL, t,
+				     NULL, NULL);
+
+	  ffelex_token_kill (ffeexpr_tokens_[0]);
+	  return (ffelexHandler) ffeexpr_token_binary_;
+	}
+      break;
+
+    case FFELEX_typePERIOD:
+      ffeexpr_tokens_[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_token_number_period_;
+
+    case FFELEX_typeHOLLERITH:
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeOPERAND_;
+      e->token = ffeexpr_tokens_[0];
+      e->u.operand = ffebld_new_conter (ffebld_constant_new_hollerith (t));
+      ni = ffeinfo_new (FFEINFO_basictypeHOLLERITH, FFEINFO_kindtypeNONE,
+			0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+			ffelex_token_length (t));
+      ffebld_set_info (e->u.operand, ni);
+      ffeexpr_exprstack_push_operand_ (e);
+      return (ffelexHandler) ffeexpr_token_binary_;
+
+    default:
+      break;
+    }
+
+  /* Nothing specific we were looking for, so make an integer and pass the
+     current token to the binary state. */
+
+  ffeexpr_make_float_const_ ('I', ffeexpr_tokens_[0], NULL, NULL,
+			     NULL, NULL, NULL);
+  return (ffelexHandler) ffeexpr_token_binary_ (t);
+}
+
+/* ffeexpr_token_number_exponent_ -- Rhs NUMBER NAME(D, E, or Q)
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Ensures this token is PLUS or MINUS, preserves it, goes to final state
+   for real number (exponent digits).  Else treats number as integer, passes
+   name to binary, passes current token to subsequent handler.  */
+
+static ffelexHandler
+ffeexpr_token_number_exponent_ (ffelexToken t)
+{
+  if ((ffelex_token_type (t) != FFELEX_typePLUS)
+      && (ffelex_token_type (t) != FFELEX_typeMINUS))
+    {
+      ffeexprExpr_ e;
+      ffelexHandler nexthandler;
+
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeOPERAND_;
+      e->token = ffeexpr_tokens_[0];
+      e->u.operand = ffebld_new_conter (ffebld_constant_new_integerdefault
+					(ffeexpr_tokens_[0]));
+      ffebld_set_info (e->u.operand,
+      ffeinfo_new (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGERDEFAULT,
+		   0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
+      ffeexpr_exprstack_push_operand_ (e);
+      nexthandler = (ffelexHandler) ffeexpr_token_binary_ (ffeexpr_tokens_[1]);
+      ffelex_token_kill (ffeexpr_tokens_[1]);
+      return (ffelexHandler) (*nexthandler) (t);
+    }
+
+  ffeexpr_tokens_[2] = ffelex_token_use (t);
+  return (ffelexHandler) ffeexpr_token_number_exp_sign_;
+}
+
+/* ffeexpr_token_number_exp_sign_ -- Rhs NUMBER NAME(D,E,Q) PLUS/MINUS
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Make sure token is a NUMBER, make a real constant out of all we have and
+   push it onto the expression stack.  Else issue diagnostic and pretend
+   exponent field was a zero.  */
+
+static ffelexHandler
+ffeexpr_token_number_exp_sign_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+    {
+      if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[1]),
+		       ffelex_token_where_column (ffeexpr_tokens_[1]));
+	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_finish ();
+	}
+
+      ffeexpr_make_float_const_ (ffelex_token_text (ffeexpr_tokens_[1])[0],
+				 ffeexpr_tokens_[0], NULL, NULL,
+				 ffeexpr_tokens_[1], ffeexpr_tokens_[2],
+				 NULL);
+
+      ffelex_token_kill (ffeexpr_tokens_[0]);
+      ffelex_token_kill (ffeexpr_tokens_[1]);
+      ffelex_token_kill (ffeexpr_tokens_[2]);
+      return (ffelexHandler) ffeexpr_token_binary_ (t);
+    }
+
+  ffeexpr_make_float_const_ (ffelex_token_text (ffeexpr_tokens_[1])[0],
+			     ffeexpr_tokens_[0], NULL, NULL,
+			     ffeexpr_tokens_[1], ffeexpr_tokens_[2], t);
+
+  ffelex_token_kill (ffeexpr_tokens_[0]);
+  ffelex_token_kill (ffeexpr_tokens_[1]);
+  ffelex_token_kill (ffeexpr_tokens_[2]);
+  return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_number_period_ -- Rhs NUMBER PERIOD
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Handle a period detected following a number at rhs state.  Must begin a
+   floating-point value (as in 1., 1.2, 1.E3, or 1.E+3) or a dot-dot name.  */
+
+static ffelexHandler
+ffeexpr_token_number_period_ (ffelexToken t)
+{
+  ffeexprExpr_ e;
+  ffelexHandler nexthandler;
+  const char *p;
+  char d;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+    case FFELEX_typeNAMES:
+      if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+				   'D', 'd')
+	   || ffesrc_char_match_init (d, 'E', 'e')
+	   || ffesrc_char_match_init (d, 'Q', 'q'))
+	  && ffeexpr_isdigits_ (++p))
+	{
+
+	  /* Just exponent character by itself?	 In which case, PLUS or MINUS
+	     must surely be next, followed by a NUMBER token. */
+
+	  if (*p == '\0')
+	    {
+	      ffeexpr_tokens_[2] = ffelex_token_use (t);
+	      return (ffelexHandler) ffeexpr_token_number_per_exp_;
+	    }
+	  ffeexpr_make_float_const_ (d, ffeexpr_tokens_[0],
+				     ffeexpr_tokens_[1], NULL, t, NULL,
+				     NULL);
+
+	  ffelex_token_kill (ffeexpr_tokens_[0]);
+	  ffelex_token_kill (ffeexpr_tokens_[1]);
+	  return (ffelexHandler) ffeexpr_token_binary_;
+	}
+      /* A name not representing an exponent, so assume it will be something
+	 like EQ, make an integer from the number, pass the period to binary
+	 state and the current token to the resulting state. */
+
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeOPERAND_;
+      e->token = ffeexpr_tokens_[0];
+      e->u.operand = ffebld_new_conter (ffebld_constant_new_integerdefault
+					(ffeexpr_tokens_[0]));
+      ffebld_set_info (e->u.operand,
+		       ffeinfo_new (FFEINFO_basictypeINTEGER,
+				    FFEINFO_kindtypeINTEGERDEFAULT, 0,
+				  FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+				    FFETARGET_charactersizeNONE));
+      ffeexpr_exprstack_push_operand_ (e);
+      nexthandler = (ffelexHandler) ffeexpr_token_binary_
+	(ffeexpr_tokens_[1]);
+      ffelex_token_kill (ffeexpr_tokens_[1]);
+      return (ffelexHandler) (*nexthandler) (t);
+
+    case FFELEX_typeNUMBER:
+      ffeexpr_tokens_[2] = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_token_number_real_;
+
+    default:
+      break;
+    }
+
+  /* Nothing specific we were looking for, so make a real number and pass the
+     period and then the current token to the binary state. */
+
+  ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
+			     ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+			     NULL, NULL, NULL, NULL);
+
+  ffelex_token_kill (ffeexpr_tokens_[0]);
+  ffelex_token_kill (ffeexpr_tokens_[1]);
+  return (ffelexHandler) ffeexpr_token_binary_ (t);
+}
+
+/* ffeexpr_token_number_per_exp_ -- Rhs NUMBER PERIOD NAME(D, E, or Q)
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Ensures this token is PLUS or MINUS, preserves it, goes to final state
+   for real number (exponent digits).  Else treats number as real, passes
+   name to binary, passes current token to subsequent handler.	*/
+
+static ffelexHandler
+ffeexpr_token_number_per_exp_ (ffelexToken t)
+{
+  if ((ffelex_token_type (t) != FFELEX_typePLUS)
+      && (ffelex_token_type (t) != FFELEX_typeMINUS))
+    {
+      ffelexHandler nexthandler;
+
+      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
+				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+				 NULL, NULL, NULL, NULL);
+
+      ffelex_token_kill (ffeexpr_tokens_[0]);
+      ffelex_token_kill (ffeexpr_tokens_[1]);
+      nexthandler = (ffelexHandler) ffeexpr_token_binary_ (ffeexpr_tokens_[2]);
+      ffelex_token_kill (ffeexpr_tokens_[2]);
+      return (ffelexHandler) (*nexthandler) (t);
+    }
+
+  ffeexpr_tokens_[3] = ffelex_token_use (t);
+  return (ffelexHandler) ffeexpr_token_num_per_exp_sign_;
+}
+
+/* ffeexpr_token_number_real_ -- Rhs NUMBER PERIOD NUMBER
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   After a number, period, and number, check next token for possible
+   exponent designation (D, E, or Q as first/only character) and continue
+   real-number handling accordingly.  Else form basic real constant, push
+   onto expression stack, and enter binary state using current token (which,
+   if it is a name not beginning with D, E, or Q, will certainly result
+   in an error, but that's not for this routine to deal with).	*/
+
+static ffelexHandler
+ffeexpr_token_number_real_ (ffelexToken t)
+{
+  char d;
+  const char *p;
+
+  if (((ffelex_token_type (t) != FFELEX_typeNAME)
+       && (ffelex_token_type (t) != FFELEX_typeNAMES))
+      || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
+				     'D', 'd')
+	     || ffesrc_char_match_init (d, 'E', 'e')
+	     || ffesrc_char_match_init (d, 'Q', 'q')))
+	   && ffeexpr_isdigits_ (++p)))
+    {
+#if 0
+      /* This code has been removed because it seems inconsistent to
+	 produce a diagnostic in this case, but not all of the other
+	 ones that look for an exponent and cannot recognize one.  */
+      if (((ffelex_token_type (t) == FFELEX_typeNAME)
+	   || (ffelex_token_type (t) == FFELEX_typeNAMES))
+	  && ffest_ffebad_start (FFEBAD_INVALID_EXPONENT))
+	{
+	  char bad[2];
+
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (ffeexpr_tokens_[0]),
+		       ffelex_token_where_column (ffeexpr_tokens_[0]));
+	  bad[0] = *(p - 1);
+	  bad[1] = '\0';
+	  ffebad_string (bad);
+	  ffebad_finish ();
+	}
+#endif
+      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
+				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+				 ffeexpr_tokens_[2], NULL, NULL, NULL);
+
+      ffelex_token_kill (ffeexpr_tokens_[0]);
+      ffelex_token_kill (ffeexpr_tokens_[1]);
+      ffelex_token_kill (ffeexpr_tokens_[2]);
+      return (ffelexHandler) ffeexpr_token_binary_ (t);
+    }
+
+  /* Just exponent character by itself?	 In which case, PLUS or MINUS must
+     surely be next, followed by a NUMBER token. */
+
+  if (*p == '\0')
+    {
+      ffeexpr_tokens_[3] = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_token_number_real_exp_;
+    }
+
+  ffeexpr_make_float_const_ (d, ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+			     ffeexpr_tokens_[2], t, NULL, NULL);
+
+  ffelex_token_kill (ffeexpr_tokens_[0]);
+  ffelex_token_kill (ffeexpr_tokens_[1]);
+  ffelex_token_kill (ffeexpr_tokens_[2]);
+  return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_num_per_exp_sign_ -- Rhs NUMBER PERIOD NAME(D,E,Q) PLUS/MINUS
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Make sure token is a NUMBER, make a real constant out of all we have and
+   push it onto the expression stack.  Else issue diagnostic and pretend
+   exponent field was a zero.  */
+
+static ffelexHandler
+ffeexpr_token_num_per_exp_sign_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+    {
+      if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[2]),
+		       ffelex_token_where_column (ffeexpr_tokens_[2]));
+	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_finish ();
+	}
+
+      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
+				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+				 NULL, NULL, NULL, NULL);
+
+      ffelex_token_kill (ffeexpr_tokens_[0]);
+      ffelex_token_kill (ffeexpr_tokens_[1]);
+      ffelex_token_kill (ffeexpr_tokens_[2]);
+      ffelex_token_kill (ffeexpr_tokens_[3]);
+      return (ffelexHandler) ffeexpr_token_binary_ (t);
+    }
+
+  ffeexpr_make_float_const_ (ffelex_token_text (ffeexpr_tokens_[2])[0],
+			     ffeexpr_tokens_[0], ffeexpr_tokens_[1], NULL,
+			     ffeexpr_tokens_[2], ffeexpr_tokens_[3], t);
+
+  ffelex_token_kill (ffeexpr_tokens_[0]);
+  ffelex_token_kill (ffeexpr_tokens_[1]);
+  ffelex_token_kill (ffeexpr_tokens_[2]);
+  ffelex_token_kill (ffeexpr_tokens_[3]);
+  return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_number_real_exp_ -- Rhs NUMBER PERIOD NUMBER NAME(D, E, or Q)
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Ensures this token is PLUS or MINUS, preserves it, goes to final state
+   for real number (exponent digits).  Else issues diagnostic, assumes a
+   zero exponent field for number, passes token on to binary state as if
+   previous token had been "E0" instead of "E", for example.  */
+
+static ffelexHandler
+ffeexpr_token_number_real_exp_ (ffelexToken t)
+{
+  if ((ffelex_token_type (t) != FFELEX_typePLUS)
+      && (ffelex_token_type (t) != FFELEX_typeMINUS))
+    {
+      if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[3]),
+		       ffelex_token_where_column (ffeexpr_tokens_[3]));
+	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_finish ();
+	}
+
+      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
+				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+				 ffeexpr_tokens_[2], NULL, NULL, NULL);
+
+      ffelex_token_kill (ffeexpr_tokens_[0]);
+      ffelex_token_kill (ffeexpr_tokens_[1]);
+      ffelex_token_kill (ffeexpr_tokens_[2]);
+      ffelex_token_kill (ffeexpr_tokens_[3]);
+      return (ffelexHandler) ffeexpr_token_binary_ (t);
+    }
+
+  ffeexpr_tokens_[4] = ffelex_token_use (t);
+  return (ffelexHandler) ffeexpr_token_num_real_exp_sn_;
+}
+
+/* ffeexpr_token_num_real_exp_sn_ -- Rhs NUMBER PERIOD NUMBER NAME(D,E,Q)
+				  PLUS/MINUS
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Make sure token is a NUMBER, make a real constant out of all we have and
+   push it onto the expression stack.  Else issue diagnostic and pretend
+   exponent field was a zero.  */
+
+static ffelexHandler
+ffeexpr_token_num_real_exp_sn_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+    {
+      if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[3]),
+		       ffelex_token_where_column (ffeexpr_tokens_[3]));
+	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_finish ();
+	}
+
+      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
+				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+				 ffeexpr_tokens_[2], NULL, NULL, NULL);
+
+      ffelex_token_kill (ffeexpr_tokens_[0]);
+      ffelex_token_kill (ffeexpr_tokens_[1]);
+      ffelex_token_kill (ffeexpr_tokens_[2]);
+      ffelex_token_kill (ffeexpr_tokens_[3]);
+      ffelex_token_kill (ffeexpr_tokens_[4]);
+      return (ffelexHandler) ffeexpr_token_binary_ (t);
+    }
+
+  ffeexpr_make_float_const_ (ffelex_token_text (ffeexpr_tokens_[3])[0],
+			     ffeexpr_tokens_[0], ffeexpr_tokens_[1],
+			     ffeexpr_tokens_[2], ffeexpr_tokens_[3],
+			     ffeexpr_tokens_[4], t);
+
+  ffelex_token_kill (ffeexpr_tokens_[0]);
+  ffelex_token_kill (ffeexpr_tokens_[1]);
+  ffelex_token_kill (ffeexpr_tokens_[2]);
+  ffelex_token_kill (ffeexpr_tokens_[3]);
+  ffelex_token_kill (ffeexpr_tokens_[4]);
+  return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_binary_ -- Handle binary operator possibility
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   The possibility of a binary operator is handled here, meaning the previous
+   token was an operand.  */
+
+static ffelexHandler
+ffeexpr_token_binary_ (ffelexToken t)
+{
+  ffeexprExpr_ e;
+
+  if (!ffeexpr_stack_->is_rhs)
+    return (ffelexHandler) ffeexpr_finished_ (t);	/* For now. */
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typePLUS:
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeBINARY_;
+      e->token = ffelex_token_use (t);
+      e->u.operator.op = FFEEXPR_operatorADD_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceADD_;
+      e->u.operator.as = FFEEXPR_operatorassociativityADD_;
+      ffeexpr_exprstack_push_binary_ (e);
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+    case FFELEX_typeMINUS:
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeBINARY_;
+      e->token = ffelex_token_use (t);
+      e->u.operator.op = FFEEXPR_operatorSUBTRACT_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceSUBTRACT_;
+      e->u.operator.as = FFEEXPR_operatorassociativitySUBTRACT_;
+      ffeexpr_exprstack_push_binary_ (e);
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+    case FFELEX_typeASTERISK:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextDATA:
+	  return (ffelexHandler) ffeexpr_finished_ (t);
+
+	default:
+	  break;
+	}
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeBINARY_;
+      e->token = ffelex_token_use (t);
+      e->u.operator.op = FFEEXPR_operatorMULTIPLY_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceMULTIPLY_;
+      e->u.operator.as = FFEEXPR_operatorassociativityMULTIPLY_;
+      ffeexpr_exprstack_push_binary_ (e);
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+    case FFELEX_typeSLASH:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextDATA:
+	  return (ffelexHandler) ffeexpr_finished_ (t);
+
+	default:
+	  break;
+	}
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeBINARY_;
+      e->token = ffelex_token_use (t);
+      e->u.operator.op = FFEEXPR_operatorDIVIDE_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceDIVIDE_;
+      e->u.operator.as = FFEEXPR_operatorassociativityDIVIDE_;
+      ffeexpr_exprstack_push_binary_ (e);
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+    case FFELEX_typePOWER:
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeBINARY_;
+      e->token = ffelex_token_use (t);
+      e->u.operator.op = FFEEXPR_operatorPOWER_;
+      e->u.operator.prec = FFEEXPR_operatorprecedencePOWER_;
+      e->u.operator.as = FFEEXPR_operatorassociativityPOWER_;
+      ffeexpr_exprstack_push_binary_ (e);
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+    case FFELEX_typeCONCAT:
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeBINARY_;
+      e->token = ffelex_token_use (t);
+      e->u.operator.op = FFEEXPR_operatorCONCATENATE_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceCONCATENATE_;
+      e->u.operator.as = FFEEXPR_operatorassociativityCONCATENATE_;
+      ffeexpr_exprstack_push_binary_ (e);
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+    case FFELEX_typeOPEN_ANGLE:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextFORMAT:
+	  ffebad_start (FFEBAD_FORMAT_EXPR_TOKEN);
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_finish ();
+	  break;
+
+	default:
+	  break;
+	}
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeBINARY_;
+      e->token = ffelex_token_use (t);
+      e->u.operator.op = FFEEXPR_operatorLT_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceLT_;
+      e->u.operator.as = FFEEXPR_operatorassociativityLT_;
+      ffeexpr_exprstack_push_binary_ (e);
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+    case FFELEX_typeCLOSE_ANGLE:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextFORMAT:
+	  return ffeexpr_finished_ (t);
+
+	default:
+	  break;
+	}
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeBINARY_;
+      e->token = ffelex_token_use (t);
+      e->u.operator.op = FFEEXPR_operatorGT_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceGT_;
+      e->u.operator.as = FFEEXPR_operatorassociativityGT_;
+      ffeexpr_exprstack_push_binary_ (e);
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+    case FFELEX_typeREL_EQ:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextFORMAT:
+	  ffebad_start (FFEBAD_FORMAT_EXPR_TOKEN);
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_finish ();
+	  break;
+
+	default:
+	  break;
+	}
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeBINARY_;
+      e->token = ffelex_token_use (t);
+      e->u.operator.op = FFEEXPR_operatorEQ_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceEQ_;
+      e->u.operator.as = FFEEXPR_operatorassociativityEQ_;
+      ffeexpr_exprstack_push_binary_ (e);
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+    case FFELEX_typeREL_NE:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextFORMAT:
+	  ffebad_start (FFEBAD_FORMAT_EXPR_TOKEN);
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_finish ();
+	  break;
+
+	default:
+	  break;
+	}
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeBINARY_;
+      e->token = ffelex_token_use (t);
+      e->u.operator.op = FFEEXPR_operatorNE_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceNE_;
+      e->u.operator.as = FFEEXPR_operatorassociativityNE_;
+      ffeexpr_exprstack_push_binary_ (e);
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+    case FFELEX_typeREL_LE:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextFORMAT:
+	  ffebad_start (FFEBAD_FORMAT_EXPR_TOKEN);
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_finish ();
+	  break;
+
+	default:
+	  break;
+	}
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeBINARY_;
+      e->token = ffelex_token_use (t);
+      e->u.operator.op = FFEEXPR_operatorLE_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceLE_;
+      e->u.operator.as = FFEEXPR_operatorassociativityLE_;
+      ffeexpr_exprstack_push_binary_ (e);
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+    case FFELEX_typeREL_GE:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextFORMAT:
+	  ffebad_start (FFEBAD_FORMAT_EXPR_TOKEN);
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_finish ();
+	  break;
+
+	default:
+	  break;
+	}
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeBINARY_;
+      e->token = ffelex_token_use (t);
+      e->u.operator.op = FFEEXPR_operatorGE_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceGE_;
+      e->u.operator.as = FFEEXPR_operatorassociativityGE_;
+      ffeexpr_exprstack_push_binary_ (e);
+      return (ffelexHandler) ffeexpr_token_rhs_;
+
+    case FFELEX_typePERIOD:
+      ffeexpr_tokens_[0] = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_token_binary_period_;
+
+#if 0
+    case FFELEX_typeOPEN_PAREN:
+    case FFELEX_typeCLOSE_PAREN:
+    case FFELEX_typeEQUALS:
+    case FFELEX_typePOINTS:
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLON:
+    case FFELEX_typeEOS:
+    case FFELEX_typeSEMICOLON:
+    case FFELEX_typeNAME:
+    case FFELEX_typeNAMES:
+#endif
+    default:
+      return (ffelexHandler) ffeexpr_finished_ (t);
+    }
+}
+
+/* ffeexpr_token_binary_period_ -- Binary PERIOD
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Handle a period detected at binary (expecting binary op or end) state.
+   Must begin a dot-dot name, of which .NOT., .TRUE., and .FALSE. are not
+   valid.  */
+
+static ffelexHandler
+ffeexpr_token_binary_period_ (ffelexToken t)
+{
+  ffeexprExpr_ operand;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+    case FFELEX_typeNAMES:
+      ffeexpr_current_dotdot_ = ffestr_other (t);
+      switch (ffeexpr_current_dotdot_)
+	{
+	case FFESTR_otherTRUE:
+	case FFESTR_otherFALSE:
+	case FFESTR_otherNOT:
+	  if (ffest_ffebad_start (FFEBAD_MISSING_BINARY_OPERATOR))
+	    {
+	      operand = ffeexpr_stack_->exprstack;
+	      assert (operand != NULL);
+	      assert (operand->type == FFEEXPR_exprtypeOPERAND_);
+	      ffebad_here (0, ffelex_token_where_line (operand->token), ffelex_token_where_column (operand->token));
+	      ffebad_here (1, ffelex_token_where_line (t),
+			   ffelex_token_where_column (t));
+	      ffebad_finish ();
+	    }
+	  ffelex_token_kill (ffeexpr_tokens_[0]);
+	  return (ffelexHandler) ffeexpr_token_binary_sw_per_;
+
+	default:
+	  ffeexpr_tokens_[1] = ffelex_token_use (t);
+	  return (ffelexHandler) ffeexpr_token_binary_end_per_;
+	}
+      break;			/* Nothing really reaches here. */
+
+    default:
+      if (ffest_ffebad_start (FFEBAD_IGNORING_PERIOD))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+		       ffelex_token_where_column (ffeexpr_tokens_[0]));
+	  ffebad_finish ();
+	}
+      ffelex_token_kill (ffeexpr_tokens_[0]);
+      return (ffelexHandler) ffeexpr_token_binary_ (t);
+    }
+}
+
+/* ffeexpr_token_binary_end_per_ -- Binary PERIOD NAME(not NOT, TRUE, or FALSE)
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Expecting a period to close a dot-dot at binary (binary op
+   or operator) state.	If period isn't found, issue a diagnostic but
+   pretend we saw one.	ffeexpr_current_dotdot_ must already contained the
+   dotdot representation of the name in between the two PERIOD tokens.	*/
+
+static ffelexHandler
+ffeexpr_token_binary_end_per_ (ffelexToken t)
+{
+  ffeexprExpr_ e;
+
+  e = ffeexpr_expr_new_ ();
+  e->type = FFEEXPR_exprtypeBINARY_;
+  e->token = ffeexpr_tokens_[0];
+
+  switch (ffeexpr_current_dotdot_)
+    {
+    case FFESTR_otherAND:
+      e->u.operator.op = FFEEXPR_operatorAND_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceAND_;
+      e->u.operator.as = FFEEXPR_operatorassociativityAND_;
+      break;
+
+    case FFESTR_otherOR:
+      e->u.operator.op = FFEEXPR_operatorOR_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceOR_;
+      e->u.operator.as = FFEEXPR_operatorassociativityOR_;
+      break;
+
+    case FFESTR_otherXOR:
+      e->u.operator.op = FFEEXPR_operatorXOR_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceXOR_;
+      e->u.operator.as = FFEEXPR_operatorassociativityXOR_;
+      break;
+
+    case FFESTR_otherEQV:
+      e->u.operator.op = FFEEXPR_operatorEQV_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceEQV_;
+      e->u.operator.as = FFEEXPR_operatorassociativityEQV_;
+      break;
+
+    case FFESTR_otherNEQV:
+      e->u.operator.op = FFEEXPR_operatorNEQV_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceNEQV_;
+      e->u.operator.as = FFEEXPR_operatorassociativityNEQV_;
+      break;
+
+    case FFESTR_otherLT:
+      e->u.operator.op = FFEEXPR_operatorLT_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceLT_;
+      e->u.operator.as = FFEEXPR_operatorassociativityLT_;
+      break;
+
+    case FFESTR_otherLE:
+      e->u.operator.op = FFEEXPR_operatorLE_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceLE_;
+      e->u.operator.as = FFEEXPR_operatorassociativityLE_;
+      break;
+
+    case FFESTR_otherEQ:
+      e->u.operator.op = FFEEXPR_operatorEQ_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceEQ_;
+      e->u.operator.as = FFEEXPR_operatorassociativityEQ_;
+      break;
+
+    case FFESTR_otherNE:
+      e->u.operator.op = FFEEXPR_operatorNE_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceNE_;
+      e->u.operator.as = FFEEXPR_operatorassociativityNE_;
+      break;
+
+    case FFESTR_otherGT:
+      e->u.operator.op = FFEEXPR_operatorGT_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceGT_;
+      e->u.operator.as = FFEEXPR_operatorassociativityGT_;
+      break;
+
+    case FFESTR_otherGE:
+      e->u.operator.op = FFEEXPR_operatorGE_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceGE_;
+      e->u.operator.as = FFEEXPR_operatorassociativityGE_;
+      break;
+
+    default:
+      if (ffest_ffebad_start (FFEBAD_INVALID_DOTDOT))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+		       ffelex_token_where_column (ffeexpr_tokens_[0]));
+	  ffebad_string (ffelex_token_text (ffeexpr_tokens_[1]));
+	  ffebad_finish ();
+	}
+      e->u.operator.op = FFEEXPR_operatorEQ_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceEQ_;
+      e->u.operator.as = FFEEXPR_operatorassociativityEQ_;
+      break;
+    }
+
+  ffeexpr_exprstack_push_binary_ (e);
+
+  if (ffelex_token_type (t) != FFELEX_typePERIOD)
+    {
+      if (ffest_ffebad_start (FFEBAD_INSERTING_PERIOD))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+		       ffelex_token_where_column (ffeexpr_tokens_[0]));
+	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_string (ffelex_token_text (ffeexpr_tokens_[1]));
+	  ffebad_finish ();
+	}
+      ffelex_token_kill (ffeexpr_tokens_[1]);	/* Kill dot-dot token. */
+      return (ffelexHandler) ffeexpr_token_rhs_ (t);
+    }
+
+  ffelex_token_kill (ffeexpr_tokens_[1]);	/* Kill dot-dot token. */
+  return (ffelexHandler) ffeexpr_token_rhs_;
+}
+
+/* ffeexpr_token_binary_sw_per_ -- Rhs PERIOD NAME(NOT, TRUE, or FALSE)
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   A diagnostic has already been issued; just swallow a period if there is
+   one, then continue with ffeexpr_token_binary_.  */
+
+static ffelexHandler
+ffeexpr_token_binary_sw_per_ (ffelexToken t)
+{
+  if (ffelex_token_type (t) != FFELEX_typePERIOD)
+    return (ffelexHandler) ffeexpr_token_binary_ (t);
+
+  return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_quote_ -- Rhs QUOTE
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Expecting a NUMBER that we'll treat as an octal integer.  */
+
+static ffelexHandler
+ffeexpr_token_quote_ (ffelexToken t)
+{
+  ffeexprExpr_ e;
+  ffebld anyexpr;
+
+  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
+    {
+      if (ffest_ffebad_start (FFEBAD_QUOTE_MISSES_DIGITS))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+		       ffelex_token_where_column (ffeexpr_tokens_[0]));
+	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_finish ();
+	}
+      ffelex_token_kill (ffeexpr_tokens_[0]);
+      return (ffelexHandler) ffeexpr_token_rhs_ (t);
+    }
+
+  /* This is kind of a kludge to prevent any whining about magical numbers
+     that start out as these octal integers, so "20000000000 (on a 32-bit
+     2's-complement machine) by itself won't produce an error. */
+
+  anyexpr = ffebld_new_any ();
+  ffebld_set_info (anyexpr, ffeinfo_new_any ());
+
+  e = ffeexpr_expr_new_ ();
+  e->type = FFEEXPR_exprtypeOPERAND_;
+  e->token = ffeexpr_tokens_[0];
+  e->u.operand = ffebld_new_conter_with_orig
+    (ffebld_constant_new_integeroctal (t), anyexpr);
+  ffebld_set_info (e->u.operand, ffeinfo_new (FFEINFO_basictypeINTEGER,
+		      FFEINFO_kindtypeINTEGERDEFAULT, 0, FFEINFO_kindENTITY,
+		       FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
+  ffeexpr_exprstack_push_operand_ (e);
+  return (ffelexHandler) ffeexpr_token_binary_;
+}
+
+/* ffeexpr_token_apostrophe_ -- Rhs APOSTROPHE
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Handle an open-apostrophe, which begins either a character ('char-const'),
+   typeless octal ('octal-const'O), or typeless hexadecimal ('hex-const'Z or
+   'hex-const'X) constant.  */
+
+static ffelexHandler
+ffeexpr_token_apostrophe_ (ffelexToken t)
+{
+  assert (ffelex_token_type (t) == FFELEX_typeCHARACTER);
+  if (ffe_is_pedantic_not_90 () && (ffelex_token_length (t) == 0))
+    {
+      ffebad_start (FFEBAD_NULL_CHAR_CONST);
+      ffebad_here (0, ffelex_token_where_line (t),
+		   ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+  ffeexpr_tokens_[1] = ffelex_token_use (t);
+  return (ffelexHandler) ffeexpr_token_apos_char_;
+}
+
+/* ffeexpr_token_apos_char_ -- Rhs APOSTROPHE CHARACTER
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Close-apostrophe is implicit; if this token is NAME, it is a possible
+   typeless-constant radix specifier.  */
+
+static ffelexHandler
+ffeexpr_token_apos_char_ (ffelexToken t)
+{
+  ffeexprExpr_ e;
+  ffeinfo ni;
+  char c;
+  ffetargetCharacterSize size;
+
+  if ((ffelex_token_type (t) == FFELEX_typeNAME)
+      || (ffelex_token_type (t) == FFELEX_typeNAMES))
+    {
+      if ((ffelex_token_length (t) == 1)
+	  && (ffesrc_char_match_init ((c = ffelex_token_text (t)[0]), 'B',
+				      'b')
+	      || ffesrc_char_match_init (c, 'O', 'o')
+	      || ffesrc_char_match_init (c, 'X', 'x')
+	      || ffesrc_char_match_init (c, 'Z', 'z')))
+	{
+	  e = ffeexpr_expr_new_ ();
+	  e->type = FFEEXPR_exprtypeOPERAND_;
+	  e->token = ffeexpr_tokens_[0];
+	  switch (c)
+	    {
+	    case FFESRC_CASE_MATCH_INIT ('B', 'b', match_b, no_match):
+	      e->u.operand = ffebld_new_conter
+		(ffebld_constant_new_typeless_bv (ffeexpr_tokens_[1]));
+	      size = ffetarget_size_typeless_binary (ffeexpr_tokens_[1]);
+	      break;
+
+	    case FFESRC_CASE_MATCH_INIT ('O', 'o', match_o, no_match):
+	      e->u.operand = ffebld_new_conter
+		(ffebld_constant_new_typeless_ov (ffeexpr_tokens_[1]));
+	      size = ffetarget_size_typeless_octal (ffeexpr_tokens_[1]);
+	      break;
+
+	    case FFESRC_CASE_MATCH_INIT ('X', 'x', match_x, no_match):
+	      e->u.operand = ffebld_new_conter
+		(ffebld_constant_new_typeless_hxv (ffeexpr_tokens_[1]));
+	      size = ffetarget_size_typeless_hex (ffeexpr_tokens_[1]);
+	      break;
+
+	    case FFESRC_CASE_MATCH_INIT ('Z', 'z', match_z, no_match):
+	      e->u.operand = ffebld_new_conter
+		(ffebld_constant_new_typeless_hzv (ffeexpr_tokens_[1]));
+	      size = ffetarget_size_typeless_hex (ffeexpr_tokens_[1]);
+	      break;
+
+	    default:
+	    no_match:		/* :::::::::::::::::::: */
+	      assert ("not BOXZ!" == NULL);
+	      size = 0;
+	      break;
+	    }
+	  ffebld_set_info (e->u.operand,
+	       ffeinfo_new (FFEINFO_basictypeTYPELESS, FFEINFO_kindtypeNONE,
+		       0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, size));
+	  ffeexpr_exprstack_push_operand_ (e);
+	  ffelex_token_kill (ffeexpr_tokens_[1]);
+	  return (ffelexHandler) ffeexpr_token_binary_;
+	}
+    }
+  e = ffeexpr_expr_new_ ();
+  e->type = FFEEXPR_exprtypeOPERAND_;
+  e->token = ffeexpr_tokens_[0];
+  e->u.operand = ffebld_new_conter (ffebld_constant_new_characterdefault
+				    (ffeexpr_tokens_[1]));
+  ni = ffeinfo_new (FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTERDEFAULT,
+		    0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+		    ffelex_token_length (ffeexpr_tokens_[1]));
+  ffebld_set_info (e->u.operand, ni);
+  ffelex_token_kill (ffeexpr_tokens_[1]);
+  ffeexpr_exprstack_push_operand_ (e);
+  if ((ffelex_token_type (t) == FFELEX_typeNAME)
+      || (ffelex_token_type (t) == FFELEX_typeNAMES))
+    {
+      if (ffest_ffebad_start (FFEBAD_INVALID_RADIX_SPECIFIER))
+	{
+	  ffebad_string (ffelex_token_text (t));
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (ffeexpr_tokens_[0]),
+		       ffelex_token_where_column (ffeexpr_tokens_[0]));
+	  ffebad_finish ();
+	}
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeBINARY_;
+      e->token = ffelex_token_use (t);
+      e->u.operator.op = FFEEXPR_operatorCONCATENATE_;
+      e->u.operator.prec = FFEEXPR_operatorprecedenceCONCATENATE_;
+      e->u.operator.as = FFEEXPR_operatorassociativityCONCATENATE_;
+      ffeexpr_exprstack_push_binary_ (e);
+      return (ffelexHandler) ffeexpr_token_rhs_ (t);
+    }
+  ffeexpr_is_substr_ok_ = !ffe_is_pedantic_not_90 ();	/* Allow "'hello'(3:5)". */
+  return (ffelexHandler) ffeexpr_token_substrp_ (t);
+}
+
+/* ffeexpr_token_name_lhs_ -- Lhs NAME
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Handle a name followed by open-paren, period (RECORD.MEMBER), percent
+   (RECORD%MEMBER), or nothing at all.	*/
+
+static ffelexHandler
+ffeexpr_token_name_lhs_ (ffelexToken t)
+{
+  ffeexprExpr_ e;
+  ffeexprParenType_ paren_type;
+  ffesymbol s;
+  ffebld expr;
+  ffeinfo info;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeOPEN_PAREN:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextASSIGN:
+	case FFEEXPR_contextAGOTO:
+	case FFEEXPR_contextFILEUNIT_DF:
+	  goto just_name;	/* :::::::::::::::::::: */
+
+	default:
+	  break;
+	}
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeOPERAND_;
+      e->token = ffelex_token_use (ffeexpr_tokens_[0]);
+      s = ffeexpr_declare_parenthesized_ (ffeexpr_tokens_[0], FALSE,
+					  &paren_type);
+
+      switch (ffesymbol_where (s))
+	{
+	case FFEINFO_whereLOCAL:
+	  if (ffeexpr_stack_->context == FFEEXPR_contextSUBROUTINEREF)
+	    ffesymbol_error (s, ffeexpr_tokens_[0]);	/* Recursion. */
+	  break;
+
+	case FFEINFO_whereINTRINSIC:
+	case FFEINFO_whereGLOBAL:
+	  if (ffeexpr_stack_->context != FFEEXPR_contextSUBROUTINEREF)
+	    ffesymbol_error (s, ffeexpr_tokens_[0]);	/* Can call intrin. */
+	  break;
+
+	case FFEINFO_whereCOMMON:
+	case FFEINFO_whereDUMMY:
+	case FFEINFO_whereRESULT:
+	  break;
+
+	case FFEINFO_whereNONE:
+	case FFEINFO_whereANY:
+	  break;
+
+	default:
+	  ffesymbol_error (s, ffeexpr_tokens_[0]);
+	  break;
+	}
+
+      if (ffesymbol_attrs (s) & FFESYMBOL_attrsANY)
+	{
+	  e->u.operand = ffebld_new_any ();
+	  ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+	}
+      else
+	{
+	  e->u.operand = ffebld_new_symter (s,
+					    ffesymbol_generic (s),
+					    ffesymbol_specific (s),
+					    ffesymbol_implementation (s));
+	  ffebld_set_info (e->u.operand, ffesymbol_info (s));
+	}
+      ffeexpr_exprstack_push_ (e);	/* Not a complete operand yet. */
+      ffeexpr_stack_->tokens[0] = ffeexpr_tokens_[0];
+      switch (paren_type)
+	{
+	case FFEEXPR_parentypeSUBROUTINE_:
+	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+	  return
+	    (ffelexHandler)
+	    ffeexpr_rhs (ffeexpr_stack_->pool,
+			 FFEEXPR_contextACTUALARG_,
+			 ffeexpr_token_arguments_);
+
+	case FFEEXPR_parentypeARRAY_:
+	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+	  ffeexpr_stack_->bound_list = ffesymbol_dims (s);
+	  ffeexpr_stack_->rank = 0;
+	  ffeexpr_stack_->constant = TRUE;
+	  ffeexpr_stack_->immediate = TRUE;
+	  switch (ffeexpr_stack_->context)
+	    {
+	    case FFEEXPR_contextDATAIMPDOITEM_:
+	      return
+		(ffelexHandler)
+		ffeexpr_rhs (ffeexpr_stack_->pool,
+			     FFEEXPR_contextDATAIMPDOINDEX_,
+			     ffeexpr_token_elements_);
+
+	    case FFEEXPR_contextEQUIVALENCE:
+	      return
+		(ffelexHandler)
+		ffeexpr_rhs (ffeexpr_stack_->pool,
+			     FFEEXPR_contextEQVINDEX_,
+			     ffeexpr_token_elements_);
+
+	    default:
+	      return
+		(ffelexHandler)
+		ffeexpr_rhs (ffeexpr_stack_->pool,
+			     FFEEXPR_contextINDEX_,
+			     ffeexpr_token_elements_);
+	    }
+
+	case FFEEXPR_parentypeSUBSTRING_:
+	  e->u.operand = ffeexpr_collapse_symter (e->u.operand,
+						  ffeexpr_tokens_[0]);
+	  return
+	    (ffelexHandler)
+	    ffeexpr_rhs (ffeexpr_stack_->pool,
+			 FFEEXPR_contextINDEX_,
+			 ffeexpr_token_substring_);
+
+	case FFEEXPR_parentypeEQUIVALENCE_:
+	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+	  ffeexpr_stack_->bound_list = ffesymbol_dims (s);
+	  ffeexpr_stack_->rank = 0;
+	  ffeexpr_stack_->constant = TRUE;
+	  ffeexpr_stack_->immediate = TRUE;
+	  return
+	    (ffelexHandler)
+	    ffeexpr_rhs (ffeexpr_stack_->pool,
+			 FFEEXPR_contextEQVINDEX_,
+			 ffeexpr_token_equivalence_);
+
+	case FFEEXPR_parentypeFUNCTION_:	/* Invalid case. */
+	case FFEEXPR_parentypeFUNSUBSTR_:	/* Invalid case. */
+	  ffesymbol_error (s, ffeexpr_tokens_[0]);
+	  /* Fall through. */
+	case FFEEXPR_parentypeANY_:
+	  e->u.operand = ffebld_new_any ();
+	  ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+	  return
+	    (ffelexHandler)
+	    ffeexpr_rhs (ffeexpr_stack_->pool,
+			 FFEEXPR_contextACTUALARG_,
+			 ffeexpr_token_anything_);
+
+	default:
+	  assert ("bad paren type" == NULL);
+	  break;
+	}
+
+    case FFELEX_typeEQUALS:	/* As in "VAR=". */
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextIMPDOITEM_:	/* within
+						   "(,VAR=start,end[,incr])". */
+	case FFEEXPR_contextIMPDOITEMDF_:
+	  ffeexpr_stack_->context = FFEEXPR_contextIMPDOCTRL_;
+	  break;
+
+	case FFEEXPR_contextDATAIMPDOITEM_:
+	  ffeexpr_stack_->context = FFEEXPR_contextDATAIMPDOCTRL_;
+	  break;
+
+	default:
+	  break;
+	}
+      break;
+
+#if 0
+    case FFELEX_typePERIOD:
+    case FFELEX_typePERCENT:
+      assert ("FOO%, FOO. not yet supported!~~" == NULL);
+      break;
+#endif
+
+    default:
+      break;
+    }
+
+just_name:			/* :::::::::::::::::::: */
+  e = ffeexpr_expr_new_ ();
+  e->type = FFEEXPR_exprtypeOPERAND_;
+  e->token = ffeexpr_tokens_[0];
+  s = ffeexpr_declare_unadorned_ (ffeexpr_tokens_[0],
+				  (ffeexpr_stack_->context
+				   == FFEEXPR_contextSUBROUTINEREF));
+
+  switch (ffesymbol_where (s))
+    {
+    case FFEINFO_whereCONSTANT:
+      if ((ffeexpr_stack_->context != FFEEXPR_contextPARAMETER)
+	  || (ffesymbol_kind (s) != FFEINFO_kindENTITY))
+	ffesymbol_error (s, ffeexpr_tokens_[0]);
+      break;
+
+    case FFEINFO_whereIMMEDIATE:
+      if ((ffeexpr_stack_->context != FFEEXPR_contextDATAIMPDOCTRL_)
+	  && (ffeexpr_stack_->context != FFEEXPR_contextDATAIMPDOINDEX_))
+	ffesymbol_error (s, ffeexpr_tokens_[0]);
+      break;
+
+    case FFEINFO_whereLOCAL:
+      if (ffeexpr_stack_->context == FFEEXPR_contextSUBROUTINEREF)
+	ffesymbol_error (s, ffeexpr_tokens_[0]);	/* Recurse!. */
+      break;
+
+    case FFEINFO_whereINTRINSIC:
+      if (ffeexpr_stack_->context != FFEEXPR_contextSUBROUTINEREF)
+	ffesymbol_error (s, ffeexpr_tokens_[0]);	/* Can call intrin. */
+      break;
+
+    default:
+      break;
+    }
+
+  if (ffesymbol_attrs (s) & FFESYMBOL_attrsANY)
+    {
+      expr = ffebld_new_any ();
+      info = ffeinfo_new_any ();
+      ffebld_set_info (expr, info);
+    }
+  else
+    {
+      expr = ffebld_new_symter (s,
+				ffesymbol_generic (s),
+				ffesymbol_specific (s),
+				ffesymbol_implementation (s));
+      info = ffesymbol_info (s);
+      ffebld_set_info (expr, info);
+      if (ffesymbol_is_doiter (s))
+	{
+	  ffebad_start (FFEBAD_DOITER);
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+		       ffelex_token_where_column (ffeexpr_tokens_[0]));
+	  ffest_ffebad_here_doiter (1, s);
+	  ffebad_string (ffesymbol_text (s));
+	  ffebad_finish ();
+	}
+      expr = ffeexpr_collapse_symter (expr, ffeexpr_tokens_[0]);
+    }
+
+  if (ffeexpr_stack_->context == FFEEXPR_contextSUBROUTINEREF)
+    {
+      if (ffebld_op (expr) == FFEBLD_opANY)
+	{
+	  expr = ffebld_new_any ();
+	  ffebld_set_info (expr, ffeinfo_new_any ());
+	}
+      else
+	{
+	  expr = ffebld_new_subrref (expr, NULL);	/* No argument list. */
+	  if (ffesymbol_generic (s) != FFEINTRIN_genNONE)
+	    ffeintrin_fulfill_generic (&expr, &info, e->token);
+	  else if (ffesymbol_specific (s) != FFEINTRIN_specNONE)
+	    ffeintrin_fulfill_specific (&expr, &info, NULL, e->token);
+	  else
+	    ffeexpr_fulfill_call_ (&expr, e->token);
+
+	  if (ffebld_op (expr) != FFEBLD_opANY)
+	    ffebld_set_info (expr,
+			     ffeinfo_new (ffeinfo_basictype (info),
+					  ffeinfo_kindtype (info),
+					  0,
+					  FFEINFO_kindENTITY,
+					  FFEINFO_whereFLEETING,
+					  ffeinfo_size (info)));
+	  else
+	    ffebld_set_info (expr, ffeinfo_new_any ());
+	}
+    }
+
+  e->u.operand = expr;
+  ffeexpr_exprstack_push_operand_ (e);
+  return (ffelexHandler) ffeexpr_finished_ (t);
+}
+
+/* ffeexpr_token_name_arg_ -- Rhs NAME
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Handle first token in an actual-arg (or possible actual-arg) context
+   being a NAME, and use second token to refine the context.  */
+
+static ffelexHandler
+ffeexpr_token_name_arg_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCLOSE_PAREN:
+    case FFELEX_typeCOMMA:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextINDEXORACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextACTUALARG_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARG_;
+	  break;
+
+	default:
+	  break;
+	}
+      break;
+
+    default:
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextINDEXORACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+	  ffeexpr_stack_->context
+	    = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
+	  break;
+
+	default:
+	  assert ("bad context in _name_arg_" == NULL);
+	  break;
+	}
+      break;
+    }
+
+  return (ffelexHandler) ffeexpr_token_name_rhs_ (t);
+}
+
+/* ffeexpr_token_name_rhs_ -- Rhs NAME
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Handle a name followed by open-paren, apostrophe (O'octal-const',
+   Z'hex-const', or X'hex-const'), period (RECORD.MEMBER).
+
+   26-Nov-91  JCB  1.2
+      When followed by apostrophe or quote, set lex hexnum flag on so
+      [0-9] as first char of next token seen as starting a potentially
+      hex number (NAME).
+   04-Oct-91  JCB  1.1
+      In case of intrinsic, decorate its SYMTER with the type info for
+      the specific intrinsic.  */
+
+static ffelexHandler
+ffeexpr_token_name_rhs_ (ffelexToken t)
+{
+  ffeexprExpr_ e;
+  ffeexprParenType_ paren_type;
+  ffesymbol s;
+  bool sfdef;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeQUOTE:
+    case FFELEX_typeAPOSTROPHE:
+      ffeexpr_tokens_[1] = ffelex_token_use (t);
+      ffelex_set_hexnum (TRUE);
+      return (ffelexHandler) ffeexpr_token_name_apos_;
+
+    case FFELEX_typeOPEN_PAREN:
+      e = ffeexpr_expr_new_ ();
+      e->type = FFEEXPR_exprtypeOPERAND_;
+      e->token = ffelex_token_use (ffeexpr_tokens_[0]);
+      s = ffeexpr_declare_parenthesized_ (ffeexpr_tokens_[0], TRUE,
+					  &paren_type);
+      if (ffesymbol_attrs (s) & FFESYMBOL_attrsANY)
+	e->u.operand = ffebld_new_any ();
+      else
+	e->u.operand = ffebld_new_symter (s, ffesymbol_generic (s),
+					  ffesymbol_specific (s),
+					  ffesymbol_implementation (s));
+      ffeexpr_exprstack_push_ (e);	/* Not a complete operand yet. */
+      ffeexpr_stack_->tokens[0] = ffeexpr_tokens_[0];
+      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+	{
+	case FFEEXPR_contextSFUNCDEF:
+	case FFEEXPR_contextSFUNCDEFINDEX_:
+	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+	  sfdef = TRUE;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+	  assert ("weird context!" == NULL);
+	  sfdef = FALSE;
+	  break;
+
+	default:
+	  sfdef = FALSE;
+	  break;
+	}
+      switch (paren_type)
+	{
+	case FFEEXPR_parentypeFUNCTION_:
+	  ffebld_set_info (e->u.operand, ffesymbol_info (s));
+	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+	  if (ffesymbol_where (s) == FFEINFO_whereCONSTANT)
+	    {			/* A statement function. */
+	      ffeexpr_stack_->num_args
+		= ffebld_list_length
+		  (ffeexpr_stack_->next_dummy
+		   = ffesymbol_dummyargs (s));
+	      ffeexpr_stack_->tokens[1] = NULL;	/* !=NULL when > num_args. */
+	    }
+	  else if ((ffesymbol_where (s) == FFEINFO_whereINTRINSIC)
+		   && !ffe_is_pedantic_not_90 ()
+		   && ((ffesymbol_implementation (s)
+			== FFEINTRIN_impICHAR)
+		       || (ffesymbol_implementation (s)
+			   == FFEINTRIN_impIACHAR)
+		       || (ffesymbol_implementation (s)
+			   == FFEINTRIN_impLEN)))
+	    {			/* Allow arbitrary concatenations. */
+	      return
+		(ffelexHandler)
+		  ffeexpr_rhs (ffeexpr_stack_->pool,
+			       sfdef
+			       ? FFEEXPR_contextSFUNCDEF
+			       : FFEEXPR_contextLET,
+			       ffeexpr_token_arguments_);
+	    }
+	  return
+	    (ffelexHandler)
+	    ffeexpr_rhs (ffeexpr_stack_->pool,
+			 sfdef
+			 ? FFEEXPR_contextSFUNCDEFACTUALARG_
+			 : FFEEXPR_contextACTUALARG_,
+			 ffeexpr_token_arguments_);
+
+	case FFEEXPR_parentypeARRAY_:
+	  ffebld_set_info (e->u.operand,
+			   ffesymbol_info (ffebld_symter (e->u.operand)));
+	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+	  ffeexpr_stack_->bound_list = ffesymbol_dims (s);
+	  ffeexpr_stack_->rank = 0;
+	  ffeexpr_stack_->constant = TRUE;
+	  ffeexpr_stack_->immediate = TRUE;
+	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					      sfdef
+					      ? FFEEXPR_contextSFUNCDEFINDEX_
+					      : FFEEXPR_contextINDEX_,
+					      ffeexpr_token_elements_);
+
+	case FFEEXPR_parentypeSUBSTRING_:
+	  ffebld_set_info (e->u.operand,
+			   ffesymbol_info (ffebld_symter (e->u.operand)));
+	  e->u.operand = ffeexpr_collapse_symter (e->u.operand,
+						  ffeexpr_tokens_[0]);
+	  return
+	    (ffelexHandler)
+	    ffeexpr_rhs (ffeexpr_stack_->pool,
+			 sfdef
+			 ? FFEEXPR_contextSFUNCDEFINDEX_
+			 : FFEEXPR_contextINDEX_,
+			 ffeexpr_token_substring_);
+
+	case FFEEXPR_parentypeFUNSUBSTR_:
+	  return
+	    (ffelexHandler)
+	    ffeexpr_rhs (ffeexpr_stack_->pool,
+			 sfdef
+			 ? FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_
+			 : FFEEXPR_contextINDEXORACTUALARG_,
+			 ffeexpr_token_funsubstr_);
+
+	case FFEEXPR_parentypeANY_:
+	  ffebld_set_info (e->u.operand, ffesymbol_info (s));
+	  return
+	    (ffelexHandler)
+	    ffeexpr_rhs (ffeexpr_stack_->pool,
+			 sfdef
+			 ? FFEEXPR_contextSFUNCDEFACTUALARG_
+			 : FFEEXPR_contextACTUALARG_,
+			 ffeexpr_token_anything_);
+
+	default:
+	  assert ("bad paren type" == NULL);
+	  break;
+	}
+
+    case FFELEX_typeEQUALS:	/* As in "VAR=". */
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextIMPDOITEM_:	/* "(,VAR=start,end[,incr])". */
+	case FFEEXPR_contextIMPDOITEMDF_:
+	  ffeexpr_stack_->is_rhs = FALSE;	/* Really an lhs construct. */
+	  ffeexpr_stack_->context = FFEEXPR_contextIMPDOCTRL_;
+	  break;
+
+	default:
+	  break;
+	}
+      break;
+
+#if 0
+    case FFELEX_typePERIOD:
+    case FFELEX_typePERCENT:
+      ~~Support these two someday, though not required
+	assert ("FOO%, FOO. not yet supported!~~" == NULL);
+      break;
+#endif
+
+    default:
+      break;
+    }
+
+  switch (ffeexpr_stack_->context)
+    {
+    case FFEEXPR_contextINDEXORACTUALARG_:
+    case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+      assert ("strange context" == NULL);
+      break;
+
+    default:
+      break;
+    }
+
+  e = ffeexpr_expr_new_ ();
+  e->type = FFEEXPR_exprtypeOPERAND_;
+  e->token = ffeexpr_tokens_[0];
+  s = ffeexpr_declare_unadorned_ (ffeexpr_tokens_[0], FALSE);
+  if (ffesymbol_attrs (s) & FFESYMBOL_attrsANY)
+    {
+      e->u.operand = ffebld_new_any ();
+      ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+    }
+  else
+    {
+      e->u.operand = ffebld_new_symter (s, FFEINTRIN_genNONE,
+					ffesymbol_specific (s),
+					ffesymbol_implementation (s));
+      if (ffesymbol_specific (s) == FFEINTRIN_specNONE)
+	ffebld_set_info (e->u.operand, ffeinfo_use (ffesymbol_info (s)));
+      else
+	{			/* Decorate the SYMTER with the actual type
+				   of the intrinsic. */
+	  ffebld_set_info (e->u.operand, ffeinfo_new
+			(ffeintrin_basictype (ffesymbol_specific (s)),
+			 ffeintrin_kindtype (ffesymbol_specific (s)),
+			 0,
+			 ffesymbol_kind (s),
+			 ffesymbol_where (s),
+			 FFETARGET_charactersizeNONE));
+	}
+      if (ffesymbol_is_doiter (s))
+	ffebld_symter_set_is_doiter (e->u.operand, TRUE);
+      e->u.operand = ffeexpr_collapse_symter (e->u.operand,
+					      ffeexpr_tokens_[0]);
+    }
+  ffeexpr_exprstack_push_operand_ (e);
+  return (ffelexHandler) ffeexpr_token_binary_ (t);
+}
+
+/* ffeexpr_token_name_apos_ -- Rhs NAME APOSTROPHE
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Expecting a NAME token, analyze the previous NAME token to see what kind,
+   if any, typeless constant we've got.
+
+   01-Sep-90  JCB  1.1
+      Expect a NAME instead of CHARACTER in this situation.  */
+
+static ffelexHandler
+ffeexpr_token_name_apos_ (ffelexToken t)
+{
+  ffeexprExpr_ e;
+
+  ffelex_set_hexnum (FALSE);
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+      ffeexpr_tokens_[2] = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_token_name_apos_name_;
+
+    default:
+      break;
+    }
+
+  if (ffest_ffebad_start (FFEBAD_INVALID_RADIX_SPECIFIER))
+    {
+      ffebad_string (ffelex_token_text (ffeexpr_tokens_[0]));
+      ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+		   ffelex_token_where_column (ffeexpr_tokens_[0]));
+      ffebad_here (1, ffelex_token_where_line (t),
+		   ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  ffelex_token_kill (ffeexpr_tokens_[1]);
+
+  e = ffeexpr_expr_new_ ();
+  e->type = FFEEXPR_exprtypeOPERAND_;
+  e->u.operand = ffebld_new_any ();
+  ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+  e->token = ffeexpr_tokens_[0];
+  ffeexpr_exprstack_push_operand_ (e);
+
+  return (ffelexHandler) ffeexpr_token_binary_ (t);
+}
+
+/* ffeexpr_token_name_apos_name_ -- Rhs NAME APOSTROPHE NAME
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Expecting an APOSTROPHE token, analyze the previous NAME token to see
+   what kind, if any, typeless constant we've got.  */
+
+static ffelexHandler
+ffeexpr_token_name_apos_name_ (ffelexToken t)
+{
+  ffeexprExpr_ e;
+  char c;
+
+  e = ffeexpr_expr_new_ ();
+  e->type = FFEEXPR_exprtypeOPERAND_;
+  e->token = ffeexpr_tokens_[0];
+
+  if ((ffelex_token_type (t) == ffelex_token_type (ffeexpr_tokens_[1]))
+      && (ffelex_token_length (ffeexpr_tokens_[0]) == 1)
+      && (ffesrc_char_match_init ((c = ffelex_token_text (ffeexpr_tokens_[0])[0]),
+				  'B', 'b')
+	  || ffesrc_char_match_init (c, 'O', 'o')
+	  || ffesrc_char_match_init (c, 'X', 'x')
+	  || ffesrc_char_match_init (c, 'Z', 'z')))
+    {
+      ffetargetCharacterSize size;
+
+      if (!ffe_is_typeless_boz ()) {
+
+      switch (c)
+	{
+	case FFESRC_CASE_MATCH_INIT ('B', 'b', imatch_b, no_imatch):
+	  e->u.operand = ffebld_new_conter (ffebld_constant_new_integerbinary
+					    (ffeexpr_tokens_[2]));
+	  break;
+
+	case FFESRC_CASE_MATCH_INIT ('O', 'o', imatch_o, no_imatch):
+	  e->u.operand = ffebld_new_conter (ffebld_constant_new_integeroctal
+					    (ffeexpr_tokens_[2]));
+	  break;
+
+	case FFESRC_CASE_MATCH_INIT ('X', 'x', imatch_x, no_imatch):
+	  e->u.operand = ffebld_new_conter (ffebld_constant_new_integerhex
+					    (ffeexpr_tokens_[2]));
+	  break;
+
+	case FFESRC_CASE_MATCH_INIT ('Z', 'z', imatch_z, no_imatch):
+	  e->u.operand = ffebld_new_conter (ffebld_constant_new_integerhex
+					    (ffeexpr_tokens_[2]));
+	  break;
+
+	default:
+	no_imatch:		/* :::::::::::::::::::: */
+	  assert ("not BOXZ!" == NULL);
+	  abort ();
+	}
+
+	ffebld_set_info (e->u.operand,
+			 ffeinfo_new (FFEINFO_basictypeINTEGER,
+				      FFEINFO_kindtypeINTEGERDEFAULT, 0,
+				      FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+				      FFETARGET_charactersizeNONE));
+	ffeexpr_exprstack_push_operand_ (e);
+	ffelex_token_kill (ffeexpr_tokens_[1]);
+	ffelex_token_kill (ffeexpr_tokens_[2]);
+	return (ffelexHandler) ffeexpr_token_binary_;
+      }
+
+      switch (c)
+	{
+	case FFESRC_CASE_MATCH_INIT ('B', 'b', match_b, no_match):
+	  e->u.operand = ffebld_new_conter (ffebld_constant_new_typeless_bm
+					    (ffeexpr_tokens_[2]));
+	  size = ffetarget_size_typeless_binary (ffeexpr_tokens_[2]);
+	  break;
+
+	case FFESRC_CASE_MATCH_INIT ('O', 'o', match_o, no_match):
+	  e->u.operand = ffebld_new_conter (ffebld_constant_new_typeless_om
+					    (ffeexpr_tokens_[2]));
+	  size = ffetarget_size_typeless_octal (ffeexpr_tokens_[2]);
+	  break;
+
+	case FFESRC_CASE_MATCH_INIT ('X', 'x', match_x, no_match):
+	  e->u.operand = ffebld_new_conter (ffebld_constant_new_typeless_hxm
+					    (ffeexpr_tokens_[2]));
+	  size = ffetarget_size_typeless_hex (ffeexpr_tokens_[2]);
+	  break;
+
+	case FFESRC_CASE_MATCH_INIT ('Z', 'z', match_z, no_match):
+	  e->u.operand = ffebld_new_conter (ffebld_constant_new_typeless_hzm
+					    (ffeexpr_tokens_[2]));
+	  size = ffetarget_size_typeless_hex (ffeexpr_tokens_[2]);
+	  break;
+
+	default:
+	no_match:		/* :::::::::::::::::::: */
+	  assert ("not BOXZ!" == NULL);
+	  e->u.operand = ffebld_new_conter (ffebld_constant_new_typeless_hzm
+					    (ffeexpr_tokens_[2]));
+	  size = ffetarget_size_typeless_hex (ffeexpr_tokens_[2]);
+	  break;
+	}
+      ffebld_set_info (e->u.operand,
+	       ffeinfo_new (FFEINFO_basictypeTYPELESS, FFEINFO_kindtypeNONE,
+		       0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, size));
+      ffeexpr_exprstack_push_operand_ (e);
+      ffelex_token_kill (ffeexpr_tokens_[1]);
+      ffelex_token_kill (ffeexpr_tokens_[2]);
+      return (ffelexHandler) ffeexpr_token_binary_;
+    }
+
+  if (ffest_ffebad_start (FFEBAD_INVALID_RADIX_SPECIFIER))
+    {
+      ffebad_string (ffelex_token_text (ffeexpr_tokens_[0]));
+      ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+		   ffelex_token_where_column (ffeexpr_tokens_[0]));
+      ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_finish ();
+    }
+
+  ffelex_token_kill (ffeexpr_tokens_[1]);
+  ffelex_token_kill (ffeexpr_tokens_[2]);
+
+  e->type = FFEEXPR_exprtypeOPERAND_;
+  e->u.operand = ffebld_new_any ();
+  ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+  e->token = ffeexpr_tokens_[0];
+  ffeexpr_exprstack_push_operand_ (e);
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeAPOSTROPHE:
+    case FFELEX_typeQUOTE:
+      return (ffelexHandler) ffeexpr_token_binary_;
+
+    default:
+      return (ffelexHandler) ffeexpr_token_binary_ (t);
+    }
+}
+
+/* ffeexpr_token_percent_ -- Rhs PERCENT
+
+   Handle a percent sign possibly followed by "LOC".  If followed instead
+   by "VAL", "REF", or "DESCR", issue an error message and substitute
+   "LOC".  If followed by something else, treat the percent sign as a
+   spurious incorrect token and reprocess the token via _rhs_.	*/
+
+static ffelexHandler
+ffeexpr_token_percent_ (ffelexToken t)
+{
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeNAME:
+    case FFELEX_typeNAMES:
+      ffeexpr_stack_->percent = ffeexpr_percent_ (t);
+      ffeexpr_tokens_[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_token_percent_name_;
+
+    default:
+      if (ffest_ffebad_start (FFEBAD_INVALID_TOKEN_IN_EXPRESSION))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+		       ffelex_token_where_column (ffeexpr_tokens_[0]));
+	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
+		   ffelex_token_where_column (ffeexpr_stack_->first_token));
+	  ffebad_finish ();
+	}
+      ffelex_token_kill (ffeexpr_tokens_[0]);
+      return (ffelexHandler) ffeexpr_token_rhs_ (t);
+    }
+}
+
+/* ffeexpr_token_percent_name_ -- Rhs PERCENT NAME
+
+   Make sure the token is OPEN_PAREN and prepare for the one-item list of
+   LHS expressions.  Else display an error message.  */
+
+static ffelexHandler
+ffeexpr_token_percent_name_ (ffelexToken t)
+{
+  ffelexHandler nexthandler;
+
+  if (ffelex_token_type (t) != FFELEX_typeOPEN_PAREN)
+    {
+      if (ffest_ffebad_start (FFEBAD_INVALID_TOKEN_IN_EXPRESSION))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+		       ffelex_token_where_column (ffeexpr_tokens_[0]));
+	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
+		   ffelex_token_where_column (ffeexpr_stack_->first_token));
+	  ffebad_finish ();
+	}
+      ffelex_token_kill (ffeexpr_tokens_[0]);
+      nexthandler = (ffelexHandler) ffeexpr_token_rhs_ (ffeexpr_tokens_[1]);
+      ffelex_token_kill (ffeexpr_tokens_[1]);
+      return (ffelexHandler) (*nexthandler) (t);
+    }
+
+  switch (ffeexpr_stack_->percent)
+    {
+    default:
+      if (ffest_ffebad_start (FFEBAD_INVALID_PERCENT))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
+		       ffelex_token_where_column (ffeexpr_tokens_[0]));
+	  ffebad_string (ffelex_token_text (ffeexpr_tokens_[1]));
+	  ffebad_finish ();
+	}
+      ffeexpr_stack_->percent = FFEEXPR_percentLOC_;
+      /* Fall through. */
+    case FFEEXPR_percentLOC_:
+      ffeexpr_stack_->tokens[0] = ffeexpr_tokens_[0];
+      ffelex_token_kill (ffeexpr_tokens_[1]);
+      ffeexpr_stack_->tokens[1] = ffelex_token_use (t);
+      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					  FFEEXPR_contextLOC_,
+					  ffeexpr_cb_end_loc_);
+    }
+}
+
+/* ffeexpr_make_float_const_ -- Make a floating-point constant
+
+   See prototype.
+
+   Pass 'E', 'D', or 'Q' for exponent letter.  */
+
+static void
+ffeexpr_make_float_const_ (char exp_letter, ffelexToken integer,
+			   ffelexToken decimal, ffelexToken fraction,
+			   ffelexToken exponent, ffelexToken exponent_sign,
+			   ffelexToken exponent_digits)
+{
+  ffeexprExpr_ e;
+
+  e = ffeexpr_expr_new_ ();
+  e->type = FFEEXPR_exprtypeOPERAND_;
+  if (integer != NULL)
+    e->token = ffelex_token_use (integer);
+  else
+    {
+      assert (decimal != NULL);
+      e->token = ffelex_token_use (decimal);
+    }
+
+  switch (exp_letter)
+    {
+#if !FFETARGET_okREALQUAD
+    case FFESRC_CASE_MATCH_INIT ('Q', 'q', match_q, no_match):
+      if (ffebad_start (FFEBAD_QUAD_UNSUPPORTED))
+	{
+	  ffebad_here (0, ffelex_token_where_line (e->token),
+		       ffelex_token_where_column (e->token));
+	  ffebad_finish ();
+	}
+      goto match_d;		/* The FFESRC_CASE_* macros don't
+				   allow fall-through! */
+#endif
+
+    case FFESRC_CASE_MATCH_INIT ('D', 'd', match_d, no_match):
+      e->u.operand = ffebld_new_conter (ffebld_constant_new_realdouble
+					(integer, decimal, fraction, exponent, exponent_sign, exponent_digits));
+      ffebld_set_info (e->u.operand,
+	     ffeinfo_new (FFEINFO_basictypeREAL, FFEINFO_kindtypeREALDOUBLE,
+			  0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
+      break;
+
+    case FFESRC_CASE_MATCH_INIT ('E', 'e', match_e, no_match):
+      e->u.operand = ffebld_new_conter (ffebld_constant_new_realdefault
+					(integer, decimal, fraction, exponent, exponent_sign, exponent_digits));
+      ffebld_set_info (e->u.operand, ffeinfo_new (FFEINFO_basictypeREAL,
+			 FFEINFO_kindtypeREALDEFAULT, 0, FFEINFO_kindENTITY,
+		       FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
+      break;
+
+#if FFETARGET_okREALQUAD
+    case FFESRC_CASE_MATCH_INIT ('Q', 'q', match_q, no_match):
+      e->u.operand = ffebld_new_conter (ffebld_constant_new_realquad
+					(integer, decimal, fraction, exponent, exponent_sign, exponent_digits));
+      ffebld_set_info (e->u.operand,
+	       ffeinfo_new (FFEINFO_basictypeREAL, FFEINFO_kindtypeREALQUAD,
+			    0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
+      break;
+#endif
+
+    case 'I':	/* Make an integer. */
+      e->u.operand = ffebld_new_conter (ffebld_constant_new_integerdefault
+					(ffeexpr_tokens_[0]));
+      ffebld_set_info (e->u.operand,
+		       ffeinfo_new (FFEINFO_basictypeINTEGER,
+				    FFEINFO_kindtypeINTEGERDEFAULT, 0,
+				    FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
+				    FFETARGET_charactersizeNONE));
+      break;
+
+    default:
+    no_match:			/* :::::::::::::::::::: */
+      assert ("Lost the exponent letter!" == NULL);
+    }
+
+  ffeexpr_exprstack_push_operand_ (e);
+}
+
+/* Just like ffesymbol_declare_local, except performs any implicit info
+   assignment necessary.  */
+
+static ffesymbol
+ffeexpr_declare_unadorned_ (ffelexToken t, bool maybe_intrin)
+{
+  ffesymbol s;
+  ffeinfoKind k;
+  bool bad;
+
+  s = ffesymbol_declare_local (t, maybe_intrin);
+
+  switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+    /* Special-case these since they can involve a different concept
+       of "state" (in the stmtfunc name space).  */
+    {
+    case FFEEXPR_contextDATAIMPDOINDEX_:
+    case FFEEXPR_contextDATAIMPDOCTRL_:
+      if (ffeexpr_context_outer_ (ffeexpr_stack_)
+	  == FFEEXPR_contextDATAIMPDOINDEX_)
+	s = ffeexpr_sym_impdoitem_ (s, t);
+      else
+	if (ffeexpr_stack_->is_rhs)
+	  s = ffeexpr_sym_impdoitem_ (s, t);
+	else
+	  s = ffeexpr_sym_lhs_impdoctrl_ (s, t);
+      bad = (ffesymbol_kind (s) != FFEINFO_kindENTITY)
+	|| ((ffesymbol_where (s) != FFEINFO_whereCONSTANT)
+	    && (ffesymbol_where (s) != FFEINFO_whereIMMEDIATE));
+      if (bad && (ffesymbol_kind (s) != FFEINFO_kindANY))
+	ffesymbol_error (s, t);
+      return s;
+
+    default:
+      break;
+    }
+
+  switch ((ffesymbol_sfdummyparent (s) == NULL)
+	  ? ffesymbol_state (s)
+	  : FFESYMBOL_stateUNDERSTOOD)
+    {
+    case FFESYMBOL_stateNONE:	/* Before first exec, not seen in expr
+				   context. */
+      if (!ffest_seen_first_exec ())
+	goto seen;		/* :::::::::::::::::::: */
+      /* Fall through. */
+    case FFESYMBOL_stateUNCERTAIN:	/* Unseen since first exec. */
+      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+	{
+	case FFEEXPR_contextSUBROUTINEREF:
+	  s = ffeexpr_sym_lhs_call_ (s, t);
+	  break;
+
+	case FFEEXPR_contextFILEEXTFUNC:
+	  s = ffeexpr_sym_lhs_extfunc_ (s, t);
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	  s = ffecom_sym_exec_transition (s);
+	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+	    goto understood;	/* :::::::::::::::::::: */
+	  /* Fall through. */
+	case FFEEXPR_contextACTUALARG_:
+	  s = ffeexpr_sym_rhs_actualarg_ (s, t);
+	  break;
+
+	case FFEEXPR_contextDATA:
+	  if (ffeexpr_stack_->is_rhs)
+	    s = ffeexpr_sym_rhs_let_ (s, t);
+	  else
+	    s = ffeexpr_sym_lhs_data_ (s, t);
+	  break;
+
+	case FFEEXPR_contextDATAIMPDOITEM_:
+	  s = ffeexpr_sym_lhs_data_ (s, t);
+	  break;
+
+	case FFEEXPR_contextSFUNCDEF:
+	case FFEEXPR_contextSFUNCDEFINDEX_:
+	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+	  s = ffecom_sym_exec_transition (s);
+	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+	    goto understood;	/* :::::::::::::::::::: */
+	  /* Fall through. */
+	case FFEEXPR_contextLET:
+	case FFEEXPR_contextPAREN_:
+	case FFEEXPR_contextACTUALARGEXPR_:
+	case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+	case FFEEXPR_contextASSIGN:
+	case FFEEXPR_contextIOLIST:
+	case FFEEXPR_contextIOLISTDF:
+	case FFEEXPR_contextDO:
+	case FFEEXPR_contextDOWHILE:
+	case FFEEXPR_contextAGOTO:
+	case FFEEXPR_contextCGOTO:
+	case FFEEXPR_contextIF:
+	case FFEEXPR_contextARITHIF:
+	case FFEEXPR_contextFORMAT:
+	case FFEEXPR_contextSTOP:
+	case FFEEXPR_contextRETURN:
+	case FFEEXPR_contextSELECTCASE:
+	case FFEEXPR_contextCASE:
+	case FFEEXPR_contextFILEASSOC:
+	case FFEEXPR_contextFILEINT:
+	case FFEEXPR_contextFILEDFINT:
+	case FFEEXPR_contextFILELOG:
+	case FFEEXPR_contextFILENUM:
+	case FFEEXPR_contextFILENUMAMBIG:
+	case FFEEXPR_contextFILECHAR:
+	case FFEEXPR_contextFILENUMCHAR:
+	case FFEEXPR_contextFILEDFCHAR:
+	case FFEEXPR_contextFILEKEY:
+	case FFEEXPR_contextFILEUNIT:
+	case FFEEXPR_contextFILEUNIT_DF:
+	case FFEEXPR_contextFILEUNITAMBIG:
+	case FFEEXPR_contextFILEFORMAT:
+	case FFEEXPR_contextFILENAMELIST:
+	case FFEEXPR_contextFILEVXTCODE:
+	case FFEEXPR_contextINDEX_:
+	case FFEEXPR_contextIMPDOITEM_:
+	case FFEEXPR_contextIMPDOITEMDF_:
+	case FFEEXPR_contextIMPDOCTRL_:
+	case FFEEXPR_contextLOC_:
+	  if (ffeexpr_stack_->is_rhs)
+	    s = ffeexpr_sym_rhs_let_ (s, t);
+	  else
+	    s = ffeexpr_sym_lhs_let_ (s, t);
+	  break;
+
+	case FFEEXPR_contextCHARACTERSIZE:
+	case FFEEXPR_contextEQUIVALENCE:
+	case FFEEXPR_contextINCLUDE:
+	case FFEEXPR_contextPARAMETER:
+	case FFEEXPR_contextDIMLIST:
+	case FFEEXPR_contextDIMLISTCOMMON:
+	case FFEEXPR_contextKINDTYPE:
+	case FFEEXPR_contextINITVAL:
+	case FFEEXPR_contextEQVINDEX_:
+	  break;		/* Will turn into errors below. */
+
+	default:
+	  ffesymbol_error (s, t);
+	  break;
+	}
+      /* Fall through. */
+    case FFESYMBOL_stateUNDERSTOOD:	/* Nothing much more to learn. */
+    understood:		/* :::::::::::::::::::: */
+      k = ffesymbol_kind (s);
+      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+	{
+	case FFEEXPR_contextSUBROUTINEREF:
+	  bad = ((k != FFEINFO_kindSUBROUTINE)
+		 && ((ffesymbol_where (s) != FFEINFO_whereINTRINSIC)
+		     || (k != FFEINFO_kindNONE)));
+	  break;
+
+	case FFEEXPR_contextFILEEXTFUNC:
+	  bad = (k != FFEINFO_kindFUNCTION)
+	    || (ffesymbol_where (s) != FFEINFO_whereGLOBAL);
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	case FFEEXPR_contextACTUALARG_:
+	  switch (k)
+	    {
+	    case FFEINFO_kindENTITY:
+	      bad = FALSE;
+	      break;
+
+	    case FFEINFO_kindFUNCTION:
+	    case FFEINFO_kindSUBROUTINE:
+	      bad
+		= ((ffesymbol_where (s) != FFEINFO_whereGLOBAL)
+		   && (ffesymbol_where (s) != FFEINFO_whereDUMMY)
+		   && ((ffesymbol_where (s) != FFEINFO_whereINTRINSIC)
+		       || !ffeintrin_is_actualarg (ffesymbol_specific (s))));
+	      break;
+
+	    case FFEINFO_kindNONE:
+	      if (ffesymbol_where (s) == FFEINFO_whereINTRINSIC)
+		{
+		  bad = !(ffeintrin_is_actualarg (ffesymbol_specific (s)));
+		  break;
+		}
+
+	      /* If state is UNDERSTOOD here, it's CHAR*(*) or attrsANY,
+		 and in the former case, attrsTYPE is set, so we
+		 see this as an error as we should, since CHAR*(*)
+		 cannot be actually referenced in a main/block data
+		 program unit.  */
+
+	      if ((ffesymbol_attrs (s) & (FFESYMBOL_attrsANY
+					  | FFESYMBOL_attrsEXTERNAL
+					  | FFESYMBOL_attrsTYPE))
+		  == FFESYMBOL_attrsEXTERNAL)
+		bad = FALSE;
+	      else
+		bad = TRUE;
+	      break;
+
+	    default:
+	      bad = TRUE;
+	      break;
+	    }
+	  break;
+
+	case FFEEXPR_contextDATA:
+	  if (ffeexpr_stack_->is_rhs)
+	    bad = (k != FFEINFO_kindENTITY)
+	      || (ffesymbol_where (s) != FFEINFO_whereCONSTANT);
+	  else
+	    bad = (k != FFEINFO_kindENTITY)
+	      || ((ffesymbol_where (s) != FFEINFO_whereNONE)
+		  && (ffesymbol_where (s) != FFEINFO_whereLOCAL)
+		  && (ffesymbol_where (s) != FFEINFO_whereCOMMON));
+	  break;
+
+	case FFEEXPR_contextDATAIMPDOITEM_:
+	  bad = TRUE;		/* Unadorned item never valid. */
+	  break;
+
+	case FFEEXPR_contextSFUNCDEF:
+	case FFEEXPR_contextSFUNCDEFINDEX_:
+	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+	case FFEEXPR_contextLET:
+	case FFEEXPR_contextPAREN_:
+	case FFEEXPR_contextACTUALARGEXPR_:
+	case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+	case FFEEXPR_contextASSIGN:
+	case FFEEXPR_contextIOLIST:
+	case FFEEXPR_contextIOLISTDF:
+	case FFEEXPR_contextDO:
+	case FFEEXPR_contextDOWHILE:
+	case FFEEXPR_contextAGOTO:
+	case FFEEXPR_contextCGOTO:
+	case FFEEXPR_contextIF:
+	case FFEEXPR_contextARITHIF:
+	case FFEEXPR_contextFORMAT:
+	case FFEEXPR_contextSTOP:
+	case FFEEXPR_contextRETURN:
+	case FFEEXPR_contextSELECTCASE:
+	case FFEEXPR_contextCASE:
+	case FFEEXPR_contextFILEASSOC:
+	case FFEEXPR_contextFILEINT:
+	case FFEEXPR_contextFILEDFINT:
+	case FFEEXPR_contextFILELOG:
+	case FFEEXPR_contextFILENUM:
+	case FFEEXPR_contextFILENUMAMBIG:
+	case FFEEXPR_contextFILECHAR:
+	case FFEEXPR_contextFILENUMCHAR:
+	case FFEEXPR_contextFILEDFCHAR:
+	case FFEEXPR_contextFILEKEY:
+	case FFEEXPR_contextFILEUNIT:
+	case FFEEXPR_contextFILEUNIT_DF:
+	case FFEEXPR_contextFILEUNITAMBIG:
+	case FFEEXPR_contextFILEFORMAT:
+	case FFEEXPR_contextFILENAMELIST:
+	case FFEEXPR_contextFILEVXTCODE:
+	case FFEEXPR_contextINDEX_:
+	case FFEEXPR_contextIMPDOITEM_:
+	case FFEEXPR_contextIMPDOITEMDF_:
+	case FFEEXPR_contextIMPDOCTRL_:
+	case FFEEXPR_contextLOC_:
+	  bad = (k != FFEINFO_kindENTITY);	/* This catches "SUBROUTINE
+						   X(A);EXTERNAL A;CALL
+						   Y(A);B=A", for example. */
+	  break;
+
+	case FFEEXPR_contextCHARACTERSIZE:
+	case FFEEXPR_contextEQUIVALENCE:
+	case FFEEXPR_contextPARAMETER:
+	case FFEEXPR_contextDIMLIST:
+	case FFEEXPR_contextDIMLISTCOMMON:
+	case FFEEXPR_contextKINDTYPE:
+	case FFEEXPR_contextINITVAL:
+	case FFEEXPR_contextEQVINDEX_:
+	  bad = (k != FFEINFO_kindENTITY)
+	    || (ffesymbol_where (s) != FFEINFO_whereCONSTANT);
+	  break;
+
+	case FFEEXPR_contextINCLUDE:
+	  bad = TRUE;
+	  break;
+
+	default:
+	  bad = TRUE;
+	  break;
+	}
+      if (bad && (k != FFEINFO_kindANY))
+	ffesymbol_error (s, t);
+      return s;
+
+    case FFESYMBOL_stateSEEN:	/* Seen but not yet in exec portion. */
+    seen:			/* :::::::::::::::::::: */
+      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+	{
+	case FFEEXPR_contextPARAMETER:
+	  if (ffeexpr_stack_->is_rhs)
+	    ffesymbol_error (s, t);
+	  else
+	    s = ffeexpr_sym_lhs_parameter_ (s, t);
+	  break;
+
+	case FFEEXPR_contextDATA:
+	  s = ffecom_sym_exec_transition (s);
+	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+	    goto understood;	/* :::::::::::::::::::: */
+	  if (ffeexpr_stack_->is_rhs)
+	    ffesymbol_error (s, t);
+	  else
+	    s = ffeexpr_sym_lhs_data_ (s, t);
+	  goto understood;	/* :::::::::::::::::::: */
+
+	case FFEEXPR_contextDATAIMPDOITEM_:
+	  s = ffecom_sym_exec_transition (s);
+	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+	    goto understood;	/* :::::::::::::::::::: */
+	  s = ffeexpr_sym_lhs_data_ (s, t);
+	  goto understood;	/* :::::::::::::::::::: */
+
+	case FFEEXPR_contextEQUIVALENCE:
+	  s = ffeexpr_sym_lhs_equivalence_ (s, t);
+	  break;
+
+	case FFEEXPR_contextDIMLIST:
+	  s = ffeexpr_sym_rhs_dimlist_ (s, t);
+	  break;
+
+	case FFEEXPR_contextCHARACTERSIZE:
+	case FFEEXPR_contextKINDTYPE:
+	case FFEEXPR_contextDIMLISTCOMMON:
+	case FFEEXPR_contextINITVAL:
+	case FFEEXPR_contextEQVINDEX_:
+	  ffesymbol_error (s, t);
+	  break;
+
+	case FFEEXPR_contextINCLUDE:
+	  ffesymbol_error (s, t);
+	  break;
+
+	case FFEEXPR_contextACTUALARG_:	/* E.g. I in REAL A(Y(I)). */
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	  s = ffecom_sym_exec_transition (s);
+	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+	    goto understood;	/* :::::::::::::::::::: */
+	  s = ffeexpr_sym_rhs_actualarg_ (s, t);
+	  goto understood;	/* :::::::::::::::::::: */
+
+	case FFEEXPR_contextINDEX_:
+	case FFEEXPR_contextACTUALARGEXPR_:
+	case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+	case FFEEXPR_contextSFUNCDEF:
+	case FFEEXPR_contextSFUNCDEFINDEX_:
+	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+	  assert (ffeexpr_stack_->is_rhs);
+	  s = ffecom_sym_exec_transition (s);
+	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+	    goto understood;	/* :::::::::::::::::::: */
+	  s = ffeexpr_sym_rhs_let_ (s, t);
+	  goto understood;	/* :::::::::::::::::::: */
+
+	default:
+	  ffesymbol_error (s, t);
+	  break;
+	}
+      return s;
+
+    default:
+      assert ("bad symbol state" == NULL);
+      return NULL;
+      break;
+    }
+}
+
+/* Have FOO in DATA (XYZ(FOO),...)/.../ or DATA (...,XYZ=FOO,BAR,BLETCH).
+   Could be found via the "statement-function" name space (in which case
+   it should become an iterator) or the local name space (in which case
+   it should be either a named constant, or a variable that will have an
+   sfunc name space sibling that should become an iterator).  */
+
+static ffesymbol
+ffeexpr_sym_impdoitem_ (ffesymbol sp, ffelexToken t)
+{
+  ffesymbol s;
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffesymbolState ss;
+  ffesymbolState ns;
+  ffeinfoKind kind;
+  ffeinfoWhere where;
+
+  ss = ffesymbol_state (sp);
+
+  if (ffesymbol_sfdummyparent (sp) != NULL)
+    {				/* Have symbol in sfunc name space. */
+      switch (ss)
+	{
+	case FFESYMBOL_stateNONE:	/* Used as iterator already. */
+	  if (ffeexpr_level_ < ffesymbol_maxentrynum (sp))
+	    ffesymbol_error (sp, t);	/* Can't use dead iterator. */
+	  else
+	    {			/* Can use dead iterator because we're at at
+				   least an innermore (higher-numbered) level
+				   than the iterator's outermost
+				   (lowest-numbered) level. */
+	      ffesymbol_signal_change (sp);
+	      ffesymbol_set_state (sp, FFESYMBOL_stateSEEN);
+	      ffesymbol_set_maxentrynum (sp, ffeexpr_level_);
+	      ffesymbol_signal_unreported (sp);
+	    }
+	  break;
+
+	case FFESYMBOL_stateSEEN:	/* Seen already in this or other
+					   implied-DO.  Set symbol level
+					   number to outermost value, as that
+					   tells us we can see it as iterator
+					   at that level at the innermost. */
+	  if (ffeexpr_level_ < ffesymbol_maxentrynum (sp))
+	    {
+	      ffesymbol_signal_change (sp);
+	      ffesymbol_set_maxentrynum (sp, ffeexpr_level_);
+	      ffesymbol_signal_unreported (sp);
+	    }
+	  break;
+
+	case FFESYMBOL_stateUNCERTAIN:	/* Iterator. */
+	  assert (ffeexpr_level_ == ffesymbol_maxentrynum (sp));
+	  ffesymbol_error (sp, t);	/* (,,,I=I,10). */
+	  break;
+
+	case FFESYMBOL_stateUNDERSTOOD:
+	  break;		/* ANY. */
+
+	default:
+	  assert ("Foo Bar!!" == NULL);
+	  break;
+	}
+
+      return sp;
+    }
+
+  /* Got symbol in local name space, so we haven't seen it in impdo yet.
+     First, if it is brand-new and we're in executable statements, set the
+     attributes and exec-transition it to set state UNCERTAIN or UNDERSTOOD.
+     Second, if it is now a constant (PARAMETER), then just return it, it
+     can't be an implied-do iterator.  If it is understood, complain if it is
+     not a valid variable, but make the inner name space iterator anyway and
+     return that.  If it is not understood, improve understanding of the
+     symbol accordingly, complain accordingly, in either case make the inner
+     name space iterator and return that.  */
+
+  sa = ffesymbol_attrs (sp);
+
+  if (ffesymbol_state_is_specable (ss)
+      && ffest_seen_first_exec ())
+    {
+      assert (sa == FFESYMBOL_attrsetNONE);
+      ffesymbol_signal_change (sp);
+      ffesymbol_set_state (sp, FFESYMBOL_stateSEEN);
+      ffesymbol_resolve_intrin (sp);
+      if (ffeimplic_establish_symbol (sp))
+	ffesymbol_set_attr (sp, FFESYMBOL_attrSFARG);
+      else
+	ffesymbol_error (sp, t);
+
+      /* After the exec transition, the state will either be UNCERTAIN (could
+	 be a dummy or local var) or UNDERSTOOD (local var, because this is a
+	 PROGRAM/BLOCKDATA program unit).  */
+
+      sp = ffecom_sym_exec_transition (sp);
+      sa = ffesymbol_attrs (sp);
+      ss = ffesymbol_state (sp);
+    }
+
+  ns = ss;
+  kind = ffesymbol_kind (sp);
+  where = ffesymbol_where (sp);
+
+  if (ss == FFESYMBOL_stateUNDERSTOOD)
+    {
+      if (kind != FFEINFO_kindENTITY)
+	ffesymbol_error (sp, t);
+      if (where == FFEINFO_whereCONSTANT)
+	return sp;
+    }
+  else
+    {
+      /* Enhance understanding of local symbol.  This used to imply exec
+	 transition, but that doesn't seem necessary, since the local symbol
+	 doesn't actually get put into an ffebld tree here -- we just learn
+	 more about it, just like when we see a local symbol's name in the
+	 dummy-arg list of a statement function.  */
+
+      if (ss != FFESYMBOL_stateUNCERTAIN)
+	{
+	  /* Figure out what kind of object we've got based on previous
+	     declarations of or references to the object. */
+
+	  ns = FFESYMBOL_stateSEEN;
+
+	  if (sa & FFESYMBOL_attrsANY)
+	    na = sa;
+	  else if (!(sa & ~(FFESYMBOL_attrsADJUSTS
+			    | FFESYMBOL_attrsANY
+			    | FFESYMBOL_attrsCOMMON
+			    | FFESYMBOL_attrsDUMMY
+			    | FFESYMBOL_attrsEQUIV
+			    | FFESYMBOL_attrsINIT
+			    | FFESYMBOL_attrsNAMELIST
+			    | FFESYMBOL_attrsRESULT
+			    | FFESYMBOL_attrsSAVE
+			    | FFESYMBOL_attrsSFARG
+			    | FFESYMBOL_attrsTYPE)))
+	    na = sa | FFESYMBOL_attrsSFARG;
+	  else
+	    na = FFESYMBOL_attrsetNONE;
+	}
+      else
+	{			/* stateUNCERTAIN. */
+	  na = sa | FFESYMBOL_attrsSFARG;
+	  ns = FFESYMBOL_stateUNDERSTOOD;
+
+	  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+			   | FFESYMBOL_attrsADJUSTABLE
+			   | FFESYMBOL_attrsANYLEN
+			   | FFESYMBOL_attrsARRAY
+			   | FFESYMBOL_attrsDUMMY
+			   | FFESYMBOL_attrsEXTERNAL
+			   | FFESYMBOL_attrsSFARG
+			   | FFESYMBOL_attrsTYPE)));
+
+	  if (sa & FFESYMBOL_attrsEXTERNAL)
+	    {
+	      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+			       | FFESYMBOL_attrsDUMMY
+			       | FFESYMBOL_attrsEXTERNAL
+			       | FFESYMBOL_attrsTYPE)));
+
+	      na = FFESYMBOL_attrsetNONE;
+	    }
+	  else if (sa & FFESYMBOL_attrsDUMMY)
+	    {
+	      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
+	      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+			       | FFESYMBOL_attrsEXTERNAL
+			       | FFESYMBOL_attrsTYPE)));
+
+	      kind = FFEINFO_kindENTITY;
+	    }
+	  else if (sa & FFESYMBOL_attrsARRAY)
+	    {
+	      assert (!(sa & ~(FFESYMBOL_attrsARRAY
+			       | FFESYMBOL_attrsADJUSTABLE
+			       | FFESYMBOL_attrsTYPE)));
+
+	      na = FFESYMBOL_attrsetNONE;
+	    }
+	  else if (sa & FFESYMBOL_attrsSFARG)
+	    {
+	      assert (!(sa & ~(FFESYMBOL_attrsSFARG
+			       | FFESYMBOL_attrsTYPE)));
+
+	      ns = FFESYMBOL_stateUNCERTAIN;
+	    }
+	  else if (sa & FFESYMBOL_attrsTYPE)
+	    {
+	      assert (!(sa & (FFESYMBOL_attrsARRAY
+			      | FFESYMBOL_attrsDUMMY
+			      | FFESYMBOL_attrsEXTERNAL
+			      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
+	      assert (!(sa & ~(FFESYMBOL_attrsTYPE
+			       | FFESYMBOL_attrsADJUSTABLE
+			       | FFESYMBOL_attrsANYLEN
+			       | FFESYMBOL_attrsARRAY
+			       | FFESYMBOL_attrsDUMMY
+			       | FFESYMBOL_attrsEXTERNAL
+			       | FFESYMBOL_attrsSFARG)));
+
+	      kind = FFEINFO_kindENTITY;
+
+	      if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYLEN))
+		na = FFESYMBOL_attrsetNONE;
+	      else if (ffest_is_entry_valid ())
+		ns = FFESYMBOL_stateUNCERTAIN;	/* Could be DUMMY or LOCAL. */
+	      else
+		where = FFEINFO_whereLOCAL;
+	    }
+	  else
+	    na = FFESYMBOL_attrsetNONE;	/* Error. */
+	}
+
+      /* Now see what we've got for a new object: NONE means a new error
+	 cropped up; ANY means an old error to be ignored; otherwise,
+	 everything's ok, update the object (symbol) and continue on. */
+
+      if (na == FFESYMBOL_attrsetNONE)
+	ffesymbol_error (sp, t);
+      else if (!(na & FFESYMBOL_attrsANY))
+	{
+	  ffesymbol_signal_change (sp);	/* May need to back up to previous
+					   version. */
+	  if (!ffeimplic_establish_symbol (sp))
+	    ffesymbol_error (sp, t);
+	  else
+	    {
+	      ffesymbol_set_info (sp,
+				  ffeinfo_new (ffesymbol_basictype (sp),
+					       ffesymbol_kindtype (sp),
+					       ffesymbol_rank (sp),
+					       kind,
+					       where,
+					       ffesymbol_size (sp)));
+	      ffesymbol_set_attrs (sp, na);
+	      ffesymbol_set_state (sp, ns);
+	      ffesymbol_resolve_intrin (sp);
+	      if (!ffesymbol_state_is_specable (ns))
+		sp = ffecom_sym_learned (sp);
+	      ffesymbol_signal_unreported (sp);	/* For debugging purposes. */
+	    }
+	}
+    }
+
+  /* Here we create the sfunc-name-space symbol representing what should
+     become an iterator in this name space at this or an outermore (lower-
+     numbered) expression level, else the implied-DO construct is in error.  */
+
+  s = ffesymbol_declare_sfdummy (t);	/* Sets maxentrynum to 0 for new obj;
+					   also sets sfa_dummy_parent to
+					   parent symbol. */
+  assert (sp == ffesymbol_sfdummyparent (s));
+
+  ffesymbol_signal_change (s);
+  ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+  ffesymbol_set_maxentrynum (s, ffeexpr_level_);
+  ffesymbol_set_info (s,
+		      ffeinfo_new (FFEINFO_basictypeINTEGER,
+				   FFEINFO_kindtypeINTEGERDEFAULT,
+				   0,
+				   FFEINFO_kindENTITY,
+				   FFEINFO_whereIMMEDIATE,
+				   FFETARGET_charactersizeNONE));
+  ffesymbol_signal_unreported (s);
+
+  if ((ffesymbol_basictype (sp) != FFEINFO_basictypeINTEGER)
+       && (ffesymbol_basictype (sp) != FFEINFO_basictypeANY))
+    ffesymbol_error (s, t);
+
+  return s;
+}
+
+/* Have FOO in CALL FOO.  Local name space, executable context only.  */
+
+static ffesymbol
+ffeexpr_sym_lhs_call_ (ffesymbol s, ffelexToken t)
+{
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffeinfoKind kind;
+  ffeinfoWhere where;
+  ffeintrinGen gen;
+  ffeintrinSpec spec;
+  ffeintrinImp imp;
+  bool error = FALSE;
+
+  assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	  || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
+
+  na = sa = ffesymbol_attrs (s);
+
+  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+		   | FFESYMBOL_attrsADJUSTABLE
+		   | FFESYMBOL_attrsANYLEN
+		   | FFESYMBOL_attrsARRAY
+		   | FFESYMBOL_attrsDUMMY
+		   | FFESYMBOL_attrsEXTERNAL
+		   | FFESYMBOL_attrsSFARG
+		   | FFESYMBOL_attrsTYPE)));
+
+  kind = ffesymbol_kind (s);
+  where = ffesymbol_where (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (sa & FFESYMBOL_attrsEXTERNAL)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsTYPE)));
+
+      if (sa & FFESYMBOL_attrsTYPE)
+	error = TRUE;
+      else
+	/* Not TYPE. */
+	{
+	  kind = FFEINFO_kindSUBROUTINE;
+
+	  if (sa & FFESYMBOL_attrsDUMMY)
+	    ;			/* Not TYPE. */
+	  else if (sa & FFESYMBOL_attrsACTUALARG)
+	    ;			/* Not DUMMY or TYPE. */
+	  else			/* Not ACTUALARG, DUMMY, or TYPE. */
+	    where = FFEINFO_whereGLOBAL;
+	}
+    }
+  else if (sa & FFESYMBOL_attrsDUMMY)
+    {
+      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsTYPE)));
+
+      if (sa & FFESYMBOL_attrsTYPE)
+	error = TRUE;
+      else
+	kind = FFEINFO_kindSUBROUTINE;
+    }
+  else if (sa & FFESYMBOL_attrsARRAY)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsTYPE)));
+
+      error = TRUE;
+    }
+  else if (sa & FFESYMBOL_attrsSFARG)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsSFARG
+		       | FFESYMBOL_attrsTYPE)));
+
+      error = TRUE;
+    }
+  else if (sa & FFESYMBOL_attrsTYPE)
+    {
+      assert (!(sa & (FFESYMBOL_attrsARRAY
+		      | FFESYMBOL_attrsDUMMY
+		      | FFESYMBOL_attrsEXTERNAL
+		      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsTYPE
+		       | FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsANYLEN
+		       | FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsSFARG)));
+
+      error = TRUE;
+    }
+  else if (sa == FFESYMBOL_attrsetNONE)
+    {
+      assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
+
+      if (ffeintrin_is_intrinsic (ffesymbol_text (s), t, FALSE,
+				  &gen, &spec, &imp))
+	{
+	  ffesymbol_signal_change (s);	/* May need to back up to previous
+					   version. */
+	  ffesymbol_set_generic (s, gen);
+	  ffesymbol_set_specific (s, spec);
+	  ffesymbol_set_implementation (s, imp);
+	  ffesymbol_set_info (s,
+			      ffeinfo_new (FFEINFO_basictypeNONE,
+					   FFEINFO_kindtypeNONE,
+					   0,
+					   FFEINFO_kindSUBROUTINE,
+					   FFEINFO_whereINTRINSIC,
+					   FFETARGET_charactersizeNONE));
+	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+	  ffesymbol_resolve_intrin (s);
+	  ffesymbol_reference (s, t, FALSE);
+	  s = ffecom_sym_learned (s);
+	  ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+
+	  return s;
+	}
+
+      kind = FFEINFO_kindSUBROUTINE;
+      where = FFEINFO_whereGLOBAL;
+    }
+  else
+    error = TRUE;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (error)
+    ffesymbol_error (s, t);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_signal_change (s);	/* May need to back up to previous
+					   version. */
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       ffesymbol_rank (s),
+				       kind,	/* SUBROUTINE. */
+				       where,	/* GLOBAL or DUMMY. */
+				       ffesymbol_size (s)));
+      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+      ffesymbol_resolve_intrin (s);
+      ffesymbol_reference (s, t, FALSE);
+      s = ffecom_sym_learned (s);
+      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+    }
+
+  return s;
+}
+
+/* Have FOO in DATA FOO/.../.  Local name space and executable context
+   only.  (This will change in the future when DATA FOO may be followed
+   by COMMON FOO or even INTEGER FOO(10), etc.)  */
+
+static ffesymbol
+ffeexpr_sym_lhs_data_ (ffesymbol s, ffelexToken t)
+{
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffeinfoKind kind;
+  ffeinfoWhere where;
+  bool error = FALSE;
+
+  assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	  || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
+
+  na = sa = ffesymbol_attrs (s);
+
+  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+		   | FFESYMBOL_attrsADJUSTABLE
+		   | FFESYMBOL_attrsANYLEN
+		   | FFESYMBOL_attrsARRAY
+		   | FFESYMBOL_attrsDUMMY
+		   | FFESYMBOL_attrsEXTERNAL
+		   | FFESYMBOL_attrsSFARG
+		   | FFESYMBOL_attrsTYPE)));
+
+  kind = ffesymbol_kind (s);
+  where = ffesymbol_where (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (sa & FFESYMBOL_attrsEXTERNAL)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsTYPE)));
+
+      error = TRUE;
+    }
+  else if (sa & FFESYMBOL_attrsDUMMY)
+    {
+      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsTYPE)));
+
+      error = TRUE;
+    }
+  else if (sa & FFESYMBOL_attrsARRAY)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsTYPE)));
+
+      if (sa & FFESYMBOL_attrsADJUSTABLE)
+	error = TRUE;
+      where = FFEINFO_whereLOCAL;
+    }
+  else if (sa & FFESYMBOL_attrsSFARG)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsSFARG
+		       | FFESYMBOL_attrsTYPE)));
+
+      where = FFEINFO_whereLOCAL;
+    }
+  else if (sa & FFESYMBOL_attrsTYPE)
+    {
+      assert (!(sa & (FFESYMBOL_attrsARRAY
+		      | FFESYMBOL_attrsDUMMY
+		      | FFESYMBOL_attrsEXTERNAL
+		      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsTYPE
+		       | FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsANYLEN
+		       | FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsSFARG)));
+
+      if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYLEN))
+	error = TRUE;
+      else
+	{
+	  kind = FFEINFO_kindENTITY;
+	  where = FFEINFO_whereLOCAL;
+	}
+    }
+  else if (sa == FFESYMBOL_attrsetNONE)
+    {
+      assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
+      kind = FFEINFO_kindENTITY;
+      where = FFEINFO_whereLOCAL;
+    }
+  else
+    error = TRUE;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (error)
+    ffesymbol_error (s, t);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_signal_change (s);	/* May need to back up to previous
+					   version. */
+      if (!ffeimplic_establish_symbol (s))
+	{
+	  ffesymbol_error (s, t);
+	  return s;
+	}
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       ffesymbol_rank (s),
+				       kind,	/* ENTITY. */
+				       where,	/* LOCAL. */
+				       ffesymbol_size (s)));
+      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+      ffesymbol_resolve_intrin (s);
+      s = ffecom_sym_learned (s);
+      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+    }
+
+  return s;
+}
+
+/* Have FOO in EQUIVALENCE (...,FOO,...).  Does not include
+   EQUIVALENCE (...,BAR(FOO),...).  */
+
+static ffesymbol
+ffeexpr_sym_lhs_equivalence_ (ffesymbol s, ffelexToken t)
+{
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffeinfoKind kind;
+  ffeinfoWhere where;
+
+  na = sa = ffesymbol_attrs (s);
+  kind = FFEINFO_kindENTITY;
+  where = ffesymbol_where (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (!(sa & ~(FFESYMBOL_attrsADJUSTS
+	       | FFESYMBOL_attrsARRAY
+	       | FFESYMBOL_attrsCOMMON
+	       | FFESYMBOL_attrsEQUIV
+	       | FFESYMBOL_attrsINIT
+	       | FFESYMBOL_attrsNAMELIST
+	       | FFESYMBOL_attrsSAVE
+	       | FFESYMBOL_attrsSFARG
+	       | FFESYMBOL_attrsTYPE)))
+    na = sa | FFESYMBOL_attrsEQUIV;
+  else
+    na = FFESYMBOL_attrsetNONE;
+
+  /* Don't know why we're bothering to set kind and where in this code, but
+     added the following to make it complete, in case it's really important.
+     Generally this is left up to symbol exec transition.  */
+
+  if (where == FFEINFO_whereNONE)
+    {
+      if (na & (FFESYMBOL_attrsADJUSTS
+		| FFESYMBOL_attrsCOMMON))
+	where = FFEINFO_whereCOMMON;
+      else if (na & FFESYMBOL_attrsSAVE)
+	where = FFEINFO_whereLOCAL;
+    }
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    ffesymbol_error (s, t);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_signal_change (s);	/* May need to back up to previous
+					   version. */
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       ffesymbol_rank (s),
+				       kind,	/* Always ENTITY. */
+				       where,	/* NONE, COMMON, or LOCAL. */
+				       ffesymbol_size (s)));
+      ffesymbol_set_attrs (s, na);
+      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+      ffesymbol_resolve_intrin (s);
+      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+    }
+
+  return s;
+}
+
+/* Have FOO in OPEN(...,USEROPEN=FOO,...).  Executable context only.
+
+   Note that I think this should be considered semantically similar to
+   doing CALL XYZ(FOO), in that it should be considered like an
+   ACTUALARG context.  In particular, without EXTERNAL being specified,
+   it should not be allowed.  */
+
+static ffesymbol
+ffeexpr_sym_lhs_extfunc_ (ffesymbol s, ffelexToken t)
+{
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffeinfoKind kind;
+  ffeinfoWhere where;
+  bool needs_type = FALSE;
+  bool error = FALSE;
+
+  assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	  || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
+
+  na = sa = ffesymbol_attrs (s);
+
+  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+		   | FFESYMBOL_attrsADJUSTABLE
+		   | FFESYMBOL_attrsANYLEN
+		   | FFESYMBOL_attrsARRAY
+		   | FFESYMBOL_attrsDUMMY
+		   | FFESYMBOL_attrsEXTERNAL
+		   | FFESYMBOL_attrsSFARG
+		   | FFESYMBOL_attrsTYPE)));
+
+  kind = ffesymbol_kind (s);
+  where = ffesymbol_where (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (sa & FFESYMBOL_attrsEXTERNAL)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsTYPE)));
+
+      if (sa & FFESYMBOL_attrsTYPE)
+	where = FFEINFO_whereGLOBAL;
+      else
+	/* Not TYPE. */
+	{
+	  kind = FFEINFO_kindFUNCTION;
+	  needs_type = TRUE;
+
+	  if (sa & FFESYMBOL_attrsDUMMY)
+	    ;			/* Not TYPE. */
+	  else if (sa & FFESYMBOL_attrsACTUALARG)
+	    ;			/* Not DUMMY or TYPE. */
+	  else			/* Not ACTUALARG, DUMMY, or TYPE. */
+	    where = FFEINFO_whereGLOBAL;
+	}
+    }
+  else if (sa & FFESYMBOL_attrsDUMMY)
+    {
+      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsTYPE)));
+
+      kind = FFEINFO_kindFUNCTION;
+      if (!(sa & FFESYMBOL_attrsTYPE))
+	needs_type = TRUE;
+    }
+  else if (sa & FFESYMBOL_attrsARRAY)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsTYPE)));
+
+      error = TRUE;
+    }
+  else if (sa & FFESYMBOL_attrsSFARG)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsSFARG
+		       | FFESYMBOL_attrsTYPE)));
+
+      error = TRUE;
+    }
+  else if (sa & FFESYMBOL_attrsTYPE)
+    {
+      assert (!(sa & (FFESYMBOL_attrsARRAY
+		      | FFESYMBOL_attrsDUMMY
+		      | FFESYMBOL_attrsEXTERNAL
+		      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsTYPE
+		       | FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsANYLEN
+		       | FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsSFARG)));
+
+      if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYLEN))
+	error = TRUE;
+      else
+	{
+	  kind = FFEINFO_kindFUNCTION;
+	  where = FFEINFO_whereGLOBAL;
+	}
+    }
+  else if (sa == FFESYMBOL_attrsetNONE)
+    {
+      assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
+      kind = FFEINFO_kindFUNCTION;
+      where = FFEINFO_whereGLOBAL;
+      needs_type = TRUE;
+    }
+  else
+    error = TRUE;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (error)
+    ffesymbol_error (s, t);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_signal_change (s);	/* May need to back up to previous
+					   version. */
+      if (needs_type && !ffeimplic_establish_symbol (s))
+	{
+	  ffesymbol_error (s, t);
+	  return s;
+	}
+      if (!ffesymbol_explicitwhere (s))
+	{
+	  ffebad_start (FFEBAD_NEED_EXTERNAL);
+	  ffebad_here (0, ffelex_token_where_line (t),
+		       ffelex_token_where_column (t));
+	  ffebad_string (ffesymbol_text (s));
+	  ffebad_finish ();
+	  ffesymbol_set_explicitwhere (s, TRUE);
+	}
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       ffesymbol_rank (s),
+				       kind,	/* FUNCTION. */
+				       where,	/* GLOBAL or DUMMY. */
+				       ffesymbol_size (s)));
+      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+      ffesymbol_resolve_intrin (s);
+      ffesymbol_reference (s, t, FALSE);
+      s = ffecom_sym_learned (s);
+      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+    }
+
+  return s;
+}
+
+/* Have FOO in DATA (stuff,FOO=1,10)/.../.  */
+
+static ffesymbol
+ffeexpr_sym_lhs_impdoctrl_ (ffesymbol s, ffelexToken t)
+{
+  ffesymbolState ss;
+
+  /* If the symbol isn't in the sfunc name space, pretend as though we saw a
+     reference to it already within the imp-DO construct at this level, so as
+     to get a symbol that is in the sfunc name space. But this is an
+     erroneous construct, and should be caught elsewhere.  */
+
+  if (ffesymbol_sfdummyparent (s) == NULL)
+    {
+      s = ffeexpr_sym_impdoitem_ (s, t);
+      if (ffesymbol_sfdummyparent (s) == NULL)
+	{			/* PARAMETER FOO...DATA (A(I),FOO=...). */
+	  ffesymbol_error (s, t);
+	  return s;
+	}
+    }
+
+  ss = ffesymbol_state (s);
+
+  switch (ss)
+    {
+    case FFESYMBOL_stateNONE:	/* Used as iterator already. */
+      if (ffeexpr_level_ < ffesymbol_maxentrynum (s))
+	ffesymbol_error (s, t);	/* Can't reuse dead iterator.  F90 disallows
+				   this; F77 allows it but it is a stupid
+				   feature. */
+      else
+	{			/* Can use dead iterator because we're at at
+				   least a innermore (higher-numbered) level
+				   than the iterator's outermost
+				   (lowest-numbered) level.  This should be
+				   diagnosed later, because it means an item
+				   in this list didn't reference this
+				   iterator. */
+#if 1
+	  ffesymbol_error (s, t);	/* For now, complain. */
+#else /* Someday will detect all cases where initializer doesn't reference
+	 all applicable iterators, in which case reenable this code. */
+	  ffesymbol_signal_change (s);
+	  ffesymbol_set_state (s, FFESYMBOL_stateUNCERTAIN);
+	  ffesymbol_set_maxentrynum (s, ffeexpr_level_);
+	  ffesymbol_signal_unreported (s);
+#endif
+	}
+      break;
+
+    case FFESYMBOL_stateSEEN:	/* Seen already in this or other implied-DO.
+				   If seen in outermore level, can't be an
+				   iterator here, so complain.  If not seen
+				   at current level, complain for now,
+				   because that indicates something F90
+				   rejects (though we currently don't detect
+				   all such cases for now). */
+      if (ffeexpr_level_ <= ffesymbol_maxentrynum (s))
+	{
+	  ffesymbol_signal_change (s);
+	  ffesymbol_set_state (s, FFESYMBOL_stateUNCERTAIN);
+	  ffesymbol_signal_unreported (s);
+	}
+      else
+	ffesymbol_error (s, t);
+      break;
+
+    case FFESYMBOL_stateUNCERTAIN:	/* Already iterator! */
+      assert ("DATA implied-DO control var seen twice!!" == NULL);
+      ffesymbol_error (s, t);
+      break;
+
+    case FFESYMBOL_stateUNDERSTOOD:
+      break;			/* ANY. */
+
+    default:
+      assert ("Foo Bletch!!" == NULL);
+      break;
+    }
+
+  return s;
+}
+
+/* Have FOO in PARAMETER (FOO=...).  */
+
+static ffesymbol
+ffeexpr_sym_lhs_parameter_ (ffesymbol s, ffelexToken t)
+{
+  ffesymbolAttrs sa;
+
+  sa = ffesymbol_attrs (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (sa & ~(FFESYMBOL_attrsANYLEN
+	     | FFESYMBOL_attrsTYPE))
+    {
+      if (!(sa & FFESYMBOL_attrsANY))
+	ffesymbol_error (s, t);
+    }
+  else
+    {
+      ffesymbol_signal_change (s);	/* May need to back up to previous
+					   version. */
+      if (!ffeimplic_establish_symbol (s))
+	{
+	  ffesymbol_error (s, t);
+	  return s;
+	}
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       ffesymbol_rank (s),
+				       FFEINFO_kindENTITY,
+				       FFEINFO_whereCONSTANT,
+				       ffesymbol_size (s)));
+      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+      ffesymbol_resolve_intrin (s);
+      s = ffecom_sym_learned (s);
+      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+    }
+
+  return s;
+}
+
+/* Have FOO in CALL XYZ(...,FOO,...).  Does not include any other
+   embedding of FOO, such as CALL XYZ((FOO)) or CALL XYZ(FOO+1).  */
+
+static ffesymbol
+ffeexpr_sym_rhs_actualarg_ (ffesymbol s, ffelexToken t)
+{
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffeinfoKind kind;
+  ffeinfoWhere where;
+  ffesymbolState ns;
+  bool needs_type = FALSE;
+
+  assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	  || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
+
+  na = sa = ffesymbol_attrs (s);
+
+  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+		   | FFESYMBOL_attrsADJUSTABLE
+		   | FFESYMBOL_attrsANYLEN
+		   | FFESYMBOL_attrsARRAY
+		   | FFESYMBOL_attrsDUMMY
+		   | FFESYMBOL_attrsEXTERNAL
+		   | FFESYMBOL_attrsSFARG
+		   | FFESYMBOL_attrsTYPE)));
+
+  kind = ffesymbol_kind (s);
+  where = ffesymbol_where (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  ns = FFESYMBOL_stateUNDERSTOOD;
+
+  if (sa & FFESYMBOL_attrsEXTERNAL)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsTYPE)));
+
+      if (sa & FFESYMBOL_attrsTYPE)
+	where = FFEINFO_whereGLOBAL;
+      else
+	/* Not TYPE. */
+	{
+	  ns = FFESYMBOL_stateUNCERTAIN;
+
+	  if (sa & FFESYMBOL_attrsDUMMY)
+	    assert (kind == FFEINFO_kindNONE);	/* FUNCTION, SUBROUTINE. */
+	  else if (sa & FFESYMBOL_attrsACTUALARG)
+	    ;			/* Not DUMMY or TYPE. */
+	  else
+	    /* Not ACTUALARG, DUMMY, or TYPE. */
+	    {
+	      assert (kind == FFEINFO_kindNONE);	/* FUNCTION, SUBROUTINE. */
+	      na |= FFESYMBOL_attrsACTUALARG;
+	      where = FFEINFO_whereGLOBAL;
+	    }
+	}
+    }
+  else if (sa & FFESYMBOL_attrsDUMMY)
+    {
+      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsTYPE)));
+
+      kind = FFEINFO_kindENTITY;
+      if (!(sa & FFESYMBOL_attrsTYPE))
+	needs_type = TRUE;
+    }
+  else if (sa & FFESYMBOL_attrsARRAY)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsTYPE)));
+
+      where = FFEINFO_whereLOCAL;
+    }
+  else if (sa & FFESYMBOL_attrsSFARG)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsSFARG
+		       | FFESYMBOL_attrsTYPE)));
+
+      where = FFEINFO_whereLOCAL;
+    }
+  else if (sa & FFESYMBOL_attrsTYPE)
+    {
+      assert (!(sa & (FFESYMBOL_attrsARRAY
+		      | FFESYMBOL_attrsDUMMY
+		      | FFESYMBOL_attrsEXTERNAL
+		      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsTYPE
+		       | FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsANYLEN
+		       | FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsSFARG)));
+
+      if (sa & FFESYMBOL_attrsANYLEN)
+	ns = FFESYMBOL_stateNONE;
+      else
+	{
+	  kind = FFEINFO_kindENTITY;
+	  where = FFEINFO_whereLOCAL;
+	}
+    }
+  else if (sa == FFESYMBOL_attrsetNONE)
+    {
+      /* New state is left empty because there isn't any state flag to
+	 set for this case, and it's UNDERSTOOD after all.  */
+      assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
+      kind = FFEINFO_kindENTITY;
+      where = FFEINFO_whereLOCAL;
+      needs_type = TRUE;
+    }
+  else
+    ns = FFESYMBOL_stateNONE;	/* Error. */
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (ns == FFESYMBOL_stateNONE)
+    ffesymbol_error (s, t);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_signal_change (s);	/* May need to back up to previous
+					   version. */
+      if (needs_type && !ffeimplic_establish_symbol (s))
+	{
+	  ffesymbol_error (s, t);
+	  return s;
+	}
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       ffesymbol_rank (s),
+				       kind,
+				       where,
+				       ffesymbol_size (s)));
+      ffesymbol_set_attrs (s, na);
+      ffesymbol_set_state (s, ns);
+      s = ffecom_sym_learned (s);
+      ffesymbol_reference (s, t, FALSE);
+      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+    }
+
+  return s;
+}
+
+/* Have FOO in DIMENSION XYZ(FOO) or any array declarator containing
+   a reference to FOO.  */
+
+static ffesymbol
+ffeexpr_sym_rhs_dimlist_ (ffesymbol s, ffelexToken t)
+{
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffeinfoKind kind;
+  ffeinfoWhere where;
+
+  na = sa = ffesymbol_attrs (s);
+  kind = FFEINFO_kindENTITY;
+  where = ffesymbol_where (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (!(sa & ~(FFESYMBOL_attrsADJUSTS
+	       | FFESYMBOL_attrsCOMMON
+	       | FFESYMBOL_attrsDUMMY
+	       | FFESYMBOL_attrsEQUIV
+	       | FFESYMBOL_attrsINIT
+	       | FFESYMBOL_attrsNAMELIST
+	       | FFESYMBOL_attrsSFARG
+               | FFESYMBOL_attrsARRAY
+	       | FFESYMBOL_attrsTYPE)))
+    na = sa | FFESYMBOL_attrsADJUSTS;
+  else
+    na = FFESYMBOL_attrsetNONE;
+
+  /* Since this symbol definitely is going into an expression (the
+     dimension-list for some dummy array, presumably), figure out WHERE if
+     possible.  */
+
+  if (where == FFEINFO_whereNONE)
+    {
+      if (na & (FFESYMBOL_attrsCOMMON
+		| FFESYMBOL_attrsEQUIV
+		| FFESYMBOL_attrsINIT
+		| FFESYMBOL_attrsNAMELIST))
+	where = FFEINFO_whereCOMMON;
+      else if (na & FFESYMBOL_attrsDUMMY)
+	where = FFEINFO_whereDUMMY;
+    }
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (na == FFESYMBOL_attrsetNONE)
+    ffesymbol_error (s, t);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_signal_change (s);	/* May need to back up to previous
+					   version. */
+      if (!ffeimplic_establish_symbol (s))
+	{
+	  ffesymbol_error (s, t);
+	  return s;
+	}
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       ffesymbol_rank (s),
+				       kind,	/* Always ENTITY. */
+				       where,	/* NONE, COMMON, or DUMMY. */
+				       ffesymbol_size (s)));
+      ffesymbol_set_attrs (s, na);
+      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
+      ffesymbol_resolve_intrin (s);
+      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+    }
+
+  return s;
+}
+
+/* Have FOO in XYZ = ...FOO....  Does not include cases like FOO in
+   XYZ = BAR(FOO), as such cases are handled elsewhere.  */
+
+static ffesymbol
+ffeexpr_sym_rhs_let_ (ffesymbol s, ffelexToken t)
+{
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffeinfoKind kind;
+  ffeinfoWhere where;
+  bool error = FALSE;
+
+  assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	  || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
+
+  na = sa = ffesymbol_attrs (s);
+
+  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+		   | FFESYMBOL_attrsADJUSTABLE
+		   | FFESYMBOL_attrsANYLEN
+		   | FFESYMBOL_attrsARRAY
+		   | FFESYMBOL_attrsDUMMY
+		   | FFESYMBOL_attrsEXTERNAL
+		   | FFESYMBOL_attrsSFARG
+		   | FFESYMBOL_attrsTYPE)));
+
+  kind = ffesymbol_kind (s);
+  where = ffesymbol_where (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (sa & FFESYMBOL_attrsEXTERNAL)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsTYPE)));
+
+      error = TRUE;
+    }
+  else if (sa & FFESYMBOL_attrsDUMMY)
+    {
+      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsTYPE)));
+
+      kind = FFEINFO_kindENTITY;
+    }
+  else if (sa & FFESYMBOL_attrsARRAY)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsTYPE)));
+
+      where = FFEINFO_whereLOCAL;
+    }
+  else if (sa & FFESYMBOL_attrsSFARG)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsSFARG
+		       | FFESYMBOL_attrsTYPE)));
+
+      where = FFEINFO_whereLOCAL;
+    }
+  else if (sa & FFESYMBOL_attrsTYPE)
+    {
+      assert (!(sa & (FFESYMBOL_attrsARRAY
+		      | FFESYMBOL_attrsDUMMY
+		      | FFESYMBOL_attrsEXTERNAL
+		      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsTYPE
+		       | FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsANYLEN
+		       | FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsSFARG)));
+
+      if (sa & FFESYMBOL_attrsANYLEN)
+	error = TRUE;
+      else
+	{
+	  kind = FFEINFO_kindENTITY;
+	  where = FFEINFO_whereLOCAL;
+	}
+    }
+  else if (sa == FFESYMBOL_attrsetNONE)
+    {
+      assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
+      kind = FFEINFO_kindENTITY;
+      where = FFEINFO_whereLOCAL;
+    }
+  else
+    error = TRUE;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (error)
+    ffesymbol_error (s, t);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_signal_change (s);	/* May need to back up to previous
+					   version. */
+      if (!ffeimplic_establish_symbol (s))
+	{
+	  ffesymbol_error (s, t);
+	  return s;
+	}
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       ffesymbol_rank (s),
+				       kind,	/* ENTITY. */
+				       where,	/* LOCAL. */
+				       ffesymbol_size (s)));
+      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+      ffesymbol_resolve_intrin (s);
+      s = ffecom_sym_learned (s);
+      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+    }
+
+  return s;
+}
+
+/* ffeexpr_declare_parenthesized_ -- ffesymbol wrapper for NAME(...) operand
+
+   ffelexToken t;
+   bool maybe_intrin;
+   ffeexprParenType_ paren_type;
+   ffesymbol s;
+   s = ffeexpr_declare_parenthesized_ (t, maybe_intrin, &paren_type);
+
+   Just like ffesymbol_declare_local, except performs any implicit info
+   assignment necessary, and it returns the type of the parenthesized list
+   (list of function args, list of array args, or substring spec).  */
+
+static ffesymbol
+ffeexpr_declare_parenthesized_ (ffelexToken t, bool maybe_intrin,
+				ffeexprParenType_ *paren_type)
+{
+  ffesymbol s;
+  ffesymbolState st;		/* Effective state. */
+  ffeinfoKind k;
+  bool bad;
+
+  if (maybe_intrin && ffesrc_check_symbol ())
+    {				/* Knock off some easy cases. */
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextSUBROUTINEREF:
+	case FFEEXPR_contextDATA:
+	case FFEEXPR_contextDATAIMPDOINDEX_:
+	case FFEEXPR_contextSFUNCDEF:
+	case FFEEXPR_contextSFUNCDEFINDEX_:
+	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+	case FFEEXPR_contextLET:
+	case FFEEXPR_contextPAREN_:
+	case FFEEXPR_contextACTUALARGEXPR_:
+	case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+	case FFEEXPR_contextIOLIST:
+	case FFEEXPR_contextIOLISTDF:
+	case FFEEXPR_contextDO:
+	case FFEEXPR_contextDOWHILE:
+	case FFEEXPR_contextACTUALARG_:
+	case FFEEXPR_contextCGOTO:
+	case FFEEXPR_contextIF:
+	case FFEEXPR_contextARITHIF:
+	case FFEEXPR_contextFORMAT:
+	case FFEEXPR_contextSTOP:
+	case FFEEXPR_contextRETURN:
+	case FFEEXPR_contextSELECTCASE:
+	case FFEEXPR_contextCASE:
+	case FFEEXPR_contextFILEASSOC:
+	case FFEEXPR_contextFILEINT:
+	case FFEEXPR_contextFILEDFINT:
+	case FFEEXPR_contextFILELOG:
+	case FFEEXPR_contextFILENUM:
+	case FFEEXPR_contextFILENUMAMBIG:
+	case FFEEXPR_contextFILECHAR:
+	case FFEEXPR_contextFILENUMCHAR:
+	case FFEEXPR_contextFILEDFCHAR:
+	case FFEEXPR_contextFILEKEY:
+	case FFEEXPR_contextFILEUNIT:
+	case FFEEXPR_contextFILEUNIT_DF:
+	case FFEEXPR_contextFILEUNITAMBIG:
+	case FFEEXPR_contextFILEFORMAT:
+	case FFEEXPR_contextFILENAMELIST:
+	case FFEEXPR_contextFILEVXTCODE:
+	case FFEEXPR_contextINDEX_:
+	case FFEEXPR_contextIMPDOITEM_:
+	case FFEEXPR_contextIMPDOITEMDF_:
+	case FFEEXPR_contextIMPDOCTRL_:
+	case FFEEXPR_contextDATAIMPDOCTRL_:
+	case FFEEXPR_contextCHARACTERSIZE:
+	case FFEEXPR_contextPARAMETER:
+	case FFEEXPR_contextDIMLIST:
+	case FFEEXPR_contextDIMLISTCOMMON:
+	case FFEEXPR_contextKINDTYPE:
+	case FFEEXPR_contextINITVAL:
+	case FFEEXPR_contextEQVINDEX_:
+	  break;		/* These could be intrinsic invocations. */
+
+	case FFEEXPR_contextAGOTO:
+	case FFEEXPR_contextFILEFORMATNML:
+	case FFEEXPR_contextALLOCATE:
+	case FFEEXPR_contextDEALLOCATE:
+	case FFEEXPR_contextHEAPSTAT:
+	case FFEEXPR_contextNULLIFY:
+	case FFEEXPR_contextINCLUDE:
+	case FFEEXPR_contextDATAIMPDOITEM_:
+	case FFEEXPR_contextLOC_:
+	case FFEEXPR_contextINDEXORACTUALARG_:
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+	case FFEEXPR_contextPARENFILENUM_:
+	case FFEEXPR_contextPARENFILEUNIT_:
+	  maybe_intrin = FALSE;
+	  break;		/* Can't be intrinsic invocation. */
+
+	default:
+	  assert ("blah! blah! waaauuggh!" == NULL);
+	  break;
+	}
+    }
+
+  s = ffesymbol_declare_local (t, maybe_intrin);
+
+  switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+    /* Special-case these since they can involve a different concept
+       of "state" (in the stmtfunc name space).  */
+    {
+    case FFEEXPR_contextDATAIMPDOINDEX_:
+    case FFEEXPR_contextDATAIMPDOCTRL_:
+      if (ffeexpr_context_outer_ (ffeexpr_stack_)
+	  == FFEEXPR_contextDATAIMPDOINDEX_)
+	s = ffeexpr_sym_impdoitem_ (s, t);
+      else
+	if (ffeexpr_stack_->is_rhs)
+	  s = ffeexpr_sym_impdoitem_ (s, t);
+	else
+	  s = ffeexpr_sym_lhs_impdoctrl_ (s, t);
+      if (ffesymbol_kind (s) != FFEINFO_kindANY)
+	ffesymbol_error (s, t);
+      return s;
+
+    default:
+      break;
+    }
+
+  switch ((ffesymbol_sfdummyparent (s) == NULL)
+	  ? ffesymbol_state (s)
+	  : FFESYMBOL_stateUNDERSTOOD)
+    {
+    case FFESYMBOL_stateNONE:	/* Before first exec, not seen in expr
+				   context. */
+      if (!ffest_seen_first_exec ())
+	goto seen;		/* :::::::::::::::::::: */
+      /* Fall through. */
+    case FFESYMBOL_stateUNCERTAIN:	/* Unseen since first exec. */
+      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+	{
+	case FFEEXPR_contextSUBROUTINEREF:
+	  s = ffeexpr_sym_lhs_call_ (s, t);	/* "CALL FOO"=="CALL
+						   FOO(...)". */
+	  break;
+
+	case FFEEXPR_contextDATA:
+	  if (ffeexpr_stack_->is_rhs)
+	    s = ffeexpr_sym_rhs_let_ (s, t);
+	  else
+	    s = ffeexpr_sym_lhs_data_ (s, t);
+	  break;
+
+	case FFEEXPR_contextDATAIMPDOITEM_:
+	  s = ffeexpr_sym_lhs_data_ (s, t);
+	  break;
+
+	case FFEEXPR_contextSFUNCDEF:
+	case FFEEXPR_contextSFUNCDEFINDEX_:
+	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+	  s = ffecom_sym_exec_transition (s);
+	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+	    goto understood;	/* :::::::::::::::::::: */
+	  /* Fall through. */
+	case FFEEXPR_contextLET:
+	case FFEEXPR_contextPAREN_:
+	case FFEEXPR_contextACTUALARGEXPR_:
+	case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+	case FFEEXPR_contextIOLIST:
+	case FFEEXPR_contextIOLISTDF:
+	case FFEEXPR_contextDO:
+	case FFEEXPR_contextDOWHILE:
+	case FFEEXPR_contextACTUALARG_:
+	case FFEEXPR_contextCGOTO:
+	case FFEEXPR_contextIF:
+	case FFEEXPR_contextARITHIF:
+	case FFEEXPR_contextFORMAT:
+	case FFEEXPR_contextSTOP:
+	case FFEEXPR_contextRETURN:
+	case FFEEXPR_contextSELECTCASE:
+	case FFEEXPR_contextCASE:
+	case FFEEXPR_contextFILEASSOC:
+	case FFEEXPR_contextFILEINT:
+	case FFEEXPR_contextFILEDFINT:
+	case FFEEXPR_contextFILELOG:
+	case FFEEXPR_contextFILENUM:
+	case FFEEXPR_contextFILENUMAMBIG:
+	case FFEEXPR_contextFILECHAR:
+	case FFEEXPR_contextFILENUMCHAR:
+	case FFEEXPR_contextFILEDFCHAR:
+	case FFEEXPR_contextFILEKEY:
+	case FFEEXPR_contextFILEUNIT:
+	case FFEEXPR_contextFILEUNIT_DF:
+	case FFEEXPR_contextFILEUNITAMBIG:
+	case FFEEXPR_contextFILEFORMAT:
+	case FFEEXPR_contextFILENAMELIST:
+	case FFEEXPR_contextFILEVXTCODE:
+	case FFEEXPR_contextINDEX_:
+	case FFEEXPR_contextIMPDOITEM_:
+	case FFEEXPR_contextIMPDOITEMDF_:
+	case FFEEXPR_contextIMPDOCTRL_:
+	case FFEEXPR_contextLOC_:
+	  if (ffeexpr_stack_->is_rhs)
+	    s = ffeexpr_paren_rhs_let_ (s, t);
+	  else
+	    s = ffeexpr_paren_lhs_let_ (s, t);
+	  break;
+
+	case FFEEXPR_contextASSIGN:
+	case FFEEXPR_contextAGOTO:
+	case FFEEXPR_contextCHARACTERSIZE:
+	case FFEEXPR_contextEQUIVALENCE:
+	case FFEEXPR_contextINCLUDE:
+	case FFEEXPR_contextPARAMETER:
+	case FFEEXPR_contextDIMLIST:
+	case FFEEXPR_contextDIMLISTCOMMON:
+	case FFEEXPR_contextKINDTYPE:
+	case FFEEXPR_contextINITVAL:
+	case FFEEXPR_contextEQVINDEX_:
+	  break;		/* Will turn into errors below. */
+
+	default:
+	  ffesymbol_error (s, t);
+	  break;
+	}
+      /* Fall through. */
+    case FFESYMBOL_stateUNDERSTOOD:	/* Nothing much more to learn. */
+    understood:		/* :::::::::::::::::::: */
+
+      /* State might have changed, update it.  */
+      st = ((ffesymbol_sfdummyparent (s) == NULL)
+	    ? ffesymbol_state (s)
+	    : FFESYMBOL_stateUNDERSTOOD);
+
+      k = ffesymbol_kind (s);
+      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+	{
+	case FFEEXPR_contextSUBROUTINEREF:
+	  bad = ((k != FFEINFO_kindSUBROUTINE)
+		 && ((ffesymbol_where (s) != FFEINFO_whereINTRINSIC)
+		     || (k != FFEINFO_kindNONE)));
+	  break;
+
+	case FFEEXPR_contextDATA:
+	  if (ffeexpr_stack_->is_rhs)
+	    bad = (k != FFEINFO_kindENTITY)
+	      || (ffesymbol_where (s) != FFEINFO_whereCONSTANT);
+	  else
+	    bad = (k != FFEINFO_kindENTITY)
+	      || ((ffesymbol_where (s) != FFEINFO_whereNONE)
+		  && (ffesymbol_where (s) != FFEINFO_whereLOCAL)
+		  && (ffesymbol_where (s) != FFEINFO_whereCOMMON));
+	  break;
+
+	case FFEEXPR_contextDATAIMPDOITEM_:
+	  bad = (k != FFEINFO_kindENTITY) || (ffesymbol_rank (s) == 0)
+	    || ((ffesymbol_where (s) != FFEINFO_whereNONE)
+		&& (ffesymbol_where (s) != FFEINFO_whereLOCAL)
+		&& (ffesymbol_where (s) != FFEINFO_whereCOMMON));
+	  break;
+
+	case FFEEXPR_contextSFUNCDEF:
+	case FFEEXPR_contextSFUNCDEFINDEX_:
+	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+	case FFEEXPR_contextLET:
+	case FFEEXPR_contextPAREN_:
+	case FFEEXPR_contextACTUALARGEXPR_:
+	case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+	case FFEEXPR_contextIOLIST:
+	case FFEEXPR_contextIOLISTDF:
+	case FFEEXPR_contextDO:
+	case FFEEXPR_contextDOWHILE:
+	case FFEEXPR_contextACTUALARG_:
+	case FFEEXPR_contextCGOTO:
+	case FFEEXPR_contextIF:
+	case FFEEXPR_contextARITHIF:
+	case FFEEXPR_contextFORMAT:
+	case FFEEXPR_contextSTOP:
+	case FFEEXPR_contextRETURN:
+	case FFEEXPR_contextSELECTCASE:
+	case FFEEXPR_contextCASE:
+	case FFEEXPR_contextFILEASSOC:
+	case FFEEXPR_contextFILEINT:
+	case FFEEXPR_contextFILEDFINT:
+	case FFEEXPR_contextFILELOG:
+	case FFEEXPR_contextFILENUM:
+	case FFEEXPR_contextFILENUMAMBIG:
+	case FFEEXPR_contextFILECHAR:
+	case FFEEXPR_contextFILENUMCHAR:
+	case FFEEXPR_contextFILEDFCHAR:
+	case FFEEXPR_contextFILEKEY:
+	case FFEEXPR_contextFILEUNIT:
+	case FFEEXPR_contextFILEUNIT_DF:
+	case FFEEXPR_contextFILEUNITAMBIG:
+	case FFEEXPR_contextFILEFORMAT:
+	case FFEEXPR_contextFILENAMELIST:
+	case FFEEXPR_contextFILEVXTCODE:
+	case FFEEXPR_contextINDEX_:
+	case FFEEXPR_contextIMPDOITEM_:
+	case FFEEXPR_contextIMPDOITEMDF_:
+	case FFEEXPR_contextIMPDOCTRL_:
+	case FFEEXPR_contextLOC_:
+	  bad = FALSE;		/* Let paren-switch handle the cases. */
+	  break;
+
+	case FFEEXPR_contextASSIGN:
+	case FFEEXPR_contextAGOTO:
+	case FFEEXPR_contextCHARACTERSIZE:
+	case FFEEXPR_contextEQUIVALENCE:
+	case FFEEXPR_contextPARAMETER:
+	case FFEEXPR_contextDIMLIST:
+	case FFEEXPR_contextDIMLISTCOMMON:
+	case FFEEXPR_contextKINDTYPE:
+	case FFEEXPR_contextINITVAL:
+	case FFEEXPR_contextEQVINDEX_:
+	  bad = (k != FFEINFO_kindENTITY)
+	    || (ffesymbol_where (s) != FFEINFO_whereCONSTANT);
+	  break;
+
+	case FFEEXPR_contextINCLUDE:
+	  bad = TRUE;
+	  break;
+
+	default:
+	  bad = TRUE;
+	  break;
+	}
+
+      switch (bad ? FFEINFO_kindANY : k)
+	{
+	case FFEINFO_kindNONE:	/* Case "CHARACTER X,Y; Y=X(?". */
+	  if (ffesymbol_where (s) == FFEINFO_whereINTRINSIC)
+	    {
+	      if (ffeexpr_context_outer_ (ffeexpr_stack_)
+		  == FFEEXPR_contextSUBROUTINEREF)
+		*paren_type = FFEEXPR_parentypeSUBROUTINE_;
+	      else
+		*paren_type = FFEEXPR_parentypeFUNCTION_;
+	      break;
+	    }
+	  if (st == FFESYMBOL_stateUNDERSTOOD)
+	    {
+	      bad = TRUE;
+	      *paren_type = FFEEXPR_parentypeANY_;
+	    }
+	  else
+	    *paren_type = FFEEXPR_parentypeFUNSUBSTR_;
+	  break;
+
+	case FFEINFO_kindFUNCTION:
+	  *paren_type = FFEEXPR_parentypeFUNCTION_;
+	  switch (ffesymbol_where (s))
+	    {
+	    case FFEINFO_whereLOCAL:
+	      bad = TRUE;	/* Attempt to recurse! */
+	      break;
+
+	    case FFEINFO_whereCONSTANT:
+	      bad = ((ffesymbol_sfexpr (s) == NULL)
+		     || (ffebld_op (ffesymbol_sfexpr (s))
+			 == FFEBLD_opANY));	/* Attempt to recurse! */
+	      break;
+
+	    default:
+	      break;
+	    }
+	  break;
+
+	case FFEINFO_kindSUBROUTINE:
+	  if ((ffeexpr_stack_->context != FFEEXPR_contextSUBROUTINEREF)
+	      || (ffeexpr_stack_->previous != NULL))
+	    {
+	      bad = TRUE;
+	      *paren_type = FFEEXPR_parentypeANY_;
+	      break;
+	    }
+
+	  *paren_type = FFEEXPR_parentypeSUBROUTINE_;
+	  switch (ffesymbol_where (s))
+	    {
+	    case FFEINFO_whereLOCAL:
+	    case FFEINFO_whereCONSTANT:
+	      bad = TRUE;	/* Attempt to recurse! */
+	      break;
+
+	    default:
+	      break;
+	    }
+	  break;
+
+	case FFEINFO_kindENTITY:
+	  if (ffesymbol_rank (s) == 0)
+	    {
+	      if (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
+		*paren_type = FFEEXPR_parentypeSUBSTRING_;
+	      else
+		{
+		  bad = TRUE;
+		  *paren_type = FFEEXPR_parentypeANY_;
+		}
+	    }
+	  else
+	    *paren_type = FFEEXPR_parentypeARRAY_;
+	  break;
+
+	default:
+	case FFEINFO_kindANY:
+	  bad = TRUE;
+	  *paren_type = FFEEXPR_parentypeANY_;
+	  break;
+	}
+
+      if (bad)
+	{
+	  if (k == FFEINFO_kindANY)
+	    ffest_shutdown ();
+	  else
+	    ffesymbol_error (s, t);
+	}
+
+      return s;
+
+    case FFESYMBOL_stateSEEN:	/* Seen but not yet in exec portion. */
+    seen:			/* :::::::::::::::::::: */
+      bad = TRUE;
+      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+	{
+	case FFEEXPR_contextPARAMETER:
+	  if (ffeexpr_stack_->is_rhs)
+	    ffesymbol_error (s, t);
+	  else
+	    s = ffeexpr_sym_lhs_parameter_ (s, t);
+	  break;
+
+	case FFEEXPR_contextDATA:
+	  s = ffecom_sym_exec_transition (s);
+	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+	    goto understood;	/* :::::::::::::::::::: */
+	  if (ffeexpr_stack_->is_rhs)
+	    ffesymbol_error (s, t);
+	  else
+	    s = ffeexpr_sym_lhs_data_ (s, t);
+	  goto understood;	/* :::::::::::::::::::: */
+
+	case FFEEXPR_contextDATAIMPDOITEM_:
+	  s = ffecom_sym_exec_transition (s);
+	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+	    goto understood;	/* :::::::::::::::::::: */
+	  s = ffeexpr_sym_lhs_data_ (s, t);
+	  goto understood;	/* :::::::::::::::::::: */
+
+	case FFEEXPR_contextEQUIVALENCE:
+	  s = ffeexpr_sym_lhs_equivalence_ (s, t);
+	  bad = FALSE;
+	  break;
+
+	case FFEEXPR_contextDIMLIST:
+	  s = ffeexpr_sym_rhs_dimlist_ (s, t);
+          bad = FALSE;
+	  break;
+
+	case FFEEXPR_contextCHARACTERSIZE:
+	case FFEEXPR_contextKINDTYPE:
+	case FFEEXPR_contextDIMLISTCOMMON:
+	case FFEEXPR_contextINITVAL:
+	case FFEEXPR_contextEQVINDEX_:
+	  break;
+
+	case FFEEXPR_contextINCLUDE:
+	  break;
+
+	case FFEEXPR_contextINDEX_:
+	case FFEEXPR_contextACTUALARGEXPR_:
+	case FFEEXPR_contextINDEXORACTUALARGEXPR_:
+	case FFEEXPR_contextSFUNCDEF:
+	case FFEEXPR_contextSFUNCDEFINDEX_:
+	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+	  assert (ffeexpr_stack_->is_rhs);
+	  s = ffecom_sym_exec_transition (s);
+	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
+	    goto understood;	/* :::::::::::::::::::: */
+	  s = ffeexpr_paren_rhs_let_ (s, t);
+	  goto understood;	/* :::::::::::::::::::: */
+
+	default:
+	  break;
+	}
+      k = ffesymbol_kind (s);
+      switch (bad ? FFEINFO_kindANY : k)
+	{
+	case FFEINFO_kindNONE:	/* Case "CHARACTER X,Y; Y=X(?". */
+	  *paren_type = FFEEXPR_parentypeFUNSUBSTR_;
+	  break;
+
+	case FFEINFO_kindFUNCTION:
+	  *paren_type = FFEEXPR_parentypeFUNCTION_;
+	  switch (ffesymbol_where (s))
+	    {
+	    case FFEINFO_whereLOCAL:
+	      bad = TRUE;	/* Attempt to recurse! */
+	      break;
+
+	    case FFEINFO_whereCONSTANT:
+	      bad = ((ffesymbol_sfexpr (s) == NULL)
+		     || (ffebld_op (ffesymbol_sfexpr (s))
+			 == FFEBLD_opANY));	/* Attempt to recurse! */
+	      break;
+
+	    default:
+	      break;
+	    }
+	  break;
+
+	case FFEINFO_kindSUBROUTINE:
+	  *paren_type = FFEEXPR_parentypeANY_;
+	  bad = TRUE;		/* Cannot possibly be in
+				   contextSUBROUTINEREF. */
+	  break;
+
+	case FFEINFO_kindENTITY:
+	  if (ffesymbol_rank (s) == 0)
+	    {
+	      if (ffeexpr_stack_->context == FFEEXPR_contextEQUIVALENCE)
+		*paren_type = FFEEXPR_parentypeEQUIVALENCE_;
+	      else if (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
+		*paren_type = FFEEXPR_parentypeSUBSTRING_;
+	      else
+		{
+		  bad = TRUE;
+		  *paren_type = FFEEXPR_parentypeANY_;
+		}
+	    }
+	  else
+	    *paren_type = FFEEXPR_parentypeARRAY_;
+	  break;
+
+	default:
+	case FFEINFO_kindANY:
+	  bad = TRUE;
+	  *paren_type = FFEEXPR_parentypeANY_;
+	  break;
+	}
+
+      if (bad)
+	{
+	  if (k == FFEINFO_kindANY)
+	    ffest_shutdown ();
+	  else
+	    ffesymbol_error (s, t);
+	}
+
+      return s;
+
+    default:
+      assert ("bad symbol state" == NULL);
+      return NULL;
+    }
+}
+
+/* Have FOO in XYZ = ...FOO(...)....  Executable context only.  */
+
+static ffesymbol
+ffeexpr_paren_rhs_let_ (ffesymbol s, ffelexToken t)
+{
+  ffesymbolAttrs sa;
+  ffesymbolAttrs na;
+  ffeinfoKind kind;
+  ffeinfoWhere where;
+  ffeintrinGen gen;
+  ffeintrinSpec spec;
+  ffeintrinImp imp;
+  bool maybe_ambig = FALSE;
+  bool error = FALSE;
+
+  assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
+	  || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
+
+  na = sa = ffesymbol_attrs (s);
+
+  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+		   | FFESYMBOL_attrsADJUSTABLE
+		   | FFESYMBOL_attrsANYLEN
+		   | FFESYMBOL_attrsARRAY
+		   | FFESYMBOL_attrsDUMMY
+		   | FFESYMBOL_attrsEXTERNAL
+		   | FFESYMBOL_attrsSFARG
+		   | FFESYMBOL_attrsTYPE)));
+
+  kind = ffesymbol_kind (s);
+  where = ffesymbol_where (s);
+
+  /* Figure out what kind of object we've got based on previous declarations
+     of or references to the object. */
+
+  if (sa & FFESYMBOL_attrsEXTERNAL)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsTYPE)));
+
+      if (sa & FFESYMBOL_attrsTYPE)
+	where = FFEINFO_whereGLOBAL;
+      else
+	/* Not TYPE. */
+	{
+	  kind = FFEINFO_kindFUNCTION;
+
+	  if (sa & FFESYMBOL_attrsDUMMY)
+	    ;			/* Not TYPE. */
+	  else if (sa & FFESYMBOL_attrsACTUALARG)
+	    ;			/* Not DUMMY or TYPE. */
+	  else			/* Not ACTUALARG, DUMMY, or TYPE. */
+	    where = FFEINFO_whereGLOBAL;
+	}
+    }
+  else if (sa & FFESYMBOL_attrsDUMMY)
+    {
+      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsTYPE)));
+
+      kind = FFEINFO_kindFUNCTION;
+      maybe_ambig = TRUE;	/* If basictypeCHARACTER, can't be sure; kind
+				   could be ENTITY w/substring ref. */
+    }
+  else if (sa & FFESYMBOL_attrsARRAY)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsTYPE)));
+
+      where = FFEINFO_whereLOCAL;
+    }
+  else if (sa & FFESYMBOL_attrsSFARG)
+    {
+      assert (!(sa & ~(FFESYMBOL_attrsSFARG
+		       | FFESYMBOL_attrsTYPE)));
+
+      where = FFEINFO_whereLOCAL;	/* Actually an error, but at least we
+					   know it's a local var. */
+    }
+  else if (sa & FFESYMBOL_attrsTYPE)
+    {
+      assert (!(sa & (FFESYMBOL_attrsARRAY
+		      | FFESYMBOL_attrsDUMMY
+		      | FFESYMBOL_attrsEXTERNAL
+		      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
+      assert (!(sa & ~(FFESYMBOL_attrsTYPE
+		       | FFESYMBOL_attrsADJUSTABLE
+		       | FFESYMBOL_attrsANYLEN
+		       | FFESYMBOL_attrsARRAY
+		       | FFESYMBOL_attrsDUMMY
+		       | FFESYMBOL_attrsEXTERNAL
+		       | FFESYMBOL_attrsSFARG)));
+
+      if (ffeintrin_is_intrinsic (ffesymbol_text (s), t, FALSE,
+				  &gen, &spec, &imp))
+	{
+	  if (!(sa & FFESYMBOL_attrsANYLEN)
+	      && (ffeimplic_peek_symbol_type (s, NULL)
+		  == FFEINFO_basictypeCHARACTER))
+	    return s;		/* Haven't learned anything yet. */
+
+	  ffesymbol_signal_change (s);	/* May need to back up to previous
+					   version. */
+	  ffesymbol_set_generic (s, gen);
+	  ffesymbol_set_specific (s, spec);
+	  ffesymbol_set_implementation (s, imp);
+	  ffesymbol_set_info (s,
+			      ffeinfo_new (ffesymbol_basictype (s),
+					   ffesymbol_kindtype (s),
+					   0,
+					   FFEINFO_kindFUNCTION,
+					   FFEINFO_whereINTRINSIC,
+					   ffesymbol_size (s)));
+	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+	  ffesymbol_resolve_intrin (s);
+	  ffesymbol_reference (s, t, FALSE);
+	  s = ffecom_sym_learned (s);
+	  ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+
+	  return s;
+	}
+      if (sa & FFESYMBOL_attrsANYLEN)
+	error = TRUE;		/* Error, since the only way we can,
+				   given CHARACTER*(*) FOO, accept
+				   FOO(...) is for FOO to be a dummy
+				   arg or constant, but it can't
+				   become either now. */
+      else if (sa & FFESYMBOL_attrsADJUSTABLE)
+	{
+	  kind = FFEINFO_kindENTITY;
+	  where = FFEINFO_whereLOCAL;
+	}
+      else
+	{
+	  kind = FFEINFO_kindFUNCTION;
+	  where = FFEINFO_whereGLOBAL;
+	  maybe_ambig = TRUE;	/* If basictypeCHARACTER, can't be sure;
+				   could be ENTITY/LOCAL w/substring ref. */
+	}
+    }
+  else if (sa == FFESYMBOL_attrsetNONE)
+    {
+      assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
+
+      if (ffeintrin_is_intrinsic (ffesymbol_text (s), t, FALSE,
+				  &gen, &spec, &imp))
+	{
+	  if (ffeimplic_peek_symbol_type (s, NULL)
+	      == FFEINFO_basictypeCHARACTER)
+	    return s;		/* Haven't learned anything yet. */
+
+	  ffesymbol_signal_change (s);	/* May need to back up to previous
+					   version. */
+	  ffesymbol_set_generic (s, gen);
+	  ffesymbol_set_specific (s, spec);
+	  ffesymbol_set_implementation (s, imp);
+	  ffesymbol_set_info (s,
+			      ffeinfo_new (ffesymbol_basictype (s),
+					   ffesymbol_kindtype (s),
+					   0,
+					   FFEINFO_kindFUNCTION,
+					   FFEINFO_whereINTRINSIC,
+					   ffesymbol_size (s)));
+	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+	  ffesymbol_resolve_intrin (s);
+	  s = ffecom_sym_learned (s);
+	  ffesymbol_reference (s, t, FALSE);
+	  ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+	  return s;
+	}
+
+      kind = FFEINFO_kindFUNCTION;
+      where = FFEINFO_whereGLOBAL;
+      maybe_ambig = TRUE;	/* If basictypeCHARACTER, can't be sure;
+				   could be ENTITY/LOCAL w/substring ref. */
+    }
+  else
+    error = TRUE;
+
+  /* Now see what we've got for a new object: NONE means a new error cropped
+     up; ANY means an old error to be ignored; otherwise, everything's ok,
+     update the object (symbol) and continue on. */
+
+  if (error)
+    ffesymbol_error (s, t);
+  else if (!(na & FFESYMBOL_attrsANY))
+    {
+      ffesymbol_signal_change (s);	/* May need to back up to previous
+					   version. */
+      if (!ffeimplic_establish_symbol (s))
+	{
+	  ffesymbol_error (s, t);
+	  return s;
+	}
+      if (maybe_ambig
+	  && (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER))
+	return s;		/* Still not sure, let caller deal with it
+				   based on (...). */
+
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       ffesymbol_rank (s),
+				       kind,
+				       where,
+				       ffesymbol_size (s)));
+      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+      ffesymbol_resolve_intrin (s);
+      s = ffecom_sym_learned (s);
+      ffesymbol_reference (s, t, FALSE);
+      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+    }
+
+  return s;
+}
+
+/* ffeexpr_token_arguments_ -- OPEN_PAREN [expr COMMA]...expr
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Handle expression (which might be null) and COMMA or CLOSE_PAREN.  */
+
+static ffelexHandler
+ffeexpr_token_arguments_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  ffeexprExpr_ procedure;
+  ffebld reduced;
+  ffeinfo info;
+  ffeexprContext ctx;
+  bool check_intrin = FALSE;	/* Set TRUE if intrinsic is REAL(Z) or AIMAG(Z). */
+
+  procedure = ffeexpr_stack_->exprstack;
+  info = ffebld_info (procedure->u.operand);
+
+  /* Is there an expression to add?  If the expression is nil,
+     it might still be an argument.  It is if:
+
+       -  The current token is comma, or
+
+       -  The -fugly-comma flag was specified *and* the procedure
+          being invoked is external.
+
+     Otherwise, if neither of the above is the case, just
+     ignore this (nil) expression.  */
+
+  if ((expr != NULL)
+      || (ffelex_token_type (t) == FFELEX_typeCOMMA)
+      || (ffe_is_ugly_comma ()
+	  && (ffeinfo_where (info) == FFEINFO_whereGLOBAL)))
+    {
+      /* This expression, even if nil, is apparently intended as an argument.  */
+
+      /* Internal procedure (CONTAINS, or statement function)?  */
+
+      if (ffeinfo_where (info) == FFEINFO_whereCONSTANT)
+	{
+	  if ((expr == NULL)
+	      && ffebad_start (FFEBAD_NULL_ARGUMENT))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+			   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+	      ffebad_here (1, ffelex_token_where_line (t),
+			   ffelex_token_where_column (t));
+	      ffebad_finish ();
+	    }
+
+	  if (expr == NULL)
+	    ;
+	  else
+	    {
+	      if (ffeexpr_stack_->next_dummy == NULL)
+		{			/* Report later which was the first extra argument. */
+		  if (ffeexpr_stack_->tokens[1] == NULL)
+		    {
+		      ffeexpr_stack_->tokens[1] = ffelex_token_use (ft);
+		      ffeexpr_stack_->num_args = 0;
+		    }
+		  ++ffeexpr_stack_->num_args;	/* Count # of extra arguments. */
+		}
+	      else
+		{
+		  if ((ffeinfo_rank (ffebld_info (expr)) != 0)
+		      && ffebad_start (FFEBAD_ARRAY_AS_SFARG))
+		    {
+		      ffebad_here (0,
+				   ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+				   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+		      ffebad_here (1, ffelex_token_where_line (ft),
+				   ffelex_token_where_column (ft));
+		      ffebad_string (ffesymbol_text (ffesymbol_sfdummyparent
+						     (ffebld_symter (ffebld_head
+								     (ffeexpr_stack_->next_dummy)))));
+		      ffebad_finish ();
+		    }
+		  else
+		    {
+		      expr = ffeexpr_convert_expr (expr, ft,
+						   ffebld_head (ffeexpr_stack_->next_dummy),
+						   ffeexpr_stack_->tokens[0],
+						   FFEEXPR_contextLET);
+		      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+		    }
+		  --ffeexpr_stack_->num_args;	/* Count down # of args. */
+		  ffeexpr_stack_->next_dummy
+		    = ffebld_trail (ffeexpr_stack_->next_dummy);
+		}
+	    }
+	}
+      else
+	{
+	  if ((expr == NULL)
+	      && ffe_is_pedantic ()
+	      && ffebad_start (FFEBAD_NULL_ARGUMENT_W))
+	    {
+	      ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+			   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+	      ffebad_here (1, ffelex_token_where_line (t),
+			   ffelex_token_where_column (t));
+	      ffebad_finish ();
+	    }
+	  ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+	}
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+	{
+	case FFEEXPR_contextSFUNCDEF:
+	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
+	case FFEEXPR_contextSFUNCDEFINDEX_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
+	  ctx = FFEEXPR_contextSFUNCDEFACTUALARG_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+	  assert ("bad context" == NULL);
+	  ctx = FFEEXPR_context;
+	  break;
+
+	default:
+	  ctx = FFEEXPR_contextACTUALARG_;
+	  break;
+	}
+      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool, ctx,
+					  ffeexpr_token_arguments_);
+
+    default:
+      break;
+    }
+
+  if ((ffeinfo_where (info) == FFEINFO_whereCONSTANT)
+      && (ffeexpr_stack_->next_dummy != NULL))
+    {				/* Too few arguments. */
+      if (ffebad_start (FFEBAD_TOO_FEW_ARGUMENTS))
+	{
+	  char num[10];
+
+	  sprintf (num, "%" ffebldListLength_f "u", ffeexpr_stack_->num_args);
+
+	  ffebad_here (0, ffelex_token_where_line (t),
+		       ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+		     ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+	  ffebad_string (num);
+	  ffebad_string (ffesymbol_text (ffesymbol_sfdummyparent (ffebld_symter
+			      (ffebld_head (ffeexpr_stack_->next_dummy)))));
+	  ffebad_finish ();
+	}
+      for (;
+	   ffeexpr_stack_->next_dummy != NULL;
+	   ffeexpr_stack_->next_dummy
+	   = ffebld_trail (ffeexpr_stack_->next_dummy))
+	{
+	  expr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (0));
+	  ffebld_set_info (expr, ffeinfo_new_any ());
+	  ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+	}
+    }
+
+  if ((ffeinfo_where (info) == FFEINFO_whereCONSTANT)
+      && (ffeexpr_stack_->tokens[1] != NULL))
+    {				/* Too many arguments to statement function. */
+      if (ffebad_start (FFEBAD_TOO_MANY_ARGUMENTS))
+	{
+	  char num[10];
+
+	  sprintf (num, "%" ffebldListLength_f "u", ffeexpr_stack_->num_args);
+
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[1]),
+		     ffelex_token_where_column (ffeexpr_stack_->tokens[1]));
+	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+		     ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+	  ffebad_string (num);
+	  ffebad_finish ();
+	}
+      ffelex_token_kill (ffeexpr_stack_->tokens[1]);
+    }
+  ffebld_end_list (&ffeexpr_stack_->bottom);
+
+  if (ffebld_op (procedure->u.operand) == FFEBLD_opANY)
+    {
+      reduced = ffebld_new_any ();
+      ffebld_set_info (reduced, ffeinfo_new_any ());
+    }
+  else
+    {
+      if (ffeexpr_stack_->context != FFEEXPR_contextSUBROUTINEREF)
+	reduced = ffebld_new_funcref (procedure->u.operand,
+				      ffeexpr_stack_->expr);
+      else
+	reduced = ffebld_new_subrref (procedure->u.operand,
+				      ffeexpr_stack_->expr);
+      if (ffebld_symter_generic (procedure->u.operand) != FFEINTRIN_genNONE)
+	ffeintrin_fulfill_generic (&reduced, &info, ffeexpr_stack_->tokens[0]);
+      else if (ffebld_symter_specific (procedure->u.operand)
+	       != FFEINTRIN_specNONE)
+	ffeintrin_fulfill_specific (&reduced, &info, &check_intrin,
+				    ffeexpr_stack_->tokens[0]);
+      else
+	ffeexpr_fulfill_call_ (&reduced, ffeexpr_stack_->tokens[0]);
+
+      if (ffebld_op (reduced) != FFEBLD_opANY)
+	ffebld_set_info (reduced,
+			 ffeinfo_new (ffeinfo_basictype (info),
+				      ffeinfo_kindtype (info),
+				      0,
+				      FFEINFO_kindENTITY,
+				      FFEINFO_whereFLEETING,
+				      ffeinfo_size (info)));
+      else
+	ffebld_set_info (reduced, ffeinfo_new_any ());
+    }
+  if (ffebld_op (reduced) == FFEBLD_opFUNCREF)
+    reduced = ffeexpr_collapse_funcref (reduced, ffeexpr_stack_->tokens[0]);
+  ffeexpr_stack_->exprstack = procedure->previous;	/* Pops
+							   not-quite-operand off
+							   stack. */
+  procedure->u.operand = reduced;	/* Save the line/column ffewhere
+					   info. */
+  ffeexpr_exprstack_push_operand_ (procedure);	/* Push it back on stack. */
+  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+    {
+      ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+      ffeexpr_is_substr_ok_ = FALSE;	/* Nobody likes "FUNC(3)(1:1)".... */
+
+      /* If the intrinsic needs checking (is REAL(Z) or AIMAG(Z), where
+	 Z is DOUBLE COMPLEX), and a command-line option doesn't already
+	 establish interpretation, probably complain.  */
+
+      if (check_intrin
+	  && !ffe_is_90 ()
+	  && !ffe_is_ugly_complex ())
+	{
+	  /* If the outer expression is REAL(me...), issue diagnostic
+	     only if next token isn't the close-paren for REAL(me).  */
+
+	  if ((ffeexpr_stack_->previous != NULL)
+	      && (ffeexpr_stack_->previous->exprstack != NULL)
+	      && (ffeexpr_stack_->previous->exprstack->type == FFEEXPR_exprtypeOPERAND_)
+	      && ((reduced = ffeexpr_stack_->previous->exprstack->u.operand) != NULL)
+	      && (ffebld_op (reduced) == FFEBLD_opSYMTER)
+	      && (ffebld_symter_implementation (reduced) == FFEINTRIN_impREAL))
+	    return (ffelexHandler) ffeexpr_token_intrincheck_;
+
+	  /* Diagnose the ambiguity now.  */
+
+	  if (ffebad_start (FFEBAD_INTRINSIC_CMPAMBIG))
+	    {
+	      ffebad_string (ffeintrin_name_implementation
+			     (ffebld_symter_implementation
+			      (ffebld_left
+			       (ffeexpr_stack_->exprstack->u.operand))));
+	      ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->exprstack->token),
+			   ffelex_token_where_column (ffeexpr_stack_->exprstack->token));
+	      ffebad_finish ();
+	    }
+	}
+      return (ffelexHandler) ffeexpr_token_substrp_;
+    }
+
+  if (ffest_ffebad_start (FFEBAD_INVALID_TOKEN_IN_EXPRESSION))
+    {
+      ffebad_here (0, ffelex_token_where_line (t),
+		   ffelex_token_where_column (t));
+      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+		   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+      ffebad_finish ();
+    }
+  ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+  ffeexpr_is_substr_ok_ = FALSE;/* Nobody likes "FUNC(3)(1:1)".... */
+  return
+    (ffelexHandler) ffeexpr_find_close_paren_ (t,
+					       (ffelexHandler)
+					       ffeexpr_token_substrp_);
+}
+
+/* ffeexpr_token_elements_ -- OPEN_PAREN [expr COMMA]...expr
+
+   Return a pointer to this array to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Handle expression and COMMA or CLOSE_PAREN.	*/
+
+static ffelexHandler
+ffeexpr_token_elements_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  ffeexprExpr_ array;
+  ffebld reduced;
+  ffeinfo info;
+  ffeinfoWhere where;
+  ffetargetIntegerDefault val;
+  ffetargetIntegerDefault lval = 0;
+  ffetargetIntegerDefault uval = 0;
+  ffebld lbound;
+  ffebld ubound;
+  bool lcheck;
+  bool ucheck;
+
+  array = ffeexpr_stack_->exprstack;
+  info = ffebld_info (array->u.operand);
+
+  if ((expr == NULL)		/* && ((ffeexpr_stack_->rank != 0) ||
+				   (ffelex_token_type(t) ==
+	 FFELEX_typeCOMMA)) */ )
+    {
+      if (ffebad_start (FFEBAD_NULL_ELEMENT))
+	{
+	  ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+		     ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+	  ffebad_here (1, ffelex_token_where_line (t),
+		       ffelex_token_where_column (t));
+	  ffebad_finish ();
+	}
+      if (ffeexpr_stack_->rank < ffeinfo_rank (info))
+	{			/* Don't bother if we're going to complain
+				   later! */
+	  expr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1));
+	  ffebld_set_info (expr, ffeinfo_new_any ());
+	}
+    }
+
+  if (expr == NULL)
+    ;
+  else if (ffeinfo_rank (info) == 0)
+    {				/* In EQUIVALENCE context, ffeinfo_rank(info)
+				   may == 0. */
+      ++ffeexpr_stack_->rank;	/* Track anyway, may need for new VXT
+				   feature. */
+      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+    }
+  else
+    {
+      ++ffeexpr_stack_->rank;
+      if (ffeexpr_stack_->rank > ffeinfo_rank (info))
+	{			/* Report later which was the first extra
+				   element. */
+	  if (ffeexpr_stack_->rank == ffeinfo_rank (info) + 1)
+	    ffeexpr_stack_->tokens[1] = ffelex_token_use (ft);
+	}
+      else
+	{
+	  switch (ffeinfo_where (ffebld_info (expr)))
+	    {
+	    case FFEINFO_whereCONSTANT:
+	      break;
+
+	    case FFEINFO_whereIMMEDIATE:
+	      ffeexpr_stack_->constant = FALSE;
+	      break;
+
+	    default:
+	      ffeexpr_stack_->constant = FALSE;
+	      ffeexpr_stack_->immediate = FALSE;
+	      break;
+	    }
+	  if (ffebld_op (expr) == FFEBLD_opCONTER
+	      && ffebld_kindtype (expr) == FFEINFO_kindtypeINTEGERDEFAULT)
+	    {
+	      val = ffebld_constant_integerdefault (ffebld_conter (expr));
+
+	      lbound = ffebld_left (ffebld_head (ffeexpr_stack_->bound_list));
+	      if (lbound == NULL)
+		{
+		  lcheck = TRUE;
+		  lval = 1;
+		}
+	      else if (ffebld_op (lbound) == FFEBLD_opCONTER)
+		{
+		  lcheck = TRUE;
+		  lval = ffebld_constant_integerdefault (ffebld_conter (lbound));
+		}
+	      else
+		lcheck = FALSE;
+
+	      ubound = ffebld_right (ffebld_head (ffeexpr_stack_->bound_list));
+	      assert (ubound != NULL);
+	      if (ffebld_op (ubound) == FFEBLD_opCONTER)
+		{
+		  ucheck = TRUE;
+		  uval = ffebld_constant_integerdefault (ffebld_conter (ubound));
+		}
+	      else
+		ucheck = FALSE;
+
+	      if ((lcheck && (val < lval)) || (ucheck && (val > uval)))
+		{
+		  ffebad_start (FFEBAD_RANGE_ARRAY);
+		  ffebad_here (0, ffelex_token_where_line (ft),
+			       ffelex_token_where_column (ft));
+		  ffebad_finish ();
+		}
+	    }
+	  ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+	  ffeexpr_stack_->bound_list = ffebld_trail (ffeexpr_stack_->bound_list);
+	}
+    }
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
+	{
+	case FFEEXPR_contextDATAIMPDOITEM_:
+	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					      FFEEXPR_contextDATAIMPDOINDEX_,
+					      ffeexpr_token_elements_);
+
+	case FFEEXPR_contextEQUIVALENCE:
+	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					      FFEEXPR_contextEQVINDEX_,
+					      ffeexpr_token_elements_);
+
+	case FFEEXPR_contextSFUNCDEF:
+	case FFEEXPR_contextSFUNCDEFINDEX_:
+	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					      FFEEXPR_contextSFUNCDEFINDEX_,
+					      ffeexpr_token_elements_);
+
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+	  assert ("bad context" == NULL);
+	  break;
+
+	default:
+	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					      FFEEXPR_contextINDEX_,
+					      ffeexpr_token_elements_);
+	}
+
+    default:
+      break;
+    }
+
+  if ((ffeexpr_stack_->rank != ffeinfo_rank (info))
+      && (ffeinfo_rank (info) != 0))
+    {
+      char num[10];
+
+      if (ffeexpr_stack_->rank < ffeinfo_rank (info))
+	{
+	  if (ffebad_start (FFEBAD_TOO_FEW_ELEMENTS))
+	    {
+	      sprintf (num, "%d",
+		       (int) (ffeinfo_rank (info) - ffeexpr_stack_->rank));
+
+	      ffebad_here (0, ffelex_token_where_line (t),
+			   ffelex_token_where_column (t));
+	      ffebad_here (1,
+			ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+		     ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+	      ffebad_string (num);
+	      ffebad_finish ();
+	    }
+	}
+      else
+	{
+	  if (ffebad_start (FFEBAD_TOO_MANY_ELEMENTS))
+	    {
+	      sprintf (num, "%d",
+		       (int) (ffeexpr_stack_->rank - ffeinfo_rank (info)));
+
+	      ffebad_here (0,
+			ffelex_token_where_line (ffeexpr_stack_->tokens[1]),
+		     ffelex_token_where_column (ffeexpr_stack_->tokens[1]));
+	      ffebad_here (1,
+			ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+		     ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+	      ffebad_string (num);
+	      ffebad_finish ();
+	    }
+	  ffelex_token_kill (ffeexpr_stack_->tokens[1]);
+	}
+      while (ffeexpr_stack_->rank++ < ffeinfo_rank (info))
+	{
+	  expr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1));
+	  ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeINTEGER,
+					      FFEINFO_kindtypeINTEGERDEFAULT,
+					      0, FFEINFO_kindENTITY,
+					      FFEINFO_whereCONSTANT,
+					      FFETARGET_charactersizeNONE));
+	  ffebld_append_item (&ffeexpr_stack_->bottom, expr);
+	}
+    }
+  ffebld_end_list (&ffeexpr_stack_->bottom);
+
+  if (ffebld_op (array->u.operand) == FFEBLD_opANY)
+    {
+      reduced = ffebld_new_any ();
+      ffebld_set_info (reduced, ffeinfo_new_any ());
+    }
+  else
+    {
+      reduced = ffebld_new_arrayref (array->u.operand, ffeexpr_stack_->expr);
+      if (ffeexpr_stack_->constant)
+	where = FFEINFO_whereFLEETING_CADDR;
+      else if (ffeexpr_stack_->immediate)
+	where = FFEINFO_whereFLEETING_IADDR;
+      else
+	where = FFEINFO_whereFLEETING;
+      ffebld_set_info (reduced,
+		       ffeinfo_new (ffeinfo_basictype (info),
+				    ffeinfo_kindtype (info),
+				    0,
+				    FFEINFO_kindENTITY,
+				    where,
+				    ffeinfo_size (info)));
+      reduced = ffeexpr_collapse_arrayref (reduced, ffeexpr_stack_->tokens[0]);
+    }
+
+  ffeexpr_stack_->exprstack = array->previous;	/* Pops not-quite-operand off
+						   stack. */
+  array->u.operand = reduced;	/* Save the line/column ffewhere info. */
+  ffeexpr_exprstack_push_operand_ (array);	/* Push it back on stack. */
+
+  switch (ffeinfo_basictype (info))
+    {
+    case FFEINFO_basictypeCHARACTER:
+      ffeexpr_is_substr_ok_ = TRUE;	/* Everyone likes "FOO(3)(1:1)".... */
+      break;
+
+    case FFEINFO_basictypeNONE:
+      ffeexpr_is_substr_ok_ = TRUE;
+      assert (ffeexpr_stack_->context == FFEEXPR_contextEQUIVALENCE);
+      break;
+
+    default:
+      ffeexpr_is_substr_ok_ = FALSE;
+      break;
+    }
+
+  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+    {
+      ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+      return (ffelexHandler) ffeexpr_token_substrp_;
+    }
+
+  if (ffest_ffebad_start (FFEBAD_INVALID_TOKEN_IN_EXPRESSION))
+    {
+      ffebad_here (0, ffelex_token_where_line (t),
+		   ffelex_token_where_column (t));
+      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+		   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+      ffebad_finish ();
+    }
+  ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+  return
+    (ffelexHandler) ffeexpr_find_close_paren_ (t,
+					       (ffelexHandler)
+					       ffeexpr_token_substrp_);
+}
+
+/* ffeexpr_token_equivalence_ -- OPEN_PAREN expr
+
+   Return a pointer to this array to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   If token is COLON, pass off to _substr_, else init list and pass off
+   to _elements_.  This handles the case "EQUIVALENCE (FOO(expr?", where
+   ? marks the token, and where FOO's rank/type has not yet been established,
+   meaning we could be in a list of indices or in a substring
+   specification.  */
+
+static ffelexHandler
+ffeexpr_token_equivalence_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  if (ffelex_token_type (t) == FFELEX_typeCOLON)
+    return ffeexpr_token_substring_ (ft, expr, t);
+
+  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+  return ffeexpr_token_elements_ (ft, expr, t);
+}
+
+/* ffeexpr_token_substring_ -- NAME(of kindENTITY) OPEN_PAREN expr
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Handle expression (which may be null) and COLON.  */
+
+static ffelexHandler
+ffeexpr_token_substring_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  ffeexprExpr_ string;
+  ffeinfo info;
+  ffetargetIntegerDefault i;
+  ffeexprContext ctx;
+  ffetargetCharacterSize size;
+
+  string = ffeexpr_stack_->exprstack;
+  info = ffebld_info (string->u.operand);
+  size = ffebld_size_max (string->u.operand);
+
+  if (ffelex_token_type (t) == FFELEX_typeCOLON)
+    {
+      if ((expr != NULL)
+	  && (ffebld_op (expr) == FFEBLD_opCONTER)
+	  && (((i = ffebld_constant_integerdefault (ffebld_conter (expr)))
+	       < 1)
+	      || ((size != FFETARGET_charactersizeNONE) && (i > size))))
+	{
+	  ffebad_start (FFEBAD_RANGE_SUBSTR);
+	  ffebad_here (0, ffelex_token_where_line (ft),
+		       ffelex_token_where_column (ft));
+	  ffebad_finish ();
+	}
+      ffeexpr_stack_->expr = expr;
+
+      switch (ffeexpr_stack_->context)
+	{
+	case FFEEXPR_contextSFUNCDEF:
+	case FFEEXPR_contextSFUNCDEFINDEX_:
+	  ctx = FFEEXPR_contextSFUNCDEFINDEX_;
+	  break;
+
+	case FFEEXPR_contextSFUNCDEFACTUALARG_:
+	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+	  assert ("bad context" == NULL);
+	  ctx = FFEEXPR_context;
+	  break;
+
+	default:
+	  ctx = FFEEXPR_contextINDEX_;
+	  break;
+	}
+
+      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool, ctx,
+					  ffeexpr_token_substring_1_);
+    }
+
+  if (ffest_ffebad_start (FFEBAD_MISSING_COLON_IN_SUBSTR))
+    {
+      ffebad_here (0, ffelex_token_where_line (t),
+		   ffelex_token_where_column (t));
+      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+		   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+      ffebad_finish ();
+    }
+
+  ffeexpr_stack_->expr = NULL;
+  return (ffelexHandler) ffeexpr_token_substring_1_ (ft, expr, t);
+}
+
+/* ffeexpr_token_substring_1_ -- NAME OPEN_PAREN [expr COMMA]...expr
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   Handle expression (which might be null) and CLOSE_PAREN.  */
+
+static ffelexHandler
+ffeexpr_token_substring_1_ (ffelexToken ft, ffebld last, ffelexToken t)
+{
+  ffeexprExpr_ string;
+  ffebld reduced;
+  ffebld substrlist;
+  ffebld first = ffeexpr_stack_->expr;
+  ffebld strop;
+  ffeinfo info;
+  ffeinfoWhere lwh;
+  ffeinfoWhere rwh;
+  ffeinfoWhere where;
+  ffeinfoKindtype first_kt;
+  ffeinfoKindtype last_kt;
+  ffetargetIntegerDefault first_val;
+  ffetargetIntegerDefault last_val;
+  ffetargetCharacterSize size;
+  ffetargetCharacterSize strop_size_max;
+  bool first_known;
+
+  string = ffeexpr_stack_->exprstack;
+  strop = string->u.operand;
+  info = ffebld_info (strop);
+
+  if (first == NULL
+      || (ffebld_op (first) == FFEBLD_opCONTER
+	  && ffebld_kindtype (first) == FFEINFO_kindtypeINTEGERDEFAULT))
+    {				/* The starting point is known. */
+      first_val = (first == NULL) ? 1
+	: ffebld_constant_integerdefault (ffebld_conter (first));
+      first_known = TRUE;
+    }
+  else
+    {				/* Assume start of the entity. */
+      first_val = 1;
+      first_known = FALSE;
+    }
+
+  if (last != NULL
+      && (ffebld_op (last) == FFEBLD_opCONTER
+	  && ffebld_kindtype (last) == FFEINFO_kindtypeINTEGERDEFAULT))
+    {				/* The ending point is known. */
+      last_val = ffebld_constant_integerdefault (ffebld_conter (last));
+
+      if (first_known)
+	{			/* The beginning point is a constant. */
+	  if (first_val <= last_val)
+	    size = last_val - first_val + 1;
+	  else
+	    {
+	      if (0 && ffe_is_90 ())
+		size = 0;
+	      else
+		{
+		  size = 1;
+		  ffebad_start (FFEBAD_ZERO_SIZE);
+		  ffebad_here (0, ffelex_token_where_line (ft),
+			       ffelex_token_where_column (ft));
+		  ffebad_finish ();
+		}
+	    }
+	}
+      else
+	size = FFETARGET_charactersizeNONE;
+
+      strop_size_max = ffebld_size_max (strop);
+
+      if ((strop_size_max != FFETARGET_charactersizeNONE)
+	  && (last_val > strop_size_max))
+	{			/* Beyond maximum possible end of string. */
+	  ffebad_start (FFEBAD_RANGE_SUBSTR);
+	  ffebad_here (0, ffelex_token_where_line (ft),
+		       ffelex_token_where_column (ft));
+	  ffebad_finish ();
+	}
+    }
+  else
+    size = FFETARGET_charactersizeNONE;	/* The size is not known. */
+
+#if 0				/* Don't do this, or "is size of target
+				   known?" would no longer be easily
+				   answerable.	To see if there is a max
+				   size, use ffebld_size_max; to get only the
+				   known size, else NONE, use
+				   ffebld_size_known; use ffebld_size if
+				   values are sure to be the same (not
+				   opSUBSTR or opCONCATENATE or known to have
+				   known length). By getting rid of this
+				   "useful info" stuff, we don't end up
+				   blank-padding the constant in the
+				   assignment "A(I:J)='XYZ'" to the known
+				   length of A. */
+  if (size == FFETARGET_charactersizeNONE)
+    size = strop_size_max;	/* Assume we use the entire string. */
+#endif
+
+  substrlist
+    = ffebld_new_item
+    (first,
+     ffebld_new_item
+     (last,
+      NULL
+     )
+    )
+    ;
+
+  if (first == NULL)
+    lwh = FFEINFO_whereCONSTANT;
+  else
+    lwh = ffeinfo_where (ffebld_info (first));
+  if (last == NULL)
+    rwh = FFEINFO_whereCONSTANT;
+  else
+    rwh = ffeinfo_where (ffebld_info (last));
+
+  switch (lwh)
+    {
+    case FFEINFO_whereCONSTANT:
+      switch (rwh)
+	{
+	case FFEINFO_whereCONSTANT:
+	  where = FFEINFO_whereCONSTANT;
+	  break;
+
+	case FFEINFO_whereIMMEDIATE:
+	  where = FFEINFO_whereIMMEDIATE;
+	  break;
+
+	default:
+	  where = FFEINFO_whereFLEETING;
+	  break;
+	}
+      break;
+
+    case FFEINFO_whereIMMEDIATE:
+      switch (rwh)
+	{
+	case FFEINFO_whereCONSTANT:
+	case FFEINFO_whereIMMEDIATE:
+	  where = FFEINFO_whereIMMEDIATE;
+	  break;
+
+	default:
+	  where = FFEINFO_whereFLEETING;
+	  break;
+	}
+      break;
+
+    default:
+      where = FFEINFO_whereFLEETING;
+      break;
+    }
+
+  if (first == NULL)
+    first_kt = FFEINFO_kindtypeINTEGERDEFAULT;
+  else
+    first_kt = ffeinfo_kindtype (ffebld_info (first));
+  if (last == NULL)
+    last_kt = FFEINFO_kindtypeINTEGERDEFAULT;
+  else
+    last_kt = ffeinfo_kindtype (ffebld_info (last));
+
+  switch (where)
+    {
+    case FFEINFO_whereCONSTANT:
+      switch (ffeinfo_where (info))
+	{
+	case FFEINFO_whereCONSTANT:
+	  break;
+
+	case FFEINFO_whereIMMEDIATE:	/* Not possible, actually. */
+	  where = FFEINFO_whereIMMEDIATE;
+	  break;
+
+	default:
+	  where = FFEINFO_whereFLEETING_CADDR;
+	  break;
+	}
+      break;
+
+    case FFEINFO_whereIMMEDIATE:
+      switch (ffeinfo_where (info))
+	{
+	case FFEINFO_whereCONSTANT:
+	case FFEINFO_whereIMMEDIATE:	/* Not possible, actually. */
+	  break;
+
+	default:
+	  where = FFEINFO_whereFLEETING_IADDR;
+	  break;
+	}
+      break;
+
+    default:
+      switch (ffeinfo_where (info))
+	{
+	case FFEINFO_whereCONSTANT:
+	  where = FFEINFO_whereCONSTANT_SUBOBJECT;	/* An F90 concept. */
+	  break;
+
+	case FFEINFO_whereIMMEDIATE:	/* Not possible, actually. */
+	default:
+	  where = FFEINFO_whereFLEETING;
+	  break;
+	}
+      break;
+    }
+
+  if (ffebld_op (strop) == FFEBLD_opANY)
+    {
+      reduced = ffebld_new_any ();
+      ffebld_set_info (reduced, ffeinfo_new_any ());
+    }
+  else
+    {
+      reduced = ffebld_new_substr (strop, substrlist);
+      ffebld_set_info (reduced, ffeinfo_new
+		       (FFEINFO_basictypeCHARACTER,
+			ffeinfo_kindtype (info),
+			0,
+			FFEINFO_kindENTITY,
+			where,
+			size));
+      reduced = ffeexpr_collapse_substr (reduced, ffeexpr_stack_->tokens[0]);
+    }
+
+  ffeexpr_stack_->exprstack = string->previous;	/* Pops not-quite-operand off
+						   stack. */
+  string->u.operand = reduced;	/* Save the line/column ffewhere info. */
+  ffeexpr_exprstack_push_operand_ (string);	/* Push it back on stack. */
+
+  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+    {
+      ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+      ffeexpr_is_substr_ok_ = FALSE;	/* Nobody likes "FOO(3:5)(1:1)".... */
+      return (ffelexHandler) ffeexpr_token_substrp_;
+    }
+
+  if (ffest_ffebad_start (FFEBAD_INVALID_TOKEN_IN_EXPRESSION))
+    {
+      ffebad_here (0, ffelex_token_where_line (t),
+		   ffelex_token_where_column (t));
+      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
+		   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
+      ffebad_finish ();
+    }
+
+  ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+  ffeexpr_is_substr_ok_ = FALSE;/* Nobody likes "FOO(3:5)(1:1)".... */
+  return
+    (ffelexHandler) ffeexpr_find_close_paren_ (t,
+					       (ffelexHandler)
+					       ffeexpr_token_substrp_);
+}
+
+/* ffeexpr_token_substrp_ -- Rhs <character entity>
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   If OPEN_PAREN, treat as start of a substring ("(3:4)") construct, and
+   issue error message if flag (serves as argument) is set.  Else, just
+   forward token to binary_.  */
+
+static ffelexHandler
+ffeexpr_token_substrp_ (ffelexToken t)
+{
+  ffeexprContext ctx;
+
+  if (ffelex_token_type (t) != FFELEX_typeOPEN_PAREN)
+    return (ffelexHandler) ffeexpr_token_binary_ (t);
+
+  ffeexpr_stack_->tokens[0] = ffelex_token_use (t);
+
+  switch (ffeexpr_stack_->context)
+    {
+    case FFEEXPR_contextSFUNCDEF:
+    case FFEEXPR_contextSFUNCDEFINDEX_:
+      ctx = FFEEXPR_contextSFUNCDEFINDEX_;
+      break;
+
+    case FFEEXPR_contextSFUNCDEFACTUALARG_:
+    case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
+      assert ("bad context" == NULL);
+      ctx = FFEEXPR_context;
+      break;
+
+    default:
+      ctx = FFEEXPR_contextINDEX_;
+      break;
+    }
+
+  if (!ffeexpr_is_substr_ok_)
+    {
+      if (ffebad_start (FFEBAD_BAD_SUBSTR))
+	{
+	  ffebad_here (0, ffelex_token_where_line (t),
+		       ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->exprstack->token),
+		       ffelex_token_where_column (ffeexpr_stack_->exprstack->token));
+	  ffebad_finish ();
+	}
+
+      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool, ctx,
+					  ffeexpr_token_anything_);
+    }
+
+  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool, ctx,
+				      ffeexpr_token_substring_);
+}
+
+static ffelexHandler
+ffeexpr_token_intrincheck_ (ffelexToken t)
+{
+  if ((ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
+      && ffebad_start (FFEBAD_INTRINSIC_CMPAMBIG))
+    {
+      ffebad_string (ffeintrin_name_implementation
+		     (ffebld_symter_implementation
+		      (ffebld_left
+		       (ffeexpr_stack_->exprstack->u.operand))));
+      ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->exprstack->token),
+		   ffelex_token_where_column (ffeexpr_stack_->exprstack->token));
+      ffebad_finish ();
+    }
+
+  return (ffelexHandler) ffeexpr_token_substrp_ (t);
+}
+
+/* ffeexpr_token_funsubstr_ -- NAME OPEN_PAREN expr
+
+   Return a pointer to this function to the lexer (ffelex), which will
+   invoke it for the next token.
+
+   If COLON, do everything we would have done since _parenthesized_ if
+   we had known NAME represented a kindENTITY instead of a kindFUNCTION.
+   If not COLON, do likewise for kindFUNCTION instead.	*/
+
+static ffelexHandler
+ffeexpr_token_funsubstr_ (ffelexToken ft, ffebld expr, ffelexToken t)
+{
+  ffeinfoWhere where;
+  ffesymbol s;
+  ffesymbolAttrs sa;
+  ffebld symter = ffeexpr_stack_->exprstack->u.operand;
+  bool needs_type;
+  ffeintrinGen gen;
+  ffeintrinSpec spec;
+  ffeintrinImp imp;
+
+  s = ffebld_symter (symter);
+  sa = ffesymbol_attrs (s);
+  where = ffesymbol_where (s);
+
+  /* We get here only if we don't already know enough about FOO when seeing a
+     FOO(stuff) reference, and FOO might turn out to be a CHARACTER type.  If
+     "stuff" is a substring reference, then FOO is a CHARACTER scalar type.
+     Else FOO is a function, either intrinsic or external.  If intrinsic, it
+     wouldn't necessarily be CHARACTER type, so unless it has already been
+     declared DUMMY, it hasn't had its type established yet.  It can't be
+     CHAR*(*) in any case, though it can have an explicit CHAR*n type.  */
+
+  assert (!(sa & ~(FFESYMBOL_attrsDUMMY
+		   | FFESYMBOL_attrsTYPE)));
+
+  needs_type = !(ffesymbol_attrs (s) & FFESYMBOL_attrsDUMMY);
+
+  ffesymbol_signal_change (s);	/* Probably already done, but in case.... */
+
+  if (ffelex_token_type (t) == FFELEX_typeCOLON)
+    {				/* Definitely an ENTITY (char substring). */
+      if (needs_type && !ffeimplic_establish_symbol (s))
+	{
+	  ffesymbol_error (s, ffeexpr_stack_->tokens[0]);
+	  return (ffelexHandler) ffeexpr_token_arguments_ (ft, expr, t);
+	}
+
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       ffesymbol_rank (s),
+				       FFEINFO_kindENTITY,
+				       (where == FFEINFO_whereNONE)
+				       ? FFEINFO_whereLOCAL
+				       : where,
+				       ffesymbol_size (s)));
+      ffebld_set_info (symter, ffeinfo_use (ffesymbol_info (s)));
+
+      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+      ffesymbol_resolve_intrin (s);
+      s = ffecom_sym_learned (s);
+      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+
+      ffeexpr_stack_->exprstack->u.operand
+	= ffeexpr_collapse_symter (symter, ffeexpr_tokens_[0]);
+
+      return (ffelexHandler) ffeexpr_token_substring_ (ft, expr, t);
+    }
+
+  /* The "stuff" isn't a substring notation, so we now know the overall
+     reference is to a function.  */
+
+  if (ffeintrin_is_intrinsic (ffesymbol_text (s), ffeexpr_stack_->tokens[0],
+			      FALSE, &gen, &spec, &imp))
+    {
+      ffebld_symter_set_generic (symter, gen);
+      ffebld_symter_set_specific (symter, spec);
+      ffebld_symter_set_implementation (symter, imp);
+      ffesymbol_set_generic (s, gen);
+      ffesymbol_set_specific (s, spec);
+      ffesymbol_set_implementation (s, imp);
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       0,
+				       FFEINFO_kindFUNCTION,
+				       FFEINFO_whereINTRINSIC,
+				       ffesymbol_size (s)));
+    }
+  else
+    {				/* Not intrinsic, now needs CHAR type. */
+      if (!ffeimplic_establish_symbol (s))
+	{
+	  ffesymbol_error (s, ffeexpr_stack_->tokens[0]);
+	  return (ffelexHandler) ffeexpr_token_arguments_ (ft, expr, t);
+	}
+
+      ffesymbol_set_info (s,
+			  ffeinfo_new (ffesymbol_basictype (s),
+				       ffesymbol_kindtype (s),
+				       ffesymbol_rank (s),
+				       FFEINFO_kindFUNCTION,
+				       (where == FFEINFO_whereNONE)
+				       ? FFEINFO_whereGLOBAL
+				       : where,
+				       ffesymbol_size (s)));
+    }
+
+  ffebld_set_info (symter, ffeinfo_use (ffesymbol_info (s)));
+
+  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
+  ffesymbol_resolve_intrin (s);
+  s = ffecom_sym_learned (s);
+  ffesymbol_reference (s, ffeexpr_stack_->tokens[0], FALSE);
+  ffesymbol_signal_unreported (s);	/* For debugging purposes. */
+  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
+  return (ffelexHandler) ffeexpr_token_arguments_ (ft, expr, t);
+}
+
+/* ffeexpr_token_anything_ -- NAME OPEN_PAREN any-expr
+
+   Handle basically any expression, looking for CLOSE_PAREN.  */
+
+static ffelexHandler
+ffeexpr_token_anything_ (ffelexToken ft UNUSED, ffebld expr UNUSED,
+			 ffelexToken t)
+{
+  ffeexprExpr_ e = ffeexpr_stack_->exprstack;
+
+  switch (ffelex_token_type (t))
+    {
+    case FFELEX_typeCOMMA:
+    case FFELEX_typeCOLON:
+      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
+					  FFEEXPR_contextACTUALARG_,
+					  ffeexpr_token_anything_);
+
+    default:
+      e->u.operand = ffebld_new_any ();
+      ffebld_set_info (e->u.operand, ffeinfo_new_any ());
+      ffelex_token_kill (ffeexpr_stack_->tokens[0]);
+      ffeexpr_is_substr_ok_ = FALSE;
+      if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
+	return (ffelexHandler) ffeexpr_token_substrp_;
+      return (ffelexHandler) ffeexpr_token_substrp_ (t);
+    }
+}
+
+/* Terminate module.  */
+
+void
+ffeexpr_terminate_2 (void)
+{
+  assert (ffeexpr_stack_ == NULL);
+  assert (ffeexpr_level_ == 0);
+}
diff --git a/gcc/f/expr.h b/gcc/f/expr.h
new file mode 100644
index 00000000000..b82173bbf0e
--- /dev/null
+++ b/gcc/f/expr.h
@@ -0,0 +1,194 @@
+/* expr.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      expr.c
+
+   Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef GCC_F_EXPR_H
+#define GCC_F_EXPR_H
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+  {
+    FFEEXPR_contextLET,
+    FFEEXPR_contextASSIGN,
+    FFEEXPR_contextIOLIST,
+    FFEEXPR_contextPARAMETER,
+    FFEEXPR_contextSUBROUTINEREF,
+    FFEEXPR_contextDATA,
+    FFEEXPR_contextIF,
+    FFEEXPR_contextARITHIF,
+    FFEEXPR_contextDO,
+    FFEEXPR_contextDOWHILE,
+    FFEEXPR_contextFORMAT,
+    FFEEXPR_contextAGOTO,
+    FFEEXPR_contextCGOTO,
+    FFEEXPR_contextCHARACTERSIZE,
+    FFEEXPR_contextEQUIVALENCE,
+    FFEEXPR_contextSTOP,
+    FFEEXPR_contextRETURN,
+    FFEEXPR_contextSFUNCDEF,
+    FFEEXPR_contextINCLUDE,
+    FFEEXPR_contextWHERE,
+    FFEEXPR_contextSELECTCASE,
+    FFEEXPR_contextCASE,
+    FFEEXPR_contextDIMLIST,
+    FFEEXPR_contextDIMLISTCOMMON,	/* Dim list in COMMON stmt. */
+    FFEEXPR_contextFILEASSOC,	/* ASSOCIATEVARIABLE=. */
+    FFEEXPR_contextFILEINT,	/* IOSTAT=. */
+    FFEEXPR_contextFILEDFINT,	/* NEXTREC=. */
+    FFEEXPR_contextFILELOG,	/* NAMED=. */
+    FFEEXPR_contextFILENUM,	/* Numerical expression. */
+    FFEEXPR_contextFILECHAR,	/* Character expression. */
+    FFEEXPR_contextFILENUMCHAR,	/* READ KEYxyz=. */
+    FFEEXPR_contextFILEDFCHAR,	/* Default kind character expression. */
+    FFEEXPR_contextFILEKEY,	/* OPEN KEY=. */
+    FFEEXPR_contextFILEEXTFUNC,	/* USEROPEN=. */
+    FFEEXPR_contextFILEUNIT,	/* READ/WRITE UNIT=. */
+    FFEEXPR_contextFILEUNIT_DF,	/* DEFINE FILE unit (no "(" after it). */
+    FFEEXPR_contextFILEFORMATNML,	/* [FMT=] or [NML=]. */
+    FFEEXPR_contextFILEFORMAT,	/* FMT=. */
+    FFEEXPR_contextFILENAMELIST,/* NML=. */
+    FFEEXPR_contextFILENUMAMBIG,/* BACKSPACE, ENDFILE, REWIND, UNLOCK...
+				   where at e.g. BACKSPACE(, if COMMA seen
+				   before ), it is ok. */
+    FFEEXPR_contextFILEUNITAMBIG,	/* READ(, if COMMA seen before ), ok. */
+    FFEEXPR_contextFILEVXTCODE,	/* ENCODE/DECODE third arg (scalar/array). */
+    FFEEXPR_contextALLOCATE,	/* ALLOCATE objects (weird). */
+    FFEEXPR_contextDEALLOCATE,	/* DEALLOCATE objects (weird). */
+    FFEEXPR_contextHEAPSTAT,	/* ALLOCATE/DEALLOCATE STAT= variable. */
+    FFEEXPR_contextKINDTYPE,	/* KIND=. */
+    FFEEXPR_contextINITVAL,	/* R426 =initialization-expr. */
+    FFEEXPR_contextNULLIFY,	/* Pointer names only (F90) or pointers. */
+    FFEEXPR_contextIOLISTDF,	/* IOLIST w/internal file (V112 9-14 30,31). */
+    FFEEXPR_contextINDEX_,	/* Element dimension or substring value. */
+    FFEEXPR_contextEQVINDEX_,	/* EQUIVALENCE element dimension. */
+    FFEEXPR_contextDATAIMPDOINDEX_,	/* INDEX in DATAIMPDO context. */
+    FFEEXPR_contextIMPDOITEM_,
+    FFEEXPR_contextIMPDOITEMDF_,/* to ...ITEM_ as IOLISTDF is to IOLIST. */
+    FFEEXPR_contextIMPDOCTRL_,
+    FFEEXPR_contextDATAIMPDOITEM_,
+    FFEEXPR_contextDATAIMPDOCTRL_,
+    FFEEXPR_contextLOC_,
+    FFEEXPR_contextACTUALARG_,	/* Actual arg to function or subroutine;
+				   turns into ACTUALARGEXPR_ if tokens not
+				   NAME (CLOSE_PAREN/COMMA) or PERCENT.... */
+    FFEEXPR_contextACTUALARGEXPR_,	/* Like LET but disallow CHAR*(*)
+					   concats. */
+    FFEEXPR_contextINDEXORACTUALARG_,	/* "CHARACTER FOO; PRINT *,FOO(?". */
+    FFEEXPR_contextINDEXORACTUALARGEXPR_,	/* ? not NAME
+						   (CLOSE_PAREN/COMMA). */
+    FFEEXPR_contextSFUNCDEFINDEX_,	/* INDEX_ within stmt-func def. */
+    FFEEXPR_contextSFUNCDEFACTUALARG_,
+    FFEEXPR_contextSFUNCDEFACTUALARGEXPR_,
+    FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_,
+    FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_,
+    FFEEXPR_contextPAREN_,	/* Rhs paren except in LET context. */
+    FFEEXPR_contextPARENFILENUM_,	/* Either PAREN or FILENUM context. */
+    FFEEXPR_contextPARENFILEUNIT_,	/* Either PAREN or FILEUNIT context. */
+    FFEEXPR_context
+  } ffeexprContext;
+
+/* Typedefs. */
+
+
+/* Include files needed by this one. */
+
+#include "bld.h"
+#include "lex.h"
+#include "malloc.h"
+
+/* Structure definitions. */
+
+typedef ffelexHandler (*ffeexprCallback) (ffelexToken ft, ffebld expr,
+					  ffelexToken t);
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+ffebld ffeexpr_collapse_convert (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_paren (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_uplus (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_uminus (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_not (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_add (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_subtract (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_multiply (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_divide (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_power (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_concatenate (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_lt (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_le (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_eq (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_ne (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_gt (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_ge (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_and (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_or (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_xor (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_eqv (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_neqv (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_symter (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_funcref (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_arrayref (ffebld expr, ffelexToken t);
+ffebld ffeexpr_collapse_substr (ffebld expr, ffelexToken t);
+ffebld ffeexpr_convert (ffebld source, ffelexToken source_token,
+	    ffelexToken dest_token, ffeinfoBasictype bt, ffeinfoKindtype kt,
+			ffeinfoRank rk, ffetargetCharacterSize sz,
+			ffeexprContext context);
+ffebld ffeexpr_convert_expr (ffebld source, ffelexToken source_token,
+			     ffebld dest, ffelexToken dest_token,
+			     ffeexprContext context);
+ffebld ffeexpr_convert_to_sym (ffebld source, ffelexToken source_token,
+			       ffesymbol dest, ffelexToken dest_token);
+void ffeexpr_init_2 (void);
+ffelexHandler ffeexpr_rhs (mallocPool pool, ffeexprContext context,
+			   ffeexprCallback callback);
+ffelexHandler ffeexpr_lhs (mallocPool pool, ffeexprContext context,
+			   ffeexprCallback callback);
+void ffeexpr_terminate_2 (void);
+void ffeexpr_type_combine (ffeinfoBasictype *nbt, ffeinfoKindtype *nkt,
+			   ffeinfoBasictype lbt, ffeinfoKindtype lkt,
+			   ffeinfoBasictype rbt, ffeinfoKindtype rkt,
+			   ffelexToken t);
+
+/* Define macros. */
+
+#define ffeexpr_init_0()
+#define ffeexpr_init_1()
+#define ffeexpr_init_3()
+#define ffeexpr_init_4()
+#define ffeexpr_terminate_0()
+#define ffeexpr_terminate_1()
+#define ffeexpr_terminate_3()
+#define ffeexpr_terminate_4()
+
+/* End of #include file. */
+
+#endif /* ! GCC_F_EXPR_H */
diff --git a/gcc/f/ffe.texi b/gcc/f/ffe.texi
new file mode 100644
index 00000000000..fd5d3bf349a
--- /dev/null
+++ b/gcc/f/ffe.texi
@@ -0,0 +1,2063 @@
+@c Copyright (C) 1999, 2003 Free Software Foundation, Inc.
+@c This is part of the G77 manual.
+@c For copying conditions, see the file g77.texi.
+
+@node Front End
+@chapter Front End
+@cindex GNU Fortran Front End (FFE)
+@cindex FFE
+@cindex @code{g77}, front end
+@cindex front end, @code{g77}
+
+This chapter describes some aspects of the design and implementation
+of the @code{g77} front end.
+
+To find about things that are ``To Be Determined'' or ``To Be Done'',
+search for the string TBD.
+If you want to help by working on one or more of these items,
+email @email{gcc@@gcc.gnu.org}.
+If you're planning to do more than just research issues and offer comments,
+see @uref{http://gcc.gnu.org/contribute.html} for steps you might
+need to take first.
+
+@menu
+* Overview of Sources::
+* Overview of Translation Process::
+* Philosophy of Code Generation::
+* Two-pass Design::
+* Challenges Posed::
+* Transforming Statements::
+* Transforming Expressions::
+* Internal Naming Conventions::
+@end menu
+
+@node Overview of Sources
+@section Overview of Sources
+
+The current directory layout includes the following:
+
+@table @file
+@item @var{srcdir}/gcc/
+Non-g77 files in gcc
+
+@item @var{srcdir}/gcc/f/
+GNU Fortran front end sources
+
+@item @var{srcdir}/libf2c/
+@code{libg2c} configuration and @code{g2c.h} file generation
+
+@item @var{srcdir}/libf2c/libF77/
+General support and math portion of @code{libg2c}
+
+@item @var{srcdir}/libf2c/libI77/
+I/O portion of @code{libg2c}
+
+@item @var{srcdir}/libf2c/libU77/
+Additional interfaces to Unix @code{libc} for @code{libg2c}
+@end table
+
+Components of note in @code{g77} are described below.
+
+@file{f/} as a whole contains the source for @code{g77},
+while @file{libf2c/} contains a portion of the separate program
+@code{f2c}.
+Note that the @code{libf2c} code is not part of the program @code{g77},
+just distributed with it.
+
+@file{f/} contains text files that document the Fortran compiler, source
+files for the GNU Fortran Front End (FFE), and some other stuff.
+The @code{g77} compiler code is placed in @file{f/} because it,
+along with its contents,
+is designed to be a subdirectory of a @code{gcc} source directory,
+@file{gcc/},
+which is structured so that language-specific front ends can be ``dropped
+in'' as subdirectories.
+The C++ front end (@code{g++}), is an example of this---it resides in
+the @file{cp/} subdirectory.
+Note that the C front end (also referred to as @code{gcc})
+is an exception to this, as its source files reside
+in the @file{gcc/} directory itself.
+
+@file{libf2c/} contains the run-time libraries for the @code{f2c} program,
+also used by @code{g77}.
+These libraries normally referred to collectively as @code{libf2c}.
+When built as part of @code{g77},
+@code{libf2c} is installed under the name @code{libg2c} to avoid
+conflict with any existing version of @code{libf2c},
+and thus is often referred to as @code{libg2c} when the
+@code{g77} version is specifically being referred to.
+
+The @code{netlib} version of @code{libf2c/}
+contains two distinct libraries,
+@code{libF77} and @code{libI77},
+each in their own subdirectories.
+In @code{g77}, this distinction is not made,
+beyond maintaining the subdirectory structure in the source-code tree.
+
+@file{libf2c/} is not part of the program @code{g77},
+just distributed with it.
+It contains files not present
+in the official (@code{netlib}) version of @code{libf2c},
+and also contains some minor changes made from @code{libf2c},
+to fix some bugs,
+and to facilitate automatic configuration, building, and installation of
+@code{libf2c} (as @code{libg2c}) for use by @code{g77} users.
+See @file{libf2c/README} for more information,
+including licensing conditions
+governing distribution of programs containing code from @code{libg2c}.
+
+@code{libg2c}, @code{g77}'s version of @code{libf2c},
+adds Dave Love's implementation of @code{libU77},
+in the @file{libf2c/libU77/} directory.
+This library is distributed under the
+GNU Library General Public License (LGPL)---see the
+file @file{libf2c/libU77/COPYING.LIB}
+for more information,
+as this license
+governs distribution conditions for programs containing code
+from this portion of the library.
+
+Files of note in @file{f/} and @file{libf2c/} are described below:
+
+@table @file
+@item f/BUGS
+Lists some important bugs known to be in g77.
+Or use Info (or GNU Emacs Info mode) to read
+the ``Actual Bugs'' node of the @code{g77} documentation:
+
+@smallexample
+info -f f/g77.info -n "Actual Bugs"
+@end smallexample
+
+@item f/ChangeLog
+Lists recent changes to @code{g77} internals.
+
+@item libf2c/ChangeLog
+Lists recent changes to @code{libg2c} internals.
+
+@item f/NEWS
+Contains the per-release changes.
+These include the user-visible
+changes described in the node ``Changes''
+in the @code{g77} documentation, plus internal
+changes of import.
+Or use:
+
+@smallexample
+info -f f/g77.info -n News
+@end smallexample
+
+@item f/g77.info*
+The @code{g77} documentation, in Info format,
+produced by building @code{g77}.
+
+All users of @code{g77} (not just installers) should read this,
+using the @code{more} command if neither the @code{info} command,
+nor GNU Emacs (with its Info mode), are available, or if users
+aren't yet accustomed to using these tools.
+All of these files are readable as ``plain text'' files,
+though they're easier to navigate using Info readers
+such as @code{info} and GNU Emacs Info mode.
+@end table
+
+If you want to explore the FFE code, which lives entirely in @file{f/},
+here are a few clues.
+The file @file{g77spec.c} contains the @code{g77}-specific source code
+for the @code{g77} command only---this just forms a variant of the
+@code{gcc} command, so,
+just as the @code{gcc} command itself does not contain the C front end,
+the @code{g77} command does not contain the Fortran front end (FFE).
+The FFE code ends up in an executable named @file{f771},
+which does the actual compiling,
+so it contains the FFE plus the @code{gcc} back end (GBE),
+the latter to do most of the optimization, and the code generation.
+
+The file @file{parse.c} is the source file for @code{yyparse()},
+which is invoked by the GBE to start the compilation process,
+for @file{f771}.
+
+The file @file{top.c} contains the top-level FFE function @code{ffe_file}
+and it (along with top.h) define all @samp{ffe_[a-z].*}, @samp{ffe[A-Z].*},
+and @samp{FFE_[A-Za-z].*} symbols.
+
+The file @file{fini.c} is a @code{main()} program that is used when building
+the FFE to generate C header and source files for recognizing keywords.
+The files @file{malloc.c} and @file{malloc.h} comprise a memory manager
+that defines all @samp{malloc_[a-z].*}, @samp{malloc[A-Z].*}, and
+@samp{MALLOC_[A-Za-z].*} symbols.
+
+All other modules named @var{xyz}
+are comprised of all files named @samp{@var{xyz}*.@var{ext}}
+and define all @samp{ffe@var{xyz}_[a-z].*}, @samp{ffe@var{xyz}[A-Z].*},
+and @samp{FFE@var{XYZ}_[A-Za-z].*} symbols.
+If you understand all this, congratulations---it's easier for me to remember
+how it works than to type in these regular expressions.
+But it does make it easy to find where a symbol is defined.
+For example, the symbol @samp{ffexyz_set_something} would be defined
+in @file{xyz.h} and implemented there (if it's a macro) or in @file{xyz.c}.
+
+The ``porting'' files of note currently are:
+
+@table @file
+@item proj.h
+This defines the ``language'' used by all the other source files,
+the language being Standard C plus some useful things
+like @code{ARRAY_SIZE} and such.
+
+@item target.c
+@itemx target.h
+These describe the target machine
+in terms of what data types are supported,
+how they are denoted
+(to what C type does an @code{INTEGER*8} map, for example),
+how to convert between them,
+and so on.
+Over time, versions of @code{g77} rely less on this file
+and more on run-time configuration based on GBE info
+in @file{com.c}.
+
+@item com.c
+@itemx com.h
+These are the primary interface to the GBE.
+
+@item ste.c
+@itemx ste.h
+This contains code for implementing recognized executable statements
+in the GBE.
+
+@item src.c
+@itemx src.h
+These contain information on the format(s) of source files
+(such as whether they are never to be processed as case-insensitive
+with regard to Fortran keywords).
+@end table
+
+If you want to debug the @file{f771} executable,
+for example if it crashes,
+note that the global variables @code{lineno} and @code{input_filename}
+are usually set to reflect the current line being read by the lexer
+during the first-pass analysis of a program unit and to reflect
+the current line being processed during the second-pass compilation
+of a program unit.
+
+If an invocation of the function @code{ffestd_exec_end} is on the stack,
+the compiler is in the second pass, otherwise it is in the first.
+
+(This information might help you reduce a test case and/or work around
+a bug in @code{g77} until a fix is available.)
+
+@node Overview of Translation Process
+@section Overview of Translation Process
+
+The order of phases translating source code to the form accepted
+by the GBE is:
+
+@enumerate
+@item
+Stripping punched-card sources (@file{g77stripcard.c})
+
+@item
+Lexing (@file{lex.c})
+
+@item
+Stand-alone statement identification (@file{sta.c})
+
+@item
+INCLUDE handling (@file{sti.c})
+
+@item
+Order-dependent statement identification (@file{stq.c})
+
+@item
+Parsing (@file{stb.c} and @file{expr.c})
+
+@item
+Constructing (@file{stc.c})
+
+@item
+Collecting (@file{std.c})
+
+@item
+Expanding (@file{ste.c})
+@end enumerate
+
+To get a rough idea of how a particularly twisted Fortran statement
+gets treated by the passes, consider:
+
+@smallexample
+      FORMAT(I2 4H)=(J/
+     &   I3)
+@end smallexample
+
+The job of @file{lex.c} is to know enough about Fortran syntax rules
+to break the statement up into distinct lexemes without requiring
+any feedback from subsequent phases:
+
+@smallexample
+`FORMAT'
+`('
+`I24H'
+`)'
+`='
+`('
+`J'
+`/'
+`I3'
+`)'
+@end smallexample
+
+The job of @file{sta.c} is to figure out the kind of statement,
+or, at least, statement form, that sequence of lexemes represent.
+
+The sooner it can do this (in terms of using the smallest number of
+lexemes, starting with the first for each statement), the better,
+because that leaves diagnostics for problems beyond the recognition
+of the statement form to subsequent phases,
+which can usually better describe the nature of the problem.
+
+In this case, the @samp{=} at ``level zero''
+(not nested within parentheses)
+tells @file{sta.c} that this is an @emph{assignment-form},
+not @code{FORMAT}, statement.
+
+An assignment-form statement might be a statement-function
+definition or an executable assignment statement.
+
+To make that determination,
+@file{sta.c} looks at the first two lexemes.
+
+Since the second lexeme is @samp{(},
+the first must represent an array for this to be an assignment statement,
+else it's a statement function.
+
+Either way, @file{sta.c} hands off the statement to @file{stq.c}
+(via @file{sti.c}, which expands INCLUDE files).
+@file{stq.c} figures out what a statement that is,
+on its own, ambiguous, must actually be based on the context
+established by previous statements.
+
+So, @file{stq.c} watches the statement stream for executable statements,
+END statements, and so on, so it knows whether @samp{A(B)=C} is
+(intended as) a statement-function definition or an assignment statement.
+
+After establishing the context-aware statement info, @file{stq.c}
+passes the original sample statement on to @file{stb.c}
+(either its statement-function parser or its assignment-statement parser).
+
+@file{stb.c} forms a
+statement-specific record containing the pertinent information.
+That information includes a source expression and,
+for an assignment statement, a destination expression.
+Expressions are parsed by @file{expr.c}.
+
+This record is passed to @file{stc.c},
+which copes with the implications of the statement
+within the context established by previous statements.
+
+For example, if it's the first statement in the file
+or after an @code{END} statement,
+@file{stc.c} recognizes that, first of all,
+a main program unit is now being lexed
+(and tells that to @file{std.c}
+before telling it about the current statement).
+
+@file{stc.c} attaches whatever information it can,
+usually derived from the context established by the preceding statements,
+and passes the information to @file{std.c}.
+
+@file{std.c} saves this information away,
+since the GBE cannot cope with information
+that might be incomplete at this stage.
+
+For example, @samp{I3} might later be determined
+to be an argument to an alternate @code{ENTRY} point.
+
+When @file{std.c} is told about the end of an external (top-level)
+program unit,
+it passes all the information it has saved away
+on statements in that program unit
+to @file{ste.c}.
+
+@file{ste.c} ``expands'' each statement, in sequence, by
+constructing the appropriate GBE information and calling
+the appropriate GBE routines.
+
+Details on the transformational phases follow.
+Keep in mind that Fortran numbering is used,
+so the first character on a line is column 1,
+decimal numbering is used, and so on.
+
+@menu
+* g77stripcard::
+* lex.c::
+* sta.c::
+* sti.c::
+* stq.c::
+* stb.c::
+* expr.c::
+* stc.c::
+* std.c::
+* ste.c::
+
+* Gotchas (Transforming)::
+* TBD (Transforming)::
+@end menu
+
+@node g77stripcard
+@subsection g77stripcard
+
+The @code{g77stripcard} program handles removing content beyond
+column 72 (adjustable via a command-line option),
+optionally warning about that content being something other
+than trailing whitespace or Fortran commentary.
+
+This program is needed because @code{lex.c} doesn't pay attention
+to maximum line lengths at all, to make it easier to maintain,
+as well as faster (for sources that don't depend on the maximum
+column length vis-a-vis trailing non-blank non-commentary content).
+
+Just how this program will be run---whether automatically for
+old source (perhaps as the default for @file{.f} files?)---is not
+yet determined.
+
+In the meantime, it might as well be implemented as a typical UNIX pipe.
+
+It should accept a @samp{-fline-length-@var{n}} option,
+with the default line length set to 72.
+
+When the text it strips off the end of a line is not blank
+(not spaces and tabs),
+it should insert an additional comment line
+(beginning with @samp{!},
+so it works for both fixed-form and free-form files)
+containing the text,
+following the stripped line.
+The inserted comment should have a prefix of some kind,
+TBD, that distinguishes the comment as representing stripped text.
+Users could use that to @code{sed} out such lines, if they wished---it
+seems silly to provide a command-line option to delete information
+when it can be so easily filtered out by another program.
+
+(This inserted comment should be designed to ``fit in'' well
+with whatever the Fortran community is using these days for
+preprocessor, translator, and other such products, like OpenMP.
+What that's all about, and how @code{g77} can elegantly fit its
+special comment conventions into it all, is TBD as well.
+We don't want to reinvent the wheel here, but if there turn out
+to be too many conflicting conventions, we might have to invent
+one that looks nothing like the others, but which offers their
+host products a better infrastructure in which to fit and coexist
+peacefully.)
+
+@code{g77stripcard} probably shouldn't do any tab expansion or other
+fancy stuff.
+People can use @code{expand} or other pre-filtering if they like.
+The idea here is to keep each stage quite simple, while providing
+excellent performance for ``normal'' code.
+
+(Code with junk beyond column 73 is not really ``normal'',
+as it comes from a card-punch heritage,
+and will be increasingly hard for tomorrow's Fortran programmers to read.)
+
+@node lex.c
+@subsection lex.c
+
+To help make the lexer simple, fast, and easy to maintain,
+while also having @code{g77} generally encourage Fortran programmers
+to write simple, maintainable, portable code by maximizing the
+performance of compiling that kind of code:
+
+@itemize @bullet
+@item
+There'll be just one lexer, for both fixed-form and free-form source.
+
+@item
+It'll care about the form only when handling the first 7 columns of
+text, stuff like spaces between strings of alphanumerics, and
+how lines are continued.
+
+Some other distinctions will be handled by subsequent phases,
+so at least one of them will have to know which form is involved.
+
+For example, @samp{I = 2 . 4} is acceptable in fixed form,
+and works in free form as well given the implementation @code{g77}
+presently uses.
+But the standard requires a diagnostic for it in free form,
+so the parser has to be able to recognize that
+the lexemes aren't contiguous
+(information the lexer @emph{does} have to provide)
+and that free-form source is being parsed,
+so it can provide the diagnostic.
+
+The @code{g77} lexer doesn't try to gather @samp{2 . 4} into a single lexeme.
+Otherwise, it'd have to know a whole lot more about how to parse Fortran,
+or subsequent phases (mainly parsing) would have two paths through
+lots of critical code---one to handle the lexeme @samp{2}, @samp{.},
+and @samp{4} in sequence, another to handle the lexeme @samp{2.4}.
+
+@item
+It won't worry about line lengths
+(beyond the first 7 columns for fixed-form source).
+
+That is, once it starts parsing the ``statement'' part of a line
+(column 7 for fixed-form, column 1 for free-form),
+it'll keep going until it finds a newline,
+rather than ignoring everything past a particular column
+(72 or 132).
+
+The implication here is that there shouldn't @emph{be}
+anything past that last column, other than whitespace or
+commentary, because users using typical editors
+(or viewing output as typically printed)
+won't necessarily know just where the last column is.
+
+Code that has ``garbage'' beyond the last column
+(almost certainly only fixed-form code with a punched-card legacy,
+such as code using columns 73-80 for ``sequence numbers'')
+will have to be run through @code{g77stripcard} first.
+
+Also, keeping track of the maximum column position while also watching out
+for the end of a line @emph{and} while reading from a file
+just makes things slower.
+Since a file must be read, and watching for the end of the line
+is necessary (unless the typical input file was preprocessed to
+include the necessary number of trailing spaces),
+dropping the tracking of the maximum column position
+is the only way to reduce the complexity of the pertinent code
+while maintaining high performance.
+
+@item
+ASCII encoding is assumed for the input file.
+
+Code written in other character sets will have to be converted first.
+
+@item
+Tabs (ASCII code 9)
+will be converted to spaces via the straightforward
+approach.
+
+Specifically, a tab is converted to between one and eight spaces
+as necessary to reach column @var{n},
+where dividing @samp{(@var{n} - 1)} by eight
+results in a remainder of zero.
+
+That saves having to pass most source files through @code{expand}.
+
+@item
+Linefeeds (ASCII code 10)
+mark the ends of lines.
+
+@item
+A carriage return (ASCII code 13)
+is accept if it immediately precedes a linefeed,
+in which case it is ignored.
+
+Otherwise, it is rejected (with a diagnostic).
+
+@item
+Any other characters other than the above
+that are not part of the GNU Fortran Character Set
+(@pxref{Character Set})
+are rejected with a diagnostic.
+
+This includes backspaces, form feeds, and the like.
+
+(It might make sense to allow a form feed in column 1
+as long as that's the only character on a line.
+It certainly wouldn't seem to cost much in terms of performance.)
+
+@item
+The end of the input stream (EOF)
+ends the current line.
+
+@item
+The distinction between uppercase and lowercase letters
+will be preserved.
+
+It will be up to subsequent phases to decide to fold case.
+
+Current plans are to permit any casing for Fortran (reserved) keywords
+while preserving casing for user-defined names.
+(This might not be made the default for @file{.f} files, though.)
+
+Preserving case seems necessary to provide more direct access
+to facilities outside of @code{g77}, such as to C or Pascal code.
+
+Names of intrinsics will probably be matchable in any case,
+
+(How @samp{external SiN; r = sin(x)} would be handled is TBD.
+I think old @code{g77} might already handle that pretty elegantly,
+but whether we can cope with allowing the same fragment to reference
+a @emph{different} procedure, even with the same interface,
+via @samp{s = SiN(r)}, needs to be determined.
+If it can't, we need to make sure that when code introduces
+a user-defined name, any intrinsic matching that name
+using a case-insensitive comparison
+is ``turned off''.)
+
+@item
+Backslashes in @code{CHARACTER} and Hollerith constants
+are not allowed.
+
+This avoids the confusion introduced by some Fortran compiler vendors
+providing C-like interpretation of backslashes,
+while others provide straight-through interpretation.
+
+Some kind of lexical construct (TBD) will be provided to allow
+flagging of a @code{CHARACTER}
+(but probably not a Hollerith)
+constant that permits backslashes.
+It'll necessarily be a prefix, such as:
+
+@smallexample
+PRINT *, C'This line has a backspace \b here.'
+PRINT *, F'This line has a straight backslash \ here.'
+@end smallexample
+
+Further, command-line options might be provided to specify that
+one prefix or the other is to be assumed as the default
+for @code{CHARACTER} constants.
+
+However, it seems more helpful for @code{g77} to provide a program
+that converts prefix all constants
+(or just those containing backslashes)
+with the desired designation,
+so printouts of code can be read
+without knowing the compile-time options used when compiling it.
+
+If such a program is provided
+(let's name it @code{g77slash} for now),
+then a command-line option to @code{g77} should not be provided.
+(Though, given that it'll be easy to implement, it might be hard
+to resist user requests for it ``to compile faster than if we
+have to invoke another filter''.)
+
+This program would take a command-line option to specify the
+default interpretation of slashes,
+affecting which prefix it uses for constants.
+
+@code{g77slash} probably should automatically convert Hollerith
+constants that contain slashes
+to the appropriate @code{CHARACTER} constants.
+Then @code{g77} wouldn't have to define a prefix syntax for Hollerith
+constants specifying whether they want C-style or straight-through
+backslashes.
+
+@item
+To allow for form-neutral INCLUDE files without requiring them
+to be preprocessed,
+the fixed-form lexer should offer an extension (if possible)
+allowing a trailing @samp{&} to be ignored, especially if after
+column 72, as it would be using the traditional Unix Fortran source
+model (which ignores @emph{everything} after column 72).
+@end itemize
+
+The above implements nearly exactly what is specified by
+@ref{Character Set},
+and
+@ref{Lines},
+except it also provides automatic conversion of tabs
+and ignoring of newline-related carriage returns,
+as well as accommodating form-neutral INCLUDE files.
+
+It also implements the ``pure visual'' model,
+by which is meant that a user viewing his code
+in a typical text editor
+(assuming it's not preprocessed via @code{g77stripcard} or similar)
+doesn't need any special knowledge
+of whether spaces on the screen are really tabs,
+whether lines end immediately after the last visible non-space character
+or after a number of spaces and tabs that follow it,
+or whether the last line in the file is ended by a newline.
+
+Most editors don't make these distinctions,
+the ANSI FORTRAN 77 standard doesn't require them to,
+and it permits a standard-conforming compiler
+to define a method for transforming source code to
+``standard form'' however it wants.
+
+So, GNU Fortran defines it such that users have the best chance
+of having the code be interpreted the way it looks on the screen
+of the typical editor.
+
+(Fancy editors should @emph{never} be required to correctly read code
+written in classic two-dimensional-plaintext form.
+By correct reading I mean ability to read it, book-like, without
+mistaking text ignored by the compiler for program code and vice versa,
+and without having to count beyond the first several columns.
+The vague meaning of ASCII TAB, among other things, complicates
+this somewhat, but as long as ``everyone'', including the editor,
+other tools, and printer, agrees about the every-eighth-column convention,
+the GNU Fortran ``pure visual'' model meets these requirements.
+Any language or user-visible source form
+requiring special tagging of tabs,
+the ends of lines after spaces/tabs,
+and so on, fails to meet this fairly straightforward specification.
+Fortunately, Fortran @emph{itself} does not mandate such a failure,
+though most vendor-supplied defaults for their Fortran compilers @emph{do}
+fail to meet this specification for readability.)
+
+Further, this model provides a clean interface
+to whatever preprocessors or code-generators are used
+to produce input to this phase of @code{g77}.
+Mainly, they need not worry about long lines.
+
+@node sta.c
+@subsection sta.c
+
+@node sti.c
+@subsection sti.c
+
+@node stq.c
+@subsection stq.c
+
+@node stb.c
+@subsection stb.c
+
+@node expr.c
+@subsection expr.c
+
+@node stc.c
+@subsection stc.c
+
+@node std.c
+@subsection std.c
+
+@node ste.c
+@subsection ste.c
+
+@node Gotchas (Transforming)
+@subsection Gotchas (Transforming)
+
+This section is not about transforming ``gotchas'' into something else.
+It is about the weirder aspects of transforming Fortran,
+however that's defined,
+into a more modern, canonical form.
+
+@subsubsection Multi-character Lexemes
+
+Each lexeme carries with it a pointer to where it appears in the source.
+
+To provide the ability for diagnostics to point to column numbers,
+in addition to line numbers and names,
+lexemes that represent more than one (significant) character
+in the source code need, generally,
+to provide pointers to where each @emph{character} appears in the source.
+
+This provides the ability to properly identify the precise location
+of the problem in code like
+
+@smallexample
+SUBROUTINE X
+END
+BLOCK DATA X
+END
+@end smallexample
+
+which, in fixed-form source, would result in single lexemes
+consisting of the strings @samp{SUBROUTINEX} and @samp{BLOCKDATAX}.
+(The problem is that @samp{X} is defined twice,
+so a pointer to the @samp{X} in the second definition,
+as well as a follow-up pointer to the corresponding pointer in the first,
+would be preferable to pointing to the beginnings of the statements.)
+
+This need also arises when parsing (and diagnosing) @code{FORMAT}
+statements.
+
+Further, it arises when diagnosing
+@code{FMT=} specifiers that contain constants
+(or partial constants, or even propagated constants!)
+in I/O statements, as in:
+
+@smallexample
+PRINT '(I2, 3HAB)', J
+@end smallexample
+
+(A pointer to the beginning of the prematurely-terminated Hollerith
+constant, and/or to the close parenthese, is preferable to a pointer
+to the open-parenthese or the apostrophe that precedes it.)
+
+Multi-character lexemes, which would seem to naturally include
+at least digit strings, alphanumeric strings, @code{CHARACTER}
+constants, and Hollerith constants, therefore need to provide
+location information on each character.
+(Maybe Hollerith constants don't, but it's unnecessary to except them.)
+
+The question then arises, what about @emph{other} multi-character lexemes,
+such as @samp{**} and @samp{//},
+and Fortran 90's @samp{(/}, @samp{/)}, @samp{::}, and so on?
+
+Turns out there's a need to identify the location of the second character
+of these two-character lexemes.
+For example, in @samp{I(/J) = K}, the slash needs to be diagnosed
+as the problem, not the open parenthese.
+Similarly, it is preferable to diagnose the second slash in
+@samp{I = J // K} rather than the first, given the implicit typing
+rules, which would result in the compiler disallowing the attempted
+concatenation of two integers.
+(Though, since that's more of a semantic issue,
+it's not @emph{that} much preferable.)
+
+Even sequences that could be parsed as digit strings could use location info,
+for example, to diagnose the @samp{9} in the octal constant @samp{O'129'}.
+(This probably will be parsed as a character string,
+to be consistent with the parsing of @samp{Z'129A'}.)
+
+To avoid the hassle of recording the location of the second character,
+while also preserving the general rule that each significant character
+is distinctly pointed to by the lexeme that contains it,
+it's best to simply not have any fixed-size lexemes
+larger than one character.
+
+This new design is expected to make checking for two
+@samp{*} lexemes in a row much easier than the old design,
+so this is not much of a sacrifice.
+It probably makes the lexer much easier to implement
+than it makes the parser harder.
+
+@subsubsection Space-padding Lexemes
+
+Certain lexemes need to be padded with virtual spaces when the
+end of the line (or file) is encountered.
+
+This is necessary in fixed form, to handle lines that don't
+extend to column 72, assuming that's the line length in effect.
+
+@subsubsection Bizarre Free-form Hollerith Constants
+
+Last I checked, the Fortran 90 standard actually required the compiler
+to silently accept something like
+
+@smallexample
+FORMAT ( 1 2   Htwelve chars )
+@end smallexample
+
+as a valid @code{FORMAT} statement specifying a twelve-character
+Hollerith constant.
+
+The implication here is that, since the new lexer is a zero-feedback one,
+it won't know that the special case of a @code{FORMAT} statement being parsed
+requires apparently distinct lexemes @samp{1} and @samp{2} to be treated as
+a single lexeme.
+
+(This is a horrible misfeature of the Fortran 90 language.
+It's one of many such misfeatures that almost make me want
+to not support them, and forge ahead with designing a new
+``GNU Fortran'' language that has the features,
+but not the misfeatures, of Fortran 90,
+and provide utility programs to do the conversion automatically.)
+
+So, the lexer must gather distinct chunks of decimal strings into
+a single lexeme in contexts where a single decimal lexeme might
+start a Hollerith constant.
+
+(Which probably means it might as well do that all the time
+for all multi-character lexemes, even in free-form mode,
+leaving it to subsequent phases to pull them apart as they see fit.)
+
+Compare the treatment of this to how
+
+@smallexample
+CHARACTER * 4 5 HEY
+@end smallexample
+
+and
+
+@smallexample
+CHARACTER * 12 HEY
+@end smallexample
+
+must be treated---the former must be diagnosed, due to the separation
+between lexemes, the latter must be accepted as a proper declaration.
+
+@subsubsection Hollerith Constants
+
+Recognizing a Hollerith constant---specifically,
+that an @samp{H} or @samp{h} after a digit string begins
+such a constant---requires some knowledge of context.
+
+Hollerith constants (such as @samp{2HAB}) can appear after:
+
+@itemize @bullet
+@item
+@samp{(}
+
+@item
+@samp{,}
+
+@item
+@samp{=}
+
+@item
+@samp{+}, @samp{-}, @samp{/}
+
+@item
+@samp{*}, except as noted below
+@end itemize
+
+Hollerith constants don't appear after:
+
+@itemize @bullet
+@item
+@samp{CHARACTER*},
+which can be treated generally as
+any @samp{*} that is the second lexeme of a statement
+@end itemize
+
+@subsubsection Confusing Function Keyword
+
+While
+
+@smallexample
+REAL FUNCTION FOO ()
+@end smallexample
+
+must be a @code{FUNCTION} statement and
+
+@smallexample
+REAL FUNCTION FOO (5)
+@end smallexample
+
+must be a type-definition statement,
+
+@smallexample
+REAL FUNCTION FOO (@var{names})
+@end smallexample
+
+where @var{names} is a comma-separated list of names,
+can be one or the other.
+
+The only way to disambiguate that statement
+(short of mandating free-form source or a short maximum
+length for name for external procedures)
+is based on the context of the statement.
+
+In particular, the statement is known to be within an
+already-started program unit
+(but not at the outer level of the @code{CONTAINS} block),
+it is a type-declaration statement.
+
+Otherwise, the statement is a @code{FUNCTION} statement,
+in that it begins a function program unit
+(external, or, within @code{CONTAINS}, nested).
+
+@subsubsection Weird READ
+
+The statement
+
+@smallexample
+READ (N)
+@end smallexample
+
+is equivalent to either
+
+@smallexample
+READ (UNIT=(N))
+@end smallexample
+
+or
+
+@smallexample
+READ (FMT=(N))
+@end smallexample
+
+depending on which would be valid in context.
+
+Specifically, if @samp{N} is type @code{INTEGER},
+@samp{READ (FMT=(N))} would not be valid,
+because parentheses may not be used around @samp{N},
+whereas they may around it in @samp{READ (UNIT=(N))}.
+
+Further, if @samp{N} is type @code{CHARACTER},
+the opposite is true---@samp{READ (UNIT=(N))} is not valid,
+but @samp{READ (FMT=(N))} is.
+
+Strictly speaking, if anything follows
+
+@smallexample
+READ (N)
+@end smallexample
+
+in the statement, whether the first lexeme after the close
+parenthese is a comma could be used to disambiguate the two cases,
+without looking at the type of @samp{N},
+because the comma is required for the @samp{READ (FMT=(N))}
+interpretation and disallowed for the @samp{READ (UNIT=(N))}
+interpretation.
+
+However, in practice, many Fortran compilers allow
+the comma for the @samp{READ (UNIT=(N))}
+interpretation anyway
+(in that they generally allow a leading comma before
+an I/O list in an I/O statement),
+and much code takes advantage of this allowance.
+
+(This is quite a reasonable allowance, since the
+juxtaposition of a comma-separated list immediately
+after an I/O control-specification list, which is also comma-separated,
+without an intervening comma,
+looks sufficiently ``wrong'' to programmers
+that they can't resist the itch to insert the comma.
+@samp{READ (I, J), K, L} simply looks cleaner than
+@samp{READ (I, J) K, L}.)
+
+So, type-based disambiguation is needed unless strict adherence
+to the standard is always assumed, and we're not going to assume that.
+
+@node TBD (Transforming)
+@subsection TBD (Transforming)
+
+Continue researching gotchas, designing the transformational process,
+and implementing it.
+
+Specific issues to resolve:
+
+@itemize @bullet
+@item
+Just where should (if it was implemented) @code{USE} processing take place?
+
+This gets into the whole issue of how @code{g77} should handle the concept
+of modules.
+I think GNAT already takes on this issue, but don't know more than that.
+Jim Giles has written extensively on @code{comp.lang.fortran}
+about his opinions on module handling, as have others.
+Jim's views should be taken into account.
+
+Actually, Richard M. Stallman (RMS) also has written up
+some guidelines for implementing such things,
+but I'm not sure where I read them.
+Perhaps the old @email{gcc2@@cygnus.com} list.
+
+If someone could dig references to these up and get them to me,
+that would be much appreciated!
+Even though modules are not on the short-term list for implementation,
+it'd be helpful to know @emph{now} how to avoid making them harder to
+implement them @emph{later}.
+
+@item
+Should the @code{g77} command become just a script that invokes
+all the various preprocessing that might be needed,
+thus making it seem slower than necessary for legacy code
+that people are unwilling to convert,
+or should we provide a separate script for that,
+thus encouraging people to convert their code once and for all?
+
+At least, a separate script to behave as old @code{g77} did,
+perhaps named @code{g77old}, might ease the transition,
+as might a corresponding one that converts source codes
+named @code{g77oldnew}.
+
+These scripts would take all the pertinent options @code{g77} used
+to take and run the appropriate filters,
+passing the results to @code{g77} or just making new sources out of them
+(in a subdirectory, leaving the user to do the dirty deed of
+moving or copying them over the old sources).
+
+@item
+Do other Fortran compilers provide a prefix syntax
+to govern the treatment of backslashes in @code{CHARACTER}
+(or Hollerith) constants?
+
+Knowing what other compilers provide would help.
+
+@item
+Is it okay to drop support for the @samp{-fintrin-case-initcap},
+@samp{-fmatch-case-initcap}, @samp{-fsymbol-case-initcap},
+and @samp{-fcase-initcap} options?
+
+I've asked @email{info-gnu-fortran@@gnu.org} for input on this.
+Not having to support these makes it easier to write the new front end,
+and might also avoid complicated its design.
+
+The consensus to date (1999-11-17) has been to drop this support.
+Can't recall anybody saying they're using it, in fact.
+@end itemize
+
+@node Philosophy of Code Generation
+@section Philosophy of Code Generation
+
+Don't poke the bear.
+
+The @code{g77} front end generates code
+via the @code{gcc} back end.
+
+@cindex GNU Back End (GBE)
+@cindex GBE
+@cindex @code{gcc}, back end
+@cindex back end, gcc
+@cindex code generator
+The @code{gcc} back end (GBE) is a large, complex
+labyrinth of intricate code
+written in a combination of the C language
+and specialized languages internal to @code{gcc}.
+
+While the @emph{code} that implements the GBE
+is written in a combination of languages,
+the GBE itself is,
+to the front end for a language like Fortran,
+best viewed as a @emph{compiler}
+that compiles its own, unique, language.
+
+The GBE's ``source'', then, is written in this language,
+which consists primarily of
+a combination of calls to GBE functions
+and @dfn{tree} nodes
+(which are, themselves, created
+by calling GBE functions).
+
+So, the @code{g77} generates code by, in effect,
+translating the Fortran code it reads
+into a form ``written'' in the ``language''
+of the @code{gcc} back end.
+
+@cindex GBEL
+@cindex GNU Back End Language (GBEL)
+This language will heretofore be referred to as @dfn{GBEL},
+for GNU Back End Language.
+
+GBEL is an evolving language,
+not fully specified in any published form
+as of this writing.
+It offers many facilities,
+but its ``core'' facilities
+are those that corresponding most directly
+to those needed to support @code{gcc}
+(compiling code written in GNU C).
+
+The @code{g77} Fortran Front End (FFE)
+is designed and implemented
+to navigate the currents and eddies
+of ongoing GBEL and @code{gcc} development
+while also delivering on the potential
+of an integrated FFE
+(as compared to using a converter like @code{f2c}
+and feeding the output into @code{gcc}).
+
+Goals of the FFE's code-generation strategy include:
+
+@itemize @bullet
+@item
+High likelihood of generation of correct code,
+or, failing that, producing a fatal diagnostic or crashing.
+
+@item
+Generation of highly optimized code,
+as directed by the user
+via GBE-specific (versus @code{g77}-specific) constructs,
+such as command-line options.
+
+@item
+Fast overall (FFE plus GBE) compilation.
+
+@item
+Preservation of source-level debugging information.
+@end itemize
+
+The strategies historically, and currently, used by the FFE
+to achieve these goals include:
+
+@itemize @bullet
+@item
+Use of GBEL constructs that most faithfully encapsulate
+the semantics of Fortran.
+
+@item
+Avoidance of GBEL constructs that are so rarely used,
+or limited to use in specialized situations not related to Fortran,
+that their reliability and performance has not yet been established
+as sufficient for use by the FFE.
+
+@item
+Flexible design, to readily accommodate changes to specific
+code-generation strategies, perhaps governed by command-line options.
+@end itemize
+
+@cindex Bear-poking
+@cindex Poking the bear
+``Don't poke the bear'' somewhat summarizes the above strategies.
+The GBE is the bear.
+The FFE is designed and implemented to avoid poking it
+in ways that are likely to just annoy it.
+The FFE usually either tackles it head-on,
+or avoids treating it in ways dissimilar to how
+the @code{gcc} front end treats it.
+
+For example, the FFE uses the native array facility in the back end
+instead of the lower-level pointer-arithmetic facility
+used by @code{gcc} when compiling @code{f2c} output).
+Theoretically, this presents more opportunities for optimization,
+faster compile times,
+and the production of more faithful debugging information.
+These benefits were not, however, immediately realized,
+mainly because @code{gcc} itself makes little or no use
+of the native array facility.
+
+Complex arithmetic is a case study of the evolution of this strategy.
+When originally implemented,
+the GBEL had just evolved its own native complex-arithmetic facility,
+so the FFE took advantage of that.
+
+When porting @code{g77} to 64-bit systems,
+it was discovered that the GBE didn't really
+implement its native complex-arithmetic facility properly.
+
+The short-term solution was to rewrite the FFE
+to instead use the lower-level facilities
+that'd be used by @code{gcc}-compiled code
+(assuming that code, itself, didn't use the native complex type
+provided, as an extension, by @code{gcc}),
+since these were known to work,
+and, in any case, if shown to not work,
+would likely be rapidly fixed
+(since they'd likely not work for vanilla C code in similar circumstances).
+
+However, the rewrite accommodated the original, native approach as well
+by offering a command-line option to select it over the emulated approach.
+This allowed users, and especially GBE maintainers, to try out
+fixes to complex-arithmetic support in the GBE
+while @code{g77} continued to default to compiling more code correctly,
+albeit producing (typically) slower executables.
+
+As of April 1999, it appeared that the last few bugs
+in the GBE's support of its native complex-arithmetic facility
+were worked out.
+The FFE was changed back to default to using that native facility,
+leaving emulation as an option.
+
+Later during the release cycle
+(which was called EGCS 1.2, but soon became GCC 2.95),
+bugs in the native facility were found.
+Reactions among various people included
+``the last thing we should do is change the default back'',
+``we must change the default back'',
+and ``let's figure out whether we can narrow down the bugs to
+few enough cases to allow the now-months-long-tested default
+to remain the same''.
+The latter viewpoint won that particular time.
+The bugs exposed other concerns regarding ABI compliance
+when the ABI specified treatment of complex data as different
+from treatment of what Fortran and GNU C consider the equivalent
+aggregation (structure) of real (or float) pairs.
+
+Other Fortran constructs---arrays, character strings,
+complex division, @code{COMMON} and @code{EQUIVALENCE} aggregates,
+and so on---involve issues similar to those pertaining to complex arithmetic.
+
+So, it is possible that the history
+of how the FFE handled complex arithmetic
+will be repeated, probably in modified form
+(and hopefully over shorter timeframes),
+for some of these other facilities.
+
+@node Two-pass Design
+@section Two-pass Design
+
+The FFE does not tell the GBE anything about a program unit
+until after the last statement in that unit has been parsed.
+(A program unit is a Fortran concept that corresponds, in the C world,
+mostly closely to functions definitions in ISO C.
+That is, a program unit in Fortran is like a top-level function in C.
+Nested functions, found among the extensions offered by GNU C,
+correspond roughly to Fortran's statement functions.)
+
+So, while parsing the code in a program unit,
+the FFE saves up all the information
+on statements, expressions, names, and so on,
+until it has seen the last statement.
+
+At that point, the FFE revisits the saved information
+(in what amounts to a second @dfn{pass} over the program unit)
+to perform the actual translation of the program unit into GBEL,
+ultimating in the generation of assembly code for it.
+
+Some lookahead is performed during this second pass,
+so the FFE could be viewed as a ``two-plus-pass'' design.
+
+@menu
+* Two-pass Code::
+* Why Two Passes::
+@end menu
+
+@node Two-pass Code
+@subsection Two-pass Code
+
+Most of the code that turns the first pass (parsing)
+into a second pass for code generation
+is in @file{@value{path-g77}/std.c}.
+
+It has external functions,
+called mainly by siblings in @file{@value{path-g77}/stc.c},
+that record the information on statements and expressions
+in the order they are seen in the source code.
+These functions save that information.
+
+It also has an external function that revisits that information,
+calling the siblings in @file{@value{path-g77}/ste.c},
+which handles the actual code generation
+(by generating GBEL code,
+that is, by calling GBE routines
+to represent and specify expressions, statements, and so on).
+
+@node Why Two Passes
+@subsection Why Two Passes
+
+The need for two passes was not immediately evident
+during the design and implementation of the code in the FFE
+that was to produce GBEL.
+Only after a few kludges,
+to handle things like incorrectly-guessed @code{ASSIGN} label nature,
+had been implemented,
+did enough evidence pile up to make it clear
+that @file{std.c} had to be introduced to intercept,
+save, then revisit as part of a second pass,
+the digested contents of a program unit.
+
+Other such missteps have occurred during the evolution of the FFE,
+because of the different goals of the FFE and the GBE.
+
+Because the GBE's original, and still primary, goal
+was to directly support the GNU C language,
+the GBEL, and the GBE itself,
+requires more complexity
+on the part of most front ends
+than it requires of @code{gcc}'s.
+
+For example,
+the GBEL offers an interface that permits the @code{gcc} front end
+to implement most, or all, of the language features it supports,
+without the front end having to
+make use of non-user-defined variables.
+(It's almost certainly the case that all of K&R C,
+and probably ANSI C as well,
+is handled by the @code{gcc} front end
+without declaring such variables.)
+
+The FFE, on the other hand, must resort to a variety of ``tricks''
+to achieve its goals.
+
+Consider the following C code:
+
+@smallexample
+int
+foo (int a, int b)
+@{
+  int c = 0;
+
+  if ((c = bar (c)) == 0)
+    goto done;
+
+  quux (c << 1);
+
+done:
+  return c;
+@}
+@end smallexample
+
+Note what kinds of objects are declared, or defined, before their use,
+and before any actual code generation involving them
+would normally take place:
+
+@itemize @bullet
+@item
+Return type of function
+
+@item
+Entry point(s) of function
+
+@item
+Dummy arguments
+
+@item
+Variables
+
+@item
+Initial values for variables
+@end itemize
+
+Whereas, the following items can, and do,
+suddenly appear ``out of the blue'' in C:
+
+@itemize @bullet
+@item
+Label references
+
+@item
+Function references
+@end itemize
+
+Not surprisingly, the GBE faithfully permits the latter set of items
+to be ``discovered'' partway through GBEL ``programs'',
+just as they are permitted to in C.
+
+Yet, the GBE has tended, at least in the past,
+to be reticent to fully support similar ``late'' discovery
+of items in the former set.
+
+This makes Fortran a poor fit for the ``safe'' subset of GBEL.
+Consider:
+
+@smallexample
+      FUNCTION X (A, ARRAY, ID1)
+      CHARACTER*(*) A
+      DOUBLE PRECISION X, Y, Z, TMP, EE, PI
+      REAL ARRAY(ID1*ID2)
+      COMMON ID2
+      EXTERNAL FRED
+
+      ASSIGN 100 TO J
+      CALL FOO (I)
+      IF (I .EQ. 0) PRINT *, A(0)
+      GOTO 200
+
+      ENTRY Y (Z)
+      ASSIGN 101 TO J
+200   PRINT *, A(1)
+      READ *, TMP
+      GOTO J
+100   X = TMP * EE
+      RETURN
+101   Y = TMP * PI
+      CALL FRED
+      DATA EE, PI /2.71D0, 3.14D0/
+      END
+@end smallexample
+
+Here are some observations about the above code,
+which, while somewhat contrived,
+conforms to the FORTRAN 77 and Fortran 90 standards:
+
+@itemize @bullet
+@item
+The return type of function @samp{X} is not known
+until the @samp{DOUBLE PRECISION} line has been parsed.
+
+@item
+Whether @samp{A} is a function or a variable
+is not known until the @samp{PRINT *, A(0)} statement
+has been parsed.
+
+@item
+The bounds of the array of argument @samp{ARRAY}
+depend on a computation involving
+the subsequent argument @samp{ID1}
+and the blank-common member @samp{ID2}.
+
+@item
+Whether @samp{Y} and @samp{Z} are local variables,
+additional function entry points,
+or dummy arguments to additional entry points
+is not known
+until the @code{ENTRY} statement is parsed.
+
+@item
+Similarly, whether @samp{TMP} is a local variable is not known
+until the @samp{READ *, TMP} statement is parsed.
+
+@item
+The initial values for @samp{EE} and @samp{PI}
+are not known until after the @code{DATA} statement is parsed.
+
+@item
+Whether @samp{FRED} is a function returning type @code{REAL}
+or a subroutine
+(which can be thought of as returning type @code{void}
+@emph{or}, to support alternate returns in a simple way,
+type @code{int})
+is not known
+until the @samp{CALL FRED} statement is parsed.
+
+@item
+Whether @samp{100} is a @code{FORMAT} label
+or the label of an executable statement
+is not known
+until the @samp{X =} statement is parsed.
+(These two types of labels get @emph{very} different treatment,
+especially when @code{ASSIGN}'ed.)
+
+@item
+That @samp{J} is a local variable is not known
+until the first @code{ASSIGN} statement is parsed.
+(This happens @emph{after} executable code has been seen.)
+@end itemize
+
+Very few of these ``discoveries''
+can be accommodated by the GBE as it has evolved over the years.
+The GBEL doesn't support several of them,
+and those it might appear to support
+don't always work properly,
+especially in combination with other GBEL and GBE features,
+as implemented in the GBE.
+
+(Had the GBE and its GBEL originally evolved to support @code{g77},
+the shoe would be on the other foot, so to speak---most, if not all,
+of the above would be directly supported by the GBEL,
+and a few C constructs would probably not, as they are in reality,
+be supported.
+Both this mythical, and today's real, GBE caters to its GBEL
+by, sometimes, scrambling around, cleaning up after itself---after
+discovering that assumptions it made earlier during code generation
+are incorrect.
+That's not a great design, since it indicates significant code
+paths that might be rarely tested but used in some key production
+environments.)
+
+So, the FFE handles these discrepancies---between the order in which
+it discovers facts about the code it is compiling,
+and the order in which the GBEL and GBE support such discoveries---by
+performing what amounts to two
+passes over each program unit.
+
+(A few ambiguities can remain at that point,
+such as whether, given @samp{EXTERNAL BAZ}
+and no other reference to @samp{BAZ} in the program unit,
+it is a subroutine, a function, or a block-data---which, in C-speak,
+governs its declared return type.
+Fortunately, these distinctions are easily finessed
+for the procedure, library, and object-file interfaces
+supported by @code{g77}.)
+
+@node Challenges Posed
+@section Challenges Posed
+
+Consider the following Fortran code, which uses various extensions
+(including some to Fortran 90):
+
+@smallexample
+SUBROUTINE X(A)
+CHARACTER*(*) A
+COMPLEX CFUNC
+INTEGER*2 CLOCKS(200)
+INTEGER IFUNC
+
+CALL SYSTEM_CLOCK (CLOCKS (IFUNC (CFUNC ('('//A//')'))))
+@end smallexample
+
+The above poses the following challenges to any Fortran compiler
+that uses run-time interfaces, and a run-time library, roughly similar
+to those used by @code{g77}:
+
+@itemize @bullet
+@item
+Assuming the library routine that supports @code{SYSTEM_CLOCK}
+expects to set an @code{INTEGER*4} variable via its @code{COUNT} argument,
+the compiler must make available to it a temporary variable of that type.
+
+@item
+Further, after the @code{SYSTEM_CLOCK} library routine returns,
+the compiler must ensure that the temporary variable it wrote
+is copied into the appropriate element of the @samp{CLOCKS} array.
+(This assumes the compiler doesn't just reject the code,
+which it should if it is compiling under some kind of a ``strict'' option.)
+
+@item
+To determine the correct index into the @samp{CLOCKS} array,
+(putting aside the fact that the index, in this particular case,
+need not be computed until after
+the @code{SYSTEM_CLOCK} library routine returns),
+the compiler must ensure that the @code{IFUNC} function is called.
+
+That requires evaluating its argument,
+which requires, for @code{g77}
+(assuming @code{-ff2c} is in force),
+reserving a temporary variable of type @code{COMPLEX}
+for use as a repository for the return value
+being computed by @samp{CFUNC}.
+
+@item
+Before invoking @samp{CFUNC},
+is argument must be evaluated,
+which requires allocating, at run time,
+a temporary large enough to hold the result of the concatenation,
+as well as actually performing the concatenation.
+
+@item
+The large temporary needed during invocation of @code{CFUNC}
+should, ideally, be deallocated
+(or, at least, left to the GBE to dispose of, as it sees fit)
+as soon as @code{CFUNC} returns,
+which means before @code{IFUNC} is called
+(as it might need a lot of dynamically allocated memory).
+@end itemize
+
+@code{g77} currently doesn't support all of the above,
+but, so that it might someday, it has evolved to handle
+at least some of the above requirements.
+
+Meeting the above requirements is made more challenging
+by conforming to the requirements of the GBEL/GBE combination.
+
+@node Transforming Statements
+@section Transforming Statements
+
+Most Fortran statements are given their own block,
+and, for temporary variables they might need, their own scope.
+(A block is what distinguishes @samp{@{ foo (); @}}
+from just @samp{foo ();} in C.
+A scope is included with every such block,
+providing a distinct name space for local variables.)
+
+Label definitions for the statement precede this block,
+so @samp{10 PRINT *, I} is handled more like
+@samp{fl10: @{ @dots{} @}} than @samp{@{ fl10: @dots{} @}}
+(where @samp{fl10} is just a notation meaning ``Fortran Label 10''
+for the purposes of this document).
+
+@menu
+* Statements Needing Temporaries::
+* Transforming DO WHILE::
+* Transforming Iterative DO::
+* Transforming Block IF::
+* Transforming SELECT CASE::
+@end menu
+
+@node Statements Needing Temporaries
+@subsection Statements Needing Temporaries
+
+Any temporaries needed during, but not beyond,
+execution of a Fortran statement,
+are made local to the scope of that statement's block.
+
+This allows the GBE to share storage for these temporaries
+among the various statements without the FFE
+having to manage that itself.
+
+(The GBE could, of course, decide to optimize 
+management of these temporaries.
+For example, it could, theoretically,
+schedule some of the computations involving these temporaries
+to occur in parallel.
+More practically, it might leave the storage for some temporaries
+``live'' beyond their scopes, to reduce the number of
+manipulations of the stack pointer at run time.)
+
+Temporaries needed across distinct statement boundaries usually
+are associated with Fortran blocks (such as @code{DO}/@code{END DO}).
+(Also, there might be temporaries not associated with blocks at all---these
+would be in the scope of the entire program unit.)
+
+Each Fortran block @emph{should} get its own block/scope in the GBE.
+This is best, because it allows temporaries to be more naturally handled.
+However, it might pose problems when handling labels
+(in particular, when they're the targets of @code{GOTO}s outside the Fortran
+block), and generally just hassling with replicating
+parts of the @code{gcc} front end
+(because the FFE needs to support
+an arbitrary number of nested back-end blocks
+if each Fortran block gets one).
+
+So, there might still be a need for top-level temporaries, whose
+``owning'' scope is that of the containing procedure.
+
+Also, there seems to be problems declaring new variables after
+generating code (within a block) in the back end, leading to, e.g.,
+@samp{label not defined before binding contour} or similar messages,
+when compiling with @samp{-fstack-check} or
+when compiling for certain targets.
+
+Because of that, and because sometimes these temporaries are not
+discovered until in the middle of of generating code for an expression
+statement (as in the case of the optimization for @samp{X**I}),
+it seems best to always
+pre-scan all the expressions that'll be expanded for a block
+before generating any of the code for that block.
+
+This pre-scan then handles discovering and declaring, to the back end,
+the temporaries needed for that block.
+
+It's also important to treat distinct items in an I/O list as distinct
+statements deserving their own blocks.
+That's because there's a requirement
+that each I/O item be fully processed before the next one,
+which matters in cases like @samp{READ (*,*), I, A(I)}---the
+element of @samp{A} read in the second item
+@emph{must} be determined from the value
+of @samp{I} read in the first item.
+
+@node Transforming DO WHILE
+@subsection Transforming DO WHILE
+
+@samp{DO WHILE(expr)} @emph{must} be implemented
+so that temporaries needed to evaluate @samp{expr}
+are generated just for the test, each time.
+
+Consider how @samp{DO WHILE (A//B .NE. 'END'); @dots{}; END DO} is transformed:
+
+@smallexample
+for (;;)
+  @{
+    int temp0;
+
+    @{
+      char temp1[large];
+
+      libg77_catenate (temp1, a, b);
+      temp0 = libg77_ne (temp1, 'END');
+    @}
+
+    if (! temp0)
+      break;
+
+    @dots{}
+  @}
+@end smallexample
+
+In this case, it seems like a time/space tradeoff
+between allocating and deallocating @samp{temp1} for each iteration
+and allocating it just once for the entire loop.
+
+However, if @samp{temp1} is allocated just once for the entire loop,
+it could be the wrong size for subsequent iterations of that loop
+in cases like @samp{DO WHILE (A(I:J)//B .NE. 'END')},
+because the body of the loop might modify @samp{I} or @samp{J}.
+
+So, the above implementation is used,
+though a more optimal one can be used
+in specific circumstances.
+
+@node Transforming Iterative DO
+@subsection Transforming Iterative DO
+
+An iterative @code{DO} loop
+(one that specifies an iteration variable)
+is required by the Fortran standards
+to be implemented as though an iteration count
+is computed before entering the loop body,
+and that iteration count used to determine
+the number of times the loop body is to be performed
+(assuming the loop isn't cut short via @code{GOTO} or @code{EXIT}).
+
+The FFE handles this by allocating a temporary variable
+to contain the computed number of iterations.
+Since this variable must be in a scope that includes the entire loop,
+a GBEL block is created for that loop,
+and the variable declared as belonging to the scope of that block.
+
+@node Transforming Block IF
+@subsection Transforming Block IF
+
+Consider:
+
+@smallexample
+SUBROUTINE X(A,B,C)
+CHARACTER*(*) A, B, C
+LOGICAL LFUNC
+
+IF (LFUNC (A//B)) THEN
+  CALL SUBR1
+ELSE IF (LFUNC (A//C)) THEN
+  CALL SUBR2
+ELSE
+  CALL SUBR3
+END
+@end smallexample
+
+The arguments to the two calls to @samp{LFUNC}
+require dynamic allocation (at run time),
+but are not required during execution of the @code{CALL} statements.
+
+So, the scopes of those temporaries must be within blocks inside
+the block corresponding to the Fortran @code{IF} block.
+
+This cannot be represented ``naturally''
+in vanilla C, nor in GBEL.
+The @code{if}, @code{elseif}, @code{else},
+and @code{endif} constructs
+provided by both languages must,
+for a given @code{if} block,
+share the same C/GBE block.
+
+Therefore, any temporaries needed during evaluation of @samp{expr}
+while executing @samp{ELSE IF(expr)}
+must either have been predeclared
+at the top of the corresponding @code{IF} block,
+or declared within a new block for that @code{ELSE IF}---a block that,
+since it cannot contain the @code{else} or @code{else if} itself
+(due to the above requirement),
+actually implements the rest of the @code{IF} block's
+@code{ELSE IF} and @code{ELSE} statements
+within an inner block.
+
+The FFE takes the latter approach.
+
+@node Transforming SELECT CASE
+@subsection Transforming SELECT CASE
+
+@code{SELECT CASE} poses a few interesting problems for code generation,
+if efficiency and frugal stack management are important.
+
+Consider @samp{SELECT CASE (I('PREFIX'//A))},
+where @samp{A} is @code{CHARACTER*(*)}.
+In a case like this---basically,
+in any case where largish temporaries are needed
+to evaluate the expression---those temporaries should
+not be ``live'' during execution of any of the @code{CASE} blocks.
+
+So, evaluation of the expression is best done within its own block,
+which in turn is within the @code{SELECT CASE} block itself
+(which contains the code for the CASE blocks as well,
+though each within their own block).
+
+Otherwise, we'd have the rough equivalent of this pseudo-code:
+
+@smallexample
+@{
+  char temp[large];
+
+  libg77_catenate (temp, 'prefix', a);
+
+  switch (i (temp))
+    @{
+    case 0:
+      @dots{}
+    @}
+@}
+@end smallexample
+
+And that would leave temp[large] in scope during the CASE blocks
+(although a clever back end *could* see that it isn't referenced
+in them, and thus free that temp before executing the blocks).
+
+So this approach is used instead:
+
+@smallexample
+@{
+  int temp0;
+
+  @{
+    char temp1[large];
+
+    libg77_catenate (temp1, 'prefix', a);
+    temp0 = i (temp1);
+  @}
+
+  switch (temp0)
+    @{
+    case 0:
+      @dots{}
+    @}
+@}
+@end smallexample
+
+Note how @samp{temp1} goes out of scope before starting the switch,
+thus making it easy for a back end to free it.
+
+The problem @emph{that} solution has, however,
+is with @samp{SELECT CASE('prefix'//A)}
+(which is currently not supported).
+
+Unless the GBEL is extended to support arbitrarily long character strings
+in its @code{case} facility,
+the FFE has to implement @code{SELECT CASE} on @code{CHARACTER}
+(probably excepting @code{CHARACTER*1})
+using a cascade of
+@code{if}, @code{elseif}, @code{else}, and @code{endif} constructs
+in GBEL.
+
+To prevent the (potentially large) temporary,
+needed to hold the selected expression itself (@samp{'prefix'//A}),
+from being in scope during execution of the @code{CASE} blocks,
+two approaches are available:
+
+@itemize @bullet
+@item
+Pre-evaluate all the @code{CASE} tests,
+producing an integer ordinal that is used,
+a la @samp{temp0} in the earlier example,
+as if @samp{SELECT CASE(temp0)} had been written.
+
+Each corresponding @code{CASE} is replaced with @samp{CASE(@var{i})},
+where @var{i} is the ordinal for that case,
+determined while, or before,
+generating the cascade of @code{if}-related constructs
+to cope with @code{CHARACTER} selection.
+
+@item
+Make @samp{temp0} above just
+large enough to hold the longest @code{CASE} string
+that'll actually be compared against the expression
+(in this case, @samp{'prefix'//A}).
+
+Since that length must be constant
+(because @code{CASE} expressions are all constant),
+it won't be so large,
+and, further, @samp{temp1} need not be dynamically allocated,
+since normal @code{CHARACTER} assignment can be used
+into the fixed-length @samp{temp0}.
+@end itemize
+
+Both of these solutions require @code{SELECT CASE} implementation
+to be changed so all the corresponding @code{CASE} statements
+are seen during the actual code generation for @code{SELECT CASE}.
+
+@node Transforming Expressions
+@section Transforming Expressions
+
+The interactions between statements, expressions, and subexpressions
+at program run time can be viewed as:
+
+@smallexample
+@var{action}(@var{expr})
+@end smallexample
+
+Here, @var{action} is the series of steps
+performed to effect the statement,
+and @var{expr} is the expression
+whose value is used by @var{action}.
+
+Expanding the above shows a typical order of events at run time:
+
+@smallexample
+Evaluate @var{expr}
+Perform @var{action}, using result of evaluation of @var{expr}
+Clean up after evaluating @var{expr}
+@end smallexample
+
+So, if evaluating @var{expr} requires allocating memory,
+that memory can be freed before performing @var{action}
+only if it is not needed to hold the result of evaluating @var{expr}.
+Otherwise, it must be freed no sooner than
+after @var{action} has been performed.
+
+The above are recursive definitions,
+in the sense that they apply to subexpressions of @var{expr}.
+
+That is, evaluating @var{expr} involves
+evaluating all of its subexpressions,
+performing the @var{action} that computes the
+result value of @var{expr},
+then cleaning up after evaluating those subexpressions.
+
+The recursive nature of this evaluation is implemented
+via recursive-descent transformation of the top-level statements,
+their expressions, @emph{their} subexpressions, and so on.
+
+However, that recursive-descent transformation is,
+due to the nature of the GBEL,
+focused primarily on generating a @emph{single} stream of code
+to be executed at run time.
+
+Yet, from the above, it's clear that multiple streams of code
+must effectively be simultaneously generated
+during the recursive-descent analysis of statements.
+
+The primary stream implements the primary @var{action} items,
+while at least two other streams implement
+the evaluation and clean-up items.
+
+Requirements imposed by expressions include:
+
+@itemize @bullet
+@item
+Whether the caller needs to have a temporary ready
+to hold the value of the expression.
+
+@item
+Other stuff???
+@end itemize
+
+@node Internal Naming Conventions
+@section Internal Naming Conventions
+
+Names exported by FFE modules have the following (regular-expression) forms.
+Note that all names beginning @code{ffe@var{mod}} or @code{FFE@var{mod}},
+where @var{mod} is lowercase or uppercase alphanumerics, respectively,
+are exported by the module @code{ffe@var{mod}},
+with the source code doing the exporting in @file{@var{mod}.h}.
+(Usually, the source code for the implementation is in @file{@var{mod}.c}.)
+
+Identifiers that don't fit the following forms
+are not considered exported,
+even if they are according to the C language.
+(For example, they might be made available to other modules
+solely for use within expansions of exported macros,
+not for use within any source code in those other modules.)
+
+@table @code
+@item ffe@var{mod}
+The single typedef exported by the module.
+
+@item FFE@var{umod}_[A-Z][A-Z0-9_]*
+(Where @var{umod} is the uppercase for of @var{mod}.)
+
+A @code{#define} or @code{enum} constant of the type @code{ffe@var{mod}}.
+
+@item ffe@var{mod}[A-Z][A-Z][a-z0-9]*
+A typedef exported by the module.
+
+The portion of the identifier after @code{ffe@var{mod}} is
+referred to as @code{ctype}, a capitalized (mixed-case) form
+of @code{type}.
+
+@item FFE@var{umod}_@var{type}[A-Z][A-Z0-9_]*[A-Z0-9]?
+(Where @var{umod} is the uppercase for of @var{mod}.)
+
+A @code{#define} or @code{enum} constant of the type
+@code{ffe@var{mod}@var{type}},
+where @var{type} is the lowercase form of @var{ctype}
+in an exported typedef.
+
+@item ffe@var{mod}_@var{value}
+A function that does or returns something,
+as described by @var{value} (see below).
+
+@item ffe@var{mod}_@var{value}_@var{input}
+A function that does or returns something based
+primarily on the thing described by @var{input} (see below).
+@end table
+
+Below are names used for @var{value} and @var{input},
+along with their definitions.
+
+@table @code
+@item col
+A column number within a line (first column is number 1).
+
+@item file
+An encapsulation of a file's name.
+
+@item find
+Looks up an instance of some type that matches specified criteria,
+and returns that, even if it has to create a new instance or
+crash trying to find it (as appropriate).
+
+@item initialize
+Initializes, usually a module.  No type.
+
+@item int
+A generic integer of type @code{int}.
+
+@item is
+A generic integer that contains a true (nonzero) or false (zero) value.
+
+@item len
+A generic integer that contains the length of something.
+
+@item line
+A line number within a source file,
+or a global line number.
+
+@item lookup
+Looks up an instance of some type that matches specified criteria,
+and returns that, or returns nil.
+
+@item name
+A @code{text} that points to a name of something.
+
+@item new
+Makes a new instance of the indicated type.
+Might return an existing one if appropriate---if so,
+similar to @code{find} without crashing.
+
+@item pt
+Pointer to a particular character (line, column pairs)
+in the input file (source code being compiled).
+
+@item run
+Performs some herculean task.  No type.
+
+@item terminate
+Terminates, usually a module.  No type.
+
+@item text
+A @code{char *} that points to generic text.
+@end table
diff --git a/gcc/f/fini.c b/gcc/f/fini.c
new file mode 100644
index 00000000000..167837b461f
--- /dev/null
+++ b/gcc/f/fini.c
@@ -0,0 +1,772 @@
+/* fini.c
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.  */
+
+#define USE_BCONFIG
+
+#include "proj.h"
+#include "malloc.h"
+
+#undef MAXNAMELEN
+#define MAXNAMELEN 100
+
+typedef struct _name_ *name;
+
+struct _name_
+  {
+    name next;
+    name previous;
+    name next_alpha;
+    name previous_alpha;
+    int namelen;
+    int kwlen;
+    char kwname[MAXNAMELEN];
+    char name_uc[MAXNAMELEN];
+    char name_lc[MAXNAMELEN];
+    char name_ic[MAXNAMELEN];
+  };
+
+struct _name_root_
+  {
+    name first;
+    name last;
+  };
+
+struct _name_alpha_
+  {
+    name ign1;
+    name ign2;
+    name first;
+    name last;
+  };
+
+static FILE *in;
+static FILE *out;
+static char prefix[32];
+static char postfix[32];
+static char storage[32];
+static const char *const xspaces[]
+=
+{
+  "",				/* 0 */
+  " ",				/* 1 */
+  "  ",				/* 2 */
+  "   ",			/* 3 */
+  "    ",			/* 4 */
+  "     ",			/* 5 */
+  "      ",			/* 6 */
+  "       ",			/* 7 */
+  "\t",				/* 8 */
+  "\t ",			/* 9 */
+  "\t  ",			/* 10 */
+  "\t   ",			/* 11 */
+  "\t    ",			/* 12 */
+  "\t     ",			/* 13 */
+  "\t      ",			/* 14 */
+  "\t       ",			/* 15 */
+  "\t\t",			/* 16 */
+  "\t\t ",			/* 17 */
+  "\t\t  ",			/* 18 */
+  "\t\t   ",			/* 19 */
+  "\t\t    ",			/* 20 */
+  "\t\t     ",			/* 21 */
+  "\t\t      ",			/* 22 */
+  "\t\t       ",		/* 23 */
+  "\t\t\t",			/* 24 */
+  "\t\t\t ",			/* 25 */
+  "\t\t\t  ",			/* 26 */
+  "\t\t\t   ",			/* 27 */
+  "\t\t\t    ",			/* 28 */
+  "\t\t\t     ",		/* 29 */
+  "\t\t\t      ",		/* 30 */
+  "\t\t\t       ",		/* 31 */
+  "\t\t\t\t",			/* 32 */
+  "\t\t\t\t ",			/* 33 */
+  "\t\t\t\t  ",			/* 34 */
+  "\t\t\t\t   ",		/* 35 */
+  "\t\t\t\t    ",		/* 36 */
+  "\t\t\t\t     ",		/* 37 */
+  "\t\t\t\t      ",		/* 38 */
+  "\t\t\t\t       ",		/* 39 */
+  "\t\t\t\t\t",			/* 40 */
+  "\t\t\t\t\t ",		/* 41 */
+  "\t\t\t\t\t  ",		/* 42 */
+  "\t\t\t\t\t   ",		/* 43 */
+  "\t\t\t\t\t    ",		/* 44 */
+  "\t\t\t\t\t     ",		/* 45 */
+  "\t\t\t\t\t      ",		/* 46 */
+  "\t\t\t\t\t       ",		/* 47 */
+  "\t\t\t\t\t\t",		/* 48 */
+  "\t\t\t\t\t\t ",		/* 49 */
+  "\t\t\t\t\t\t  ",		/* 50 */
+  "\t\t\t\t\t\t   ",		/* 51 */
+  "\t\t\t\t\t\t    ",		/* 52 */
+  "\t\t\t\t\t\t     ",		/* 53 */
+  "\t\t\t\t\t\t      ",		/* 54 */
+  "\t\t\t\t\t\t       ",	/* 55 */
+  "\t\t\t\t\t\t\t",		/* 56 */
+  "\t\t\t\t\t\t\t ",		/* 57 */
+  "\t\t\t\t\t\t\t  ",		/* 58 */
+  "\t\t\t\t\t\t\t   ",		/* 59 */
+  "\t\t\t\t\t\t\t    ",		/* 60 */
+  "\t\t\t\t\t\t\t     ",	/* 61 */
+  "\t\t\t\t\t\t\t      ",	/* 62 */
+  "\t\t\t\t\t\t\t       ",	/* 63 */
+  "\t\t\t\t\t\t\t\t",		/* 64 */
+  "\t\t\t\t\t\t\t\t ",		/* 65 */
+  "\t\t\t\t\t\t\t\t  ",		/* 66 */
+  "\t\t\t\t\t\t\t\t   ",	/* 67 */
+  "\t\t\t\t\t\t\t\t    ",	/* 68 */
+  "\t\t\t\t\t\t\t\t     ",	/* 69 */
+  "\t\t\t\t\t\t\t\t      ",	/* 70 */
+  "\t\t\t\t\t\t\t\t       ",	/* 71 */
+  "\t\t\t\t\t\t\t\t\t",		/* 72 */
+  "\t\t\t\t\t\t\t\t\t ",	/* 73 */
+  "\t\t\t\t\t\t\t\t\t  ",	/* 74 */
+  "\t\t\t\t\t\t\t\t\t   ",	/* 75 */
+  "\t\t\t\t\t\t\t\t\t    ",	/* 76 */
+  "\t\t\t\t\t\t\t\t\t     ",	/* 77 */
+  "\t\t\t\t\t\t\t\t\t      ",	/* 78 */
+  "\t\t\t\t\t\t\t\t\t       ",	/* 79 */
+  "\t\t\t\t\t\t\t\t\t\t",	/* 80 */
+  "\t\t\t\t\t\t\t\t\t\t ",	/* 81 */
+  "\t\t\t\t\t\t\t\t\t\t  ",	/* 82 */
+  "\t\t\t\t\t\t\t\t\t\t   ",	/* 83 */
+  "\t\t\t\t\t\t\t\t\t\t    ",	/* 84 */
+  "\t\t\t\t\t\t\t\t\t\t     ",	/* 85 */
+  "\t\t\t\t\t\t\t\t\t\t      ",	/* 86 */
+  "\t\t\t\t\t\t\t\t\t\t       ",/* 87 */
+  "\t\t\t\t\t\t\t\t\t\t\t",	/* 88 */
+  "\t\t\t\t\t\t\t\t\t\t\t ",	/* 89 */
+  "\t\t\t\t\t\t\t\t\t\t\t  ",	/* 90 */
+  "\t\t\t\t\t\t\t\t\t\t\t   ",	/* 91 */
+  "\t\t\t\t\t\t\t\t\t\t\t    ",	/* 92 */
+  "\t\t\t\t\t\t\t\t\t\t\t     ",/* 93 */
+  "\t\t\t\t\t\t\t\t\t\t\t      ",	/* 94 */
+  "\t\t\t\t\t\t\t\t\t\t\t       ",	/* 95 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t",	/* 96 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t ",	/* 97 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 98 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t   ",/* 99 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 100 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 101 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 102 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 103 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t",	/* 104 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t ",/* 105 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 106 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t   ",	/* 107 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 108 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 109 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 110 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 111 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t",	/* 112 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ",	/* 113 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 114 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t   ",	/* 115 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 116 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 117 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 118 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 119 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t",	/* 120 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ",	/* 121 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 122 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t   ",	/* 123 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 124 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 125 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 126 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 127 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t",	/* 128 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ",	/* 129 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 130 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t   ",	/* 131 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 132 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 133 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 134 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 135 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t",	/* 136 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ",	/* 137 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 138 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t   ",	/* 139 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 140 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 141 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 142 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 143 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t",	/* 144 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ",	/* 145 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 146 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t   ",	/* 147 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 148 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 149 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 150 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 151 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t",	/* 152 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ",	/* 153 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 154 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t   ",	/* 155 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 156 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 157 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 158 */
+  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 159 */
+};
+
+void testname (bool nested, int indent, name first, name last);
+void testnames (bool nested, int indent, int len, name first, name last);
+
+int
+main (int argc, char **argv)
+{
+  char buf[MAXNAMELEN];
+  char last_buf[MAXNAMELEN];
+  char kwname[MAXNAMELEN];
+  char routine[32];
+  char type[32];
+  int i;
+  int count;
+  int len;
+  struct _name_root_ names[200];
+  struct _name_alpha_ names_alpha;
+  name n;
+  name newname;
+  char *input_name;
+  char *output_name;
+  char *include_name;
+  FILE *incl;
+  int fixlengths;
+  int total_length;
+  int do_name;			/* TRUE if token may be NAME. */
+  int do_names;			/* TRUE if token may be NAMES. */
+  int cc;
+  bool do_exit = FALSE;
+
+  last_buf[0] = '\0';
+  
+  for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i)
+    {				/* Initialize length/name ordered list roots. */
+      names[i].first = (name) &names[i];
+      names[i].last = (name) &names[i];
+    }
+  names_alpha.first = (name) &names_alpha;	/* Initialize name order. */
+  names_alpha.last = (name) &names_alpha;
+
+  if (argc != 4)
+    {
+      fprintf (stderr, "Command form: fini input output-code output-include\n");
+      return (1);
+    }
+
+  input_name = argv[1];
+  output_name = argv[2];
+  include_name = argv[3];
+
+  in = fopen (input_name, "r");
+  if (in == NULL)
+    {
+      fprintf (stderr, "Cannot open \"%s\"\n", input_name);
+      return (1);
+    }
+  out = fopen (output_name, "w");
+  if (out == NULL)
+    {
+      fclose (in);
+      fprintf (stderr, "Cannot open \"%s\"\n", output_name);
+      return (1);
+    }
+  incl = fopen (include_name, "w");
+  if (incl == NULL)
+    {
+      fclose (in);
+      fprintf (stderr, "Cannot open \"%s\"\n", include_name);
+      return (1);
+    }
+
+  /* Get past the initial block-style comment (man, this parsing code is just
+     _so_ lame, but I'm too lazy to improve it).  */
+
+  for (;;)
+    {
+      cc = getc (in);
+      if (cc == '{')
+	{
+	  while (((cc = getc (in)) != '}') && (cc != EOF))
+	    ;
+	}
+      else if (cc != EOF)
+	{
+	  while (((cc = getc (in)) != EOF) && (! ISALNUM (cc)))
+	    ;
+	  ungetc (cc, in);
+	  break;
+	}
+      else
+	{
+	  assert ("EOF too soon!" == NULL);
+	  return (1);
+	}
+    }
+
+  fscanf (in, "%s %s %s %s %s %d %d", prefix, postfix, storage, type, routine,
+	  &do_name, &do_names);
+
+  if (storage[0] == '\0')
+    storage[1] = '\0';
+  else
+    /* Assume string is quoted somehow, replace ending quote with space. */
+    {
+      if (storage[2] == '\0')
+	storage[1] = '\0';
+      else
+	storage[strlen (storage) - 1] = ' ';
+    }
+
+  if (postfix[0] == '\0')
+    postfix[1] = '\0';
+  else				/* Assume string is quoted somehow, strip off
+				   ending quote. */
+    postfix[strlen (postfix) - 1] = '\0';
+
+  for (i = 1; storage[i] != '\0'; ++i)
+    storage[i - 1] = storage[i];
+  storage[i - 1] = '\0';
+
+  for (i = 1; postfix[i] != '\0'; ++i)
+    postfix[i - 1] = postfix[i];
+  postfix[i - 1] = '\0';
+
+  fixlengths = strlen (prefix) + strlen (postfix);
+
+  while (TRUE)
+    {
+      count = fscanf (in, "%s %s", buf, kwname);
+      if (count == EOF)
+	break;
+      len = strlen (buf);
+      if (len == 0)
+	continue;		/* Skip empty lines. */
+      if (buf[0] == ';')
+	continue;		/* Skip commented-out lines. */
+      for (i = strlen (buf) - 1; i > 0; --i)
+	cc = buf[i];
+
+      /* Make new name object to store name and its keyword. */
+
+      newname = xmalloc (sizeof (*newname));
+      newname->namelen = strlen (buf);
+      newname->kwlen = strlen (kwname);
+      total_length = newname->kwlen + fixlengths;
+      if (total_length >= 32)	/* Else resulting keyword name too long. */
+	{
+	  fprintf (stderr, "%s: %s%s%s is 31+%d chars long\n", input_name,
+		   prefix, kwname, postfix, total_length - 31);
+	  do_exit = TRUE;
+	}
+      strcpy (newname->kwname, kwname);
+      for (i = 0; i < newname->namelen; ++i)
+	{
+	  cc = buf[i];
+	  newname->name_uc[i] = TOUPPER (cc);
+	  newname->name_lc[i] = TOLOWER (cc);
+	  newname->name_ic[i] = cc;
+	}
+      newname->name_uc[i] = newname->name_lc[i] = newname->name_ic[i] = '\0';
+
+      /* Warn user if names aren't alphabetically ordered. */
+
+      if ((last_buf[0] != '\0')
+	  && (strcmp (last_buf, newname->name_uc) >= 0))
+	{
+	  fprintf (stderr, "%s: \"%s\" precedes \"%s\"\n", input_name,
+		   last_buf, newname->name_uc);
+	  do_exit = TRUE;
+	}
+      strcpy (last_buf, newname->name_uc);
+
+      /* Append name to end of alpha-sorted list (assumes names entered in
+	 alpha order wrt name, not kwname, even though kwname is output from
+	 this list). */
+
+      n = names_alpha.last;
+      newname->next_alpha = n->next_alpha;
+      newname->previous_alpha = n;
+      n->next_alpha->previous_alpha = newname;
+      n->next_alpha = newname;
+
+      /* Insert name in appropriate length/name ordered list. */
+
+      n = (name) &names[len];
+      while ((n->next != (name) &names[len])
+	     && (strcmp (buf, n->next->name_uc) > 0))
+	n = n->next;
+      if (strcmp (buf, n->next->name_uc) == 0)
+	{
+	  fprintf (stderr, "%s: extraneous \"%s\"\n", input_name, buf);
+	  do_exit = TRUE;
+	}
+      newname->next = n->next;
+      newname->previous = n;
+      n->next->previous = newname;
+      n->next = newname;
+    }
+
+#if 0
+  for (len = 0; len < ARRAY_SIZE (name); ++len)
+    {
+      if (names[len].first == (name) &names[len])
+	continue;
+      printf ("Length %d:\n", len);
+      for (n = names[len].first; n != (name) &names[len]; n = n->next)
+	printf ("    %s %s %s\n", n->name_uc, n->name_lc, n->name_ic);
+    }
+#endif
+
+  if (do_exit)
+    return (1);
+
+  /* First output the #include file. */
+
+  for (n = names_alpha.first; n != (name) &names_alpha; n = n->next_alpha)
+    {
+      fprintf (incl, "#define %sl%s%s %d\n", prefix, n->kwname, postfix,
+	       n->namelen);
+    }
+
+  fprintf (incl,
+	   "\
+\n\
+enum %s_\n\
+{\n\
+%sNone%s,\n\
+",
+	   type, prefix, postfix);
+
+  for (n = names_alpha.first; n != (name) &names_alpha; n = n->next_alpha)
+    {
+      fprintf (incl,
+	       "\
+%s%s%s,\n\
+",
+	       prefix, n->kwname, postfix);
+    }
+
+  fprintf (incl,
+	   "\
+%s%s\n\
+};\n\
+typedef enum %s_ %s;\n\
+",
+	   prefix, postfix, type, type);
+
+  /* Now output the C program. */
+
+  fprintf (out,
+	   "\
+%s%s\n\
+%s (ffelexToken t)\n\
+%c\n\
+  char *p;\n\
+  int c;\n\
+\n\
+  p = ffelex_token_text (t);\n\
+\n\
+",
+	   storage, type, routine, '{');
+
+  if (do_name)
+    {
+      if (do_names)
+	fprintf (out,
+		 "\
+  if (ffelex_token_type (t) == FFELEX_typeNAME)\n\
+    {\n\
+      switch (ffelex_token_length (t))\n\
+\t{\n\
+"
+	  );
+      else
+	fprintf (out,
+		 "\
+  assert (ffelex_token_type (t) == FFELEX_typeNAME);\n\
+\n\
+  switch (ffelex_token_length (t))\n\
+    {\n\
+"
+	  );
+
+/* Now output the length as a case, followed by the binary search within that length.  */
+
+      for (len = 0; ((size_t) len) < ARRAY_SIZE (names); ++len)
+	{
+	  if (names[len].first != (name) &names[len])
+	    {
+	      if (do_names)
+		fprintf (out,
+			 "\
+\tcase %d:\n\
+",
+			 len);
+	      else
+		fprintf (out,
+			 "\
+    case %d:\n\
+",
+			 len);
+	      testname (FALSE, do_names ? 10 : 6, names[len].first, names[len].last);
+	      if (do_names)
+		fprintf (out,
+			 "\
+\t  break;\n\
+"
+		  );
+	      else
+		fprintf (out,
+			 "\
+      break;\n\
+"
+		  );
+	    }
+	}
+
+      if (do_names)
+	fprintf (out,
+		 "\
+\t}\n\
+      return %sNone%s;\n\
+    }\n\
+\n\
+",
+		 prefix, postfix);
+      else
+	fprintf (out,
+		 "\
+    }\n\
+\n\
+  return %sNone%s;\n\
+}\n\
+",
+		 prefix, postfix);
+    }
+
+  if (do_names)
+    {
+      fputs ("\
+  assert (ffelex_token_type (t) == FFELEX_typeNAMES);\n\
+\n\
+  switch (ffelex_token_length (t))\n\
+    {\n\
+    default:\n\
+",
+	     out);
+
+      /* Find greatest non-empty length list. */
+
+      for (len = ARRAY_SIZE (names) - 1;
+	   names[len].first == (name) &names[len];
+	   --len)
+	;
+
+/* Now output the length as a case, followed by the binary search within that length. */
+
+      if (len > 0)
+	{
+	  for (; len != 0; --len)
+	    {
+	      fprintf (out,
+		       "\
+    case %d:\n\
+",
+		       len);
+	      if (names[len].first != (name) &names[len])
+		testnames (FALSE, 6, len, names[len].first, names[len].last);
+	    }
+	  if (names[1].first == (name) &names[1])
+	    fprintf (out,
+		     "\
+      ;\n\
+"
+	      );		/* Need empty statement after an empty case
+				   1:  */
+	}
+
+      fprintf (out,
+	       "\
+    }\n\
+\n\
+  return %sNone%s;\n\
+}\n\
+",
+	       prefix, postfix);
+    }
+
+  if (out != stdout)
+    fclose (out);
+  if (incl != stdout)
+    fclose (incl);
+  if (in != stdin)
+    fclose (in);
+  return (0);
+}
+
+void
+testname (bool nested, int indent, name first, name last)
+{
+  name n;
+  name nhalf;
+  int num;
+  int numhalf;
+
+  assert (!nested || indent >= 2);
+  assert (((size_t) indent) + 4 < ARRAY_SIZE (xspaces));
+
+  num = 0;
+  numhalf = 0;
+  for (n = first, nhalf = first; n != last->next; n = n->next)
+    {
+      if ((++num & 1) == 0)
+	{
+	  nhalf = nhalf->next;
+	  ++numhalf;
+	}
+    }
+
+  if (nested)
+    fprintf (out,
+	     "\
+%s{\n\
+",
+	     xspaces[indent - 2]);
+
+  fprintf (out,
+	   "\
+%sif ((c = ffesrc_strcmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\")) == 0)\n\
+%sreturn %s%s%s;\n\
+",
+	   xspaces[indent], nhalf->name_uc, nhalf->name_lc, nhalf->name_ic,
+	   xspaces[indent + 2], prefix, nhalf->kwname, postfix);
+
+  if (num != 1)
+    {
+      fprintf (out,
+	       "\
+%selse if (c < 0)\n\
+",
+	       xspaces[indent]);
+
+      if (numhalf == 0)
+	fprintf (out,
+		 "\
+%s;\n\
+",
+		 xspaces[indent + 2]);
+      else
+	testname (TRUE, indent + 4, first, nhalf->previous);
+
+      if (num - numhalf > 1)
+	{
+	  fprintf (out,
+		   "\
+%selse\n\
+",
+		   xspaces[indent]);
+
+	  testname (TRUE, indent + 4, nhalf->next, last);
+	}
+    }
+
+  if (nested)
+    fprintf (out,
+	     "\
+%s}\n\
+",
+	     xspaces[indent - 2]);
+}
+
+void
+testnames (bool nested, int indent, int len, name first, name last)
+{
+  name n;
+  name nhalf;
+  int num;
+  int numhalf;
+
+  assert (!nested || indent >= 2);
+  assert (((size_t) indent) + 4 < ARRAY_SIZE (xspaces));
+
+  num = 0;
+  numhalf = 0;
+  for (n = first, nhalf = first; n != last->next; n = n->next)
+    {
+      if ((++num & 1) == 0)
+	{
+	  nhalf = nhalf->next;
+	  ++numhalf;
+	}
+    }
+
+  if (nested)
+    fprintf (out,
+	     "\
+%s{\n\
+",
+	     xspaces[indent - 2]);
+
+  fprintf (out,
+	   "\
+%sif ((c = ffesrc_strncmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\", %d)) == 0)\n\
+%sreturn %s%s%s;\n\
+",
+	   xspaces[indent], nhalf->name_uc, nhalf->name_lc, nhalf->name_ic,
+	   len, xspaces[indent + 2], prefix, nhalf->kwname, postfix);
+
+  if (num != 1)
+    {
+      fprintf (out,
+	       "\
+%selse if (c < 0)\n\
+",
+	       xspaces[indent]);
+
+      if (numhalf == 0)
+	fprintf (out,
+		 "\
+%s;\n\
+",
+		 xspaces[indent + 2]);
+      else
+	testnames (TRUE, indent + 4, len, first, nhalf->previous);
+
+      if (num - numhalf > 1)
+	{
+	  fprintf (out,
+		   "\
+%selse\n\
+",
+		   xspaces[indent]);
+
+	  testnames (TRUE, indent + 4, len, nhalf->next, last);
+	}
+    }
+
+  if (nested)
+    fprintf (out,
+	     "\
+%s}\n\
+",
+	     xspaces[indent - 2]);
+}
diff --git a/gcc/f/g77.texi b/gcc/f/g77.texi
new file mode 100644
index 00000000000..3d5f83d3da6
--- /dev/null
+++ b/gcc/f/g77.texi
@@ -0,0 +1,11848 @@
+\input texinfo  @c -*-texinfo-*-
+@c %**start of header
+@setfilename g77.info
+
+@set last-update 2004-03-21
+@set copyrights-g77 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004
+
+@include root.texi
+
+@c This tells @include'd files that they're part of the overall G77 doc
+@c set.  (They might be part of a higher-level doc set too.)
+@set DOC-G77
+
+@c @setfilename useg77.info
+@c @setfilename portg77.info
+@c To produce the full manual, use the "g77.info" setfilename, and
+@c make sure the following do NOT begin with '@c' (and the @clear lines DO)
+@set INTERNALS
+@set USING
+@c To produce a user-only manual, use the "useg77.info" setfilename, and
+@c make sure the following does NOT begin with '@c':
+@c @clear INTERNALS
+@c To produce a porter-only manual, use the "portg77.info" setfilename,
+@c and make sure the following does NOT begin with '@c':
+@c @clear USING
+
+@ifset INTERNALS
+@ifset USING
+@settitle Using and Porting GNU Fortran
+@end ifset
+@end ifset
+@c seems reasonable to assume at least one of INTERNALS or USING is set...
+@ifclear INTERNALS
+@settitle Using GNU Fortran
+@end ifclear
+@ifclear USING
+@settitle Porting GNU Fortran
+@end ifclear
+@c then again, have some fun
+@ifclear INTERNALS
+@ifclear USING
+@settitle Doing Squat with GNU Fortran
+@end ifclear
+@end ifclear
+
+@syncodeindex fn cp
+@syncodeindex vr cp
+@c %**end of header
+
+@c Cause even numbered pages to be printed on the left hand side of
+@c the page and odd numbered pages to be printed on the right hand
+@c side of the page.  Using this, you can print on both sides of a
+@c sheet of paper and have the text on the same part of the sheet.
+
+@c The text on right hand pages is pushed towards the right hand
+@c margin and the text on left hand pages is pushed toward the left
+@c hand margin.
+@c (To provide the reverse effect, set bindingoffset to -0.75in.)
+
+@c @tex
+@c \global\bindingoffset=0.75in
+@c \global\normaloffset =0.75in
+@c @end tex
+
+@copying
+Copyright @copyright{} @value{copyrights-g77} Free Software Foundation, Inc.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.2 or
+any later version published by the Free Software Foundation; with the
+Invariant Sections being ``GNU General Public License'' and ``Funding
+Free Software'', the Front-Cover
+texts being (a) (see below), and with the Back-Cover Texts being (b)
+(see below).  A copy of the license is included in the section entitled
+``GNU Free Documentation License''.
+
+(a) The FSF's Front-Cover Text is:
+
+     A GNU Manual
+
+(b) The FSF's Back-Cover Text is:
+
+     You have freedom to copy and modify this GNU Manual, like GNU
+     software.  Copies published by the Free Software Foundation raise
+     funds for GNU development.
+@end copying
+
+@ifinfo
+@dircategory Programming
+@direntry
+* g77: (g77).                  The GNU Fortran compiler.
+@end direntry
+@ifset INTERNALS
+@ifset USING
+This file documents the use and the internals of the GNU Fortran (@command{g77})
+compiler.
+It corresponds to the @value{which-g77} version of @command{g77}.
+@end ifset
+@end ifset
+@ifclear USING
+This file documents the internals of the GNU Fortran (@command{g77}) compiler.
+It corresponds to the @value{which-g77} version of @command{g77}.
+@end ifclear
+@ifclear INTERNALS
+This file documents the use of the GNU Fortran (@command{g77}) compiler.
+It corresponds to the @value{which-g77} version of @command{g77}.
+@end ifclear
+
+Published by the Free Software Foundation
+59 Temple Place - Suite 330
+Boston, MA 02111-1307 USA
+
+@insertcopying
+@end ifinfo
+
+Contributed by James Craig Burley (@email{@value{email-burley}}).
+Inspired by a first pass at translating @file{g77-0.5.16/f/DOC} that
+was contributed to Craig by David Ronis (@email{ronis@@onsager.chem.mcgill.ca}).
+
+@setchapternewpage odd
+@titlepage
+@ifset INTERNALS
+@ifset USING
+@center @titlefont{Using and Porting GNU Fortran}
+
+@end ifset
+@end ifset
+@ifclear INTERNALS
+@title Using GNU Fortran
+@end ifclear
+@ifclear USING
+@title Porting GNU Fortran
+@end ifclear
+@sp 2
+@center James Craig Burley
+@sp 3
+@center Last updated @value{last-update}
+@sp 1
+@center for version @value{which-g77}
+@page
+@vskip 0pt plus 1filll
+For the @value{which-g77} Version*
+@sp 1
+Published by the Free Software Foundation @*
+59 Temple Place - Suite 330@*
+Boston, MA 02111-1307, USA@*
+@c Last printed ??ber, 19??.@*
+@c Printed copies are available for $? each.@*
+@c ISBN ???
+@sp 1
+@insertcopying
+@end titlepage
+@summarycontents
+@contents
+@page
+
+@node Top, Copying,, (DIR)
+@top Introduction
+@cindex Introduction
+
+@ifset INTERNALS
+@ifset USING
+This manual documents how to run, install and port @command{g77},
+as well as its new features and incompatibilities,
+and how to report bugs.
+It corresponds to the @value{which-g77} version of @command{g77}.
+@end ifset
+@end ifset
+
+@ifclear INTERNALS
+This manual documents how to run and install @command{g77},
+as well as its new features and incompatibilities, and how to report
+bugs.
+It corresponds to the @value{which-g77} version of @command{g77}.
+@end ifclear
+@ifclear USING
+This manual documents how to port @command{g77},
+as well as its new features and incompatibilities,
+and how to report bugs.
+It corresponds to the @value{which-g77} version of @command{g77}.
+@end ifclear
+
+@ifset DEVELOPMENT
+@emph{Warning:} This document is still under development,
+and might not accurately reflect the @command{g77} code base
+of which it is a part.
+Efforts are made to keep it somewhat up-to-date,
+but they are particularly concentrated
+on any version of this information
+that is distributed as part of a @emph{released} @command{g77}.
+
+In particular, while this document is intended to apply to
+the @value{which-g77} version of @command{g77},
+only an official @emph{release} of that version
+is expected to contain documentation that is
+most consistent with the @command{g77} product in that version.
+@end ifset
+
+@menu
+* Copying::         GNU General Public License says
+                    how you can copy and share GNU Fortran.
+* GNU Free Documentation License::
+		    How you can copy and share this manual.
+* Contributors::    People who have contributed to GNU Fortran.
+* Funding::         How to help assure continued work for free software.
+* Funding GNU Fortran::  How to help assure continued work on GNU Fortran.
+@ifset USING
+* Getting Started:: Finding your way around this manual.
+* What is GNU Fortran?::  How @command{g77} fits into the universe.
+* G77 and GCC::     You can compile Fortran, C, or other programs.
+* Invoking G77::    Command options supported by @command{g77}.
+* News::            News about recent releases of @command{g77}.
+* Changes::         User-visible changes to recent releases of @command{g77}.
+* Language::        The GNU Fortran language.
+* Compiler::        The GNU Fortran compiler.
+* Other Dialects::  Dialects of Fortran supported by @command{g77}.
+* Other Compilers:: Fortran compilers other than @command{g77}.
+* Other Languages:: Languages other than Fortran.
+* Debugging and Interfacing::  How @command{g77} generates code.
+* Collected Fortran Wisdom::  How to avoid Trouble.
+* Trouble::         If you have trouble with GNU Fortran.
+* Open Questions::  Things we'd like to know.
+* Bugs::            How, why, and where to report bugs.
+* Service::         How to find suppliers of support for GNU Fortran.
+@end ifset
+@ifset INTERNALS
+* Adding Options::  Guidance on teaching @command{g77} about new options.
+* Projects::        Projects for @command{g77} internals hackers.
+* Front End::       Design and implementation of the @command{g77} front end.
+@end ifset
+
+* M: Diagnostics.   Diagnostics produced by @command{g77}.
+
+* Keyword Index::   Index of concepts and symbol names.
+@end menu
+@c yes, the "M: " @emph{is} intentional -- bad.def references it (CMPAMBIG)!
+
+@include gpl.texi
+
+@include fdl.texi
+
+@node Contributors
+@unnumbered Contributors to GNU Fortran
+@cindex contributors
+@cindex credits
+
+In addition to James Craig Burley, who wrote the front end,
+many people have helped create and improve GNU Fortran.
+
+@itemize @bullet
+@item
+The packaging and compiler portions of GNU Fortran are based largely
+on the GCC compiler.
+@xref{Contributors,,Contributors to GCC,gcc,Using the GNU Compiler
+Collection (GCC)},
+for more information.
+
+@item
+The run-time library used by GNU Fortran is a repackaged version
+of the @code{libf2c} library (combined from the @code{libF77} and
+@code{libI77} libraries) provided as part of @command{f2c}, available for
+free from @code{netlib} sites on the Internet.
+
+@item
+Cygnus Support and The Free Software Foundation contributed
+significant money and/or equipment to Craig's efforts.
+
+@item
+The following individuals served as alpha testers prior to @command{g77}'s
+public release.  This work consisted of testing, researching, sometimes
+debugging, and occasionally providing small amounts of code and fixes
+for @command{g77}, plus offering plenty of helpful advice to Craig:
+
+@itemize @w{}
+@item
+Jonathan Corbet
+@item
+Dr.@: Mark Fernyhough
+@item
+Takafumi Hayashi (The University of Aizu)---@email{takafumi@@u-aizu.ac.jp}
+@item
+Kate Hedstrom
+@item
+Michel Kern (INRIA and Rice University)---@email{Michel.Kern@@inria.fr}
+@item
+Dr.@: A. O. V. Le Blanc
+@item
+Dave Love
+@item
+Rick Lutowski
+@item
+Toon Moene
+@item
+Rick Niles
+@item
+Derk Reefman
+@item
+Wayne K. Schroll
+@item
+Bill Thorson
+@item
+Pedro A. M. Vazquez
+@item
+Ian Watson
+@end itemize
+
+@item
+Dave Love (@email{d.love@@dl.ac.uk})
+wrote the libU77 part of the run-time library.
+
+@item
+Scott Snyder (@email{snyder@@d0sgif.fnal.gov})
+provided the patch to add rudimentary support
+for @code{INTEGER*1}, @code{INTEGER*2}, and
+@code{LOGICAL*1}.
+This inspired Craig to add further support,
+even though the resulting support
+would still be incomplete.
+This support is believed to be completed at version 3.4
+of @command{gcc} by Roger Sayle (@email{roger@@eyesopen.com}).
+
+@item
+David Ronis (@email{ronis@@onsager.chem.mcgill.ca}) inspired
+and encouraged Craig to rewrite the documentation in texinfo
+format by contributing a first pass at a translation of the
+old @file{g77-0.5.16/f/DOC} file.
+
+@item
+Toon Moene (@email{toon@@moene.indiv.nluug.nl}) performed
+some analysis of generated code as part of an overall project
+to improve @command{g77} code generation to at least be as good
+as @command{f2c} used in conjunction with @command{gcc}.
+So far, this has resulted in the three, somewhat
+experimental, options added by @command{g77} to the @command{gcc}
+compiler and its back end.
+
+(These, in turn, had made their way into the @code{egcs}
+version of the compiler, and do not exist in @command{gcc}
+version 2.8 or versions of @command{g77} based on that version
+of @command{gcc}.)
+
+@item
+John Carr (@email{jfc@@mit.edu}) wrote the alias analysis improvements.
+
+@item
+Thanks to Mary Cortani and the staff at Craftwork Solutions
+(@email{support@@craftwork.com}) for all of their support.
+
+@item
+Many other individuals have helped debug, test, and improve @command{g77}
+over the past several years, and undoubtedly more people
+will be doing so in the future.
+If you have done so, and would like
+to see your name listed in the above list, please ask!
+The default is that people wish to remain anonymous.
+@end itemize
+
+@include funding.texi
+
+@node Funding GNU Fortran
+@chapter Funding GNU Fortran
+@cindex funding improvements
+@cindex improvements, funding
+
+James Craig Burley (@email{@value{email-burley}}), the original author
+of @command{g77}, stopped working on it in September 1999
+(He has a web page at @uref{@value{www-burley}}.)
+
+GNU Fortran is currently maintained by Toon Moene
+(@email{toon@@moene.indiv.nluug.nl}), with the help of countless other
+volunteers.
+
+As with other GNU software, funding is important because it can pay for
+needed equipment, personnel, and so on.
+
+@cindex FSF, funding the
+@cindex funding the FSF
+The FSF provides information on the best way to fund ongoing
+development of GNU software (such as GNU Fortran) in documents
+such as the ``GNUS Bulletin''.
+Email @email{gnu@@gnu.org} for information on funding the FSF.
+
+Another important way to support work on GNU Fortran is to volunteer
+to help out.
+
+Email @email{@value{email-general}} to volunteer for this work.
+
+However, we strongly expect that there will never be a version 0.6
+of @command{g77}.  Work on this compiler has stopped as of the release
+of GCC 3.1, except for bug fixing.  @command{g77} will be succeeded by
+@command{g95} - see @uref{http://g95.sourceforge.net}.
+
+@xref{Funding,,Funding Free Software}, for more information.
+
+@node Getting Started
+@chapter Getting Started
+@cindex getting started
+@cindex new users
+@cindex newbies
+@cindex beginners
+
+If you don't need help getting started reading the portions
+of this manual that are most important to you, you should skip
+this portion of the manual.
+
+If you are new to compilers, especially Fortran compilers, or
+new to how compilers are structured under UNIX and UNIX-like
+systems, you'll want to see @ref{What is GNU Fortran?}.
+
+If you are new to GNU compilers, or have used only one GNU
+compiler in the past and not had to delve into how it lets
+you manage various versions and configurations of @command{gcc},
+you should see @ref{G77 and GCC}.
+
+Everyone except experienced @command{g77} users should
+see @ref{Invoking G77}.
+
+If you're acquainted with previous versions of @command{g77},
+you should see @ref{News,,News About GNU Fortran}.
+Further, if you've actually used previous versions of @command{g77},
+especially if you've written or modified Fortran code to
+be compiled by previous versions of @command{g77}, you
+should see @ref{Changes}.
+
+If you intend to write or otherwise compile code that is
+not already strictly conforming ANSI FORTRAN 77---and this
+is probably everyone---you should see @ref{Language}.
+
+If you run into trouble getting Fortran code to compile,
+link, run, or work properly, you might find answers
+if you see @ref{Debugging and Interfacing},
+see @ref{Collected Fortran Wisdom},
+and see @ref{Trouble}.
+You might also find that the problems you are encountering
+are bugs in @command{g77}---see @ref{Bugs}, for information on
+reporting them, after reading the other material.
+
+If you need further help with @command{g77}, or with
+freely redistributable software in general,
+see @ref{Service}.
+
+If you would like to help the @command{g77} project,
+see @ref{Funding GNU Fortran}, for information on
+helping financially, and see @ref{Projects}, for information
+on helping in other ways.
+
+If you're generally curious about the future of
+@command{g77}, see @ref{Projects}.
+If you're curious about its past,
+see @ref{Contributors},
+and see @ref{Funding GNU Fortran}.
+
+To see a few of the questions maintainers of @command{g77} have,
+and that you might be able to answer,
+see @ref{Open Questions}.
+
+@ifset USING
+@node What is GNU Fortran?
+@chapter What is GNU Fortran?
+@cindex concepts, basic
+@cindex basic concepts
+
+GNU Fortran, or @command{g77}, is designed initially as a free replacement
+for, or alternative to, the UNIX @command{f77} command.
+(Similarly, @command{gcc} is designed as a replacement
+for the UNIX @command{cc} command.)
+
+@command{g77} also is designed to fit in well with the other
+fine GNU compilers and tools.
+
+Sometimes these design goals conflict---in such cases, resolution
+often is made in favor of fitting in well with Project GNU.
+These cases are usually identified in the appropriate
+sections of this manual.
+
+@cindex compilers
+As compilers, @command{g77}, @command{gcc}, and @command{f77}
+share the following characteristics:
+
+@itemize @bullet
+@cindex source code
+@cindex file, source
+@cindex code, source
+@cindex source file
+@item
+They read a user's program, stored in a file and
+containing instructions written in the appropriate
+language (Fortran, C, and so on).
+This file contains @dfn{source code}.
+
+@cindex translation of user programs
+@cindex machine code
+@cindex code, machine
+@cindex mistakes
+@item
+They translate the user's program into instructions
+a computer can carry out more quickly than it takes
+to translate the instructions in the first place.
+These instructions are called @dfn{machine code}---code
+designed to be efficiently translated and processed
+by a machine such as a computer.
+Humans usually aren't as good writing machine code
+as they are at writing Fortran or C, because
+it is easy to make tiny mistakes writing machine code.
+When writing Fortran or C, it is easy
+to make big mistakes.
+
+@cindex debugger
+@cindex bugs, finding
+@cindex @command{gdb}, command
+@cindex commands, @command{gdb}
+@item
+They provide information in the generated machine code
+that can make it easier to find bugs in the program
+(using a debugging tool, called a @dfn{debugger},
+such as @command{gdb}).
+
+@cindex libraries
+@cindex linking
+@cindex @command{ld} command
+@cindex commands, @command{ld}
+@item
+They locate and gather machine code already generated
+to perform actions requested by statements in
+the user's program.
+This machine code is organized
+into @dfn{libraries} and is located and gathered
+during the @dfn{link} phase of the compilation
+process.
+(Linking often is thought of as a separate
+step, because it can be directly invoked via the
+@command{ld} command.
+However, the @command{g77} and @command{gcc}
+commands, as with most compiler commands, automatically
+perform the linking step by calling on @command{ld}
+directly, unless asked to not do so by the user.)
+
+@cindex language, incorrect use of
+@cindex incorrect use of language
+@item
+They attempt to diagnose cases where the user's
+program contains incorrect usages of the language.
+The @dfn{diagnostics} produced by the compiler
+indicate the problem and the location in the user's
+source file where the problem was first noticed.
+The user can use this information to locate and
+fix the problem.
+@cindex diagnostics, incorrect
+@cindex incorrect diagnostics
+@cindex error messages, incorrect
+@cindex incorrect error messages
+(Sometimes an incorrect usage
+of the language leads to a situation where the
+compiler can no longer make any sense of what
+follows---while a human might be able to---and
+thus ends up complaining about many ``problems''
+it encounters that, in fact, stem from just one
+problem, usually the first one reported.)
+
+@cindex warnings
+@cindex questionable instructions
+@item
+They attempt to diagnose cases where the user's
+program contains a correct usage of the language,
+but instructs the computer to do something questionable.
+These diagnostics often are in the form of @dfn{warnings},
+instead of the @dfn{errors} that indicate incorrect
+usage of the language.
+@end itemize
+
+How these actions are performed is generally under the
+control of the user.
+Using command-line options, the user can specify
+how persnickety the compiler is to be regarding
+the program (whether to diagnose questionable usage
+of the language), how much time to spend making
+the generated machine code run faster, and so on.
+
+@cindex components of @command{g77}
+@cindex @command{g77}, components of
+@command{g77} consists of several components:
+
+@cindex @command{gcc}, command
+@cindex commands, @command{gcc}
+@itemize @bullet
+@item
+A modified version of the @command{gcc} command, which also might be
+installed as the system's @command{cc} command.
+(In many cases, @command{cc} refers to the
+system's ``native'' C compiler, which
+might be a non-GNU compiler, or an older version
+of @command{gcc} considered more stable or that is
+used to build the operating system kernel.)
+
+@cindex @command{g77}, command
+@cindex commands, @command{g77}
+@item
+The @command{g77} command itself, which also might be installed as the
+system's @command{f77} command.
+
+@cindex libg2c library
+@cindex libf2c library
+@cindex libraries, libf2c
+@cindex libraries, libg2c
+@cindex run-time, library
+@item
+The @code{libg2c} run-time library.
+This library contains the machine code needed to support
+capabilities of the Fortran language that are not directly
+provided by the machine code generated by the @command{g77}
+compilation phase.
+
+@code{libg2c} is just the unique name @command{g77} gives
+to its version of @code{libf2c} to distinguish it from
+any copy of @code{libf2c} installed from @command{f2c}
+(or versions of @command{g77} that built @code{libf2c} under
+that same name)
+on the system.
+
+The maintainer of @code{libf2c} currently is
+@email{dmg@@bell-labs.com}.
+
+@cindex @code{f771}, program
+@cindex programs, @code{f771}
+@cindex assembler
+@cindex @command{as} command
+@cindex commands, @command{as}
+@cindex assembly code
+@cindex code, assembly
+@item
+The compiler itself, internally named @code{f771}.
+
+Note that @code{f771} does not generate machine code directly---it
+generates @dfn{assembly code} that is a more readable form
+of machine code, leaving the conversion to actual machine code
+to an @dfn{assembler}, usually named @command{as}.
+@end itemize
+
+@command{gcc} is often thought of as ``the C compiler'' only,
+but it does more than that.
+Based on command-line options and the names given for files
+on the command line, @command{gcc} determines which actions to perform, including
+preprocessing, compiling (in a variety of possible languages), assembling,
+and linking.
+
+@cindex driver, gcc command as
+@cindex @command{gcc}, command as driver
+@cindex executable file
+@cindex files, executable
+@cindex cc1 program
+@cindex programs, cc1
+@cindex preprocessor
+@cindex cpp program
+@cindex programs, cpp
+For example, the command @samp{gcc foo.c} @dfn{drives} the file
+@file{foo.c} through the preprocessor @command{cpp}, then
+the C compiler (internally named
+@code{cc1}), then the assembler (usually @command{as}), then the linker
+(@command{ld}), producing an executable program named @file{a.out} (on
+UNIX systems).
+
+@cindex cc1plus program
+@cindex programs, cc1plus
+As another example, the command @samp{gcc foo.cc} would do much the same as
+@samp{gcc foo.c}, but instead of using the C compiler named @code{cc1},
+@command{gcc} would use the C++ compiler (named @code{cc1plus}).
+
+@cindex @code{f771}, program
+@cindex programs, @code{f771}
+In a GNU Fortran installation, @command{gcc} recognizes Fortran source
+files by name just like it does C and C++ source files.
+It knows to use the Fortran compiler named @code{f771}, instead of
+@code{cc1} or @code{cc1plus}, to compile Fortran files.
+
+@cindex @command{gcc}, not recognizing Fortran source
+@cindex unrecognized file format
+@cindex file format not recognized
+Non-Fortran-related operation of @command{gcc} is generally
+unaffected by installing the GNU Fortran version of @command{gcc}.
+However, without the installed version of @command{gcc} being the
+GNU Fortran version, @command{gcc} will not be able to compile
+and link Fortran programs---and since @command{g77} uses @command{gcc}
+to do most of the actual work, neither will @command{g77}!
+
+@cindex @command{g77}, command
+@cindex commands, @command{g77}
+The @command{g77} command is essentially just a front-end for
+the @command{gcc} command.
+Fortran users will normally use @command{g77} instead of @command{gcc},
+because @command{g77}
+knows how to specify the libraries needed to link with Fortran programs
+(@code{libg2c} and @code{lm}).
+@command{g77} can still compile and link programs and
+source files written in other languages, just like @command{gcc}.
+
+@cindex printing version information
+@cindex version information, printing
+The command @samp{g77 -v} is a quick
+way to display lots of version information for the various programs
+used to compile a typical preprocessed Fortran source file---this
+produces much more output than @samp{gcc -v} currently does.
+(If it produces an error message near the end of the output---diagnostics
+from the linker, usually @command{ld}---you might
+have an out-of-date @code{libf2c} that improperly handles
+complex arithmetic.)
+In the output of this command, the line beginning @samp{GNU Fortran Front
+End} identifies the version number of GNU Fortran; immediately
+preceding that line is a line identifying the version of @command{gcc}
+with which that version of @command{g77} was built.
+
+@cindex libf2c library
+@cindex libraries, libf2c
+The @code{libf2c} library is distributed with GNU Fortran for
+the convenience of its users, but is not part of GNU Fortran.
+It contains the procedures
+needed by Fortran programs while they are running.
+
+@cindex in-line code
+@cindex code, in-line
+For example, while code generated by @command{g77} is likely
+to do additions, subtractions, and multiplications @dfn{in line}---in
+the actual compiled code---it is not likely to do trigonometric
+functions this way.
+
+Instead, operations like trigonometric
+functions are compiled by the @code{f771} compiler
+(invoked by @command{g77} when compiling Fortran code) into machine
+code that, when run, calls on functions in @code{libg2c}, so
+@code{libg2c} must be linked with almost every useful program
+having any component compiled by GNU Fortran.
+(As mentioned above, the @command{g77} command takes
+care of all this for you.)
+
+The @code{f771} program represents most of what is unique to GNU Fortran.
+While much of the @code{libg2c} component comes from
+the @code{libf2c} component of @command{f2c},
+a free Fortran-to-C converter distributed by Bellcore (AT&T),
+plus @code{libU77}, provided by Dave Love,
+and the @command{g77} command is just a small front-end to @command{gcc},
+@code{f771} is a combination of two rather
+large chunks of code.
+
+@cindex GNU Back End (GBE)
+@cindex GBE
+@cindex @command{gcc}, back end
+@cindex back end, gcc
+@cindex code generator
+One chunk is the so-called @dfn{GNU Back End}, or GBE,
+which knows how to generate fast code for a wide variety of processors.
+The same GBE is used by the C, C++, and Fortran compiler programs @code{cc1},
+@code{cc1plus}, and @code{f771}, plus others.
+Often the GBE is referred to as the ``gcc back end'' or
+even just ``gcc''---in this manual, the term GBE is used
+whenever the distinction is important.
+
+@cindex GNU Fortran Front End (FFE)
+@cindex FFE
+@cindex @command{g77}, front end
+@cindex front end, @command{g77}
+The other chunk of @code{f771} is the
+majority of what is unique about GNU Fortran---the code that knows how
+to interpret Fortran programs to determine what they are intending to
+do, and then communicate that knowledge to the GBE for actual compilation
+of those programs.
+This chunk is called the @dfn{Fortran Front End} (FFE).
+The @code{cc1} and @code{cc1plus} programs have their own front ends,
+for the C and C++ languages, respectively.
+These fronts ends are responsible for diagnosing
+incorrect usage of their respective languages by the
+programs the process, and are responsible for most of
+the warnings about questionable constructs as well.
+(The GBE handles producing some warnings, like those
+concerning possible references to undefined variables.)
+
+Because so much is shared among the compilers for various languages,
+much of the behavior and many of the user-selectable options for these
+compilers are similar.
+For example, diagnostics (error messages and
+warnings) are similar in appearance; command-line
+options like @option{-Wall} have generally similar effects; and the quality
+of generated code (in terms of speed and size) is roughly similar
+(since that work is done by the shared GBE).
+
+@node G77 and GCC
+@chapter Compile Fortran, C, or Other Programs
+@cindex compiling programs
+@cindex programs, compiling
+
+@cindex @command{gcc}, command
+@cindex commands, @command{gcc}
+A GNU Fortran installation includes a modified version of the @command{gcc}
+command.
+
+In a non-Fortran installation, @command{gcc} recognizes C, C++,
+and Objective-C source files.
+
+In a GNU Fortran installation, @command{gcc} also recognizes Fortran source
+files and accepts Fortran-specific command-line options, plus some
+command-line options that are designed to cater to Fortran users
+but apply to other languages as well.
+
+@xref{G++ and GCC,,Programming Languages Supported by GCC,gcc,Using
+the GNU Compiler Collection (GCC)},
+for information on the way different languages are handled
+by the GCC compiler (@command{gcc}).
+
+@cindex @command{g77}, command
+@cindex commands, @command{g77}
+Also provided as part of GNU Fortran is the @command{g77} command.
+The @command{g77} command is designed to make compiling and linking Fortran
+programs somewhat easier than when using the @command{gcc} command for
+these tasks.
+It does this by analyzing the command line somewhat and changing it
+appropriately before submitting it to the @command{gcc} command.
+
+@cindex -v option
+@cindex @command{g77} options, -v
+@cindex options, -v
+Use the @option{-v} option with @command{g77}
+to see what is going on---the first line of output is the invocation
+of the @command{gcc} command.
+
+@include invoke.texi
+
+@include news.texi
+
+@set USERVISONLY
+@include news.texi
+@clear USERVISONLY
+
+@node Language
+@chapter The GNU Fortran Language
+
+@cindex standard, ANSI FORTRAN 77
+@cindex ANSI FORTRAN 77 standard
+@cindex reference works
+GNU Fortran supports a variety of extensions to, and dialects
+of, the Fortran language.
+Its primary base is the ANSI FORTRAN 77 standard, currently available on
+the network at
+@uref{http://www.fortran.com/fortran/F77_std/rjcnf0001.html}
+or as monolithic text at
+@uref{http://www.fortran.com/fortran/F77_std/f77_std.html}.
+It offers some extensions that are popular among users
+of UNIX @command{f77} and @command{f2c} compilers, some that
+are popular among users of other compilers (such as Digital
+products), some that are popular among users of the
+newer Fortran 90 standard, and some that are introduced
+by GNU Fortran.
+
+@cindex textbooks
+(If you need a text on Fortran,
+a few freely available electronic references have pointers from
+@uref{http://www.fortran.com/F/books.html}.  There is a `cooperative
+net project', @cite{User Notes on Fortran Programming} at
+@uref{ftp://vms.huji.ac.il/fortran/} and mirrors elsewhere; some of this
+material might not apply specifically to @command{g77}.)
+
+Part of what defines a particular implementation of a Fortran
+system, such as @command{g77}, is the particular characteristics
+of how it supports types, constants, and so on.
+Much of this is left up to the implementation by the various
+Fortran standards and accepted practice in the industry.
+
+The GNU Fortran @emph{language} is described below.
+Much of the material is organized along the same lines
+as the ANSI FORTRAN 77 standard itself.
+
+@xref{Other Dialects}, for information on features @command{g77} supports
+that are not part of the GNU Fortran language.
+
+@emph{Note}: This portion of the documentation definitely needs a lot
+of work!
+
+@menu
+Relationship to the ANSI FORTRAN 77 standard:
+* Direction of Language Development::  Where GNU Fortran is headed.
+* Standard Support::  Degree of support for the standard.
+
+Extensions to the ANSI FORTRAN 77 standard:
+* Conformance::
+* Notation Used::
+* Terms and Concepts::
+* Characters Lines Sequence::
+* Data Types and Constants::
+* Expressions::
+* Specification Statements::
+* Control Statements::
+* Functions and Subroutines::
+* Scope and Classes of Names::
+* I/O::
+* Fortran 90 Features::
+@end menu
+
+@node Direction of Language Development
+@section Direction of Language Development
+@cindex direction of language development
+@cindex features, language
+@cindex language, features
+
+The purpose of the following description of the GNU Fortran
+language is to promote wide portability of GNU Fortran programs.
+
+GNU Fortran is an evolving language, due to the
+fact that @command{g77} itself is in beta test.
+Some current features of the language might later
+be redefined as dialects of Fortran supported by @command{g77}
+when better ways to express these features are added to @command{g77},
+for example.
+Such features would still be supported by
+@command{g77}, but would be available only when
+one or more command-line options were used.
+
+The GNU Fortran @emph{language} is distinct from the
+GNU Fortran @emph{compilation system} (@command{g77}).
+
+For example, @command{g77} supports various dialects of
+Fortran---in a sense, these are languages other than
+GNU Fortran---though its primary
+purpose is to support the GNU Fortran language, which also is
+described in its documentation and by its implementation.
+
+On the other hand, non-GNU compilers might offer
+support for the GNU Fortran language, and are encouraged
+to do so.
+
+Currently, the GNU Fortran language is a fairly fuzzy object.
+It represents something of a cross between what @command{g77} accepts
+when compiling using the prevailing defaults and what this
+document describes as being part of the language.
+
+Future versions of @command{g77} are expected to clarify the
+definition of the language in the documentation.
+Often, this will mean adding new features to the language, in the form
+of both new documentation and new support in @command{g77}.
+However, it might occasionally mean removing a feature
+from the language itself to ``dialect'' status.
+In such a case, the documentation would be adjusted
+to reflect the change, and @command{g77} itself would likely be changed
+to require one or more command-line options to continue supporting
+the feature.
+
+The development of the GNU Fortran language is intended to strike
+a balance between:
+
+@itemize @bullet
+@item
+Serving as a mostly-upwards-compatible language from the
+de facto UNIX Fortran dialect as supported by @command{f77}.
+
+@item
+Offering new, well-designed language features.
+Attributes of such features include
+not making existing code any harder to read
+(for those who might be unaware that the new
+features are not in use) and
+not making state-of-the-art
+compilers take longer to issue diagnostics,
+among others.
+
+@item
+Supporting existing, well-written code without gratuitously
+rejecting non-standard constructs, regardless of the origin
+of the code (its dialect).
+
+@item
+Offering default behavior and command-line options to reduce
+and, where reasonable, eliminate the need for programmers to make
+any modifications to code that already works in existing
+production environments.
+
+@item
+Diagnosing constructs that have different meanings in different
+systems, languages, and dialects, while offering clear,
+less ambiguous ways to express each of the different meanings
+so programmers can change their code appropriately.
+@end itemize
+
+One of the biggest practical challenges for the developers of the
+GNU Fortran language is meeting the sometimes contradictory demands
+of the above items.
+
+For example, a feature might be widely used in one popular environment,
+but the exact same code that utilizes that feature might not work
+as expected---perhaps it might mean something entirely different---in
+another popular environment.
+
+Traditionally, Fortran compilers---even portable ones---have solved this
+problem by simply offering the appropriate feature to users of
+the respective systems.
+This approach treats users of various Fortran systems and dialects
+as remote ``islands'', or camps, of programmers, and assume that these
+camps rarely come into contact with each other (or,
+especially, with each other's code).
+
+Project GNU takes a radically different approach to software and language
+design, in that it assumes that users of GNU software do not necessarily
+care what kind of underlying system they are using, regardless
+of whether they are using software (at the user-interface
+level) or writing it (for example, writing Fortran or C code).
+
+As such, GNU users rarely need consider just what kind of underlying
+hardware (or, in many cases, operating system) they are using at any
+particular time.
+They can use and write software designed for a general-purpose,
+widely portable, heterogeneous environment---the GNU environment.
+
+In line with this philosophy, GNU Fortran must evolve into a product
+that is widely ported and portable not only in the sense that it can
+be successfully built, installed, and run by users, but in the larger
+sense that its users can use it in the same way, and expect largely the
+same behaviors from it, regardless of the kind of system they are using
+at any particular time.
+
+This approach constrains the solutions @command{g77} can use to resolve
+conflicts between various camps of Fortran users.
+If these two camps disagree about what a particular construct should
+mean, @command{g77} cannot simply be changed to treat that particular construct as
+having one meaning without comment (such as a warning), lest the users
+expecting it to have the other meaning are unpleasantly surprised that
+their code misbehaves when executed.
+
+The use of the ASCII backslash character in character constants is
+an excellent (and still somewhat unresolved) example of this kind of
+controversy.
+@xref{Backslash in Constants}.
+Other examples are likely to arise in the future, as @command{g77} developers
+strive to improve its ability to accept an ever-wider variety of existing
+Fortran code without requiring significant modifications to said code.
+
+Development of GNU Fortran is further constrained by the desire
+to avoid requiring programmers to change their code.
+This is important because it allows programmers, administrators,
+and others to more faithfully evaluate and validate @command{g77}
+(as an overall product and as new versions are distributed)
+without having to support multiple versions of their programs
+so that they continue to work the same way on their existing
+systems (non-GNU perhaps, but possibly also earlier versions
+of @command{g77}).
+
+@node Standard Support
+@section ANSI FORTRAN 77 Standard Support
+@cindex ANSI FORTRAN 77 support
+@cindex standard, support for
+@cindex support, FORTRAN 77
+@cindex compatibility, FORTRAN 77
+@cindex FORTRAN 77 compatibility
+
+GNU Fortran supports ANSI FORTRAN 77 with the following caveats.
+In summary, the only ANSI FORTRAN 77 features @command{g77} doesn't
+support are those that are probably rarely used in actual code,
+some of which are explicitly disallowed by the Fortran 90 standard.
+
+@menu
+* No Passing External Assumed-length::  CHAR*(*) CFUNC restriction.
+* No Passing Dummy Assumed-length::     CHAR*(*) CFUNC restriction.
+* No Pathological Implied-DO::          No @samp{((@dots{}, I=@dots{}), I=@dots{})}.
+* No Useless Implied-DO::               No @samp{(A, I=1, 1)}.
+@end menu
+
+@node No Passing External Assumed-length
+@subsection No Passing External Assumed-length
+
+@command{g77} disallows passing of an external procedure
+as an actual argument if the procedure's
+type is declared @code{CHARACTER*(*)}.  For example:
+
+@example
+CHARACTER*(*) CFUNC
+EXTERNAL CFUNC
+CALL FOO(CFUNC)
+END
+@end example
+
+@noindent
+It isn't clear whether the standard considers this conforming.
+
+@node No Passing Dummy Assumed-length
+@subsection No Passing Dummy Assumed-length
+
+@command{g77} disallows passing of a dummy procedure
+as an actual argument if the procedure's
+type is declared @code{CHARACTER*(*)}.
+
+@example
+SUBROUTINE BAR(CFUNC)
+CHARACTER*(*) CFUNC
+EXTERNAL CFUNC
+CALL FOO(CFUNC)
+END
+@end example
+
+@noindent
+It isn't clear whether the standard considers this conforming.
+
+@node No Pathological Implied-DO
+@subsection No Pathological Implied-DO
+
+The @code{DO} variable for an implied-@code{DO} construct in a
+@code{DATA} statement may not be used as the @code{DO} variable
+for an outer implied-@code{DO} construct.  For example, this
+fragment is disallowed by @command{g77}:
+
+@smallexample
+DATA ((A(I, I), I= 1, 10), I= 1, 10) /@dots{}/
+@end smallexample
+
+@noindent
+This also is disallowed by Fortran 90, as it offers no additional
+capabilities and would have a variety of possible meanings.
+
+Note that it is @emph{very} unlikely that any production Fortran code
+tries to use this unsupported construct.
+
+@node No Useless Implied-DO
+@subsection No Useless Implied-DO
+
+An array element initializer in an implied-@code{DO} construct in a
+@code{DATA} statement must contain at least one reference to the @code{DO}
+variables of each outer implied-@code{DO} construct.  For example,
+this fragment is disallowed by @command{g77}:
+
+@smallexample
+DATA (A, I= 1, 1) /1./
+@end smallexample
+
+@noindent
+This also is disallowed by Fortran 90, as FORTRAN 77's more permissive
+requirements offer no additional capabilities.
+However, @command{g77} doesn't necessarily diagnose all cases
+where this requirement is not met.
+
+Note that it is @emph{very} unlikely that any production Fortran code
+tries to use this unsupported construct.
+
+@node Conformance
+@section Conformance
+
+(The following information augments or overrides the information in
+Section 1.4 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 1 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+The definition of the GNU Fortran language is akin to that of
+the ANSI FORTRAN 77 language in that it does not generally require
+conforming implementations to diagnose cases where programs do
+not conform to the language.
+
+However, @command{g77} as a compiler is being developed in a way that
+is intended to enable it to diagnose such cases in an easy-to-understand
+manner.
+
+A program that conforms to the GNU Fortran language should, when
+compiled, linked, and executed using a properly installed @command{g77}
+system, perform as described by the GNU Fortran language definition.
+Reasons for different behavior include, among others:
+
+@itemize @bullet
+@item
+Use of resources (memory---heap, stack, and so on; disk space; CPU
+time; etc.) exceeds those of the system.
+
+@item
+Range and/or precision of calculations required by the program
+exceeds that of the system.
+
+@item
+Excessive reliance on behaviors that are system-dependent
+(non-portable Fortran code).
+
+@item
+Bugs in the program.
+
+@item
+Bug in @command{g77}.
+
+@item
+Bugs in the system.
+@end itemize
+
+Despite these ``loopholes'', the availability of a clear specification
+of the language of programs submitted to @command{g77}, as this document
+is intended to provide, is considered an important aspect of providing
+a robust, clean, predictable Fortran implementation.
+
+The definition of the GNU Fortran language, while having no special
+legal status, can therefore be viewed as a sort of contract, or agreement.
+This agreement says, in essence, ``if you write a program in this language,
+and run it in an environment (such as a @command{g77} system) that supports
+this language, the program should behave in a largely predictable way''.
+
+@node Notation Used
+@section Notation Used in This Chapter
+
+(The following information augments or overrides the information in
+Section 1.5 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 1 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+In this chapter, ``must'' denotes a requirement, ``may'' denotes permission,
+and ``must not'' and ``may not'' denote prohibition.
+Terms such as ``might'', ``should'', and ``can'' generally add little or
+nothing in the way of weight to the GNU Fortran language itself,
+but are used to explain or illustrate the language.
+
+For example:
+
+@display
+``The @code{FROBNITZ} statement must precede all executable
+statements in a program unit, and may not specify any dummy
+arguments.  It may specify local or common variables and arrays.
+Its use should be limited to portions of the program designed to
+be non-portable and system-specific, because it might cause the
+containing program unit to behave quite differently on different
+systems.''
+@end display
+
+Insofar as the GNU Fortran language is specified,
+the requirements and permissions denoted by the above sample statement
+are limited to the placement of the statement and the kinds of
+things it may specify.
+The rest of the statement---the content regarding non-portable portions
+of the program and the differing behavior of program units containing
+the @code{FROBNITZ} statement---does not pertain the GNU Fortran
+language itself.
+That content offers advice and warnings about the @code{FROBNITZ}
+statement.
+
+@emph{Remember:} The GNU Fortran language definition specifies
+both what constitutes a valid GNU Fortran program and how,
+given such a program, a valid GNU Fortran implementation is
+to interpret that program.
+
+It is @emph{not} incumbent upon a valid GNU Fortran implementation
+to behave in any particular way, any consistent way, or any
+predictable way when it is asked to interpret input that is
+@emph{not} a valid GNU Fortran program.
+
+Such input is said to have @dfn{undefined} behavior when
+interpreted by a valid GNU Fortran implementation, though
+an implementation may choose to specify behaviors for some
+cases of inputs that are not valid GNU Fortran programs.
+
+Other notation used herein is that of the GNU texinfo format,
+which is used to generate printed hardcopy, on-line hypertext
+(Info), and on-line HTML versions, all from a single source
+document.
+This notation is used as follows:
+
+@itemize @bullet
+@item
+Keywords defined by the GNU Fortran language are shown
+in uppercase, as in: @code{COMMON}, @code{INTEGER}, and
+@code{BLOCK DATA}.
+
+Note that, in practice, many Fortran programs are written
+in lowercase---uppercase is used in this manual as a
+means to readily distinguish keywords and sample Fortran-related
+text from the prose in this document.
+
+@item
+Portions of actual sample program, input, or output text
+look like this: @samp{Actual program text}.
+
+Generally, uppercase is used for all Fortran-specific and
+Fortran-related text, though this does not always include
+literal text within Fortran code.
+
+For example: @samp{PRINT *, 'My name is Bob'}.
+
+@item
+A metasyntactic variable---that is, a name used in this document
+to serve as a placeholder for whatever text is used by the
+user or programmer---appears as shown in the following example:
+
+``The @code{INTEGER @var{ivar}} statement specifies that
+@var{ivar} is a variable or array of type @code{INTEGER}.''
+
+In the above example, any valid text may be substituted for
+the metasyntactic variable @var{ivar} to make the statement
+apply to a specific instance, as long as the same text is
+substituted for @emph{both} occurrences of @var{ivar}.
+
+@item
+Ellipses (``@dots{}'') are used to indicate further text that
+is either unimportant or expanded upon further, elsewhere.
+
+@item
+Names of data types are in the style of Fortran 90, in most
+cases.
+
+@xref{Kind Notation}, for information on the relationship
+between Fortran 90 nomenclature (such as @code{INTEGER(KIND=1)})
+and the more traditional, less portably concise nomenclature
+(such as @code{INTEGER*4}).
+@end itemize
+
+@node Terms and Concepts
+@section Fortran Terms and Concepts
+
+(The following information augments or overrides the information in
+Chapter 2 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 2 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+@menu
+* Syntactic Items::
+* Statements Comments Lines::
+* Scope of Names and Labels::
+@end menu
+
+@node Syntactic Items
+@subsection Syntactic Items
+
+(Corresponds to Section 2.2 of ANSI X3.9-1978 FORTRAN 77.)
+
+@cindex limits, lengths of names
+In GNU Fortran, a symbolic name is at least one character long,
+and has no arbitrary upper limit on length.
+However, names of entities requiring external linkage (such as
+external functions, external subroutines, and @code{COMMON} areas)
+might be restricted to some arbitrary length by the system.
+Such a restriction is no more constrained than that of one
+through six characters.
+
+Underscores (@samp{_}) are accepted in symbol names after the first
+character (which must be a letter).
+
+@node Statements Comments Lines
+@subsection Statements, Comments, and Lines
+
+(Corresponds to Section 2.3 of ANSI X3.9-1978 FORTRAN 77.)
+
+@cindex trailing comment
+@cindex comment
+@cindex characters, comment
+@cindex !
+@cindex exclamation point
+@cindex continuation character
+@cindex characters, continuation
+Use of an exclamation point (@samp{!}) to begin a
+trailing comment (a comment that extends to the end of the same
+source line) is permitted under the following conditions:
+
+@itemize @bullet
+@item
+The exclamation point does not appear in column 6.
+Otherwise, it is treated as an indicator of a continuation
+line.
+
+@item
+The exclamation point appears outside a character or Hollerith
+constant.
+Otherwise, the exclamation point is considered part of the
+constant.
+
+@item
+The exclamation point appears to the left of any other possible
+trailing comment.
+That is, a trailing comment may contain exclamation points
+in their commentary text.
+@end itemize
+
+@cindex ;
+@cindex semicolon
+@cindex statements, separated by semicolon
+Use of a semicolon (@samp{;}) as a statement separator
+is permitted under the following conditions:
+
+@itemize @bullet
+@item
+The semicolon appears outside a character or Hollerith
+constant.
+Otherwise, the semicolon is considered part of the
+constant.
+
+@item
+The semicolon appears to the left of a trailing comment.
+Otherwise, the semicolon is considered part of that
+comment.
+
+@item
+Neither a logical @code{IF} statement nor a non-construct
+@code{WHERE} statement (a Fortran 90 feature) may be
+followed (in the same, possibly continued, line) by
+a semicolon used as a statement separator.
+
+This restriction avoids the confusion
+that can result when reading a line such as:
+
+@smallexample
+IF (VALIDP) CALL FOO; CALL BAR
+@end smallexample
+
+@noindent
+Some readers might think the @samp{CALL BAR} is executed
+only if @samp{VALIDP} is @code{.TRUE.}, while others might
+assume its execution is unconditional.
+
+(At present, @command{g77} does not diagnose code that
+violates this restriction.)
+@end itemize
+
+@node Scope of Names and Labels
+@subsection Scope of Symbolic Names and Statement Labels
+@cindex scope
+
+(Corresponds to Section 2.9 of ANSI X3.9-1978 FORTRAN 77.)
+
+Included in the list of entities that have a scope of a
+program unit are construct names (a Fortran 90 feature).
+@xref{Construct Names}, for more information.
+
+@node Characters Lines Sequence
+@section Characters, Lines, and Execution Sequence
+
+(The following information augments or overrides the information in
+Chapter 3 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 3 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+@menu
+* Character Set::
+* Lines::
+* Continuation Line::
+* Statements::
+* Statement Labels::
+* Order::
+* INCLUDE::
+* Cpp-style directives::
+@end menu
+
+@node Character Set
+@subsection GNU Fortran Character Set
+@cindex characters
+
+(Corresponds to Section 3.1 of ANSI X3.9-1978 FORTRAN 77.)
+
+Letters include uppercase letters (the twenty-six characters
+of the English alphabet) and lowercase letters (their lowercase
+equivalent).
+Generally, lowercase letters may be used in place of uppercase
+letters, though in character and Hollerith constants, they
+are distinct.
+
+Special characters include:
+
+@itemize @bullet
+@item
+@cindex ;
+@cindex semicolon
+Semicolon (@samp{;})
+
+@item
+@cindex !
+@cindex exclamation point
+Exclamation point (@samp{!})
+
+@item
+@cindex "
+@cindex double quote
+Double quote (@samp{"})
+
+@item
+@cindex \
+@cindex backslash
+Backslash (@samp{\})
+
+@item
+@cindex ?
+@cindex question mark
+Question mark (@samp{?})
+
+@item
+@cindex #
+@cindex hash mark
+@cindex pound sign
+Hash mark (@samp{#})
+
+@item
+@cindex &
+@cindex ampersand
+Ampersand (@samp{&})
+
+@item
+@cindex %
+@cindex percent sign
+Percent sign (@samp{%})
+
+@item
+@cindex _
+@cindex underscore
+Underscore (@samp{_})
+
+@item
+@cindex <
+@cindex open angle
+@cindex left angle
+@cindex open bracket
+@cindex left bracket
+Open angle (@samp{<})
+
+@item
+@cindex >
+@cindex close angle
+@cindex right angle
+@cindex close bracket
+@cindex right bracket
+Close angle (@samp{>})
+
+@item
+The FORTRAN 77 special characters (@key{SPC}, @samp{=},
+@samp{+}, @samp{-}, @samp{*}, @samp{/}, @samp{(},
+@samp{)}, @samp{,}, @samp{.}, @samp{$}, @samp{'},
+and @samp{:})
+@end itemize
+
+@cindex blank
+@cindex space
+@cindex SPC
+Note that this document refers to @key{SPC} as @dfn{space},
+while X3.9-1978 FORTRAN 77 refers to it as @dfn{blank}.
+
+@node Lines
+@subsection Lines
+@cindex lines
+@cindex source file format
+@cindex source format
+@cindex file, source
+@cindex source code
+@cindex code, source
+@cindex fixed form
+@cindex free form
+
+(Corresponds to Section 3.2 of ANSI X3.9-1978 FORTRAN 77.)
+
+The way a Fortran compiler views source files depends entirely on the
+implementation choices made for the compiler, since those choices
+are explicitly left to the implementation by the published Fortran
+standards.
+
+The GNU Fortran language mandates a view applicable to UNIX-like
+text files---files that are made up of an arbitrary number of lines,
+each with an arbitrary number of characters (sometimes called stream-based
+files).
+
+This view does not apply to types of files that are specified as
+having a particular number of characters on every single line (sometimes
+referred to as record-based files).
+
+Because a ``line in a program unit is a sequence of 72 characters'',
+to quote X3.9-1978, the GNU Fortran language specifies that a
+stream-based text file is translated to GNU Fortran lines as follows:
+
+@itemize @bullet
+@item
+A newline in the file is the character that represents the end of
+a line of text to the underlying system.
+For example, on ASCII-based systems, a newline is the @key{NL}
+character, which has ASCII value 10 (decimal).
+
+@item
+Each newline in the file serves to end the line of text that precedes
+it (and that does not contain a newline).
+
+@item
+The end-of-file marker (@code{EOF}) also serves to end the line
+of text that precedes it (and that does not contain a newline).
+
+@item
+@cindex blank
+@cindex space
+@cindex SPC
+Any line of text that is shorter than 72 characters is padded to that length
+with spaces (called ``blanks'' in the standard).
+
+@item
+Any line of text that is longer than 72 characters is truncated to that
+length, but the truncated remainder must consist entirely of spaces.
+
+@item
+Characters other than newline and the GNU Fortran character set
+are invalid.
+@end itemize
+
+For the purposes of the remainder of this description of the GNU
+Fortran language, the translation described above has already
+taken place, unless otherwise specified.
+
+The result of the above translation is that the source file appears,
+in terms of the remainder of this description of the GNU Fortran language,
+as if it had an arbitrary
+number of 72-character lines, each character being among the GNU Fortran
+character set.
+
+For example, if the source file itself has two newlines in a row,
+the second newline becomes, after the above translation, a single
+line containing 72 spaces.
+
+@node Continuation Line
+@subsection Continuation Line
+@cindex continuation line, number of
+@cindex lines, continuation
+@cindex number of continuation lines
+@cindex limits, continuation lines
+
+(Corresponds to Section 3.2.3 of ANSI X3.9-1978 FORTRAN 77.)
+
+A continuation line is any line that both
+
+@itemize @bullet
+@item
+Contains a continuation character, and
+
+@item
+Contains only spaces in columns 1 through 5
+@end itemize
+
+A continuation character is any character of the GNU Fortran character set
+other than space (@key{SPC}) or zero (@samp{0})
+in column 6, or a digit (@samp{0} through @samp{9}) in column
+7 through 72 of a line that has only spaces to the left of that
+digit.
+
+The continuation character is ignored as far as the content of
+the statement is concerned.
+
+The GNU Fortran language places no limit on the number of
+continuation lines in a statement.
+In practice, the limit depends on a variety of factors, such as
+available memory, statement content, and so on, but no
+GNU Fortran system may impose an arbitrary limit.
+
+@node Statements
+@subsection Statements
+
+(Corresponds to Section 3.3 of ANSI X3.9-1978 FORTRAN 77.)
+
+Statements may be written using an arbitrary number of continuation
+lines.
+
+Statements may be separated using the semicolon (@samp{;}), except
+that the logical @code{IF} and non-construct @code{WHERE} statements
+may not be separated from subsequent statements using only a semicolon
+as statement separator.
+
+The @code{END PROGRAM}, @code{END SUBROUTINE}, @code{END FUNCTION},
+and @code{END BLOCK DATA} statements are alternatives to the @code{END}
+statement.
+These alternatives may be written as normal statements---they are not
+subject to the restrictions of the @code{END} statement.
+
+However, no statement other than @code{END} may have an initial line
+that appears to be an @code{END} statement---even @code{END PROGRAM},
+for example, must not be written as:
+
+@example
+      END
+     &PROGRAM
+@end example
+
+@node Statement Labels
+@subsection Statement Labels
+
+(Corresponds to Section 3.4 of ANSI X3.9-1978 FORTRAN 77.)
+
+A statement separated from its predecessor via a semicolon may be
+labeled as follows:
+
+@itemize @bullet
+@item
+The semicolon is followed by the label for the statement,
+which in turn follows the label.
+
+@item
+The label must be no more than five digits in length.
+
+@item
+The first digit of the label for the statement is not
+the first non-space character on a line.
+Otherwise, that character is treated as a continuation
+character.
+@end itemize
+
+A statement may have only one label defined for it.
+
+@node Order
+@subsection Order of Statements and Lines
+
+(Corresponds to Section 3.5 of ANSI X3.9-1978 FORTRAN 77.)
+
+Generally, @code{DATA} statements may precede executable statements.
+However, specification statements pertaining to any entities
+initialized by a @code{DATA} statement must precede that @code{DATA}
+statement.
+For example,
+after @samp{DATA I/1/}, @samp{INTEGER I} is not permitted, but
+@samp{INTEGER J} is permitted.
+
+The last line of a program unit may be an @code{END} statement,
+or may be:
+
+@itemize @bullet
+@item
+An @code{END PROGRAM} statement, if the program unit is a main program.
+
+@item
+An @code{END SUBROUTINE} statement, if the program unit is a subroutine.
+
+@item
+An @code{END FUNCTION} statement, if the program unit is a function.
+
+@item
+An @code{END BLOCK DATA} statement, if the program unit is a block data.
+@end itemize
+
+@node INCLUDE
+@subsection Including Source Text
+@cindex INCLUDE directive
+
+Additional source text may be included in the processing of
+the source file via the @code{INCLUDE} directive:
+
+@example
+INCLUDE @var{filename}
+@end example
+
+@noindent
+The source text to be included is identified by @var{filename},
+which is a literal GNU Fortran character constant.
+The meaning and interpretation of @var{filename} depends on the
+implementation, but typically is a filename.
+
+(@command{g77} treats it as a filename that it searches for
+in the current directory and/or directories specified
+via the @option{-I} command-line option.)
+
+The effect of the @code{INCLUDE} directive is as if the
+included text directly replaced the directive in the source
+file prior to interpretation of the program.
+Included text may itself use @code{INCLUDE}.
+The depth of nested @code{INCLUDE} references depends on
+the implementation, but typically is a positive integer.
+
+This virtual replacement treats the statements and @code{INCLUDE}
+directives in the included text as syntactically distinct from
+those in the including text.
+
+Therefore, the first non-comment line of the included text
+must not be a continuation line.
+The included text must therefore have, after the non-comment
+lines, either an initial line (statement), an @code{INCLUDE}
+directive, or nothing (the end of the included text).
+
+Similarly, the including text may end the @code{INCLUDE}
+directive with a semicolon or the end of the line, but it
+cannot follow an @code{INCLUDE} directive at the end of its
+line with a continuation line.
+Thus, the last statement in an included text may not be
+continued.
+
+Any statements between two @code{INCLUDE} directives on the
+same line are treated as if they appeared in between the
+respective included texts.
+For example:
+
+@smallexample
+INCLUDE 'A'; PRINT *, 'B'; INCLUDE 'C'; END PROGRAM
+@end smallexample
+
+@noindent
+If the text included by @samp{INCLUDE 'A'} constitutes
+a @samp{PRINT *, 'A'} statement and the text included by
+@samp{INCLUDE 'C'} constitutes a @samp{PRINT *, 'C'} statement,
+then the output of the above sample program would be
+
+@example
+A
+B
+C
+@end example
+
+@noindent
+(with suitable allowances for how an implementation defines
+its handling of output).
+
+Included text must not include itself directly or indirectly,
+regardless of whether the @var{filename} used to reference
+the text is the same.
+
+Note that @code{INCLUDE} is @emph{not} a statement.
+As such, it is neither a non-executable or executable
+statement.
+However, if the text it includes constitutes one or more
+executable statements, then the placement of @code{INCLUDE}
+is subject to effectively the same restrictions as those
+on executable statements.
+
+An @code{INCLUDE} directive may be continued across multiple
+lines as if it were a statement.
+This permits long names to be used for @var{filename}.
+
+@node Cpp-style directives
+@subsection Cpp-style directives
+@cindex #
+@cindex preprocessor
+
+@code{cpp} output-style @code{#} directives
+(@pxref{C Preprocessor Output,,, cpp, The C Preprocessor})
+are recognized by the compiler even
+when the preprocessor isn't run on the input (as it is when compiling
+@samp{.F} files).  (Note the distinction between these @command{cpp}
+@code{#} @emph{output} directives and @code{#line} @emph{input}
+directives.)
+
+@node Data Types and Constants
+@section Data Types and Constants
+
+(The following information augments or overrides the information in
+Chapter 4 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 4 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+To more concisely express the appropriate types for
+entities, this document uses the more concise
+Fortran 90 nomenclature such as @code{INTEGER(KIND=1)}
+instead of the more traditional, but less portably concise,
+byte-size-based nomenclature such as @code{INTEGER*4},
+wherever reasonable.
+
+When referring to generic types---in contexts where the
+specific precision and range of a type are not important---this
+document uses the generic type names @code{INTEGER}, @code{LOGICAL},
+@code{REAL}, @code{COMPLEX}, and @code{CHARACTER}.
+
+In some cases, the context requires specification of a
+particular type.
+This document uses the @samp{KIND=} notation to accomplish
+this throughout, sometimes supplying the more traditional
+notation for clarification, though the traditional notation
+might not work the same way on all GNU Fortran implementations.
+
+Use of @samp{KIND=} makes this document more concise because
+@command{g77} is able to define values for @samp{KIND=} that
+have the same meanings on all systems, due to the way the
+Fortran 90 standard specifies these values are to be used.
+
+(In particular, that standard permits an implementation to
+arbitrarily assign nonnegative values.
+There are four distinct sets of assignments: one to the @code{CHARACTER}
+type; one to the @code{INTEGER} type; one to the @code{LOGICAL} type;
+and the fourth to both the @code{REAL} and @code{COMPLEX} types.
+Implementations are free to assign these values in any order,
+leave gaps in the ordering of assignments, and assign more than
+one value to a representation.)
+
+This makes @samp{KIND=} values superior to the values used
+in non-standard statements such as @samp{INTEGER*4}, because
+the meanings of the values in those statements vary from machine
+to machine, compiler to compiler, even operating system to
+operating system.
+
+However, use of @samp{KIND=} is @emph{not} generally recommended
+when writing portable code (unless, for example, the code is
+going to be compiled only via @command{g77}, which is a widely
+ported compiler).
+GNU Fortran does not yet have adequate language constructs to
+permit use of @samp{KIND=} in a fashion that would make the
+code portable to Fortran 90 implementations; and, this construct
+is known to @emph{not} be accepted by many popular FORTRAN 77
+implementations, so it cannot be used in code that is to be ported
+to those.
+
+The distinction here is that this document is able to use
+specific values for @samp{KIND=} to concisely document the
+types of various operations and operands.
+
+A Fortran program should use the FORTRAN 77 designations for the
+appropriate GNU Fortran types---such as @code{INTEGER} for
+@code{INTEGER(KIND=1)}, @code{REAL} for @code{REAL(KIND=1)},
+and @code{DOUBLE COMPLEX} for @code{COMPLEX(KIND=2)}---and,
+where no such designations exist, make use of appropriate
+techniques (preprocessor macros, parameters, and so on)
+to specify the types in a fashion that may be easily adjusted
+to suit each particular implementation to which the program
+is ported.
+(These types generally won't need to be adjusted for ports of
+@command{g77}.)
+
+Further details regarding GNU Fortran data types and constants
+are provided below.
+
+@menu
+* Types::
+* Constants::
+* Integer Type::
+* Character Type::
+@end menu
+
+@node Types
+@subsection Data Types
+
+(Corresponds to Section 4.1 of ANSI X3.9-1978 FORTRAN 77.)
+
+GNU Fortran supports these types:
+
+@enumerate
+@item
+Integer (generic type @code{INTEGER})
+
+@item
+Real (generic type @code{REAL})
+
+@item
+Double precision
+
+@item
+Complex (generic type @code{COMPLEX})
+
+@item
+Logical (generic type @code{LOGICAL})
+
+@item
+Character (generic type @code{CHARACTER})
+
+@item
+Double Complex
+@end enumerate
+
+(The types numbered 1 through 6 above are standard FORTRAN 77 types.)
+
+The generic types shown above are referred to in this document
+using only their generic type names.
+Such references usually indicate that any specific type (kind)
+of that generic type is valid.
+
+For example, a context described in this document as accepting
+the @code{COMPLEX} type also is likely to accept the
+@code{DOUBLE COMPLEX} type.
+
+The GNU Fortran language supports three ways to specify
+a specific kind of a generic type.
+
+@menu
+* Double Notation::  As in @code{DOUBLE COMPLEX}.
+* Star Notation::    As in @code{INTEGER*4}.
+* Kind Notation::    As in @code{INTEGER(KIND=1)}.
+@end menu
+
+@node Double Notation
+@subsubsection Double Notation
+
+The GNU Fortran language supports two uses of the keyword
+@code{DOUBLE} to specify a specific kind of type:
+
+@itemize @bullet
+@item
+@code{DOUBLE PRECISION}, equivalent to @code{REAL(KIND=2)}
+
+@item
+@code{DOUBLE COMPLEX}, equivalent to @code{COMPLEX(KIND=2)}
+@end itemize
+
+Use one of the above forms where a type name is valid.
+
+While use of this notation is popular, it doesn't scale
+well in a language or dialect rich in intrinsic types,
+as is the case for the GNU Fortran language (especially
+planned future versions of it).
+
+After all, one rarely sees type names such as @samp{DOUBLE INTEGER},
+@samp{QUADRUPLE REAL}, or @samp{QUARTER INTEGER}.
+Instead, @code{INTEGER*8}, @code{REAL*16}, and @code{INTEGER*1}
+often are substituted for these, respectively, even though they
+do not always have the same meanings on all systems.
+(And, the fact that @samp{DOUBLE REAL} does not exist as such
+is an inconsistency.)
+
+Therefore, this document uses ``double notation'' only on occasion
+for the benefit of those readers who are accustomed to it.
+
+@node Star Notation
+@subsubsection Star Notation
+@cindex *@var{n} notation
+
+The following notation specifies the storage size for a type:
+
+@smallexample
+@var{generic-type}*@var{n}
+@end smallexample
+
+@noindent
+@var{generic-type} must be a generic type---one of
+@code{INTEGER}, @code{REAL}, @code{COMPLEX}, @code{LOGICAL},
+or @code{CHARACTER}.
+@var{n} must be one or more digits comprising a decimal
+integer number greater than zero.
+
+Use the above form where a type name is valid.
+
+The @samp{*@var{n}} notation specifies that the amount of storage
+occupied by variables and array elements of that type is @var{n}
+times the storage occupied by a @code{CHARACTER*1} variable.
+
+This notation might indicate a different degree of precision and/or
+range for such variables and array elements, and the functions that
+return values of types using this notation.
+It does not limit the precision or range of values of that type
+in any particular way---use explicit code to do that.
+
+Further, the GNU Fortran language requires no particular values
+for @var{n} to be supported by an implementation via the @samp{*@var{n}}
+notation.
+@command{g77} supports @code{INTEGER*1} (as @code{INTEGER(KIND=3)})
+on all systems, for example,
+but not all implementations are required to do so, and @command{g77}
+is known to not support @code{REAL*1} on most (or all) systems.
+
+As a result, except for @var{generic-type} of @code{CHARACTER},
+uses of this notation should be limited to isolated
+portions of a program that are intended to handle system-specific
+tasks and are expected to be non-portable.
+
+(Standard FORTRAN 77 supports the @samp{*@var{n}} notation for
+only @code{CHARACTER}, where it signifies not only the amount
+of storage occupied, but the number of characters in entities
+of that type.
+However, almost all Fortran compilers have supported this
+notation for generic types, though with a variety of meanings
+for @var{n}.)
+
+Specifications of types using the @samp{*@var{n}} notation
+always are interpreted as specifications of the appropriate
+types described in this document using the @samp{KIND=@var{n}}
+notation, described below.
+
+While use of this notation is popular, it doesn't serve well
+in the context of a widely portable dialect of Fortran, such as
+the GNU Fortran language.
+
+For example, even on one particular machine, two or more popular
+Fortran compilers might well disagree on the size of a type
+declared @code{INTEGER*2} or @code{REAL*16}.
+Certainly there
+is known to be disagreement over such things among Fortran
+compilers on @emph{different} systems.
+
+Further, this notation offers no elegant way to specify sizes
+that are not even multiples of the ``byte size'' typically
+designated by @code{INTEGER*1}.
+Use of ``absurd'' values (such as @code{INTEGER*1000}) would
+certainly be possible, but would perhaps be stretching the original
+intent of this notation beyond the breaking point in terms
+of widespread readability of documentation and code making use
+of it.
+
+Therefore, this document uses ``star notation'' only on occasion
+for the benefit of those readers who are accustomed to it.
+
+@node Kind Notation
+@subsubsection Kind Notation
+@cindex KIND= notation
+
+The following notation specifies the kind-type selector of a type:
+
+@smallexample
+@var{generic-type}(KIND=@var{n})
+@end smallexample
+
+@noindent
+Use the above form where a type name is valid.
+
+@var{generic-type} must be a generic type---one of
+@code{INTEGER}, @code{REAL}, @code{COMPLEX}, @code{LOGICAL},
+or @code{CHARACTER}.
+@var{n} must be an integer initialization expression that
+is a positive, nonzero value.
+
+Programmers are discouraged from writing these values directly
+into their code.
+Future versions of the GNU Fortran language will offer
+facilities that will make the writing of code portable
+to @command{g77} @emph{and} Fortran 90 implementations simpler.
+
+However, writing code that ports to existing FORTRAN 77
+implementations depends on avoiding the @samp{KIND=} construct.
+
+The @samp{KIND=} construct is thus useful in the context
+of GNU Fortran for two reasons:
+
+@itemize @bullet
+@item
+It provides a means to specify a type in a fashion that
+is portable across all GNU Fortran implementations (though
+not other FORTRAN 77 and Fortran 90 implementations).
+
+@item
+It provides a sort of Rosetta stone for this document to use
+to concisely describe the types of various operations and
+operands.
+@end itemize
+
+The values of @var{n} in the GNU Fortran language are
+assigned using a scheme that:
+
+@itemize @bullet
+@item
+Attempts to maximize the ability of readers
+of this document to quickly familiarize themselves
+with assignments for popular types
+
+@item
+Provides a unique value for each specific desired
+meaning
+
+@item
+Provides a means to automatically assign new values so
+they have a ``natural'' relationship to existing values,
+if appropriate, or, if no such relationship exists, will
+not interfere with future values assigned on the basis
+of such relationships
+
+@item
+Avoids using values that are similar to values used
+in the existing, popular @samp{*@var{n}} notation,
+to prevent readers from expecting that these implied
+correspondences work on all GNU Fortran implementations
+@end itemize
+
+The assignment system accomplishes this by assigning
+to each ``fundamental meaning'' of a specific type a
+unique prime number.
+Combinations of fundamental meanings---for example, a type
+that is two times the size of some other type---are assigned
+values of @var{n} that are the products of the values for
+those fundamental meanings.
+
+A prime value of @var{n} is never given more than one fundamental
+meaning, to avoid situations where some code or system
+cannot reasonably provide those meanings in the form of a
+single type.
+
+The values of @var{n} assigned so far are:
+
+@table @code
+@item KIND=0
+This value is reserved for future use.
+
+The planned future use is for this value to designate,
+explicitly, context-sensitive kind-type selection.
+For example, the expression @samp{1D0 * 0.1_0} would
+be equivalent to @samp{1D0 * 0.1D0}.
+
+@item KIND=1
+This corresponds to the default types for
+@code{REAL}, @code{INTEGER}, @code{LOGICAL}, @code{COMPLEX},
+and @code{CHARACTER}, as appropriate.
+
+These are the ``default'' types described in the Fortran 90 standard,
+though that standard does not assign any particular @samp{KIND=}
+value to these types.
+
+(Typically, these are @code{REAL*4}, @code{INTEGER*4},
+@code{LOGICAL*4}, and @code{COMPLEX*8}.)
+
+@item KIND=2
+This corresponds to types that occupy twice as much
+storage as the default types.
+@code{REAL(KIND=2)} is @code{DOUBLE PRECISION} (typically @code{REAL*8}),
+@code{COMPLEX(KIND=2)} is @code{DOUBLE COMPLEX} (typically @code{COMPLEX*16}),
+
+These are the ``double precision'' types described in the Fortran 90
+standard,
+though that standard does not assign any particular @samp{KIND=}
+value to these types.
+
+@var{n} of 4 thus corresponds to types that occupy four times
+as much storage as the default types, @var{n} of 8 to types that
+occupy eight times as much storage, and so on.
+
+The @code{INTEGER(KIND=2)} and @code{LOGICAL(KIND=2)} types
+are not necessarily supported by every GNU Fortran implementation.
+
+@item KIND=3
+This corresponds to types that occupy as much
+storage as the default @code{CHARACTER} type,
+which is the same effective type as @code{CHARACTER(KIND=1)}
+(making that type effectively the same as @code{CHARACTER(KIND=3)}).
+
+(Typically, these are @code{INTEGER*1} and @code{LOGICAL*1}.)
+
+@var{n} of 6 thus corresponds to types that occupy twice as
+much storage as the @var{n}=3 types, @var{n} of 12 to types
+that occupy four times as much storage, and so on.
+
+These are not necessarily supported by every GNU Fortran
+implementation.
+
+@item KIND=5
+This corresponds to types that occupy half the
+storage as the default (@var{n}=1) types.
+
+(Typically, these are @code{INTEGER*2} and @code{LOGICAL*2}.)
+
+@var{n} of 25 thus corresponds to types that occupy one-quarter
+as much storage as the default types.
+
+These are not necessarily supported by every GNU Fortran
+implementation.
+
+@item KIND=7
+@cindex pointers
+This is valid only as @code{INTEGER(KIND=7)} and
+denotes the @code{INTEGER} type that has the smallest
+storage size that holds a pointer on the system.
+
+A pointer representable by this type is capable of uniquely
+addressing a @code{CHARACTER*1} variable, array, array element,
+or substring.
+
+(Typically this is equivalent to @code{INTEGER*4} or,
+on 64-bit systems, @code{INTEGER*8}.
+In a compatible C implementation, it typically would
+be the same size and semantics of the C type @code{void *}.)
+@end table
+
+Note that these are @emph{proposed} correspondences and might change
+in future versions of @command{g77}---avoid writing code depending
+on them while @command{g77}, and therefore the GNU Fortran language
+it defines, is in beta testing.
+
+Values not specified in the above list are reserved to
+future versions of the GNU Fortran language.
+
+Implementation-dependent meanings will be assigned new,
+unique prime numbers so as to not interfere with other
+implementation-dependent meanings, and offer the possibility
+of increasing the portability of code depending on such
+types by offering support for them in other GNU Fortran
+implementations.
+
+Other meanings that might be given unique values are:
+
+@itemize @bullet
+@item
+Types that make use of only half their storage size for
+representing precision and range.
+
+For example, some compilers offer options that cause
+@code{INTEGER} types to occupy the amount of storage
+that would be needed for @code{INTEGER(KIND=2)} types, but the
+range remains that of @code{INTEGER(KIND=1)}.
+
+@item
+The IEEE single floating-point type.
+
+@item
+Types with a specific bit pattern (endianness), such as the
+little-endian form of @code{INTEGER(KIND=1)}.
+These could permit, conceptually, use of portable code and
+implementations on data files written by existing systems.
+@end itemize
+
+Future @emph{prime} numbers should be given meanings in as incremental
+a fashion as possible, to allow for flexibility and
+expressiveness in combining types.
+
+For example, instead of defining a prime number for little-endian
+IEEE doubles, one prime number might be assigned the meaning
+``little-endian'', another the meaning ``IEEE double'', and the
+value of @var{n} for a little-endian IEEE double would thus
+naturally be the product of those two respective assigned values.
+(It could even be reasonable to have IEEE values result from the
+products of prime values denoting exponent and fraction sizes
+and meanings, hidden bit usage, availability and representations
+of special values such as subnormals, infinities, and Not-A-Numbers
+(NaNs), and so on.)
+
+This assignment mechanism, while not inherently required for
+future versions of the GNU Fortran language, is worth using
+because it could ease management of the ``space'' of supported
+types much easier in the long run.
+
+The above approach suggests a mechanism for specifying inheritance
+of intrinsic (built-in) types for an entire, widely portable
+product line.
+It is certainly reasonable that, unlike programmers of other languages
+offering inheritance mechanisms that employ verbose names for classes
+and subclasses, along with graphical browsers to elucidate the
+relationships, Fortran programmers would employ
+a mechanism that works by multiplying prime numbers together
+and finding the prime factors of such products.
+
+Most of the advantages for the above scheme have been explained
+above.
+One disadvantage is that it could lead to the defining,
+by the GNU Fortran language, of some fairly large prime numbers.
+This could lead to the GNU Fortran language being declared
+``munitions'' by the United States Department of Defense.
+
+@node Constants
+@subsection Constants
+@cindex constants
+@cindex types, constants
+
+(Corresponds to Section 4.2 of ANSI X3.9-1978 FORTRAN 77.)
+
+A @dfn{typeless constant} has one of the following forms:
+
+@smallexample
+'@var{binary-digits}'B
+'@var{octal-digits}'O
+'@var{hexadecimal-digits}'Z
+'@var{hexadecimal-digits}'X
+@end smallexample
+
+@noindent
+@var{binary-digits}, @var{octal-digits}, and @var{hexadecimal-digits}
+are nonempty strings of characters in the set @samp{01}, @samp{01234567},
+and @samp{0123456789ABCDEFabcdef}, respectively.
+(The value for @samp{A} (and @samp{a}) is 10, for @samp{B} and @samp{b}
+is 11, and so on.)
+
+A prefix-radix constant, such as @samp{Z'ABCD'}, can optionally be
+treated as typeless.  @xref{Fortran Dialect Options,, Options
+Controlling Fortran Dialect}, for information on the
+@option{-ftypeless-boz} option.
+
+Typeless constants have values that depend on the context in which
+they are used.
+
+All other constants, called @dfn{typed constants}, are interpreted---converted
+to internal form---according to their inherent type.
+Thus, context is @emph{never} a determining factor for the type, and hence
+the interpretation, of a typed constant.
+(All constants in the ANSI FORTRAN 77 language are typed constants.)
+
+For example, @samp{1} is always type @code{INTEGER(KIND=1)} in GNU
+Fortran (called default INTEGER in Fortran 90),
+@samp{9.435784839284958} is always type @code{REAL(KIND=1)} (even if the
+additional precision specified is lost, and even when used in a
+@code{REAL(KIND=2)} context), @samp{1E0} is always type @code{REAL(KIND=2)},
+and @samp{1D0} is always type @code{REAL(KIND=2)}.
+
+@node Integer Type
+@subsection Integer Type
+
+(Corresponds to Section 4.3 of ANSI X3.9-1978 FORTRAN 77.)
+
+An integer constant also may have one of the following forms:
+
+@smallexample
+B'@var{binary-digits}'
+O'@var{octal-digits}'
+Z'@var{hexadecimal-digits}'
+X'@var{hexadecimal-digits}'
+@end smallexample
+
+@noindent
+@var{binary-digits}, @var{octal-digits}, and @var{hexadecimal-digits}
+are nonempty strings of characters in the set @samp{01}, @samp{01234567},
+and @samp{0123456789ABCDEFabcdef}, respectively.
+(The value for @samp{A} (and @samp{a}) is 10, for @samp{B} and @samp{b}
+is 11, and so on.)
+
+@node Character Type
+@subsection Character Type
+
+(Corresponds to Section 4.8 of ANSI X3.9-1978 FORTRAN 77.)
+
+@cindex double quoted character constants
+A character constant may be delimited by a pair of double quotes
+(@samp{"}) instead of apostrophes.
+In this case, an apostrophe within the constant represents
+a single apostrophe, while a double quote is represented in
+the source text of the constant by two consecutive double
+quotes with no intervening spaces.
+
+@cindex zero-length CHARACTER
+@cindex null CHARACTER strings
+@cindex empty CHARACTER strings
+@cindex strings, empty
+@cindex CHARACTER, null
+A character constant may be empty (have a length of zero).
+
+A character constant may include a substring specification,
+The value of such a constant is the value of the substring---for
+example, the value of @samp{'hello'(3:5)} is the same
+as the value of @samp{'llo'}.
+
+@node Expressions
+@section Expressions
+
+(The following information augments or overrides the information in
+Chapter 6 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 6 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+@menu
+* %LOC()::
+@end menu
+
+@node %LOC()
+@subsection The @code{%LOC()} Construct
+@cindex %LOC() construct
+
+@example
+%LOC(@var{arg})
+@end example
+
+The @code{%LOC()} construct is an expression
+that yields the value of the location of its argument,
+@var{arg}, in memory.
+The size of the type of the expression depends on the system---typically,
+it is equivalent to either @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=2)},
+though it is actually type @code{INTEGER(KIND=7)}.
+
+The argument to @code{%LOC()} must be suitable as the
+left-hand side of an assignment statement.
+That is, it may not be a general expression involving
+operators such as addition, subtraction, and so on,
+nor may it be a constant.
+
+Use of @code{%LOC()} is recommended only for code that
+is accessing facilities outside of GNU Fortran, such as
+operating system or windowing facilities.
+It is best to constrain such uses to isolated portions of
+a program---portions that deal specifically and exclusively
+with low-level, system-dependent facilities.
+Such portions might well provide a portable interface for
+use by the program as a whole, but are themselves not
+portable, and should be thoroughly tested each time they
+are rebuilt using a new compiler or version of a compiler.
+
+Do not depend on @code{%LOC()} returning a pointer that
+can be safely used to @emph{define} (change) the argument.
+While this might work in some circumstances, it is hard
+to predict whether it will continue to work when a program
+(that works using this unsafe behavior)
+is recompiled using different command-line options or
+a different version of @command{g77}.
+
+Generally, @code{%LOC()} is safe when used as an argument
+to a procedure that makes use of the value of the corresponding
+dummy argument only during its activation, and only when
+such use is restricted to referencing (reading) the value
+of the argument to @code{%LOC()}.
+
+@emph{Implementation Note:} Currently, @command{g77} passes
+arguments (those not passed using a construct such as @code{%VAL()})
+by reference or descriptor, depending on the type of
+the actual argument.
+Thus, given @samp{INTEGER I}, @samp{CALL FOO(I)} would
+seem to mean the same thing as @samp{CALL FOO(%VAL(%LOC(I)))}, and
+in fact might compile to identical code.
+
+However, @samp{CALL FOO(%VAL(%LOC(I)))} emphatically means
+``pass, by value, the address of @samp{I} in memory''.
+While @samp{CALL FOO(I)} might use that same approach in a
+particular version of @command{g77}, another version or compiler
+might choose a different implementation, such as copy-in/copy-out,
+to effect the desired behavior---and which will therefore not
+necessarily compile to the same code as would
+@samp{CALL FOO(%VAL(%LOC(I)))}
+using the same version or compiler.
+
+@xref{Debugging and Interfacing}, for detailed information on
+how this particular version of @command{g77} implements various
+constructs.
+
+@node Specification Statements
+@section Specification Statements
+
+(The following information augments or overrides the information in
+Chapter 8 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 8 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+@menu
+* NAMELIST::
+* DOUBLE COMPLEX::
+@end menu
+
+@node NAMELIST
+@subsection @code{NAMELIST} Statement
+@cindex NAMELIST statement
+@cindex statements, NAMELIST
+
+The @code{NAMELIST} statement, and related I/O constructs, are
+supported by the GNU Fortran language in essentially the same
+way as they are by @command{f2c}.
+
+This follows Fortran 90 with the restriction that on @code{NAMELIST}
+input, subscripts must have the form
+@smallexample
+@var{subscript} [ @code{:} @var{subscript} [ @code{:} @var{stride}]]
+@end smallexample
+i.e.@:
+@smallexample
+&xx x(1:3,8:10:2)=1,2,3,4,5,6/
+@end smallexample
+is allowed, but not, say,
+@smallexample
+&xx x(:3,8::2)=1,2,3,4,5,6/
+@end smallexample
+
+As an extension of the Fortran 90 form, @code{$} and @code{$END} may be
+used in place of @code{&} and @code{/} in @code{NAMELIST} input, so that
+@smallexample
+$&xx x(1:3,8:10:2)=1,2,3,4,5,6 $end
+@end smallexample
+could be used instead of the example above.
+
+@node DOUBLE COMPLEX
+@subsection @code{DOUBLE COMPLEX} Statement
+@cindex DOUBLE COMPLEX
+
+@code{DOUBLE COMPLEX} is a type-statement (and type) that
+specifies the type @code{COMPLEX(KIND=2)} in GNU Fortran.
+
+@node Control Statements
+@section Control Statements
+
+(The following information augments or overrides the information in
+Chapter 11 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 11 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+@menu
+* DO WHILE::
+* END DO::
+* Construct Names::
+* CYCLE and EXIT::
+@end menu
+
+@node DO WHILE
+@subsection DO WHILE
+@cindex DO WHILE
+@cindex DO
+@cindex MIL-STD 1753
+
+The @code{DO WHILE} statement, a feature of both the MIL-STD 1753 and
+Fortran 90 standards, is provided by the GNU Fortran language.
+The Fortran 90 ``do forever'' statement comprising just @code{DO} is
+also supported.
+
+@node END DO
+@subsection END DO
+@cindex END DO
+@cindex MIL-STD 1753
+
+The @code{END DO} statement is provided by the GNU Fortran language.
+
+This statement is used in one of two ways:
+
+@itemize @bullet
+@item
+The Fortran 90 meaning, in which it specifies the termination
+point of a single @code{DO} loop started with a @code{DO} statement
+that specifies no termination label.
+
+@item
+The MIL-STD 1753 meaning, in which it specifies the termination
+point of one or more @code{DO} loops, all of which start with a
+@code{DO} statement that specify the label defined for the
+@code{END DO} statement.
+
+This kind of @code{END DO} statement is merely a synonym for
+@code{CONTINUE}, except it is permitted only when the statement
+is labeled and a target of one or more labeled @code{DO} loops.
+
+It is expected that this use of @code{END DO} will be removed from
+the GNU Fortran language in the future, though it is likely that
+it will long be supported by @command{g77} as a dialect form.
+@end itemize
+
+@node Construct Names
+@subsection Construct Names
+@cindex construct names
+
+The GNU Fortran language supports construct names as defined
+by the Fortran 90 standard.
+These names are local to the program unit and are defined
+as follows:
+
+@smallexample
+@var{construct-name}: @var{block-statement}
+@end smallexample
+
+@noindent
+Here, @var{construct-name} is the construct name itself;
+its definition is connoted by the single colon (@samp{:}); and
+@var{block-statement} is an @code{IF}, @code{DO},
+or @code{SELECT CASE} statement that begins a block.
+
+A block that is given a construct name must also specify the
+same construct name in its termination statement:
+
+@example
+END @var{block} @var{construct-name}
+@end example
+
+@noindent
+Here, @var{block} must be @code{IF}, @code{DO}, or @code{SELECT},
+as appropriate.
+
+@node CYCLE and EXIT
+@subsection The @code{CYCLE} and @code{EXIT} Statements
+
+@cindex CYCLE statement
+@cindex EXIT statement
+@cindex statements, CYCLE
+@cindex statements, EXIT
+The @code{CYCLE} and @code{EXIT} statements specify that
+the remaining statements in the current iteration of a
+particular active (enclosing) @code{DO} loop are to be skipped.
+
+@code{CYCLE} specifies that these statements are skipped,
+but the @code{END DO} statement that marks the end of the
+@code{DO} loop be executed---that is, the next iteration,
+if any, is to be started.
+If the statement marking the end of the @code{DO} loop is
+not @code{END DO}---in other words, if the loop is not
+a block @code{DO}---the @code{CYCLE} statement does not
+execute that statement, but does start the next iteration (if any).
+
+@code{EXIT} specifies that the loop specified by the
+@code{DO} construct is terminated.
+
+The @code{DO} loop affected by @code{CYCLE} and @code{EXIT}
+is the innermost enclosing @code{DO} loop when the following
+forms are used:
+
+@example
+CYCLE
+EXIT
+@end example
+
+Otherwise, the following forms specify the construct name
+of the pertinent @code{DO} loop:
+
+@example
+CYCLE @var{construct-name}
+EXIT @var{construct-name}
+@end example
+
+@code{CYCLE} and @code{EXIT} can be viewed as glorified @code{GO TO}
+statements.
+However, they cannot be easily thought of as @code{GO TO} statements
+in obscure cases involving FORTRAN 77 loops.
+For example:
+
+@smallexample
+      DO 10 I = 1, 5
+      DO 10 J = 1, 5
+         IF (J .EQ. 5) EXIT
+      DO 10 K = 1, 5
+         IF (K .EQ. 3) CYCLE
+10    PRINT *, 'I=', I, ' J=', J, ' K=', K
+20    CONTINUE
+@end smallexample
+
+@noindent
+In particular, neither the @code{EXIT} nor @code{CYCLE} statements
+above are equivalent to a @code{GO TO} statement to either label
+@samp{10} or @samp{20}.
+
+To understand the effect of @code{CYCLE} and @code{EXIT} in the
+above fragment, it is helpful to first translate it to its equivalent
+using only block @code{DO} loops:
+
+@smallexample
+      DO I = 1, 5
+         DO J = 1, 5
+            IF (J .EQ. 5) EXIT
+            DO K = 1, 5
+               IF (K .EQ. 3) CYCLE
+10             PRINT *, 'I=', I, ' J=', J, ' K=', K
+            END DO
+         END DO
+      END DO
+20    CONTINUE
+@end smallexample
+
+Adding new labels allows translation of @code{CYCLE} and @code{EXIT}
+to @code{GO TO} so they may be more easily understood by programmers
+accustomed to FORTRAN coding:
+
+@smallexample
+      DO I = 1, 5
+         DO J = 1, 5
+            IF (J .EQ. 5) GOTO 18
+            DO K = 1, 5
+               IF (K .EQ. 3) GO TO 12
+10             PRINT *, 'I=', I, ' J=', J, ' K=', K
+12          END DO
+         END DO
+18    END DO
+20    CONTINUE
+@end smallexample
+
+@noindent
+Thus, the @code{CYCLE} statement in the innermost loop skips over
+the @code{PRINT} statement as it begins the next iteration of the
+loop, while the @code{EXIT} statement in the middle loop ends that
+loop but @emph{not} the outermost loop.
+
+@node Functions and Subroutines
+@section Functions and Subroutines
+
+(The following information augments or overrides the information in
+Chapter 15 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 15 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+@menu
+* %VAL()::
+* %REF()::
+* %DESCR()::
+* Generics and Specifics::
+* REAL() and AIMAG() of Complex::
+* CMPLX() of DOUBLE PRECISION::
+* MIL-STD 1753::
+* f77/f2c Intrinsics::
+* Table of Intrinsic Functions::
+@end menu
+
+@node %VAL()
+@subsection The @code{%VAL()} Construct
+@cindex %VAL() construct
+
+@example
+%VAL(@var{arg})
+@end example
+
+The @code{%VAL()} construct specifies that an argument,
+@var{arg}, is to be passed by value, instead of by reference
+or descriptor.
+
+@code{%VAL()} is restricted to actual arguments in
+invocations of external procedures.
+
+Use of @code{%VAL()} is recommended only for code that
+is accessing facilities outside of GNU Fortran, such as
+operating system or windowing facilities.
+It is best to constrain such uses to isolated portions of
+a program---portions the deal specifically and exclusively
+with low-level, system-dependent facilities.
+Such portions might well provide a portable interface for
+use by the program as a whole, but are themselves not
+portable, and should be thoroughly tested each time they
+are rebuilt using a new compiler or version of a compiler.
+
+@emph{Implementation Note:} Currently, @command{g77} passes
+all arguments either by reference or by descriptor.
+
+Thus, use of @code{%VAL()} tends to be restricted to cases
+where the called procedure is written in a language other
+than Fortran that supports call-by-value semantics.
+(C is an example of such a language.)
+
+@xref{Procedures,,Procedures (SUBROUTINE and FUNCTION)},
+for detailed information on
+how this particular version of @command{g77} passes arguments
+to procedures.
+
+@node %REF()
+@subsection The @code{%REF()} Construct
+@cindex %REF() construct
+
+@example
+%REF(@var{arg})
+@end example
+
+The @code{%REF()} construct specifies that an argument,
+@var{arg}, is to be passed by reference, instead of by
+value or descriptor.
+
+@code{%REF()} is restricted to actual arguments in
+invocations of external procedures.
+
+Use of @code{%REF()} is recommended only for code that
+is accessing facilities outside of GNU Fortran, such as
+operating system or windowing facilities.
+It is best to constrain such uses to isolated portions of
+a program---portions the deal specifically and exclusively
+with low-level, system-dependent facilities.
+Such portions might well provide a portable interface for
+use by the program as a whole, but are themselves not
+portable, and should be thoroughly tested each time they
+are rebuilt using a new compiler or version of a compiler.
+
+Do not depend on @code{%REF()} supplying a pointer to the
+procedure being invoked.
+While that is a likely implementation choice, other
+implementation choices are available that preserve Fortran
+pass-by-reference semantics without passing a pointer to
+the argument, @var{arg}.
+(For example, a copy-in/copy-out implementation.)
+
+@emph{Implementation Note:} Currently, @command{g77} passes
+all arguments
+(other than variables and arrays of type @code{CHARACTER})
+by reference.
+Future versions of, or dialects supported by, @command{g77} might
+not pass @code{CHARACTER} functions by reference.
+
+Thus, use of @code{%REF()} tends to be restricted to cases
+where @var{arg} is type @code{CHARACTER} but the called
+procedure accesses it via a means other than the method
+used for Fortran @code{CHARACTER} arguments.
+
+@xref{Procedures,,Procedures (SUBROUTINE and FUNCTION)}, for detailed information on
+how this particular version of @command{g77} passes arguments
+to procedures.
+
+@node %DESCR()
+@subsection The @code{%DESCR()} Construct
+@cindex %DESCR() construct
+
+@example
+%DESCR(@var{arg})
+@end example
+
+The @code{%DESCR()} construct specifies that an argument,
+@var{arg}, is to be passed by descriptor, instead of by
+value or reference.
+
+@code{%DESCR()} is restricted to actual arguments in
+invocations of external procedures.
+
+Use of @code{%DESCR()} is recommended only for code that
+is accessing facilities outside of GNU Fortran, such as
+operating system or windowing facilities.
+It is best to constrain such uses to isolated portions of
+a program---portions the deal specifically and exclusively
+with low-level, system-dependent facilities.
+Such portions might well provide a portable interface for
+use by the program as a whole, but are themselves not
+portable, and should be thoroughly tested each time they
+are rebuilt using a new compiler or version of a compiler.
+
+Do not depend on @code{%DESCR()} supplying a pointer
+and/or a length passed by value
+to the procedure being invoked.
+While that is a likely implementation choice, other
+implementation choices are available that preserve the
+pass-by-reference semantics without passing a pointer to
+the argument, @var{arg}.
+(For example, a copy-in/copy-out implementation.)
+And, future versions of @command{g77} might change the
+way descriptors are implemented, such as passing a
+single argument pointing to a record containing the
+pointer/length information instead of passing that same
+information via two arguments as it currently does.
+
+@emph{Implementation Note:} Currently, @command{g77} passes
+all variables and arrays of type @code{CHARACTER}
+by descriptor.
+Future versions of, or dialects supported by, @command{g77} might
+pass @code{CHARACTER} functions by descriptor as well.
+
+Thus, use of @code{%DESCR()} tends to be restricted to cases
+where @var{arg} is not type @code{CHARACTER} but the called
+procedure accesses it via a means similar to the method
+used for Fortran @code{CHARACTER} arguments.
+
+@xref{Procedures,,Procedures (SUBROUTINE and FUNCTION)}, for detailed information on
+how this particular version of @command{g77} passes arguments
+to procedures.
+
+@node Generics and Specifics
+@subsection Generics and Specifics
+@cindex generic intrinsics
+@cindex intrinsics, generic
+
+The ANSI FORTRAN 77 language defines generic and specific
+intrinsics.
+In short, the distinctions are:
+
+@itemize @bullet
+@item
+@emph{Specific} intrinsics have
+specific types for their arguments and a specific return
+type.
+
+@item
+@emph{Generic} intrinsics are treated,
+on a case-by-case basis in the program's source code,
+as one of several possible specific intrinsics.
+
+Typically, a generic intrinsic has a return type that
+is determined by the type of one or more of its arguments.
+@end itemize
+
+The GNU Fortran language generalizes these concepts somewhat,
+especially by providing intrinsic subroutines and generic
+intrinsics that are treated as either a specific intrinsic subroutine
+or a specific intrinsic function (e.g. @code{SECOND}).
+
+However, GNU Fortran avoids generalizing this concept to
+the point where existing code would be accepted as meaning
+something possibly different than what was intended.
+
+For example, @code{ABS} is a generic intrinsic, so all working
+code written using @code{ABS} of an @code{INTEGER} argument
+expects an @code{INTEGER} return value.
+Similarly, all such code expects that @code{ABS} of an @code{INTEGER*2}
+argument returns an @code{INTEGER*2} return value.
+
+Yet, @code{IABS} is a @emph{specific} intrinsic that accepts only
+an @code{INTEGER(KIND=1)} argument.
+Code that passes something other than an @code{INTEGER(KIND=1)}
+argument to @code{IABS} is not valid GNU Fortran code, because
+it is not clear what the author intended.
+
+For example, if @samp{J} is @code{INTEGER(KIND=6)}, @samp{IABS(J)}
+is not defined by the GNU Fortran language, because the programmer
+might have used that construct to mean any of the following, subtly
+different, things:
+
+@itemize @bullet
+@item
+Convert @samp{J} to @code{INTEGER(KIND=1)} first
+(as if @samp{IABS(INT(J))} had been written).
+
+@item
+Convert the result of the intrinsic to @code{INTEGER(KIND=1)}
+(as if @samp{INT(ABS(J))} had been written).
+
+@item
+No conversion (as if @samp{ABS(J)} had been written).
+@end itemize
+
+The distinctions matter especially when types and values wider than
+@code{INTEGER(KIND=1)} (such as @code{INTEGER(KIND=2)}), or when
+operations performing more ``arithmetic'' than absolute-value, are involved.
+
+The following sample program is not a valid GNU Fortran program, but
+might be accepted by other compilers.
+If so, the output is likely to be revealing in terms of how a given
+compiler treats intrinsics (that normally are specific) when they
+are given arguments that do not conform to their stated requirements:
+
+@cindex JCB002 program
+@smallexample
+      PROGRAM JCB002
+C Version 1:
+C Modified 1999-02-15 (Burley) to delete my email address.
+C Modified 1997-05-21 (Burley) to accommodate compilers that implement
+C INT(I1-I2) as INT(I1)-INT(I2) given INTEGER*2 I1,I2.
+C
+C Version 0:
+C Written by James Craig Burley 1997-02-20.
+C
+C Purpose:
+C Determine how compilers handle non-standard IDIM
+C on INTEGER*2 operands, which presumably can be
+C extrapolated into understanding how the compiler
+C generally treats specific intrinsics that are passed
+C arguments not of the correct types.
+C
+C If your compiler implements INTEGER*2 and INTEGER
+C as the same type, change all INTEGER*2 below to
+C INTEGER*1.
+C
+      INTEGER*2 I0, I4
+      INTEGER I1, I2, I3
+      INTEGER*2 ISMALL, ILARGE
+      INTEGER*2 ITOOLG, ITWO
+      INTEGER*2 ITMP
+      LOGICAL L2, L3, L4
+C
+C Find smallest INTEGER*2 number.
+C
+      ISMALL=0
+ 10   I0 = ISMALL-1
+      IF ((I0 .GE. ISMALL) .OR. (I0+1 .NE. ISMALL)) GOTO 20
+      ISMALL = I0
+      GOTO 10
+ 20   CONTINUE
+C
+C Find largest INTEGER*2 number.
+C
+      ILARGE=0
+ 30   I0 = ILARGE+1
+      IF ((I0 .LE. ILARGE) .OR. (I0-1 .NE. ILARGE)) GOTO 40
+      ILARGE = I0
+      GOTO 30
+ 40   CONTINUE
+C
+C Multiplying by two adds stress to the situation.
+C
+      ITWO = 2
+C
+C Need a number that, added to -2, is too wide to fit in I*2.
+C
+      ITOOLG = ISMALL
+C
+C Use IDIM the straightforward way.
+C
+      I1 = IDIM (ILARGE, ISMALL) * ITWO + ITOOLG
+C
+C Calculate result for first interpretation.
+C
+      I2 = (INT (ILARGE) - INT (ISMALL)) * ITWO + ITOOLG
+C
+C Calculate result for second interpretation.
+C
+      ITMP = ILARGE - ISMALL
+      I3 = (INT (ITMP)) * ITWO + ITOOLG
+C
+C Calculate result for third interpretation.
+C
+      I4 = (ILARGE - ISMALL) * ITWO + ITOOLG
+C
+C Print results.
+C
+      PRINT *, 'ILARGE=', ILARGE
+      PRINT *, 'ITWO=', ITWO
+      PRINT *, 'ITOOLG=', ITOOLG
+      PRINT *, 'ISMALL=', ISMALL
+      PRINT *, 'I1=', I1
+      PRINT *, 'I2=', I2
+      PRINT *, 'I3=', I3
+      PRINT *, 'I4=', I4
+      PRINT *
+      L2 = (I1 .EQ. I2)
+      L3 = (I1 .EQ. I3)
+      L4 = (I1 .EQ. I4)
+      IF (L2 .AND. .NOT.L3 .AND. .NOT.L4) THEN
+         PRINT *, 'Interp 1: IDIM(I*2,I*2) => IDIM(INT(I*2),INT(I*2))'
+         STOP
+      END IF
+      IF (L3 .AND. .NOT.L2 .AND. .NOT.L4) THEN
+         PRINT *, 'Interp 2: IDIM(I*2,I*2) => INT(DIM(I*2,I*2))'
+         STOP
+      END IF
+      IF (L4 .AND. .NOT.L2 .AND. .NOT.L3) THEN
+         PRINT *, 'Interp 3: IDIM(I*2,I*2) => DIM(I*2,I*2)'
+         STOP
+      END IF
+      PRINT *, 'Results need careful analysis.'
+      END
+@end smallexample
+
+No future version of the GNU Fortran language
+will likely permit specific intrinsic invocations with wrong-typed
+arguments (such as @code{IDIM} in the above example), since
+it has been determined that disagreements exist among
+many production compilers on the interpretation of
+such invocations.
+These disagreements strongly suggest that Fortran programmers,
+and certainly existing Fortran programs, disagree about the
+meaning of such invocations.
+
+The first version of @code{JCB002} didn't accommodate some compilers'
+treatment of @samp{INT(I1-I2)} where @samp{I1} and @samp{I2} are
+@code{INTEGER*2}.
+In such a case, these compilers apparently convert both
+operands to @code{INTEGER*4} and then do an @code{INTEGER*4} subtraction,
+instead of doing an @code{INTEGER*2} subtraction on the
+original values in @samp{I1} and @samp{I2}.
+
+However, the results of the careful analyses done on the outputs
+of programs compiled by these various compilers show that they
+all implement either @samp{Interp 1} or @samp{Interp 2} above.
+
+Specifically, it is believed that the new version of @code{JCB002}
+above will confirm that:
+
+@itemize @bullet
+@item
+Digital Semiconductor (``DEC'') Alpha OSF/1, HP-UX 10.0.1, AIX 3.2.5
+@command{f77} compilers all implement @samp{Interp 1}.
+
+@item
+IRIX 5.3 @command{f77} compiler implements @samp{Interp 2}.
+
+@item
+Solaris 2.5, SunOS 4.1.3, DECstation ULTRIX 4.3,
+and IRIX 6.1 @command{f77} compilers all implement @samp{Interp 3}.
+@end itemize
+
+If you get different results than the above for the stated
+compilers, or have results for other compilers that might be
+worth adding to the above list, please let us know the details
+(compiler product, version, machine, results, and so on).
+
+@node REAL() and AIMAG() of Complex
+@subsection @code{REAL()} and @code{AIMAG()} of Complex
+@cindex @code{Real} intrinsic
+@cindex intrinsics, @code{Real}
+@cindex @code{AImag} intrinsic
+@cindex intrinsics, @code{AImag}
+
+The GNU Fortran language disallows @code{REAL(@var{expr})}
+and @code{AIMAG(@var{expr})},
+where @var{expr} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)},
+except when they are used in the following way:
+
+@example
+REAL(REAL(@var{expr}))
+REAL(AIMAG(@var{expr}))
+@end example
+
+@noindent
+The above forms explicitly specify that the desired effect
+is to convert the real or imaginary part of @var{expr}, which might
+be some @code{REAL} type other than @code{REAL(KIND=1)},
+to type @code{REAL(KIND=1)},
+and have that serve as the value of the expression.
+
+The GNU Fortran language offers clearly named intrinsics to extract the
+real and imaginary parts of a complex entity without any
+conversion:
+
+@example
+REALPART(@var{expr})
+IMAGPART(@var{expr})
+@end example
+
+To express the above using typical extended FORTRAN 77,
+use the following constructs
+(when @var{expr} is @code{COMPLEX(KIND=2)}):
+
+@example
+DBLE(@var{expr})
+DIMAG(@var{expr})
+@end example
+
+The FORTRAN 77 language offers no way
+to explicitly specify the real and imaginary parts of a complex expression of
+arbitrary type, apparently as a result of requiring support for
+only one @code{COMPLEX} type (@code{COMPLEX(KIND=1)}).
+The concepts of converting an expression to type @code{REAL(KIND=1)} and
+of extracting the real part of a complex expression were
+thus ``smooshed'' by FORTRAN 77 into a single intrinsic, since
+they happened to have the exact same effect in that language
+(due to having only one @code{COMPLEX} type).
+
+@emph{Note:} When @option{-ff90} is in effect,
+@command{g77} treats @samp{REAL(@var{expr})}, where @var{expr} is of
+type @code{COMPLEX}, as @samp{REALPART(@var{expr})},
+whereas with @samp{-fugly-complex -fno-f90} in effect, it is
+treated as @samp{REAL(REALPART(@var{expr}))}.
+
+@xref{Ugly Complex Part Extraction}, for more information.
+
+@node CMPLX() of DOUBLE PRECISION
+@subsection @code{CMPLX()} of @code{DOUBLE PRECISION}
+@cindex @code{Cmplx} intrinsic
+@cindex intrinsics, @code{Cmplx}
+
+In accordance with Fortran 90 and at least some (perhaps all)
+other compilers, the GNU Fortran language defines @code{CMPLX()}
+as always returning a result that is type @code{COMPLEX(KIND=1)}.
+
+This means @samp{CMPLX(D1,D2)}, where @samp{D1} and @samp{D2}
+are @code{REAL(KIND=2)} (@code{DOUBLE PRECISION}), is treated as:
+
+@example
+CMPLX(SNGL(D1), SNGL(D2))
+@end example
+
+(It was necessary for Fortran 90 to specify this behavior
+for @code{DOUBLE PRECISION} arguments, since that is
+the behavior mandated by FORTRAN 77.)
+
+The GNU Fortran language also provides the @code{DCMPLX()} intrinsic,
+which is provided by some FORTRAN 77 compilers to construct
+a @code{DOUBLE COMPLEX} entity from of @code{DOUBLE PRECISION}
+operands.
+However, this solution does not scale well when more @code{COMPLEX} types
+(having various precisions and ranges) are offered by Fortran implementations.
+
+Fortran 90 extends the @code{CMPLX()} intrinsic by adding
+an extra argument used to specify the desired kind of complex
+result.
+However, this solution is somewhat awkward to use, and
+@command{g77} currently does not support it.
+
+The GNU Fortran language provides a simple way to build a complex
+value out of two numbers, with the precise type of the value
+determined by the types of the two numbers (via the usual
+type-promotion mechanism):
+
+@example
+COMPLEX(@var{real}, @var{imag})
+@end example
+
+When @var{real} and @var{imag} are the same @code{REAL} types, @code{COMPLEX()}
+performs no conversion other than to put them together to form a
+complex result of the same (complex version of real) type.
+
+@xref{Complex Intrinsic}, for more information.
+
+@node MIL-STD 1753
+@subsection MIL-STD 1753 Support
+@cindex MIL-STD 1753
+
+The GNU Fortran language includes the MIL-STD 1753 intrinsics
+@code{BTEST}, @code{IAND}, @code{IBCLR}, @code{IBITS},
+@code{IBSET}, @code{IEOR}, @code{IOR}, @code{ISHFT},
+@code{ISHFTC}, @code{MVBITS}, and @code{NOT}.
+
+@node f77/f2c Intrinsics
+@subsection @command{f77}/@command{f2c} Intrinsics
+
+The bit-manipulation intrinsics supported by traditional
+@command{f77} and by @command{f2c} are available in the GNU Fortran language.
+These include @code{AND}, @code{LSHIFT}, @code{OR}, @code{RSHIFT},
+and @code{XOR}.
+
+Also supported are the intrinsics @code{CDABS},
+@code{CDCOS}, @code{CDEXP}, @code{CDLOG}, @code{CDSIN},
+@code{CDSQRT}, @code{DCMPLX}, @code{DCONJG}, @code{DFLOAT},
+@code{DIMAG}, @code{DREAL}, and @code{IMAG},
+@code{ZABS}, @code{ZCOS}, @code{ZEXP}, @code{ZLOG}, @code{ZSIN},
+and @code{ZSQRT}.
+
+@node Table of Intrinsic Functions
+@subsection Table of Intrinsic Functions
+@cindex intrinsics, table of
+@cindex table of intrinsics
+
+(Corresponds to Section 15.10 of ANSI X3.9-1978 FORTRAN 77.)
+
+The GNU Fortran language adds various functions, subroutines, types,
+and arguments to the set of intrinsic functions in ANSI FORTRAN 77.
+The complete set of intrinsics supported by the GNU Fortran language
+is described below.
+
+Note that a name is not treated as that of an intrinsic if it is
+specified in an @code{EXTERNAL} statement in the same program unit;
+if a command-line option is used to disable the groups to which
+the intrinsic belongs; or if the intrinsic is not named in an
+@code{INTRINSIC} statement and a command-line option is used to
+hide the groups to which the intrinsic belongs.
+
+So, it is recommended that any reference in a program unit to
+an intrinsic procedure that is not a standard FORTRAN 77
+intrinsic be accompanied by an appropriate @code{INTRINSIC}
+statement in that program unit.
+This sort of defensive programming makes it more
+likely that an implementation will issue a diagnostic rather
+than generate incorrect code for such a reference.
+
+The terminology used below is based on that of the Fortran 90
+standard, so that the text may be more concise and accurate:
+
+@itemize @bullet
+@item
+@code{OPTIONAL} means the argument may be omitted.
+
+@item
+@samp{A-1, A-2, @dots{}, A-n} means more than one argument
+(generally named @samp{A}) may be specified.
+
+@item
+@samp{scalar} means the argument must not be an array (must
+be a variable or array element, or perhaps a constant if expressions
+are permitted).
+
+@item
+@samp{DIMENSION(4)} means the argument must be an array having 4 elements.
+
+@item
+@code{INTENT(IN)} means the argument must be an expression
+(such as a constant or a variable that is defined upon invocation
+of the intrinsic).
+
+@item
+@code{INTENT(OUT)} means the argument must be definable by the
+invocation of the intrinsic (that is, must not be a constant nor
+an expression involving operators other than array reference and
+substring reference).
+
+@item
+@code{INTENT(INOUT)} means the argument must be defined prior to,
+and definable by, invocation of the intrinsic (a combination of
+the requirements of @code{INTENT(IN)} and @code{INTENT(OUT)}.
+
+@item
+@xref{Kind Notation}, for an explanation of @code{KIND}.
+@end itemize
+
+@ifinfo
+(Note that the empty lines appearing in the menu below
+are not intentional---they result from a bug in the
+GNU @command{makeinfo} program@dots{}a program that, if it
+did not exist, would leave this document in far worse shape!)
+@end ifinfo
+
+@c The actual documentation for intrinsics comes from
+@c intdoc.texi, which in turn is automatically generated
+@c from the internal g77 tables in intrin.def _and_ the
+@c largely hand-written text in intdoc.h.  So, if you want
+@c to change or add to existing documentation on intrinsics,
+@c you probably want to edit intdoc.h.
+@c
+@set familyF77
+@set familyGNU
+@set familyASC
+@set familyMIL
+@set familyF90
+@clear familyVXT
+@clear familyFVZ
+@set familyF2C
+@set familyF2U
+@clear familyBADU77
+@include intdoc.texi
+
+@node Scope and Classes of Names
+@section Scope and Classes of Symbolic Names
+@cindex symbol names, scope and classes
+@cindex scope
+
+(The following information augments or overrides the information in
+Chapter 18 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
+language.
+Chapter 18 of that document otherwise serves as the basis
+for the relevant aspects of GNU Fortran.)
+
+@menu
+* Underscores in Symbol Names::
+@end menu
+
+@node Underscores in Symbol Names
+@subsection Underscores in Symbol Names
+@cindex underscore
+
+Underscores (@samp{_}) are accepted in symbol names after the first
+character (which must be a letter).
+
+@node I/O
+@section I/O
+
+@cindex dollar sign
+A dollar sign at the end of an output format specification suppresses
+the newline at the end of the output.
+
+@cindex <> edit descriptor
+@cindex edit descriptor, <>
+Edit descriptors in @code{FORMAT} statements may contain compile-time
+@code{INTEGER} constant expressions in angle brackets, such as
+@smallexample
+10    FORMAT (I<WIDTH>)
+@end smallexample
+
+The @code{OPEN} specifier @code{NAME=} is equivalent to @code{FILE=}.
+
+These Fortran 90 features are supported:
+@itemize @bullet
+@item
+@cindex FORMAT descriptors
+@cindex Z edit descriptor
+@cindex edit descriptor, Z
+@cindex O edit descriptor
+@cindex edit descriptor, O
+The @code{O} and @code{Z} edit descriptors are supported for I/O of
+integers in octal and hexadecimal formats, respectively.
+@item
+The @code{FILE=} specifier may be omitted in an @code{OPEN} statement if
+@code{STATUS='SCRATCH'} is supplied.  The @code{STATUS='REPLACE'}
+specifier is supported.
+@end itemize
+
+@node Fortran 90 Features
+@section Fortran 90 Features
+@cindex Fortran 90
+@cindex extensions, from Fortran 90
+
+For convenience this section collects a list (probably incomplete) of
+the Fortran 90 features supported by the GNU Fortran language, even if
+they are documented elsewhere.
+@xref{Characters Lines Sequence,,@asis{Characters, Lines, and Execution Sequence}},
+for information on additional fixed source form lexical issues.
+@cindex @option{-ffree-form}
+Further, the free source form is supported through the
+@option{-ffree-form} option.
+@cindex @option{-ff90}
+Other Fortran 90 features can be turned on by the @option{-ff90} option;
+see @ref{Fortran 90}.
+For information on the Fortran 90 intrinsics available,
+see @ref{Table of Intrinsic Functions}.
+
+@table @asis
+@item Automatic arrays in procedures
+@item Character assignments
+@cindex character assignments
+In character assignments, the variable being assigned may occur on the
+right hand side of the assignment.
+@item Character strings
+@cindex double quoted character constants
+Strings may have zero length and substrings of character constants are
+permitted.  Character constants may be enclosed in double quotes
+(@code{"}) as well as single quotes.  @xref{Character Type}.
+@item Construct names
+(Symbolic tags on blocks.)  @xref{Construct Names}.
+@item @code{CYCLE} and @code{EXIT}
+@xref{CYCLE and EXIT,,The @code{CYCLE} and @code{EXIT} Statements}.
+@item @code{DOUBLE COMPLEX}
+@xref{DOUBLE COMPLEX,,@code{DOUBLE COMPLEX} Statement}.
+@item @code{DO WHILE}
+@xref{DO WHILE}.
+@item @code{END} decoration
+@xref{Statements}.
+@item @code{END DO}
+@xref{END DO}.
+@item @code{KIND}
+@item @code{IMPLICIT NONE}
+@item @code{INCLUDE} statements
+@xref{INCLUDE}.
+@item List-directed and namelist I/O on internal files
+@item Binary, octal and hexadecimal constants
+These are supported more generally than required by Fortran 90.
+@xref{Integer Type}.
+@item @samp{O} and @samp{Z} edit descriptors
+@item @code{NAMELIST}
+@xref{NAMELIST}.
+@item @code{OPEN} specifiers
+@code{STATUS='REPLACE'} is supported.
+The @code{FILE=} specifier may be omitted in an @code{OPEN} statement if
+@code{STATUS='SCRATCH'} is supplied.
+@item @code{FORMAT} edit descriptors
+@cindex FORMAT descriptors
+@cindex Z edit descriptor
+@cindex edit descriptor, Z
+The @code{Z} edit descriptor is supported.
+@item Relational operators
+The operators @code{<}, @code{<=}, @code{==}, @code{/=}, @code{>} and
+@code{>=} may be used instead of @code{.LT.}, @code{.LE.}, @code{.EQ.},
+@code{.NE.}, @code{.GT.} and @code{.GE.} respectively.
+@item @code{SELECT CASE}
+Not fully implemented.
+@xref{SELECT CASE on CHARACTER Type,, @code{SELECT CASE} on @code{CHARACTER} Type}.
+@item Specification statements
+A limited subset of the Fortran 90 syntax and semantics for variable
+declarations is supported, including @code{KIND}.  @xref{Kind Notation}.
+(@code{KIND} is of limited usefulness in the absence of the
+@code{KIND}-related intrinsics, since these intrinsics permit writing
+more widely portable code.)  An example of supported @code{KIND} usage
+is:
+@smallexample
+INTEGER (KIND=1) :: FOO=1, BAR=2
+CHARACTER (LEN=3) FOO
+@end smallexample
+@code{PARAMETER} and @code{DIMENSION} attributes aren't supported.
+@end table
+
+@node Other Dialects
+@chapter Other Dialects
+
+GNU Fortran supports a variety of features that are not
+considered part of the GNU Fortran language itself, but
+are representative of various dialects of Fortran that
+@command{g77} supports in whole or in part.
+
+Any of the features listed below might be disallowed by
+@command{g77} unless some command-line option is specified.
+Currently, some of the features are accepted using the
+default invocation of @command{g77}, but that might change
+in the future.
+
+@emph{Note: This portion of the documentation definitely needs a lot
+of work!}
+
+@menu
+* Source Form::       Details of fixed-form and free-form source.
+* Trailing Comment::  Use of @samp{/*} to start a comment.
+* Debug Line::        Use of @samp{D} in column 1.
+* Dollar Signs::      Use of @samp{$} in symbolic names.
+* Case Sensitivity::  Uppercase and lowercase in source files.
+* VXT Fortran::       @dots{}versus the GNU Fortran language.
+* Fortran 90::        @dots{}versus the GNU Fortran language.
+* Pedantic Compilation::  Enforcing the standard.
+* Distensions::       Misfeatures supported by GNU Fortran.
+@end menu
+
+@node Source Form
+@section Source Form
+@cindex source file format
+@cindex source format
+@cindex file, source
+@cindex source code
+@cindex code, source
+@cindex fixed form
+@cindex free form
+
+GNU Fortran accepts programs written in either fixed form or
+free form.
+
+Fixed form
+corresponds to ANSI FORTRAN 77 (plus popular extensions, such as
+allowing tabs) and Fortran 90's fixed form.
+
+Free form corresponds to
+Fortran 90's free form (though possibly not entirely up-to-date, and
+without complaining about some things that for which Fortran 90 requires
+diagnostics, such as the spaces in the constant in @samp{R = 3 . 1}).
+
+The way a Fortran compiler views source files depends entirely on the
+implementation choices made for the compiler, since those choices
+are explicitly left to the implementation by the published Fortran
+standards.
+GNU Fortran currently tries to be somewhat like a few popular compilers
+(@command{f2c}, Digital (``DEC'') Fortran, and so on).
+
+This section describes how @command{g77} interprets source lines.
+
+@menu
+* Carriage Returns::  Carriage returns ignored.
+* Tabs::              Tabs converted to spaces.
+* Short Lines::       Short lines padded with spaces (fixed-form only).
+* Long Lines::        Long lines truncated.
+* Ampersands::        Special Continuation Lines.
+@end menu
+
+@node Carriage Returns
+@subsection Carriage Returns
+@cindex carriage returns
+
+Carriage returns (@samp{\r}) in source lines are ignored.
+This is somewhat different from @command{f2c}, which seems to treat them as
+spaces outside character/Hollerith constants, and encodes them as @samp{\r}
+inside such constants.
+
+@node Tabs
+@subsection Tabs
+@cindex tab character
+@cindex horizontal tab
+
+A source line with a @key{TAB} character anywhere in it is treated as
+entirely significant---however long it is---instead of ending in
+column 72 (for fixed-form source) or 132 (for free-form source).
+This also is different from @command{f2c}, which encodes tabs as
+@samp{\t} (the ASCII @key{TAB} character) inside character
+and Hollerith constants, but nevertheless seems to treat the column
+position as if it had been affected by the canonical tab positioning.
+
+@command{g77} effectively
+translates tabs to the appropriate number of spaces (a la the default
+for the UNIX @command{expand} command) before doing any other processing, other
+than (currently) noting whether a tab was found on a line and using this
+information to decide how to interpret the length of the line and continued
+constants.
+
+@node Short Lines
+@subsection Short Lines
+@cindex short source lines
+@cindex space, padding with
+@cindex source lines, short
+@cindex lines, short
+
+Source lines shorter than the applicable fixed-form length are treated as
+if they were padded with spaces to that length.
+(None of this is relevant to source files written in free form.)
+
+This affects only
+continued character and Hollerith constants, and is a different
+interpretation than provided by some other popular compilers
+(although a bit more consistent with the traditional punched-card
+basis of Fortran and the way the Fortran standard expressed fixed
+source form).
+
+@command{g77} might someday offer an option to warn about cases where differences
+might be seen as a result of this treatment, and perhaps an option to
+specify the alternate behavior as well.
+
+Note that this padding cannot apply to lines that are effectively of
+infinite length---such lines are specified using command-line options
+like @option{-ffixed-line-length-none}, for example.
+
+@node Long Lines
+@subsection Long Lines
+@cindex long source lines
+@cindex truncation, of long lines
+@cindex lines, long
+@cindex source lines, long
+
+Source lines longer than the applicable length are truncated to that
+length.
+Currently, @command{g77} does not warn if the truncated characters are
+not spaces, to accommodate existing code written for systems that
+treated truncated text as commentary (especially in columns 73 through 80).
+
+@xref{Fortran Dialect Options,,Options Controlling Fortran Dialect},
+for information on the @option{-ffixed-line-length-@var{n}} option,
+which can be used to set the line length applicable to fixed-form
+source files.
+
+@node Ampersands
+@subsection Ampersand Continuation Line
+@cindex ampersand continuation line
+@cindex continuation line, ampersand
+
+A @samp{&} in column 1 of fixed-form source denotes an arbitrary-length
+continuation line, imitating the behavior of @command{f2c}.
+
+@node Trailing Comment
+@section Trailing Comment
+
+@cindex trailing comment
+@cindex comment
+@cindex characters, comment
+@cindex /*
+@cindex !
+@cindex exclamation point
+@command{g77} supports use of @samp{/*} to start a trailing
+comment.
+In the GNU Fortran language, @samp{!} is used for this purpose.
+
+@samp{/*} is not in the GNU Fortran language
+because the use of @samp{/*} in a program might
+suggest to some readers that a block, not trailing, comment is
+started (and thus ended by @samp{*/}, not end of line),
+since that is the meaning of @samp{/*} in C.
+
+Also, such readers might think they can use @samp{//} to start
+a trailing comment as an alternative to @samp{/*}, but
+@samp{//} already denotes concatenation, and such a ``comment''
+might actually result in a program that compiles without
+error (though it would likely behave incorrectly).
+
+@node Debug Line
+@section Debug Line
+@cindex debug line
+@cindex comment line, debug
+
+Use of @samp{D} or @samp{d} as the first character (column 1) of
+a source line denotes a debug line.
+
+In turn, a debug line is treated as either a comment line
+or a normal line, depending on whether debug lines are enabled.
+
+When treated as a comment line, a line beginning with @samp{D} or
+@samp{d} is treated as if it the first character was @samp{C} or @samp{c}, respectively.
+When treated as a normal line, such a line is treated as if
+the first character was @key{SPC} (space).
+
+(Currently, @command{g77} provides no means for treating debug
+lines as normal lines.)
+
+@node Dollar Signs
+@section Dollar Signs in Symbol Names
+@cindex dollar sign
+@cindex $
+
+Dollar signs (@samp{$}) are allowed in symbol names (after the first character)
+when the @option{-fdollar-ok} option is specified.
+
+@node Case Sensitivity
+@section Case Sensitivity
+@cindex case sensitivity
+@cindex source file format
+@cindex code, source
+@cindex source code
+@cindex uppercase letters
+@cindex lowercase letters
+@cindex letters, uppercase
+@cindex letters, lowercase
+
+GNU Fortran offers the programmer way too much flexibility in deciding
+how source files are to be treated vis-a-vis uppercase and lowercase
+characters.
+There are 66 useful settings that affect case sensitivity, plus 10
+settings that are nearly useless, with the remaining 116 settings
+being either redundant or useless.
+
+None of these settings have any effect on the contents of comments
+(the text after a @samp{c} or @samp{C} in Column 1, for example)
+or of character or Hollerith constants.
+Note that things like the @samp{E} in the statement
+@samp{CALL FOO(3.2E10)} and the @samp{TO} in @samp{ASSIGN 10 TO LAB}
+are considered built-in keywords, and so are affected by
+these settings.
+
+Low-level switches are identified in this section as follows:
+
+@itemize @w{}
+@item A
+Source Case Conversion:
+
+@itemize @w{}
+@item 0
+Preserve (see Note 1)
+@item 1
+Convert to Upper Case
+@item 2
+Convert to Lower Case
+@end itemize
+
+@item B
+Built-in Keyword Matching:
+
+@itemize @w{}
+@item 0
+Match Any Case (per-character basis)
+@item 1
+Match Upper Case Only
+@item 2
+Match Lower Case Only
+@item 3
+Match InitialCaps Only (see tables for spellings)
+@end itemize
+
+@item C
+Built-in Intrinsic Matching:
+
+@itemize @w{}
+@item 0
+Match Any Case (per-character basis)
+@item 1
+Match Upper Case Only
+@item 2
+Match Lower Case Only
+@item 3
+Match InitialCaps Only (see tables for spellings)
+@end itemize
+
+@item D
+User-defined Symbol Possibilities (warnings only):
+
+@itemize @w{}
+@item 0
+Allow Any Case (per-character basis)
+@item 1
+Allow Upper Case Only
+@item 2
+Allow Lower Case Only
+@item 3
+Allow InitialCaps Only (see Note 2)
+@end itemize
+@end itemize
+
+Note 1: @command{g77} eventually will support @code{NAMELIST} in a manner that is
+consistent with these source switches---in the sense that input will be
+expected to meet the same requirements as source code in terms
+of matching symbol names and keywords (for the exponent letters).
+
+Currently, however, @code{NAMELIST} is supported by @code{libg2c},
+which uppercases @code{NAMELIST} input and symbol names for matching.
+This means not only that @code{NAMELIST} output currently shows symbol
+(and keyword) names in uppercase even if lower-case source
+conversion (option A2) is selected, but that @code{NAMELIST} cannot be
+adequately supported when source case preservation (option A0)
+is selected.
+
+If A0 is selected, a warning message will be
+output for each @code{NAMELIST} statement to this effect.
+The behavior
+of the program is undefined at run time if two or more symbol names
+appear in a given @code{NAMELIST} such that the names are identical
+when converted to upper case (e.g. @samp{NAMELIST /X/ VAR, Var, var}).
+For complete and total elegance, perhaps there should be a warning
+when option A2 is selected, since the output of NAMELIST is currently
+in uppercase but will someday be lowercase (when a @code{libg77} is written),
+but that seems to be overkill for a product in beta test.
+
+Note 2: Rules for InitialCaps names are:
+
+@itemize @minus
+@item
+Must be a single uppercase letter, @strong{or}
+@item
+Must start with an uppercase letter and contain at least one
+lowercase letter.
+@end itemize
+
+So @samp{A}, @samp{Ab}, @samp{ABc}, @samp{AbC}, and @samp{Abc} are
+valid InitialCaps names, but @samp{AB}, @samp{A2}, and @samp{ABC} are
+not.
+Note that most, but not all, built-in names meet these
+requirements---the exceptions are some of the two-letter format
+specifiers, such as @code{BN} and @code{BZ}.
+
+Here are the names of the corresponding command-line options:
+
+@smallexample
+A0: -fsource-case-preserve
+A1: -fsource-case-upper
+A2: -fsource-case-lower
+
+B0: -fmatch-case-any
+B1: -fmatch-case-upper
+B2: -fmatch-case-lower
+B3: -fmatch-case-initcap
+
+C0: -fintrin-case-any
+C1: -fintrin-case-upper
+C2: -fintrin-case-lower
+C3: -fintrin-case-initcap
+
+D0: -fsymbol-case-any
+D1: -fsymbol-case-upper
+D2: -fsymbol-case-lower
+D3: -fsymbol-case-initcap
+@end smallexample
+
+Useful combinations of the above settings, along with abbreviated
+option names that set some of these combinations all at once:
+
+@smallexample
+ 1: A0--  B0---  C0---  D0---    -fcase-preserve
+ 2: A0--  B0---  C0---  D-1--
+ 3: A0--  B0---  C0---  D--2-
+ 4: A0--  B0---  C0---  D---3
+ 5: A0--  B0---  C-1--  D0---
+ 6: A0--  B0---  C-1--  D-1--
+ 7: A0--  B0---  C-1--  D--2-
+ 8: A0--  B0---  C-1--  D---3
+ 9: A0--  B0---  C--2-  D0---
+10: A0--  B0---  C--2-  D-1--
+11: A0--  B0---  C--2-  D--2-
+12: A0--  B0---  C--2-  D---3
+13: A0--  B0---  C---3  D0---
+14: A0--  B0---  C---3  D-1--
+15: A0--  B0---  C---3  D--2-
+16: A0--  B0---  C---3  D---3
+17: A0--  B-1--  C0---  D0---
+18: A0--  B-1--  C0---  D-1--
+19: A0--  B-1--  C0---  D--2-
+20: A0--  B-1--  C0---  D---3
+21: A0--  B-1--  C-1--  D0---
+22: A0--  B-1--  C-1--  D-1--    -fcase-strict-upper
+23: A0--  B-1--  C-1--  D--2-
+24: A0--  B-1--  C-1--  D---3
+25: A0--  B-1--  C--2-  D0---
+26: A0--  B-1--  C--2-  D-1--
+27: A0--  B-1--  C--2-  D--2-
+28: A0--  B-1--  C--2-  D---3
+29: A0--  B-1--  C---3  D0---
+30: A0--  B-1--  C---3  D-1--
+31: A0--  B-1--  C---3  D--2-
+32: A0--  B-1--  C---3  D---3
+33: A0--  B--2-  C0---  D0---
+34: A0--  B--2-  C0---  D-1--
+35: A0--  B--2-  C0---  D--2-
+36: A0--  B--2-  C0---  D---3
+37: A0--  B--2-  C-1--  D0---
+38: A0--  B--2-  C-1--  D-1--
+39: A0--  B--2-  C-1--  D--2-
+40: A0--  B--2-  C-1--  D---3
+41: A0--  B--2-  C--2-  D0---
+42: A0--  B--2-  C--2-  D-1--
+43: A0--  B--2-  C--2-  D--2-    -fcase-strict-lower
+44: A0--  B--2-  C--2-  D---3
+45: A0--  B--2-  C---3  D0---
+46: A0--  B--2-  C---3  D-1--
+47: A0--  B--2-  C---3  D--2-
+48: A0--  B--2-  C---3  D---3
+49: A0--  B---3  C0---  D0---
+50: A0--  B---3  C0---  D-1--
+51: A0--  B---3  C0---  D--2-
+52: A0--  B---3  C0---  D---3
+53: A0--  B---3  C-1--  D0---
+54: A0--  B---3  C-1--  D-1--
+55: A0--  B---3  C-1--  D--2-
+56: A0--  B---3  C-1--  D---3
+57: A0--  B---3  C--2-  D0---
+58: A0--  B---3  C--2-  D-1--
+59: A0--  B---3  C--2-  D--2-
+60: A0--  B---3  C--2-  D---3
+61: A0--  B---3  C---3  D0---
+62: A0--  B---3  C---3  D-1--
+63: A0--  B---3  C---3  D--2-
+64: A0--  B---3  C---3  D---3    -fcase-initcap
+65: A-1-  B01--  C01--  D01--    -fcase-upper
+66: A--2  B0-2-  C0-2-  D0-2-    -fcase-lower
+@end smallexample
+
+Number 22 is the ``strict'' ANSI FORTRAN 77 model wherein all input
+(except comments, character constants, and Hollerith strings) must
+be entered in uppercase.
+Use @option{-fcase-strict-upper} to specify this
+combination.
+
+Number 43 is like Number 22 except all input must be lowercase.  Use
+@option{-fcase-strict-lower} to specify this combination.
+
+Number 65 is the ``classic'' ANSI FORTRAN 77 model as implemented on many
+non-UNIX machines whereby all the source is translated to uppercase.
+Use @option{-fcase-upper} to specify this combination.
+
+Number 66 is the ``canonical'' UNIX model whereby all the source is
+translated to lowercase.
+Use @option{-fcase-lower} to specify this combination.
+
+There are a few nearly useless combinations:
+
+@smallexample
+67: A-1-  B01--  C01--  D--2-
+68: A-1-  B01--  C01--  D---3
+69: A-1-  B01--  C--23  D01--
+70: A-1-  B01--  C--23  D--2-
+71: A-1-  B01--  C--23  D---3
+72: A--2  B01--  C0-2-  D-1--
+73: A--2  B01--  C0-2-  D---3
+74: A--2  B01--  C-1-3  D0-2-
+75: A--2  B01--  C-1-3  D-1--
+76: A--2  B01--  C-1-3  D---3
+@end smallexample
+
+The above allow some programs to be compiled but with restrictions that
+make most useful programs impossible: Numbers 67 and 72 warn about
+@emph{any} user-defined symbol names (such as @samp{SUBROUTINE FOO});
+Numbers
+68 and 73 warn about any user-defined symbol names longer than one
+character that don't have at least one non-alphabetic character after
+the first;
+Numbers 69 and 74 disallow any references to intrinsics;
+and Numbers 70, 71, 75, and 76 are combinations of the restrictions in
+67+69, 68+69, 72+74, and 73+74, respectively.
+
+All redundant combinations are shown in the above tables anyplace
+where more than one setting is shown for a low-level switch.
+For example, @samp{B0-2-} means either setting 0 or 2 is valid for switch B.
+The ``proper'' setting in such a case is the one that copies the setting
+of switch A---any other setting might slightly reduce the speed of
+the compiler, though possibly to an unmeasurable extent.
+
+All remaining combinations are useless in that they prevent successful
+compilation of non-null source files (source files with something other
+than comments).
+
+@node VXT Fortran
+@section VXT Fortran
+
+@cindex VXT extensions
+@cindex extensions, VXT
+@command{g77} supports certain constructs that
+have different meanings in VXT Fortran than they
+do in the GNU Fortran language.
+
+Generally, this manual uses the invented term VXT Fortran to refer
+VAX FORTRAN (circa v4).
+That compiler offered many popular features, though not necessarily
+those that are specific to the VAX processor architecture,
+the VMS operating system,
+or Digital Equipment Corporation's Fortran product line.
+(VAX and VMS probably are trademarks of Digital Equipment
+Corporation.)
+
+An extension offered by a Digital Fortran product that also is
+offered by several other Fortran products for different kinds of
+systems is probably going to be considered for inclusion in @command{g77}
+someday, and is considered a VXT Fortran feature.
+
+The @option{-fvxt} option generally specifies that, where
+the meaning of a construct is ambiguous (means one thing
+in GNU Fortran and another in VXT Fortran), the VXT Fortran
+meaning is to be assumed.
+
+@menu
+* Double Quote Meaning::  @samp{"2000} as octal constant.
+* Exclamation Point::     @samp{!} in column 6.
+@end menu
+
+@node Double Quote Meaning
+@subsection Meaning of Double Quote
+@cindex double quotes
+@cindex character constants
+@cindex constants, character
+@cindex octal constants
+@cindex constants, octal
+
+@command{g77} treats double-quote (@samp{"})
+as beginning an octal constant of @code{INTEGER(KIND=1)} type
+when the @option{-fvxt} option is specified.
+The form of this octal constant is
+
+@example
+"@var{octal-digits}
+@end example
+
+@noindent
+where @var{octal-digits} is a nonempty string of characters in
+the set @samp{01234567}.
+
+For example, the @option{-fvxt} option permits this:
+
+@example
+PRINT *, "20
+END
+@end example
+
+@noindent
+The above program would print the value @samp{16}.
+
+@xref{Integer Type}, for information on the preferred construct
+for integer constants specified using GNU Fortran's octal notation.
+
+(In the GNU Fortran language, the double-quote character (@samp{"})
+delimits a character constant just as does apostrophe (@samp{'}).
+There is no way to allow
+both constructs in the general case, since statements like
+@samp{PRINT *,"2000 !comment?"} would be ambiguous.)
+
+@node Exclamation Point
+@subsection Meaning of Exclamation Point in Column 6
+@cindex !
+@cindex exclamation point
+@cindex continuation character
+@cindex characters, continuation
+@cindex comment character
+@cindex characters, comment
+
+@command{g77} treats an exclamation point (@samp{!}) in column 6 of
+a fixed-form source file
+as a continuation character rather than
+as the beginning of a comment
+(as it does in any other column)
+when the @option{-fvxt} option is specified.
+
+The following program, when run, prints a message indicating
+whether it is interpreted according to GNU Fortran (and Fortran 90)
+rules or VXT Fortran rules:
+
+@smallexample
+C234567  (This line begins in column 1.)
+      I = 0
+     !1
+      IF (I.EQ.0) PRINT *, ' I am a VXT Fortran program'
+      IF (I.EQ.1) PRINT *, ' I am a Fortran 90 program'
+      IF (I.LT.0 .OR. I.GT.1) PRINT *, ' I am a HAL 9000 computer'
+      END
+@end smallexample
+
+(In the GNU Fortran and Fortran 90 languages, exclamation point is
+a valid character and, unlike space (@key{SPC}) or zero (@samp{0}),
+marks a line as a continuation line when it appears in column 6.)
+
+@node Fortran 90
+@section Fortran 90
+@cindex compatibility, Fortran 90
+@cindex Fortran 90, compatibility
+
+The GNU Fortran language includes a number of features that are
+part of Fortran 90, even when the @option{-ff90} option is not specified.
+The features enabled by @option{-ff90} are intended to be those that,
+when @option{-ff90} is not specified, would have another
+meaning to @command{g77}---usually meaning something invalid in the
+GNU Fortran language.
+
+So, the purpose of @option{-ff90} is not to specify whether @command{g77} is
+to gratuitously reject Fortran 90 constructs.
+The @option{-pedantic} option specified with @option{-fno-f90} is intended
+to do that, although its implementation is certainly incomplete at
+this point.
+
+When @option{-ff90} is specified:
+
+@itemize @bullet
+@item
+The type of @samp{REAL(@var{expr})} and @samp{AIMAG(@var{expr})},
+where @var{expr} is @code{COMPLEX} type,
+is the same type as the real part of @var{expr}.
+
+For example, assuming @samp{Z} is type @code{COMPLEX(KIND=2)},
+@samp{REAL(Z)} would return a value of type @code{REAL(KIND=2)},
+not of type @code{REAL(KIND=1)}, since @option{-ff90} is specified.
+@end itemize
+
+@node Pedantic Compilation
+@section Pedantic Compilation
+@cindex pedantic compilation
+@cindex compilation, pedantic
+
+The @option{-fpedantic} command-line option specifies that @command{g77}
+is to warn about code that is not standard-conforming.
+This is useful for finding
+some extensions @command{g77} accepts that other compilers might not accept.
+(Note that the @option{-pedantic} and @option{-pedantic-errors} options
+always imply @option{-fpedantic}.)
+
+With @option{-fno-f90} in force, ANSI FORTRAN 77 is used as the standard
+for conforming code.
+With @option{-ff90} in force, Fortran 90 is used.
+
+The constructs for which @command{g77} issues diagnostics when @option{-fpedantic}
+and @option{-fno-f90} are in force are:
+
+@itemize @bullet
+@item
+Automatic arrays, as in
+
+@example
+SUBROUTINE X(N)
+REAL A(N)
+@dots{}
+@end example
+
+@noindent
+where @samp{A} is not listed in any @code{ENTRY} statement,
+and thus is not a dummy argument.
+
+@item
+The commas in @samp{READ (5), I} and @samp{WRITE (10), J}.
+
+These commas are disallowed by FORTRAN 77, but, while strictly
+superfluous, are syntactically elegant,
+especially given that commas are required in statements such
+as @samp{READ 99, I} and @samp{PRINT *, J}.
+Many compilers permit the superfluous commas for this reason.
+
+@item
+@code{DOUBLE COMPLEX}, either explicitly or implicitly.
+
+An explicit use of this type is via a @code{DOUBLE COMPLEX} or
+@code{IMPLICIT DOUBLE COMPLEX} statement, for examples.
+
+An example of an implicit use is the expression @samp{C*D},
+where @samp{C} is @code{COMPLEX(KIND=1)}
+and @samp{D} is @code{DOUBLE PRECISION}.
+This expression is prohibited by ANSI FORTRAN 77
+because the rules of promotion would suggest that it
+produce a @code{DOUBLE COMPLEX} result---a type not
+provided for by that standard.
+
+@item
+Automatic conversion of numeric
+expressions to @code{INTEGER(KIND=1)} in contexts such as:
+
+@itemize @minus
+@item
+Array-reference indexes.
+@item
+Alternate-return values.
+@item
+Computed @code{GOTO}.
+@item
+@code{FORMAT} run-time expressions (not yet supported).
+@item
+Dimension lists in specification statements.
+@item
+Numbers for I/O statements (such as @samp{READ (UNIT=3.2), I})
+@item
+Sizes of @code{CHARACTER} entities in specification statements.
+@item
+Kind types in specification entities (a Fortran 90 feature).
+@item
+Initial, terminal, and incrementation parameters for implied-@code{DO}
+constructs in @code{DATA} statements.
+@end itemize
+
+@item
+Automatic conversion of @code{LOGICAL} expressions to @code{INTEGER}
+in contexts such as arithmetic @code{IF} (where @code{COMPLEX}
+expressions are disallowed anyway).
+
+@item
+Zero-size array dimensions, as in:
+
+@example
+INTEGER I(10,20,4:2)
+@end example
+
+@item
+Zero-length @code{CHARACTER} entities, as in:
+
+@example
+PRINT *, ''
+@end example
+
+@item
+Substring operators applied to character constants and named
+constants, as in:
+
+@example
+PRINT *, 'hello'(3:5)
+@end example
+
+@item
+Null arguments passed to statement function, as in:
+
+@example
+PRINT *, FOO(,3)
+@end example
+
+@item
+Disagreement among program units regarding whether a given @code{COMMON}
+area is @code{SAVE}d (for targets where program units in a single source
+file are ``glued'' together as they typically are for UNIX development
+environments).
+
+@item
+Disagreement among program units regarding the size of a
+named @code{COMMON} block.
+
+@item
+Specification statements following first @code{DATA} statement.
+
+(In the GNU Fortran language, @samp{DATA I/1/} may be followed by @samp{INTEGER J},
+but not @samp{INTEGER I}.
+The @option{-fpedantic} option disallows both of these.)
+
+@item
+Semicolon as statement separator, as in:
+
+@example
+CALL FOO; CALL BAR
+@end example
+@c
+@c @item
+@c Comma before list of I/O items in @code{WRITE}
+@c  @c, @code{ENCODE}, @code{DECODE}, and @code{REWRITE}
+@c statements, as with @code{READ} (as explained above).
+
+@item
+Use of @samp{&} in column 1 of fixed-form source (to indicate continuation).
+
+@item
+Use of @code{CHARACTER} constants to initialize numeric entities, and vice
+versa.
+
+@item
+Expressions having two arithmetic operators in a row, such
+as @samp{X*-Y}.
+@end itemize
+
+If @option{-fpedantic} is specified along with @option{-ff90}, the
+following constructs result in diagnostics:
+
+@itemize @bullet
+@item
+Use of semicolon as a statement separator on a line
+that has an @code{INCLUDE} directive.
+@end itemize
+
+@node Distensions
+@section Distensions
+@cindex distensions
+@cindex ugly features
+@cindex features, ugly
+
+The @option{-fugly-*} command-line options determine whether certain
+features supported by VAX FORTRAN and other such compilers, but considered
+too ugly to be in code that can be changed to use safer and/or more
+portable constructs, are accepted.
+These are humorously referred to as ``distensions'',
+extensions that just plain look ugly in the harsh light of day.
+
+@menu
+* Ugly Implicit Argument Conversion::  Disabled via @option{-fno-ugly-args}.
+* Ugly Assumed-Size Arrays::           Enabled via @option{-fugly-assumed}.
+* Ugly Null Arguments::                Enabled via @option{-fugly-comma}.
+* Ugly Complex Part Extraction::       Enabled via @option{-fugly-complex}.
+* Ugly Conversion of Initializers::    Disabled via @option{-fno-ugly-init}.
+* Ugly Integer Conversions::           Enabled via @option{-fugly-logint}.
+* Ugly Assigned Labels::               Enabled via @option{-fugly-assign}.
+@end menu
+
+@node Ugly Implicit Argument Conversion
+@subsection Implicit Argument Conversion
+@cindex Hollerith constants
+@cindex constants, Hollerith
+
+The @option{-fno-ugly-args} option disables
+passing typeless and Hollerith constants as actual arguments
+in procedure invocations.
+For example:
+
+@example
+CALL FOO(4HABCD)
+CALL BAR('123'O)
+@end example
+
+@noindent
+These constructs can be too easily used to create non-portable
+code, but are not considered as ``ugly'' as others.
+Further, they are widely used in existing Fortran source code
+in ways that often are quite portable.
+Therefore, they are enabled by default.
+
+@node Ugly Assumed-Size Arrays
+@subsection Ugly Assumed-Size Arrays
+@cindex arrays, assumed-size
+@cindex assumed-size arrays
+@cindex DIMENSION X(1)
+
+The @option{-fugly-assumed} option enables
+the treatment of any array with a final dimension specified as @samp{1}
+as an assumed-size array, as if @samp{*} had been specified
+instead.
+
+For example, @samp{DIMENSION X(1)} is treated as if it
+had read @samp{DIMENSION X(*)} if @samp{X} is listed as
+a dummy argument in a preceding @code{SUBROUTINE}, @code{FUNCTION},
+or @code{ENTRY} statement in the same program unit.
+
+Use an explicit lower bound to avoid this interpretation.
+For example, @samp{DIMENSION X(1:1)} is never treated as if
+it had read @samp{DIMENSION X(*)} or @samp{DIMENSION X(1:*)}.
+Nor is @samp{DIMENSION X(2-1)} affected by this option,
+since that kind of expression is unlikely to have been
+intended to designate an assumed-size array.
+
+This option is used to prevent warnings being issued about apparent
+out-of-bounds reference such as @samp{X(2) = 99}.
+
+It also prevents the array from being used in contexts that
+disallow assumed-size arrays, such as @samp{PRINT *,X}.
+In such cases, a diagnostic is generated and the source file is
+not compiled.
+
+The construct affected by this option is used only in old code
+that pre-exists the widespread acceptance of adjustable and assumed-size
+arrays in the Fortran community.
+
+@emph{Note:} This option does not affect how @samp{DIMENSION X(1)} is
+treated if @samp{X} is listed as a dummy argument only
+@emph{after} the @code{DIMENSION} statement (presumably in
+an @code{ENTRY} statement).
+For example, @option{-fugly-assumed} has no effect on the
+following program unit:
+
+@example
+SUBROUTINE X
+REAL A(1)
+RETURN
+ENTRY Y(A)
+PRINT *, A
+END
+@end example
+
+@node Ugly Complex Part Extraction
+@subsection Ugly Complex Part Extraction
+@cindex complex values
+@cindex real part
+@cindex imaginary part
+
+The @option{-fugly-complex} option enables
+use of the @code{REAL()} and @code{AIMAG()}
+intrinsics with arguments that are
+@code{COMPLEX} types other than @code{COMPLEX(KIND=1)}.
+
+With @option{-ff90} in effect, these intrinsics return
+the unconverted real and imaginary parts (respectively)
+of their argument.
+
+With @option{-fno-f90} in effect, these intrinsics convert
+the real and imaginary parts to @code{REAL(KIND=1)}, and return
+the result of that conversion.
+
+Due to this ambiguity, the GNU Fortran language defines
+these constructs as invalid, except in the specific
+case where they are entirely and solely passed as an
+argument to an invocation of the @code{REAL()} intrinsic.
+For example,
+
+@example
+REAL(REAL(Z))
+@end example
+
+@noindent
+is permitted even when @samp{Z} is @code{COMPLEX(KIND=2)}
+and @option{-fno-ugly-complex} is in effect, because the
+meaning is clear.
+
+@command{g77} enforces this restriction, unless @option{-fugly-complex}
+is specified, in which case the appropriate interpretation is
+chosen and no diagnostic is issued.
+
+@xref{CMPAMBIG}, for information on how to cope with existing
+code with unclear expectations of @code{REAL()} and @code{AIMAG()}
+with @code{COMPLEX(KIND=2)} arguments.
+
+@xref{RealPart Intrinsic}, for information on the @code{REALPART()}
+intrinsic, used to extract the real part of a complex expression
+without conversion.
+@xref{ImagPart Intrinsic}, for information on the @code{IMAGPART()}
+intrinsic, used to extract the imaginary part of a complex expression
+without conversion.
+
+@node Ugly Null Arguments
+@subsection Ugly Null Arguments
+@cindex trailing comma
+@cindex comma, trailing
+@cindex characters, comma
+@cindex null arguments
+@cindex arguments, null
+
+The @option{-fugly-comma} option enables use of a single trailing comma
+to mean ``pass an extra trailing null argument''
+in a list of actual arguments to an external procedure,
+and use of an empty list of arguments to such a procedure
+to mean ``pass a single null argument''.
+
+@cindex omitting arguments
+@cindex arguments, omitting
+(Null arguments often are used in some procedure-calling
+schemes to indicate omitted arguments.)
+
+For example, @samp{CALL FOO(,)} means ``pass
+two null arguments'', rather than ``pass one null argument''.
+Also, @samp{CALL BAR()} means ``pass one null argument''.
+
+This construct is considered ``ugly'' because it does not
+provide an elegant way to pass a single null argument
+that is syntactically distinct from passing no arguments.
+That is, this construct changes the meaning of code that
+makes no use of the construct.
+
+So, with @option{-fugly-comma} in force, @samp{CALL FOO()}
+and @samp{I = JFUNC()} pass a single null argument, instead
+of passing no arguments as required by the Fortran 77 and
+90 standards.
+
+@emph{Note:} Many systems gracefully allow the case
+where a procedure call passes one extra argument that the
+called procedure does not expect.
+
+So, in practice, there might be no difference in
+the behavior of a program that does @samp{CALL FOO()}
+or @samp{I = JFUNC()} and is compiled with @option{-fugly-comma}
+in force as compared to its behavior when compiled
+with the default, @option{-fno-ugly-comma}, in force,
+assuming @samp{FOO} and @samp{JFUNC} do not expect any
+arguments to be passed.
+
+@node Ugly Conversion of Initializers
+@subsection Ugly Conversion of Initializers
+
+The constructs disabled by @option{-fno-ugly-init} are:
+
+@itemize @bullet
+@cindex Hollerith constants
+@cindex constants, Hollerith
+@item
+Use of Hollerith and typeless constants in contexts where they set
+initial (compile-time) values for variables, arrays, and named
+constants---that is, @code{DATA} and @code{PARAMETER} statements, plus
+type-declaration statements specifying initial values.
+
+Here are some sample initializations that are disabled by the
+@option{-fno-ugly-init} option:
+
+@example
+PARAMETER (VAL='9A304FFE'X)
+REAL*8 STRING/8HOUTPUT00/
+DATA VAR/4HABCD/
+@end example
+
+@cindex character constants
+@cindex constants, character
+@item
+In the same contexts as above, use of character constants to initialize
+numeric items and vice versa (one constant per item).
+
+Here are more sample initializations that are disabled by the
+@option{-fno-ugly-init} option:
+
+@example
+INTEGER IA
+CHARACTER BELL
+PARAMETER (IA = 'A')
+PARAMETER (BELL = 7)
+@end example
+
+@item
+Use of Hollerith and typeless constants on the right-hand side
+of assignment statements to numeric types, and in other
+contexts (such as passing arguments in invocations of
+intrinsic procedures and statement functions) that
+are treated as assignments to known types (the dummy
+arguments, in these cases).
+
+Here are sample statements that are disabled by the
+@option{-fno-ugly-init} option:
+
+@example
+IVAR = 4HABCD
+PRINT *, IMAX0(2HAB, 2HBA)
+@end example
+@end itemize
+
+The above constructs, when used,
+can tend to result in non-portable code.
+But, they are widely used in existing Fortran code in ways
+that often are quite portable.
+Therefore, they are enabled by default.
+
+@node Ugly Integer Conversions
+@subsection Ugly Integer Conversions
+
+The constructs enabled via @option{-fugly-logint} are:
+
+@itemize @bullet
+@item
+Automatic conversion between @code{INTEGER} and @code{LOGICAL} as
+dictated by
+context (typically implies nonportable dependencies on how a
+particular implementation encodes @code{.TRUE.} and @code{.FALSE.}).
+
+@item
+Use of a @code{LOGICAL} variable in @code{ASSIGN} and assigned-@code{GOTO}
+statements.
+@end itemize
+
+The above constructs are disabled by default because use
+of them tends to lead to non-portable code.
+Even existing Fortran code that uses that often turns out
+to be non-portable, if not outright buggy.
+
+Some of this is due to differences among implementations as
+far as how @code{.TRUE.} and @code{.FALSE.} are encoded as
+@code{INTEGER} values---Fortran code that assumes a particular
+coding is likely to use one of the above constructs, and is
+also likely to not work correctly on implementations using
+different encodings.
+
+@xref{Equivalence Versus Equality}, for more information.
+
+@node Ugly Assigned Labels
+@subsection Ugly Assigned Labels
+@cindex ASSIGN statement
+@cindex statements, ASSIGN
+@cindex assigned labels
+@cindex pointers
+
+The @option{-fugly-assign} option forces @command{g77} to use the
+same storage for assigned labels as it would for a normal
+assignment to the same variable.
+
+For example, consider the following code fragment:
+
+@example
+I = 3
+ASSIGN 10 TO I
+@end example
+
+@noindent
+Normally, for portability and improved diagnostics, @command{g77}
+reserves distinct storage for a ``sibling'' of @samp{I}, used
+only for @code{ASSIGN} statements to that variable (along with
+the corresponding assigned-@code{GOTO} and assigned-@code{FORMAT}-I/O
+statements that reference the variable).
+
+However, some code (that violates the ANSI FORTRAN 77 standard)
+attempts to copy assigned labels among variables involved with
+@code{ASSIGN} statements, as in:
+
+@example
+ASSIGN 10 TO I
+ISTATE(5) = I
+@dots{}
+J = ISTATE(ICUR)
+GOTO J
+@end example
+
+@noindent
+Such code doesn't work under @command{g77} unless @option{-fugly-assign}
+is specified on the command-line, ensuring that the value of @code{I}
+referenced in the second line is whatever value @command{g77} uses
+to designate statement label @samp{10}, so the value may be
+copied into the @samp{ISTATE} array, later retrieved into a
+variable of the appropriate type (@samp{J}), and used as the target of
+an assigned-@code{GOTO} statement.
+
+@emph{Note:} To avoid subtle program bugs,
+when @option{-fugly-assign} is specified,
+@command{g77} requires the type of variables
+specified in assigned-label contexts
+@emph{must} be the same type returned by @code{%LOC()}.
+On many systems, this type is effectively the same
+as @code{INTEGER(KIND=1)}, while, on others, it is
+effectively the same as @code{INTEGER(KIND=2)}.
+
+Do @emph{not} depend on @command{g77} actually writing valid pointers
+to these variables, however.
+While @command{g77} currently chooses that implementation, it might
+be changed in the future.
+
+@xref{Assigned Statement Labels,,Assigned Statement Labels (ASSIGN and GOTO)},
+for implementation details on assigned-statement labels.
+
+@node Compiler
+@chapter The GNU Fortran Compiler
+
+The GNU Fortran compiler, @command{g77}, supports programs written
+in the GNU Fortran language and in some other dialects of Fortran.
+
+Some aspects of how @command{g77} works are universal regardless
+of dialect, and yet are not properly part of the GNU Fortran
+language itself.
+These are described below.
+
+@emph{Note: This portion of the documentation definitely needs a lot
+of work!}
+
+@menu
+* Compiler Limits::
+* Run-time Environment Limits::
+* Compiler Types::
+* Compiler Constants::
+* Compiler Intrinsics::
+@end menu
+
+@node Compiler Limits
+@section Compiler Limits
+@cindex limits, compiler
+@cindex compiler limits
+
+@command{g77}, as with GNU tools in general, imposes few arbitrary restrictions
+on lengths of identifiers, number of continuation lines, number of external
+symbols in a program, and so on.
+
+@cindex options, -Nl
+@cindex -Nl option
+@cindex options, -Nx
+@cindex -Nx option
+@cindex limits, continuation lines
+@cindex limits, lengths of names
+For example, some other Fortran compiler have an option
+(such as @option{-Nl@var{x}}) to increase the limit on the
+number of continuation lines.
+Also, some Fortran compilation systems have an option
+(such as @option{-Nx@var{x}}) to increase the limit on the
+number of external symbols.
+
+@command{g77}, @command{gcc}, and GNU @command{ld} (the GNU linker) have
+no equivalent options, since they do not impose arbitrary
+limits in these areas.
+
+@cindex rank, maximum
+@cindex maximum rank
+@cindex number of dimensions, maximum
+@cindex maximum number of dimensions
+@cindex limits, rank
+@cindex limits, array dimensions
+@command{g77} does currently limit the number of dimensions in an array
+to the same degree as do the Fortran standards---seven (7).
+This restriction might be lifted in a future version.
+
+@node Run-time Environment Limits
+@section Run-time Environment Limits
+@cindex limits, run-time library
+@cindex wraparound
+
+As a portable Fortran implementation,
+@command{g77} offers its users direct access to,
+and otherwise depends upon,
+the underlying facilities of the system
+used to build @command{g77},
+the system on which @command{g77} itself is used to compile programs,
+and the system on which the @command{g77}-compiled program is actually run.
+(For most users, the three systems are of the same
+type---combination of operating environment and hardware---often
+the same physical system.)
+
+The run-time environment for a particular system
+inevitably imposes some limits on a program's use
+of various system facilities.
+These limits vary from system to system.
+
+Even when such limits might be well beyond the
+possibility of being encountered on a particular system,
+the @command{g77} run-time environment
+has certain built-in limits,
+usually, but not always, stemming from intrinsics
+with inherently limited interfaces.
+
+Currently, the @command{g77} run-time environment
+does not generally offer a less-limiting environment
+by augmenting the underlying system's own environment.
+
+Therefore, code written in the GNU Fortran language,
+while syntactically and semantically portable,
+might nevertheless make non-portable assumptions
+about the run-time environment---assumptions that
+prove to be false for some particular environments.
+
+The GNU Fortran language,
+the @command{g77} compiler and run-time environment,
+and the @command{g77} documentation
+do not yet offer comprehensive portable work-arounds for such limits,
+though programmers should be able to
+find their own in specific instances.
+
+Not all of the limitations are described in this document.
+Some of the known limitations include:
+
+@menu
+* Timer Wraparounds::
+* Year 2000 (Y2K) Problems::
+* Array Size::
+* Character-variable Length::
+* Year 10000 (Y10K) Problems::
+@end menu
+
+@node Timer Wraparounds
+@subsection Timer Wraparounds
+
+Intrinsics that return values computed from system timers,
+whether elapsed (wall-clock) timers,
+process CPU timers,
+or other kinds of timers,
+are prone to experiencing wrap-around errors
+(or returning wrapped-around values from successive calls)
+due to insufficient ranges
+offered by the underlying system's timers.
+
+@cindex negative time
+@cindex short time
+@cindex long time
+Some of the symptoms of such behaviors include
+apparently negative time being computed for a duration,
+an extremely short amount of time being computed for a long duration,
+and an extremely long amount of time being computed for a short duration.
+
+See the following for intrinsics
+known to have potential problems in these areas
+on at least some systems:
+@ref{CPU_Time Intrinsic},
+@ref{DTime Intrinsic (function)}, @ref{DTime Intrinsic (subroutine)},
+@ref{ETime Intrinsic (function)}, @ref{ETime Intrinsic (subroutine)},
+@ref{MClock Intrinsic}, @ref{MClock8 Intrinsic},
+@ref{Secnds Intrinsic},
+@ref{Second Intrinsic (function)}, @ref{Second Intrinsic (subroutine)},
+@ref{System_Clock Intrinsic},
+@ref{Time Intrinsic (UNIX)}, @ref{Time Intrinsic (VXT)},
+@ref{Time8 Intrinsic}.
+
+@node Year 2000 (Y2K) Problems
+@subsection Year 2000 (Y2K) Problems
+@cindex Y2K compliance
+@cindex Year 2000 compliance
+
+While the @command{g77} compiler itself is believed to
+be Year-2000 (Y2K) compliant,
+some intrinsics are not,
+and, potentially, some underlying systems are not,
+perhaps rendering some Y2K-compliant intrinsics
+non-compliant when used on those particular systems.
+
+Fortran code that uses non-Y2K-compliant intrinsics
+(listed below)
+is, itself, almost certainly not compliant,
+and should be modified to use Y2K-compliant intrinsics instead.
+
+Fortran code that uses no non-Y2K-compliant intrinsics,
+but which currently is running on a non-Y2K-compliant system,
+can be made more Y2K compliant by compiling and
+linking it for use on a new Y2K-compliant system,
+such as a new version of an old, non-Y2K-compliant, system.
+
+Currently, information on Y2K and related issues
+is being maintained at
+@uref{http://www.gnu.org/software/year2000-list.html}.
+
+See the following for intrinsics
+known to have potential problems in these areas
+on at least some systems:
+@ref{Date Intrinsic},
+@ref{IDate Intrinsic (VXT)}.
+
+@cindex y2kbuggy
+@cindex date_y2kbuggy_0
+@cindex vxtidate_y2kbuggy_0
+@cindex G77_date_y2kbuggy_0
+@cindex G77_vxtidate_y2kbuggy_0
+The @code{libg2c} library
+shipped with any @command{g77} that warns
+about invocation of a non-Y2K-compliant intrinsic
+has renamed the @code{EXTERNAL} procedure names
+of those intrinsics.
+This is done so that
+the @code{libg2c} implementations of these intrinsics
+cannot be directly linked to
+as @code{EXTERNAL} names
+(which normally would avoid the non-Y2K-intrinsic warning).
+
+The renamed forms of the @code{EXTERNAL} names
+of these renamed procedures
+may be linked to
+by appending the string @samp{_y2kbug}
+to the name of the procedure
+in the source code.
+For example:
+
+@smallexample
+CHARACTER*20 STR
+INTEGER YY, MM, DD
+EXTERNAL DATE_Y2KBUG, VXTIDATE_Y2KBUG
+CALL DATE_Y2KBUG (STR)
+CALL VXTIDATE_Y2KBUG (MM, DD, YY)
+@end smallexample
+
+(Note that the @code{EXTERNAL} statement
+is not actually required,
+since the modified names are not recognized as intrinsics
+by the current version of @command{g77}.
+But it is shown in this specific case,
+for purposes of illustration.)
+
+The renaming of @code{EXTERNAL} procedure names of these intrinsics
+causes unresolved references at link time.
+For example, @samp{EXTERNAL DATE; CALL DATE(STR)}
+is normally compiled by @command{g77}
+as, in C, @samp{date_(&str, 20);}.
+This, in turn, links to the @code{date_} procedure
+in the @code{libE77} portion of @code{libg2c},
+which purposely calls a nonexistent procedure
+named @code{G77_date_y2kbuggy_0}.
+The resulting link-time error is designed, via this name,
+to encourage the programmer to look up the
+index entries to this portion of the @command{g77} documentation.
+
+Generally, we recommend that the @code{EXTERNAL} method
+of invoking procedures in @code{libg2c}
+@emph{not} be used.
+When used, some of the correctness checking
+normally performed by @command{g77}
+is skipped.
+
+In particular, it is probably better to use the
+@code{INTRINSIC} method of invoking
+non-Y2K-compliant procedures,
+so anyone compiling the code
+can quickly notice the potential Y2K problems
+(via the warnings printing by @command{g77})
+without having to even look at the code itself.
+
+If there are problems linking @code{libg2c}
+to code compiled by @command{g77}
+that involve the string @samp{y2kbug},
+and these are not explained above,
+that probably indicates
+that a version of @code{libg2c}
+older than @command{g77}
+is being linked to,
+or that the new library is being linked
+to code compiled by an older version of @command{g77}.
+
+That's because, as of the version that warns about
+non-Y2K-compliant intrinsic invocation,
+@command{g77} references the @code{libg2c} implementations
+of those intrinsics
+using new names, containing the string @samp{y2kbug}.
+
+So, linking newly-compiled code
+(invoking one of the intrinsics in question)
+to an old library
+might yield an unresolved reference
+to @code{G77_date_y2kbug_0}.
+(The old library calls it @code{G77_date_0}.)
+
+Similarly, linking previously-compiled code
+to a new library
+might yield an unresolved reference
+to @code{G77_vxtidate_0}.
+(The new library calls it @code{G77_vxtidate_y2kbug_0}.)
+
+The proper fix for the above problems
+is to obtain the latest release of @command{g77}
+and related products
+(including @code{libg2c})
+and install them on all systems,
+then recompile, relink, and install
+(as appropriate)
+all existing Fortran programs.
+
+(Normally, this sort of renaming is steadfastly avoided.
+In this case, however, it seems more important to highlight
+potential Y2K problems
+than to ease the transition
+of potentially non-Y2K-compliant code
+to new versions of @command{g77} and @code{libg2c}.)
+
+@node Array Size
+@subsection Array Size
+@cindex limits, array size
+@cindex array size
+
+Currently, @command{g77} uses the default @code{INTEGER} type
+for array indexes,
+which limits the sizes of single-dimension arrays
+on systems offering a larger address space
+than can be addressed by that type.
+(That @command{g77} puts all arrays in memory
+could be considered another limitation---it
+could use large temporary files---but that decision
+is left to the programmer as an implementation choice
+by most Fortran implementations.)
+
+@c ??? Investigate this, to offer a more clear statement
+@c than the following paragraphs do.  -- burley 1999-02-17
+It is not yet clear whether this limitation
+never, sometimes, or always applies to the
+sizes of multiple-dimension arrays as a whole.
+
+For example, on a system with 64-bit addresses
+and 32-bit default @code{INTEGER},
+an array with a size greater than can be addressed
+by a 32-bit offset
+can be declared using multiple dimensions.
+Such an array is therefore larger
+than a single-dimension array can be,
+on the same system.
+
+@cindex limits, multi-dimension arrays
+@cindex multi-dimension arrays
+@cindex arrays, dimensioning
+Whether large multiple-dimension arrays are reliably supported
+depends mostly on the @command{gcc} back end (code generator)
+used by @command{g77}, and has not yet been fully investigated.
+
+@node Character-variable Length
+@subsection Character-variable Length
+@cindex limits, on character-variable length
+@cindex character-variable length
+
+Currently, @command{g77} uses the default @code{INTEGER} type
+for the lengths of @code{CHARACTER} variables
+and array elements.
+
+This means that, for example,
+a system with a 64-bit address space
+and a 32-bit default @code{INTEGER} type
+does not, under @command{g77},
+support a @code{CHARACTER*@var{n}} declaration
+where @var{n} is greater than 2147483647.
+
+@node Year 10000 (Y10K) Problems
+@subsection Year 10000 (Y10K) Problems
+@cindex Y10K compliance
+@cindex Year 10000 compliance
+
+Most intrinsics returning, or computing values based on,
+date information are prone to Year-10000 (Y10K) problems,
+due to supporting only 4 digits for the year.
+
+See the following for examples:
+@ref{FDate Intrinsic (function)}, @ref{FDate Intrinsic (subroutine)},
+@ref{IDate Intrinsic (UNIX)},
+@ref{Time Intrinsic (VXT)},
+@ref{Date_and_Time Intrinsic}.
+
+@node Compiler Types
+@section Compiler Types
+@cindex types, of data
+@cindex data types
+
+Fortran implementations have a fair amount of freedom given them by the
+standard as far as how much storage space is used and how much precision
+and range is offered by the various types such as @code{LOGICAL(KIND=1)},
+@code{INTEGER(KIND=1)}, @code{REAL(KIND=1)}, @code{REAL(KIND=2)},
+@code{COMPLEX(KIND=1)}, and @code{CHARACTER}.
+Further, many compilers offer so-called @samp{*@var{n}} notation, but
+the interpretation of @var{n} varies across compilers and target architectures.
+
+The standard requires that @code{LOGICAL(KIND=1)}, @code{INTEGER(KIND=1)},
+and @code{REAL(KIND=1)}
+occupy the same amount of storage space, and that @code{COMPLEX(KIND=1)}
+and @code{REAL(KIND=2)} take twice as much storage space as @code{REAL(KIND=1)}.
+Further, it requires that @code{COMPLEX(KIND=1)}
+entities be ordered such that when a @code{COMPLEX(KIND=1)} variable is
+storage-associated (such as via @code{EQUIVALENCE})
+with a two-element @code{REAL(KIND=1)} array named @samp{R}, @samp{R(1)}
+corresponds to the real element and @samp{R(2)} to the imaginary
+element of the @code{COMPLEX(KIND=1)} variable.
+
+(Few requirements as to precision or ranges of any of these are
+placed on the implementation, nor is the relationship of storage sizes of
+these types to the @code{CHARACTER} type specified, by the standard.)
+
+@command{g77} follows the above requirements, warning when compiling
+a program requires placement of items in memory that contradict the
+requirements of the target architecture.
+(For example, a program can require placement of a @code{REAL(KIND=2)}
+on a boundary that is not an even multiple of its size, but still an
+even multiple of the size of a @code{REAL(KIND=1)} variable.
+On some target architectures, using the canonical
+mapping of Fortran types to underlying architectural types, such
+placement is prohibited by the machine definition or
+the Application Binary Interface (ABI) in force for
+the configuration defined for building @command{gcc} and @command{g77}.
+@command{g77} warns about such
+situations when it encounters them.)
+
+@command{g77} follows consistent rules for configuring the mapping between Fortran
+types, including the @samp{*@var{n}} notation, and the underlying architectural
+types as accessed by a similarly-configured applicable version of the
+@command{gcc} compiler.
+These rules offer a widely portable, consistent Fortran/C
+environment, although they might well conflict with the expectations of
+users of Fortran compilers designed and written for particular
+architectures.
+
+These rules are based on the configuration that is in force for the
+version of @command{gcc} built in the same release as @command{g77} (and
+which was therefore used to build both the @command{g77} compiler
+components and the @code{libg2c} run-time library):
+
+@table @code
+@cindex REAL(KIND=1) type
+@cindex types, REAL(KIND=1)
+@item REAL(KIND=1)
+Same as @code{float} type.
+
+@cindex REAL(KIND=2) type
+@cindex types, REAL(KIND=2)
+@item REAL(KIND=2)
+Same as whatever floating-point type that is twice the size
+of a @code{float}---usually, this is a @code{double}.
+
+@cindex INTEGER(KIND=1) type
+@cindex types, INTEGER(KIND=1)
+@item INTEGER(KIND=1)
+Same as an integral type that is occupies the same amount
+of memory storage as @code{float}---usually, this is either
+an @code{int} or a @code{long int}.
+
+@cindex LOGICAL(KIND=1) type
+@cindex types, LOGICAL(KIND=1)
+@item LOGICAL(KIND=1)
+Same @command{gcc} type as @code{INTEGER(KIND=1)}.
+
+@cindex INTEGER(KIND=2) type
+@cindex types, INTEGER(KIND=2)
+@item INTEGER(KIND=2)
+Twice the size, and usually nearly twice the range,
+as @code{INTEGER(KIND=1)}---usually, this is either
+a @code{long int} or a @code{long long int}.
+
+@cindex LOGICAL(KIND=2) type
+@cindex types, LOGICAL(KIND=2)
+@item LOGICAL(KIND=2)
+Same @command{gcc} type as @code{INTEGER(KIND=2)}.
+
+@cindex INTEGER(KIND=3) type
+@cindex types, INTEGER(KIND=3)
+@item INTEGER(KIND=3)
+Same @command{gcc} type as signed @code{char}.
+
+@cindex LOGICAL(KIND=3) type
+@cindex types, LOGICAL(KIND=3)
+@item LOGICAL(KIND=3)
+Same @command{gcc} type as @code{INTEGER(KIND=3)}.
+
+@cindex INTEGER(KIND=6) type
+@cindex types, INTEGER(KIND=6)
+@item INTEGER(KIND=6)
+Twice the size, and usually nearly twice the range,
+as @code{INTEGER(KIND=3)}---usually, this is
+a @code{short}.
+
+@cindex LOGICAL(KIND=6) type
+@cindex types, LOGICAL(KIND=6)
+@item LOGICAL(KIND=6)
+Same @command{gcc} type as @code{INTEGER(KIND=6)}.
+
+@cindex COMPLEX(KIND=1) type
+@cindex types, COMPLEX(KIND=1)
+@item COMPLEX(KIND=1)
+Two @code{REAL(KIND=1)} scalars (one for the real part followed by
+one for the imaginary part).
+
+@cindex COMPLEX(KIND=2) type
+@cindex types, COMPLEX(KIND=2)
+@item COMPLEX(KIND=2)
+Two @code{REAL(KIND=2)} scalars.
+
+@cindex *@var{n} notation
+@item @var{numeric-type}*@var{n}
+(Where @var{numeric-type} is any type other than @code{CHARACTER}.)
+Same as whatever @command{gcc} type occupies @var{n} times the storage
+space of a @command{gcc} @code{char} item.
+
+@cindex DOUBLE PRECISION type
+@cindex types, DOUBLE PRECISION
+@item DOUBLE PRECISION
+Same as @code{REAL(KIND=2)}.
+
+@cindex DOUBLE COMPLEX type
+@cindex types, DOUBLE COMPLEX
+@item DOUBLE COMPLEX
+Same as @code{COMPLEX(KIND=2)}.
+@end table
+
+Note that the above are proposed correspondences and might change
+in future versions of @command{g77}---avoid writing code depending
+on them.
+
+Other types supported by @command{g77}
+are derived from gcc types such as @code{char}, @code{short},
+@code{int}, @code{long int}, @code{long long int}, @code{long double},
+and so on.
+That is, whatever types @command{gcc} already supports, @command{g77} supports
+now or probably will support in a future version.
+The rules for the @samp{@var{numeric-type}*@var{n}} notation
+apply to these types,
+and new values for @samp{@var{numeric-type}(KIND=@var{n})} will be
+assigned in a way that encourages clarity, consistency, and portability.
+
+@node Compiler Constants
+@section Compiler Constants
+@cindex constants
+@cindex types, constants
+
+@command{g77} strictly assigns types to @emph{all} constants not
+documented as ``typeless'' (typeless constants including @samp{'1'Z},
+for example).
+Many other Fortran compilers attempt to assign types to typed constants
+based on their context.
+This results in hard-to-find bugs, nonportable
+code, and is not in the spirit (though it strictly follows the letter)
+of the 77 and 90 standards.
+
+@command{g77} might offer, in a future release, explicit constructs by
+which a wider variety of typeless constants may be specified, and/or
+user-requested warnings indicating places where @command{g77} might differ
+from how other compilers assign types to constants.
+
+@xref{Context-Sensitive Constants}, for more information on this issue.
+
+@node Compiler Intrinsics
+@section Compiler Intrinsics
+
+@command{g77} offers an ever-widening set of intrinsics.
+Currently these all are procedures (functions and subroutines).
+
+Some of these intrinsics are unimplemented, but their names reserved
+to reduce future problems with existing code as they are implemented.
+Others are implemented as part of the GNU Fortran language, while
+yet others are provided for compatibility with other dialects of
+Fortran but are not part of the GNU Fortran language.
+
+To manage these distinctions, @command{g77} provides intrinsic @emph{groups},
+a facility that is simply an extension of the intrinsic groups provided
+by the GNU Fortran language.
+
+@menu
+* Intrinsic Groups::  How intrinsics are grouped for easy management.
+* Other Intrinsics::  Intrinsics other than those in the GNU
+                       Fortran language.
+@end menu
+
+@node Intrinsic Groups
+@subsection Intrinsic Groups
+@cindex groups of intrinsics
+@cindex intrinsics, groups
+
+A given specific intrinsic belongs in one or more groups.
+Each group is deleted, disabled, hidden, or enabled
+by default or a command-line option.
+The meaning of each term follows.
+
+@table @b
+@cindex deleted intrinsics
+@cindex intrinsics, deleted
+@item Deleted
+No intrinsics are recognized as belonging to that group.
+
+@cindex disabled intrinsics
+@cindex intrinsics, disabled
+@item Disabled
+Intrinsics are recognized as belonging to the group, but
+references to them (other than via the @code{INTRINSIC} statement)
+are disallowed through that group.
+
+@cindex hidden intrinsics
+@cindex intrinsics, hidden
+@item Hidden
+Intrinsics in that group are recognized and enabled (if implemented)
+@emph{only} if the first mention of the actual name of an intrinsic
+in a program unit is in an @code{INTRINSIC} statement.
+
+@cindex enabled intrinsics
+@cindex intrinsics, enabled
+@item Enabled
+Intrinsics in that group are recognized and enabled (if implemented).
+@end table
+
+The distinction between deleting and disabling a group is illustrated
+by the following example.
+Assume intrinsic @samp{FOO} belongs only to group @samp{FGR}.
+If group @samp{FGR} is deleted, the following program unit will
+successfully compile, because @samp{FOO()} will be seen as a
+reference to an external function named @samp{FOO}:
+
+@example
+PRINT *, FOO()
+END
+@end example
+
+@noindent
+If group @samp{FGR} is disabled, compiling the above program will produce
+diagnostics, either because the @samp{FOO} intrinsic is improperly invoked
+or, if properly invoked, it is not enabled.
+To change the above program so it references an external function @samp{FOO}
+instead of the disabled @samp{FOO} intrinsic,
+add the following line to the top:
+
+@example
+EXTERNAL FOO
+@end example
+
+@noindent
+So, deleting a group tells @command{g77} to pretend as though the intrinsics in
+that group do not exist at all, whereas disabling it tells @command{g77} to
+recognize them as (disabled) intrinsics in intrinsic-like contexts.
+
+Hiding a group is like enabling it, but the intrinsic must be first
+named in an @code{INTRINSIC} statement to be considered a reference to the
+intrinsic rather than to an external procedure.
+This might be the ``safest'' way to treat a new group of intrinsics
+when compiling old
+code, because it allows the old code to be generally written as if
+those new intrinsics never existed, but to be changed to use them
+by inserting @code{INTRINSIC} statements in the appropriate places.
+However, it should be the goal of development to use @code{EXTERNAL}
+for all names of external procedures that might be intrinsic names.
+
+If an intrinsic is in more than one group, it is enabled if any of its
+containing groups are enabled; if not so enabled, it is hidden if
+any of its containing groups are hidden; if not so hidden, it is disabled
+if any of its containing groups are disabled; if not so disabled, it is
+deleted.
+This extra complication is necessary because some intrinsics,
+such as @code{IBITS}, belong to more than one group, and hence should be
+enabled if any of the groups to which they belong are enabled, and so
+on.
+
+The groups are:
+
+@cindex intrinsics, groups of
+@cindex groups of intrinsics
+@table @code
+@cindex @code{badu77} intrinsics group
+@item badu77
+UNIX intrinsics having inappropriate forms (usually functions that
+have intended side effects).
+
+@cindex @code{gnu} intrinsics group
+@item gnu
+Intrinsics the GNU Fortran language supports that are extensions to
+the Fortran standards (77 and 90).
+
+@cindex @command{f2c} intrinsics group
+@item f2c
+Intrinsics supported by AT&T's @command{f2c} converter and/or @code{libf2c}.
+
+@cindex @code{f90} intrinsics group
+@item f90
+Fortran 90 intrinsics.
+
+@cindex @code{mil} intrinsics group
+@item mil
+MIL-STD 1753 intrinsics (@code{MVBITS}, @code{IAND}, @code{BTEST}, and so on).
+
+@cindex @code{mil} intrinsics group
+@item unix
+UNIX intrinsics (@code{IARGC}, @code{EXIT}, @code{ERF}, and so on).
+
+@cindex @code{mil} intrinsics group
+@item vxt
+VAX/VMS FORTRAN (current as of v4) intrinsics.
+@end table
+
+@node Other Intrinsics
+@subsection Other Intrinsics
+@cindex intrinsics, others
+@cindex other intrinsics
+
+@command{g77} supports intrinsics other than those in the GNU Fortran
+language proper.
+This set of intrinsics is described below.
+
+@ifinfo
+(Note that the empty lines appearing in the menu below
+are not intentional---they result from a bug in the
+@code{makeinfo} program.)
+@end ifinfo
+
+@c The actual documentation for intrinsics comes from
+@c intdoc.texi, which in turn is automatically generated
+@c from the internal g77 tables in intrin.def _and_ the
+@c largely hand-written text in intdoc.h.  So, if you want
+@c to change or add to existing documentation on intrinsics,
+@c you probably want to edit intdoc.h.
+@c
+@clear familyF77
+@clear familyGNU
+@clear familyASC
+@clear familyMIL
+@clear familyF90
+@set familyVXT
+@set familyFVZ
+@clear familyF2C
+@clear familyF2U
+@set familyBADU77
+@include intdoc.texi
+
+@node Other Compilers
+@chapter Other Compilers
+
+An individual Fortran source file can be compiled to
+an object (@file{*.o}) file instead of to the final
+program executable.
+This allows several portions of a program to be compiled
+at different times and linked together whenever a new
+version of the program is needed.
+However, it introduces the issue of @dfn{object compatibility}
+across the various object files (and libraries, or @file{*.a}
+files) that are linked together to produce any particular
+executable file.
+
+Object compatibility is an issue when combining, in one
+program, Fortran code compiled by more than one compiler
+(or more than one configuration of a compiler).
+If the compilers
+disagree on how to transform the names of procedures, there
+will normally be errors when linking such programs.
+Worse, if the compilers agree on naming, but disagree on issues
+like how to pass parameters, return arguments, and lay out
+@code{COMMON} areas, the earliest detected errors might be the
+incorrect results produced by the program (and that assumes
+these errors are detected, which is not always the case).
+
+Normally, @command{g77} generates code that is
+object-compatible with code generated by a version of
+@command{f2c} configured (with, for example, @file{f2c.h} definitions)
+to be generally compatible with @command{g77} as built by @command{gcc}.
+(Normally, @command{f2c} will, by default, conform to the appropriate
+configuration, but it is possible that older or perhaps even newer
+versions of @command{f2c}, or versions having certain configuration changes
+to @command{f2c} internals, will produce object files that are
+incompatible with @command{g77}.)
+
+For example, a Fortran string subroutine
+argument will become two arguments on the C side: a @code{char *}
+and an @code{int} length.
+
+Much of this compatibility results from the fact that
+@command{g77} uses the same run-time library,
+@code{libf2c}, used by @command{f2c},
+though @command{g77} gives its version the name @code{libg2c}
+so as to avoid conflicts when linking,
+installing them in the same directories,
+and so on.
+
+Other compilers might or might not generate code that
+is object-compatible with @code{libg2c} and current @command{g77},
+and some might offer such compatibility only when explicitly
+selected via a command-line option to the compiler.
+
+@emph{Note: This portion of the documentation definitely needs a lot
+of work!}
+
+@menu
+* Dropping f2c Compatibility::  When speed is more important.
+* Compilers Other Than f2c::    Interoperation with code from other compilers.
+@end menu
+
+@node Dropping f2c Compatibility
+@section Dropping @command{f2c} Compatibility
+
+Specifying @option{-fno-f2c} allows @command{g77} to generate, in
+some cases, faster code, by not needing to allow to the possibility
+of linking with code compiled by @command{f2c}.
+
+For example, this affects how @code{REAL(KIND=1)},
+@code{COMPLEX(KIND=1)}, and @code{COMPLEX(KIND=2)} functions are called.
+With @option{-fno-f2c}, they are
+compiled as returning the appropriate @command{gcc} type
+(@code{float}, @code{__complex__ float}, @code{__complex__ double},
+in many configurations).
+
+With @option{-ff2c} in force, they
+are compiled differently (with perhaps slower run-time performance)
+to accommodate the restrictions inherent in @command{f2c}'s use of K&R
+C as an intermediate language---@code{REAL(KIND=1)} functions
+return C's @code{double} type, while @code{COMPLEX} functions return
+@code{void} and use an extra argument pointing to a place for the functions to
+return their values.
+
+It is possible that, in some cases, leaving @option{-ff2c} in force
+might produce faster code than using @option{-fno-f2c}.
+Feel free to experiment, but remember to experiment with changing the way
+@emph{entire programs and their Fortran libraries are compiled} at
+a time, since this sort of experimentation affects the interface
+of code generated for a Fortran source file---that is, it affects
+object compatibility.
+
+Note that @command{f2c} compatibility is a fairly static target to achieve,
+though not necessarily perfectly so, since, like @command{g77}, it is
+still being improved.
+However, specifying @option{-fno-f2c} causes @command{g77}
+to generate code that will probably be incompatible with code
+generated by future versions of @command{g77} when the same option
+is in force.
+You should make sure you are always able to recompile complete
+programs from source code when upgrading to new versions of @command{g77}
+or @command{f2c}, especially when using options such as @option{-fno-f2c}.
+
+Therefore, if you are using @command{g77} to compile libraries and other
+object files for possible future use and you don't want to require
+recompilation for future use with subsequent versions of @command{g77},
+you might want to stick with @command{f2c} compatibility for now, and
+carefully watch for any announcements about changes to the
+@command{f2c}/@code{libf2c} interface that might affect existing programs
+(thus requiring recompilation).
+
+It is probable that a future version of @command{g77} will not,
+by default, generate object files compatible with @command{f2c},
+and that version probably would no longer use @code{libf2c}.
+If you expect to depend on this compatibility in the
+long term, use the options @samp{-ff2c -ff2c-library} when compiling
+all of the applicable code.
+This should cause future versions of @command{g77} either to produce
+compatible code (at the expense of the availability of some features and
+performance), or at the very least, to produce diagnostics.
+
+(The library @command{g77} produces will no longer be named @file{libg2c}
+when it is no longer generally compatible with @file{libf2c}.
+It will likely be referred to, and, if installed as a distinct
+library, named @code{libg77}, or some other as-yet-unused name.)
+
+@node Compilers Other Than f2c
+@section Compilers Other Than @command{f2c}
+
+On systems with Fortran compilers other than @command{f2c} and @command{g77},
+code compiled by @command{g77} is not expected to work
+well with code compiled by the native compiler.
+(This is true for @command{f2c}-compiled objects as well.)
+Libraries compiled with the native compiler probably will have
+to be recompiled with @command{g77} to be used with @command{g77}-compiled code.
+
+Reasons for such incompatibilities include:
+
+@itemize @bullet
+@item
+There might be differences in the way names of Fortran procedures
+are translated for use in the system's object-file format.
+For example, the statement @samp{CALL FOO} might be compiled
+by @command{g77} to call a procedure the linker @command{ld} sees
+given the name @samp{_foo_}, while the apparently corresponding
+statement @samp{SUBROUTINE FOO} might be compiled by the
+native compiler to define the linker-visible name @samp{_foo},
+or @samp{_FOO_}, and so on.
+
+@item
+There might be subtle type mismatches which cause subroutine arguments
+and function return values to get corrupted.
+
+This is why simply getting @command{g77} to
+transform procedure names the same way a native
+compiler does is not usually a good idea---unless
+some effort has been made to ensure that, aside
+from the way the two compilers transform procedure
+names, everything else about the way they generate
+code for procedure interfaces is identical.
+
+@item
+Native compilers
+use libraries of private I/O routines which will not be available
+at link time unless you have the native compiler---and you would
+have to explicitly ask for them.
+
+For example, on the Sun you
+would have to add @samp{-L/usr/lang/SCx.x -lF77 -lV77} to the link
+command.
+@end itemize
+
+@node Other Languages
+@chapter Other Languages
+
+@emph{Note: This portion of the documentation definitely needs a lot
+of work!}
+
+@menu
+* Interoperating with C and C++::
+@end menu
+
+@node Interoperating with C and C++
+@section Tools and advice for interoperating with C and C++
+
+@cindex C, linking with
+@cindex C++, linking with
+@cindex linking with C
+The following discussion assumes that you are running @command{g77} in @command{f2c}
+compatibility mode, i.e.@: not using @option{-fno-f2c}.
+It provides some
+advice about quick and simple techniques for linking Fortran and C (or
+C++), the most common requirement.
+For the full story consult the
+description of code generation.
+@xref{Debugging and Interfacing}.
+
+When linking Fortran and C, it's usually best to use @command{g77} to do
+the linking so that the correct libraries are included (including the
+maths one).
+If you're linking with C++ you will want to add
+@option{-lstdc++}, @option{-lg++} or whatever.
+If you need to use another
+driver program (or @command{ld} directly),
+you can find out what linkage
+options @command{g77} passes by running @samp{g77 -v}.
+
+@menu
+* C Interfacing Tools::
+* C Access to Type Information::
+* f2c Skeletons and Prototypes::
+* C++ Considerations::
+* Startup Code::
+@end menu
+
+@node C Interfacing Tools
+@subsection C Interfacing Tools
+@pindex f2c
+@cindex cfortran.h
+@cindex Netlib
+Even if you don't actually use it as a compiler, @command{f2c} from
+@uref{ftp://ftp.netlib.org/f2c/src}, can be a useful tool when you're
+interfacing (linking) Fortran and C@.
+@xref{f2c Skeletons and Prototypes,,Generating Skeletons and Prototypes with @command{f2c}}.
+
+To use @command{f2c} for this purpose you only need retrieve and
+build the @file{src} directory from the distribution, consult the
+@file{README} instructions there for machine-specifics, and install the
+@command{f2c} program on your path.
+
+Something else that might be useful is @samp{cfortran.h} from
+@uref{ftp://zebra.desy.de/cfortran}.
+This is a fairly general tool which
+can be used to generate interfaces for calling in both directions
+between Fortran and C@.
+It can be used in @command{f2c} mode with
+@command{g77}---consult its documentation for details.
+
+@node C Access to Type Information
+@subsection Accessing Type Information in C
+
+@cindex types, Fortran/C
+Generally, C code written to link with
+@command{g77} code---calling and/or being
+called from Fortran---should @samp{#include <g2c.h>} to define the C
+versions of the Fortran types.
+Don't assume Fortran @code{INTEGER} types
+correspond to C @code{int}s, for instance; instead, declare them as
+@code{integer}, a type defined by @file{g2c.h}.
+@file{g2c.h} is installed where @command{gcc} will find it by
+default, assuming you use a copy of @command{gcc} compatible with
+@command{g77}, probably built at the same time as @command{g77}.
+
+@node f2c Skeletons and Prototypes
+@subsection Generating Skeletons and Prototypes with @command{f2c}
+
+@pindex f2c
+@cindex -fno-second-underscore
+A simple and foolproof way to write @command{g77}-callable C routines---e.g.@: to
+interface with an existing library---is to write a file (named, for
+example, @file{fred.f}) of dummy Fortran
+skeletons comprising just the declaration of the routine(s) and dummy
+arguments plus @code{END} statements.
+Then run @command{f2c} on file @file{fred.f} to produce @file{fred.c}
+into which you can edit
+useful code, confident the calling sequence is correct, at least.
+(There are some errors otherwise commonly made in generating C
+interfaces with @command{f2c} conventions,
+such as not using @code{doublereal}
+as the return type of a @code{REAL} @code{FUNCTION}.)
+
+@pindex ftnchek
+@command{f2c} also can help with calling Fortran from C, using its
+@option{-P} option to generate C prototypes appropriate for calling the
+Fortran.@footnote{The files generated like this can also be used for
+inter-unit consistency checking of dummy and actual arguments, although
+the @command{ftnchek} tool from @uref{ftp://ftp.netlib.org/fortran}
+or @uref{ftp://ftp.dsm.fordham.edu} is
+probably better for this purpose.}
+If the Fortran code containing any
+routines to be called from C is in file @file{joe.f}, use the command
+@kbd{f2c -P joe.f} to generate the file @file{joe.P} containing
+prototype information.
+@code{#include} this in the C which has to call
+the Fortran routines to make sure you get it right.
+
+@xref{Arrays,,Arrays (DIMENSION)}, for information on the differences
+between the way Fortran (including compilers like @command{g77}) and
+C handle arrays.
+
+@node C++ Considerations
+@subsection C++ Considerations
+
+@cindex C++
+@command{f2c} can be used to generate suitable code for compilation with a
+C++ system using the @option{-C++} option.
+The important thing about linking @command{g77}-compiled
+code with C++ is that the prototypes for the @command{g77}
+routines must specify C linkage to avoid name mangling.
+So, use an @samp{extern "C"} declaration.
+@command{f2c}'s @option{-C++} option will not take care
+of this when generating skeletons or prototype files as above, however,
+it will avoid clashes with C++ reserved words in addition to those in C@.
+
+@node Startup Code
+@subsection Startup Code
+
+@cindex startup code
+@cindex run-time, initialization
+@cindex initialization, run-time
+Unlike with some runtime systems,
+it shouldn't be necessary
+(unless there are bugs)
+to use a Fortran main program unit to ensure the
+runtime---specifically the I/O system---is initialized.
+
+However, to use the @command{g77} intrinsics @code{GETARG} and @code{IARGC},
+either the @code{main} routine from the @file{libg2c} library must be used,
+or the @code{f_setarg} routine
+(new as of @code{egcs} version 1.1 and @command{g77} version 0.5.23)
+must be called with the appropriate @code{argc} and @code{argv} arguments
+prior to the program calling @code{GETARG} or @code{IARGC}.
+
+To provide more flexibility for mixed-language programming
+involving @command{g77} while allowing for shared libraries,
+as of @code{egcs} version 1.1 and @command{g77} version 0.5.23,
+@command{g77}'s @code{main} routine in @code{libg2c}
+does the following, in order:
+
+@enumerate
+@item
+Calls @code{f_setarg}
+with the incoming @code{argc} and @code{argv} arguments,
+in the same order as for @code{main} itself.
+
+This sets up the command-line environment
+for @code{GETARG} and @code{IARGC}.
+
+@item
+Calls @code{f_setsig} (with no arguments).
+
+This sets up the signaling and exception environment.
+
+@item
+Calls @code{f_init} (with no arguments).
+
+This initializes the I/O environment,
+though that should not be necessary,
+as all I/O functions in @code{libf2c}
+are believed to call @code{f_init} automatically,
+if necessary.
+
+(A future version of @command{g77} might skip this explicit step,
+to speed up normal exit of a program.)
+
+@item
+Arranges for @code{f_exit} to be called (with no arguments)
+when the program exits.
+
+This ensures that the I/O environment is properly shut down
+before the program exits normally.
+Otherwise, output buffers might not be fully flushed,
+scratch files might not be deleted, and so on.
+
+The simple way @code{main} does this is
+to call @code{f_exit} itself after calling
+@code{MAIN__} (in the next step).
+
+However, this does not catch the cases where the program
+might call @code{exit} directly,
+instead of using the @code{EXIT} intrinsic
+(implemented as @code{exit_} in @code{libf2c}).
+
+So, @code{main} attempts to use
+the operating environment's @code{onexit} or @code{atexit}
+facility, if available,
+to cause @code{f_exit} to be called automatically
+upon any invocation of @code{exit}.
+
+@item
+Calls @code{MAIN__} (with no arguments).
+
+This starts executing the Fortran main program unit for
+the application.
+(Both @command{g77} and @command{f2c} currently compile a main
+program unit so that its global name is @code{MAIN__}.)
+
+@item
+If no @code{onexit} or @code{atexit} is provided by the system,
+calls @code{f_exit}.
+
+@item
+Calls @code{exit} with a zero argument,
+to signal a successful program termination.
+
+@item
+Returns a zero value to the caller,
+to signal a successful program termination,
+in case @code{exit} doesn't exit on the system.
+@end enumerate
+
+All of the above names are C @code{extern} names,
+i.e.@: not mangled.
+
+When using the @code{main} procedure provided by @command{g77}
+without a Fortran main program unit,
+you need to provide @code{MAIN__}
+as the entry point for your C code.
+(Make sure you link the object file that defines that
+entry point with the rest of your program.)
+
+To provide your own @code{main} procedure
+in place of @command{g77}'s,
+make sure you specify the object file defining that procedure
+@emph{before} @option{-lg2c} on the @command{g77} command line.
+Since the @option{-lg2c} option is implicitly provided,
+this is usually straightforward.
+(Use the @option{--verbose} option to see how and where
+@command{g77} implicitly adds @option{-lg2c} in a command line
+that will link the program.
+Feel free to specify @option{-lg2c} explicitly,
+as appropriate.)
+
+However, when providing your own @code{main},
+make sure you perform the appropriate tasks in the
+appropriate order.
+For example, if your @code{main} does not call @code{f_setarg},
+make sure the rest of your application does not call
+@code{GETARG} or @code{IARGC}.
+
+And, if your @code{main} fails to ensure that @code{f_exit}
+is called upon program exit,
+some files might end up incompletely written,
+some scratch files might be left lying around,
+and some existing files being written might be left
+with old data not properly truncated at the end.
+
+Note that, generally, the @command{g77} operating environment
+does not depend on a procedure named @code{MAIN__} actually
+being called prior to any other @command{g77}-compiled code.
+That is, @code{MAIN__} does not, itself,
+set up any important operating-environment characteristics
+upon which other code might depend.
+This might change in future versions of @command{g77},
+with appropriate notification in the release notes.
+
+For more information, consult the source code for the above routines.
+These are in @file{@value{path-libf2c}/libF77/}, named @file{main.c},
+@file{setarg.c}, @file{setsig.c}, @file{getarg_.c}, and @file{iargc_.c}.
+
+Also, the file @file{@value{path-g77}/com.c} contains the code @command{g77}
+uses to open-code (inline) references to @code{IARGC}.
+
+@node Debugging and Interfacing
+@chapter Debugging and Interfacing
+@cindex debugging
+@cindex interfacing
+@cindex calling C routines
+@cindex C routines calling Fortran
+@cindex f2c compatibility
+
+GNU Fortran currently generates code that is object-compatible with
+the @command{f2c} converter.
+Also, it avoids limitations in the current GBE, such as the
+inability to generate a procedure with
+multiple entry points, by generating code that is structured
+differently (in terms of procedure names, scopes, arguments, and
+so on) than might be expected.
+
+As a result, writing code in other languages that calls on, is
+called by, or shares in-memory data with @command{g77}-compiled code generally
+requires some understanding of the way @command{g77} compiles code for
+various constructs.
+
+Similarly, using a debugger to debug @command{g77}-compiled
+code, even if that debugger supports native Fortran debugging, generally
+requires this sort of information.
+
+This section describes some of the basic information on how
+@command{g77} compiles code for constructs involving interfaces to other
+languages and to debuggers.
+
+@emph{Caution:} Much or all of this information pertains to only the current
+release of @command{g77}, sometimes even to using certain compiler options
+with @command{g77} (such as @option{-fno-f2c}).
+Do not write code that depends on this
+information without clearly marking said code as nonportable and
+subject to review for every new release of @command{g77}.
+This information
+is provided primarily to make debugging of code generated by this
+particular release of @command{g77} easier for the user, and partly to make
+writing (generally nonportable) interface code easier.
+Both of these
+activities require tracking changes in new version of @command{g77} as they
+are installed, because new versions can change the behaviors
+described in this section.
+
+@menu
+* Main Program Unit::  How @command{g77} compiles a main program unit.
+* Procedures::         How @command{g77} constructs parameter lists
+                       for procedures.
+* Functions::          Functions returning floating-point or character data.
+* Names::              Naming of user-defined variables, procedures, etc.
+* Common Blocks::      Accessing common variables while debugging.
+* Local Equivalence Areas::  Accessing @code{EQUIVALENCE} while debugging.
+* Complex Variables::  How @command{g77} performs complex arithmetic.
+* Arrays::             Dealing with (possibly multi-dimensional) arrays.
+* Adjustable Arrays::  Special consideration for adjustable arrays.
+* Alternate Entry Points::  How @command{g77} implements alternate @code{ENTRY}.
+* Alternate Returns::  How @command{g77} handles alternate returns.
+* Assigned Statement Labels::  How @command{g77} handles @code{ASSIGN}.
+* Run-time Library Errors::  Meanings of some @code{IOSTAT=} values.
+@end menu
+
+@node Main Program Unit
+@section Main Program Unit (PROGRAM)
+@cindex PROGRAM statement
+@cindex statements, PROGRAM
+
+When @command{g77} compiles a main program unit, it gives it the public
+procedure name @code{MAIN__}.
+The @code{libg2c} library has the actual @code{main()} procedure
+as is typical of C-based environments, and
+it is this procedure that performs some initial start-up
+activity and then calls @code{MAIN__}.
+
+Generally, @command{g77} and @code{libg2c} are designed so that you need not
+include a main program unit written in Fortran in your program---it
+can be written in C or some other language.
+Especially for I/O handling, this is the case, although @command{g77} version 0.5.16
+includes a bug fix for @code{libg2c} that solved a problem with using the
+@code{OPEN} statement as the first Fortran I/O activity in a program
+without a Fortran main program unit.
+
+However, if you don't intend to use @command{g77} (or @command{f2c}) to compile
+your main program unit---that is, if you intend to compile a @code{main()}
+procedure using some other language---you should carefully
+examine the code for @code{main()} in @code{libg2c}, found in the source
+file @file{@value{path-libf2c}/libF77/main.c}, to see what kinds of things
+might need to be done by your @code{main()} in order to provide the
+Fortran environment your Fortran code is expecting.
+
+@cindex @code{IArgC} intrinsic
+@cindex intrinsics, @code{IArgC}
+@cindex @code{GetArg} intrinsic
+@cindex intrinsics, @code{GetArg}
+For example, @code{libg2c}'s @code{main()} sets up the information used by
+the @code{IARGC} and @code{GETARG} intrinsics.
+Bypassing @code{libg2c}'s @code{main()}
+without providing a substitute for this activity would mean
+that invoking @code{IARGC} and @code{GETARG} would produce undefined
+results.
+
+@cindex debugging
+@cindex main program unit, debugging
+@cindex main()
+@cindex MAIN__()
+@cindex .gdbinit
+When debugging, one implication of the fact that @code{main()}, which
+is the place where the debugged program ``starts'' from the
+debugger's point of view, is in @code{libg2c} is that you won't be
+starting your Fortran program at a point you recognize as your
+Fortran code.
+
+The standard way to get around this problem is to set a break
+point (a one-time, or temporary, break point will do) at
+the entrance to @code{MAIN__}, and then run the program.
+A convenient way to do so is to add the @command{gdb} command
+
+@example
+tbreak MAIN__
+@end example
+
+@noindent
+to the file @file{.gdbinit} in the directory in which you're debugging
+(using @command{gdb}).
+
+After doing this, the debugger will see the current execution
+point of the program as at the beginning of the main program
+unit of your program.
+
+Of course, if you really want to set a break point at some
+other place in your program and just start the program
+running, without first breaking at @code{MAIN__},
+that should work fine.
+
+@node Procedures
+@section Procedures (SUBROUTINE and FUNCTION)
+@cindex procedures
+@cindex SUBROUTINE statement
+@cindex statements, SUBROUTINE
+@cindex FUNCTION statement
+@cindex statements, FUNCTION
+@cindex signature of procedures
+
+Currently, @command{g77} passes arguments via reference---specifically,
+by passing a pointer to the location in memory of a variable, array,
+array element, a temporary location that holds the result of evaluating an
+expression, or a temporary or permanent location that holds the value
+of a constant.
+
+Procedures that accept @code{CHARACTER} arguments are implemented by
+@command{g77} so that each @code{CHARACTER} argument has two actual arguments.
+
+The first argument occupies the expected position in the
+argument list and has the user-specified name.
+This argument
+is a pointer to an array of characters, passed by the caller.
+
+The second argument is appended to the end of the user-specified
+calling sequence and is named @samp{__g77_length_@var{x}}, where @var{x}
+is the user-specified name.
+This argument is of the C type @code{ftnlen}
+(see @file{@value{path-libf2c}/g2c.h.in} for information on that type) and
+is the number of characters the caller has allocated in the
+array pointed to by the first argument.
+
+A procedure will ignore the length argument if @samp{X} is not declared
+@code{CHARACTER*(*)}, because for other declarations, it knows the
+length.
+Not all callers necessarily ``know'' this, however, which
+is why they all pass the extra argument.
+
+The contents of the @code{CHARACTER} argument are specified by the
+address passed in the first argument (named after it).
+The procedure can read or write these contents as appropriate.
+
+When more than one @code{CHARACTER} argument is present in the argument
+list, the length arguments are appended in the order
+the original arguments appear.
+So @samp{CALL FOO('HI','THERE')} is implemented in
+C as @samp{foo("hi","there",2,5);}, ignoring the fact that @command{g77}
+does not provide the trailing null bytes on the constant
+strings (@command{f2c} does provide them, but they are unnecessary in
+a Fortran environment, and you should not expect them to be
+there).
+
+Note that the above information applies to @code{CHARACTER} variables and
+arrays @strong{only}.
+It does @strong{not} apply to external @code{CHARACTER}
+functions or to intrinsic @code{CHARACTER} functions.
+That is, no second length argument is passed to @samp{FOO} in this case:
+
+@example
+CHARACTER X
+EXTERNAL X
+CALL FOO(X)
+@end example
+
+@noindent
+Nor does @samp{FOO} expect such an argument in this case:
+
+@example
+SUBROUTINE FOO(X)
+CHARACTER X
+EXTERNAL X
+@end example
+
+Because of this implementation detail, if a program has a bug
+such that there is disagreement as to whether an argument is
+a procedure, and the type of the argument is @code{CHARACTER}, subtle
+symptoms might appear.
+
+@node Functions
+@section Functions (FUNCTION and RETURN)
+@cindex functions
+@cindex FUNCTION statement
+@cindex statements, FUNCTION
+@cindex RETURN statement
+@cindex statements, RETURN
+@cindex return type of functions
+
+@command{g77} handles in a special way functions that return the following
+types:
+
+@itemize @bullet
+@item
+@code{CHARACTER}
+@item
+@code{COMPLEX}
+@item
+@code{REAL(KIND=1)}
+@end itemize
+
+For @code{CHARACTER}, @command{g77} implements a subroutine (a C function
+returning @code{void})
+with two arguments prepended: @samp{__g77_result}, which the caller passes
+as a pointer to a @code{char} array expected to hold the return value,
+and @samp{__g77_length}, which the caller passes as an @code{ftnlen} value
+specifying the length of the return value as declared in the calling
+program.
+For @code{CHARACTER*(*)}, the called function uses @samp{__g77_length}
+to determine the size of the array that @samp{__g77_result} points to;
+otherwise, it ignores that argument.
+
+For @code{COMPLEX}, when @option{-ff2c} is in
+force, @command{g77} implements
+a subroutine with one argument prepended: @samp{__g77_result}, which the
+caller passes as a pointer to a variable of the type of the function.
+The called function writes the return value into this variable instead
+of returning it as a function value.
+When @option{-fno-f2c} is in force,
+@command{g77} implements a @code{COMPLEX} function as @command{gcc}'s
+@samp{__complex__ float} or @samp{__complex__ double} function
+(or an emulation thereof, when @option{-femulate-complex} is in effect),
+returning the result of the function in the same way as @command{gcc} would.
+
+For @code{REAL(KIND=1)}, when @option{-ff2c} is in force, @command{g77} implements
+a function that actually returns @code{REAL(KIND=2)} (typically
+C's @code{double} type).
+When @option{-fno-f2c} is in force, @code{REAL(KIND=1)}
+functions return @code{float}.
+
+@node Names
+@section Names
+@cindex symbol names
+@cindex transforming symbol names
+
+Fortran permits each implementation to decide how to represent
+names as far as how they're seen in other contexts, such as debuggers
+and when interfacing to other languages, and especially as far
+as how casing is handled.
+
+External names---names of entities that are public, or ``accessible'',
+to all modules in a program---normally have an underscore (@samp{_})
+appended by @command{g77},
+to generate code that is compatible with @command{f2c}.
+External names include names of Fortran things like common blocks,
+external procedures (subroutines and functions, but not including
+statement functions, which are internal procedures), and entry point
+names.
+
+However, use of the @option{-fno-underscoring} option
+disables this kind of transformation of external names (though inhibiting
+the transformation certainly improves the chances of colliding with
+incompatible externals written in other languages---but that
+might be intentional.
+
+@cindex -fno-underscoring option
+@cindex options, -fno-underscoring
+@cindex -fno-second-underscore option
+@cindex options, -fno-underscoring
+When @option{-funderscoring} is in force, any name (external or local)
+that already has at least one underscore in it is
+implemented by @command{g77} by appending two underscores.
+(This second underscore can be disabled via the
+@option{-fno-second-underscore} option.)
+External names are changed this way for @command{f2c} compatibility.
+Local names are changed this way to avoid collisions with external names
+that are different in the source code---@command{f2c} does the same thing, but
+there's no compatibility issue there except for user expectations while
+debugging.
+
+For example:
+
+@example
+Max_Cost = 0
+@end example
+
+@cindex debugging
+@noindent
+Here, a user would, in the debugger, refer to this variable using the
+name @samp{max_cost__} (or @samp{MAX_COST__} or @samp{Max_Cost__},
+as described below).
+(We hope to improve @command{g77} in this regard in the future---don't
+write scripts depending on this behavior!
+Also, consider experimenting with the @option{-fno-underscoring}
+option to try out debugging without having to massage names by
+hand like this.)
+
+@command{g77} provides a number of command-line options that allow the user
+to control how case mapping is handled for source files.
+The default is the traditional UNIX model for Fortran compilers---names
+are mapped to lower case.
+Other command-line options can be specified to map names to upper
+case, or to leave them exactly as written in the source file.
+
+For example:
+
+@example
+Foo = 9.436
+@end example
+
+@noindent
+Here, it is normally the case that the variable assigned will be named
+@samp{foo}.
+This would be the name to enter when using a debugger to
+access the variable.
+
+However, depending on the command-line options specified, the
+name implemented by @command{g77} might instead be @samp{FOO} or even
+@samp{Foo}, thus affecting how debugging is done.
+
+Also:
+
+@example
+Call Foo
+@end example
+
+@noindent
+This would normally call a procedure that, if it were in a separate C program,
+be defined starting with the line:
+
+@example
+void foo_()
+@end example
+
+@noindent
+However, @command{g77} command-line options could be used to change the casing
+of names, resulting in the name @samp{FOO_} or @samp{Foo_} being given to the
+procedure instead of @samp{foo_}, and the @option{-fno-underscoring} option
+could be used to inhibit the appending of the underscore to the name.
+
+@node Common Blocks
+@section Common Blocks (COMMON)
+@cindex common blocks
+@cindex @code{COMMON} statement
+@cindex statements, @code{COMMON}
+
+@command{g77} names and lays out @code{COMMON} areas
+the same way @command{f2c} does,
+for compatibility with @command{f2c}.
+
+@node Local Equivalence Areas
+@section Local Equivalence Areas (EQUIVALENCE)
+@cindex equivalence areas
+@cindex local equivalence areas
+@cindex EQUIVALENCE statement
+@cindex statements, EQUIVALENCE
+
+@command{g77} treats storage-associated areas involving a @code{COMMON}
+block as explained in the section on common blocks.
+
+A local @code{EQUIVALENCE} area is a collection of variables and arrays
+connected to each other in any way via @code{EQUIVALENCE}, none of which are
+listed in a @code{COMMON} statement.
+
+(@emph{Note:} @command{g77} version 0.5.18 and earlier chose the name
+for @var{x} using a different method when more than one name was
+in the list of names of entities placed at the beginning of the
+array.
+Though the documentation specified that the first name listed in
+the @code{EQUIVALENCE} statements was chosen for @var{x}, @command{g77}
+in fact chose the name using a method that was so complicated,
+it seemed easier to change it to an alphabetical sort than to describe the
+previous method in the documentation.)
+
+@node Complex Variables
+@section Complex Variables (COMPLEX)
+@cindex complex variables
+@cindex imaginary part
+@cindex COMPLEX statement
+@cindex statements, COMPLEX
+
+As of 0.5.20, @command{g77} defaults to handling @code{COMPLEX} types
+(and related intrinsics, constants, functions, and so on)
+in a manner that
+makes direct debugging involving these types in Fortran
+language mode difficult.
+
+Essentially, @command{g77} implements these types using an
+internal construct similar to C's @code{struct}, at least
+as seen by the @command{gcc} back end.
+
+Currently, the back end, when outputting debugging info with
+the compiled code for the assembler to digest, does not detect
+these @code{struct} types as being substitutes for Fortran
+complex.
+As a result, the Fortran language modes of debuggers such as
+@command{gdb} see these types as C @code{struct} types, which
+they might or might not support.
+
+Until this is fixed, switch to C language mode to work with
+entities of @code{COMPLEX} type and then switch back to Fortran language
+mode afterward.
+(In @command{gdb}, this is accomplished via @samp{set lang c} and
+either @samp{set lang fortran} or @samp{set lang auto}.)
+
+@node Arrays
+@section Arrays (DIMENSION)
+@cindex DIMENSION statement
+@cindex statements, DIMENSION
+@cindex array ordering
+@cindex ordering, array
+@cindex column-major ordering
+@cindex row-major ordering
+@cindex arrays
+
+Fortran uses ``column-major ordering'' in its arrays.
+This differs from other languages, such as C, which use ``row-major ordering''.
+The difference is that, with Fortran, array elements adjacent to
+each other in memory differ in the @emph{first} subscript instead of
+the last; @samp{A(5,10,20)} immediately follows @samp{A(4,10,20)},
+whereas with row-major ordering it would follow @samp{A(5,10,19)}.
+
+This consideration
+affects not only interfacing with and debugging Fortran code,
+it can greatly affect how code is designed and written, especially
+when code speed and size is a concern.
+
+Fortran also differs from C, a popular language for interfacing and
+to support directly in debuggers, in the way arrays are treated.
+In C, arrays are single-dimensional and have interesting relationships
+to pointers, neither of which is true for Fortran.
+As a result, dealing with Fortran arrays from within
+an environment limited to C concepts can be challenging.
+
+For example, accessing the array element @samp{A(5,10,20)} is easy enough
+in Fortran (use @samp{A(5,10,20)}), but in C some difficult machinations
+are needed.
+First, C would treat the A array as a single-dimension array.
+Second, C does not understand low bounds for arrays as does Fortran.
+Third, C assumes a low bound of zero (0), while Fortran defaults to a
+low bound of one (1) and can supports an arbitrary low bound.
+Therefore, calculations must be done
+to determine what the C equivalent of @samp{A(5,10,20)} would be, and these
+calculations require knowing the dimensions of @samp{A}.
+
+For @samp{DIMENSION A(2:11,21,0:29)}, the calculation of the offset of
+@samp{A(5,10,20)} would be:
+
+@example
+  (5-2)
++ (10-1)*(11-2+1)
++ (20-0)*(11-2+1)*(21-1+1)
+= 4293
+@end example
+
+@noindent
+So the C equivalent in this case would be @samp{a[4293]}.
+
+When using a debugger directly on Fortran code, the C equivalent
+might not work, because some debuggers cannot understand the notion
+of low bounds other than zero.  However, unlike @command{f2c}, @command{g77}
+does inform the GBE that a multi-dimensional array (like @samp{A}
+in the above example) is really multi-dimensional, rather than a
+single-dimensional array, so at least the dimensionality of the array
+is preserved.
+
+Debuggers that understand Fortran should have no trouble with
+nonzero low bounds, but for non-Fortran debuggers, especially
+C debuggers, the above example might have a C equivalent of
+@samp{a[4305]}.
+This calculation is arrived at by eliminating the subtraction
+of the lower bound in the first parenthesized expression on each
+line---that is, for @samp{(5-2)} substitute @samp{(5)}, for @samp{(10-1)}
+substitute @samp{(10)}, and for @samp{(20-0)} substitute @samp{(20)}.
+Actually, the implication of
+this can be that the expression @samp{*(&a[2][1][0] + 4293)} works fine,
+but that @samp{a[20][10][5]} produces the equivalent of
+@samp{*(&a[0][0][0] + 4305)} because of the missing lower bounds.
+
+Come to think of it, perhaps
+the behavior is due to the debugger internally compensating for
+the lower bounds by offsetting the base address of @samp{a}, leaving
+@samp{&a} set lower, in this case, than @samp{&a[2][1][0]} (the address of
+its first element as identified by subscripts equal to the
+corresponding lower bounds).
+
+You know, maybe nobody really needs to use arrays.
+
+@node Adjustable Arrays
+@section Adjustable Arrays (DIMENSION)
+@cindex arrays, adjustable
+@cindex adjustable arrays
+@cindex arrays, automatic
+@cindex automatic arrays
+@cindex DIMENSION statement
+@cindex statements, DIMENSION
+@cindex dimensioning arrays
+@cindex arrays, dimensioning
+
+Adjustable and automatic arrays in Fortran require the implementation
+(in this
+case, the @command{g77} compiler) to ``memorize'' the expressions that
+dimension the arrays each time the procedure is invoked.
+This is so that subsequent changes to variables used in those
+expressions, made during execution of the procedure, do not
+have any effect on the dimensions of those arrays.
+
+For example:
+
+@example
+REAL ARRAY(5)
+DATA ARRAY/5*2/
+CALL X(ARRAY, 5)
+END
+SUBROUTINE X(A, N)
+DIMENSION A(N)
+N = 20
+PRINT *, N, A
+END
+@end example
+
+@noindent
+Here, the implementation should, when running the program, print something
+like:
+
+@example
+20   2.  2.  2.  2.  2.
+@end example
+
+@noindent
+Note that this shows that while the value of @samp{N} was successfully
+changed, the size of the @samp{A} array remained at 5 elements.
+
+To support this, @command{g77} generates code that executes before any user
+code (and before the internally generated computed @code{GOTO} to handle
+alternate entry points, as described below) that evaluates each
+(nonconstant) expression in the list of subscripts for an
+array, and saves the result of each such evaluation to be used when
+determining the size of the array (instead of re-evaluating the
+expressions).
+
+So, in the above example, when @samp{X} is first invoked, code is
+executed that copies the value of @samp{N} to a temporary.
+And that same temporary serves as the actual high bound for the single
+dimension of the @samp{A} array (the low bound being the constant 1).
+Since the user program cannot (legitimately) change the value
+of the temporary during execution of the procedure, the size
+of the array remains constant during each invocation.
+
+For alternate entry points, the code @command{g77} generates takes into
+account the possibility that a dummy adjustable array is not actually
+passed to the actual entry point being invoked at that time.
+In that case, the public procedure implementing the entry point
+passes to the master private procedure implementing all the
+code for the entry points a @code{NULL} pointer where a pointer to that
+adjustable array would be expected.
+The @command{g77}-generated code
+doesn't attempt to evaluate any of the expressions in the subscripts
+for an array if the pointer to that array is @code{NULL} at run time in
+such cases.
+(Don't depend on this particular implementation
+by writing code that purposely passes @code{NULL} pointers where the
+callee expects adjustable arrays, even if you know the callee
+won't reference the arrays---nor should you pass @code{NULL} pointers
+for any dummy arguments used in calculating the bounds of such
+arrays or leave undefined any values used for that purpose in
+COMMON---because the way @command{g77} implements these things might
+change in the future!)
+
+@node Alternate Entry Points
+@section Alternate Entry Points (ENTRY)
+@cindex alternate entry points
+@cindex entry points
+@cindex ENTRY statement
+@cindex statements, ENTRY
+
+The GBE does not understand the general concept of
+alternate entry points as Fortran provides via the ENTRY statement.
+@command{g77} gets around this by using an approach to compiling procedures
+having at least one @code{ENTRY} statement that is almost identical to the
+approach used by @command{f2c}.
+(An alternate approach could be used that
+would probably generate faster, but larger, code that would also
+be a bit easier to debug.)
+
+Information on how @command{g77} implements @code{ENTRY} is provided for those
+trying to debug such code.
+The choice of implementation seems
+unlikely to affect code (compiled in other languages) that interfaces
+to such code.
+
+@command{g77} compiles exactly one public procedure for the primary entry
+point of a procedure plus each @code{ENTRY} point it specifies, as usual.
+That is, in terms of the public interface, there is no difference
+between
+
+@example
+SUBROUTINE X
+END
+SUBROUTINE Y
+END
+@end example
+
+@noindent
+and:
+
+@example
+SUBROUTINE X
+ENTRY Y
+END
+@end example
+
+The difference between the above two cases lies in the code compiled
+for the @samp{X} and @samp{Y} procedures themselves, plus the fact that,
+for the second case, an extra internal procedure is compiled.
+
+For every Fortran procedure with at least one @code{ENTRY}
+statement, @command{g77} compiles an extra procedure
+named @samp{__g77_masterfun_@var{x}}, where @var{x} is
+the name of the primary entry point (which, in the above case,
+using the standard compiler options, would be @samp{x_} in C).
+
+This extra procedure is compiled as a private procedure---that is,
+a procedure not accessible by name to separately compiled modules.
+It contains all the code in the program unit, including the code
+for the primary entry point plus for every entry point.
+(The code for each public procedure is quite short, and explained later.)
+
+The extra procedure has some other interesting characteristics.
+
+The argument list for this procedure is invented by @command{g77}.
+It contains
+a single integer argument named @samp{__g77_which_entrypoint},
+passed by value (as in Fortran's @samp{%VAL()} intrinsic), specifying the
+entry point index---0 for the primary entry point, 1 for the
+first entry point (the first @code{ENTRY} statement encountered), 2 for
+the second entry point, and so on.
+
+It also contains, for functions returning @code{CHARACTER} and
+(when @option{-ff2c} is in effect) @code{COMPLEX} functions,
+and for functions returning different types among the
+@code{ENTRY} statements (e.g. @samp{REAL FUNCTION R()}
+containing @samp{ENTRY I()}), an argument named @samp{__g77_result} that
+is expected at run time to contain a pointer to where to store
+the result of the entry point.
+For @code{CHARACTER} functions, this
+storage area is an array of the appropriate number of characters;
+for @code{COMPLEX} functions, it is the appropriate area for the return
+type; for multiple-return-type functions, it is a union of all the supported return
+types (which cannot include @code{CHARACTER}, since combining @code{CHARACTER}
+and non-@code{CHARACTER} return types via @code{ENTRY} in a single function
+is not supported by @command{g77}).
+
+For @code{CHARACTER} functions, the @samp{__g77_result} argument is followed
+by yet another argument named @samp{__g77_length} that, at run time,
+specifies the caller's expected length of the returned value.
+Note that only @code{CHARACTER*(*)} functions and entry points actually
+make use of this argument, even though it is always passed by
+all callers of public @code{CHARACTER} functions (since the caller does not
+generally know whether such a function is @code{CHARACTER*(*)} or whether
+there are any other callers that don't have that information).
+
+The rest of the argument list is the union of all the arguments
+specified for all the entry points (in their usual forms, e.g.
+@code{CHARACTER} arguments have extra length arguments, all appended at
+the end of this list).
+This is considered the ``master list'' of
+arguments.
+
+The code for this procedure has, before the code for the first
+executable statement, code much like that for the following Fortran
+statement:
+
+@smallexample
+       GOTO (100000,100001,100002), __g77_which_entrypoint
+100000 @dots{}code for primary entry point@dots{}
+100001 @dots{}code immediately following first ENTRY statement@dots{}
+100002 @dots{}code immediately following second ENTRY statement@dots{}
+@end smallexample
+
+@noindent
+(Note that invalid Fortran statement labels and variable names
+are used in the above example to highlight the fact that it
+represents code generated by the @command{g77} internals, not code to be
+written by the user.)
+
+It is this code that, when the procedure is called, picks which
+entry point to start executing.
+
+Getting back to the public procedures (@samp{x} and @samp{Y} in the original
+example), those procedures are fairly simple.
+Their interfaces
+are just like they would be if they were self-contained procedures
+(without @code{ENTRY}), of course, since that is what the callers
+expect.
+Their code consists of simply calling the private
+procedure, described above, with the appropriate extra arguments
+(the entry point index, and perhaps a pointer to a multiple-type-
+return variable, local to the public procedure, that contains
+all the supported returnable non-character types).
+For arguments
+that are not listed for a given entry point that are listed for
+other entry points, and therefore that are in the ``master list''
+for the private procedure, null pointers (in C, the @code{NULL} macro)
+are passed.
+Also, for entry points that are part of a multiple-type-
+returning function, code is compiled after the call of the private
+procedure to extract from the multi-type union the appropriate result,
+depending on the type of the entry point in question, returning
+that result to the original caller.
+
+When debugging a procedure containing alternate entry points, you
+can either set a break point on the public procedure itself (e.g.
+a break point on @samp{X} or @samp{Y}) or on the private procedure that
+contains most of the pertinent code (e.g. @samp{__g77_masterfun_@var{x}}).
+If you do the former, you should use the debugger's command to
+``step into'' the called procedure to get to the actual code; with
+the latter approach, the break point leaves you right at the
+actual code, skipping over the public entry point and its call
+to the private procedure (unless you have set a break point there
+as well, of course).
+
+Further, the list of dummy arguments that is visible when the
+private procedure is active is going to be the expanded version
+of the list for whichever particular entry point is active,
+as explained above, and the way in which return values are
+handled might well be different from how they would be handled
+for an equivalent single-entry function.
+
+@node Alternate Returns
+@section Alternate Returns (SUBROUTINE and RETURN)
+@cindex subroutines
+@cindex alternate returns
+@cindex SUBROUTINE statement
+@cindex statements, SUBROUTINE
+@cindex RETURN statement
+@cindex statements, RETURN
+
+Subroutines with alternate returns (e.g. @samp{SUBROUTINE X(*)} and
+@samp{CALL X(*50)}) are implemented by @command{g77} as functions returning
+the C @code{int} type.
+The actual alternate-return arguments are omitted from the calling sequence.
+Instead, the caller uses
+the return value to do a rough equivalent of the Fortran
+computed-@code{GOTO} statement, as in @samp{GOTO (50), X()} in the
+example above (where @samp{X} is quietly declared as an @code{INTEGER(KIND=1)}
+function), and the callee just returns whatever integer
+is specified in the @code{RETURN} statement for the subroutine
+For example, @samp{RETURN 1} is implemented as @samp{X = 1} followed
+by @samp{RETURN}
+in C, and @samp{RETURN} by itself is @samp{X = 0} and @samp{RETURN}).
+
+@node Assigned Statement Labels
+@section Assigned Statement Labels (ASSIGN and GOTO)
+@cindex assigned statement labels
+@cindex statement labels, assigned
+@cindex ASSIGN statement
+@cindex statements, ASSIGN
+@cindex GOTO statement
+@cindex statements, GOTO
+
+For portability to machines where a pointer (such as to a label,
+which is how @command{g77} implements @code{ASSIGN} and its relatives,
+the assigned-@code{GOTO} and assigned-@code{FORMAT}-I/O statements)
+is wider (bitwise) than an @code{INTEGER(KIND=1)}, @command{g77}
+uses a different memory location to hold the @code{ASSIGN}ed value of a variable
+than it does the numerical value in that variable, unless the
+variable is wide enough (can hold enough bits).
+
+In particular, while @command{g77} implements
+
+@example
+I = 10
+@end example
+
+@noindent
+as, in C notation, @samp{i = 10;}, it implements
+
+@example
+ASSIGN 10 TO I
+@end example
+
+@noindent
+as, in GNU's extended C notation (for the label syntax),
+@samp{__g77_ASSIGN_I = &&L10;} (where @samp{L10} is just a massaging
+of the Fortran label @samp{10} to make the syntax C-like; @command{g77} doesn't
+actually generate the name @samp{L10} or any other name like that,
+since debuggers cannot access labels anyway).
+
+While this currently means that an @code{ASSIGN} statement does not
+overwrite the numeric contents of its target variable, @emph{do not}
+write any code depending on this feature.
+@command{g77} has already changed this implementation across
+versions and might do so in the future.
+This information is provided only to make debugging Fortran programs
+compiled with the current version of @command{g77} somewhat easier.
+If there's no debugger-visible variable named @samp{__g77_ASSIGN_I}
+in a program unit that does @samp{ASSIGN 10 TO I}, that probably
+means @command{g77} has decided it can store the pointer to the label directly
+into @samp{I} itself.
+
+@xref{Ugly Assigned Labels}, for information on a command-line option
+to force @command{g77} to use the same storage for both normal and
+assigned-label uses of a variable.
+
+@node Run-time Library Errors
+@section Run-time Library Errors
+@cindex IOSTAT=
+@cindex error values
+@cindex error messages
+@cindex messages, run-time
+@cindex I/O, errors
+
+The @code{libg2c} library currently has the following table to relate
+error code numbers, returned in @code{IOSTAT=} variables, to messages.
+This information should, in future versions of this document, be
+expanded upon to include detailed descriptions of each message.
+
+In line with good coding practices, any of the numbers in the
+list below should @emph{not} be directly written into Fortran
+code you write.
+Instead, make a separate @code{INCLUDE} file that defines
+@code{PARAMETER} names for them, and use those in your code,
+so you can more easily change the actual numbers in the future.
+
+The information below is culled from the definition
+of @code{F_err} in @file{f/runtime/libI77/err.c} in the
+@command{g77} source tree.
+
+@smallexample
+100: "error in format"
+101: "illegal unit number"
+102: "formatted io not allowed"
+103: "unformatted io not allowed"
+104: "direct io not allowed"
+105: "sequential io not allowed"
+106: "can't backspace file"
+107: "null file name"
+108: "can't stat file"
+109: "unit not connected"
+110: "off end of record"
+111: "truncation failed in endfile"
+112: "incomprehensible list input"
+113: "out of free space"
+114: "unit not connected"
+115: "read unexpected character"
+116: "bad logical input field"
+117: "bad variable type"
+118: "bad namelist name"
+119: "variable not in namelist"
+120: "no end record"
+121: "variable count incorrect"
+122: "subscript for scalar variable"
+123: "invalid array section"
+124: "substring out of bounds"
+125: "subscript out of bounds"
+126: "can't read file"
+127: "can't write file"
+128: "'new' file exists"
+129: "can't append to file"
+130: "non-positive record number"
+131: "I/O started while already doing I/O"
+@end smallexample
+
+@node Collected Fortran Wisdom
+@chapter Collected Fortran Wisdom
+@cindex wisdom
+@cindex legacy code
+@cindex code, legacy
+@cindex writing code
+@cindex code, writing
+
+Most users of @command{g77} can be divided into two camps:
+
+@itemize @bullet
+@item
+Those writing new Fortran code to be compiled by @command{g77}.
+
+@item
+Those using @command{g77} to compile existing, ``legacy'' code.
+@end itemize
+
+Users writing new code generally understand most of the necessary
+aspects of Fortran to write ``mainstream'' code, but often need
+help deciding how to handle problems, such as the construction
+of libraries containing @code{BLOCK DATA}.
+
+Users dealing with ``legacy'' code sometimes don't have much
+experience with Fortran, but believe that the code they're compiling
+already works when compiled by other compilers (and might
+not understand why, as is sometimes the case, it doesn't work
+when compiled by @command{g77}).
+
+The following information is designed to help users do a better job
+coping with existing, ``legacy'' Fortran code, and with writing
+new code as well.
+
+@menu
+* Advantages Over f2c::        If @command{f2c} is so great, why @command{g77}?
+* Block Data and Libraries::   How @command{g77} solves a common problem.
+* Loops::                      Fortran @code{DO} loops surprise many people.
+* Working Programs::           Getting programs to work should be done first.
+* Overly Convenient Options::  Temptations to avoid, habits to not form.
+* Faster Programs::            Everybody wants these, but at what cost?
+@end menu
+
+@node Advantages Over f2c
+@section Advantages Over f2c
+
+Without @command{f2c}, @command{g77} would have taken much longer to
+do and probably not been as good for quite a while.
+Sometimes people who notice how much @command{g77} depends on, and
+documents encouragement to use, @command{f2c} ask why @command{g77}
+was created if @command{f2c} already existed.
+
+This section gives some basic answers to these questions, though it
+is not intended to be comprehensive.
+
+@menu
+* Language Extensions::  Features used by Fortran code.
+* Diagnostic Abilities:: Abilities to spot problems early.
+* Compiler Options::     Features helpful to accommodate legacy code, etc.
+* Compiler Speed::       Speed of the compilation process.
+* Program Speed::        Speed of the generated, optimized code.
+* Ease of Debugging::    Debugging ease-of-use at the source level.
+* Character and Hollerith Constants::  A byte saved is a byte earned.
+@end menu
+
+@node Language Extensions
+@subsection Language Extensions
+
+@command{g77} offers several extensions to FORTRAN 77 language that @command{f2c}
+doesn't:
+
+@itemize @bullet
+@item
+Automatic arrays
+
+@item
+@code{CYCLE} and @code{EXIT}
+
+@item
+Construct names
+
+@item
+@code{SELECT CASE}
+
+@item
+@code{KIND=} and @code{LEN=} notation
+
+@item
+Semicolon as statement separator
+
+@item
+Constant expressions in @code{FORMAT} statements
+(such as @samp{FORMAT(I<J>)},
+where @samp{J} is a @code{PARAMETER} named constant)
+
+@item
+@code{MvBits} intrinsic
+
+@item
+@code{libU77} (Unix-compatibility) library,
+with routines known to compiler as intrinsics
+(so they work even when compiler options are used
+to change the interfaces used by Fortran routines)
+@end itemize
+
+@command{g77} also implements iterative @code{DO} loops
+so that they work even in the presence of certain ``extreme'' inputs,
+unlike @command{f2c}.
+@xref{Loops}.
+
+However, @command{f2c} offers a few that @command{g77} doesn't, such as:
+
+@itemize @bullet
+@item
+Intrinsics in @code{PARAMETER} statements
+
+@item
+Array bounds expressions (such as @samp{REAL M(N(2))})
+
+@item
+@code{AUTOMATIC} statement
+@end itemize
+
+It is expected that @command{g77} will offer some or all of these missing
+features at some time in the future.
+
+@node Diagnostic Abilities
+@subsection Diagnostic Abilities
+
+@command{g77} offers better diagnosis of problems in @code{FORMAT} statements.
+@command{f2c} doesn't, for example, emit any diagnostic for
+@samp{FORMAT(XZFAJG10324)},
+leaving that to be diagnosed, at run time, by
+the @code{libf2c} run-time library.
+
+@node Compiler Options
+@subsection Compiler Options
+
+@command{g77} offers compiler options that @command{f2c} doesn't,
+most of which are designed to more easily accommodate
+legacy code:
+
+@itemize @bullet
+@item
+Two that control the automatic appending of extra
+underscores to external names
+
+@item
+One that allows dollar signs (@samp{$}) in symbol names
+
+@item
+A variety that control acceptance of various
+``ugly'' constructs
+
+@item
+Several that specify acceptable use of upper and lower case
+in the source code
+
+@item
+Many that enable, disable, delete, or hide
+groups of intrinsics
+
+@item
+One to specify the length of fixed-form source lines
+(normally 72)
+
+@item
+One to specify the the source code is written in
+Fortran-90-style free-form
+@end itemize
+
+However, @command{f2c} offers a few that @command{g77} doesn't,
+like an option to have @code{REAL} default to @code{REAL*8}.
+It is expected that @command{g77} will offer all of the
+missing options pertinent to being a Fortran compiler
+at some time in the future.
+
+@node Compiler Speed
+@subsection Compiler Speed
+
+Saving the steps of writing and then rereading C code is a big reason
+why @command{g77} should be able to compile code much faster than using
+@command{f2c} in conjunction with the equivalent invocation of @command{gcc}.
+
+However, due to @command{g77}'s youth, lots of self-checking is still being
+performed.
+As a result, this improvement is as yet unrealized
+(though the potential seems to be there for quite a big speedup
+in the future).
+It is possible that, as of version 0.5.18, @command{g77}
+is noticeably faster compiling many Fortran source files than using
+@command{f2c} in conjunction with @command{gcc}.
+
+@node Program Speed
+@subsection Program Speed
+
+@command{g77} has the potential to better optimize code than @command{f2c},
+even when @command{gcc} is used to compile the output of @command{f2c},
+because @command{f2c} must necessarily
+translate Fortran into a somewhat lower-level language (C) that cannot
+preserve all the information that is potentially useful for optimization,
+while @command{g77} can gather, preserve, and transmit that information directly
+to the GBE.
+
+For example, @command{g77} implements @code{ASSIGN} and assigned
+@code{GOTO} using direct assignment of pointers to labels and direct
+jumps to labels, whereas @command{f2c} maps the assigned labels to
+integer values and then uses a C @code{switch} statement to encode
+the assigned @code{GOTO} statements.
+
+However, as is typical, theory and reality don't quite match, at least
+not in all cases, so it is still the case that @command{f2c} plus @command{gcc}
+can generate code that is faster than @command{g77}.
+
+Version 0.5.18 of @command{g77} offered default
+settings and options, via patches to the @command{gcc}
+back end, that allow for better program speed, though
+some of these improvements also affected the performance
+of programs translated by @command{f2c} and then compiled
+by @command{g77}'s version of @command{gcc}.
+
+Version 0.5.20 of @command{g77} offers further performance
+improvements, at least one of which (alias analysis) is
+not generally applicable to @command{f2c} (though @command{f2c}
+could presumably be changed to also take advantage of
+this new capability of the @command{gcc} back end, assuming
+this is made available in an upcoming release of @command{gcc}).
+
+@node Ease of Debugging
+@subsection Ease of Debugging
+
+Because @command{g77} compiles directly to assembler code like @command{gcc},
+instead of translating to an intermediate language (C) as does @command{f2c},
+support for debugging can be better for @command{g77} than @command{f2c}.
+
+However, although @command{g77} might be somewhat more ``native'' in terms of
+debugging support than @command{f2c} plus @command{gcc}, there still are a lot
+of things ``not quite right''.
+Many of the important ones should be resolved in the near future.
+
+For example, @command{g77} doesn't have to worry about reserved names
+like @command{f2c} does.
+Given @samp{FOR = WHILE}, @command{f2c} must necessarily
+translate this to something @emph{other} than
+@samp{for = while;}, because C reserves those words.
+
+However, @command{g77} does still uses things like an extra level of indirection
+for @code{ENTRY}-laden procedures---in this case, because the back end doesn't
+yet support multiple entry points.
+
+Another example is that, given
+
+@smallexample
+COMMON A, B
+EQUIVALENCE (B, C)
+@end smallexample
+
+@noindent
+the @command{g77} user should be able to access the variables directly, by name,
+without having to traverse C-like structures and unions, while @command{f2c}
+is unlikely to ever offer this ability (due to limitations in the
+C language).
+
+Yet another example is arrays.
+@command{g77} represents them to the debugger
+using the same ``dimensionality'' as in the source code, while @command{f2c}
+must necessarily convert them all to one-dimensional arrays to fit
+into the confines of the C language.
+However, the level of support
+offered by debuggers for interactive Fortran-style access to arrays
+as compiled by @command{g77} can vary widely.
+In some cases, it can actually
+be an advantage that @command{f2c} converts everything to widely supported
+C semantics.
+
+In fairness, @command{g77} could do many of the things @command{f2c} does
+to get things working at least as well as @command{f2c}---for now,
+the developers prefer making @command{g77} work the
+way they think it is supposed to, and finding help improving the
+other products (the back end of @command{gcc}; @command{gdb}; and so on)
+to get things working properly.
+
+@node Character and Hollerith Constants
+@subsection Character and Hollerith Constants
+@cindex character constants
+@cindex constants, character
+@cindex Hollerith constants
+@cindex constants, Hollerith
+@cindex trailing null byte
+@cindex null byte, trailing
+@cindex zero byte, trailing
+
+To avoid the extensive hassle that would be needed to avoid this,
+@command{f2c} uses C character constants to encode character and Hollerith
+constants.
+That means a constant like @samp{'HELLO'} is translated to
+@samp{"hello"} in C, which further means that an extra null byte is
+present at the end of the constant.
+This null byte is superfluous.
+
+@command{g77} does not generate such null bytes.
+This represents significant
+savings of resources, such as on systems where @file{/dev/null} or
+@file{/dev/zero} represent bottlenecks in the systems' performance,
+because @command{g77} simply asks for fewer zeros from the operating
+system than @command{f2c}.
+(Avoiding spurious use of zero bytes, each byte typically have
+eight zero bits, also reduces the liabilities in case
+Microsoft's rumored patent on the digits 0 and 1 is upheld.)
+
+@node Block Data and Libraries
+@section Block Data and Libraries
+@cindex block data and libraries
+@cindex BLOCK DATA statement
+@cindex statements, BLOCK DATA
+@cindex libraries, containing BLOCK DATA
+@cindex f2c compatibility
+@cindex compatibility, f2c
+
+To ensure that block data program units are linked, especially a concern
+when they are put into libraries, give each one a name (as in
+@samp{BLOCK DATA FOO}) and make sure there is an @samp{EXTERNAL FOO}
+statement in every program unit that uses any common block
+initialized by the corresponding @code{BLOCK DATA}.
+@command{g77} currently compiles a @code{BLOCK DATA} as if it were a
+@code{SUBROUTINE},
+that is, it generates an actual procedure having the appropriate name.
+The procedure does nothing but return immediately if it happens to be
+called.
+For @samp{EXTERNAL FOO}, where @samp{FOO} is not otherwise referenced in the
+same program unit, @command{g77} assumes there exists a @samp{BLOCK DATA FOO}
+in the program and ensures that by generating a
+reference to it so the linker will make sure it is present.
+(Specifically, @command{g77} outputs in the data section a static pointer to the
+external name @samp{FOO}.)
+
+The implementation @command{g77} currently uses to make this work is
+one of the few things not compatible with @command{f2c} as currently
+shipped.
+@command{f2c} currently does nothing with @samp{EXTERNAL FOO} except
+issue a warning that @samp{FOO} is not otherwise referenced,
+and, for @samp{BLOCK DATA FOO},
+@command{f2c} doesn't generate a dummy procedure with the name @samp{FOO}.
+The upshot is that you shouldn't mix @command{f2c} and @command{g77} in
+this particular case.
+If you use @command{f2c} to compile @samp{BLOCK DATA FOO},
+then any @command{g77}-compiled program unit that says @samp{EXTERNAL FOO}
+will result in an unresolved reference when linked.
+If you do the
+opposite, then @samp{FOO} might not be linked in under various
+circumstances (such as when @samp{FOO} is in a library, or you're
+using a ``clever'' linker---so clever, it produces a broken program
+with little or no warning by omitting initializations of global data
+because they are contained in unreferenced procedures).
+
+The changes you make to your code to make @command{g77} handle this situation,
+however, appear to be a widely portable way to handle it.
+That is, many systems permit it (as they should, since the
+FORTRAN 77 standard permits @samp{EXTERNAL FOO} when @samp{FOO}
+is a block data program unit), and of the ones
+that might not link @samp{BLOCK DATA FOO} under some circumstances, most of
+them appear to do so once @samp{EXTERNAL FOO} is present in the appropriate
+program units.
+
+Here is the recommended approach to modifying a program containing
+a program unit such as the following:
+
+@smallexample
+BLOCK DATA FOO
+COMMON /VARS/ X, Y, Z
+DATA X, Y, Z / 3., 4., 5. /
+END
+@end smallexample
+
+@noindent
+If the above program unit might be placed in a library module, then
+ensure that every program unit in every program that references that
+particular @code{COMMON} area uses the @code{EXTERNAL} statement
+to force the area to be initialized.
+
+For example, change a program unit that starts with
+
+@smallexample
+INTEGER FUNCTION CURX()
+COMMON /VARS/ X, Y, Z
+CURX = X
+END
+@end smallexample
+
+@noindent
+so that it uses the @code{EXTERNAL} statement, as in:
+
+@smallexample
+INTEGER FUNCTION CURX()
+COMMON /VARS/ X, Y, Z
+EXTERNAL FOO
+CURX = X
+END
+@end smallexample
+
+@noindent
+That way, @samp{CURX} is compiled by @command{g77} (and many other
+compilers) so that the linker knows it must include @samp{FOO},
+the @code{BLOCK DATA} program unit that sets the initial values
+for the variables in @samp{VAR}, in the executable program.
+
+@node Loops
+@section Loops
+@cindex DO statement
+@cindex statements, DO
+@cindex trips, number of
+@cindex number of trips
+
+The meaning of a @code{DO} loop in Fortran is precisely specified
+in the Fortran standard@dots{}and is quite different from what
+many programmers might expect.
+
+In particular, Fortran iterative @code{DO} loops are implemented as if
+the number of trips through the loop is calculated @emph{before}
+the loop is entered.
+
+The number of trips for a loop is calculated from the @var{start},
+@var{end}, and @var{increment} values specified in a statement such as:
+
+@smallexample
+DO @var{iter} = @var{start}, @var{end}, @var{increment}
+@end smallexample
+
+@noindent
+The trip count is evaluated using a fairly simple formula
+based on the three values following the @samp{=} in the
+statement, and it is that trip count that is effectively
+decremented during each iteration of the loop.
+If, at the beginning of an iteration of the loop, the
+trip count is zero or negative, the loop terminates.
+The per-loop-iteration modifications to @var{iter} are not
+related to determining whether to terminate the loop.
+
+There are two important things to remember about the trip
+count:
+
+@itemize @bullet
+@item
+It can be @emph{negative}, in which case it is
+treated as if it was zero---meaning the loop is
+not executed at all.
+
+@item
+The type used to @emph{calculate} the trip count
+is the same type as @var{iter}, but the final
+calculation, and thus the type of the trip
+count itself, always is @code{INTEGER(KIND=1)}.
+@end itemize
+
+These two items mean that there are loops that cannot
+be written in straightforward fashion using the Fortran @code{DO}.
+
+For example, on a system with the canonical 32-bit two's-complement
+implementation of @code{INTEGER(KIND=1)}, the following loop will not work:
+
+@smallexample
+DO I = -2000000000, 2000000000
+@end smallexample
+
+@noindent
+Although the @var{start} and @var{end} values are well within
+the range of @code{INTEGER(KIND=1)}, the @emph{trip count} is not.
+The expected trip count is 40000000001, which is outside
+the range of @code{INTEGER(KIND=1)} on many systems.
+
+Instead, the above loop should be constructed this way:
+
+@smallexample
+I = -2000000000
+DO
+  IF (I .GT. 2000000000) EXIT
+  @dots{}
+  I = I + 1
+END DO
+@end smallexample
+
+@noindent
+The simple @code{DO} construct and the @code{EXIT} statement
+(used to leave the innermost loop)
+are F90 features that @command{g77} supports.
+
+Some Fortran compilers have buggy implementations of @code{DO},
+in that they don't follow the standard.
+They implement @code{DO} as a straightforward translation
+to what, in C, would be a @code{for} statement.
+Instead of creating a temporary variable to hold the trip count
+as calculated at run time, these compilers
+use the iteration variable @var{iter} to control
+whether the loop continues at each iteration.
+
+The bug in such an implementation shows up when the
+trip count is within the range of the type of @var{iter},
+but the magnitude of @samp{ABS(@var{end}) + ABS(@var{incr})}
+exceeds that range.  For example:
+
+@smallexample
+DO I = 2147483600, 2147483647
+@end smallexample
+
+@noindent
+A loop started by the above statement will work as implemented
+by @command{g77}, but the use, by some compilers, of a
+more C-like implementation akin to
+
+@smallexample
+for (i = 2147483600; i <= 2147483647; ++i)
+@end smallexample
+
+@noindent
+produces a loop that does not terminate, because @samp{i}
+can never be greater than 2147483647, since incrementing it
+beyond that value overflows @samp{i}, setting it to -2147483648.
+This is a large, negative number that still is less than 2147483647.
+
+Another example of unexpected behavior of @code{DO} involves
+using a nonintegral iteration variable @var{iter}, that is,
+a @code{REAL} variable.
+Consider the following program:
+
+@smallexample
+      DATA BEGIN, END, STEP /.1, .31, .007/
+      DO 10 R = BEGIN, END, STEP
+         IF (R .GT. END) PRINT *, R, ' .GT. ', END, '!!'
+         PRINT *,R
+10    CONTINUE
+      PRINT *,'LAST = ',R
+      IF (R .LE. END) PRINT *, R, ' .LE. ', END, '!!'
+      END
+@end smallexample
+
+@noindent
+A C-like view of @code{DO} would hold that the two ``exclamatory''
+@code{PRINT} statements are never executed.
+However, this is the output of running the above program
+as compiled by @command{g77} on a GNU/Linux ix86 system:
+
+@smallexample
+ .100000001
+ .107000001
+ .114
+ .120999999
+ @dots{}
+ .289000005
+ .296000004
+ .303000003
+LAST =   .310000002
+ .310000002 .LE.   .310000002!!
+@end smallexample
+
+Note that one of the two checks in the program turned up
+an apparent violation of the programmer's expectation---yet,
+the loop is correctly implemented by @command{g77}, in that
+it has 30 iterations.
+This trip count of 30 is correct when evaluated using
+the floating-point representations for the @var{begin},
+@var{end}, and @var{incr} values (.1, .31, .007) on GNU/Linux
+ix86 are used.
+On other systems, an apparently more accurate trip count
+of 31 might result, but, nevertheless, @command{g77} is
+faithfully following the Fortran standard, and the result
+is not what the author of the sample program above
+apparently expected.
+(Such other systems might, for different values in the @code{DATA}
+statement, violate the other programmer's expectation,
+for example.)
+
+Due to this combination of imprecise representation
+of floating-point values and the often-misunderstood
+interpretation of @code{DO} by standard-conforming
+compilers such as @command{g77}, use of @code{DO} loops
+with @code{REAL} iteration
+variables is not recommended.
+Such use can be caught by specifying @option{-Wsurprising}.
+@xref{Warning Options}, for more information on this
+option.
+
+@node Working Programs
+@section Working Programs
+
+Getting Fortran programs to work in the first place can be
+quite a challenge---even when the programs already work on
+other systems, or when using other compilers.
+
+@command{g77} offers some facilities that might be useful for
+tracking down bugs in such programs.
+
+@menu
+* Not My Type::
+* Variables Assumed To Be Zero::
+* Variables Assumed To Be Saved::
+* Unwanted Variables::
+* Unused Arguments::
+* Surprising Interpretations of Code::
+* Aliasing Assumed To Work::
+* Output Assumed To Flush::
+* Large File Unit Numbers::
+* Floating-point precision::
+* Inconsistent Calling Sequences::
+@end menu
+
+@node Not My Type
+@subsection Not My Type
+@cindex mistyped variables
+@cindex variables, mistyped
+@cindex mistyped functions
+@cindex functions, mistyped
+@cindex implicit typing
+
+A fruitful source of bugs in Fortran source code is use, or
+mis-use, of Fortran's implicit-typing feature, whereby the
+type of a variable, array, or function is determined by the
+first character of its name.
+
+Simple cases of this include statements like @samp{LOGX=9.227},
+without a statement such as @samp{REAL LOGX}.
+In this case, @samp{LOGX} is implicitly given @code{INTEGER(KIND=1)}
+type, with the result of the assignment being that it is given
+the value @samp{9}.
+
+More involved cases include a function that is defined starting
+with a statement like @samp{DOUBLE PRECISION FUNCTION IPS(@dots{})}.
+Any caller of this function that does not also declare @samp{IPS}
+as type @code{DOUBLE PRECISION} (or, in GNU Fortran, @code{REAL(KIND=2)})
+is likely to assume it returns
+@code{INTEGER}, or some other type, leading to invalid results
+or even program crashes.
+
+The @option{-Wimplicit} option might catch failures to
+properly specify the types of
+variables, arrays, and functions in the code.
+
+However, in code that makes heavy use of Fortran's
+implicit-typing facility, this option might produce so
+many warnings about cases that are working, it would be
+hard to find the one or two that represent bugs.
+This is why so many experienced Fortran programmers strongly
+recommend widespread use of the @code{IMPLICIT NONE} statement,
+despite it not being standard FORTRAN 77, to completely turn
+off implicit typing.
+(@command{g77} supports @code{IMPLICIT NONE}, as do almost all
+FORTRAN 77 compilers.)
+
+Note that @option{-Wimplicit} catches only implicit typing of
+@emph{names}.
+It does not catch implicit typing of expressions such
+as @samp{X**(2/3)}.
+Such expressions can be buggy as well---in fact, @samp{X**(2/3)}
+is equivalent to @samp{X**0}, due to the way Fortran expressions
+are given types and then evaluated.
+(In this particular case, the programmer probably wanted
+@samp{X**(2./3.)}.)
+
+@node Variables Assumed To Be Zero
+@subsection Variables Assumed To Be Zero
+@cindex zero-initialized variables
+@cindex variables, assumed to be zero
+@cindex uninitialized variables
+
+Many Fortran programs were developed on systems that provided
+automatic initialization of all, or some, variables and arrays
+to zero.
+As a result, many of these programs depend, sometimes
+inadvertently, on this behavior, though to do so violates
+the Fortran standards.
+
+You can ask @command{g77} for this behavior by specifying the
+@option{-finit-local-zero} option when compiling Fortran code.
+(You might want to specify @option{-fno-automatic} as well,
+to avoid code-size inflation for non-optimized compilations.)
+
+Note that a program that works better when compiled with the
+@option{-finit-local-zero} option
+is almost certainly depending on a particular system's,
+or compiler's, tendency to initialize some variables to zero.
+It might be worthwhile finding such cases and fixing them,
+using techniques such as compiling with the @option{-O -Wuninitialized}
+options using @command{g77}.
+
+@node Variables Assumed To Be Saved
+@subsection Variables Assumed To Be Saved
+@cindex variables, retaining values across calls
+@cindex saved variables
+@cindex static variables
+
+Many Fortran programs were developed on systems that
+saved the values of all, or some, variables and arrays
+across procedure calls.
+As a result, many of these programs depend, sometimes
+inadvertently, on being able to assign a value to a
+variable, perform a @code{RETURN} to a calling procedure,
+and, upon subsequent invocation, reference the previously
+assigned variable to obtain the value.
+
+They expect this despite not using the @code{SAVE} statement
+to specify that the value in a variable is expected to survive
+procedure returns and calls.
+Depending on variables and arrays to retain values across
+procedure calls without using @code{SAVE} to require it violates
+the Fortran standards.
+
+You can ask @command{g77} to assume @code{SAVE} is specified for all
+relevant (local) variables and arrays by using the
+@option{-fno-automatic} option.
+
+Note that a program that works better when compiled with the
+@option{-fno-automatic} option
+is almost certainly depending on not having to use
+the @code{SAVE} statement as required by the Fortran standard.
+It might be worthwhile finding such cases and fixing them,
+using techniques such as compiling with the @samp{-O -Wuninitialized}
+options using @command{g77}.
+
+@node Unwanted Variables
+@subsection Unwanted Variables
+
+The @option{-Wunused} option can find bugs involving
+implicit typing, sometimes
+more easily than using @option{-Wimplicit} in code that makes
+heavy use of implicit typing.
+An unused variable or array might indicate that the
+spelling for its declaration is different from that of
+its intended uses.
+
+Other than cases involving typos, unused variables rarely
+indicate actual bugs in a program.
+However, investigating such cases thoroughly has, on occasion,
+led to the discovery of code that had not been completely
+written---where the programmer wrote declarations as needed
+for the whole algorithm, wrote some or even most of the code
+for that algorithm, then got distracted and forgot that the
+job was not complete.
+
+@node Unused Arguments
+@subsection Unused Arguments
+@cindex unused arguments
+@cindex arguments, unused
+
+As with unused variables, It is possible that unused arguments
+to a procedure might indicate a bug.
+Compile with @samp{-W -Wunused} option to catch cases of
+unused arguments.
+
+Note that @option{-W} also enables warnings regarding overflow
+of floating-point constants under certain circumstances.
+
+@node Surprising Interpretations of Code
+@subsection Surprising Interpretations of Code
+
+The @option{-Wsurprising} option can help find bugs involving
+expression evaluation or in
+the way @code{DO} loops with non-integral iteration variables
+are handled.
+Cases found by this option might indicate a difference of
+interpretation between the author of the code involved, and
+a standard-conforming compiler such as @command{g77}.
+Such a difference might produce actual bugs.
+
+In any case, changing the code to explicitly do what the
+programmer might have expected it to do, so @command{g77} and
+other compilers are more likely to follow the programmer's
+expectations, might be worthwhile, especially if such changes
+make the program work better.
+
+@node Aliasing Assumed To Work
+@subsection Aliasing Assumed To Work
+@cindex -falias-check option
+@cindex options, -falias-check
+@cindex -fargument-alias option
+@cindex options, -fargument-alias
+@cindex -fargument-noalias option
+@cindex options, -fargument-noalias
+@cindex -fno-argument-noalias-global option
+@cindex options, -fno-argument-noalias-global
+@cindex aliasing
+@cindex anti-aliasing
+@cindex overlapping arguments
+@cindex overlays
+@cindex association, storage
+@cindex storage association
+@cindex scheduling of reads and writes
+@cindex reads and writes, scheduling
+
+The @option{-falias-check}, @option{-fargument-alias},
+@option{-fargument-noalias},
+and @option{-fno-argument-noalias-global} options,
+introduced in version 0.5.20 and
+@command{g77}'s version 2.7.2.2.f.2 of @command{gcc},
+were withdrawn as of @command{g77} version 0.5.23
+due to their not being supported by @command{gcc} version 2.8.
+
+These options control the assumptions regarding aliasing
+(overlapping) of writes and reads to main memory (core) made
+by the @command{gcc} back end.
+
+The information below still is useful, but applies to
+only those versions of @command{g77} that support the
+alias analysis implied by support for these options.
+
+These options are effective only when compiling with @option{-O}
+(specifying any level other than @option{-O0})
+or with @option{-falias-check}.
+
+The default for Fortran code is @option{-fargument-noalias-global}.
+(The default for C code and code written in other C-based languages
+is @option{-fargument-alias}.
+These defaults apply regardless of whether you use @command{g77} or
+@command{gcc} to compile your code.)
+
+Note that, on some systems, compiling with @option{-fforce-addr} in
+effect can produce more optimal code when the default aliasing
+options are in effect (and when optimization is enabled).
+
+If your program is not working when compiled with optimization,
+it is possible it is violating the Fortran standards (77 and 90)
+by relying on the ability to ``safely'' modify variables and
+arrays that are aliased, via procedure calls, to other variables
+and arrays, without using @code{EQUIVALENCE} to explicitly
+set up this kind of aliasing.
+
+(The FORTRAN 77 standard's prohibition of this sort of
+overlap, generally referred to therein as ``storage
+association'', appears in Sections 15.9.3.6.
+This prohibition allows implementations, such as @command{g77},
+to, for example, implement the passing of procedures and
+even values in @code{COMMON} via copy operations into local,
+perhaps more efficiently accessed temporaries at entry to a
+procedure, and, where appropriate, via copy operations back
+out to their original locations in memory at exit from that
+procedure, without having to take into consideration the
+order in which the local copies are updated by the code,
+among other things.)
+
+To test this hypothesis, try compiling your program with
+the @option{-fargument-alias} option, which causes the
+compiler to revert to assumptions essentially the same as
+made by versions of @command{g77} prior to 0.5.20.
+
+If the program works using this option, that strongly suggests
+that the bug is in your program.
+Finding and fixing the bug(s) should result in a program that
+is more standard-conforming and that can be compiled by @command{g77}
+in a way that results in a faster executable.
+
+(You might want to try compiling with @option{-fargument-noalias},
+a kind of half-way point, to see if the problem is limited to
+aliasing between dummy arguments and @code{COMMON} variables---this
+option assumes that such aliasing is not done, while still allowing
+aliasing among dummy arguments.)
+
+An example of aliasing that is invalid according to the standards
+is shown in the following program, which might @emph{not} produce
+the expected results when executed:
+
+@smallexample
+I = 1
+CALL FOO(I, I)
+PRINT *, I
+END
+
+SUBROUTINE FOO(J, K)
+J = J + K
+K = J * K
+PRINT *, J, K
+END
+@end smallexample
+
+The above program attempts to use the temporary aliasing of the
+@samp{J} and @samp{K} arguments in @samp{FOO} to effect a
+pathological behavior---the simultaneous changing of the values
+of @emph{both} @samp{J} and @samp{K} when either one of them
+is written.
+
+The programmer likely expects the program to print these values:
+
+@example
+2  4
+4
+@end example
+
+However, since the program is not standard-conforming, an
+implementation's behavior when running it is undefined, because
+subroutine @samp{FOO} modifies at least one of the arguments,
+and they are aliased with each other.
+(Even if one of the assignment statements was deleted, the
+program would still violate these rules.
+This kind of on-the-fly aliasing is permitted by the standard
+only when none of the aliased items are defined, or written,
+while the aliasing is in effect.)
+
+As a practical example, an optimizing compiler might schedule
+the @samp{J =} part of the second line of @samp{FOO} @emph{after}
+the reading of @samp{J} and @samp{K} for the @samp{J * K} expression,
+resulting in the following output:
+
+@example
+2  2
+2
+@end example
+
+Essentially, compilers are promised (by the standard and, therefore,
+by programmers who write code they claim to be standard-conforming)
+that if they cannot detect aliasing via static analysis of a single
+program unit's @code{EQUIVALENCE} and @code{COMMON} statements, no
+such aliasing exists.
+In such cases, compilers are free to assume that an assignment to
+one variable will not change the value of another variable, allowing
+it to avoid generating code to re-read the value of the other
+variable, to re-schedule reads and writes, and so on, to produce
+a faster executable.
+
+The same promise holds true for arrays (as seen by the called
+procedure)---an element of one dummy array cannot be aliased
+with, or overlap, any element of another dummy array or be
+in a @code{COMMON} area known to the procedure.
+
+(These restrictions apply only when the procedure defines, or
+writes to, one of the aliased variables or arrays.)
+
+Unfortunately, there is no way to find @emph{all} possible cases of
+violations of the prohibitions against aliasing in Fortran code.
+Static analysis is certainly imperfect, as is run-time analysis,
+since neither can catch all violations.
+(Static analysis can catch all likely violations, and some that
+might never actually happen, while run-time analysis can catch
+only those violations that actually happen during a particular run.
+Neither approach can cope with programs mixing Fortran code with
+routines written in other languages, however.)
+
+Currently, @command{g77} provides neither static nor run-time facilities
+to detect any cases of this problem, although other products might.
+Run-time facilities are more likely to be offered by future
+versions of @command{g77}, though patches improving @command{g77} so that
+it provides either form of detection are welcome.
+
+@node Output Assumed To Flush
+@subsection Output Assumed To Flush
+@cindex ALWAYS_FLUSH
+@cindex synchronous write errors
+@cindex disk full
+@cindex flushing output
+@cindex fflush()
+@cindex I/O, flushing
+@cindex output, flushing
+@cindex writes, flushing
+@cindex NFS
+@cindex network file system
+
+For several versions prior to 0.5.20, @command{g77} configured its
+version of the @code{libf2c} run-time library so that one of
+its configuration macros, @code{ALWAYS_FLUSH}, was defined.
+
+This was done as a result of a belief that many programs expected
+output to be flushed to the operating system (under UNIX, via
+the @code{fflush()} library call) with the result that errors,
+such as disk full, would be immediately flagged via the
+relevant @code{ERR=} and @code{IOSTAT=} mechanism.
+
+Because of the adverse effects this approach had on the performance
+of many programs, @command{g77} no longer configures @code{libf2c}
+(now named @code{libg2c} in its @command{g77} incarnation)
+to always flush output.
+
+If your program depends on this behavior, either insert the
+appropriate @samp{CALL FLUSH} statements, or modify the sources
+to the @code{libg2c}, rebuild and reinstall @command{g77}, and
+relink your programs with the modified library.
+
+(Ideally, @code{libg2c} would offer the choice at run-time, so
+that a compile-time option to @command{g77} or @command{f2c} could
+result in generating the appropriate calls to flushing or
+non-flushing library routines.)
+
+Some Fortran programs require output
+(writes) to be flushed to the operating system (under UNIX,
+via the @code{fflush()} library call) so that errors,
+such as disk full, are immediately flagged via the relevant
+@code{ERR=} and @code{IOSTAT=} mechanism, instead of such
+errors being flagged later as subsequent writes occur, forcing
+the previously written data to disk, or when the file is
+closed.
+
+Essentially, the difference can be viewed as synchronous error
+reporting (immediate flagging of errors during writes) versus
+asynchronous, or, more precisely, buffered error reporting
+(detection of errors might be delayed).
+
+@code{libg2c} supports flagging write errors immediately when
+it is built with the @code{ALWAYS_FLUSH} macro defined.
+This results in a @code{libg2c} that runs slower, sometimes
+quite a bit slower, under certain circumstances---for example,
+accessing files via the networked file system NFS---but the
+effect can be more reliable, robust file I/O.
+
+If you know that Fortran programs requiring this level of precision
+of error reporting are to be compiled using the
+version of @command{g77} you are building, you might wish to
+modify the @command{g77} source tree so that the version of
+@code{libg2c} is built with the @code{ALWAYS_FLUSH} macro
+defined, enabling this behavior.
+
+To do this, find this line in @file{@value{path-libf2c}/f2c.h} in
+your @command{g77} source tree:
+
+@example
+/* #define ALWAYS_FLUSH */
+@end example
+
+Remove the leading @samp{/*@w{ }},
+so the line begins with @samp{#define},
+and the trailing @samp{@w{ }*/}.
+
+Then build or rebuild @command{g77} as appropriate.
+
+@node Large File Unit Numbers
+@subsection Large File Unit Numbers
+@cindex MXUNIT
+@cindex unit numbers
+@cindex maximum unit number
+@cindex illegal unit number
+@cindex increasing maximum unit number
+
+If your program crashes at run time with a message including
+the text @samp{illegal unit number}, that probably is
+a message from the run-time library, @code{libg2c}.
+
+The message means that your program has attempted to use a
+file unit number that is out of the range accepted by
+@code{libg2c}.
+Normally, this range is 0 through 99, and the high end
+of the range is controlled by a @code{libg2c} source-file
+macro named @code{MXUNIT}.
+
+If you can easily change your program to use unit numbers
+in the range 0 through 99, you should do so.
+
+As distributed, whether as part of @command{f2c} or @command{g77},
+@code{libf2c} accepts file unit numbers only in the range
+0 through 99.
+For example, a statement such as @samp{WRITE (UNIT=100)} causes
+a run-time crash in @code{libf2c}, because the unit number,
+100, is out of range.
+
+If you know that Fortran programs at your installation require
+the use of unit numbers higher than 99, you can change the
+value of the @code{MXUNIT} macro, which represents the maximum unit
+number, to an appropriately higher value.
+
+To do this, edit the file @file{@value{path-libf2c}/libI77/fio.h} in your
+@command{g77} source tree, changing the following line:
+
+@example
+#define MXUNIT 100
+@end example
+
+Change the line so that the value of @code{MXUNIT} is defined to be
+at least one @emph{greater} than the maximum unit number used by
+the Fortran programs on your system.
+
+(For example, a program that does @samp{WRITE (UNIT=255)} would require
+@code{MXUNIT} set to at least 256 to avoid crashing.)
+
+Then build or rebuild @command{g77} as appropriate.
+
+@emph{Note:} Changing this macro has @emph{no} effect on other limits
+your system might place on the number of files open at the same time.
+That is, the macro might allow a program to do @samp{WRITE (UNIT=100)},
+but the library and operating system underlying @code{libf2c} might
+disallow it if many other files have already been opened (via @code{OPEN} or
+implicitly via @code{READ}, @code{WRITE}, and so on).
+Information on how to increase these other limits should be found
+in your system's documentation.
+
+@node Floating-point precision
+@subsection Floating-point precision
+
+@cindex IEEE 754 conformance
+@cindex conformance, IEEE 754
+@cindex floating-point, precision
+@cindex ix86 floating-point
+@cindex x86 floating-point
+If your program depends on exact IEEE 754 floating-point handling it may
+help on some systems---specifically x86 or m68k hardware---to use
+the @option{-ffloat-store} option or to reset the precision flag on the
+floating-point unit.
+@xref{Optimize Options}.
+
+However, it might be better simply to put the FPU into double precision
+mode and not take the performance hit of @option{-ffloat-store}.  On x86
+and m68k GNU systems you can do this with a technique similar to that
+for turning on floating-point exceptions
+(@pxref{Floating-point Exception Handling}).
+The control word could be set to double precision by some code like this
+one:
+@smallexample
+#include <fpu_control.h>
+@{
+  fpu_control_t cw = (_FPU_DEFAULT & ~_FPU_EXTENDED) | _FPU_DOUBLE;
+  _FPU_SETCW(cw);
+@}
+@end smallexample
+(It is not clear whether this has any effect on the operation of the GNU
+maths library, but we have no evidence of it causing trouble.)
+
+Some targets (such as the Alpha) may need special options for full IEEE
+conformance.
+@xref{Submodel Options,,Hardware Models and Configurations,gcc,Using
+the GNU Compiler Collection (GCC)}.
+
+@node Inconsistent Calling Sequences
+@subsection Inconsistent Calling Sequences
+
+@pindex ftnchek
+@cindex floating-point, errors
+@cindex ix86 FPU stack
+@cindex x86 FPU stack
+Code containing inconsistent calling sequences in the same file is
+normally rejected---see @ref{GLOBALS}.
+(Use, say, @command{ftnchek} to ensure
+consistency across source files.
+@xref{f2c Skeletons and Prototypes,,
+Generating Skeletons and Prototypes with @command{f2c}}.)
+
+Mysterious errors, which may appear to be code generation problems, can
+appear specifically on the x86 architecture with some such
+inconsistencies.  On x86 hardware, floating-point return values of
+functions are placed on the floating-point unit's register stack, not
+the normal stack.  Thus calling a @code{REAL} or @code{DOUBLE PRECISION}
+@code{FUNCTION} as some other sort of procedure, or vice versa,
+scrambles the floating-point stack.  This may break unrelated code
+executed later.  Similarly if, say, external C routines are written
+incorrectly.
+
+@node Overly Convenient Options
+@section Overly Convenient Command-line Options
+@cindex overly convenient options
+@cindex options, overly convenient
+
+These options should be used only as a quick-and-dirty way to determine
+how well your program will run under different compilation models
+without having to change the source.
+Some are more problematic
+than others, depending on how portable and maintainable you want the
+program to be (and, of course, whether you are allowed to change it
+at all is crucial).
+
+You should not continue to use these command-line options to compile
+a given program, but rather should make changes to the source code:
+
+@table @code
+@cindex -finit-local-zero option
+@cindex options, -finit-local-zero
+@item -finit-local-zero
+(This option specifies that any uninitialized local variables
+and arrays have default initialization to binary zeros.)
+
+Many other compilers do this automatically, which means lots of
+Fortran code developed with those compilers depends on it.
+
+It is safer (and probably
+would produce a faster program) to find the variables and arrays that
+need such initialization and provide it explicitly via @code{DATA}, so that
+@option{-finit-local-zero} is not needed.
+
+Consider using @option{-Wuninitialized} (which requires @option{-O}) to
+find likely candidates, but
+do not specify @option{-finit-local-zero} or @option{-fno-automatic},
+or this technique won't work.
+
+@cindex -fno-automatic option
+@cindex options, -fno-automatic
+@item -fno-automatic
+(This option specifies that all local variables and arrays
+are to be treated as if they were named in @code{SAVE} statements.)
+
+Many other compilers do this automatically, which means lots of
+Fortran code developed with those compilers depends on it.
+
+The effect of this is that all non-automatic variables and arrays
+are made static, that is, not placed on the stack or in heap storage.
+This might cause a buggy program to appear to work better.
+If so, rather than relying on this command-line option (and hoping all
+compilers provide the equivalent one), add @code{SAVE}
+statements to some or all program unit sources, as appropriate.
+Consider using @option{-Wuninitialized} (which requires @option{-O})
+to find likely candidates, but
+do not specify @option{-finit-local-zero} or @option{-fno-automatic},
+or this technique won't work.
+
+The default is @option{-fautomatic}, which tells @command{g77} to try
+and put variables and arrays on the stack (or in fast registers)
+where possible and reasonable.
+This tends to make programs faster.
+
+@cindex automatic arrays
+@cindex arrays, automatic
+@emph{Note:} Automatic variables and arrays are not affected
+by this option.
+These are variables and arrays that are @emph{necessarily} automatic,
+either due to explicit statements, or due to the way they are
+declared.
+Examples include local variables and arrays not given the
+@code{SAVE} attribute in procedures declared @code{RECURSIVE},
+and local arrays declared with non-constant bounds (automatic
+arrays).
+Currently, @command{g77} supports only automatic arrays, not
+@code{RECURSIVE} procedures or other means of explicitly
+specifying that variables or arrays are automatic.
+
+@cindex -f@var{group}-intrinsics-hide option
+@cindex options, -f@var{group}-intrinsics-hide
+@item -f@var{group}-intrinsics-hide
+Change the source code to use @code{EXTERNAL} for any external procedure
+that might be the name of an intrinsic.
+It is easy to find these using @option{-f@var{group}-intrinsics-disable}.
+@end table
+
+@node Faster Programs
+@section Faster Programs
+@cindex speed, of programs
+@cindex programs, speeding up
+
+Aside from the usual @command{gcc} options, such as @option{-O},
+@option{-ffast-math}, and so on, consider trying some of the
+following approaches to speed up your program (once you get
+it working).
+
+@menu
+* Aligned Data::
+* Prefer Automatic Uninitialized Variables::
+* Avoid f2c Compatibility::
+* Use Submodel Options::
+@end menu
+
+@node Aligned Data
+@subsection Aligned Data
+@cindex alignment
+@cindex data, aligned
+@cindex stack, aligned
+@cindex aligned data
+@cindex aligned stack
+@cindex Pentium optimizations
+@cindex optimization, for Pentium
+
+On some systems, such as those with Pentium Pro CPUs, programs
+that make heavy use of @code{REAL(KIND=2)} (@code{DOUBLE PRECISION})
+might run much slower
+than possible due to the compiler not aligning these 64-bit
+values to 64-bit boundaries in memory.
+(The effect also is present, though
+to a lesser extent, on the 586 (Pentium) architecture.)
+
+The Intel x86 architecture generally ensures that these programs will
+work on all its implementations,
+but particular implementations (such as Pentium Pro)
+perform better with more strict alignment.
+(Such behavior isn't unique to the Intel x86 architecture.)
+Other architectures might @emph{demand} 64-bit alignment
+of 64-bit data.
+
+There are a variety of approaches to use to address this problem:
+
+@itemize @bullet
+@item
+@cindex @code{COMMON} layout
+@cindex layout of @code{COMMON} blocks
+Order your @code{COMMON} and @code{EQUIVALENCE} areas such
+that the variables and arrays with the widest alignment
+guidelines come first.
+
+For example, on most systems, this would mean placing
+@code{COMPLEX(KIND=2)}, @code{REAL(KIND=2)}, and
+@code{INTEGER(KIND=2)} entities first, followed by @code{REAL(KIND=1)},
+@code{INTEGER(KIND=1)}, and @code{LOGICAL(KIND=1)} entities, then
+@code{INTEGER(KIND=6)} entities, and finally @code{CHARACTER}
+and @code{INTEGER(KIND=3)} entities.
+
+The reason to use such placement is it makes it more likely
+that your data will be aligned properly, without requiring
+you to do detailed analysis of each aggregate (@code{COMMON}
+and @code{EQUIVALENCE}) area.
+
+Specifically, on systems where the above guidelines are
+appropriate, placing @code{CHARACTER} entities before
+@code{REAL(KIND=2)} entities can work just as well,
+but only if the number of bytes occupied by the @code{CHARACTER}
+entities is divisible by the recommended alignment for
+@code{REAL(KIND=2)}.
+
+By ordering the placement of entities in aggregate
+areas according to the simple guidelines above, you
+avoid having to carefully count the number of bytes
+occupied by each entity to determine whether the
+actual alignment of each subsequent entity meets the
+alignment guidelines for the type of that entity.
+
+If you don't ensure correct alignment of @code{COMMON} elements, the
+compiler may be forced by some systems to violate the Fortran semantics by
+adding padding to get @code{DOUBLE PRECISION} data properly aligned.
+If the unfortunate practice is employed of overlaying different types of
+data in the @code{COMMON} block, the different variants
+of this block may become misaligned with respect to each other.
+Even if your platform doesn't require strict alignment,
+@code{COMMON} should be laid out as above for portability.
+(Unfortunately the FORTRAN 77 standard didn't anticipate this
+possible requirement, which is compiler-independent on a given platform.)
+
+@item
+@cindex -malign-double option
+@cindex options, -malign-double
+Use the (x86-specific) @option{-malign-double} option when compiling
+programs for the Pentium and Pentium Pro architectures (called 586
+and 686 in the @command{gcc} configuration subsystem).
+The warning about this in the @command{gcc} manual isn't
+generally relevant to Fortran,
+but using it will force @code{COMMON} to be padded if necessary to align
+@code{DOUBLE PRECISION} data.
+
+When @code{DOUBLE PRECISION} data is forcibly aligned
+in @code{COMMON} by @command{g77} due to specifying @option{-malign-double},
+@command{g77} issues a warning about the need to
+insert padding.
+
+In this case, each and every program unit that uses
+the same @code{COMMON} area
+must specify the same layout of variables and their types
+for that area
+and be compiled with @option{-malign-double} as well.
+@command{g77} will issue warnings in each case,
+but as long as every program unit using that area
+is compiled with the same warnings,
+the resulting object files should work when linked together
+unless the program makes additional assumptions about
+@code{COMMON} area layouts that are outside the scope
+of the FORTRAN 77 standard,
+or uses @code{EQUIVALENCE} or different layouts
+in ways that assume no padding is ever inserted by the compiler.
+
+@item
+Ensure that @file{crt0.o} or @file{crt1.o}
+on your system guarantees a 64-bit
+aligned stack for @code{main()}.
+The recent one from GNU (@code{glibc2}) will do this on x86 systems,
+but we don't know of any other x86 setups where it will be right.
+Read your system's documentation to determine if
+it is appropriate to upgrade to a more recent version
+to obtain the optimal alignment.
+@end itemize
+
+Progress is being made on making this work
+``out of the box'' on future versions of @command{g77},
+@command{gcc}, and some of the relevant operating systems
+(such as GNU/Linux).
+
+@node Prefer Automatic Uninitialized Variables
+@subsection Prefer Automatic Uninitialized Variables
+
+If you're using @option{-fno-automatic} already, you probably
+should change your code to allow compilation with @option{-fautomatic}
+(the default), to allow the program to run faster.
+
+Similarly, you should be able to use @option{-fno-init-local-zero}
+(the default) instead of @option{-finit-local-zero}.
+This is because it is rare that every variable affected by these
+options in a given program actually needs to
+be so affected.
+
+For example, @option{-fno-automatic}, which effectively @code{SAVE}s
+every local non-automatic variable and array, affects even things like
+@code{DO} iteration
+variables, which rarely need to be @code{SAVE}d, and this often reduces
+run-time performances.
+Similarly, @option{-fno-init-local-zero} forces such
+variables to be initialized to zero---when @code{SAVE}d (such as when
+@option{-fno-automatic}), this by itself generally affects only
+startup time for a program, but when not @code{SAVE}d,
+it can slow down the procedure every time it is called.
+
+@xref{Overly Convenient Options,,Overly Convenient Command-Line Options},
+for information on the @option{-fno-automatic} and
+@option{-finit-local-zero} options and how to convert
+their use into selective changes in your own code.
+
+@node Avoid f2c Compatibility
+@subsection Avoid f2c Compatibility
+@cindex -fno-f2c option
+@cindex options, -fno-f2c
+@cindex @command{f2c} compatibility
+@cindex compatibility, @command{f2c}
+
+If you aren't linking with any code compiled using
+@command{f2c}, try using the @option{-fno-f2c} option when
+compiling @emph{all} the code in your program.
+(Note that @code{libf2c} is @emph{not} an example of code
+that is compiled using @command{f2c}---it is compiled by a C
+compiler, typically @command{gcc}.)
+
+@node Use Submodel Options
+@subsection Use Submodel Options
+@cindex submodels
+
+Using an appropriate @option{-m} option to generate specific code for your
+CPU may be worthwhile, though it may mean the executable won't run on
+other versions of the CPU that don't support the same instruction set.
+@xref{Submodel Options,,Hardware Models and Configurations,gcc,Using the
+GNU Compiler Collection (GCC)}.  For instance on an x86 system the
+compiler might have
+been built---as shown by @samp{g77 -v}---for the target
+@samp{i386-pc-linux-gnu}, i.e.@: an @samp{i386} CPU@.  In that case to
+generate code best optimized for a Pentium you could use the option
+@option{-march=pentium}.
+
+For recent CPUs that don't have explicit support in the released version
+of @command{gcc}, it @emph{might} still be possible to get improvements
+with certain @option{-m} options.
+
+@option{-fomit-frame-pointer} can help performance on x86 systems and
+others.  It will, however, inhibit debugging on the systems on which it
+is not turned on anyway by @option{-O}.
+
+@node Trouble
+@chapter Known Causes of Trouble with GNU Fortran
+@cindex bugs, known
+@cindex installation trouble
+@cindex known causes of trouble
+
+This section describes known problems that affect users of GNU Fortran.
+Most of these are not GNU Fortran bugs per se---if they were, we would
+fix them.
+But the result for a user might be like the result of a bug.
+
+Some of these problems are due to bugs in other software, some are
+missing features that are too much work to add, and some are places
+where people's opinions differ as to what is best.
+
+(Note that some of this portion of the manual is lifted
+directly from the @command{gcc} manual, with minor modifications
+to tailor it to users of @command{g77}.
+Anytime a bug seems to have more to do with the @command{gcc}
+portion of @command{g77}, see
+@ref{Trouble,,Known Causes of Trouble with GCC,
+gcc,Using the GNU Compiler Collection (GCC)}.)
+
+@menu
+* But-bugs::         Bugs really in other programs or elsewhere.
+* Known Bugs::       Bugs known to be in this version of @command{g77}.
+* Missing Features:: Features we already know we want to add later.
+* Disappointments::  Regrettable things we can't change.
+* Non-bugs::         Things we think are right, but some others disagree.
+* Warnings and Errors::  Which problems in your code get warnings,
+                        and which get errors.
+@end menu
+
+@node But-bugs
+@section Bugs Not In GNU Fortran
+@cindex but-bugs
+
+These are bugs to which the maintainers often have to reply,
+``but that isn't a bug in @command{g77}@dots{}''.
+Some of these already are fixed in new versions of other
+software; some still need to be fixed; some are problems
+with how @command{g77} is installed or is being used;
+some are the result of bad hardware that causes software
+to misbehave in sometimes bizarre ways;
+some just cannot be addressed at this time until more
+is known about the problem.
+
+Please don't re-report these bugs to the @command{g77} maintainers---if
+you must remind someone how important it is to you that the problem
+be fixed, talk to the people responsible for the other products
+identified below, but preferably only after you've tried the
+latest versions of those products.
+The @command{g77} maintainers have their hands full working on
+just fixing and improving @command{g77}, without serving as a
+clearinghouse for all bugs that happen to affect @command{g77}
+users.
+
+@xref{Collected Fortran Wisdom}, for information on behavior
+of Fortran programs, and the programs that compile them, that
+might be @emph{thought} to indicate bugs.
+
+@menu
+* Signal 11 and Friends::  Strange behavior by any software.
+* Cannot Link Fortran Programs::  Unresolved references.
+* Large Common Blocks::    Problems on older GNU/Linux systems.
+* Debugger Problems::      When the debugger crashes.
+* NeXTStep Problems::      Misbehaving executables.
+* Stack Overflow::         More misbehaving executables.
+* Nothing Happens::        Less behaving executables.
+* Strange Behavior at Run Time::  Executables misbehaving due to
+                            bugs in your program.
+* Floating-point Errors::  The results look wrong, but@dots{}.
+@end menu
+
+@node Signal 11 and Friends
+@subsection Signal 11 and Friends
+@cindex signal 11
+@cindex hardware errors
+
+A whole variety of strange behaviors can occur when the
+software, or the way you are using the software,
+stresses the hardware in a way that triggers hardware bugs.
+This might seem hard to believe, but it happens frequently
+enough that there exist documents explaining in detail
+what the various causes of the problems are, what
+typical symptoms look like, and so on.
+
+Generally these problems are referred to in this document
+as ``signal 11'' crashes, because the Linux kernel, running
+on the most popular hardware (the Intel x86 line), often
+stresses the hardware more than other popular operating
+systems.
+When hardware problems do occur under GNU/Linux on x86
+systems, these often manifest themselves as ``signal 11''
+problems, as illustrated by the following diagnostic:
+
+@smallexample
+sh# @kbd{g77 myprog.f}
+gcc: Internal compiler error: program f771 got fatal signal 11
+sh#
+@end smallexample
+
+It is @emph{very} important to remember that the above
+message is @emph{not} the only one that indicates a
+hardware problem, nor does it always indicate a hardware
+problem.
+
+In particular, on systems other than those running the Linux
+kernel, the message might appear somewhat or very different,
+as it will if the error manifests itself while running a
+program other than the @command{g77} compiler.
+For example,
+it will appear somewhat different when running your program,
+when running Emacs, and so on.
+
+How to cope with such problems is well beyond the scope
+of this manual.
+
+However, users of Linux-based systems (such as GNU/Linux)
+should review @uref{http://www.bitwizard.nl/sig11/}, a source
+of detailed information on diagnosing hardware problems,
+by recognizing their common symptoms.
+
+Users of other operating systems and hardware might
+find this reference useful as well.
+If you know of similar material for another hardware/software
+combination, please let us know so we can consider including
+a reference to it in future versions of this manual.
+
+@node Cannot Link Fortran Programs
+@subsection Cannot Link Fortran Programs
+@cindex unresolved reference (various)
+@cindex linking error for user code
+@cindex code, user
+@cindex @command{ld}, error linking user code
+@cindex @command{ld}, can't find strange names
+On some systems, perhaps just those with out-of-date (shared?)
+libraries, unresolved-reference errors happen when linking @command{g77}-compiled
+programs (which should be done using @command{g77}).
+
+If this happens to you, try appending @option{-lc} to the command you
+use to link the program, e.g. @samp{g77 foo.f -lc}.
+@command{g77} already specifies @samp{-lg2c -lm} when it calls the linker,
+but it cannot also specify @option{-lc} because not all systems have a
+file named @file{libc.a}.
+
+It is unclear at this point whether there are legitimately installed
+systems where @samp{-lg2c -lm} is insufficient to resolve code produced
+by @command{g77}.
+
+@cindex undefined reference (_main)
+@cindex linking error, user code
+@cindex @command{ld}, error linking user code
+@cindex code, user
+@cindex @command{ld}, can't find @samp{_main}
+If your program doesn't link due to unresolved references to names
+like @samp{_main}, make sure you're using the @command{g77} command to do the
+link, since this command ensures that the necessary libraries are
+loaded by specifying @samp{-lg2c -lm} when it invokes the @command{gcc}
+command to do the actual link.
+(Use the @option{-v} option to discover
+more about what actually happens when you use the @command{g77} and @command{gcc}
+commands.)
+
+Also, try specifying @option{-lc} as the last item on the @command{g77}
+command line, in case that helps.
+
+@node Large Common Blocks
+@subsection Large Common Blocks
+@cindex common blocks, large
+@cindex large common blocks
+@cindex linking, errors
+@cindex @command{ld}, errors
+@cindex errors, linker
+On some older GNU/Linux systems, programs with common blocks larger
+than 16MB cannot be linked without some kind of error
+message being produced.
+
+This is a bug in older versions of @command{ld}, fixed in
+more recent versions of @code{binutils}, such as version 2.6.
+
+@node Debugger Problems
+@subsection Debugger Problems
+@cindex @command{gdb}, support
+@cindex support, @command{gdb}
+There are some known problems when using @command{gdb} on code
+compiled by @command{g77}.
+Inadequate investigation as of the release of 0.5.16 results in not
+knowing which products are the culprit, but @file{gdb-4.14} definitely
+crashes when, for example, an attempt is made to print the contents
+of a @code{COMPLEX(KIND=2)} dummy array, on at least some GNU/Linux
+machines, plus some others.
+Attempts to access assumed-size arrays are
+also known to crash recent versions of @command{gdb}.
+(@command{gdb}'s Fortran support was done for a different compiler
+and isn't properly compatible with @command{g77}.)
+
+@node NeXTStep Problems
+@subsection NeXTStep Problems
+@cindex NeXTStep problems
+@cindex bus error
+@cindex segmentation violation
+Developers of Fortran code on NeXTStep (all architectures) have to
+watch out for the following problem when writing programs with
+large, statically allocated (i.e. non-stack based) data structures
+(common blocks, saved arrays).
+
+Due to the way the native loader (@file{/bin/ld}) lays out
+data structures in virtual memory, it is very easy to create an
+executable wherein the @samp{__DATA} segment overlaps (has addresses in
+common) with the @samp{UNIX STACK} segment.
+
+This leads to all sorts of trouble, from the executable simply not
+executing, to bus errors.
+The NeXTStep command line tool @command{ebadexec} points to
+the problem as follows:
+
+@smallexample
+% @kbd{/bin/ebadexec a.out}
+/bin/ebadexec: __LINKEDIT segment (truncated address = 0x3de000
+rounded size = 0x2a000) of executable file: a.out overlaps with UNIX
+STACK segment (truncated address = 0x400000 rounded size =
+0x3c00000) of executable file: a.out
+@end smallexample
+
+(In the above case, it is the @samp{__LINKEDIT} segment that overlaps the
+stack segment.)
+
+This can be cured by assigning the @samp{__DATA} segment
+(virtual) addresses beyond the stack segment.
+A conservative
+estimate for this is from address 6000000 (hexadecimal) onwards---this
+has always worked for me [Toon Moene]:
+
+@smallexample
+% @kbd{g77 -segaddr __DATA 6000000 test.f}
+% @kbd{ebadexec a.out}
+ebadexec: file: a.out appears to be executable
+%
+@end smallexample
+
+Browsing through @file{@value{path-g77}/Makefile.in},
+you will find that the @code{f771} program itself also has to be
+linked with these flags---it has large statically allocated
+data structures.
+(Version 0.5.18 reduces this somewhat, but probably
+not enough.)
+
+(The above item was contributed by Toon Moene
+(@email{toon@@moene.indiv.nluug.nl}).)
+
+@node Stack Overflow
+@subsection Stack Overflow
+@cindex stack, overflow
+@cindex segmentation violation
+@command{g77} code might fail at runtime (probably with a ``segmentation
+violation'') due to overflowing the stack.
+This happens most often on systems with an environment
+that provides substantially more heap space (for use
+when arbitrarily allocating and freeing memory) than stack
+space.
+
+Often this can be cured by
+increasing or removing your shell's limit on stack usage, typically
+using @kbd{limit stacksize} (in @command{csh} and derivatives) or
+@kbd{ulimit -s} (in @command{sh} and derivatives).
+
+Increasing the allowed stack size might, however, require
+changing some operating system or system configuration parameters.
+
+You might be able to work around the problem by compiling with the
+@option{-fno-automatic} option to reduce stack usage, probably at the
+expense of speed.
+
+@command{g77}, on most machines, puts many variables and arrays on the stack
+where possible, and can be configured (by changing
+@code{FFECOM_sizeMAXSTACKITEM} in @file{@value{path-g77}/com.c}) to force
+smaller-sized entities into static storage (saving
+on stack space) or permit larger-sized entities to be put on the
+stack (which can improve run-time performance, as it presents
+more opportunities for the GBE to optimize the generated code).
+
+@emph{Note:} Putting more variables and arrays on the stack
+might cause problems due to system-dependent limits on stack size.
+Also, the value of @code{FFECOM_sizeMAXSTACKITEM} has no
+effect on automatic variables and arrays.
+@xref{But-bugs}, for more information.
+@emph{Note:} While @code{libg2c} places a limit on the range
+of Fortran file-unit numbers, the underlying library and operating
+system might impose different kinds of limits.
+For example, some systems limit the number of files simultaneously
+open by a running program.
+Information on how to increase these limits should be found
+in your system's documentation.
+
+@cindex automatic arrays
+@cindex arrays, automatic
+However, if your program uses large automatic arrays
+(for example, has declarations like @samp{REAL A(N)} where
+@samp{A} is a local array and @samp{N} is a dummy or
+@code{COMMON} variable that can have a large value),
+neither use of @option{-fno-automatic},
+nor changing the cut-off point for @command{g77} for using the stack,
+will solve the problem by changing the placement of these
+large arrays, as they are @emph{necessarily} automatic.
+
+@command{g77} currently provides no means to specify that
+automatic arrays are to be allocated on the heap instead
+of the stack.
+So, other than increasing the stack size, your best bet is to
+change your source code to avoid large automatic arrays.
+Methods for doing this currently are outside the scope of
+this document.
+
+(@emph{Note:} If your system puts stack and heap space in the
+same memory area, such that they are effectively combined, then
+a stack overflow probably indicates a program that is either
+simply too large for the system, or buggy.)
+
+@node Nothing Happens
+@subsection Nothing Happens
+@cindex nothing happens
+@cindex naming programs
+@cindex @command{test} programs
+@cindex programs, @command{test}
+It is occasionally reported that a ``simple'' program,
+such as a ``Hello, World!'' program, does nothing when
+it is run, even though the compiler reported no errors,
+despite the program containing nothing other than a
+simple @code{PRINT} statement.
+
+This most often happens because the program has been
+compiled and linked on a UNIX system and named @command{test},
+though other names can lead to similarly unexpected
+run-time behavior on various systems.
+
+Essentially this problem boils down to giving
+your program a name that is already known to
+the shell you are using to identify some other program,
+which the shell continues to execute instead of your
+program when you invoke it via, for example:
+
+@smallexample
+sh# @kbd{test}
+sh#
+@end smallexample
+
+Under UNIX and many other system, a simple command name
+invokes a searching mechanism that might well not choose
+the program located in the current working directory if
+there is another alternative (such as the @command{test}
+command commonly installed on UNIX systems).
+
+The reliable way to invoke a program you just linked in
+the current directory under UNIX is to specify it using
+an explicit pathname, as in:
+
+@smallexample
+sh# @kbd{./test}
+ Hello, World!
+sh#
+@end smallexample
+
+Users who encounter this problem should take the time to
+read up on how their shell searches for commands, how to
+set their search path, and so on.
+The relevant UNIX commands to learn about include
+@command{man}, @command{info} (on GNU systems), @command{setenv} (or
+@command{set} and @command{env}), @command{which}, and @command{find}.
+
+@node Strange Behavior at Run Time
+@subsection Strange Behavior at Run Time
+@cindex segmentation violation
+@cindex bus error
+@cindex overwritten data
+@cindex data, overwritten
+@command{g77} code might fail at runtime with ``segmentation violation'',
+``bus error'', or even something as subtle as a procedure call
+overwriting a variable or array element that it is not supposed
+to touch.
+
+These can be symptoms of a wide variety of actual bugs that
+occurred earlier during the program's run, but manifested
+themselves as @emph{visible} problems some time later.
+
+Overflowing the bounds of an array---usually by writing beyond
+the end of it---is one of two kinds of bug that often occurs
+in Fortran code.
+(Compile your code with the @option{-fbounds-check} option
+to catch many of these kinds of errors at program run time.)
+
+The other kind of bug is a mismatch between the actual arguments
+passed to a procedure and the dummy arguments as declared by that
+procedure.
+
+Both of these kinds of bugs, and some others as well, can be
+difficult to track down, because the bug can change its behavior,
+or even appear to not occur, when using a debugger.
+
+That is, these bugs can be quite sensitive to data, including
+data representing the placement of other data in memory (that is,
+pointers, such as the placement of stack frames in memory).
+
+@command{g77} now offers the
+ability to catch and report some of these problems at compile, link, or
+run time, such as by generating code to detect references to
+beyond the bounds of most arrays (except assumed-size arrays),
+and checking for agreement between calling and called procedures.
+Future improvements are likely to be made in the procedure-mismatch area,
+at least.
+
+In the meantime, finding and fixing the programming
+bugs that lead to these behaviors is, ultimately, the user's
+responsibility, as difficult as that task can sometimes be.
+
+@cindex infinite spaces printed
+@cindex space, endless printing of
+@cindex libc, non-ANSI or non-default
+@cindex C library
+@cindex linking against non-standard library
+@cindex Solaris
+One runtime problem that has been observed might have a simple solution.
+If a formatted @code{WRITE} produces an endless stream of spaces, check
+that your program is linked against the correct version of the C library.
+The configuration process takes care to account for your
+system's normal @file{libc} not being ANSI-standard, which will
+otherwise cause this behavior.
+If your system's default library is
+ANSI-standard and you subsequently link against a non-ANSI one, there
+might be problems such as this one.
+
+Specifically, on Solaris2 systems,
+avoid picking up the @code{BSD} library from @file{/usr/ucblib}.
+
+@node Floating-point Errors
+@subsection Floating-point Errors
+@cindex floating-point errors
+@cindex rounding errors
+@cindex inconsistent floating-point results
+@cindex results, inconsistent
+Some programs appear to produce inconsistent floating-point
+results compiled by @command{g77} versus by other compilers.
+
+Often the reason for this behavior is the fact that floating-point
+values are represented on almost all Fortran systems by
+@emph{approximations}, and these approximations are inexact
+even for apparently simple values like 0.1, 0.2, 0.3, 0.4, 0.6,
+0.7, 0.8, 0.9, 1.1, and so on.
+Most Fortran systems, including all current ports of @command{g77},
+use binary arithmetic to represent these approximations.
+
+Therefore, the exact value of any floating-point approximation
+as manipulated by @command{g77}-compiled code is representable by
+adding some combination of the values 1.0, 0.5, 0.25, 0.125, and
+so on (just keep dividing by two) through the precision of the
+fraction (typically around 23 bits for @code{REAL(KIND=1)}, 52 for
+@code{REAL(KIND=2)}), then multiplying the sum by a integral
+power of two (in Fortran, by @samp{2**N}) that typically is between
+-127 and +128 for @code{REAL(KIND=1)} and -1023 and +1024 for
+@code{REAL(KIND=2)}, then multiplying by -1 if the number
+is negative.
+
+So, a value like 0.2 is exactly represented in decimal---since
+it is a fraction, @samp{2/10}, with a denominator that is compatible
+with the base of the number system (base 10).
+However, @samp{2/10} cannot be represented by any finite number
+of sums of any of 1.0, 0.5, 0.25, and so on, so 0.2 cannot
+be exactly represented in binary notation.
+
+(On the other hand, decimal notation can represent any binary
+number in a finite number of digits.
+Decimal notation cannot do so with ternary, or base-3,
+notation, which would represent floating-point numbers as
+sums of any of @samp{1/1}, @samp{1/3}, @samp{1/9}, and so on.
+After all, no finite number of decimal digits can exactly
+represent @samp{1/3}.
+Fortunately, few systems use ternary notation.)
+
+Moreover, differences in the way run-time I/O libraries convert
+between these approximations and the decimal representation often
+used by programmers and the programs they write can result in
+apparent differences between results that do not actually exist,
+or exist to such a small degree that they usually are not worth
+worrying about.
+
+For example, consider the following program:
+
+@smallexample
+PRINT *, 0.2
+END
+@end smallexample
+
+When compiled by @command{g77}, the above program might output
+@samp{0.20000003}, while another compiler might produce a
+executable that outputs @samp{0.2}.
+
+This particular difference is due to the fact that, currently,
+conversion of floating-point values by the @code{libg2c} library,
+used by @command{g77}, handles only double-precision values.
+
+Since @samp{0.2} in the program is a single-precision value, it
+is converted to double precision (still in binary notation)
+before being converted back to decimal.
+The conversion to binary appends @emph{binary} zero digits to the
+original value---which, again, is an inexact approximation of
+0.2---resulting in an approximation that is much less exact
+than is connoted by the use of double precision.
+
+(The appending of binary zero digits has essentially the same
+effect as taking a particular decimal approximation of
+@samp{1/3}, such as @samp{0.3333333}, and appending decimal
+zeros to it, producing @samp{0.33333330000000000}.
+Treating the resulting decimal approximation as if it really
+had 18 or so digits of valid precision would make it seem
+a very poor approximation of @samp{1/3}.)
+
+As a result of converting the single-precision approximation
+to double precision by appending binary zeros, the conversion
+of the resulting double-precision
+value to decimal produces what looks like an incorrect
+result, when in fact the result is @emph{inexact}, and
+is probably no less inaccurate or imprecise an approximation
+of 0.2 than is produced by other compilers that happen to output
+the converted value as ``exactly'' @samp{0.2}.
+(Some compilers behave in a way that can make them appear
+to retain more accuracy across a conversion of a single-precision
+constant to double precision.
+@xref{Context-Sensitive Constants}, to see why
+this practice is illusory and even dangerous.)
+
+Note that a more exact approximation of the constant is
+computed when the program is changed to specify a
+double-precision constant:
+
+@smallexample
+PRINT *, 0.2D0
+END
+@end smallexample
+
+Future versions of @command{g77} and/or @code{libg2c} might convert
+single-precision values directly to decimal,
+instead of converting them to double precision first.
+This would tend to result in output that is more consistent
+with that produced by some other Fortran implementations.
+
+A useful source of information on floating-point computation is David
+Goldberg, `What Every Computer Scientist Should Know About
+Floating-Point Arithmetic', Computing Surveys, 23, March 1991, pp.@:
+5-48.
+An online version is available at
+@uref{http://docs.sun.com/}.
+
+Information related to the IEEE 754 floating-point standard can be found
+at @uref{http://grouper.ieee.org/groups/754/} and
+@uref{http://http.cs.berkeley.edu/%7Ewkahan/ieee754status/};
+see also slides from the short course referenced from
+@uref{http://http.cs.berkeley.edu/%7Efateman/}.
+
+The supplement to the PostScript-formatted Goldberg document,
+referenced above, is available in HTML format.
+See `Differences Among IEEE 754 Implementations' by Doug Priest.
+This document explores some of the issues surrounding computing
+of extended (80-bit) results on processors such as the x86,
+especially when those results are arbitrarily truncated
+to 32-bit or 64-bit values by the compiler
+as ``spills''.
+
+@cindex spills of floating-point results
+@cindex 80-bit spills
+@cindex truncation, of floating-point values
+(@emph{Note:} @command{g77} specifically, and @command{gcc} generally,
+does arbitrarily truncate 80-bit results during spills
+as of this writing.
+It is not yet clear whether a future version of
+the GNU compiler suite will offer 80-bit spills
+as an option, or perhaps even as the default behavior.)
+
+@c xref would be different between editions:
+The GNU C library provides routines for controlling the FPU, and other
+documentation about this.
+
+@xref{Floating-point precision}, regarding IEEE 754 conformance.
+
+@include bugs.texi
+
+@node Missing Features
+@section Missing Features
+
+This section lists features we know are missing from @command{g77},
+and which we want to add someday.
+(There is no priority implied in the ordering below.)
+
+@menu
+GNU Fortran language:
+* Better Source Model::
+* Fortran 90 Support::
+* Intrinsics in PARAMETER Statements::
+* Arbitrary Concatenation::
+* SELECT CASE on CHARACTER Type::
+* RECURSIVE Keyword::
+* Popular Non-standard Types::
+* Full Support for Compiler Types::
+* Array Bounds Expressions::
+* POINTER Statements::
+* Sensible Non-standard Constructs::
+* READONLY Keyword::
+* FLUSH Statement::
+* Expressions in FORMAT Statements::
+* Explicit Assembler Code::
+* Q Edit Descriptor::
+
+GNU Fortran dialects:
+* Old-style PARAMETER Statements::
+* TYPE and ACCEPT I/O Statements::
+* STRUCTURE UNION RECORD MAP::
+* OPEN CLOSE and INQUIRE Keywords::
+* ENCODE and DECODE::
+* AUTOMATIC Statement::
+* Suppressing Space Padding::
+* Fortran Preprocessor::
+* Bit Operations on Floating-point Data::
+* Really Ugly Character Assignments::
+
+New facilities:
+* POSIX Standard::
+* Floating-point Exception Handling::
+* Nonportable Conversions::
+* Large Automatic Arrays::
+* Support for Threads::
+* Increasing Precision/Range::
+* Enabling Debug Lines::
+
+Better diagnostics:
+* Better Warnings::
+* Gracefully Handle Sensible Bad Code::
+* Non-standard Conversions::
+* Non-standard Intrinsics::
+* Modifying DO Variable::
+* Better Pedantic Compilation::
+* Warn About Implicit Conversions::
+* Invalid Use of Hollerith Constant::
+* Dummy Array Without Dimensioning Dummy::
+* Invalid FORMAT Specifiers::
+* Ambiguous Dialects::
+* Unused Labels::
+* Informational Messages::
+
+Run-time facilities:
+* Uninitialized Variables at Run Time::
+* Portable Unformatted Files::
+* Better List-directed I/O::
+* Default to Console I/O::
+
+Debugging:
+* Labels Visible to Debugger::
+@end menu
+
+@node Better Source Model
+@subsection Better Source Model
+
+@command{g77} needs to provide, as the default source-line model,
+a ``pure visual'' mode, where
+the interpretation of a source program in this mode can be accurately
+determined by a user looking at a traditionally displayed rendition
+of the program (assuming the user knows whether the program is fixed
+or free form).
+
+The design should assume the user cannot tell tabs from spaces
+and cannot see trailing spaces on lines, but has canonical tab stops
+and, for fixed-form source, has the ability to always know exactly
+where column 72 is (since the Fortran standard itself requires
+this for fixed-form source).
+
+This would change the default treatment of fixed-form source
+to not treat lines with tabs as if they were infinitely long---instead,
+they would end at column 72 just as if the tabs were replaced
+by spaces in the canonical way.
+
+As part of this, provide common alternate models (Digital, @command{f2c},
+and so on) via command-line options.
+This includes allowing arbitrarily long
+lines for free-form source as well as fixed-form source and providing
+various limits and diagnostics as appropriate.
+
+@cindex sequence numbers
+@cindex columns 73 through 80
+Also, @command{g77} should offer, perhaps even default to, warnings
+when characters beyond the last valid column are anything other
+than spaces.
+This would mean code with ``sequence numbers'' in columns 73 through 80
+would be rejected, and there's a lot of that kind of code around,
+but one of the most frequent bugs encountered by new users is
+accidentally writing fixed-form source code into and beyond
+column 73.
+So, maybe the users of old code would be able to more easily handle
+having to specify, say, a @option{-Wno-col73to80} option.
+
+@node Fortran 90 Support
+@subsection Fortran 90 Support
+@cindex Fortran 90, support
+@cindex support, Fortran 90
+
+@command{g77} does not support many of the features that
+distinguish Fortran 90 (and, now, Fortran 95) from
+ANSI FORTRAN 77.
+
+Some Fortran 90 features are supported, because they
+make sense to offer even to die-hard users of F77.
+For example, many of them codify various ways F77 has
+been extended to meet users' needs during its tenure,
+so @command{g77} might as well offer them as the primary
+way to meet those same needs, even if it offers compatibility
+with one or more of the ways those needs were met
+by other F77 compilers in the industry.
+
+Still, many important F90 features are not supported,
+because no attempt has been made to research each and
+every feature and assess its viability in @command{g77}.
+In the meantime, users who need those features must
+use Fortran 90 compilers anyway, and the best approach
+to adding some F90 features to GNU Fortran might well be
+to fund a comprehensive project to create GNU Fortran 95.
+
+@node Intrinsics in PARAMETER Statements
+@subsection Intrinsics in @code{PARAMETER} Statements
+@cindex PARAMETER statement
+@cindex statements, PARAMETER
+
+@command{g77} doesn't allow intrinsics in @code{PARAMETER} statements.
+
+Related to this, @command{g77} doesn't allow non-integral
+exponentiation in @code{PARAMETER} statements, such as
+@samp{PARAMETER (R=2**.25)}.
+It is unlikely @command{g77} will ever support this feature,
+as doing it properly requires complete emulation of
+a target computer's floating-point facilities when
+building @command{g77} as a cross-compiler.
+But, if the @command{gcc} back end is enhanced to provide
+such a facility, @command{g77} will likely use that facility
+in implementing this feature soon afterwards.
+
+@node Arbitrary Concatenation
+@subsection Arbitrary Concatenation
+@cindex concatenation
+@cindex CHARACTER*(*)
+@cindex run-time, dynamic allocation
+
+@command{g77} doesn't support arbitrary operands for concatenation
+in contexts where run-time allocation is required.
+For example:
+
+@smallexample
+SUBROUTINE X(A)
+CHARACTER*(*) A
+CALL FOO(A // 'suffix')
+@end smallexample
+
+@node SELECT CASE on CHARACTER Type
+@subsection @code{SELECT CASE} on @code{CHARACTER} Type
+
+Character-type selector/cases for @code{SELECT CASE} currently
+are not supported.
+
+@node RECURSIVE Keyword
+@subsection @code{RECURSIVE} Keyword
+@cindex RECURSIVE keyword
+@cindex keywords, RECURSIVE
+@cindex recursion, lack of
+@cindex lack of recursion
+
+@command{g77} doesn't support the @code{RECURSIVE} keyword that
+F90 compilers do.
+Nor does it provide any means for compiling procedures
+designed to do recursion.
+
+All recursive code can be rewritten to not use recursion,
+but the result is not pretty.
+
+@node Increasing Precision/Range
+@subsection Increasing Precision/Range
+@cindex -r8
+@cindex -qrealsize=8
+@cindex -i8
+@cindex f2c
+@cindex increasing precision
+@cindex precision, increasing
+@cindex increasing range
+@cindex range, increasing
+@cindex Toolpack
+@cindex Netlib
+
+Some compilers, such as @command{f2c}, have an option (@option{-r8},
+@option{-qrealsize=8} or
+similar) that provides automatic treatment of @code{REAL}
+entities such that they have twice the storage size, and
+a corresponding increase in the range and precision, of what
+would normally be the @code{REAL(KIND=1)} (default @code{REAL}) type.
+(This affects @code{COMPLEX} the same way.)
+
+They also typically offer another option (@option{-i8}) to increase
+@code{INTEGER} entities so they are twice as large
+(with roughly twice as much range).
+
+(There are potential pitfalls in using these options.)
+
+@command{g77} does not yet offer any option that performs these
+kinds of transformations.
+Part of the problem is the lack of detailed specifications regarding
+exactly how these options affect the interpretation of constants,
+intrinsics, and so on.
+
+Until @command{g77} addresses this need, programmers could improve
+the portability of their code by modifying it to not require
+compile-time options to produce correct results.
+Some free tools are available which may help, specifically
+in Toolpack (which one would expect to be sound) and the @file{fortran}
+section of the Netlib repository.
+
+Use of preprocessors can provide a fairly portable means
+to work around the lack of widely portable methods in the Fortran
+language itself (though increasing acceptance of Fortran 90 would
+alleviate this problem).
+
+@node Popular Non-standard Types
+@subsection Popular Non-standard Types
+@cindex @code{INTEGER*2} support
+@cindex types, @code{INTEGER*2}
+@cindex @code{LOGICAL*1} support
+@cindex types, @code{LOGICAL*1}
+
+@command{g77} doesn't fully support @code{INTEGER*2}, @code{LOGICAL*1},
+and similar.
+In the meantime, version 0.5.18 provides rudimentary support
+for them.
+
+@node Full Support for Compiler Types
+@subsection Full Support for Compiler Types
+
+@cindex @code{REAL*16} support
+@cindex types, @code{REAL*16}
+@cindex @code{INTEGER*8} support
+@cindex types, @code{INTEGER*8}
+@command{g77} doesn't support @code{INTEGER}, @code{REAL}, and @code{COMPLEX} equivalents
+for @emph{all} applicable back-end-supported types (@code{char}, @code{short int},
+@code{int}, @code{long int}, @code{long long int}, and @code{long double}).
+This means providing intrinsic support, and maybe constant
+support (using F90 syntax) as well, and, for most
+machines will result in automatic support of @code{INTEGER*1},
+@code{INTEGER*2}, @code{INTEGER*8}, maybe even @code{REAL*16},
+and so on.
+
+@node Array Bounds Expressions
+@subsection Array Bounds Expressions
+@cindex array elements, in adjustable array bounds
+@cindex function references, in adjustable array bounds
+@cindex array bounds, adjustable
+@cindex @code{DIMENSION} statement
+@cindex statements, @code{DIMENSION}
+
+@command{g77} doesn't support more general expressions to dimension
+arrays, such as array element references, function
+references, etc.
+
+For example, @command{g77} currently does not accept the following:
+
+@smallexample
+SUBROUTINE X(M, N)
+INTEGER N(10), M(N(2), N(1))
+@end smallexample
+
+@node POINTER Statements
+@subsection POINTER Statements
+@cindex POINTER statement
+@cindex statements, POINTER
+@cindex Cray pointers
+
+@command{g77} doesn't support pointers or allocatable objects
+(other than automatic arrays).
+This set of features is
+probably considered just behind intrinsics
+in @code{PARAMETER} statements on the list of large,
+important things to add to @command{g77}.
+
+In the meantime, consider using the @code{INTEGER(KIND=7)}
+declaration to specify that a variable must be
+able to hold a pointer.
+This construct is not portable to other non-GNU compilers,
+but it is portable to all machines GNU Fortran supports
+when @command{g77} is used.
+
+@xref{Functions and Subroutines}, for information on
+@code{%VAL()}, @code{%REF()}, and @code{%DESCR()}
+constructs, which are useful for passing pointers to
+procedures written in languages other than Fortran.
+
+@node Sensible Non-standard Constructs
+@subsection Sensible Non-standard Constructs
+
+@command{g77} rejects things other compilers accept,
+like @samp{INTRINSIC SQRT,SQRT}.
+As time permits in the future, some of these things that are easy for
+humans to read and write and unlikely to be intended to mean something
+else will be accepted by @command{g77} (though @option{-fpedantic} should
+trigger warnings about such non-standard constructs).
+
+Until @command{g77} no longer gratuitously rejects sensible code,
+you might as well fix your code
+to be more standard-conforming and portable.
+
+The kind of case that is important to except from the
+recommendation to change your code is one where following
+good coding rules would force you to write non-standard
+code that nevertheless has a clear meaning.
+
+For example, when writing an @code{INCLUDE} file that
+defines a common block, it might be appropriate to
+include a @code{SAVE} statement for the common block
+(such as @samp{SAVE /CBLOCK/}), so that variables
+defined in the common block retain their values even
+when all procedures declaring the common block become
+inactive (return to their callers).
+
+However, putting @code{SAVE} statements in an @code{INCLUDE}
+file would prevent otherwise standard-conforming code
+from also specifying the @code{SAVE} statement, by itself,
+to indicate that all local variables and arrays are to
+have the @code{SAVE} attribute.
+
+For this reason, @command{g77} already has been changed to
+allow this combination, because although the general
+problem of gratuitously rejecting unambiguous and
+``safe'' constructs still exists in @command{g77}, this
+particular construct was deemed useful enough that
+it was worth fixing @command{g77} for just this case.
+
+So, while there is no need to change your code
+to avoid using this particular construct, there
+might be other, equally appropriate but non-standard
+constructs, that you shouldn't have to stop using
+just because @command{g77} (or any other compiler)
+gratuitously rejects it.
+
+Until the general problem is solved, if you have
+any such construct you believe is worthwhile
+using (e.g. not just an arbitrary, redundant
+specification of an attribute), please submit a
+bug report with an explanation, so we can consider
+fixing @command{g77} just for cases like yours.
+
+@node READONLY Keyword
+@subsection @code{READONLY} Keyword
+@cindex READONLY
+
+Support for @code{READONLY}, in @code{OPEN} statements,
+requires @code{libg2c} support,
+to make sure that @samp{CLOSE(@dots{},STATUS='DELETE')}
+does not delete a file opened on a unit
+with the @code{READONLY} keyword,
+and perhaps to trigger a fatal diagnostic
+if a @code{WRITE} or @code{PRINT}
+to such a unit is attempted.
+
+@emph{Note:} It is not sufficient for @command{g77} and @code{libg2c}
+(its version of @code{libf2c})
+to assume that @code{READONLY} does not need some kind of explicit support
+at run time,
+due to UNIX systems not (generally) needing it.
+@command{g77} is not just a UNIX-based compiler!
+
+Further, mounting of non-UNIX filesystems on UNIX systems
+(such as via NFS)
+might require proper @code{READONLY} support.
+
+@cindex SHARED
+(Similar issues might be involved with supporting the @code{SHARED}
+keyword.)
+
+@node FLUSH Statement
+@subsection @code{FLUSH} Statement
+
+@command{g77} could perhaps use a @code{FLUSH} statement that
+does what @samp{CALL FLUSH} does,
+but that supports @samp{*} as the unit designator (same unit as for
+@code{PRINT}) and accepts @code{ERR=} and/or @code{IOSTAT=}
+specifiers.
+
+@node Expressions in FORMAT Statements
+@subsection Expressions in @code{FORMAT} Statements
+@cindex FORMAT statement
+@cindex statements, FORMAT
+
+@command{g77} doesn't support @samp{FORMAT(I<J>)} and the like.
+Supporting this requires a significant redesign or replacement
+of @code{libg2c}.
+
+However, @command{g77} does support
+this construct when the expression is constant
+(as of version 0.5.22).
+For example:
+
+@smallexample
+      PARAMETER (IWIDTH = 12)
+10    FORMAT (I<IWIDTH>)
+@end smallexample
+
+Otherwise, at least for output (@code{PRINT} and
+@code{WRITE}), Fortran code making use of this feature can
+be rewritten to avoid it by constructing the @code{FORMAT}
+string in a @code{CHARACTER} variable or array, then
+using that variable or array in place of the @code{FORMAT}
+statement label to do the original @code{PRINT} or @code{WRITE}.
+
+Many uses of this feature on input can be rewritten this way
+as well, but not all can.
+For example, this can be rewritten:
+
+@smallexample
+      READ 20, I
+20    FORMAT (I<J>)
+@end smallexample
+
+However, this cannot, in general, be rewritten, especially
+when @code{ERR=} and @code{END=} constructs are employed:
+
+@smallexample
+      READ 30, J, I
+30    FORMAT (I<J>)
+@end smallexample
+
+@node Explicit Assembler Code
+@subsection Explicit Assembler Code
+
+@command{g77} needs to provide some way, a la @command{gcc}, for @command{g77}
+code to specify explicit assembler code.
+
+@node Q Edit Descriptor
+@subsection Q Edit Descriptor
+@cindex FORMAT statement
+@cindex Q edit descriptor
+@cindex edit descriptor, Q
+
+The @code{Q} edit descriptor in @code{FORMAT}s isn't supported.
+(This is meant to get the number of characters remaining in an input record.)
+Supporting this requires a significant redesign or replacement
+of @code{libg2c}.
+
+A workaround might be using internal I/O or the stream-based intrinsics.
+@xref{FGetC Intrinsic (subroutine)}.
+
+@node Old-style PARAMETER Statements
+@subsection Old-style PARAMETER Statements
+@cindex PARAMETER statement
+@cindex statements, PARAMETER
+
+@command{g77} doesn't accept @samp{PARAMETER I=1}.
+Supporting this obsolete form of
+the @code{PARAMETER} statement would not be particularly hard, as most of the
+parsing code is already in place and working.
+
+Until time/money is
+spent implementing it, you might as well fix your code to use the
+standard form, @samp{PARAMETER (I=1)} (possibly needing
+@samp{INTEGER I} preceding the @code{PARAMETER} statement as well,
+otherwise, in the obsolete form of @code{PARAMETER}, the
+type of the variable is set from the type of the constant being
+assigned to it).
+
+@node TYPE and ACCEPT I/O Statements
+@subsection @code{TYPE} and @code{ACCEPT} I/O Statements
+@cindex TYPE statement
+@cindex statements, TYPE
+@cindex ACCEPT statement
+@cindex statements, ACCEPT
+
+@command{g77} doesn't support the I/O statements @code{TYPE} and
+@code{ACCEPT}.
+These are common extensions that should be easy to support,
+but also are fairly easy to work around in user code.
+
+Generally, any @samp{TYPE fmt,list} I/O statement can be replaced
+by @samp{PRINT fmt,list}.
+And, any @samp{ACCEPT fmt,list} statement can be
+replaced by @samp{READ fmt,list}.
+
+@node STRUCTURE UNION RECORD MAP
+@subsection @code{STRUCTURE}, @code{UNION}, @code{RECORD}, @code{MAP}
+@cindex STRUCTURE statement
+@cindex statements, STRUCTURE
+@cindex UNION statement
+@cindex statements, UNION
+@cindex RECORD statement
+@cindex statements, RECORD
+@cindex MAP statement
+@cindex statements, MAP
+
+@command{g77} doesn't support @code{STRUCTURE}, @code{UNION}, @code{RECORD},
+@code{MAP}.
+This set of extensions is quite a bit
+lower on the list of large, important things to add to @command{g77}, partly
+because it requires a great deal of work either upgrading or
+replacing @code{libg2c}.
+
+@node OPEN CLOSE and INQUIRE Keywords
+@subsection @code{OPEN}, @code{CLOSE}, and @code{INQUIRE} Keywords
+@cindex disposition of files
+@cindex OPEN statement
+@cindex statements, OPEN
+@cindex CLOSE statement
+@cindex statements, CLOSE
+@cindex INQUIRE statement
+@cindex statements, INQUIRE
+
+@command{g77} doesn't have support for keywords such as @code{DISP='DELETE'} in
+the @code{OPEN}, @code{CLOSE}, and @code{INQUIRE} statements.
+These extensions are easy to add to @command{g77} itself, but
+require much more work on @code{libg2c}.
+
+@cindex FORM='PRINT'
+@cindex ANS carriage control
+@cindex carriage control
+@pindex asa
+@pindex fpr
+@command{g77} doesn't support @code{FORM='PRINT'} or an equivalent to
+translate the traditional `carriage control' characters in column 1 of
+output to use backspaces, carriage returns and the like.  However
+programs exist to translate them in output files (or standard output).
+These are typically called either @command{fpr} or @command{asa}.  You can get
+a version of @command{asa} from
+@uref{ftp://sunsite.unc.edu/pub/Linux/devel/lang/fortran} for GNU
+systems which will probably build easily on other systems.
+Alternatively, @command{fpr} is in BSD distributions in various archive
+sites.
+
+@c (Can both programs can be used in a pipeline,
+@c with a named input file,
+@c and/or with a named output file???)
+
+@node ENCODE and DECODE
+@subsection @code{ENCODE} and @code{DECODE}
+@cindex ENCODE statement
+@cindex statements, ENCODE
+@cindex DECODE statement
+@cindex statements, DECODE
+
+@command{g77} doesn't support @code{ENCODE} or @code{DECODE}.
+
+These statements are best replaced by READ and WRITE statements
+involving internal files (CHARACTER variables and arrays).
+
+For example, replace a code fragment like
+
+@smallexample
+      INTEGER*1 LINE(80)
+@dots{}
+      DECODE (80, 9000, LINE) A, B, C
+@dots{}
+9000  FORMAT (1X, 3(F10.5))
+@end smallexample
+
+@noindent
+with:
+
+@smallexample
+      CHARACTER*80 LINE
+@dots{}
+      READ (UNIT=LINE, FMT=9000) A, B, C
+@dots{}
+9000  FORMAT (1X, 3(F10.5))
+@end smallexample
+
+Similarly, replace a code fragment like
+
+@smallexample
+      INTEGER*1 LINE(80)
+@dots{}
+      ENCODE (80, 9000, LINE) A, B, C
+@dots{}
+9000  FORMAT (1X, 'OUTPUT IS ', 3(F10.5))
+@end smallexample
+
+@noindent
+with:
+
+@smallexample
+      CHARACTER*80 LINE
+@dots{}
+      WRITE (UNIT=LINE, FMT=9000) A, B, C
+@dots{}
+9000  FORMAT (1X, 'OUTPUT IS ', 3(F10.5))
+@end smallexample
+
+It is entirely possible that @code{ENCODE} and @code{DECODE} will
+be supported by a future version of @command{g77}.
+
+@node AUTOMATIC Statement
+@subsection @code{AUTOMATIC} Statement
+@cindex @code{AUTOMATIC} statement
+@cindex statements, @code{AUTOMATIC}
+@cindex automatic variables
+@cindex variables, automatic
+
+@command{g77} doesn't support the @code{AUTOMATIC} statement that
+@command{f2c} does.
+
+@code{AUTOMATIC} would identify a variable or array
+as not being @code{SAVE}'d, which is normally the default,
+but which would be especially useful for code that, @emph{generally},
+needed to be compiled with the @option{-fno-automatic} option.
+
+@code{AUTOMATIC} also would serve as a hint to the compiler that placing
+the variable or array---even a very large array--on the stack is acceptable.
+
+@code{AUTOMATIC} would not, by itself, designate the containing procedure
+as recursive.
+
+@code{AUTOMATIC} should work syntactically like @code{SAVE},
+in that @code{AUTOMATIC} with no variables listed should apply to
+all pertinent variables and arrays
+(which would not include common blocks or their members).
+
+Variables and arrays denoted as @code{AUTOMATIC}
+would not be permitted to be initialized via @code{DATA}
+or other specification of any initial values,
+requiring explicit initialization,
+such as via assignment statements.
+
+@cindex UNSAVE
+@cindex STATIC
+Perhaps @code{UNSAVE} and @code{STATIC},
+as strict semantic opposites to @code{SAVE} and @code{AUTOMATIC},
+should be provided as well.
+
+@node Suppressing Space Padding
+@subsection Suppressing Space Padding of Source Lines
+
+@command{g77} should offer VXT-Fortran-style suppression of virtual
+spaces at the end of a source line
+if an appropriate command-line option is specified.
+
+This affects cases where
+a character constant is continued onto the next line in a fixed-form
+source file, as in the following example:
+
+@smallexample
+10    PRINT *,'HOW MANY
+     1 SPACES?'
+@end smallexample
+
+@noindent
+@command{g77}, and many other compilers, virtually extend
+the continued line through column 72 with spaces that become part
+of the character constant, but Digital Fortran normally didn't,
+leaving only one space between @samp{MANY} and @samp{SPACES?}
+in the output of the above statement.
+
+Fairly recently, at least one version of Digital Fortran
+was enhanced to provide the other behavior when a
+command-line option is specified, apparently due to demand
+from readers of the USENET group @file{comp.lang.fortran}
+to offer conformance to this widespread practice in the
+industry.
+@command{g77} should return the favor by offering conformance
+to Digital's approach to handling the above example.
+
+@node Fortran Preprocessor
+@subsection Fortran Preprocessor
+
+@command{g77} should offer a preprocessor designed specifically
+for Fortran to replace @samp{cpp -traditional}.
+There are several out there worth evaluating, at least.
+
+Such a preprocessor would recognize Hollerith constants,
+properly parse comments and character constants, and so on.
+It might also recognize, process, and thus preprocess
+files included via the @code{INCLUDE} directive.
+
+@node Bit Operations on Floating-point Data
+@subsection Bit Operations on Floating-point Data
+@cindex @code{And} intrinsic
+@cindex intrinsics, @code{And}
+@cindex @code{Or} intrinsic
+@cindex intrinsics, @code{Or}
+@cindex @code{Shift} intrinsic
+@cindex intrinsics, @code{Shift}
+
+@command{g77} does not allow @code{REAL} and other non-integral types for
+arguments to intrinsics like @code{And}, @code{Or}, and @code{Shift}.
+
+For example, this program is rejected by @command{g77}, because
+the intrinsic @code{Iand} does not accept @code{REAL} arguments:
+
+@smallexample
+DATA A/7.54/, B/9.112/
+PRINT *, IAND(A, B)
+END
+@end smallexample
+
+@node Really Ugly Character Assignments
+@subsection Really Ugly Character Assignments
+
+An option such as @option{-fugly-char} should be provided
+to allow
+
+@smallexample
+REAL*8 A1
+DATA A1 / '12345678' /
+@end smallexample
+
+and:
+
+@smallexample
+REAL*8 A1
+A1 = 'ABCDEFGH'
+@end smallexample
+
+@node POSIX Standard
+@subsection @code{POSIX} Standard
+
+@command{g77} should support the POSIX standard for Fortran.
+
+@node Floating-point Exception Handling
+@subsection Floating-point Exception Handling
+@cindex floating-point, exceptions
+@cindex exceptions, floating-point
+@cindex FPE handling
+@cindex NaN values
+
+The @command{gcc} backend and, consequently, @command{g77}, currently provides no
+general control over whether or not floating-point exceptions are trapped or
+ignored.
+(Ignoring them typically results in NaN values being
+propagated in systems that conform to IEEE 754.)
+The behavior is normally inherited from the system-dependent startup
+code, though some targets, such as the Alpha, have code generation
+options which change the behavior.
+
+Most systems provide some C-callable mechanism to change this; this can
+be invoked at startup using @command{gcc}'s @code{constructor} attribute.
+For example, just compiling and linking the following C code with your
+program will turn on exception trapping for the ``common'' exceptions
+on a GNU system using glibc 2.2 or newer:
+
+@smallexample
+#define _GNU_SOURCE 1
+#include <fenv.h>
+static void __attribute__ ((constructor))
+trapfpe ()
+@{
+  /* Enable some exceptions.  At startup all exceptions are masked.  */
+  
+  feenableexcept (FE_INVALID|FE_DIVBYZERO|FE_OVERFLOW);
+@}
+@end smallexample
+
+A convenient trick is to compile this something like:
+@smallexample
+gcc -o libtrapfpe.a trapfpe.c
+@end smallexample
+and then use it by adding @option{-trapfpe} to the @command{g77} command line
+when linking.
+
+@node Nonportable Conversions
+@subsection Nonportable Conversions
+@cindex nonportable conversions
+@cindex conversions, nonportable
+
+@command{g77} doesn't accept some particularly nonportable,
+silent data-type conversions such as @code{LOGICAL}
+to @code{REAL} (as in @samp{A=.FALSE.}, where @samp{A}
+is type @code{REAL}), that other compilers might
+quietly accept.
+
+Some of these conversions are accepted by @command{g77}
+when the @option{-fugly-logint} option is specified.
+Perhaps it should accept more or all of them.
+
+@node Large Automatic Arrays
+@subsection Large Automatic Arrays
+@cindex automatic arrays
+@cindex arrays, automatic
+
+Currently, automatic arrays always are allocated on the stack.
+For situations where the stack cannot be made large enough,
+@command{g77} should offer a compiler option that specifies
+allocation of automatic arrays in heap storage.
+
+@node Support for Threads
+@subsection Support for Threads
+@cindex threads
+@cindex parallel processing
+
+Neither the code produced by @command{g77} nor the @code{libg2c} library
+are thread-safe, nor does @command{g77} have support for parallel processing
+(other than the instruction-level parallelism available on some
+processors).
+A package such as PVM might help here.
+
+@node Enabling Debug Lines
+@subsection Enabling Debug Lines
+@cindex debug line
+@cindex comment line, debug
+
+An option such as @option{-fdebug-lines} should be provided
+to turn fixed-form lines beginning with @samp{D}
+to be treated as if they began with a space,
+instead of as if they began with a @samp{C}
+(as comment lines).
+
+@node Better Warnings
+@subsection Better Warnings
+
+Because of how @command{g77} generates code via the back end,
+it doesn't always provide warnings the user wants.
+Consider:
+
+@smallexample
+PROGRAM X
+PRINT *, A
+END
+@end smallexample
+
+Currently, the above is not flagged as a case of
+using an uninitialized variable,
+because @command{g77} generates a run-time library call that looks,
+to the GBE, like it might actually @emph{modify} @samp{A} at run time.
+(And, in fact, depending on the previous run-time library call,
+it would!)
+
+Fixing this requires one of the following:
+
+@itemize @bullet
+@item
+Switch to new library, @code{libg77}, that provides
+a more ``clean'' interface,
+vis-a-vis input, output, and modified arguments,
+so the GBE can tell what's going on.
+
+This would provide a pretty big performance improvement,
+at least theoretically, and, ultimately, in practice,
+for some types of code.
+
+@item
+Have @command{g77} pass a pointer to a temporary
+containing a copy of @samp{A},
+instead of to @samp{A} itself.
+The GBE would then complain about the copy operation
+involving a potentially uninitialized variable.
+
+This might also provide a performance boost for some code,
+because @samp{A} might then end up living in a register,
+which could help with inner loops.
+
+@item
+Have @command{g77} use a GBE construct similar to @code{ADDR_EXPR}
+but with extra information on the fact that the
+item pointed to won't be modified
+(a la @code{const} in C).
+
+Probably the best solution for now, but not quite trivial
+to implement in the general case.
+@end itemize
+
+@node Gracefully Handle Sensible Bad Code
+@subsection Gracefully Handle Sensible Bad Code
+
+@command{g77} generally should continue processing for
+warnings and recoverable (user) errors whenever possible---that
+is, it shouldn't gratuitously make bad or useless code.
+
+For example:
+
+@smallexample
+INTRINSIC ZABS
+CALL FOO(ZABS)
+END
+@end smallexample
+
+@noindent
+When compiling the above with @option{-ff2c-intrinsics-disable},
+@command{g77} should indeed complain about passing @code{ZABS},
+but it still should compile, instead of rejecting
+the entire @code{CALL} statement.
+(Some of this is related to improving
+the compiler internals to improve how statements are analyzed.)
+
+@node Non-standard Conversions
+@subsection Non-standard Conversions
+
+@option{-Wconversion} and related should flag places where non-standard
+conversions are found.
+Perhaps much of this would be part of @option{-Wugly*}.
+
+@node Non-standard Intrinsics
+@subsection Non-standard Intrinsics
+
+@command{g77} needs a new option, like @option{-Wintrinsics}, to warn about use of
+non-standard intrinsics without explicit @code{INTRINSIC} statements for them.
+This would help find code that might fail silently when ported to another
+compiler.
+
+@node Modifying DO Variable
+@subsection Modifying @code{DO} Variable
+
+@command{g77} should warn about modifying @code{DO} variables
+via @code{EQUIVALENCE}.
+(The internal information gathered to produce this warning
+might also be useful in setting the
+internal ``doiter'' flag for a variable or even array
+reference within a loop, since that might produce faster code someday.)
+
+For example, this code is invalid, so @command{g77} should warn about
+the invalid assignment to @samp{NOTHER}:
+
+@smallexample
+EQUIVALENCE (I, NOTHER)
+DO I = 1, 100
+   IF (I.EQ. 10) NOTHER = 20
+END DO
+@end smallexample
+
+@node Better Pedantic Compilation
+@subsection Better Pedantic Compilation
+
+@command{g77} needs to support @option{-fpedantic} more thoroughly,
+and use it only to generate
+warnings instead of rejecting constructs outright.
+Have it warn:
+if a variable that dimensions an array is not a dummy or placed
+explicitly in @code{COMMON} (F77 does not allow it to be
+placed in @code{COMMON} via @code{EQUIVALENCE}); if specification statements
+follow statement-function-definition statements; about all sorts of
+syntactic extensions.
+
+@node Warn About Implicit Conversions
+@subsection Warn About Implicit Conversions
+
+@command{g77} needs a @option{-Wpromotions} option to warn if source code appears
+to expect automatic, silent, and
+somewhat dangerous compiler-assisted conversion of @code{REAL(KIND=1)}
+constants to @code{REAL(KIND=2)} based on context.
+
+For example, it would warn about cases like this:
+
+@smallexample
+DOUBLE PRECISION FOO
+PARAMETER (TZPHI = 9.435784839284958)
+FOO = TZPHI * 3D0
+@end smallexample
+
+@node Invalid Use of Hollerith Constant
+@subsection Invalid Use of Hollerith Constant
+
+@command{g77} should disallow statements like @samp{RETURN 2HAB},
+which are invalid in both source forms
+(unlike @samp{RETURN (2HAB)},
+which probably still makes no sense but at least can
+be reliably parsed).
+Fixed-form processing rejects it, but not free-form, except
+in a way that is a bit difficult to understand.
+
+@node Dummy Array Without Dimensioning Dummy
+@subsection Dummy Array Without Dimensioning Dummy
+
+@command{g77} should complain when a list of dummy arguments containing an
+adjustable dummy array does
+not also contain every variable listed in the dimension list of the
+adjustable array.
+
+Currently, @command{g77} does complain about a variable that
+dimensions an array but doesn't appear in any dummy list or @code{COMMON}
+area, but this needs to be extended to catch cases where it doesn't appear in
+every dummy list that also lists any arrays it dimensions.
+
+For example, @command{g77} should warn about the entry point @samp{ALT}
+below, since it includes @samp{ARRAY} but not @samp{ISIZE} in its
+list of arguments:
+
+@smallexample
+SUBROUTINE PRIMARY(ARRAY, ISIZE)
+REAL ARRAY(ISIZE)
+ENTRY ALT(ARRAY)
+@end smallexample
+
+@node Invalid FORMAT Specifiers
+@subsection Invalid FORMAT Specifiers
+
+@command{g77} should check @code{FORMAT} specifiers for validity
+as it does @code{FORMAT} statements.
+
+For example, a diagnostic would be produced for:
+
+@smallexample
+PRINT 'HI THERE!'  !User meant PRINT *, 'HI THERE!'
+@end smallexample
+
+@node Ambiguous Dialects
+@subsection Ambiguous Dialects
+
+@command{g77} needs a set of options such as @option{-Wugly*}, @option{-Wautomatic},
+@option{-Wvxt}, @option{-Wf90}, and so on.
+These would warn about places in the user's source where ambiguities
+are found, helpful in resolving ambiguities in the program's
+dialect or dialects.
+
+@node Unused Labels
+@subsection Unused Labels
+
+@command{g77} should warn about unused labels when @option{-Wunused} is in effect.
+
+@node Informational Messages
+@subsection Informational Messages
+
+@command{g77} needs an option to suppress information messages (notes).
+@option{-w} does this but also suppresses warnings.
+The default should be to suppress info messages.
+
+Perhaps info messages should simply be eliminated.
+
+@node Uninitialized Variables at Run Time
+@subsection Uninitialized Variables at Run Time
+
+@command{g77} needs an option to initialize everything (not otherwise
+explicitly initialized) to ``weird''
+(machine-dependent) values, e.g. NaNs, bad (non-@code{NULL}) pointers, and
+largest-magnitude integers, would help track down references to
+some kinds of uninitialized variables at run time.
+
+Note that use of the options @samp{-O -Wuninitialized} can catch
+many such bugs at compile time.
+
+@node Portable Unformatted Files
+@subsection Portable Unformatted Files
+
+@cindex unformatted files
+@cindex file formats
+@cindex binary data
+@cindex byte ordering
+@command{g77} has no facility for exchanging unformatted files with systems
+using different number formats---even differing only in endianness (byte
+order)---or written by other compilers.  Some compilers provide
+facilities at least for doing byte-swapping during unformatted I/O.
+
+It is unrealistic to expect to cope with exchanging unformatted files
+with arbitrary other compiler runtimes, but the @command{g77} runtime
+should at least be able to read files written by @command{g77} on systems
+with different number formats, particularly if they differ only in byte
+order.
+
+In case you do need to write a program to translate to or from
+@command{g77} (@code{libf2c}) unformatted files, they are written as
+follows:
+@table @asis
+@item Sequential
+Unformatted sequential records consist of
+@enumerate
+@item
+A number giving the length of the record contents;
+@item
+the length of record contents again (for backspace).
+@end enumerate
+
+The record length is of C type
+@code{long}; this means that it is 8 bytes on 64-bit systems such as
+Alpha GNU/Linux and 4 bytes on other systems, such as x86 GNU/Linux.
+Consequently such files cannot be exchanged between 64-bit and 32-bit
+systems, even with the same basic number format.
+@item Direct access
+Unformatted direct access files form a byte stream of length
+@var{records}*@var{recl} bytes, where @var{records} is the maximum
+record number (@code{REC=@var{records}}) written and @var{recl} is the
+record length in bytes specified in the @code{OPEN} statement
+(@code{RECL=@var{recl}}).  Data appear in the records as determined by
+the relevant @code{WRITE} statement.  Dummy records with arbitrary
+contents appear in the file in place of records which haven't been
+written.
+@end table
+
+Thus for exchanging a sequential or direct access unformatted file
+between big- and little-endian 32-bit systems using IEEE 754 floating
+point it would be sufficient to reverse the bytes in consecutive words
+in the file if, and @emph{only} if, only @code{REAL*4}, @code{COMPLEX},
+@code{INTEGER*4} and/or @code{LOGICAL*4} data have been written to it by
+@command{g77}.
+
+If necessary, it is possible to do byte-oriented i/o with @command{g77}'s
+@code{FGETC} and @code{FPUTC} intrinsics.  Byte-swapping can be done in
+Fortran by equivalencing larger sized variables to an @code{INTEGER*1}
+array or a set of scalars.
+
+@cindex HDF
+@cindex PDB
+If you need to exchange binary data between arbitrary system and
+compiler variations, we recommend using a portable binary format with
+Fortran bindings, such as NCSA's HDF (@uref{http://hdf.ncsa.uiuc.edu/})
+or PACT's PDB@footnote{No, not @emph{that} one.}
+(@uref{http://www.llnl.gov/def_sci/pact/pact_homepage.html}).  (Unlike,
+say, CDF or XDR, HDF-like systems write in the native number formats and
+only incur overhead when they are read on a system with a different
+format.)  A future @command{g77} runtime library should use such
+techniques.
+
+@node Better List-directed I/O
+@subsection Better List-directed I/O
+
+Values output using list-directed I/O
+(@samp{PRINT *, R, D})
+should be written with a field width, precision, and so on
+appropriate for the type (precision) of each value.
+
+(Currently, no distinction is made between single-precision
+and double-precision values
+by @code{libf2c}.)
+
+It is likely this item will require the @code{libg77} project
+to be undertaken.
+
+In the meantime, use of formatted I/O is recommended.
+While it might be of little consolation,
+@command{g77} does support @samp{FORMAT(F<WIDTH>.4)}, for example,
+as long as @samp{WIDTH} is defined as a named constant
+(via @code{PARAMETER}).
+That at least allows some compile-time specification
+of the precision of a data type,
+perhaps controlled by preprocessing directives.
+
+@node Default to Console I/O
+@subsection Default to Console I/O
+
+The default I/O units,
+specified by @samp{READ @var{fmt}},
+@samp{READ (UNIT=*)},
+@samp{WRITE (UNIT=*)}, and
+@samp{PRINT @var{fmt}},
+should not be units 5 (input) and 6 (output),
+but, rather, unit numbers not normally available
+for use in statements such as @code{OPEN} and @code{CLOSE}.
+
+Changing this would allow a program to connect units 5 and 6
+to files via @code{OPEN},
+but still use @samp{READ (UNIT=*)} and @samp{PRINT}
+to do I/O to the ``console''.
+
+This change probably requires the @code{libg77} project.
+
+@node Labels Visible to Debugger
+@subsection Labels Visible to Debugger
+
+@command{g77} should output debugging information for statements labels,
+for use by debuggers that know how to support them.
+Same with weirder things like construct names.
+It is not yet known if any debug formats or debuggers support these.
+
+@node Disappointments
+@section Disappointments and Misunderstandings
+
+These problems are perhaps regrettable, but we don't know any practical
+way around them for now.
+
+@menu
+* Mangling of Names::                       @samp{SUBROUTINE FOO} is given
+                                              external name @samp{foo_}.
+* Multiple Definitions of External Names::  No doing both @samp{COMMON /FOO/}
+                                              and @samp{SUBROUTINE FOO}.
+* Limitation on Implicit Declarations::     No @samp{IMPLICIT CHARACTER*(*)}.
+@end menu
+
+@node Mangling of Names
+@subsection Mangling of Names in Source Code
+@cindex naming issues
+@cindex external names
+@cindex common blocks
+@cindex name space
+@cindex underscore
+
+The current external-interface design, which includes naming of
+external procedures, COMMON blocks, and the library interface,
+has various usability problems, including things like adding
+underscores where not really necessary (and preventing easier
+inter-language operability) and yet not providing complete
+namespace freedom for user C code linked with Fortran apps (due
+to the naming of functions in the library, among other things).
+
+Project GNU should at least get all this ``right'' for systems
+it fully controls, such as the Hurd, and provide defaults and
+options for compatibility with existing systems and interoperability
+with popular existing compilers.
+
+@node Multiple Definitions of External Names
+@subsection Multiple Definitions of External Names
+@cindex block data
+@cindex BLOCK DATA statement
+@cindex statements, BLOCK DATA
+@cindex @code{COMMON} statement
+@cindex statements, @code{COMMON}
+@cindex naming conflicts
+
+@command{g77} doesn't allow a common block and an external procedure or
+@code{BLOCK DATA} to have the same name.
+Some systems allow this, but @command{g77} does not,
+to be compatible with @command{f2c}.
+
+@command{g77} could special-case the way it handles
+@code{BLOCK DATA}, since it is not compatible with @command{f2c} in this
+particular area (necessarily, since @command{g77} offers an
+important feature here), but
+it is likely that such special-casing would be very annoying to people
+with programs that use @samp{EXTERNAL FOO}, with no other mention of
+@samp{FOO} in the same program unit, to refer to external procedures, since
+the result would be that @command{g77} would treat these references as requests to
+force-load BLOCK DATA program units.
+
+In that case, if @command{g77} modified
+names of @code{BLOCK DATA} so they could have the same names as
+@code{COMMON}, users
+would find that their programs wouldn't link because the @samp{FOO} procedure
+didn't have its name translated the same way.
+
+(Strictly speaking,
+@command{g77} could emit a null-but-externally-satisfying definition of
+@samp{FOO} with its name transformed as if it had been a
+@code{BLOCK DATA}, but that probably invites more trouble than it's
+worth.)
+
+@node Limitation on Implicit Declarations
+@subsection Limitation on Implicit Declarations
+@cindex IMPLICIT CHARACTER*(*) statement
+@cindex statements, IMPLICIT CHARACTER*(*)
+
+@command{g77} disallows @code{IMPLICIT CHARACTER*(*)}.
+This is not standard-conforming.
+
+@node Non-bugs
+@section Certain Changes We Don't Want to Make
+
+This section lists changes that people frequently request, but which
+we do not make because we think GNU Fortran is better without them.
+
+@menu
+* Backslash in Constants::           Why @samp{'\\'} is a constant that
+                                       is one, not two, characters long.
+* Initializing Before Specifying::   Why @samp{DATA VAR/1/} can't precede
+                                       @samp{COMMON VAR}.
+* Context-Sensitive Intrinsicness::  Why @samp{CALL SQRT} won't work.
+* Context-Sensitive Constants::      Why @samp{9.435784839284958} is a
+                                       single-precision constant,
+                                       and might be interpreted as
+                                       @samp{9.435785} or similar.
+* Equivalence Versus Equality::      Why @samp{.TRUE. .EQ. .TRUE.} won't work.
+* Order of Side Effects::            Why @samp{J = IFUNC() - IFUNC()} might
+                                       not behave as expected.
+@end menu
+
+@node Backslash in Constants
+@subsection Backslash in Constants
+@cindex backslash
+@cindex @command{f77} support
+@cindex support, @command{f77}
+
+In the opinion of many experienced Fortran users,
+@option{-fno-backslash} should be the default, not @option{-fbackslash},
+as currently set by @command{g77}.
+
+First of all, you can always specify
+@option{-fno-backslash} to turn off this processing.
+
+Despite not being within the spirit (though apparently within the
+letter) of the ANSI FORTRAN 77 standard, @command{g77} defaults to
+@option{-fbackslash} because that is what most UNIX @command{f77} commands
+default to, and apparently lots of code depends on this feature.
+
+This is a particularly troubling issue.
+The use of a C construct in the midst of Fortran code
+is bad enough, worse when it makes existing Fortran
+programs stop working (as happens when programs written
+for non-UNIX systems are ported to UNIX systems with
+compilers that provide the @option{-fbackslash} feature
+as the default---sometimes with no option to turn it off).
+
+The author of GNU Fortran wished, for reasons of linguistic
+purity, to make @option{-fno-backslash} the default for GNU
+Fortran and thus require users of UNIX @command{f77} and @command{f2c}
+to specify @option{-fbackslash} to get the UNIX behavior.
+
+However, the realization that @command{g77} is intended as
+a replacement for @emph{UNIX} @command{f77}, caused the author
+to choose to make @command{g77} as compatible with
+@command{f77} as feasible, which meant making @option{-fbackslash}
+the default.
+
+The primary focus on compatibility is at the source-code
+level, and the question became ``What will users expect
+a replacement for @command{f77} to do, by default?''
+Although at least one UNIX @command{f77} does not provide
+@option{-fbackslash} as a default, it appears that
+the majority of them do, which suggests that
+the majority of code that is compiled by UNIX @command{f77}
+compilers expects @option{-fbackslash} to be the default.
+
+It is probably the case that more code exists
+that would @emph{not} work with @option{-fbackslash}
+in force than code that requires it be in force.
+
+However, most of @emph{that} code is not being compiled
+with @command{f77},
+and when it is, new build procedures (shell scripts,
+makefiles, and so on) must be set up anyway so that
+they work under UNIX.
+That makes a much more natural and safe opportunity for
+non-UNIX users to adapt their build procedures for
+@command{g77}'s default of @option{-fbackslash} than would
+exist for the majority of UNIX @command{f77} users who
+would have to modify existing, working build procedures
+to explicitly specify @option{-fbackslash} if that was
+not the default.
+
+One suggestion has been to configure the default for
+@option{-fbackslash} (and perhaps other options as well)
+based on the configuration of @command{g77}.
+
+This is technically quite straightforward, but will be avoided
+even in cases where not configuring defaults to be
+dependent on a particular configuration greatly inconveniences
+some users of legacy code.
+
+Many users appreciate the GNU compilers because they provide an
+environment that is uniform across machines.
+These users would be
+inconvenienced if the compiler treated things like the
+format of the source code differently on certain machines.
+
+Occasionally users write programs intended only for a particular machine
+type.
+On these occasions, the users would benefit if the GNU Fortran compiler
+were to support by default the same dialect as the other compilers on
+that machine.
+But such applications are rare.
+And users writing a
+program to run on more than one type of machine cannot possibly benefit
+from this kind of compatibility.
+(This is consistent with the design goals for @command{gcc}.
+To change them for @command{g77}, you must first change them
+for @command{gcc}.
+Do not ask the maintainers of @command{g77} to do this for you,
+or to disassociate @command{g77} from the widely understood, if
+not widely agreed-upon, goals for GNU compilers in general.)
+
+This is why GNU Fortran does and will treat backslashes in the same
+fashion on all types of machines (by default).
+@xref{Direction of Language Development}, for more information on
+this overall philosophy guiding the development of the GNU Fortran
+language.
+
+Of course, users strongly concerned about portability should indicate
+explicitly in their build procedures which options are expected
+by their source code, or write source code that has as few such
+expectations as possible.
+
+For example, avoid writing code that depends on backslash (@samp{\})
+being interpreted either way in particular, such as by
+starting a program unit with:
+
+@smallexample
+CHARACTER BACKSL
+PARAMETER (BACKSL = '\\')
+@end smallexample
+
+@noindent
+Then, use concatenation of @samp{BACKSL} anyplace a backslash
+is desired.
+In this way, users can write programs which have the same meaning
+in many Fortran dialects.
+
+(However, this technique does not work for Hollerith constants---which
+is just as well, since the only generally portable uses for Hollerith
+constants are in places where character constants can and should
+be used instead, for readability.)
+
+@node Initializing Before Specifying
+@subsection Initializing Before Specifying
+@cindex initialization, statement placement
+@cindex placing initialization statements
+
+@command{g77} does not allow @samp{DATA VAR/1/} to appear in the
+source code before @samp{COMMON VAR},
+@samp{DIMENSION VAR(10)}, @samp{INTEGER VAR}, and so on.
+In general, @command{g77} requires initialization of a variable
+or array to be specified @emph{after} all other specifications
+of attributes (type, size, placement, and so on) of that variable
+or array are specified (though @emph{confirmation} of data type is
+permitted).
+
+It is @emph{possible} @command{g77} will someday allow all of this,
+even though it is not allowed by the FORTRAN 77 standard.
+
+Then again, maybe it is better to have
+@command{g77} always require placement of @code{DATA}
+so that it can possibly immediately write constants
+to the output file, thus saving time and space.
+
+That is, @samp{DATA A/1000000*1/} should perhaps always
+be immediately writable to canonical assembler, unless it's already known
+to be in a @code{COMMON} area following as-yet-uninitialized stuff,
+and to do this it cannot be followed by @samp{COMMON A}.
+
+@node Context-Sensitive Intrinsicness
+@subsection Context-Sensitive Intrinsicness
+@cindex intrinsics, context-sensitive
+@cindex context-sensitive intrinsics
+
+@command{g77} treats procedure references to @emph{possible} intrinsic
+names as always enabling their intrinsic nature, regardless of
+whether the @emph{form} of the reference is valid for that
+intrinsic.
+
+For example, @samp{CALL SQRT} is interpreted by @command{g77} as
+an invalid reference to the @code{SQRT} intrinsic function,
+because the reference is a subroutine invocation.
+
+First, @command{g77} recognizes the statement @samp{CALL SQRT}
+as a reference to a @emph{procedure} named @samp{SQRT}, not
+to a @emph{variable} with that name (as it would for a statement
+such as @samp{V = SQRT}).
+
+Next, @command{g77} establishes that, in the program unit being compiled,
+@code{SQRT} is an intrinsic---not a subroutine that
+happens to have the same name as an intrinsic (as would be
+the case if, for example, @samp{EXTERNAL SQRT} was present).
+
+Finally, @command{g77} recognizes that the @emph{form} of the
+reference is invalid for that particular intrinsic.
+That is, it recognizes that it is invalid for an intrinsic
+@emph{function}, such as @code{SQRT}, to be invoked as
+a @emph{subroutine}.
+
+At that point, @command{g77} issues a diagnostic.
+
+Some users claim that it is ``obvious'' that @samp{CALL SQRT}
+references an external subroutine of their own, not an
+intrinsic function.
+
+However, @command{g77} knows about intrinsic
+subroutines, not just functions, and is able to support both having
+the same names, for example.
+
+As a result of this, @command{g77} rejects calls
+to intrinsics that are not subroutines, and function invocations
+of intrinsics that are not functions, just as it (and most compilers)
+rejects invocations of intrinsics with the wrong number (or types)
+of arguments.
+
+So, use the @samp{EXTERNAL SQRT} statement in a program unit that calls
+a user-written subroutine named @samp{SQRT}.
+
+@node Context-Sensitive Constants
+@subsection Context-Sensitive Constants
+@cindex constants, context-sensitive
+@cindex context-sensitive constants
+
+@command{g77} does not use context to determine the types of
+constants or named constants (@code{PARAMETER}), except
+for (non-standard) typeless constants such as @samp{'123'O}.
+
+For example, consider the following statement:
+
+@smallexample
+PRINT *, 9.435784839284958 * 2D0
+@end smallexample
+
+@noindent
+@command{g77} will interpret the (truncated) constant
+@samp{9.435784839284958} as a @code{REAL(KIND=1)}, not @code{REAL(KIND=2)},
+constant, because the suffix @code{D0} is not specified.
+
+As a result, the output of the above statement when
+compiled by @command{g77} will appear to have ``less precision''
+than when compiled by other compilers.
+
+In these and other cases, some compilers detect the
+fact that a single-precision constant is used in
+a double-precision context and therefore interpret the
+single-precision constant as if it was @emph{explicitly}
+specified as a double-precision constant.
+(This has the effect of appending @emph{decimal}, not
+@emph{binary}, zeros to the fractional part of the
+number---producing different computational results.)
+
+The reason this misfeature is dangerous is that a slight,
+apparently innocuous change to the source code can change
+the computational results.
+Consider:
+
+@smallexample
+REAL ALMOST, CLOSE
+DOUBLE PRECISION FIVE
+PARAMETER (ALMOST = 5.000000000001)
+FIVE = 5
+CLOSE = 5.000000000001
+PRINT *, 5.000000000001 - FIVE
+PRINT *, ALMOST - FIVE
+PRINT *, CLOSE - FIVE
+END
+@end smallexample
+
+@noindent
+Running the above program should
+result in the same value being
+printed three times.
+With @command{g77} as the compiler,
+it does.
+
+However, compiled by many other compilers,
+running the above program would print
+two or three distinct values, because
+in two or three of the statements, the
+constant @samp{5.000000000001}, which
+on most systems is exactly equal to @samp{5.}
+when interpreted as a single-precision constant,
+is instead interpreted as a double-precision
+constant, preserving the represented
+precision.
+However, this ``clever'' promotion of
+type does not extend to variables or,
+in some compilers, to named constants.
+
+Since programmers often are encouraged to replace manifest
+constants or permanently-assigned variables with named
+constants (@code{PARAMETER} in Fortran), and might need
+to replace some constants with variables having the same
+values for pertinent portions of code,
+it is important that compilers treat code so modified in the
+same way so that the results of such programs are the same.
+@command{g77} helps in this regard by treating constants just
+the same as variables in terms of determining their types
+in a context-independent way.
+
+Still, there is a lot of existing Fortran code that has
+been written to depend on the way other compilers freely
+interpret constants' types based on context, so anything
+@command{g77} can do to help flag cases of this in such code
+could be very helpful.
+
+@node Equivalence Versus Equality
+@subsection Equivalence Versus Equality
+@cindex .EQV., with integer operands
+@cindex comparing logical expressions
+@cindex logical expressions, comparing
+
+Use of @code{.EQ.} and @code{.NE.} on @code{LOGICAL} operands
+is not supported, except via @option{-fugly-logint}, which is not
+recommended except for legacy code (where the behavior expected
+by the @emph{code} is assumed).
+
+Legacy code should be changed, as resources permit, to use @code{.EQV.}
+and @code{.NEQV.} instead, as these are permitted by the various
+Fortran standards.
+
+New code should never be written expecting @code{.EQ.} or @code{.NE.}
+to work if either of its operands is @code{LOGICAL}.
+
+The problem with supporting this ``feature'' is that there is
+unlikely to be consensus on how it works, as illustrated by the
+following sample program:
+
+@smallexample
+LOGICAL L,M,N
+DATA L,M,N /3*.FALSE./
+IF (L.AND.M.EQ.N) PRINT *,'L.AND.M.EQ.N'
+END
+@end smallexample
+
+The issue raised by the above sample program is: what is the
+precedence of @code{.EQ.} (and @code{.NE.}) when applied to
+@code{LOGICAL} operands?
+
+Some programmers will argue that it is the same as the precedence
+for @code{.EQ.} when applied to numeric (such as @code{INTEGER})
+operands.
+By this interpretation, the subexpression @samp{M.EQ.N} must be
+evaluated first in the above program, resulting in a program that,
+when run, does not execute the @code{PRINT} statement.
+
+Other programmers will argue that the precedence is the same as
+the precedence for @code{.EQV.}, which is restricted by the standards
+to @code{LOGICAL} operands.
+By this interpretation, the subexpression @samp{L.AND.M} must be
+evaluated first, resulting in a program that @emph{does} execute
+the @code{PRINT} statement.
+
+Assigning arbitrary semantic interpretations to syntactic expressions
+that might legitimately have more than one ``obvious'' interpretation
+is generally unwise.
+
+The creators of the various Fortran standards have done a good job
+in this case, requiring a distinct set of operators (which have their
+own distinct precedence) to compare @code{LOGICAL} operands.
+This requirement results in expression syntax with more certain
+precedence (without requiring substantial context), making it easier
+for programmers to read existing code.
+@command{g77} will avoid muddying up elements of the Fortran language
+that were well-designed in the first place.
+
+(Ask C programmers about the precedence of expressions such as
+@samp{(a) & (b)} and @samp{(a) - (b)}---they cannot even tell
+you, without knowing more context, whether the @samp{&} and @samp{-}
+operators are infix (binary) or unary!)
+
+Most dangerous of all is the fact that,
+even assuming consensus on its meaning,
+an expression like @samp{L.AND.M.EQ.N},
+if it is the result of a typographical error,
+doesn't @emph{look} like it has such a typo.
+Even experienced Fortran programmers would not likely notice that
+@samp{L.AND.M.EQV.N} was, in fact, intended.
+
+So, this is a prime example of a circumstance in which
+a quality compiler diagnoses the code,
+instead of leaving it up to someone debugging it
+to know to turn on special compiler options
+that might diagnose it.
+
+@node Order of Side Effects
+@subsection Order of Side Effects
+@cindex side effects, order of evaluation
+@cindex order of evaluation, side effects
+
+@command{g77} does not necessarily produce code that, when run, performs
+side effects (such as those performed by function invocations)
+in the same order as in some other compiler---or even in the same
+order as another version, port, or invocation (using different
+command-line options) of @command{g77}.
+
+It is never safe to depend on the order of evaluation of side effects.
+For example, an expression like this may very well behave differently
+from one compiler to another:
+
+@smallexample
+J = IFUNC() - IFUNC()
+@end smallexample
+
+@noindent
+There is no guarantee that @samp{IFUNC} will be evaluated in any particular
+order.
+Either invocation might happen first.
+If @samp{IFUNC} returns 5 the first time it is invoked, and
+returns 12 the second time, @samp{J} might end up with the
+value @samp{7}, or it might end up with @samp{-7}.
+
+Generally, in Fortran, procedures with side-effects intended to
+be visible to the caller are best designed as @emph{subroutines},
+not functions.
+Examples of such side-effects include:
+
+@itemize @bullet
+@item
+The generation of random numbers
+that are intended to influence return values.
+
+@item
+Performing I/O
+(other than internal I/O to local variables).
+
+@item
+Updating information in common blocks.
+@end itemize
+
+An example of a side-effect that is not intended to be visible
+to the caller is a function that maintains a cache of recently
+calculated results, intended solely to speed repeated invocations
+of the function with identical arguments.
+Such a function can be safely used in expressions, because
+if the compiler optimizes away one or more calls to the
+function, operation of the program is unaffected (aside
+from being speeded up).
+
+@node Warnings and Errors
+@section Warning Messages and Error Messages
+
+@cindex error messages
+@cindex warnings vs errors
+@cindex messages, warning and error
+The GNU compiler can produce two kinds of diagnostics: errors and
+warnings.
+Each kind has a different purpose:
+
+@itemize @w{}
+@item
+@emph{Errors} report problems that make it impossible to compile your
+program.
+GNU Fortran reports errors with the source file name, line
+number, and column within the line where the problem is apparent.
+
+@item
+@emph{Warnings} report other unusual conditions in your code that
+@emph{might} indicate a problem, although compilation can (and does)
+proceed.
+Warning messages also report the source file name, line number,
+and column information,
+but include the text @samp{warning:} to distinguish them
+from error messages.
+@end itemize
+
+Warnings might indicate danger points where you should check to make sure
+that your program really does what you intend; or the use of obsolete
+features; or the use of nonstandard features of GNU Fortran.
+Many warnings are issued only if you ask for them, with one of the
+@option{-W} options (for instance, @option{-Wall} requests a variety of
+useful warnings).
+
+@emph{Note:} Currently, the text of the line and a pointer to the column
+is printed in most @command{g77} diagnostics.
+
+@xref{Warning Options,,Options to Request or Suppress Warnings}, for
+more detail on these and related command-line options.
+
+@node Open Questions
+@chapter Open Questions
+
+Please consider offering useful answers to these questions!
+
+@itemize @bullet
+@item
+@code{LOC()} and other intrinsics are probably somewhat misclassified.
+Is the a need for more precise classification of intrinsics, and if so,
+what are the appropriate groupings?
+Is there a need to individually
+enable/disable/delete/hide intrinsics from the command line?
+@end itemize
+
+@node Bugs
+@chapter Reporting Bugs
+@cindex bugs
+@cindex reporting bugs
+
+Your bug reports play an essential role in making GNU Fortran reliable.
+
+When you encounter a problem, the first thing to do is to see if it is
+already known.  @xref{Trouble}.  If it isn't known, then you should
+report the problem.
+
+@menu
+* Criteria: Bug Criteria.    Have you really found a bug?
+* Reporting: Bug Reporting.  How to report a bug effectively.
+@end menu
+
+@xref{Trouble,,Known Causes of Trouble with GNU Fortran},
+for information on problems we already know about.
+
+@xref{Service,,How To Get Help with GNU Fortran},
+for information on where to ask for help.
+
+@node Bug Criteria
+@section Have You Found a Bug?
+@cindex bug criteria
+
+If you are not sure whether you have found a bug, here are some guidelines:
+
+@itemize @bullet
+@cindex fatal signal
+@cindex core dump
+@item
+If the compiler gets a fatal signal, for any input whatever, that is a
+compiler bug.
+Reliable compilers never crash---they just remain obsolete.
+
+@cindex invalid assembly code
+@cindex assembly code, invalid
+@item
+If the compiler produces invalid assembly code, for any input whatever,
+@c (except an @code{asm} statement),
+that is a compiler bug, unless the
+compiler reports errors (not just warnings) which would ordinarily
+prevent the assembler from being run.
+
+@cindex undefined behavior
+@cindex undefined function value
+@item
+If the compiler produces valid assembly code that does not correctly
+execute the input source code, that is a compiler bug.
+
+However, you must double-check to make sure, because you might have run
+into an incompatibility between GNU Fortran and traditional Fortran.
+@c (@pxref{Incompatibilities}).
+These incompatibilities might be considered
+bugs, but they are inescapable consequences of valuable features.
+
+Or you might have a program whose behavior is undefined, which happened
+by chance to give the desired results with another Fortran compiler.
+It is best to check the relevant Fortran standard thoroughly if
+it is possible that the program indeed does something undefined.
+
+After you have localized the error to a single source line, it should
+be easy to check for these things.
+If your program is correct and well defined, you have found
+a compiler bug.
+
+It might help if, in your submission, you identified the specific
+language in the relevant Fortran standard that specifies the
+desired behavior, if it isn't likely to be obvious and agreed-upon
+by all Fortran users.
+
+@item
+If the compiler produces an error message for valid input, that is a
+compiler bug.
+
+@cindex invalid input
+@item
+If the compiler does not produce an error message for invalid input,
+that is a compiler bug.
+However, you should note that your idea of
+``invalid input'' might be someone else's idea
+of ``an extension'' or ``support for traditional practice''.
+
+@item
+If you are an experienced user of Fortran compilers, your suggestions
+for improvement of GNU Fortran are welcome in any case.
+@end itemize
+
+Many, perhaps most, bug reports against @command{g77} turn out to
+be bugs in the user's code.
+While we find such bug reports educational, they sometimes take
+a considerable amount of time to track down or at least respond
+to---time we could be spending making @command{g77}, not some user's
+code, better.
+
+Some steps you can take to verify that the bug is not certainly
+in the code you're compiling with @command{g77}:
+
+@itemize @bullet
+@item
+Compile your code using the @command{g77} options @samp{-W -Wall -O}.
+These options enable many useful warning; the @option{-O} option
+enables flow analysis that enables the uninitialized-variable
+warning.
+
+If you investigate the warnings and find evidence of possible bugs
+in your code, fix them first and retry @command{g77}.
+
+@item
+Compile your code using the @command{g77} options @option{-finit-local-zero},
+@option{-fno-automatic}, @option{-ffloat-store}, and various
+combinations thereof.
+
+If your code works with any of these combinations, that is not
+proof that the bug isn't in @command{g77}---a @command{g77} bug exposed
+by your code might simply be avoided, or have a different, more subtle
+effect, when different options are used---but it can be a
+strong indicator that your code is making unwarranted assumptions
+about the Fortran dialect and/or underlying machine it is
+being compiled and run on.
+
+@xref{Overly Convenient Options,,Overly Convenient Command-Line Options},
+for information on the @option{-fno-automatic} and
+@option{-finit-local-zero} options and how to convert
+their use into selective changes in your own code.
+
+@item
+@pindex ftnchek
+Validate your code with @command{ftnchek} or a similar code-checking
+tool.
+@command{ftnchek} can be found at @uref{ftp://ftp.netlib.org/fortran}
+or @uref{ftp://ftp.dsm.fordham.edu}.
+
+@pindex make
+@cindex Makefile example
+Here are some sample @file{Makefile} rules using @command{ftnchek}
+``project'' files to do cross-file checking and @command{sfmakedepend}
+(from @uref{ftp://ahab.rutgers.edu/pub/perl/sfmakedepend})
+to maintain dependencies automatically.
+These assume the use of GNU @command{make}.
+
+@smallexample
+# Dummy suffix for ftnchek targets:
+.SUFFIXES: .chek
+.PHONY: chekall
+
+# How to compile .f files (for implicit rule):
+FC = g77
+# Assume `include' directory:
+FFLAGS = -Iinclude -g -O -Wall
+
+# Flags for ftnchek:
+CHEK1 = -array=0 -include=includes -noarray
+CHEK2 = -nonovice -usage=1 -notruncation
+CHEKFLAGS = $(CHEK1) $(CHEK2)
+
+# Run ftnchek with all the .prj files except the one corresponding
+# to the target's root:
+%.chek : %.f ; \
+  ftnchek $(filter-out $*.prj,$(PRJS)) $(CHEKFLAGS) \
+    -noextern -library $<
+
+# Derive a project file from a source file:
+%.prj : %.f ; \
+  ftnchek $(CHEKFLAGS) -noextern -project -library $<
+
+# The list of objects is assumed to be in variable OBJS.
+# Sources corresponding to the objects:
+SRCS = $(OBJS:%.o=%.f)
+# ftnchek project files:
+PRJS = $(OBJS:%.o=%.prj)
+
+# Build the program
+prog: $(OBJS) ; \
+  $(FC) -o $@ $(OBJS)
+
+chekall: $(PRJS) ; \
+  ftnchek $(CHEKFLAGS) $(PRJS)
+
+prjs: $(PRJS)
+
+# For Emacs M-x find-tag:
+TAGS: $(SRCS) ; \
+  etags $(SRCS)
+
+# Rebuild dependencies:
+depend: ; \
+  sfmakedepend -I $(PLTLIBDIR) -I includes -a prj $(SRCS1)
+@end smallexample
+
+@item
+Try your code out using other Fortran compilers, such as @command{f2c}.
+If it does not work on at least one other compiler (assuming the
+compiler supports the features the code needs), that is a strong
+indicator of a bug in the code.
+
+However, even if your code works on many compilers @emph{except}
+@command{g77}, that does @emph{not} mean the bug is in @command{g77}.
+It might mean the bug is in your code, and that @command{g77} simply
+exposes it more readily than other compilers.
+@end itemize
+
+@node Bug Reporting
+@section How to Report Bugs
+@cindex compiler bugs, reporting
+
+Bugs should be reported to our bug database.  Please refer to
+@uref{http://gcc.gnu.org/bugs.html} for up-to-date instructions how to
+submit bug reports.  Copies of this file in HTML (@file{bugs.html}) and
+plain text (@file{BUGS}) are also part of GCC releases.
+
+
+@node Service
+@chapter How To Get Help with GNU Fortran
+
+If you need help installing, using or changing GNU Fortran, there are two
+ways to find it:
+
+@itemize @bullet
+@item
+Look in the service directory for someone who might help you for a fee.
+The service directory is found in the file named @file{SERVICE} in the
+GCC distribution.
+
+@item
+Send a message to @email{@value{email-help}}.
+@end itemize
+
+@end ifset
+@ifset INTERNALS
+@node Adding Options
+@chapter Adding Options
+@cindex options, adding
+@cindex adding options
+
+To add a new command-line option to @command{g77}, first decide
+what kind of option you wish to add.
+Search the @command{g77} and @command{gcc} documentation for one
+or more options that is most closely like the one you want to add
+(in terms of what kind of effect it has, and so on) to
+help clarify its nature.
+
+@itemize @bullet
+@item
+@emph{Fortran options} are options that apply only
+when compiling Fortran programs.
+They are accepted by @command{g77} and @command{gcc}, but
+they apply only when compiling Fortran programs.
+
+@item
+@emph{Compiler options} are options that apply
+when compiling most any kind of program.
+@end itemize
+
+@emph{Fortran options} are listed in the file
+@file{@value{path-g77}/lang-options.h},
+which is used during the build of @command{gcc} to
+build a list of all options that are accepted by
+at least one language's compiler.
+This list goes into the @code{documented_lang_options} array
+in @file{gcc/toplev.c}, which uses this array to
+determine whether a particular option should be
+offered to the linked-in front end for processing
+by calling @code{lang_option_decode}, which, for
+@command{g77}, is in @file{@value{path-g77}/com.c} and just
+calls @code{ffe_decode_option}.
+
+If the linked-in front end ``rejects'' a
+particular option passed to it, @file{toplev.c}
+just ignores the option, because @emph{some}
+language's compiler is willing to accept it.
+
+This allows commands like @samp{gcc -fno-asm foo.c bar.f}
+to work, even though Fortran compilation does
+not currently support the @option{-fno-asm} option;
+even though the @code{f771} version of @code{lang_decode_option}
+rejects @option{-fno-asm}, @file{toplev.c} doesn't
+produce a diagnostic because some other language (C)
+does accept it.
+
+This also means that commands like
+@samp{g77 -fno-asm foo.f} yield no diagnostics,
+despite the fact that no phase of the command was
+able to recognize and process @option{-fno-asm}---perhaps
+a warning about this would be helpful if it were
+possible.
+
+Code that processes Fortran options is found in
+@file{@value{path-g77}/top.c}, function @code{ffe_decode_option}.
+This code needs to check positive and negative forms
+of each option.
+
+The defaults for Fortran options are set in their
+global definitions, also found in @file{@value{path-g77}/top.c}.
+Many of these defaults are actually macros defined
+in @file{@value{path-g77}/target.h}, since they might be
+machine-specific.
+However, since, in practice, GNU compilers
+should behave the same way on all configurations
+(especially when it comes to language constructs),
+the practice of setting defaults in @file{target.h}
+is likely to be deprecated and, ultimately, stopped
+in future versions of @command{g77}.
+
+Accessor macros for Fortran options, used by code
+in the @command{g77} FFE, are defined in @file{@value{path-g77}/top.h}.
+
+@emph{Compiler options} are listed in @file{gcc/toplev.c}
+in the array @code{f_options}.
+An option not listed in @code{lang_options} is
+looked up in @code{f_options} and handled from there.
+
+The defaults for compiler options are set in the
+global definitions for the corresponding variables,
+some of which are in @file{gcc/toplev.c}.
+
+You can set different defaults for @emph{Fortran-oriented}
+or @emph{Fortran-reticent} compiler options by changing
+the source code of @command{g77} and rebuilding.
+How to do this depends on the version of @command{g77}:
+
+@table @code
+@item G77 0.5.24 (EGCS 1.1)
+@itemx G77 0.5.25 (EGCS 1.2 - which became GCC 2.95)
+Change the @code{lang_init_options} routine in @file{gcc/gcc/f/com.c}.
+
+(Note that these versions of @command{g77}
+perform internal consistency checking automatically
+when the @option{-fversion} option is specified.)
+
+@item G77 0.5.23
+@itemx G77 0.5.24 (EGCS 1.0)
+Change the way @code{f771} handles the @option{-fset-g77-defaults}
+option, which is always provided as the first option when
+called by @command{g77} or @command{gcc}.
+
+This code is in @code{ffe_decode_options} in @file{@value{path-g77}/top.c}.
+Have it change just the variables that you want to default
+to a different setting for Fortran compiles compared to
+compiles of other languages.
+
+The @option{-fset-g77-defaults} option is passed to @code{f771}
+automatically because of the specification information
+kept in @file{@value{path-g77}/lang-specs.h}.
+This file tells the @command{gcc} command how to recognize,
+in this case, Fortran source files (those to be preprocessed,
+and those that are not), and further, how to invoke the
+appropriate programs (including @code{f771}) to process
+those source files.
+
+It is in @file{@value{path-g77}/lang-specs.h} that @option{-fset-g77-defaults},
+@option{-fversion}, and other options are passed, as appropriate,
+even when the user has not explicitly specified them.
+Other ``internal'' options such as @option{-quiet} also
+are passed via this mechanism.
+@end table
+
+@node Projects
+@chapter Projects
+@cindex projects
+
+If you want to contribute to @command{g77} by doing research,
+design, specification, documentation, coding, or testing,
+the following information should give you some ideas.
+
+@menu
+* Efficiency::               Make @command{g77} itself compile code faster.
+* Better Optimization::      Teach @command{g77} to generate faster code.
+* Simplify Porting::         Make @command{g77} easier to configure, build,
+                             and install.
+* More Extensions::          Features many users won't know to ask for.
+* Machine Model::            @command{g77} should better leverage @command{gcc}.
+* Internals Documentation::  Make maintenance easier.
+* Internals Improvements::   Make internals more robust.
+* Better Diagnostics::       Make using @command{g77} on new code easier.
+@end menu
+
+@node Efficiency
+@section Improve Efficiency
+@cindex efficiency
+
+Don't bother doing any performance analysis until most of the
+following items are taken care of, because there's no question
+they represent serious space/time problems, although some of
+them show up only given certain kinds of (popular) input.
+
+@itemize @bullet
+@item
+Improve @code{malloc} package and its uses to specify more info about
+memory pools and, where feasible, use obstacks to implement them.
+
+@item
+Skip over uninitialized portions of aggregate areas (arrays,
+@code{COMMON} areas, @code{EQUIVALENCE} areas) so zeros need not be output.
+This would reduce memory usage for large initialized aggregate
+areas, even ones with only one initialized element.
+
+As of version 0.5.18, a portion of this item has already been
+accomplished.
+
+@item
+Prescan the statement (in @file{sta.c}) so that the nature of the statement
+is determined as much as possible by looking entirely at its form,
+and not looking at any context (previous statements, including types
+of symbols).
+This would allow ripping out of the statement-confirmation,
+symbol retraction/confirmation, and diagnostic inhibition
+mechanisms.
+Plus, it would result in much-improved diagnostics.
+For example, @samp{CALL some-intrinsic(@dots{})}, where the intrinsic
+is not a subroutine intrinsic, would result actual error instead of the
+unimplemented-statement catch-all.
+
+@item
+Throughout @command{g77}, don't pass line/column pairs where
+a simple @code{ffewhere} type, which points to the error as much as is
+desired by the configuration, will do, and don't pass @code{ffelexToken} types
+where a simple @code{ffewhere} type will do.
+Then, allow new default
+configuration of @code{ffewhere} such that the source line text is not
+preserved, and leave it to things like Emacs' next-error function
+to point to them (now that @samp{next-error} supports column,
+or, perhaps, character-offset, numbers).
+The change in calling sequences should improve performance somewhat,
+as should not having to save source lines.
+(Whether this whole
+item will improve performance is questionable, but it should
+improve maintainability.)
+
+@item
+Handle @samp{DATA (A(I),I=1,1000000)/1000000*2/} more efficiently, especially
+as regards the assembly output.
+Some of this might require improving
+the back end, but lots of improvement in space/time required in @command{g77}
+itself can be fairly easily obtained without touching the back end.
+Maybe type-conversion, where necessary, can be speeded up as well in
+cases like the one shown (converting the @samp{2} into @samp{2.}).
+
+@item
+If analysis shows it to be worthwhile, optimize @file{lex.c}.
+
+@item
+Consider redesigning @file{lex.c} to not need any feedback
+during tokenization, by keeping track of enough parse state on its
+own.
+@end itemize
+
+@node Better Optimization
+@section Better Optimization
+@cindex optimization, better
+@cindex code generation, improving
+
+Much of this work should be put off until after @command{g77} has
+all the features necessary for its widespread acceptance as a
+useful F77 compiler.
+However, perhaps this work can be done in parallel during
+the feature-adding work.
+
+@itemize @bullet
+@item
+Do the equivalent of the trick of putting @samp{extern inline} in front
+of every function definition in @code{libg2c} and #include'ing the resulting
+file in @command{f2c}+@command{gcc}---that is, inline all run-time-library functions
+that are at all worth inlining.
+(Some of this has already been done, such as for integral exponentiation.)
+
+@item
+When doing @samp{CHAR_VAR = CHAR_FUNC(@dots{})},
+and it's clear that types line up
+and @samp{CHAR_VAR} is addressable or not a @code{VAR_DECL},
+make @samp{CHAR_VAR}, not a
+temporary, be the receiver for @samp{CHAR_FUNC}.
+(This is now done for @code{COMPLEX} variables.)
+
+@item
+Design and implement Fortran-specific optimizations that don't
+really belong in the back end, or where the front end needs to
+give the back end more info than it currently does.
+
+@item
+Design and implement a new run-time library interface, with the
+code going into @code{libgcc} so no special linking is required to
+link Fortran programs using standard language features.
+This library
+would speed up lots of things, from I/O (using precompiled formats,
+doing just one, or, at most, very few, calls for arrays or array sections,
+and so on) to general computing (array/section implementations of
+various intrinsics, implementation of commonly performed loops that
+aren't likely to be optimally compiled otherwise, etc.).
+
+Among the important things the library would do are:
+
+@itemize @bullet
+@item
+Be a one-stop-shop-type
+library, hence shareable and usable by all, in that what are now
+library-build-time options in @code{libg2c} would be moved at least to the
+@command{g77} compile phase, if not to finer grains (such as choosing how
+list-directed I/O formatting is done by default at @code{OPEN} time, for
+preconnected units via options or even statements in the main program
+unit, maybe even on a per-I/O basis with appropriate pragma-like
+devices).
+@end itemize
+
+@item
+Probably requiring the new library design, change interface to
+normally have @code{COMPLEX} functions return their values in the way
+@command{gcc} would if they were declared @code{__complex__ float},
+rather than using
+the mechanism currently used by @code{CHARACTER} functions (whereby the
+functions are compiled as returning void and their first arg is
+a pointer to where to store the result).
+(Don't append underscores to
+external names for @code{COMPLEX} functions in some cases once @command{g77} uses
+@command{gcc} rather than @command{f2c} calling conventions.)
+
+@item
+Do something useful with @code{doiter} references where possible.
+For example, @samp{CALL FOO(I)} cannot modify @samp{I} if within
+a @code{DO} loop that uses @samp{I} as the
+iteration variable, and the back end might find that info useful
+in determining whether it needs to read @samp{I} back into a register after
+the call.
+(It normally has to do that, unless it knows @samp{FOO} never
+modifies its passed-by-reference argument, which is rarely the case
+for Fortran-77 code.)
+@end itemize
+
+@node Simplify Porting
+@section Simplify Porting
+@cindex porting, simplify
+@cindex simplify porting
+
+Making @command{g77} easier to configure, port, build, and install, either
+as a single-system compiler or as a cross-compiler, would be
+very useful.
+
+@itemize @bullet
+@item
+A new library (replacing @code{libg2c}) should improve portability as well as
+produce more optimal code.
+Further, @command{g77} and the new library should
+conspire to simplify naming of externals, such as by removing unnecessarily
+added underscores, and to reduce/eliminate the possibility of naming
+conflicts, while making debugger more straightforward.
+
+Also, it should
+make multi-language applications more feasible, such as by providing
+Fortran intrinsics that get Fortran unit numbers given C @code{FILE *}
+descriptors.
+
+@item
+Possibly related to a new library, @command{g77} should produce the equivalent
+of a @command{gcc} @samp{main(argc, argv)} function when it compiles a
+main program unit, instead of compiling something that must be
+called by a library
+implementation of @code{main()}.
+
+This would do many useful things such as
+provide more flexibility in terms of setting up exception handling,
+not requiring programmers to start their debugging sessions with
+@kbd{breakpoint MAIN__} followed by @kbd{run}, and so on.
+
+@item
+The GBE needs to understand the difference between alignment
+requirements and desires.
+For example, on Intel x86 machines, @command{g77} currently imposes
+overly strict alignment requirements, due to the back end, but it
+would be useful for Fortran and C programmers to be able to override
+these @emph{recommendations} as long as they don't violate the actual
+processor @emph{requirements}.
+@end itemize
+
+@node More Extensions
+@section More Extensions
+@cindex extensions, more
+
+These extensions are not the sort of things users ask for ``by name'',
+but they might improve the usability of @command{g77}, and Fortran in
+general, in the long run.
+Some of these items really pertain to improving @command{g77} internals
+so that some popular extensions can be more easily supported.
+
+@itemize @bullet
+@item
+Look through all the documentation on the GNU Fortran language,
+dialects, compiler, missing features, bugs, and so on.
+Many mentions of incomplete or missing features are
+sprinkled throughout.
+It is not worth repeating them here.
+
+@item
+Consider adding a @code{NUMERIC} type to designate typeless numeric constants,
+named and unnamed.
+The idea is to provide a forward-looking, effective
+replacement for things like the old-style @code{PARAMETER} statement
+when people
+really need typelessness in a maintainable, portable, clearly documented
+way.
+Maybe @code{TYPELESS} would include @code{CHARACTER}, @code{POINTER},
+and whatever else might come along.
+(This is not really a call for polymorphism per se, just
+an ability to express limited, syntactic polymorphism.)
+
+@item
+Support @samp{OPEN(@dots{},KEY=(@dots{}),@dots{})}.
+
+@item
+Support arbitrary file unit numbers, instead of limiting them
+to 0 through @samp{MXUNIT-1}.
+(This is a @code{libg2c} issue.)
+
+@item
+@samp{OPEN(NOSPANBLOCKS,@dots{})} is treated as
+@samp{OPEN(UNIT=NOSPANBLOCKS,@dots{})}, so a
+later @code{UNIT=} in the first example is invalid.
+Make sure this is what users of this feature would expect.
+
+@item
+Currently @command{g77} disallows @samp{READ(1'10)} since
+it is an obnoxious syntax, but
+supporting it might be pretty easy if needed.
+More details are needed, such
+as whether general expressions separated by an apostrophe are supported,
+or maybe the record number can be a general expression, and so on.
+
+@item
+Support @code{STRUCTURE}, @code{UNION}, @code{MAP}, and @code{RECORD}
+fully.
+Currently there is no support at all
+for @code{%FILL} in @code{STRUCTURE} and related syntax,
+whereas the rest of the
+stuff has at least some parsing support.
+This requires either major
+changes to @code{libg2c} or its replacement.
+
+@item
+F90 and @command{g77} probably disagree about label scoping relative to
+@code{INTERFACE} and @code{END INTERFACE}, and their contained
+procedure interface bodies (blocks?).
+
+@item
+@code{ENTRY} doesn't support F90 @code{RESULT()} yet,
+since that was added after S8.112.
+
+@item
+Empty-statement handling (10 ;;CONTINUE;;) probably isn't consistent
+with the final form of the standard (it was vague at S8.112).
+
+@item
+It seems to be an ``open'' question whether a file, immediately after being
+@code{OPEN}ed,is positioned at the beginning, the end, or wherever---it
+might be nice to offer an option of opening to ``undefined'' status, requiring
+an explicit absolute-positioning operation to be performed before any
+other (besides @code{CLOSE}) to assist in making applications port to systems
+(some IBM?) that @code{OPEN} to the end of a file or some such thing.
+@end itemize
+
+@node Machine Model
+@section Machine Model
+
+This items pertain to generalizing @command{g77}'s view of
+the machine model to more fully accept whatever the GBE
+provides it via its configuration.
+
+@itemize @bullet
+@item
+Switch to using @code{REAL_VALUE_TYPE} to represent floating-point constants
+exclusively so the target float format need not be required.
+This
+means changing the way @command{g77} handles initialization of aggregate areas
+having more than one type, such as @code{REAL} and @code{INTEGER},
+because currently
+it initializes them as if they were arrays of @code{char} and uses the
+bit patterns of the constants of the various types in them to determine
+what to stuff in elements of the arrays.
+
+@item
+Rely more and more on back-end info and capabilities, especially in the
+area of constants (where having the @command{g77} front-end's IL just store
+the appropriate tree nodes containing constants might be best).
+
+@item
+Suite of C and Fortran programs that a user/administrator can run on a
+machine to help determine the configuration for @command{g77} before building
+and help determine if the compiler works (especially with whatever
+libraries are installed) after building.
+@end itemize
+
+@node Internals Documentation
+@section Internals Documentation
+
+Better info on how @command{g77} works and how to port it is needed.
+
+@xref{Front End}, which contains some information
+on @command{g77} internals.
+
+@node Internals Improvements
+@section Internals Improvements
+
+Some more items that would make @command{g77} more reliable
+and easier to maintain:
+
+@itemize @bullet
+@item
+Generally make expression handling focus
+more on critical syntax stuff, leaving semantics to callers.
+For example,
+anything a caller can check, semantically, let it do so, rather
+than having @file{expr.c} do it.
+(Exceptions might include things like
+diagnosing @samp{FOO(I--K:)=BAR} where @samp{FOO} is a @code{PARAMETER}---if
+it seems
+important to preserve the left-to-right-in-source order of production
+of diagnostics.)
+
+@item
+Come up with better naming conventions for @option{-D} to establish requirements
+to achieve desired implementation dialect via @file{proj.h}.
+
+@item
+Clean up used tokens and @code{ffewhere}s in @code{ffeglobal_terminate_1}.
+
+@item
+Replace @file{sta.c} @code{outpooldisp} mechanism with @code{malloc_pool_use}.
+
+@item
+Check for @code{opANY} in more places in @file{com.c}, @file{std.c},
+and @file{ste.c}, and get rid of the @samp{opCONVERT(opANY)} kludge
+(after determining if there is indeed no real need for it).
+
+@item
+Utility to read and check @file{bad.def} messages and their references in the
+code, to make sure calls are consistent with message templates.
+
+@item
+Search and fix @samp{&ffe@dots{}} and similar so that
+@samp{ffe@dots{}ptr@dots{}} macros are
+available instead (a good argument for wishing this could have written all
+this stuff in C++, perhaps).
+On the other hand, it's questionable whether this sort of
+improvement is really necessary, given the availability of
+tools such as Emacs and Perl, which make finding any
+address-taking of structure members easy enough?
+
+@item
+Some modules truly export the member names of their structures (and the
+structures themselves), maybe fix this, and fix other modules that just
+appear to as well (by appending @samp{_}, though it'd be ugly and probably
+not worth the time).
+
+@item
+Implement C macros @samp{RETURNS(value)} and @samp{SETS(something,value)}
+in @file{proj.h}
+and use them throughout @command{g77} source code (especially in the definitions
+of access macros in @samp{.h} files) so they can be tailored
+to catch code writing into a @samp{RETURNS()} or reading from a @samp{SETS()}.
+
+@item
+Decorate throughout with @code{const} and other such stuff.
+
+@item
+All F90 notational derivations in the source code are still based
+on the S8.112 version of the draft standard.
+Probably should update
+to the official standard, or put documentation of the rules as used
+in the code@dots{}uh@dots{}in the code.
+
+@item
+Some @code{ffebld_new} calls (those outside of @file{ffeexpr.c} or
+inside but invoked via paths not involving @code{ffeexpr_lhs} or
+@code{ffeexpr_rhs}) might be creating things
+in improper pools, leading to such things staying around too long or
+(doubtful, but possible and dangerous) not long enough.
+
+@item
+Some @code{ffebld_list_new} (or whatever) calls might not be matched by
+@code{ffebld_list_bottom} (or whatever) calls, which might someday matter.
+(It definitely is not a problem just yet.)
+
+@item
+Probably not doing clean things when we fail to @code{EQUIVALENCE} something
+due to alignment/mismatch or other problems---they end up without
+@code{ffestorag} objects, so maybe the backend (and other parts of the front
+end) can notice that and handle like an @code{opANY} (do what it wants, just
+don't complain or crash).
+Most of this seems to have been addressed
+by now, but a code review wouldn't hurt.
+@end itemize
+
+@node Better Diagnostics
+@section Better Diagnostics
+
+These are things users might not ask about, or that need to
+be looked into, before worrying about.
+Also here are items that involve reducing unnecessary diagnostic
+clutter.
+
+@itemize @bullet
+@item
+When @code{FUNCTION} and @code{ENTRY} point types disagree (@code{CHARACTER}
+lengths, type classes, and so on),
+@code{ANY}-ize the offending @code{ENTRY} point and any @emph{new} dummies
+it specifies.
+
+@item
+Speed up and improve error handling for data when repeat-count is
+specified.
+For example, don't output 20 unnecessary messages after the
+first necessary one for:
+
+@smallexample
+INTEGER X(20)
+CONTINUE
+DATA (X(I), J= 1, 20) /20*5/
+END
+@end smallexample
+
+@noindent
+(The @code{CONTINUE} statement ensures the @code{DATA} statement
+is processed in the context of executable, not specification,
+statements.)
+@end itemize
+
+@include ffe.texi
+
+@end ifset
+
+@ifset USING
+@node Diagnostics
+@chapter Diagnostics
+@cindex diagnostics
+
+Some diagnostics produced by @command{g77} require sufficient explanation
+that the explanations are given below, and the diagnostics themselves
+identify the appropriate explanation.
+
+Identification uses the GNU Info format---specifically, the @command{info}
+command that displays the explanation is given within square
+brackets in the diagnostic.
+For example:
+
+@smallexample
+foo.f:5: Invalid statement [info -f g77 M FOOEY]
+@end smallexample
+
+More details about the above diagnostic is found in the @command{g77} Info
+documentation, menu item @samp{M}, submenu item @samp{FOOEY},
+which is displayed by typing the UNIX command
+@samp{info -f g77 M FOOEY}.
+
+Other Info readers, such as EMACS, may be just as easily used to display
+the pertinent node.
+In the above example, @samp{g77} is the Info document name,
+@samp{M} is the top-level menu item to select,
+and, in that node (named @samp{Diagnostics}, the name of
+this chapter, which is the very text you're reading now),
+@samp{FOOEY} is the menu item to select.
+
+@iftex
+In this printed version of the @command{g77} manual, the above example
+points to a section, below, entitled @samp{FOOEY}---though, of course,
+as the above is just a sample, no such section exists.
+@end iftex
+
+@menu
+* CMPAMBIG::    Ambiguous use of intrinsic.
+* EXPIMP::      Intrinsic used explicitly and implicitly.
+* INTGLOB::     Intrinsic also used as name of global.
+* LEX::         Various lexer messages
+* GLOBALS::     Disagreements about globals.
+* LINKFAIL::    When linking @code{f771} fails.
+* Y2KBAD::      Use of non-Y2K-compliant intrinsic.
+@end menu
+
+@node CMPAMBIG
+@section @code{CMPAMBIG}
+
+@noindent
+@smallexample
+Ambiguous use of intrinsic @var{intrinsic} @dots{}
+@end smallexample
+
+The type of the argument to the invocation of the @var{intrinsic}
+intrinsic is a @code{COMPLEX} type other than @code{COMPLEX(KIND=1)}.
+Typically, it is @code{COMPLEX(KIND=2)}, also known as
+@code{DOUBLE COMPLEX}.
+
+The interpretation of this invocation depends on the particular
+dialect of Fortran for which the code was written.
+Some dialects convert the real part of the argument to
+@code{REAL(KIND=1)}, thus losing precision; other dialects,
+and Fortran 90, do no such conversion.
+
+So, GNU Fortran rejects such invocations except under certain
+circumstances, to avoid making an incorrect assumption that results
+in generating the wrong code.
+
+To determine the dialect of the program unit, perhaps even whether
+that particular invocation is properly coded, determine how the
+result of the intrinsic is used.
+
+The result of @var{intrinsic} is expected (by the original programmer)
+to be @code{REAL(KIND=1)} (the non-Fortran-90 interpretation) if:
+
+@itemize @bullet
+@item
+It is passed as an argument to a procedure that explicitly or
+implicitly declares that argument @code{REAL(KIND=1)}.
+
+For example,
+a procedure with no @code{DOUBLE PRECISION} or @code{IMPLICIT DOUBLE PRECISION}
+statement specifying the dummy argument corresponding to an
+actual argument of @samp{REAL(Z)}, where @samp{Z} is declared
+@code{DOUBLE COMPLEX}, strongly suggests that the programmer
+expected @samp{REAL(Z)} to return @code{REAL(KIND=1)} instead
+of @code{REAL(KIND=2)}.
+
+@item
+It is used in a context that would otherwise not include
+any @code{REAL(KIND=2)} but where treating the @var{intrinsic}
+invocation as @code{REAL(KIND=2)} would result in unnecessary
+promotions and (typically) more expensive operations on the
+wider type.
+
+For example:
+
+@smallexample
+DOUBLE COMPLEX Z
+@dots{}
+R(1) = T * REAL(Z)
+@end smallexample
+
+The above example suggests the programmer expected the real part
+of @samp{Z} to be converted to @code{REAL(KIND=1)} before being
+multiplied by @samp{T} (presumed, along with @samp{R} above, to
+be type @code{REAL(KIND=1)}).
+
+Otherwise, the conversion would have to be delayed until after
+the multiplication, requiring not only an extra conversion
+(of @samp{T} to @code{REAL(KIND=2)}), but a (typically) more
+expensive multiplication (a double-precision multiplication instead
+of a single-precision one).
+@end itemize
+
+The result of @var{intrinsic} is expected (by the original programmer)
+to be @code{REAL(KIND=2)} (the Fortran 90 interpretation) if:
+
+@itemize @bullet
+@item
+It is passed as an argument to a procedure that explicitly or
+implicitly declares that argument @code{REAL(KIND=2)}.
+
+For example, a procedure specifying a @code{DOUBLE PRECISION}
+dummy argument corresponding to an
+actual argument of @samp{REAL(Z)}, where @samp{Z} is declared
+@code{DOUBLE COMPLEX}, strongly suggests that the programmer
+expected @samp{REAL(Z)} to return @code{REAL(KIND=2)} instead
+of @code{REAL(KIND=1)}.
+
+@item
+It is used in an expression context that includes
+other @code{REAL(KIND=2)} operands,
+or is assigned to a @code{REAL(KIND=2)} variable or array element.
+
+For example:
+
+@smallexample
+DOUBLE COMPLEX Z
+DOUBLE PRECISION R, T
+@dots{}
+R(1) = T * REAL(Z)
+@end smallexample
+
+The above example suggests the programmer expected the real part
+of @samp{Z} to @emph{not} be converted to @code{REAL(KIND=1)}
+by the @code{REAL()} intrinsic.
+
+Otherwise, the conversion would have to be immediately followed
+by a conversion back to @code{REAL(KIND=2)}, losing
+the original, full precision of the real part of @code{Z},
+before being multiplied by @samp{T}.
+@end itemize
+
+Once you have determined whether a particular invocation of @var{intrinsic}
+expects the Fortran 90 interpretation, you can:
+
+@itemize @bullet
+@item
+Change it to @samp{DBLE(@var{expr})} (if @var{intrinsic} is
+@code{REAL}) or @samp{DIMAG(@var{expr})} (if @var{intrinsic}
+is @code{AIMAG})
+if it expected the Fortran 90 interpretation.
+
+This assumes @var{expr} is @code{COMPLEX(KIND=2)}---if it is
+some other type, such as @code{COMPLEX*32}, you should use the
+appropriate intrinsic, such as the one to convert to @code{REAL*16}
+(perhaps @code{DBLEQ()} in place of @code{DBLE()}, and
+@code{QIMAG()} in place of @code{DIMAG()}).
+
+@item
+Change it to @samp{REAL(@var{intrinsic}(@var{expr}))},
+otherwise.
+This converts to @code{REAL(KIND=1)} in all working
+Fortran compilers.
+@end itemize
+
+If you don't want to change the code, and you are certain that all
+ambiguous invocations of @var{intrinsic} in the source file have
+the same expectation regarding interpretation, you can:
+
+@itemize @bullet
+@item
+Compile with the @command{g77} option @option{-ff90}, to enable the
+Fortran 90 interpretation.
+
+@item
+Compile with the @command{g77} options @samp{-fno-f90 -fugly-complex},
+to enable the non-Fortran-90 interpretations.
+@end itemize
+
+@xref{REAL() and AIMAG() of Complex}, for more information on this
+issue.
+
+Note: If the above suggestions don't produce enough evidence
+as to whether a particular program expects the Fortran 90
+interpretation of this ambiguous invocation of @var{intrinsic},
+there is one more thing you can try.
+
+If you have access to most or all the compilers used on the
+program to create successfully tested and deployed executables,
+read the documentation for, and @emph{also} test out, each compiler
+to determine how it treats the @var{intrinsic} intrinsic in
+this case.
+(If all the compilers don't agree on an interpretation, there
+might be lurking bugs in the deployed versions of the program.)
+
+The following sample program might help:
+
+@cindex JCB003 program
+@smallexample
+      PROGRAM JCB003
+C
+C Written by James Craig Burley 1997-02-23.
+C
+C Determine how compilers handle non-standard REAL
+C and AIMAG on DOUBLE COMPLEX operands.
+C
+      DOUBLE COMPLEX Z
+      REAL R
+      Z = (3.3D0, 4.4D0)
+      R = Z
+      CALL DUMDUM(Z, R)
+      R = REAL(Z) - R
+      IF (R .NE. 0.) PRINT *, 'REAL() is Fortran 90'
+      IF (R .EQ. 0.) PRINT *, 'REAL() is not Fortran 90'
+      R = 4.4D0
+      CALL DUMDUM(Z, R)
+      R = AIMAG(Z) - R
+      IF (R .NE. 0.) PRINT *, 'AIMAG() is Fortran 90'
+      IF (R .EQ. 0.) PRINT *, 'AIMAG() is not Fortran 90'
+      END
+C
+C Just to make sure compiler doesn't use naive flow
+C analysis to optimize away careful work above,
+C which might invalidate results....
+C
+      SUBROUTINE DUMDUM(Z, R)
+      DOUBLE COMPLEX Z
+      REAL R
+      END
+@end smallexample
+
+If the above program prints contradictory results on a
+particular compiler, run away!
+
+@node EXPIMP
+@section @code{EXPIMP}
+
+@noindent
+@smallexample
+Intrinsic @var{intrinsic} referenced @dots{}
+@end smallexample
+
+The @var{intrinsic} is explicitly declared in one program
+unit in the source file and implicitly used as an intrinsic
+in another program unit in the same source file.
+
+This diagnostic is designed to catch cases where a program
+might depend on using the name @var{intrinsic} as an intrinsic
+in one program unit and as a global name (such as the name
+of a subroutine or function) in another, but @command{g77} recognizes
+the name as an intrinsic in both cases.
+
+After verifying that the program unit making implicit use
+of the intrinsic is indeed written expecting the intrinsic,
+add an @samp{INTRINSIC @var{intrinsic}} statement to that
+program unit to prevent this warning.
+
+This and related warnings are disabled by using
+the @option{-Wno-globals} option when compiling.
+
+Note that this warning is not issued for standard intrinsics.
+Standard intrinsics include those described in the FORTRAN 77
+standard and, if @option{-ff90} is specified, those described
+in the Fortran 90 standard.
+Such intrinsics are not as likely to be confused with user
+procedures as intrinsics provided as extensions to the
+standard by @command{g77}.
+
+@node INTGLOB
+@section @code{INTGLOB}
+
+@noindent
+@smallexample
+Same name `@var{intrinsic}' given @dots{}
+@end smallexample
+
+The name @var{intrinsic} is used for a global entity (a common
+block or a program unit) in one program unit and implicitly
+used as an intrinsic in another program unit.
+
+This diagnostic is designed to catch cases where a program
+intends to use a name entirely as a global name, but @command{g77}
+recognizes the name as an intrinsic in the program unit that
+references the name, a situation that would likely produce
+incorrect code.
+
+For example:
+
+@smallexample
+INTEGER FUNCTION TIME()
+@dots{}
+END
+@dots{}
+PROGRAM SAMP
+INTEGER TIME
+PRINT *, 'Time is ', TIME()
+END
+@end smallexample
+
+The above example defines a program unit named @samp{TIME}, but
+the reference to @samp{TIME} in the main program unit @samp{SAMP}
+is normally treated by @command{g77} as a reference to the intrinsic
+@code{TIME()} (unless a command-line option that prevents such
+treatment has been specified).
+
+As a result, the program @samp{SAMP} will @emph{not}
+invoke the @samp{TIME} function in the same source file.
+
+Since @command{g77} recognizes @code{libU77} procedures as
+intrinsics, and since some existing code uses the same names
+for its own procedures as used by some @code{libU77}
+procedures, this situation is expected to arise often enough
+to make this sort of warning worth issuing.
+
+After verifying that the program unit making implicit use
+of the intrinsic is indeed written expecting the intrinsic,
+add an @samp{INTRINSIC @var{intrinsic}} statement to that
+program unit to prevent this warning.
+
+Or, if you believe the program unit is designed to invoke the
+program-defined procedure instead of the intrinsic (as
+recognized by @command{g77}), add an @samp{EXTERNAL @var{intrinsic}}
+statement to the program unit that references the name to
+prevent this warning.
+
+This and related warnings are disabled by using
+the @option{-Wno-globals} option when compiling.
+
+Note that this warning is not issued for standard intrinsics.
+Standard intrinsics include those described in the FORTRAN 77
+standard and, if @option{-ff90} is specified, those described
+in the Fortran 90 standard.
+Such intrinsics are not as likely to be confused with user
+procedures as intrinsics provided as extensions to the
+standard by @command{g77}.
+
+@node LEX
+@section @code{LEX}
+
+@noindent
+@smallexample
+Unrecognized character @dots{}
+Invalid first character @dots{}
+Line too long @dots{}
+Non-numeric character @dots{}
+Continuation indicator @dots{}
+Label at @dots{} invalid with continuation line indicator @dots{}
+Character constant @dots{}
+Continuation line @dots{}
+Statement at @dots{} begins with invalid token
+@end smallexample
+
+Although the diagnostics identify specific problems, they can
+be produced when general problems such as the following occur:
+
+@itemize @bullet
+@item
+The source file contains something other than Fortran code.
+
+If the code in the file does not look like many of the examples
+elsewhere in this document, it might not be Fortran code.
+(Note that Fortran code often is written in lower case letters,
+while the examples in this document use upper case letters,
+for stylistic reasons.)
+
+For example, if the file contains lots of strange-looking
+characters, it might be APL source code; if it contains lots
+of parentheses, it might be Lisp source code; if it
+contains lots of bugs, it might be C++ source code.
+
+@item
+The source file contains free-form Fortran code, but @option{-ffree-form}
+was not specified on the command line to compile it.
+
+Free form is a newer form for Fortran code.
+The older, classic form is called fixed form.
+
+@cindex continuation character
+@cindex characters, continuation
+Fixed-form code is visually fairly distinctive, because
+numerical labels and comments are all that appear in
+the first five columns of a line, the sixth column is
+reserved to denote continuation lines,
+and actual statements start at or beyond column 7.
+Spaces generally are not significant, so if you
+see statements such as @samp{REALX,Y} and @samp{DO10I=1,100},
+you are looking at fixed-form code.
+@cindex *
+@cindex asterisk
+Comment lines are indicated by the letter @samp{C} or the symbol
+@samp{*} in column 1.
+@cindex trailing comment
+@cindex comment
+@cindex characters, comment
+@cindex !
+@cindex exclamation point
+(Some code uses @samp{!} or @samp{/*} to begin in-line comments,
+which many compilers support.)
+
+Free-form code is distinguished from fixed-form source
+primarily by the fact that statements may start anywhere.
+(If lots of statements start in columns 1 through 6,
+that's a strong indicator of free-form source.)
+Consecutive keywords must be separated by spaces, so
+@samp{REALX,Y} is not valid, while @samp{REAL X,Y} is.
+There are no comment lines per se, but @samp{!} starts a
+comment anywhere in a line (other than within a character or
+Hollerith constant).
+
+@xref{Source Form}, for more information.
+
+@item
+The source file is in fixed form and has been edited without
+sensitivity to the column requirements.
+
+Statements in fixed-form code must be entirely contained within
+columns 7 through 72 on a given line.
+Starting them ``early'' is more likely to result in diagnostics
+than finishing them ``late'', though both kinds of errors are
+often caught at compile time.
+
+For example, if the following code fragment is edited by following
+the commented instructions literally, the result, shown afterward,
+would produce a diagnostic when compiled:
+
+@smallexample
+C On XYZZY systems, remove "C" on next line:
+C     CALL XYZZY_RESET
+@end smallexample
+
+The result of editing the above line might be:
+
+@smallexample
+C On XYZZY systems, remove "C" on next line:
+     CALL XYZZY_RESET
+@end smallexample
+
+However, that leaves the first @samp{C} in the @code{CALL}
+statement in column 6, making it a comment line, which is
+not really what the author intended, and which is likely
+to result in one of the above-listed diagnostics.
+
+@emph{Replacing} the @samp{C} in column 1 with a space
+is the proper change to make, to ensure the @code{CALL}
+keyword starts in or after column 7.
+
+Another common mistake like this is to forget that fixed-form
+source lines are significant through only column 72, and that,
+normally, any text beyond column 72 is ignored or is diagnosed
+at compile time.
+
+@xref{Source Form}, for more information.
+
+@item
+The source file requires preprocessing, and the preprocessing
+is not being specified at compile time.
+
+A source file containing lines beginning with @code{#define},
+@code{#include}, @code{#if}, and so on is likely one that
+requires preprocessing.
+
+If the file's suffix is @samp{.f}, @samp{.for}, or @samp{.FOR},
+the file normally will be compiled @emph{without} preprocessing
+by @command{g77}.
+
+Change the file's suffix from @samp{.f} to @samp{.F}
+(or, on systems with case-insensitive file names,
+to @samp{.fpp} or @samp{.FPP}),
+from @samp{.for} to @samp{.fpp},
+or from @samp{.FOR} to @samp{.FPP}.
+@command{g77} compiles files with such names @emph{with}
+preprocessing.
+
+@pindex cpp
+@cindex preprocessor
+@cindex cpp program
+@cindex programs, cpp
+@cindex @option{-x f77-cpp-input} option
+@cindex options, @option{-x f77-cpp-input}
+Or, learn how to use @command{gcc}'s @option{-x} option to specify
+the language @samp{f77-cpp-input} for Fortran files that
+require preprocessing.
+@xref{Overall Options,,Options Controlling the Kind of
+Output,gcc,Using the GNU Compiler Collection (GCC)}.
+
+@item
+The source file is preprocessed, and the results of preprocessing
+result in syntactic errors that are not necessarily obvious to
+someone examining the source file itself.
+
+Examples of errors resulting from preprocessor macro expansion
+include exceeding the line-length limit, improperly starting,
+terminating, or incorporating the apostrophe or double-quote in
+a character constant, improperly forming a Hollerith constant,
+and so on.
+
+@xref{Overall Options,,Options Controlling the Kind of Output},
+for suggestions about how to use, and not use, preprocessing
+for Fortran code.
+@end itemize
+
+@node GLOBALS
+@section @code{GLOBALS}
+
+@noindent
+@smallexample
+Global name @var{name} defined at @dots{} already defined@dots{}
+Global name @var{name} at @dots{} has different type@dots{}
+Too many arguments passed to @var{name} at @dots{}
+Too few arguments passed to @var{name} at @dots{}
+Argument #@var{n} of @var{name} is @dots{}
+@end smallexample
+
+These messages all identify disagreements about the
+global procedure named @var{name} among different program units
+(usually including @var{name} itself).
+
+Whether a particular disagreement is reported
+as a warning or an error
+can depend on the relative order
+of the disagreeing portions of the source file.
+
+Disagreements between a procedure invocation
+and the @emph{subsequent} procedure itself
+are, usually, diagnosed as errors
+when the procedure itself @emph{precedes} the invocation.
+Other disagreements are diagnosed via warnings.
+
+@cindex forward references
+@cindex in-line code
+@cindex compilation, in-line
+This distinction, between warnings and errors,
+is due primarily to the present tendency of the @command{gcc} back end
+to inline only those procedure invocations that are
+@emph{preceded} by the corresponding procedure definitions.
+If the @command{gcc} back end is changed
+to inline ``forward references'',
+in which invocations precede definitions,
+the @command{g77} front end will be changed
+to treat both orderings as errors, accordingly.
+
+The sorts of disagreements that are diagnosed by @command{g77} include
+whether a procedure is a subroutine or function;
+if it is a function, the type of the return value of the procedure;
+the number of arguments the procedure accepts;
+and the type of each argument.
+
+Disagreements regarding global names among program units
+in a Fortran program @emph{should} be fixed in the code itself.
+However, if that is not immediately practical,
+and the code has been working for some time,
+it is possible it will work
+when compiled with the @option{-fno-globals} option.
+
+The @option{-fno-globals} option
+causes these diagnostics to all be warnings
+and disables all inlining of references to global procedures
+(to avoid subsequent compiler crashes and bad-code generation).
+Use of the @option{-Wno-globals} option as well as @option{-fno-globals}
+suppresses all of these diagnostics.
+(@option{-Wno-globals} by itself disables only the warnings,
+not the errors.)
+
+After using @option{-fno-globals} to work around these problems,
+it is wise to stop using that option and address them by fixing
+the Fortran code, because such problems, while they might not
+actually result in bugs on some systems, indicate that the code
+is not as portable as it could be.
+In particular, the code might appear to work on a particular
+system, but have bugs that affect the reliability of the data
+without exhibiting any other outward manifestations of the bugs.
+
+@node LINKFAIL
+@section @code{LINKFAIL}
+
+@noindent
+On AIX 4.1, @command{g77} might not build with the native (non-GNU) tools
+due to a linker bug in coping with the @option{-bbigtoc} option which
+leads to a @samp{Relocation overflow} error.  The GNU linker is not
+recommended on current AIX versions, though; it was developed under a
+now-unsupported version.  This bug is said to be fixed by `update PTF
+U455193 for APAR IX75823'.
+
+Compiling with @option{-mminimal-toc}
+might solve this problem, e.g.@: by adding
+@smallexample
+BOOT_CFLAGS='-mminimal-toc -O2 -g'
+@end smallexample
+to the @code{make bootstrap} command line.
+
+@node Y2KBAD
+@section @code{Y2KBAD}
+@cindex Y2K compliance
+@cindex Year 2000 compliance
+
+@noindent
+@smallexample
+Intrinsic `@var{name}', invoked at (^), known to be non-Y2K-compliant@dots{}
+@end smallexample
+
+This diagnostic indicates that
+the specific intrinsic invoked by the name @var{name}
+is known to have an interface
+that is not Year-2000 (Y2K) compliant.
+
+@xref{Year 2000 (Y2K) Problems}.
+
+@end ifset
+
+@node Keyword Index
+@unnumbered Keyword Index
+
+@printindex cp
+@bye
diff --git a/gcc/f/g77spec.c b/gcc/f/g77spec.c
new file mode 100644
index 00000000000..3dca7bc4483
--- /dev/null
+++ b/gcc/f/g77spec.c
@@ -0,0 +1,541 @@
+/* Specific flags and argument handling of the Fortran front-end.
+   Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004
+   Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GCC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* This file contains a filter for the main `gcc' driver, which is
+   replicated for the `g77' driver by adding this filter.  The purpose
+   of this filter is to be basically identical to gcc (in that
+   it faithfully passes all of the original arguments to gcc) but,
+   unless explicitly overridden by the user in certain ways, ensure
+   that the needs of the language supported by this wrapper are met.
+
+   For GNU Fortran (g77), we do the following to the argument list
+   before passing it to `gcc':
+
+   1.  Make sure `-lg2c -lm' is at the end of the list.
+
+   2.  Make sure each time `-lg2c' or `-lm' is seen, it forms
+       part of the series `-lg2c -lm'.
+
+   #1 and #2 are not done if `-nostdlib' or any option that disables
+   the linking phase is present, or if `-xfoo' is in effect.  Note that
+   a lack of source files or -l options disables linking.
+
+   This program was originally made out of gcc/cp/g++spec.c, but the
+   way it builds the new argument list was rewritten so it is much
+   easier to maintain, improve the way it decides to add or not add
+   extra arguments, etc.  And several improvements were made in the
+   handling of arguments, primarily to make it more consistent with
+   `gcc' itself.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "gcc.h"
+#include "intl.h"
+
+#ifndef MATH_LIBRARY
+#define MATH_LIBRARY "-lm"
+#endif
+
+#ifndef FORTRAN_INIT
+#define FORTRAN_INIT "-lfrtbegin"
+#endif
+
+#ifndef FORTRAN_LIBRARY
+#define FORTRAN_LIBRARY "-lg2c"
+#endif
+
+/* Options this driver needs to recognize, not just know how to
+   skip over.  */
+typedef enum
+{
+  OPTION_b,			/* Aka --prefix. */
+  OPTION_B,			/* Aka --target. */
+  OPTION_c,			/* Aka --compile. */
+  OPTION_driver,		/* Wrapper-specific option. */
+  OPTION_E,			/* Aka --preprocess. */
+  OPTION_help,			/* --help. */
+  OPTION_i,			/* -imacros, -include, -include-*. */
+  OPTION_l,
+  OPTION_L,			/* Aka --library-directory. */
+  OPTION_M,			/* Aka --dependencies. */
+  OPTION_MM,			/* Aka --user-dependencies. */
+  OPTION_nostdlib,		/* Aka --no-standard-libraries, or
+				   -nodefaultlibs. */
+  OPTION_o,			/* Aka --output. */
+  OPTION_S,			/* Aka --assemble. */
+  OPTION_syntax_only,		/* -fsyntax-only. */
+  OPTION_v,			/* Aka --verbose. */
+  OPTION_version,		/* --version. */
+  OPTION_V,			/* Aka --use-version. */
+  OPTION_x,			/* Aka --language. */
+  OPTION_			/* Unrecognized or unimportant. */
+} Option;
+
+/* The original argument list and related info is copied here.  */
+static int g77_xargc;
+static const char *const *g77_xargv;
+static void lookup_option (Option *, int *, const char **, const char *);
+static void append_arg (const char *);
+
+/* The new argument list will be built here.  */
+static int g77_newargc;
+static const char **g77_newargv;
+
+#ifndef SWITCH_TAKES_ARG
+#define SWITCH_TAKES_ARG(CHAR) DEFAULT_SWITCH_TAKES_ARG(CHAR)
+#endif
+
+#ifndef WORD_SWITCH_TAKES_ARG
+#define WORD_SWITCH_TAKES_ARG(STR) DEFAULT_WORD_SWITCH_TAKES_ARG (STR)
+#endif
+
+/* Assumes text[0] == '-'.  Returns number of argv items that belong to
+   (and follow) this one, an option id for options important to the
+   caller, and a pointer to the first char of the arg, if embedded (else
+   returns NULL, meaning no arg or it's the next argv).
+
+   Note that this also assumes gcc.c's pass converting long options
+   to short ones, where available, has already been run.  */
+
+static void
+lookup_option (Option *xopt, int *xskip, const char **xarg, const char *text)
+{
+  Option opt = OPTION_;
+  int skip;
+  const char *arg = NULL;
+
+  if ((skip = SWITCH_TAKES_ARG (text[1])))
+    skip -= (text[2] != '\0');	/* See gcc.c. */
+
+  if (text[1] == 'B')
+    opt = OPTION_B, skip = (text[2] == '\0'), arg = text + 2;
+  else if (text[1] == 'b')
+    opt = OPTION_b, skip = (text[2] == '\0'), arg = text + 2;
+  else if ((text[1] == 'c') && (text[2] == '\0'))
+    opt = OPTION_c, skip = 0;
+  else if ((text[1] == 'E') && (text[2] == '\0'))
+    opt = OPTION_E, skip = 0;
+  else if (text[1] == 'i')
+    opt = OPTION_i, skip = 0;
+  else if (text[1] == 'l')
+    opt = OPTION_l;
+  else if (text[1] == 'L')
+    opt = OPTION_L, arg = text + 2;
+  else if (text[1] == 'o')
+    opt = OPTION_o;
+  else if ((text[1] == 'S') && (text[2] == '\0'))
+    opt = OPTION_S, skip = 0;
+  else if (text[1] == 'V')
+    opt = OPTION_V, skip = (text[2] == '\0');
+  else if ((text[1] == 'v') && (text[2] == '\0'))
+    opt = OPTION_v, skip = 0;
+  else if (text[1] == 'x')
+    opt = OPTION_x, arg = text + 2;
+  else
+    {
+      if ((skip = WORD_SWITCH_TAKES_ARG (text + 1)) != 0)  /* See gcc.c. */
+	;
+      else if (! strncmp (text, "-fdriver", 8))  /* Really --driver!! */
+	opt = OPTION_driver;	/* Never mind arg, this is unsupported. */
+      else if (! strcmp (text, "-fhelp"))  /* Really --help!! */
+	opt = OPTION_help;
+      else if (! strcmp (text, "-M"))
+	opt = OPTION_M;
+      else if (! strcmp (text, "-MM"))
+	opt = OPTION_MM;
+      else if (! strcmp (text, "-nostdlib")
+	       || ! strcmp (text, "-nodefaultlibs"))
+	opt = OPTION_nostdlib;
+      else if (! strcmp (text, "-fsyntax-only"))
+	opt = OPTION_syntax_only;
+      else if (! strcmp (text, "-dumpversion"))
+	opt = OPTION_version;
+      else if (! strcmp (text, "-fversion"))  /* Really --version!! */
+	opt = OPTION_version;
+      else if (! strcmp (text, "-Xlinker")
+	       || ! strcmp (text, "-specs"))
+	skip = 1;
+      else
+	skip = 0;
+    }
+
+  if (xopt != NULL)
+    *xopt = opt;
+  if (xskip != NULL)
+    *xskip = skip;
+  if (xarg != NULL)
+    {
+      if ((arg != NULL)
+	  && (arg[0] == '\0'))
+	*xarg = NULL;
+      else
+	*xarg = arg;
+    }
+}
+
+/* Append another argument to the list being built.  As long as it is
+   identical to the corresponding arg in the original list, just increment
+   the new arg count.  Otherwise allocate a new list, etc.  */
+
+static void
+append_arg (const char *arg)
+{
+  static int newargsize;
+
+#if 0
+  fprintf (stderr, "`%s'\n", arg);
+#endif
+
+  if (g77_newargv == g77_xargv
+      && g77_newargc < g77_xargc
+      && (arg == g77_xargv[g77_newargc]
+	  || ! strcmp (arg, g77_xargv[g77_newargc])))
+    {
+      ++g77_newargc;
+      return;			/* Nothing new here. */
+    }
+
+  if (g77_newargv == g77_xargv)
+    {				/* Make new arglist. */
+      int i;
+
+      newargsize = (g77_xargc << 2) + 20;	/* This should handle all. */
+      g77_newargv = xmalloc (newargsize * sizeof (char *));
+
+      /* Copy what has been done so far.  */
+      for (i = 0; i < g77_newargc; ++i)
+	g77_newargv[i] = g77_xargv[i];
+    }
+
+  if (g77_newargc == newargsize)
+    fatal ("overflowed output arg list for `%s'", arg);
+
+  g77_newargv[g77_newargc++] = arg;
+}
+
+void
+lang_specific_driver (int *in_argc, const char *const **in_argv,
+		      int *in_added_libraries ATTRIBUTE_UNUSED)
+{
+  int argc = *in_argc;
+  const char *const *argv = *in_argv;
+  int i;
+  int verbose = 0;
+  Option opt;
+  int skip;
+  const char *arg;
+
+  /* This will be NULL if we encounter a situation where we should not
+     link in libf2c.  */
+  const char *library = FORTRAN_LIBRARY;
+
+  /* 0 => -xnone in effect.
+     1 => -xfoo in effect.  */
+  int saw_speclang = 0;
+
+  /* 0 => initial/reset state
+     1 => last arg was -l<library>
+     2 => last two args were -l<library> -lm.  */
+  int saw_library = 0;
+
+  /* 0 => initial/reset state
+     1 => FORTRAN_INIT linked in */
+  int use_init = 0;
+  /* By default, we throw on the math library if we have one.  */
+  int need_math = (MATH_LIBRARY[0] != '\0');
+
+  /* The number of input and output files in the incoming arg list.  */
+  int n_infiles = 0;
+  int n_outfiles = 0;
+
+#if 0
+  fprintf (stderr, "Incoming:");
+  for (i = 0; i < argc; i++)
+    fprintf (stderr, " %s", argv[i]);
+  fprintf (stderr, "\n");
+#endif
+
+  g77_xargc = argc;
+  g77_xargv = argv;
+  g77_newargc = 0;
+  g77_newargv = (const char **) argv;
+
+  /* First pass through arglist.
+
+     If -nostdlib or a "turn-off-linking" option is anywhere in the
+     command line, don't do any library-option processing (except
+     relating to -x).  Also, if -v is specified, but no other options
+     that do anything special (allowing -V version, etc.), remember
+     to add special stuff to make gcc command actually invoke all
+     the different phases of the compilation process so all the version
+     numbers can be seen.
+
+     Also, here is where all problems with missing arguments to options
+     are caught.  If this loop is exited normally, it means all options
+     have the appropriate number of arguments as far as the rest of this
+     program is concerned.  */
+
+  for (i = 1; i < argc; ++i)
+    {
+      if ((argv[i][0] == '+') && (argv[i][1] == 'e'))
+	{
+	  continue;
+	}
+
+      if ((argv[i][0] != '-') || (argv[i][1] == '\0'))
+	{
+	  ++n_infiles;
+	  continue;
+	}
+
+      lookup_option (&opt, &skip, NULL, argv[i]);
+
+      switch (opt)
+	{
+	case OPTION_nostdlib:
+	case OPTION_c:
+	case OPTION_S:
+	case OPTION_syntax_only:
+	case OPTION_E:
+	case OPTION_M:
+	case OPTION_MM:
+	  /* These options disable linking entirely or linking of the
+	     standard libraries.  */
+	  library = 0;
+	  break;
+
+	case OPTION_l:
+	  ++n_infiles;
+	  break;
+
+	case OPTION_o:
+	  ++n_outfiles;
+	  break;
+
+	case OPTION_v:
+	  verbose = 1;
+	  break;
+
+	case OPTION_b:
+	case OPTION_B:
+	case OPTION_L:
+	case OPTION_i:
+	case OPTION_V:
+	  /* These options are useful in conjunction with -v to get
+	     appropriate version info.  */
+	  break;
+
+	case OPTION_version:
+	  printf ("GNU Fortran (GCC) %s\n", version_string);
+	  printf ("Copyright %s 2004 Free Software Foundation, Inc.\n",
+		  _("(C)"));
+	  printf ("\n");
+	  printf (_("\
+GNU Fortran comes with NO WARRANTY, to the extent permitted by law.\n\
+You may redistribute copies of GNU Fortran\n\
+under the terms of the GNU General Public License.\n\
+For more information about these matters, see the file named COPYING\n\
+or type the command `info -f g77 Copying'.\n\
+"));
+	  exit (0);
+	  break;
+
+	case OPTION_help:
+	  /* Let gcc.c handle this, as it has a really
+	     cool facility for handling --help and --verbose --help.  */
+	  return;
+
+	case OPTION_driver:
+	  fatal ("--driver no longer supported");
+	  break;
+
+	default:
+	  break;
+	}
+
+      /* This is the one place we check for missing arguments in the
+	 program.  */
+
+      if (i + skip < argc)
+	i += skip;
+      else
+	fatal ("argument to `%s' missing", argv[i]);
+    }
+
+  if ((n_outfiles != 0) && (n_infiles == 0))
+    fatal ("no input files; unwilling to write output files");
+
+  /* If there are no input files, no need for the library.  */
+  if (n_infiles == 0)
+    library = 0;
+
+  /* Second pass through arglist, transforming arguments as appropriate.  */
+
+  append_arg (argv[0]);	/* Start with command name, of course. */
+
+  for (i = 1; i < argc; ++i)
+    {
+      if (argv[i][0] == '\0')
+	{
+	  append_arg (argv[i]);	/* Interesting.  Just append as is. */
+	  continue;
+	}
+
+      if ((argv[i][0] == '-') && (argv[i][1] != 'l'))
+	{
+	  /* Not a filename or library. */
+
+	 if (saw_library == 1 && need_math)    /* -l<library>. */
+	    append_arg (MATH_LIBRARY);
+
+	  saw_library = 0;
+
+	  lookup_option (&opt, &skip, &arg, argv[i]);
+
+	  if (argv[i][1] == '\0')
+	    {
+	      append_arg (argv[i]);	/* "-" == Standard input. */
+	      continue;
+	    }
+
+	  if (opt == OPTION_x)
+	    {
+	      /* Track input language. */
+	      const char *lang;
+
+	      if (arg == NULL)
+		lang = argv[i+1];
+	      else
+		lang = arg;
+
+	      saw_speclang = (strcmp (lang, "none") != 0);
+	    }
+
+	  append_arg (argv[i]);
+
+	  for (; skip != 0; --skip)
+	    append_arg (argv[++i]);
+
+	  continue;
+	}
+
+      /* A filename/library, not an option. */
+
+      if (saw_speclang)
+	saw_library = 0;	/* -xfoo currently active. */
+      else
+	{			/* -lfoo or filename. */
+	  if (strcmp (argv[i], MATH_LIBRARY) == 0)
+	    {
+	      if (saw_library == 1)
+		saw_library = 2;	/* -l<library> -lm. */
+	      else
+		{
+		  if (0 == use_init)
+		    {
+		      append_arg (FORTRAN_INIT);
+		      use_init = 1;
+		    }
+		  append_arg (FORTRAN_LIBRARY);
+		}
+	    }
+	  else if (strcmp (argv[i], FORTRAN_LIBRARY) == 0)
+	    saw_library = 1;	/* -l<library>. */
+	  else
+	    {		/* Other library, or filename. */
+	     if (saw_library == 1 && need_math)
+		append_arg (MATH_LIBRARY);
+	      saw_library = 0;
+	    }
+	}
+      append_arg (argv[i]);
+    }
+
+  /* Append `-lg2c -lm' as necessary.  */
+
+  if (library)
+    {				/* Doing a link and no -nostdlib. */
+      if (saw_speclang)
+	append_arg ("-xnone");
+
+      switch (saw_library)
+	{
+	case 0:
+	  if (0 == use_init)
+	    {
+	      append_arg (FORTRAN_INIT);
+	      use_init = 1;
+	    }
+	  append_arg (library);
+	case 1:
+	 if (need_math)
+	   append_arg (MATH_LIBRARY);
+	default:
+	  break;
+	}
+    }
+
+#ifdef ENABLE_SHARED_LIBGCC
+  if (library)
+    {
+      int i;
+
+      for (i = 1; i < g77_newargc; i++)
+	if (g77_newargv[i][0] == '-')
+	  if (strcmp (g77_newargv[i], "-static-libgcc") == 0
+	      || strcmp (g77_newargv[i], "-static") == 0)
+	    break;
+    
+      if (i == g77_newargc)
+	append_arg ("-shared-libgcc");
+    }
+  
+#endif
+
+  if (verbose
+      && g77_newargv != g77_xargv)
+    {
+      fprintf (stderr, "Driving:");
+      for (i = 0; i < g77_newargc; i++)
+	fprintf (stderr, " %s", g77_newargv[i]);
+      fprintf (stderr, "\n");
+    }
+
+  *in_argc = g77_newargc;
+  *in_argv = g77_newargv;
+}
+
+/* Called before linking.  Returns 0 on success and -1 on failure. */
+int lang_specific_pre_link (void)  /* Not used for F77. */
+{
+  return 0;
+}
+
+/* Number of extra output files that lang_specific_pre_link may generate. */
+int lang_specific_extra_outfiles = 0;  /* Not used for F77. */
+
+/* Table of language-specific spec functions.  */ 
+const struct spec_function lang_specific_spec_functions[] =
+{
+  { 0, 0 }
+};
diff --git a/gcc/f/global.c b/gcc/f/global.c
new file mode 100644
index 00000000000..8793f62c4a7
--- /dev/null
+++ b/gcc/f/global.c
@@ -0,0 +1,1586 @@
+/* global.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 1997, 2003 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Related Modules:
+
+   Description:
+      Manages information kept across individual program units within a single
+      source file.  This includes reporting errors when a name is defined
+      multiple times (for example, two program units named FOO) and when a
+      COMMON block is given initial data in more than one program unit.
+
+   Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "global.h"
+#include "info.h"
+#include "lex.h"
+#include "malloc.h"
+#include "name.h"
+#include "symbol.h"
+#include "top.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+#if FFEGLOBAL_ENABLED
+static ffenameSpace ffeglobal_filewide_ = NULL;
+static const char *const ffeglobal_type_string_[] =
+{
+  [FFEGLOBAL_typeNONE] = "??",
+  [FFEGLOBAL_typeMAIN] = "main program",
+  [FFEGLOBAL_typeEXT] = "external",
+  [FFEGLOBAL_typeSUBR] = "subroutine",
+  [FFEGLOBAL_typeFUNC] = "function",
+  [FFEGLOBAL_typeBDATA] = "block data",
+  [FFEGLOBAL_typeCOMMON] = "common block",
+  [FFEGLOBAL_typeANY] = "?any?"
+};
+#endif
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+
+/* Call given fn with all globals
+
+   ffeglobal (*fn)(ffeglobal g);
+   ffeglobal_drive(fn);	 */
+
+#if FFEGLOBAL_ENABLED
+void
+ffeglobal_drive (ffeglobal (*fn) (ffeglobal))
+{
+  if (ffeglobal_filewide_ != NULL)
+    ffename_space_drive_global (ffeglobal_filewide_, fn);
+}
+
+#endif
+/* ffeglobal_new_ -- Make new global
+
+   ffename n;
+   ffeglobal g;
+   g = ffeglobal_new_(n);  */
+
+#if FFEGLOBAL_ENABLED
+static ffeglobal
+ffeglobal_new_ (ffename n)
+{
+  ffeglobal g;
+
+  assert (n != NULL);
+
+  g = malloc_new_ks (malloc_pool_image (), "FFEGLOBAL", sizeof (*g));
+  g->n = n;
+  g->hook = FFECOM_globalNULL;
+  g->tick = 0;
+
+  ffename_set_global (n, g);
+
+  return g;
+}
+
+#endif
+/* ffeglobal_init_1 -- Initialize per file
+
+   ffeglobal_init_1();	*/
+
+void
+ffeglobal_init_1 (void)
+{
+#if FFEGLOBAL_ENABLED
+  if (ffeglobal_filewide_ != NULL)
+    ffename_space_kill (ffeglobal_filewide_);
+  ffeglobal_filewide_ = ffename_space_new (malloc_pool_image ());
+#endif
+}
+
+/* ffeglobal_init_common -- Initial value specified for common block
+
+   ffesymbol s;	 // the ffesymbol for the common block
+   ffelexToken t;  // the token with the point of initialization
+   ffeglobal_init_common(s,t);
+
+   For back ends where file-wide global symbols are not maintained, does
+   nothing.  Otherwise, makes sure this common block hasn't already been
+   initialized in a previous program unit, and flag that it's been
+   initialized in this one.  */
+
+void
+ffeglobal_init_common (ffesymbol s, ffelexToken t)
+{
+#if FFEGLOBAL_ENABLED
+  ffeglobal g;
+
+  g = ffesymbol_global (s);
+
+  if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
+    return;
+  if (g->type == FFEGLOBAL_typeANY)
+    return;
+
+  if (g->tick == ffe_count_2)
+    return;
+
+  if (g->tick != 0)
+    {
+      if (g->u.common.initt != NULL)
+	{
+	  ffebad_start (FFEBAD_COMMON_ALREADY_INIT);
+	  ffebad_string (ffesymbol_text (s));
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (g->u.common.initt),
+		       ffelex_token_where_column (g->u.common.initt));
+	  ffebad_finish ();
+	}
+
+      /* Complain about just one attempt to reinit per program unit, but
+	 continue referring back to the first such successful attempt.  */
+    }
+  else
+    {
+      if (g->u.common.blank)
+	{
+	  /* Not supposed to initialize blank common, though it works.  */
+	  ffebad_start (FFEBAD_COMMON_BLANK_INIT);
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_finish ();
+	}
+
+      g->u.common.initt = ffelex_token_use (t);
+    }
+
+  g->tick = ffe_count_2;
+#endif
+}
+
+/* ffeglobal_new_common -- New common block
+
+   ffesymbol s;	 // the ffesymbol for the new common block
+   ffelexToken t;  // the token with the name of the common block
+   bool blank;	// TRUE if blank common
+   ffeglobal_new_common(s,t,blank);
+
+   For back ends where file-wide global symbols are not maintained, does
+   nothing.  Otherwise, makes sure this symbol hasn't been seen before or
+   is known as a common block.	*/
+
+void
+ffeglobal_new_common (ffesymbol s, ffelexToken t, bool blank)
+{
+#if FFEGLOBAL_ENABLED
+  ffename n;
+  ffeglobal g;
+
+  if (ffesymbol_global (s) == NULL)
+    {
+      n = ffename_find (ffeglobal_filewide_, t);
+      g = ffename_global (n);
+    }
+  else
+    {
+      g = ffesymbol_global (s);
+      n = NULL;
+    }
+
+  if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
+    return;
+
+  if ((g != NULL) && (g->type != FFEGLOBAL_typeNONE))
+    {
+      if (g->type == FFEGLOBAL_typeCOMMON)
+	{
+	  /* The names match, so the "blankness" should match too!  */
+	  assert (g->u.common.blank == blank);
+	}
+      else
+	{
+	  /* This global name has already been established,
+	     but as something other than a common block.  */
+	  if (ffe_is_globals () || ffe_is_warn_globals ())
+	    {
+	      ffebad_start (ffe_is_globals ()
+			    ? FFEBAD_FILEWIDE_ALREADY_SEEN
+			    : FFEBAD_FILEWIDE_ALREADY_SEEN_W);
+	      ffebad_string (ffelex_token_text (t));
+	      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	      ffebad_here (1, ffelex_token_where_line (g->t),
+			   ffelex_token_where_column (g->t));
+	      ffebad_finish ();
+	    }
+	  g->type = FFEGLOBAL_typeANY;
+	}
+    }
+  else
+    {
+      if (g == NULL)
+	{
+	  g = ffeglobal_new_ (n);
+	  g->intrinsic = FALSE;
+	}
+      else if (g->intrinsic
+	       && !g->explicit_intrinsic
+	       && ffe_is_warn_globals ())
+	{
+	  /* Common name previously used as intrinsic.  Though it works,
+	     warn, because the intrinsic reference might have been intended
+	     as a ref to an external procedure, but g77's vast list of
+	     intrinsics happened to snarf the name.  */
+	  ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
+	  ffebad_string (ffelex_token_text (t));
+	  ffebad_string ("common block");
+	  ffebad_string ("intrinsic");
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (g->t),
+		       ffelex_token_where_column (g->t));
+	  ffebad_finish ();
+	}
+      g->t = ffelex_token_use (t);
+      g->type = FFEGLOBAL_typeCOMMON;
+      g->u.common.have_pad = FALSE;
+      g->u.common.have_save = FALSE;
+      g->u.common.have_size = FALSE;
+      g->u.common.blank = blank;
+    }
+
+  ffesymbol_set_global (s, g);
+#endif
+}
+
+/* ffeglobal_new_progunit_ -- New program unit
+
+   ffesymbol s;	 // the ffesymbol for the new unit
+   ffelexToken t;  // the token with the name of the unit
+   ffeglobalType type;	// the type of the new unit
+   ffeglobal_new_progunit_(s,t,type);
+
+   For back ends where file-wide global symbols are not maintained, does
+   nothing.  Otherwise, makes sure this symbol hasn't been seen before.	 */
+
+void
+ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
+{
+#if FFEGLOBAL_ENABLED
+  ffename n;
+  ffeglobal g;
+
+  n = ffename_find (ffeglobal_filewide_, t);
+  g = ffename_global (n);
+  if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
+    return;
+
+  if ((g != NULL)
+      && ((g->type == FFEGLOBAL_typeMAIN)
+	  || (g->type == FFEGLOBAL_typeSUBR)
+	  || (g->type == FFEGLOBAL_typeFUNC)
+	  || (g->type == FFEGLOBAL_typeBDATA))
+      && g->u.proc.defined)
+    {
+      /* This program unit has already been defined.  */
+      if (ffe_is_globals () || ffe_is_warn_globals ())
+	{
+	  ffebad_start (ffe_is_globals ()
+			? FFEBAD_FILEWIDE_ALREADY_SEEN
+			: FFEBAD_FILEWIDE_ALREADY_SEEN_W);
+	  ffebad_string (ffelex_token_text (t));
+	  ffebad_here (0, ffelex_token_where_line (t),
+		       ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (g->t),
+		       ffelex_token_where_column (g->t));
+	  ffebad_finish ();
+	}
+      g->type = FFEGLOBAL_typeANY;
+    }
+  else if ((g != NULL)
+	   && (g->type != FFEGLOBAL_typeNONE)
+	   && (g->type != FFEGLOBAL_typeEXT)
+	   && (g->type != type))
+    {
+      /* A reference to this program unit has been seen, but its
+	 context disagrees about the new definition regarding
+	 what kind of program unit it is.  (E.g. `call foo' followed
+	 by `function foo'.)  But `external foo' alone doesn't mean
+	 disagreement with either a function or subroutine, though
+	 g77 normally interprets it as a request to force-load
+	 a block data program unit by that name (to cope with libs).  */
+      if (ffe_is_globals () || ffe_is_warn_globals ())
+	{
+	  ffebad_start (ffe_is_globals ()
+			? FFEBAD_FILEWIDE_DISAGREEMENT
+			: FFEBAD_FILEWIDE_DISAGREEMENT_W);
+	  ffebad_string (ffelex_token_text (t));
+	  ffebad_string (ffeglobal_type_string_[type]);
+	  ffebad_string (ffeglobal_type_string_[g->type]);
+	  ffebad_here (0, ffelex_token_where_line (t),
+		       ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (g->t),
+		       ffelex_token_where_column (g->t));
+	  ffebad_finish ();
+	}
+      g->type = FFEGLOBAL_typeANY;
+    }
+  else
+    {
+      if (g == NULL)
+	{
+	  g = ffeglobal_new_ (n);
+	  g->intrinsic = FALSE;
+	  g->u.proc.n_args = -1;
+	  g->u.proc.other_t = NULL;
+	}
+      else if ((ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
+	       && (g->type == FFEGLOBAL_typeFUNC)
+	       && ((ffesymbol_basictype (s) != g->u.proc.bt)
+		   || (ffesymbol_kindtype (s) != g->u.proc.kt)
+		   || ((ffesymbol_size (s) != FFETARGET_charactersizeNONE)
+		       && (ffesymbol_size (s) != g->u.proc.sz))))
+	{
+	  /* The previous reference and this new function definition
+	     disagree about the type of the function.  I (Burley) think
+	     this rarely occurs, because when this code is reached,
+	     the type info doesn't appear to be filled in yet.  */
+	  if (ffe_is_globals () || ffe_is_warn_globals ())
+	    {
+	      ffebad_start (ffe_is_globals ()
+			    ? FFEBAD_FILEWIDE_TYPE_MISMATCH
+			    : FFEBAD_FILEWIDE_TYPE_MISMATCH_W);
+	      ffebad_string (ffelex_token_text (t));
+	      ffebad_here (0, ffelex_token_where_line (t),
+			   ffelex_token_where_column (t));
+	      ffebad_here (1, ffelex_token_where_line (g->t),
+			   ffelex_token_where_column (g->t));
+	      ffebad_finish ();
+	    }
+	  g->type = FFEGLOBAL_typeANY;
+	  return;
+	}
+      if (g->intrinsic
+	  && !g->explicit_intrinsic
+	  && ffe_is_warn_globals ())
+	{
+	  /* This name, previously used as an intrinsic, now is known
+	     to also be a global procedure name.  Warn, since the previous
+	     use as an intrinsic might have been intended to refer to
+	     this procedure.  */
+	  ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
+	  ffebad_string (ffelex_token_text (t));
+	  ffebad_string ("global");
+	  ffebad_string ("intrinsic");
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (g->t),
+		       ffelex_token_where_column (g->t));
+	  ffebad_finish ();
+	}
+      g->t = ffelex_token_use (t);
+      if ((g->tick == 0)
+	  || (g->u.proc.bt == FFEINFO_basictypeNONE)
+	  || (g->u.proc.kt == FFEINFO_kindtypeNONE))
+	{
+	  g->u.proc.bt = ffesymbol_basictype (s);
+	  g->u.proc.kt = ffesymbol_kindtype (s);
+	  g->u.proc.sz = ffesymbol_size (s);
+	}
+      /* If there's a known disagreement about the kind of program
+	 unit, then don't even bother tracking arglist argreement.  */
+      if ((g->tick != 0)
+	  && (g->type != type))
+	g->u.proc.n_args = -1;
+      g->tick = ffe_count_2;
+      g->type = type;
+      g->u.proc.defined = TRUE;
+    }
+
+  ffesymbol_set_global (s, g);
+#endif
+}
+
+/* ffeglobal_pad_common -- Check initial padding of common area
+
+   ffesymbol s;	 // the common area
+   ffetargetAlign pad;	// the initial padding
+   ffeglobal_pad_common(s,pad,ffesymbol_where_line(s),
+	 ffesymbol_where_column(s));
+
+   In global-enabled mode, make sure the padding agrees with any existing
+   padding established for the common area, otherwise complain.
+   In global-disabled mode, warn about nonzero padding.	 */
+
+void
+ffeglobal_pad_common (ffesymbol s, ffetargetAlign pad, ffewhereLine wl,
+		      ffewhereColumn wc)
+{
+#if FFEGLOBAL_ENABLED
+  ffeglobal g;
+
+  g = ffesymbol_global (s);
+  if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
+    return;			/* Let someone else catch this! */
+  if (g->type == FFEGLOBAL_typeANY)
+    return;
+
+  if (!g->u.common.have_pad)
+    {
+      g->u.common.have_pad = TRUE;
+      g->u.common.pad = pad;
+      g->u.common.pad_where_line = ffewhere_line_use (wl);
+      g->u.common.pad_where_col = ffewhere_column_use (wc);
+
+      if (pad != 0)
+	{
+	  char padding[20];
+
+	  sprintf (&padding[0], "%" ffetargetAlign_f "u", pad);
+	  ffebad_start (FFEBAD_COMMON_INIT_PAD);
+	  ffebad_string (ffesymbol_text (s));
+	  ffebad_string (padding);
+	  ffebad_string ((pad == 1)
+			 ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+	  ffebad_here (0, wl, wc);
+	  ffebad_finish ();
+	}
+    }
+  else
+    {
+      if (g->u.common.pad != pad)
+	{
+	  char padding_1[20];
+	  char padding_2[20];
+
+	  sprintf (&padding_1[0], "%" ffetargetAlign_f "u", pad);
+	  sprintf (&padding_2[0], "%" ffetargetAlign_f "u", g->u.common.pad);
+	  ffebad_start (FFEBAD_COMMON_DIFF_PAD);
+	  ffebad_string (ffesymbol_text (s));
+	  ffebad_string (padding_1);
+	  ffebad_here (0, wl, wc);
+	  ffebad_string (padding_2);
+	  ffebad_string ((pad == 1)
+			 ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+	  ffebad_string ((g->u.common.pad == 1)
+			 ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+	  ffebad_here (1, g->u.common.pad_where_line, g->u.common.pad_where_col);
+	  ffebad_finish ();
+	}
+
+      if (g->u.common.pad < pad)
+	{
+	  g->u.common.pad = pad;
+	  g->u.common.pad_where_line = ffewhere_line_use (wl);
+	  g->u.common.pad_where_col = ffewhere_column_use (wc);
+	}
+    }
+#endif
+}
+
+/* Collect info for a global's argument.  */
+
+void
+ffeglobal_proc_def_arg (ffesymbol s, int argno, const char *name, ffeglobalArgSummary as,
+			ffeinfoBasictype bt, ffeinfoKindtype kt,
+			bool array)
+{
+  ffeglobal g = ffesymbol_global (s);
+  ffeglobalArgInfo_ ai;
+
+  assert (g != NULL);
+
+  if (g->type == FFEGLOBAL_typeANY)
+    return;
+
+  assert (g->u.proc.n_args >= 0);
+
+  if (argno >= g->u.proc.n_args)
+    return;	/* Already complained about this discrepancy. */
+
+  ai = &g->u.proc.arg_info[argno];
+
+  /* Maybe warn about previous references.  */
+
+  if ((ai->t != NULL)
+      && ffe_is_warn_globals ())
+    {
+      const char *refwhy = NULL;
+      const char *defwhy = NULL;
+      bool warn = FALSE;
+
+      switch (as)
+	{
+	case FFEGLOBAL_argsummaryREF:
+	  if ((ai->as != FFEGLOBAL_argsummaryREF)
+	      && (ai->as != FFEGLOBAL_argsummaryNONE)
+	      && ((ai->as != FFEGLOBAL_argsummaryDESCR)	/* Choose better message. */
+		  || (ai->bt != FFEINFO_basictypeCHARACTER)
+		  || (ai->bt == bt)))
+	    {
+	      warn = TRUE;
+	      refwhy = "passed by reference";
+	    }
+	  break;
+
+	case FFEGLOBAL_argsummaryDESCR:
+	  if ((ai->as != FFEGLOBAL_argsummaryDESCR)
+	      && (ai->as != FFEGLOBAL_argsummaryNONE)
+	      && ((ai->as != FFEGLOBAL_argsummaryREF)	/* Choose better message. */
+		  || (bt != FFEINFO_basictypeCHARACTER)
+		  || (ai->bt == bt)))
+	    {
+	      warn = TRUE;
+	      refwhy = "passed by descriptor";
+	    }
+	  break;
+
+	case FFEGLOBAL_argsummaryPROC:
+	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
+	      && (ai->as != FFEGLOBAL_argsummarySUBR)
+	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
+	      && (ai->as != FFEGLOBAL_argsummaryNONE))
+	    {
+	      warn = TRUE;
+	      refwhy = "a procedure";
+	    }
+	  break;
+
+	case FFEGLOBAL_argsummarySUBR:
+	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
+	      && (ai->as != FFEGLOBAL_argsummarySUBR)
+	      && (ai->as != FFEGLOBAL_argsummaryNONE))
+	    {
+	      warn = TRUE;
+	      refwhy = "a subroutine";
+	    }
+	  break;
+
+	case FFEGLOBAL_argsummaryFUNC:
+	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
+	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
+	      && (ai->as != FFEGLOBAL_argsummaryNONE))
+	    {
+	      warn = TRUE;
+	      refwhy = "a function";
+	    }
+	  break;
+
+	case FFEGLOBAL_argsummaryALTRTN:
+	  if ((ai->as != FFEGLOBAL_argsummaryALTRTN)
+	      && (ai->as != FFEGLOBAL_argsummaryNONE))
+	    {
+	      warn = TRUE;
+	      refwhy = "an alternate-return label";
+	    }
+	  break;
+
+	default:
+	  break;
+	}
+
+      if ((refwhy != NULL) && (defwhy == NULL))
+	{
+	  /* Fill in the def info.  */
+
+	  switch (ai->as)
+	    {
+	    case FFEGLOBAL_argsummaryNONE:
+	      defwhy = "omitted";
+	      break;
+
+	    case FFEGLOBAL_argsummaryVAL:
+	      defwhy = "passed by value";
+	      break;
+
+	    case FFEGLOBAL_argsummaryREF:
+	      defwhy = "passed by reference";
+	      break;
+
+	    case FFEGLOBAL_argsummaryDESCR:
+	      defwhy = "passed by descriptor";
+	      break;
+
+	    case FFEGLOBAL_argsummaryPROC:
+	      defwhy = "a procedure";
+	      break;
+
+	    case FFEGLOBAL_argsummarySUBR:
+	      defwhy = "a subroutine";
+	      break;
+
+	    case FFEGLOBAL_argsummaryFUNC:
+	      defwhy = "a function";
+	      break;
+
+	    case FFEGLOBAL_argsummaryALTRTN:
+	      defwhy = "an alternate-return label";
+	      break;
+
+#if 0
+	    case FFEGLOBAL_argsummaryPTR:
+	      defwhy = "a pointer";
+	      break;
+#endif
+
+	    default:
+	      defwhy = "???";
+	      break;
+	    }
+	}
+
+      if (!warn
+	  && (bt != FFEINFO_basictypeHOLLERITH)
+	  && (bt != FFEINFO_basictypeTYPELESS)
+	  && (bt != FFEINFO_basictypeNONE)
+	  && (ai->bt != FFEINFO_basictypeHOLLERITH)
+	  && (ai->bt != FFEINFO_basictypeTYPELESS)
+	  && (ai->bt != FFEINFO_basictypeNONE))
+	{
+	  /* Check types.  */
+
+	  if ((bt != ai->bt)
+	      && ((bt != FFEINFO_basictypeREAL)
+		  || (ai->bt != FFEINFO_basictypeCOMPLEX))
+	      && ((bt != FFEINFO_basictypeCOMPLEX)
+		  || (ai->bt != FFEINFO_basictypeREAL)))
+	    {
+	      warn = TRUE;	/* We can cope with these differences. */
+	      refwhy = "one type";
+	      defwhy = "some other type";
+	    }
+
+	  if (!warn && (kt != ai->kt))
+	    {
+	      warn = TRUE;
+	      refwhy = "one precision";
+	      defwhy = "some other precision";
+	    }
+	}
+
+      if (warn)
+	{
+	  char num[60];
+
+	  if (name == NULL)
+	    sprintf (&num[0], "%d", argno + 1);
+	  else
+	    {
+	      if (strlen (name) < 30)
+		sprintf (&num[0], "%d (named `%s')", argno + 1, name);
+	      else
+		sprintf (&num[0], "%d (named `%.*s...')", argno + 1, 30, name);
+	    }
+	  ffebad_start (FFEBAD_FILEWIDE_ARG_W);
+	  ffebad_string (ffesymbol_text (s));
+	  ffebad_string (num);
+	  ffebad_string (refwhy);
+	  ffebad_string (defwhy);
+	  ffebad_here (0, ffelex_token_where_line (g->t), ffelex_token_where_column (g->t));
+	  ffebad_here (1, ffelex_token_where_line (ai->t), ffelex_token_where_column (ai->t));
+	  ffebad_finish ();
+	}
+    }
+
+  /* Define this argument.  */
+
+  if (ai->t != NULL)
+    ffelex_token_kill (ai->t);
+  if ((as != FFEGLOBAL_argsummaryPROC)
+      || (ai->t == NULL))
+    ai->as = as;	/* Otherwise leave SUBR/FUNC info intact. */
+  ai->t = ffelex_token_use (g->t);
+  if (name == NULL)
+    ai->name = NULL;
+  else
+    {
+      ai->name = malloc_new_ks (malloc_pool_image (),
+				"ffeglobalArgInfo_ name",
+				strlen (name) + 1);
+      strcpy (ai->name, name);
+    }
+  ai->bt = bt;
+  ai->kt = kt;
+  ai->array = array;
+}
+
+/* Collect info on #args a global accepts.  */
+
+void
+ffeglobal_proc_def_nargs (ffesymbol s, int n_args)
+{
+  ffeglobal g = ffesymbol_global (s);
+
+  assert (g != NULL);
+
+  if (g->type == FFEGLOBAL_typeANY)
+    return;
+
+  if (g->u.proc.n_args >= 0)
+    {
+      if (g->u.proc.n_args == n_args)
+	return;
+
+      if (ffe_is_warn_globals ())
+	{
+	  ffebad_start (FFEBAD_FILEWIDE_NARGS_W);
+	  ffebad_string (ffesymbol_text (s));
+	  if (g->u.proc.n_args > n_args)
+	    ffebad_string ("few");
+	  else
+	    ffebad_string ("many");
+	  ffebad_here (0, ffelex_token_where_line (g->u.proc.other_t),
+		       ffelex_token_where_column (g->u.proc.other_t));
+	  ffebad_here (1, ffelex_token_where_line (g->t),
+		       ffelex_token_where_column (g->t));
+	  ffebad_finish ();
+	}
+    }
+
+  /* This is new info we can use in cross-checking future references
+     and a possible future definition.  */
+
+  g->u.proc.n_args = n_args;
+  g->u.proc.other_t = NULL;	/* No other reference yet. */
+
+  if (n_args == 0)
+    {
+      g->u.proc.arg_info = NULL;
+      return;
+    }
+
+  g->u.proc.arg_info = malloc_new_ks (malloc_pool_image (),
+				      "ffeglobalArgInfo_",
+				      n_args * sizeof (g->u.proc.arg_info[0]));
+  while (n_args-- > 0)
+    g->u.proc.arg_info[n_args].t = NULL;
+}
+
+/* Verify that the info for a global's argument is valid.  */
+
+bool
+ffeglobal_proc_ref_arg (ffesymbol s, int argno, ffeglobalArgSummary as,
+			ffeinfoBasictype bt, ffeinfoKindtype kt,
+			bool array, ffelexToken t)
+{
+  ffeglobal g = ffesymbol_global (s);
+  ffeglobalArgInfo_ ai;
+
+  assert (g != NULL);
+
+  if (g->type == FFEGLOBAL_typeANY)
+    return FALSE;
+
+  assert (g->u.proc.n_args >= 0);
+
+  if (argno >= g->u.proc.n_args)
+    return TRUE;	/* Already complained about this discrepancy. */
+
+  ai = &g->u.proc.arg_info[argno];
+
+  /* Warn about previous references.  */
+
+  if (ai->t != NULL)
+    {
+      const char *refwhy = NULL;
+      const char *defwhy = NULL;
+      bool fail = FALSE;
+      bool warn = FALSE;
+
+      switch (as)
+	{
+	case FFEGLOBAL_argsummaryNONE:
+	  if (g->u.proc.defined)
+	    {
+	      fail = TRUE;
+	      refwhy = "omitted";
+	      defwhy = "not optional";
+	    }
+	  break;
+
+	case FFEGLOBAL_argsummaryVAL:
+	  if (ai->as != FFEGLOBAL_argsummaryVAL)
+	    {
+	      fail = TRUE;
+	      refwhy = "passed by value";
+	    }
+	  break;
+
+	case FFEGLOBAL_argsummaryREF:
+	  if ((ai->as != FFEGLOBAL_argsummaryREF)
+	      && (ai->as != FFEGLOBAL_argsummaryNONE)
+	      && ((ai->as != FFEGLOBAL_argsummaryDESCR)	/* Choose better message. */
+		  || (ai->bt != FFEINFO_basictypeCHARACTER)
+		  || (ai->bt == bt)))
+	    {
+	      fail = TRUE;
+	      refwhy = "passed by reference";
+	    }
+	  break;
+
+	case FFEGLOBAL_argsummaryDESCR:
+	  if ((ai->as != FFEGLOBAL_argsummaryDESCR)
+	      && (ai->as != FFEGLOBAL_argsummaryNONE)
+	      && ((ai->as != FFEGLOBAL_argsummaryREF)	/* Choose better message. */
+		  || (bt != FFEINFO_basictypeCHARACTER)
+		  || (ai->bt == bt)))
+	    {
+	      fail = TRUE;
+	      refwhy = "passed by descriptor";
+	    }
+	  break;
+
+	case FFEGLOBAL_argsummaryPROC:
+	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
+	      && (ai->as != FFEGLOBAL_argsummarySUBR)
+	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
+	      && (ai->as != FFEGLOBAL_argsummaryNONE))
+	    {
+	      fail = TRUE;
+	      refwhy = "a procedure";
+	    }
+	  break;
+
+	case FFEGLOBAL_argsummarySUBR:
+	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
+	      && (ai->as != FFEGLOBAL_argsummarySUBR)
+	      && (ai->as != FFEGLOBAL_argsummaryNONE))
+	    {
+	      fail = TRUE;
+	      refwhy = "a subroutine";
+	    }
+	  break;
+
+	case FFEGLOBAL_argsummaryFUNC:
+	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
+	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
+	      && (ai->as != FFEGLOBAL_argsummaryNONE))
+	    {
+	      fail = TRUE;
+	      refwhy = "a function";
+	    }
+	  break;
+
+	case FFEGLOBAL_argsummaryALTRTN:
+	  if ((ai->as != FFEGLOBAL_argsummaryALTRTN)
+	      && (ai->as != FFEGLOBAL_argsummaryNONE))
+	    {
+	      fail = TRUE;
+	      refwhy = "an alternate-return label";
+	    }
+	  break;
+
+#if 0
+	case FFEGLOBAL_argsummaryPTR:
+	  if ((ai->as != FFEGLOBAL_argsummaryPTR)
+	      && (ai->as != FFEGLOBAL_argsummaryNONE))
+	    {
+	      fail = TRUE;
+	      refwhy = "a pointer";
+	    }
+	  break;
+#endif
+
+	default:
+	  break;
+	}
+
+      if ((refwhy != NULL) && (defwhy == NULL))
+	{
+	  /* Fill in the def info.  */
+
+	  switch (ai->as)
+	    {
+	    case FFEGLOBAL_argsummaryNONE:
+	      defwhy = "omitted";
+	      break;
+
+	    case FFEGLOBAL_argsummaryVAL:
+	      defwhy = "passed by value";
+	      break;
+
+	    case FFEGLOBAL_argsummaryREF:
+	      defwhy = "passed by reference";
+	      break;
+
+	    case FFEGLOBAL_argsummaryDESCR:
+	      defwhy = "passed by descriptor";
+	      break;
+
+	    case FFEGLOBAL_argsummaryPROC:
+	      defwhy = "a procedure";
+	      break;
+
+	    case FFEGLOBAL_argsummarySUBR:
+	      defwhy = "a subroutine";
+	      break;
+
+	    case FFEGLOBAL_argsummaryFUNC:
+	      defwhy = "a function";
+	      break;
+
+	    case FFEGLOBAL_argsummaryALTRTN:
+	      defwhy = "an alternate-return label";
+	      break;
+
+#if 0
+	    case FFEGLOBAL_argsummaryPTR:
+	      defwhy = "a pointer";
+	      break;
+#endif
+
+	    default:
+	      defwhy = "???";
+	      break;
+	    }
+	}
+
+      if (!fail && !warn
+	  && (bt != FFEINFO_basictypeHOLLERITH)
+	  && (bt != FFEINFO_basictypeTYPELESS)
+	  && (bt != FFEINFO_basictypeNONE)
+	  && (ai->bt != FFEINFO_basictypeHOLLERITH)
+	  && (ai->bt != FFEINFO_basictypeNONE)
+	  && (ai->bt != FFEINFO_basictypeTYPELESS))
+	{
+	  /* Check types.  */
+
+	  if ((bt != ai->bt)
+	      && ((bt != FFEINFO_basictypeREAL)
+		  || (ai->bt != FFEINFO_basictypeCOMPLEX))
+	      && ((bt != FFEINFO_basictypeCOMPLEX)
+		  || (ai->bt != FFEINFO_basictypeREAL)))
+	    {
+	      if (((bt == FFEINFO_basictypeINTEGER)
+		   && (ai->bt == FFEINFO_basictypeLOGICAL))
+		  || ((bt == FFEINFO_basictypeLOGICAL)
+		   && (ai->bt == FFEINFO_basictypeINTEGER)))
+		warn = TRUE;	/* We can cope with these differences. */
+	      else
+		fail = TRUE;
+	      refwhy = "one type";
+	      defwhy = "some other type";
+	    }
+
+	  if (!fail && !warn && (kt != ai->kt))
+	    {
+	      fail = TRUE;
+	      refwhy = "one precision";
+	      defwhy = "some other precision";
+	    }
+	}
+
+      if (fail && ! g->u.proc.defined)
+	{
+	  /* No point failing if we're worried only about invocations.  */
+	  fail = FALSE;
+	  warn = TRUE;
+	}
+
+      if (fail && ! ffe_is_globals ())
+	{
+	  warn = TRUE;
+	  fail = FALSE;
+	}
+
+      if (fail || (warn && ffe_is_warn_globals ()))
+	{
+	  char num[60];
+
+	  if (ai->name == NULL)
+	    sprintf (&num[0], "%d", argno + 1);
+	  else
+	    {
+	      if (strlen (ai->name) < 30)
+		sprintf (&num[0], "%d (named `%s')", argno + 1, ai->name);
+	      else
+		sprintf (&num[0], "%d (named `%.*s...')", argno + 1, 30, ai->name);
+	    }
+	  ffebad_start (fail ? FFEBAD_FILEWIDE_ARG : FFEBAD_FILEWIDE_ARG_W);
+	  ffebad_string (ffesymbol_text (s));
+	  ffebad_string (num);
+	  ffebad_string (refwhy);
+	  ffebad_string (defwhy);
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (ai->t), ffelex_token_where_column (ai->t));
+	  ffebad_finish ();
+	  return (fail ? FALSE : TRUE);
+	}
+
+      if (warn)
+	return TRUE;
+    }
+
+  /* Define this argument.  */
+
+  if (ai->t != NULL)
+    ffelex_token_kill (ai->t);
+  if ((as != FFEGLOBAL_argsummaryPROC)
+      || (ai->t == NULL))
+    ai->as = as;
+  ai->t = ffelex_token_use (g->t);
+  ai->name = NULL;
+  ai->bt = bt;
+  ai->kt = kt;
+  ai->array = array;
+  return TRUE;
+}
+
+bool
+ffeglobal_proc_ref_nargs (ffesymbol s, int n_args, ffelexToken t)
+{
+  ffeglobal g = ffesymbol_global (s);
+
+  assert (g != NULL);
+
+  if (g->type == FFEGLOBAL_typeANY)
+    return FALSE;
+
+  if (g->u.proc.n_args >= 0)
+    {
+      if (g->u.proc.n_args == n_args)
+	return TRUE;
+
+      if (g->u.proc.defined && ffe_is_globals ())
+	{
+	  ffebad_start (FFEBAD_FILEWIDE_NARGS);
+	  ffebad_string (ffesymbol_text (s));
+	  if (g->u.proc.n_args > n_args)
+	    ffebad_string ("few");
+	  else
+	    ffebad_string ("many");
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (g->t),
+		       ffelex_token_where_column (g->t));
+	  ffebad_finish ();
+	  return FALSE;
+	}
+
+      if (ffe_is_warn_globals ())
+	{
+	  ffebad_start (FFEBAD_FILEWIDE_NARGS_W);
+	  ffebad_string (ffesymbol_text (s));
+	  if (g->u.proc.n_args > n_args)
+	    ffebad_string ("few");
+	  else
+	    ffebad_string ("many");
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (g->t),
+		       ffelex_token_where_column (g->t));
+	  ffebad_finish ();
+	}
+
+      return TRUE;		/* Don't replace the info we already have. */
+    }
+
+  /* This is new info we can use in cross-checking future references
+     and a possible future definition.  */
+
+  g->u.proc.n_args = n_args;
+  g->u.proc.other_t = ffelex_token_use (t);
+
+  /* Make this "the" place we found the global, since it has the most info.  */
+
+  if (g->t != NULL)
+    ffelex_token_kill (g->t);
+  g->t = ffelex_token_use (t);
+
+  if (n_args == 0)
+    {
+      g->u.proc.arg_info = NULL;
+      return TRUE;
+    }
+
+  g->u.proc.arg_info = malloc_new_ks (malloc_pool_image (),
+				      "ffeglobalArgInfo_",
+				      n_args * sizeof (g->u.proc.arg_info[0]));
+  while (n_args-- > 0)
+    g->u.proc.arg_info[n_args].t = NULL;
+
+  return TRUE;
+}
+
+/* Return a global for a promoted symbol (one that has heretofore
+   been assumed to be local, but since discovered to be global).  */
+
+ffeglobal
+ffeglobal_promoted (ffesymbol s)
+{
+#if FFEGLOBAL_ENABLED
+  ffename n;
+  ffeglobal g;
+
+  assert (ffesymbol_global (s) == NULL);
+
+  n = ffename_find (ffeglobal_filewide_, ffename_token (ffesymbol_name (s)));
+  g = ffename_global (n);
+
+  return g;
+#else
+  return NULL;
+#endif
+}
+
+/* Register a reference to an intrinsic.  Such a reference is always
+   valid, though a warning might be in order if the same name has
+   already been used for a global.  */
+
+void
+ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit)
+{
+#if FFEGLOBAL_ENABLED
+  ffename n;
+  ffeglobal g;
+
+  if (ffesymbol_global (s) == NULL)
+    {
+      n = ffename_find (ffeglobal_filewide_, t);
+      g = ffename_global (n);
+    }
+  else
+    {
+      g = ffesymbol_global (s);
+      n = NULL;
+    }
+
+  if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
+    return;
+
+  if ((g != NULL) && (g->type != FFEGLOBAL_typeNONE))
+    {
+      if (! explicit
+	  && ! g->intrinsic
+	  && ffe_is_warn_globals ())
+	{
+	  /* This name, previously used as a global, now is used
+	     for an intrinsic.  Warn, since this new use as an
+	     intrinsic might have been intended to refer to
+	     the global procedure.  */
+	  ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
+	  ffebad_string (ffelex_token_text (t));
+	  ffebad_string ("intrinsic");
+	  ffebad_string ("global");
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (g->t),
+		       ffelex_token_where_column (g->t));
+	  ffebad_finish ();
+	}
+    }
+  else
+    {
+      if (g == NULL)
+	{
+	  g = ffeglobal_new_ (n);
+	  g->tick = ffe_count_2;
+	  g->type = FFEGLOBAL_typeNONE;
+	  g->intrinsic = TRUE;
+	  g->explicit_intrinsic = explicit;
+	  g->t = ffelex_token_use (t);
+	}
+      else if (g->intrinsic
+	       && (explicit != g->explicit_intrinsic)
+	       && (g->tick != ffe_count_2)
+	       && ffe_is_warn_globals ())
+	{
+	  /* An earlier reference to this intrinsic disagrees with
+	     this reference vis-a-vis explicit `intrinsic foo',
+	     which suggests that the one relying on implicit
+	     intrinsicacity might have actually intended to refer
+	     to a global of the same name.  */
+	  ffebad_start (FFEBAD_INTRINSIC_EXPIMP);
+	  ffebad_string (ffelex_token_text (t));
+	  ffebad_string (explicit ? "explicit" : "implicit");
+	  ffebad_string (explicit ? "implicit" : "explicit");
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (g->t),
+		       ffelex_token_where_column (g->t));
+	  ffebad_finish ();
+	}
+    }
+
+  g->intrinsic = TRUE;
+  if (explicit)
+    g->explicit_intrinsic = TRUE;
+
+  ffesymbol_set_global (s, g);
+#endif
+}
+
+/* Register a reference to a global.  Returns TRUE if the reference
+   is valid.  */
+
+bool
+ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
+{
+#if FFEGLOBAL_ENABLED
+  ffename n = NULL;
+  ffeglobal g;
+
+  /* It is never really _known_ that an EXTERNAL statement
+     names a BLOCK DATA by just looking at the program unit,
+     so override a different notion here.  */
+  if (type == FFEGLOBAL_typeBDATA)
+    type = FFEGLOBAL_typeEXT;
+
+  g = ffesymbol_global (s);
+  if (g == NULL)
+    {
+      n = ffename_find (ffeglobal_filewide_, t);
+      g = ffename_global (n);
+      if (g != NULL)
+	ffesymbol_set_global (s, g);
+    }
+
+  if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
+    return TRUE;
+
+  if ((g != NULL)
+      && (g->type != FFEGLOBAL_typeNONE)
+      && (g->type != FFEGLOBAL_typeEXT)
+      && (g->type != type)
+      && (type != FFEGLOBAL_typeEXT))
+    {
+      /* Disagreement about (fully refined) class of program unit
+	 (main, subroutine, function, block data).  Treat EXTERNAL/
+	 COMMON disagreements distinctly.  */
+      if ((((type == FFEGLOBAL_typeBDATA)
+	    && (g->type != FFEGLOBAL_typeCOMMON))
+	   || ((g->type == FFEGLOBAL_typeBDATA)
+	       && (type != FFEGLOBAL_typeCOMMON)
+	       && ! g->u.proc.defined)))
+	{
+#if 0	/* This is likely to just annoy people. */
+	  if (ffe_is_warn_globals ())
+	    {
+	      /* Warn about EXTERNAL of a COMMON name, though it works.  */
+	      ffebad_start (FFEBAD_FILEWIDE_TIFF);
+	      ffebad_string (ffelex_token_text (t));
+	      ffebad_string (ffeglobal_type_string_[type]);
+	      ffebad_string (ffeglobal_type_string_[g->type]);
+	      ffebad_here (0, ffelex_token_where_line (t),
+			   ffelex_token_where_column (t));
+	      ffebad_here (1, ffelex_token_where_line (g->t),
+			   ffelex_token_where_column (g->t));
+	      ffebad_finish ();
+	    }
+#endif
+	}
+      else if (ffe_is_globals () || ffe_is_warn_globals ())
+	{
+	  ffebad_start (ffe_is_globals ()
+			? FFEBAD_FILEWIDE_DISAGREEMENT
+			: FFEBAD_FILEWIDE_DISAGREEMENT_W);
+	  ffebad_string (ffelex_token_text (t));
+	  ffebad_string (ffeglobal_type_string_[type]);
+	  ffebad_string (ffeglobal_type_string_[g->type]);
+	  ffebad_here (0, ffelex_token_where_line (t),
+		       ffelex_token_where_column (t));
+	  ffebad_here (1, ffelex_token_where_line (g->t),
+		       ffelex_token_where_column (g->t));
+	  ffebad_finish ();
+	  g->type = FFEGLOBAL_typeANY;
+	  return (! ffe_is_globals ());
+	}
+    }
+
+  if ((g != NULL)
+      && (type == FFEGLOBAL_typeFUNC))
+    {
+      /* If just filling in this function's type, do so.  */
+      if ((g->tick == ffe_count_2)
+	  && (ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
+	  && (ffesymbol_kindtype (s) != FFEINFO_kindtypeNONE))
+	{
+	  g->u.proc.bt = ffesymbol_basictype (s);
+	  g->u.proc.kt = ffesymbol_kindtype (s);
+	  g->u.proc.sz = ffesymbol_size (s);
+	}
+      /* Make sure there is type agreement.  */
+      if (g->type == FFEGLOBAL_typeFUNC
+	  && g->u.proc.bt != FFEINFO_basictypeNONE
+	  && ffesymbol_basictype (s) != FFEINFO_basictypeNONE
+	  && (ffesymbol_basictype (s) != g->u.proc.bt
+	      || ffesymbol_kindtype (s) != g->u.proc.kt
+	      /* CHARACTER*n disagreements matter only once a
+		 definition is involved, since the definition might
+		 be CHARACTER*(*), which accepts all references.  */
+	      || (g->u.proc.defined
+		  && ffesymbol_size (s) != g->u.proc.sz
+		  && ffesymbol_size (s) != FFETARGET_charactersizeNONE
+		  && g->u.proc.sz != FFETARGET_charactersizeNONE)))
+	{
+	  int error;
+
+	  /* Type mismatch between function reference/definition and
+	     this subsequent reference (which might just be the filling-in
+	     of type info for the definition, but we can't reach here
+	     if that's the case and there was a previous definition).
+
+	     It's an error given a previous definition, since that
+	     implies inlining can crash the compiler, unless the user
+	     asked for no such inlining.  */
+	  error = (g->tick != ffe_count_2
+		   && g->u.proc.defined
+		   && ffe_is_globals ());
+	  if (error || ffe_is_warn_globals ())
+	    {
+	      ffebad_start (error
+			    ? FFEBAD_FILEWIDE_TYPE_MISMATCH
+			    : FFEBAD_FILEWIDE_TYPE_MISMATCH_W);
+	      ffebad_string (ffelex_token_text (t));
+	      if (g->tick == ffe_count_2)
+		{
+		  /* Current reference fills in type info for definition.
+		     The current token doesn't necessarily point to the actual
+		     definition of the function, so use the definition pointer
+		     and the pointer to the pre-definition type info.  */
+		  ffebad_here (0, ffelex_token_where_line (g->t),
+			       ffelex_token_where_column (g->t));
+		  ffebad_here (1, ffelex_token_where_line (g->u.proc.other_t),
+			       ffelex_token_where_column (g->u.proc.other_t));
+		}
+	      else
+		{
+		  /* Current reference is not a filling-in of a current
+		     definition.  The current token is fine, as is
+		     the previous-mention token.  */
+		  ffebad_here (0, ffelex_token_where_line (t),
+			       ffelex_token_where_column (t));
+		  ffebad_here (1, ffelex_token_where_line (g->t),
+			       ffelex_token_where_column (g->t));
+		}
+	      ffebad_finish ();
+	      if (error)
+		g->type = FFEGLOBAL_typeANY;
+	      return FALSE;
+	    }
+	}
+    }
+
+  if (g == NULL)
+    {
+      g = ffeglobal_new_ (n);
+      g->t = ffelex_token_use (t);
+      g->tick = ffe_count_2;
+      g->intrinsic = FALSE;
+      g->type = type;
+      g->u.proc.defined = FALSE;
+      g->u.proc.bt = ffesymbol_basictype (s);
+      g->u.proc.kt = ffesymbol_kindtype (s);
+      g->u.proc.sz = ffesymbol_size (s);
+      g->u.proc.n_args = -1;
+      ffesymbol_set_global (s, g);
+    }
+  else if (g->intrinsic
+	   && !g->explicit_intrinsic
+	   && (g->tick != ffe_count_2)
+	   && ffe_is_warn_globals ())
+    {
+      /* Now known as a global, this name previously was seen as an
+	 intrinsic.  Warn, in case the previous reference was intended
+	 for the same global.  */
+      ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
+      ffebad_string (ffelex_token_text (t));
+      ffebad_string ("global");
+      ffebad_string ("intrinsic");
+      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+      ffebad_here (1, ffelex_token_where_line (g->t),
+		   ffelex_token_where_column (g->t));
+      ffebad_finish ();
+    }
+
+  if ((g->type != type)
+      && (type != FFEGLOBAL_typeEXT))
+    {
+      /* We've learned more, so point to where we learned it.  */
+      g->t = ffelex_token_use (t);
+      g->type = type;
+      g->hook = FFECOM_globalNULL;	/* Discard previous _DECL. */
+      g->u.proc.n_args = -1;
+    }
+
+  return TRUE;
+#endif
+}
+
+/* ffeglobal_save_common -- Check SAVE status of common area
+
+   ffesymbol s;	 // the common area
+   bool save;  // TRUE if SAVEd, FALSE otherwise
+   ffeglobal_save_common(s,save,ffesymbol_where_line(s),
+	 ffesymbol_where_column(s));
+
+   In global-enabled mode, make sure the save info agrees with any existing
+   info established for the common area, otherwise complain.
+   In global-disabled mode, do nothing.	 */
+
+void
+ffeglobal_save_common (ffesymbol s, bool save, ffewhereLine wl,
+		       ffewhereColumn wc)
+{
+#if FFEGLOBAL_ENABLED
+  ffeglobal g;
+
+  g = ffesymbol_global (s);
+  if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
+    return;			/* Let someone else catch this! */
+  if (g->type == FFEGLOBAL_typeANY)
+    return;
+
+  if (!g->u.common.have_save)
+    {
+      g->u.common.have_save = TRUE;
+      g->u.common.save = save;
+      g->u.common.save_where_line = ffewhere_line_use (wl);
+      g->u.common.save_where_col = ffewhere_column_use (wc);
+    }
+  else
+    {
+      if ((g->u.common.save != save) && ffe_is_pedantic ())
+	{
+	  ffebad_start (FFEBAD_COMMON_DIFF_SAVE);
+	  ffebad_string (ffesymbol_text (s));
+	  ffebad_here (save ? 0 : 1, wl, wc);
+	  ffebad_here (save ? 1 : 0, g->u.common.pad_where_line, g->u.common.pad_where_col);
+	  ffebad_finish ();
+	}
+    }
+#endif
+}
+
+/* ffeglobal_size_common -- Establish size of COMMON area
+
+   ffesymbol s;	 // the common area
+   ffetargetOffset size;  // size in units
+   if (ffeglobal_size_common(s,size))  // new size is largest seen
+
+   In global-enabled mode, set the size if it current size isn't known or is
+   smaller than new size, and for non-blank common, complain if old size
+   is different from new.  Return TRUE if the new size is the largest seen
+   for this COMMON area (or if no size was known for it previously).
+   In global-disabled mode, do nothing.	 */
+
+#if FFEGLOBAL_ENABLED
+bool
+ffeglobal_size_common (ffesymbol s, ffetargetOffset size)
+{
+  ffeglobal g;
+
+  g = ffesymbol_global (s);
+  if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
+    return FALSE;
+  if (g->type == FFEGLOBAL_typeANY)
+    return FALSE;
+
+  if (!g->u.common.have_size)
+    {
+      g->u.common.have_size = TRUE;
+      g->u.common.size = size;
+      return TRUE;
+    }
+
+  if ((g->tick > 0) && (g->tick < ffe_count_2)
+      && (g->u.common.size < size))
+    {
+      char oldsize[40];
+      char newsize[40];
+
+      /* Common block initialized in a previous program unit, which
+	 effectively freezes its size, but now the program is trying
+	 to enlarge it.  */
+
+      sprintf (&oldsize[0], "%" ffetargetOffset_f "d", g->u.common.size);
+      sprintf (&newsize[0], "%" ffetargetOffset_f "d", size);
+
+      ffebad_start (FFEBAD_COMMON_ENLARGED);
+      ffebad_string (ffesymbol_text (s));
+      ffebad_string (oldsize);
+      ffebad_string (newsize);
+      ffebad_string ((g->u.common.size == 1)
+		     ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+      ffebad_string ((size == 1)
+		     ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+      ffebad_here (0, ffelex_token_where_line (g->u.common.initt),
+		   ffelex_token_where_column (g->u.common.initt));
+      ffebad_here (1, ffesymbol_where_line (s),
+		   ffesymbol_where_column (s));
+      ffebad_finish ();
+    }
+  else if ((g->u.common.size != size) && !g->u.common.blank)
+    {
+      char oldsize[40];
+      char newsize[40];
+
+      /* Warn about this even if not -pedantic, because putting all
+	 program units in a single source file is the only way to
+	 detect this.  Apparently UNIX-model linkers neither handle
+	 nor report when they make a common unit smaller than
+	 requested, such as when the smaller-declared version is
+	 initialized and the larger-declared version is not.  So
+	 if people complain about strange overwriting, we can tell
+	 them to put all their code in a single file and compile
+	 that way.  Warnings about differing sizes must therefore
+	 always be issued.  */
+
+      sprintf (&oldsize[0], "%" ffetargetOffset_f "d", g->u.common.size);
+      sprintf (&newsize[0], "%" ffetargetOffset_f "d", size);
+
+      ffebad_start (FFEBAD_COMMON_DIFF_SIZE);
+      ffebad_string (ffesymbol_text (s));
+      ffebad_string (oldsize);
+      ffebad_string (newsize);
+      ffebad_string ((g->u.common.size == 1)
+		     ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+      ffebad_string ((size == 1)
+		     ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+      ffebad_here (0, ffelex_token_where_line (g->t),
+		   ffelex_token_where_column (g->t));
+      ffebad_here (1, ffesymbol_where_line (s),
+		   ffesymbol_where_column (s));
+      ffebad_finish ();
+    }
+
+  if (size > g->u.common.size)
+    {
+      g->u.common.size = size;
+      return TRUE;
+    }
+
+  return FALSE;
+}
+
+#endif
+void
+ffeglobal_terminate_1 (void)
+{
+}
diff --git a/gcc/f/global.h b/gcc/f/global.h
new file mode 100644
index 00000000000..dc499df9eb7
--- /dev/null
+++ b/gcc/f/global.h
@@ -0,0 +1,193 @@
+/* global.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995, 1997, 2003 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      global.c
+
+   Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef GCC_F_GLOBAL_H
+#define GCC_F_GLOBAL_H
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+  {
+    FFEGLOBAL_typeNONE,
+    FFEGLOBAL_typeMAIN,
+    FFEGLOBAL_typeEXT,		/* EXTERNAL is all we know. */
+    FFEGLOBAL_typeSUBR,
+    FFEGLOBAL_typeFUNC,
+    FFEGLOBAL_typeBDATA,
+    FFEGLOBAL_typeCOMMON,
+    FFEGLOBAL_typeANY,		/* Confusion reigns, so just ignore. */
+    FFEGLOBAL_type
+  } ffeglobalType;
+
+typedef enum
+  {
+    FFEGLOBAL_argsummaryNONE,	/* No arg present. */
+    FFEGLOBAL_argsummaryVAL,	/* Pass-by-value. */
+    FFEGLOBAL_argsummaryREF,	/* Pass-by-reference. */
+    FFEGLOBAL_argsummaryDESCR,	/* Pass-by-descriptor. */
+    FFEGLOBAL_argsummaryPROC,	/* Procedure (intrinsic, external). */
+    FFEGLOBAL_argsummarySUBR,	/* Subroutine (intrinsic, external). */
+    FFEGLOBAL_argsummaryFUNC,	/* Function (intrinsic, external). */
+    FFEGLOBAL_argsummaryALTRTN,	/* Alternate-return (label). */
+    FFEGLOBAL_argsummaryANY,
+    FFEGLOBAL_argsummary
+  } ffeglobalArgSummary;
+
+/* Typedefs. */
+
+typedef struct _ffeglobal_arginfo_ *ffeglobalArgInfo_;
+typedef struct _ffeglobal_ *ffeglobal;
+
+/* Include files needed by this one. */
+
+#include "info.h"
+#include "lex.h"
+#include "name.h"
+#include "symbol.h"
+#include "target.h"
+#include "top.h"
+
+/* Structure definitions. */
+
+struct _ffeglobal_arginfo_
+{
+  ffelexToken t;	/* Different from master token when difference is important. */
+  char *name;		/* Name of dummy arg, or NULL if not yet known. */
+  ffeglobalArgSummary as;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  bool array;
+};
+
+struct _ffeglobal_
+{
+  ffelexToken t;
+  ffename n;
+  ffecomGlobal hook;
+  ffeCounter tick;		/* Recent transition in this progunit. */
+  ffeglobalType type;
+  bool intrinsic;		/* Known as intrinsic? */
+  bool explicit_intrinsic;	/* Explicit intrinsic? */
+  union {
+    struct {
+      ffelexToken initt;	/* First initial value. */
+      bool have_pad;		/* Padding info avail for COMMON? */
+      ffetargetAlign pad;	/* Initial padding for COMMON. */
+      ffewhereLine pad_where_line;
+      ffewhereColumn pad_where_col;
+      bool have_save;		/* Save info avail for COMMON? */
+      bool save;		/* Save info for COMMON. */
+      ffewhereLine save_where_line;
+      ffewhereColumn save_where_col;
+      bool have_size;		/* Size info avail for COMMON? */
+      ffetargetOffset size;	/* Size info for COMMON. */
+      bool blank;		/* TRUE if blank COMMON. */
+    } common;
+    struct {
+      bool defined;		/* Seen actual code yet? */
+      ffeinfoBasictype bt;	/* NONE for non-function. */
+      ffeinfoKindtype kt;	/* NONE for non-function. */
+      ffetargetCharacterSize sz;
+      int n_args;		/* 0 for main/blockdata. */
+      ffelexToken other_t;	/* Location of reference. */
+      ffeglobalArgInfo_ arg_info;	/* Info on each argument. */
+    } proc;
+  } u;
+};
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+void ffeglobal_drive (ffeglobal (*fn) (ffeglobal));
+void ffeglobal_init_1 (void);
+void ffeglobal_init_common (ffesymbol s, ffelexToken t);
+void ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type);
+void ffeglobal_new_common (ffesymbol s, ffelexToken t, bool blank);
+void ffeglobal_pad_common (ffesymbol s, ffetargetAlign pad, ffewhereLine wl,
+			   ffewhereColumn wc);
+void ffeglobal_proc_def_arg (ffesymbol s, int argno, const char *name, ffeglobalArgSummary as,
+			     ffeinfoBasictype bt, ffeinfoKindtype kt,
+			     bool array);
+void ffeglobal_proc_def_nargs (ffesymbol s, int n_args);
+bool ffeglobal_proc_ref_arg (ffesymbol s, int argno, ffeglobalArgSummary as,
+			     ffeinfoBasictype bt, ffeinfoKindtype kt,
+			     bool array, ffelexToken t);
+bool ffeglobal_proc_ref_nargs (ffesymbol s, int n_args, ffelexToken t);
+ffeglobal ffeglobal_promoted (ffesymbol s);
+void ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit);
+bool ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type);
+void ffeglobal_save_common (ffesymbol s, bool save, ffewhereLine wl,
+			    ffewhereColumn wc);
+bool ffeglobal_size_common (ffesymbol s, ffetargetOffset size);
+void ffeglobal_terminate_1 (void);
+
+/* Define macros. */
+
+#define FFEGLOBAL_ENABLED 1
+
+#define ffeglobal_common_init(g) ((g)->tick != 0)
+#define ffeglobal_common_have_pad(g) ((g)->u.common.have_pad)
+#define ffeglobal_common_have_size(g) ((g)->u.common.have_size)
+#define ffeglobal_common_pad(g) ((g)->u.common.pad)
+#define ffeglobal_common_size(g) ((g)->u.common.size)
+#define ffeglobal_hook(g) ((g)->hook)
+#define ffeglobal_init_0()
+#define ffeglobal_init_2()
+#define ffeglobal_init_3()
+#define ffeglobal_init_4()
+#define ffeglobal_new_blockdata(s,t) \
+      ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeBDATA)
+#define ffeglobal_new_function(s,t) \
+      ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeFUNC)
+#define ffeglobal_new_program(s,t) \
+      ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeMAIN)
+#define ffeglobal_new_subroutine(s,t) \
+      ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeSUBR)
+#define ffeglobal_ref_blockdata(s,t) \
+      ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeBDATA)
+#define ffeglobal_ref_external(s,t) \
+      ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeEXT)
+#define ffeglobal_ref_function(s,t) \
+      ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeFUNC)
+#define ffeglobal_ref_subroutine(s,t) \
+      ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeSUBR)
+#define ffeglobal_set_hook(g,h) ((g)->hook = (h))
+#define ffeglobal_terminate_0()
+#define ffeglobal_terminate_2()
+#define ffeglobal_terminate_3()
+#define ffeglobal_terminate_4()
+#define ffeglobal_text(g) ffename_text((g)->n)
+#define ffeglobal_type(g) ((g)->type)
+
+/* End of #include file. */
+
+#endif /* ! GCC_F_GLOBAL_H */
+
diff --git a/gcc/f/implic.c b/gcc/f/implic.c
new file mode 100644
index 00000000000..c7a28cbc42a
--- /dev/null
+++ b/gcc/f/implic.c
@@ -0,0 +1,383 @@
+/* implic.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Related Modules:
+      None.
+
+   Description:
+      The GNU Fortran Front End.
+
+   Modifications:
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "implic.h"
+#include "info.h"
+#include "src.h"
+#include "symbol.h"
+#include "target.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+  {
+    FFEIMPLIC_stateINITIAL_,
+    FFEIMPLIC_stateASSUMED_,
+    FFEIMPLIC_stateESTABLISHED_,
+    FFEIMPLIC_state
+  } ffeimplicState_;
+
+/* Internal typedefs. */
+
+typedef struct _ffeimplic_ *ffeimplic_;
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+struct _ffeimplic_
+  {
+    ffeimplicState_ state;
+    ffeinfo info;
+  };
+
+/* Static objects accessed by functions in this module. */
+
+/* NOTE: This is definitely ASCII-specific!!  */
+
+static struct _ffeimplic_ ffeimplic_table_['z' - 'A' + 1];
+
+/* Static functions (internal). */
+
+static ffeimplic_ ffeimplic_lookup_ (unsigned char c);
+
+/* Internal macros. */
+
+
+/* ffeimplic_lookup_ -- Look up implicit descriptor for initial character
+
+   ffeimplic_ imp;
+   if ((imp = ffeimplic_lookup_('A')) == NULL)
+       // error
+
+   Returns a pointer to an implicit descriptor block based on the character
+   passed, or NULL if it is not a valid initial character for an implicit
+   data type.  */
+
+static ffeimplic_
+ffeimplic_lookup_ (unsigned char c)
+{
+  /* NOTE: This is definitely ASCII-specific!!  */
+  if (ISIDST (c))
+    return &ffeimplic_table_[c - 'A'];
+  return NULL;
+}
+
+/* ffeimplic_establish_initial -- Establish type of implicit initial letter
+
+   ffesymbol s;
+   if (!ffeimplic_establish_initial(s))
+       // error
+
+   Assigns implicit type information to the symbol based on the first
+   character of the symbol's name.  */
+
+bool
+ffeimplic_establish_initial (char c, ffeinfoBasictype basic_type,
+		     ffeinfoKindtype kind_type, ffetargetCharacterSize size)
+{
+  ffeimplic_ imp;
+
+  imp = ffeimplic_lookup_ (c);
+  if (imp == NULL)
+    return FALSE;		/* Character not A-Z or some such thing. */
+  if (ffeinfo_basictype (imp->info) == FFEINFO_basictypeNONE)
+    return FALSE;		/* IMPLICIT NONE in effect here. */
+
+  switch (imp->state)
+    {
+    case FFEIMPLIC_stateINITIAL_:
+      imp->info = ffeinfo_new (basic_type,
+			       kind_type,
+			       0,
+			       FFEINFO_kindNONE,
+			       FFEINFO_whereNONE,
+			       size);
+      imp->state = FFEIMPLIC_stateESTABLISHED_;
+      return TRUE;
+
+    case FFEIMPLIC_stateASSUMED_:
+      if ((ffeinfo_basictype (imp->info) != basic_type)
+	  || (ffeinfo_kindtype (imp->info) != kind_type)
+	  || (ffeinfo_size (imp->info) != size))
+	return FALSE;
+      imp->state = FFEIMPLIC_stateESTABLISHED_;
+      return TRUE;
+
+    case FFEIMPLIC_stateESTABLISHED_:
+      return FALSE;
+
+    default:
+      assert ("Weird state for implicit object" == NULL);
+      return FALSE;
+    }
+}
+
+/* ffeimplic_establish_symbol -- Establish implicit type of a symbol
+
+   ffesymbol s;
+   if (!ffeimplic_establish_symbol(s))
+       // error
+
+   Assigns implicit type information to the symbol based on the first
+   character of the symbol's name.
+
+   If symbol already has a type, return TRUE.
+   Get first character of symbol's name.
+   Get ffeimplic_ object for it (return FALSE if NULL returned).
+   Return FALSE if object has no assigned type (IMPLICIT NONE).
+   Copy the type information from the object to the symbol.
+   If the object is state "INITIAL", set to state "ASSUMED" so no
+       subsequent IMPLICIT statement may change the state.
+   Return TRUE.	 */
+
+bool
+ffeimplic_establish_symbol (ffesymbol s)
+{
+  char c;
+  ffeimplic_ imp;
+
+  if (ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
+    return TRUE;
+
+  c = *(ffesymbol_text (s));
+  imp = ffeimplic_lookup_ (c);
+  if (imp == NULL)
+    return FALSE;		/* First character not A-Z or some such
+				   thing. */
+  if (ffeinfo_basictype (imp->info) == FFEINFO_basictypeNONE)
+    return FALSE;		/* IMPLICIT NONE in effect here. */
+
+  ffesymbol_signal_change (s);	/* Gonna change, save existing? */
+
+  /* Establish basictype, kindtype, size; preserve rank, kind, where. */
+
+  ffesymbol_set_info (s,
+		      ffeinfo_new (ffeinfo_basictype (imp->info),
+				   ffeinfo_kindtype (imp->info),
+				   ffesymbol_rank (s),
+				   ffesymbol_kind (s),
+				   ffesymbol_where (s),
+				   ffeinfo_size (imp->info)));
+
+  if (imp->state == FFEIMPLIC_stateINITIAL_)
+    imp->state = FFEIMPLIC_stateASSUMED_;
+
+  if (ffe_is_warn_implicit ())
+    {
+      /* xgettext:no-c-format */
+      ffebad_start_msg ("Implicit declaration of `%A' at %0",
+			FFEBAD_severityWARNING);
+      ffebad_here (0, ffesymbol_where_line (s),
+		   ffesymbol_where_column (s));
+      ffebad_string (ffesymbol_text (s));
+      ffebad_finish ();
+    }
+
+  return TRUE;
+}
+
+/* ffeimplic_init_2 -- Initialize table
+
+   ffeimplic_init_2();
+
+   Assigns initial type information to all initial letters.
+
+   Allows for holes in the sequence of letters (i.e. EBCDIC).  */
+
+void
+ffeimplic_init_2 (void)
+{
+  ffeimplic_ imp;
+  char c;
+
+  for (c = 'A'; c <= 'z'; ++c)
+    {
+      imp = &ffeimplic_table_[c - 'A'];
+      imp->state = FFEIMPLIC_stateINITIAL_;
+      switch (c)
+	{
+	case 'A':
+	case 'B':
+	case 'C':
+	case 'D':
+	case 'E':
+	case 'F':
+	case 'G':
+	case 'H':
+	case 'O':
+	case 'P':
+	case 'Q':
+	case 'R':
+	case 'S':
+	case 'T':
+	case 'U':
+	case 'V':
+	case 'W':
+	case 'X':
+	case 'Y':
+	case 'Z':
+	case '_':
+	case 'a':
+	case 'b':
+	case 'c':
+	case 'd':
+	case 'e':
+	case 'f':
+	case 'g':
+	case 'h':
+	case 'o':
+	case 'p':
+	case 'q':
+	case 'r':
+	case 's':
+	case 't':
+	case 'u':
+	case 'v':
+	case 'w':
+	case 'x':
+	case 'y':
+	case 'z':
+	  imp->info = ffeinfo_new (FFEINFO_basictypeREAL,
+				   FFEINFO_kindtypeREALDEFAULT,
+				   0,
+				   FFEINFO_kindNONE,
+				   FFEINFO_whereNONE,
+				   FFETARGET_charactersizeNONE);
+	  break;
+
+	case 'I':
+	case 'J':
+	case 'K':
+	case 'L':
+	case 'M':
+	case 'N':
+	case 'i':
+	case 'j':
+	case 'k':
+	case 'l':
+	case 'm':
+	case 'n':
+	  imp->info = ffeinfo_new (FFEINFO_basictypeINTEGER,
+				   FFEINFO_kindtypeINTEGERDEFAULT, 0, FFEINFO_kindNONE, FFEINFO_whereNONE,
+				   FFETARGET_charactersizeNONE);
+	  break;
+
+	default:
+	  imp->info = ffeinfo_new (FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0,
+	  FFEINFO_kindNONE, FFEINFO_whereNONE, FFETARGET_charactersizeNONE);
+	  break;
+	}
+    }
+}
+
+/* ffeimplic_none -- Implement IMPLICIT NONE statement
+
+   ffeimplic_none();
+
+   Assigns null type information to all initial letters.  */
+
+void
+ffeimplic_none (void)
+{
+  ffeimplic_ imp;
+
+  for (imp = &ffeimplic_table_[0];
+       imp != &ffeimplic_table_[ARRAY_SIZE (ffeimplic_table_)];
+       imp++)
+    {
+      imp->info = ffeinfo_new (FFEINFO_basictypeNONE,
+			       FFEINFO_kindtypeNONE,
+			       0,
+			       FFEINFO_kindNONE,
+			       FFEINFO_whereNONE,
+			       FFETARGET_charactersizeNONE);
+    }
+}
+
+/* ffeimplic_peek_symbol_type -- Determine implicit type of a symbol
+
+   ffesymbol s;
+   const char *name; // name for s in case it is NULL, or NULL if s never NULL
+   if (ffeimplic_peek_symbol_type(s,name) == FFEINFO_basictypeCHARACTER)
+       // is or will be a CHARACTER-typed name
+
+   Like establish_symbol, but doesn't change anything.
+
+   If symbol is non-NULL and already has a type, return it.
+   Get first character of symbol's name or from name arg if symbol is NULL.
+   Get ffeimplic_ object for it (return FALSE if NULL returned).
+   Return NONE if object has no assigned type (IMPLICIT NONE).
+   Return the data type indicated in the object.
+
+   24-Oct-91  JCB  2.0
+      Take a char * instead of ffelexToken, since the latter isn't always
+      needed anyway (as when ffecom calls it).	*/
+
+ffeinfoBasictype
+ffeimplic_peek_symbol_type (ffesymbol s, const char *name)
+{
+  char c;
+  ffeimplic_ imp;
+
+  if (s == NULL)
+    c = *name;
+  else
+    {
+      if (ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
+	return ffesymbol_basictype (s);
+
+      c = *(ffesymbol_text (s));
+    }
+
+  imp = ffeimplic_lookup_ (c);
+  if (imp == NULL)
+    return FFEINFO_basictypeNONE;	/* First character not A-Z or
+					   something. */
+  return ffeinfo_basictype (imp->info);
+}
+
+/* ffeimplic_terminate_2 -- Terminate table
+
+   ffeimplic_terminate_2();
+
+   Kills info object for each entry in table.  */
+
+void
+ffeimplic_terminate_2 (void)
+{
+}
diff --git a/gcc/f/implic.h b/gcc/f/implic.h
new file mode 100644
index 00000000000..44fbfac4e4f
--- /dev/null
+++ b/gcc/f/implic.h
@@ -0,0 +1,74 @@
+/* implic.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      implic.c
+
+   Modifications:
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef GCC_F_IMPLIC_H
+#define GCC_F_IMPLIC_H
+
+/* Simple definitions and enumerations. */
+
+
+/* Typedefs. */
+
+
+/* Include files needed by this one. */
+
+#include "info.h"
+#include "symbol.h"
+#include "target.h"
+
+/* Structure definitions. */
+
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+bool ffeimplic_establish_initial (char c, ffeinfoBasictype basic_type,
+		    ffeinfoKindtype kind_type, ffetargetCharacterSize size);
+bool ffeimplic_establish_symbol (ffesymbol s);
+void ffeimplic_init_2 (void);
+void ffeimplic_none (void);
+ffeinfoBasictype ffeimplic_peek_symbol_type (ffesymbol s, const char *name);
+void ffeimplic_terminate_2 (void);
+
+/* Define macros. */
+
+#define ffeimplic_init_0()
+#define ffeimplic_init_1()
+#define ffeimplic_init_3()
+#define ffeimplic_init_4()
+#define ffeimplic_terminate_0()
+#define ffeimplic_terminate_1()
+#define ffeimplic_terminate_3()
+#define ffeimplic_terminate_4()
+
+/* End of #include file. */
+
+#endif /* ! GCC_F_IMPLIC_H */
diff --git a/gcc/f/info-b.def b/gcc/f/info-b.def
new file mode 100644
index 00000000000..088d108f055
--- /dev/null
+++ b/gcc/f/info-b.def
@@ -0,0 +1,36 @@
+/* info-b.def -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      info.c
+
+   Modifications:
+*/
+
+FFEINFO_BASICTYPE (FFEINFO_basictypeNONE, "None", "")
+FFEINFO_BASICTYPE (FFEINFO_basictypeINTEGER, "INTEGER", "i")
+FFEINFO_BASICTYPE (FFEINFO_basictypeLOGICAL, "LOGICAL", "l")
+FFEINFO_BASICTYPE (FFEINFO_basictypeREAL, "REAL", "r")
+FFEINFO_BASICTYPE (FFEINFO_basictypeCOMPLEX, "COMPLEX", "c")
+FFEINFO_BASICTYPE (FFEINFO_basictypeCHARACTER, "CHARACTER", "a")
+FFEINFO_BASICTYPE (FFEINFO_basictypeHOLLERITH, "Hollerith", "h")
+FFEINFO_BASICTYPE (FFEINFO_basictypeTYPELESS, "Typeless", "t")
+FFEINFO_BASICTYPE (FFEINFO_basictypeANY, "Any", "~")
diff --git a/gcc/f/info-k.def b/gcc/f/info-k.def
new file mode 100644
index 00000000000..9e6052d6150
--- /dev/null
+++ b/gcc/f/info-k.def
@@ -0,0 +1,41 @@
+/* info-k.def -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995, 2002 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      info.c
+
+   Modifications:
+*/
+
+#
+/* Kind messages are used in diagnostic location reports of the
+   form "<file>: In function `foo': <error message>". */
+
+FFEINFO_KIND (FFEINFO_kindNONE, "In unknown kind", "")
+FFEINFO_KIND (FFEINFO_kindENTITY, "In entity", "e")
+FFEINFO_KIND (FFEINFO_kindFUNCTION, "In function", "f")
+FFEINFO_KIND (FFEINFO_kindSUBROUTINE, "In subroutine", "u")
+FFEINFO_KIND (FFEINFO_kindPROGRAM, "In program", "p")
+FFEINFO_KIND (FFEINFO_kindBLOCKDATA, "In block-data unit", "b")
+FFEINFO_KIND (FFEINFO_kindCOMMON, "In common block", "c")
+FFEINFO_KIND (FFEINFO_kindCONSTRUCT, "In construct", ":")
+FFEINFO_KIND (FFEINFO_kindNAMELIST, "In namelist", "n")
+FFEINFO_KIND (FFEINFO_kindANY, "In anything", "~")
diff --git a/gcc/f/info-w.def b/gcc/f/info-w.def
new file mode 100644
index 00000000000..57e3f8c6d62
--- /dev/null
+++ b/gcc/f/info-w.def
@@ -0,0 +1,41 @@
+/* info-w.def -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      info.c
+
+   Modifications:
+*/
+
+FFEINFO_WHERE (FFEINFO_whereNONE, "None", "")
+FFEINFO_WHERE (FFEINFO_whereLOCAL, "Local", "l")	/* Defined locally. */
+FFEINFO_WHERE (FFEINFO_whereCOMMON, "Common", "c")	/* In a common area. */
+FFEINFO_WHERE (FFEINFO_whereDUMMY, "Dummy", "d")	/* A dummy argument. */
+FFEINFO_WHERE (FFEINFO_whereGLOBAL, "Global", "g")	/* Reference to external global like FUNCTION, SUBR. */
+FFEINFO_WHERE (FFEINFO_whereRESULT, "Result", "r")	/* Result of this function. */
+FFEINFO_WHERE (FFEINFO_whereFLEETING, "Fleeting", "f")		/* Result of "X*Y", "FUNCREF(5,1.3)", "ARRAY(X)", etc. */
+FFEINFO_WHERE (FFEINFO_whereFLEETING_CADDR, "Fleet-Const", "fp")	/* "A(3)", "CHARS(4:5)". */
+FFEINFO_WHERE (FFEINFO_whereFLEETING_IADDR, "Fleet-Immed", "fi")	/* A(IX) in "DATA (A(IX),IX=1,100)/.../". */
+FFEINFO_WHERE (FFEINFO_whereIMMEDIATE, "Immediate", "i")	/* IX in "DATA (A(IX),IX=1,100)/.../". */
+FFEINFO_WHERE (FFEINFO_whereINTRINSIC, "Intrinsic", "b")
+FFEINFO_WHERE (FFEINFO_whereCONSTANT, "Constant", "p")		/* For kindFUNCTION, means statement function! */
+FFEINFO_WHERE (FFEINFO_whereCONSTANT_SUBOBJECT, "Const-subobj", "q")	/* As in "'FOO'(I:J)". */
+FFEINFO_WHERE (FFEINFO_whereANY, "Any", "~")
diff --git a/gcc/f/info.c b/gcc/f/info.c
new file mode 100644
index 00000000000..3c0030f27f8
--- /dev/null
+++ b/gcc/f/info.c
@@ -0,0 +1,303 @@
+/* info.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Related Modules:
+      None
+
+   Description:
+      An abstraction for information maintained on a per-operator and per-
+      operand basis in expression trees.
+
+   Modifications:
+      30-Aug-90	 JCB  2.0
+	 Extensive rewrite for new cleaner approach.
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "info.h"
+#include "target.h"
+#include "type.h"
+
+/* Externals defined here. */
+
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module.	 */
+
+static const char *const ffeinfo_basictype_string_[]
+=
+{
+#define FFEINFO_BASICTYPE(KWD,LNAM,SNAM) SNAM,
+#include "info-b.def"
+#undef FFEINFO_BASICTYPE
+};
+static const char *const ffeinfo_kind_message_[]
+=
+{
+#define FFEINFO_KIND(kwd,msgid,snam) msgid,
+#include "info-k.def"
+#undef FFEINFO_KIND
+};
+static const char *const ffeinfo_kind_string_[]
+=
+{
+#define FFEINFO_KIND(KWD,LNAM,SNAM) SNAM,
+#include "info-k.def"
+#undef FFEINFO_KIND
+};
+static ffeinfoBasictype ffeinfo_combine_[FFEINFO_basictype][FFEINFO_basictype];
+static const char *const ffeinfo_kindtype_string_[]
+=
+{
+  "",
+  "1",
+  "2",
+  "3",
+  "4",
+  "5",
+  "6",
+  "7",
+  "8",
+  "*",
+};
+static const char *const ffeinfo_where_string_[]
+=
+{
+#define FFEINFO_WHERE(KWD,LNAM,SNAM) SNAM,
+#include "info-w.def"
+#undef FFEINFO_WHERE
+};
+static ffetype ffeinfo_types_[FFEINFO_basictype][FFEINFO_kindtype];
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+
+/* ffeinfo_basictype_combine -- Combine two basictypes into highest rank type
+
+   ffeinfoBasictype i, j, k;
+   k = ffeinfo_basictype_combine(i,j);
+
+   Returns a type based on "standard" operation between two given types.  */
+
+ffeinfoBasictype
+ffeinfo_basictype_combine (ffeinfoBasictype l, ffeinfoBasictype r)
+{
+  assert (l < FFEINFO_basictype);
+  assert (r < FFEINFO_basictype);
+  return ffeinfo_combine_[l][r];
+}
+
+/* ffeinfo_basictype_string -- Return tiny string showing the basictype
+
+   ffeinfoBasictype i;
+   printf("%s",ffeinfo_basictype_string(dt));
+
+   Returns the string based on the basic type.	*/
+
+const char *
+ffeinfo_basictype_string (ffeinfoBasictype basictype)
+{
+  if (basictype >= ARRAY_SIZE (ffeinfo_basictype_string_))
+    return "?\?\?";
+  return ffeinfo_basictype_string_[basictype];
+}
+
+/* ffeinfo_init_0 -- Initialize
+
+   ffeinfo_init_0();  */
+
+void
+ffeinfo_init_0 (void)
+{
+  ffeinfoBasictype i;
+  ffeinfoBasictype j;
+
+  assert (FFEINFO_basictype == ARRAY_SIZE (ffeinfo_basictype_string_));
+  assert (FFEINFO_kind == ARRAY_SIZE (ffeinfo_kind_message_));
+  assert (FFEINFO_kind == ARRAY_SIZE (ffeinfo_kind_string_));
+  assert (FFEINFO_kindtype == ARRAY_SIZE (ffeinfo_kindtype_string_));
+  assert (FFEINFO_where == ARRAY_SIZE (ffeinfo_where_string_));
+
+  /* Make array that, given two basic types, produces resulting basic type. */
+
+  for (i = 0; i < FFEINFO_basictype; ++i)
+    for (j = 0; j < FFEINFO_basictype; ++j)
+      if ((i == FFEINFO_basictypeANY) || (j == FFEINFO_basictypeANY))
+	ffeinfo_combine_[i][j] = FFEINFO_basictypeANY;
+      else
+	ffeinfo_combine_[i][j] = FFEINFO_basictypeNONE;
+
+#define same(bt) ffeinfo_combine_[bt][bt] = bt
+#define use2(bt1,bt2) ffeinfo_combine_[bt1][bt2]  \
+      = ffeinfo_combine_[bt2][bt1] = bt2
+
+  same (FFEINFO_basictypeINTEGER);
+  same (FFEINFO_basictypeLOGICAL);
+  same (FFEINFO_basictypeREAL);
+  same (FFEINFO_basictypeCOMPLEX);
+  same (FFEINFO_basictypeCHARACTER);
+  use2 (FFEINFO_basictypeINTEGER, FFEINFO_basictypeREAL);
+  use2 (FFEINFO_basictypeINTEGER, FFEINFO_basictypeCOMPLEX);
+  use2 (FFEINFO_basictypeREAL, FFEINFO_basictypeCOMPLEX);
+
+#undef same
+#undef use2
+}
+
+/* ffeinfo_kind_message -- Return helpful string showing the kind
+
+   ffeinfoKind kind;
+   printf("%s",ffeinfo_kind_message(kind));
+
+   Returns the string based on the kind.  */
+
+const char *
+ffeinfo_kind_message (ffeinfoKind kind)
+{
+  if (kind >= ARRAY_SIZE (ffeinfo_kind_message_))
+    return "?\?\?";
+  return ffeinfo_kind_message_[kind];
+}
+
+/* ffeinfo_kind_string -- Return tiny string showing the kind
+
+   ffeinfoKind kind;
+   printf("%s",ffeinfo_kind_string(kind));
+
+   Returns the string based on the kind.  */
+
+const char *
+ffeinfo_kind_string (ffeinfoKind kind)
+{
+  if (kind >= ARRAY_SIZE (ffeinfo_kind_string_))
+    return "?\?\?";
+  return ffeinfo_kind_string_[kind];
+}
+
+ffeinfoKindtype
+ffeinfo_kindtype_max(ffeinfoBasictype bt,
+		     ffeinfoKindtype k1,
+		     ffeinfoKindtype k2)
+{
+  if ((bt == FFEINFO_basictypeANY)
+      || (k1 == FFEINFO_kindtypeANY)
+      || (k2 == FFEINFO_kindtypeANY))
+    return FFEINFO_kindtypeANY;
+
+  if (ffetype_size (ffeinfo_types_[bt][k1])
+      > ffetype_size (ffeinfo_types_[bt][k2]))
+    return k1;
+  return k2;
+}
+
+/* ffeinfo_kindtype_string -- Return tiny string showing the kind type
+
+   ffeinfoKindtype kind_type;
+   printf("%s",ffeinfo_kindtype_string(kind));
+
+   Returns the string based on the kind type.  */
+
+const char *
+ffeinfo_kindtype_string (ffeinfoKindtype kind_type)
+{
+  if (kind_type >= ARRAY_SIZE (ffeinfo_kindtype_string_))
+    return "?\?\?";
+  return ffeinfo_kindtype_string_[kind_type];
+}
+
+void
+ffeinfo_set_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
+		  ffetype type)
+{
+  assert (basictype < FFEINFO_basictype);
+  assert (kindtype < FFEINFO_kindtype);
+  assert (ffeinfo_types_[basictype][kindtype] == NULL);
+
+  ffeinfo_types_[basictype][kindtype] = type;
+}
+
+ffetype
+ffeinfo_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype)
+{
+  assert (basictype < FFEINFO_basictype);
+  assert (kindtype < FFEINFO_kindtype);
+
+  return ffeinfo_types_[basictype][kindtype];
+}
+
+/* ffeinfo_where_string -- Return tiny string showing the where
+
+   ffeinfoWhere where;
+   printf("%s",ffeinfo_where_string(where));
+
+   Returns the string based on the where.  */
+
+const char *
+ffeinfo_where_string (ffeinfoWhere where)
+{
+  if (where >= ARRAY_SIZE (ffeinfo_where_string_))
+    return "?\?\?";
+  return ffeinfo_where_string_[where];
+}
+
+/* ffeinfo_new -- Return object representing datatype, kind, and where info
+
+   ffeinfo i;
+   i = ffeinfo_new(FFEINFO_datatypeINTEGER,FFEINFO_kindSCALAR,
+       FFEINFO_whereLOCAL);
+
+   Returns the string based on the data type.  */
+
+#ifndef __GNUC__
+ffeinfo
+ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
+	     ffeinfoRank rank, ffeinfoKind kind, ffeinfoWhere where,
+	     ffetargetCharacterSize size)
+{
+  ffeinfo i;
+
+  i.basictype = basictype;
+  i.kindtype = kindtype;
+  i.rank = rank;
+  i.size = size;
+  i.kind = kind;
+  i.where = where;
+  i.size = size;
+
+  return i;
+}
+#endif
diff --git a/gcc/f/info.h b/gcc/f/info.h
new file mode 100644
index 00000000000..69defd27ab6
--- /dev/null
+++ b/gcc/f/info.h
@@ -0,0 +1,186 @@
+/* info.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      info.c
+
+   Modifications:
+      30-Aug-90	 JCB  2.0
+	 Extensive rewrite for new cleaner approach.
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef GCC_F_INFO_H
+#define GCC_F_INFO_H
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+  {
+#define FFEINFO_BASICTYPE(KWD,LNAM,SNAM) KWD,
+#include "info-b.def"
+#undef FFEINFO_BASICTYPE
+    FFEINFO_basictype
+  } ffeinfoBasictype;
+
+typedef enum
+  {				/* If these kindtypes aren't in size order,
+				   change _kindtype_max. */
+    FFEINFO_kindtypeNONE,
+    FFEINFO_kindtypeINTEGER1,
+    FFEINFO_kindtypeINTEGER2,
+    FFEINFO_kindtypeINTEGER3,
+    FFEINFO_kindtypeINTEGER4,
+    FFEINFO_kindtypeINTEGER5,
+    FFEINFO_kindtypeINTEGER6,
+    FFEINFO_kindtypeINTEGER7,
+    FFEINFO_kindtypeINTEGER8,
+    FFEINFO_kindtypeLOGICAL1 = 1,	/* Ok to omit, but ok to overlap. */
+    FFEINFO_kindtypeLOGICAL2,
+    FFEINFO_kindtypeLOGICAL3,
+    FFEINFO_kindtypeLOGICAL4,
+    FFEINFO_kindtypeLOGICAL5,
+    FFEINFO_kindtypeLOGICAL6,
+    FFEINFO_kindtypeLOGICAL7,
+    FFEINFO_kindtypeLOGICAL8,
+    FFEINFO_kindtypeREAL1 = 1,	/* Ok to omit, but ok to overlap. */
+    FFEINFO_kindtypeREAL2,
+    FFEINFO_kindtypeREAL3,
+    FFEINFO_kindtypeREAL4,
+    FFEINFO_kindtypeREAL5,
+    FFEINFO_kindtypeREAL6,
+    FFEINFO_kindtypeREAL7,
+    FFEINFO_kindtypeREAL8,
+    FFEINFO_kindtypeCHARACTER1 = 1,	/* Ok to omit, but ok to overlap. */
+    FFEINFO_kindtypeCHARACTER2,
+    FFEINFO_kindtypeCHARACTER3,
+    FFEINFO_kindtypeCHARACTER4,
+    FFEINFO_kindtypeCHARACTER5,
+    FFEINFO_kindtypeCHARACTER6,
+    FFEINFO_kindtypeCHARACTER7,
+    FFEINFO_kindtypeCHARACTER8,
+    FFEINFO_kindtypeANY,
+    FFEINFO_kindtype
+  } ffeinfoKindtype;
+
+typedef enum
+  {
+#define FFEINFO_KIND(KWD,LNAM,SNAM) KWD,
+#include "info-k.def"
+#undef FFEINFO_KIND
+    FFEINFO_kind
+  } ffeinfoKind;
+
+typedef enum
+  {
+#define FFEINFO_WHERE(KWD,LNAM,SNAM) KWD,
+#include "info-w.def"
+#undef FFEINFO_WHERE
+    FFEINFO_where
+  } ffeinfoWhere;
+
+/* Typedefs. */
+
+typedef struct _ffeinfo_ ffeinfo;
+typedef char ffeinfoRank;
+
+/* Include files needed by this one. */
+
+#include "target.h"
+#include "type.h"
+
+/* Structure definitions. */
+
+struct _ffeinfo_
+  {
+    ffeinfoBasictype basictype;
+    ffeinfoKindtype kindtype;
+    ffeinfoRank rank;
+    ffeinfoKind kind;
+    ffeinfoWhere where;
+    ffetargetCharacterSize size;
+  };
+
+/* Global objects accessed by users of this module. */
+
+
+/* Declare functions with prototypes. */
+
+ffeinfoBasictype ffeinfo_basictype_combine (ffeinfoBasictype l,
+					    ffeinfoBasictype r);
+const char *ffeinfo_basictype_string (ffeinfoBasictype basictype);
+void ffeinfo_init_0 (void);
+const char *ffeinfo_kind_message (ffeinfoKind kind);
+const char *ffeinfo_kind_string (ffeinfoKind kind);
+ffeinfoKindtype ffeinfo_kindtype_max(ffeinfoBasictype bt,
+				     ffeinfoKindtype k1,
+				     ffeinfoKindtype k2);
+const char *ffeinfo_kindtype_string (ffeinfoKindtype kind_type);
+const char *ffeinfo_where_string (ffeinfoWhere where);
+ffeinfo ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
+		     ffeinfoRank rank, ffeinfoKind kind, ffeinfoWhere where,
+		     ffetargetCharacterSize size);
+void ffeinfo_set_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
+		       ffetype type);
+ffetype ffeinfo_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype);
+
+/* Define macros. */
+
+#define ffeinfo_basictype(i) (i.basictype)
+#define ffeinfo_init_1()
+#define ffeinfo_init_2()
+#define ffeinfo_init_3()
+#define ffeinfo_init_4()
+#define ffeinfo_kind(i) (i.kind)
+#define ffeinfo_kindtype(i) (i.kindtype)
+#ifdef __GNUC__
+#define ffeinfo_new(bt,kt,r,k,w,sz) \
+  ((ffeinfo) {(bt), (kt), (r), (k), (w), (sz)})
+#endif
+#define ffeinfo_new_any()						      \
+  ffeinfo_new (FFEINFO_basictypeANY, FFEINFO_kindtypeANY, 0,		      \
+	       FFEINFO_kindANY, FFEINFO_whereANY,			      \
+	       FFETARGET_charactersizeNONE)
+#define ffeinfo_new_null()						      \
+  ffeinfo_new (FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0,		      \
+	       FFEINFO_kindNONE, FFEINFO_whereNONE,			      \
+	       FFETARGET_charactersizeNONE)
+#define ffeinfo_rank(i) (i.rank)
+#define ffeinfo_size(i) (i.size)
+#define ffeinfo_terminate_0()
+#define ffeinfo_terminate_1()
+#define ffeinfo_terminate_2()
+#define ffeinfo_terminate_3()
+#define ffeinfo_terminate_4()
+#define ffeinfo_use(i) i
+#define ffeinfo_where(i) (i.where)
+
+#define FFEINFO_kindtypeINTEGERDEFAULT FFEINFO_kindtypeINTEGER1
+#define FFEINFO_kindtypeLOGICALDEFAULT FFEINFO_kindtypeLOGICAL1
+#define FFEINFO_kindtypeREALDEFAULT FFEINFO_kindtypeREAL1
+#define FFEINFO_kindtypeREALDOUBLE FFEINFO_kindtypeREAL2
+#define FFEINFO_kindtypeREALQUAD FFEINFO_kindtypeREAL3
+#define FFEINFO_kindtypeCHARACTERDEFAULT FFEINFO_kindtypeCHARACTER1
+
+/* End of #include file. */
+
+#endif /* ! GCC_F_INFO_H */
diff --git a/gcc/f/intdoc.c b/gcc/f/intdoc.c
new file mode 100644
index 00000000000..b24c79a4811
--- /dev/null
+++ b/gcc/f/intdoc.c
@@ -0,0 +1,1325 @@
+/* intdoc.c
+   Copyright (C) 1997, 2000, 2001, 2003
+   Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.  */
+
+/* From f/proj.h, which uses #error -- not all C compilers
+   support that, and we want *this* program to be compilable
+   by pretty much any C compiler.  */
+#include "bconfig.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "assert.h"
+
+/* Pull in the intrinsics info, but only the doc parts.  */
+#define FFEINTRIN_DOC 1
+#include "intrin.h"
+
+const char *family_name (ffeintrinFamily family);
+static void dumpif (ffeintrinFamily fam);
+static void dumpendif (void);
+static void dumpclearif (void);
+static void dumpem (void);
+static void dumpgen (int menu, const char *name, const char *name_uc,
+		     ffeintrinGen gen);
+static void dumpspec (int menu, const char *name, const char *name_uc,
+		      ffeintrinSpec spec);
+static void dumpimp (int menu, const char *name, const char *name_uc, size_t genno, ffeintrinFamily family,
+		     ffeintrinImp imp, ffeintrinSpec spec);
+static const char *argument_info_ptr (ffeintrinImp imp, int argno);
+static const char *argument_info_string (ffeintrinImp imp, int argno);
+static const char *argument_name_ptr (ffeintrinImp imp, int argno);
+static const char *argument_name_string (ffeintrinImp imp, int argno);
+#if 0
+static const char *elaborate_if_complex (ffeintrinImp imp, int argno);
+static const char *elaborate_if_maybe_complex (ffeintrinImp imp, int argno);
+static const char *elaborate_if_real (ffeintrinImp imp, int argno);
+#endif
+static void print_type_string (const char *c);
+
+int
+main (int argc, char **argv ATTRIBUTE_UNUSED)
+{
+  if (argc != 1)
+    {
+      fprintf (stderr, "\
+Usage: intdoc > intdoc.texi\n\
+  Collects and dumps documentation on g77 intrinsics\n\
+  to the file named intdoc.texi.\n");
+      exit (1);
+    }
+
+  dumpem ();
+  return 0;
+}
+
+struct _ffeintrin_name_
+  {
+    const char *const name_uc;
+    const char *const name_lc;
+    const char *const name_ic;
+    const ffeintrinGen generic;
+    const ffeintrinSpec specific;
+  };
+
+struct _ffeintrin_gen_
+  {
+    const char *const name;		/* Name as seen in program. */
+    const ffeintrinSpec specs[2];
+  };
+
+struct _ffeintrin_spec_
+  {
+    const char *const name;	/* Uppercase name as seen in source code,
+				   lowercase if no source name, "none" if no
+				   name at all (NONE case). */
+    const bool is_actualarg;	/* Ok to pass as actual arg if -pedantic. */
+    const ffeintrinFamily family;
+    const ffeintrinImp implementation;
+  };
+
+struct _ffeintrin_imp_
+  {
+    const char *const name;		/* Name of implementation. */
+    const char *const control;
+  };
+
+static const struct _ffeintrin_name_ names[] = {
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC) \
+  { UPPER, LOWER, MIXED, FFEINTRIN_ ## GEN, FFEINTRIN_ ## SPEC },
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+#undef DEFIMPY
+};
+
+static const struct _ffeintrin_gen_ gens[] = {
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2) \
+  { NAME, { SPEC1, SPEC2, }, },
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+#undef DEFIMPY
+};
+
+static const struct _ffeintrin_imp_ imps[] = {
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
+  { NAME, CONTROL },
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
+  { NAME, CONTROL },
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+#undef DEFIMPY
+};
+
+static const struct _ffeintrin_spec_ specs[] = {
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \
+  { NAME, CALLABLE, FAMILY, IMP, },
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
+#include "intrin.def"
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+#undef DEFIMPY
+};
+
+struct cc_pair { const ffeintrinImp imp; const char *const text; };
+
+static const char *descriptions[FFEINTRIN_imp] = { 0 };
+static const struct cc_pair cc_descriptions[] = {
+#define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, DESCRIPTION },
+#include "intdoc.h0"
+#undef DEFDOC
+};
+
+static const char *summaries[FFEINTRIN_imp] = { 0 };
+static const struct cc_pair cc_summaries[] = {
+#define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, SUMMARY },
+#include "intdoc.h0"
+#undef DEFDOC
+};
+
+const char *
+family_name (ffeintrinFamily family)
+{
+  switch (family)
+    {
+    case FFEINTRIN_familyF77:
+      return "familyF77";
+
+    case FFEINTRIN_familyASC:
+      return "familyASC";
+
+    case FFEINTRIN_familyMIL:
+      return "familyMIL";
+
+    case FFEINTRIN_familyGNU:
+      return "familyGNU";
+
+    case FFEINTRIN_familyF90:
+      return "familyF90";
+
+    case FFEINTRIN_familyVXT:
+      return "familyVXT";
+
+    case FFEINTRIN_familyFVZ:
+      return "familyFVZ";
+
+    case FFEINTRIN_familyF2C:
+      return "familyF2C";
+
+    case FFEINTRIN_familyF2U:
+      return "familyF2U";
+
+    case FFEINTRIN_familyBADU77:
+      return "familyBADU77";
+
+    default:
+      assert ("bad family" == NULL);
+      return "??";
+    }
+}
+
+static int in_ifset = 0;
+static ffeintrinFamily latest_family = FFEINTRIN_familyNONE;
+
+static void
+dumpif (ffeintrinFamily fam)
+{
+  assert (fam != FFEINTRIN_familyNONE);
+  if ((in_ifset != 2)
+      || (fam != latest_family))
+    {
+      if (in_ifset == 2)
+	printf ("@end ifset\n");
+      latest_family = fam;
+      printf ("@ifset %s\n", family_name (fam));
+    }
+  in_ifset = 1;
+}
+
+static void
+dumpendif (void)
+{
+  in_ifset = 2;
+}
+
+static void
+dumpclearif (void)
+{
+  if ((in_ifset == 2)
+      || (latest_family != FFEINTRIN_familyNONE))
+    printf ("@end ifset\n");
+  latest_family = FFEINTRIN_familyNONE;
+  in_ifset = 0;
+}
+
+static void
+dumpem (void)
+{
+  int i;
+
+  for (i = 0; ((size_t) i) < ARRAY_SIZE (cc_descriptions); ++i)
+    {
+      assert (descriptions[cc_descriptions[i].imp] == NULL);
+      descriptions[cc_descriptions[i].imp] = cc_descriptions[i].text;
+    }
+
+  for (i = 0; ((size_t) i) < ARRAY_SIZE (cc_summaries); ++i)
+    {
+      assert (summaries[cc_summaries[i].imp] == NULL);
+      summaries[cc_summaries[i].imp] = cc_summaries[i].text;
+    }
+
+  printf ("@c This file is automatically derived from intdoc.c, intdoc.in,\n");
+  printf ("@c ansify.c, intrin.def, and intrin.h.  Edit those files instead.\n");
+  printf ("@menu\n");
+  for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i)
+    {
+      if (names[i].generic != FFEINTRIN_genNONE)
+	dumpgen (1, names[i].name_ic, names[i].name_uc,
+		 names[i].generic);
+      if (names[i].specific != FFEINTRIN_specNONE)
+	dumpspec (1, names[i].name_ic, names[i].name_uc,
+		  names[i].specific);
+    }
+  dumpclearif ();
+
+  printf ("@end menu\n\n");
+
+  for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i)
+    {
+      if (names[i].generic != FFEINTRIN_genNONE)
+	dumpgen (0, names[i].name_ic, names[i].name_uc,
+		 names[i].generic);
+      if (names[i].specific != FFEINTRIN_specNONE)
+	dumpspec (0, names[i].name_ic, names[i].name_uc,
+		  names[i].specific);
+    }
+  dumpclearif ();
+}
+
+static void
+dumpgen (int menu, const char *name, const char *name_uc, ffeintrinGen gen)
+{
+  size_t i;
+  int total = 0;
+
+  if (!menu)
+    {
+      for (i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i)
+	{
+	  if (gens[gen].specs[i] != FFEINTRIN_specNONE)
+	    ++total;
+	}
+    }
+
+  for (i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i)
+    {
+      ffeintrinSpec spec;
+      size_t j;
+
+      if ((spec = gens[gen].specs[i]) == FFEINTRIN_specNONE)
+	continue;
+
+      dumpif (specs[spec].family);
+      dumpimp (menu, name, name_uc, i, specs[spec].family, specs[spec].implementation,
+	       spec);
+      if (!menu && (total > 0))
+	{
+	  if (total == 1)
+	    {
+	      printf ("\
+For information on another intrinsic with the same name:\n");
+	    }
+	  else
+	    {
+	      printf ("\
+For information on other intrinsics with the same name:\n");
+	    }
+	  for (j = 0; j < ARRAY_SIZE (gens[gen].specs); ++j)
+	    {
+	      if (j == i)
+		continue;
+	      if ((spec = gens[gen].specs[j]) == FFEINTRIN_specNONE)
+		continue;
+	      printf ("@xref{%s Intrinsic (%s)}.\n",
+		      name, specs[spec].name);
+	    }
+	  printf ("\n");
+	}
+      dumpendif ();
+    }
+}
+
+static void
+dumpspec (int menu, const char *name, const char *name_uc, ffeintrinSpec spec)
+{
+  dumpif (specs[spec].family);
+  dumpimp (menu, name, name_uc, 0, specs[spec].family, specs[spec].implementation,
+	   FFEINTRIN_specNONE);
+  dumpendif ();
+}
+
+static void
+dumpimp (int menu, const char *name, const char *name_uc, size_t genno,
+	 ffeintrinFamily family, ffeintrinImp imp, ffeintrinSpec spec)
+{
+  const char *c;
+  bool subr;
+  const char *argc;
+  const char *argi;
+  int colon;
+  int argno;
+
+  assert ((imp != FFEINTRIN_impNONE) || !genno);
+
+  if (menu)
+    {
+      printf ("* %s Intrinsic",
+	      name);
+      if (spec != FFEINTRIN_specNONE)
+	printf (" (%s)", specs[spec].name);	/* See XYZZY1 below */
+      printf ("::");
+#define INDENT_SUMMARY 24
+      if ((imp == FFEINTRIN_impNONE)
+	  || (summaries[imp] != NULL))
+	{
+	  int spaces = INDENT_SUMMARY - 14 - strlen (name);
+	  const char *c;
+
+	  if (spec != FFEINTRIN_specNONE)
+	    spaces -= (3 + strlen (specs[spec].name));	/* See XYZZY1 above */
+	  if (spaces < 1)
+	    spaces = 1;
+	  while (spaces--)
+	    fputc (' ', stdout);
+
+	  if (imp == FFEINTRIN_impNONE)
+	    {
+	      printf ("(Reserved for future use.)\n");
+	      return;
+	    }
+
+	  for (c = summaries[imp]; c[0] != '\0'; ++c)
+	    {
+	      if (c[0] == '@' && ISDIGIT (c[1]))
+		{
+		  int argno = c[1] - '0';
+
+		  c += 2;
+		  while (ISDIGIT (c[0]))
+		    {
+		      argno = 10 * argno + (c[0] - '0');
+		      ++c;
+		    }
+		  assert (c[0] == '@');
+		  if (argno == 0)
+		    printf ("%s", name);
+		  else if (argno == 99)
+		    {	/* Yeah, this is a major kludge. */
+		      printf ("\n");
+		      spaces = INDENT_SUMMARY + 1;
+		      while (spaces--)
+			fputc (' ', stdout);
+		    }
+		  else
+		    printf ("%s", argument_name_string (imp, argno - 1));
+		}
+	      else
+		fputc (c[0], stdout);
+	    }
+	}
+      printf ("\n");
+      return;
+    }
+
+  printf ("@node %s Intrinsic", name);
+  if (spec != FFEINTRIN_specNONE)
+    printf (" (%s)", specs[spec].name);
+  printf ("\n@subsubsection %s Intrinsic", name);
+  if (spec != FFEINTRIN_specNONE)
+    printf (" (%s)", specs[spec].name);
+  printf ("\n@cindex %s intrinsic\n@cindex intrinsics, %s\n",
+	  name, name);
+
+  if (imp == FFEINTRIN_impNONE)
+    {
+      printf ("\n\
+This intrinsic is not yet implemented.\n\
+The name is, however, reserved as an intrinsic.\n\
+Use @samp{EXTERNAL %s} to use this name for an\n\
+external procedure.\n\
+\n\
+",
+	      name);
+      return;
+    }
+
+  c = imps[imp].control;
+  subr = (c[0] == '-');
+  colon = (c[2] == ':') ? 2 : 3;
+
+  printf ("\n\
+@noindent\n\
+@example\n\
+%s%s(",
+	  (subr ? "CALL " : ""), name);
+
+  fflush (stdout);
+
+  for (argno = 0; ; ++argno)
+    {
+      argc = argument_name_ptr (imp, argno);
+      if (argc == NULL)
+	break;
+      if (argno > 0)
+	printf (", ");
+      printf ("@var{%s}", argc);
+      argi = argument_info_string (imp, argno);
+      if ((argi[0] == '*')
+	  || (argi[0] == 'n')
+	  || (argi[0] == '+')
+	  || (argi[0] == 'p'))
+	printf ("-1, @var{%s}-2, @dots{}, @var{%s}-n",
+		argc, argc);
+    }
+
+  printf (")\n\
+@end example\n\
+\n\
+");
+
+  if (!subr)
+    {
+      int other_arg;
+      const char *arg_string;
+      const char *arg_info;
+
+      if (ISDIGIT (c[colon + 1]))
+	{
+	  other_arg = c[colon + 1] - '0';
+	  arg_string = argument_name_string (imp, other_arg);
+	  arg_info = argument_info_string (imp, other_arg);
+	}
+      else
+	{
+	  other_arg = -1;
+	  arg_string = NULL;
+	  arg_info = NULL;
+	}
+
+      printf ("\
+@noindent\n\
+%s: ", name);
+      print_type_string (c);
+      printf (" function");
+
+      if ((c[0] == 'R')
+	  && (c[1] == 'C'))
+	{
+	  assert (other_arg >= 0);
+
+	  if ((arg_info[0] == '?') || (arg_info[0] == '!') || (arg_info[0] == '+')
+	  || (arg_info[0] == '*') || (arg_info[0] == 'n') || (arg_info[0] == 'p'))
+	    ++arg_info;
+	  if ((arg_info[0] == 'F') || (arg_info[0] == 'N'))
+	    printf (".\n\
+The exact type is @samp{REAL(KIND=1)} when argument @var{%s} is\n\
+any type other than @code{COMPLEX}, or when it is @code{COMPLEX(KIND=1)}.\n\
+When @var{%s} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)},\n\
+this intrinsic is valid only when used as the argument to\n\
+@code{REAL()}, as explained below.\n\n",
+		    arg_string,
+		    arg_string);
+	  else
+	    printf (".\n\
+This intrinsic is valid when argument @var{%s} is\n\
+@code{COMPLEX(KIND=1)}.\n\
+When @var{%s} is any other @code{COMPLEX} type,\n\
+this intrinsic is valid only when used as the argument to\n\
+@code{REAL()}, as explained below.\n\n",
+		    arg_string,
+		    arg_string);
+	}
+#if 0
+      else if ((c[0] == 'I')
+	       && (c[1] == '7'))
+	printf (", the exact type being wide enough to hold a pointer\n\
+on the target system (typically @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=4)}).\n\n");
+#endif
+      else if (c[1] == '=' && ISDIGIT (c[colon + 1]))
+	{
+	  assert (other_arg >= 0);
+
+	  if ((arg_info[0] == '?') || (arg_info[0] == '!') || (arg_info[0] == '+')
+	  || (arg_info[0] == '*') || (arg_info[0] == 'n') || (arg_info[0] == 'p'))
+	    ++arg_info;
+
+	  if (((c[0] == arg_info[0])
+	       && ((c[0] == 'A') || (c[0] == 'C') || (c[0] == 'I')
+		   || (c[0] == 'L') || (c[0] == 'R')))
+	      || ((c[0] == 'R')
+		  && (arg_info[0] == 'C'))
+	      || ((c[0] == 'C')
+		  && (arg_info[0] == 'R')))
+	    printf (", the @samp{KIND=} value of the type being that of argument @var{%s}.\n\n",
+		    arg_string);
+	  else if ((c[0] == 'S')
+		   && ((arg_info[0] == 'C')
+		       || (arg_info[0] == 'F')
+		       || (arg_info[0] == 'N')))
+	    printf (".\n\
+The exact type depends on that of argument @var{%s}---if @var{%s} is\n\
+@code{COMPLEX}, this function's type is @code{REAL}\n\
+with the same @samp{KIND=} value as the type of @var{%s}.\n\
+Otherwise, this function's type is the same as that of @var{%s}.\n\n",
+		    arg_string, arg_string, arg_string, arg_string);
+	  else
+	    printf (", the exact type being that of argument @var{%s}.\n\n",
+		    arg_string);
+	}
+      else if ((c[1] == '=')
+	       && (c[colon + 1] == '*'))
+	printf (", the exact type being the result of cross-promoting the\n\
+types of all the arguments.\n\n");
+      else if (c[1] == '=')
+	assert ("?0:?:" == NULL);
+      else
+	printf (".\n\n");
+    }
+
+  for (argno = 0, argc = &c[colon + 3]; *argc != '\0'; ++argno)
+    {
+      char optionality = '\0';
+      char extra = '\0';
+      char basic;
+      char kind;
+      int length;
+      int elements;
+
+      printf ("\
+@noindent\n\
+@var{");
+      for (; ; ++argc)
+	{
+	  if (argc[0] == '=')
+	    break;
+	  printf ("%c", *argc);
+	}
+      printf ("}: ");
+
+      ++argc;
+      if ((*argc == '?')
+	  || (*argc == '!')
+	  || (*argc == '*')
+	  || (*argc == '+')
+	  || (*argc == 'n')
+	  || (*argc == 'p'))
+	optionality = *(argc++);
+      basic = *(argc++);
+      kind = *(argc++);
+      if (*argc == '[')
+	{
+	  length = *++argc - '0';
+	  if (*++argc != ']')
+	    length = 10 * length + (*(argc++) - '0');
+	  ++argc;
+	}
+      else
+	length = -1;
+      if (*argc == '(')
+	{
+	  elements = *++argc - '0';
+	  if (*++argc != ')')
+	    elements = 10 * elements + (*(argc++) - '0');
+	  ++argc;
+	}
+      else if (*argc == '&')
+	{
+	  elements = -1;
+	  ++argc;
+	}
+      else
+	elements = 0;
+      if ((*argc == '&')
+	  || (*argc == 'i')
+	  || (*argc == 'w')
+	  || (*argc == 'x'))
+	extra = *(argc++);
+      if (*argc == ',')
+	++argc;
+
+      switch (basic)
+	{
+	case '-':
+	  switch (kind)
+	    {
+	    case '*':
+	      printf ("Any type");
+	      break;
+
+	    default:
+	      assert ("kind arg" == NULL);
+	      break;
+	    }
+	  break;
+
+	case 'A':
+	  assert ((kind == '1') || (kind == '*'));
+	  printf ("@code{CHARACTER");
+	  if (length != -1)
+	    printf ("*%d", length);
+	  printf ("}");
+	  break;
+
+	case 'C':
+	  switch (kind)
+	    {
+	    case '*':
+	      printf ("@code{COMPLEX}");
+	      break;
+
+	    case '1': case '2': case '3': case '4': case '5':
+	    case '6': case '7': case '8': case '9':
+	      printf ("@code{COMPLEX(KIND=%d)}", (kind - '0'));
+	      break;
+
+	    case 'A':
+	      printf ("Same @samp{KIND=} value as for @var{%s}",
+		      argument_name_string (imp, 0));
+	      break;
+
+	    default:
+	      assert ("Ca" == NULL);
+	      break;
+	    }
+	  break;
+
+	case 'I':
+	  switch (kind)
+	    {
+	    case '*':
+	      printf ("@code{INTEGER}");
+	      break;
+
+	    case '1': case '2': case '3': case '4': case '5':
+	    case '6': case '7': case '8': case '9':
+	      printf ("@code{INTEGER(KIND=%d)}", (kind - '0'));
+	      break;
+
+	    case 'A':
+	      printf ("@code{INTEGER} with same @samp{KIND=} value as for @var{%s}",
+		      argument_name_string (imp, 0));
+	      break;
+
+	    case 'N':
+	      printf ("@code{INTEGER} not wider than the default kind");
+	      break;
+
+	    default:
+	      assert ("Ia" == NULL);
+	      break;
+	    }
+	  break;
+
+	case 'L':
+	  switch (kind)
+	    {
+	    case '*':
+	      printf ("@code{LOGICAL}");
+	      break;
+
+	    case '1': case '2': case '3': case '4': case '5':
+	    case '6': case '7': case '8': case '9':
+	      printf ("@code{LOGICAL(KIND=%d)}", (kind - '0'));
+	      break;
+
+	    case 'A':
+	      printf ("@code{LOGICAL} with same @samp{KIND=} value as for @var{%s}",
+		      argument_name_string (imp, 0));
+	      break;
+
+	    case 'N':
+	      printf ("@code{LOGICAL} not wider than the default kind");
+	      break;
+
+	    default:
+	      assert ("La" == NULL);
+	      break;
+	    }
+	  break;
+
+	case 'R':
+	  switch (kind)
+	    {
+	    case '*':
+	      printf ("@code{REAL}");
+	      break;
+
+	    case '1': case '2': case '3': case '4': case '5':
+	    case '6': case '7': case '8': case '9':
+	      printf ("@code{REAL(KIND=%d)}", (kind - '0'));
+	      break;
+
+	    case 'A':
+	      printf ("@code{REAL} with same @samp{KIND=} value as for @var{%s}",
+		      argument_name_string (imp, 0));
+	      break;
+
+	    default:
+	      assert ("Ra" == NULL);
+	      break;
+	    }
+	  break;
+
+	case 'B':
+	  switch (kind)
+	    {
+	    case '*':
+	      printf ("@code{INTEGER} or @code{LOGICAL}");
+	      break;
+
+	    case '1': case '2': case '3': case '4': case '5':
+	    case '6': case '7': case '8': case '9':
+	      printf ("@code{INTEGER(KIND=%d)} or @code{LOGICAL(KIND=%d)}",
+		      (kind - '0'), (kind - '0'));
+	      break;
+
+	    case 'A':
+	      printf ("Same type and @samp{KIND=} value as for @var{%s}",
+		      argument_name_string (imp, 0));
+	      break;
+
+	    case 'N':
+	      printf ("@code{INTEGER} or @code{LOGICAL} not wider than the default kind");
+	      break;
+
+	    default:
+	      assert ("Ba" == NULL);
+	      break;
+	    }
+	  break;
+
+	case 'F':
+	  switch (kind)
+	    {
+	    case '*':
+	      printf ("@code{REAL} or @code{COMPLEX}");
+	      break;
+
+	    case '1': case '2': case '3': case '4': case '5':
+	    case '6': case '7': case '8': case '9':
+	      printf ("@code{REAL(KIND=%d)} or @code{COMPLEX(KIND=%d)}",
+		      (kind - '0'), (kind - '0'));
+	      break;
+
+	    case 'A':
+	      printf ("Same type as @var{%s}",
+		      argument_name_string (imp, 0));
+	      break;
+
+	    default:
+	      assert ("Fa" == NULL);
+	      break;
+	    }
+	  break;
+
+	case 'N':
+	  switch (kind)
+	    {
+	    case '*':
+	      printf ("@code{INTEGER}, @code{REAL}, or @code{COMPLEX}");
+	      break;
+
+	    case '1': case '2': case '3': case '4': case '5':
+	    case '6': case '7': case '8': case '9':
+	      printf ("@code{INTEGER(KIND=%d)}, @code{REAL(KIND=%d)}, or @code{COMPLEX(KIND=%d)}",
+		      (kind - '0'), (kind - '0'), (kind - '0'));
+	      break;
+
+	    default:
+	      assert ("N1" == NULL);
+	      break;
+	    }
+	  break;
+
+	case 'S':
+	  switch (kind)
+	    {
+	    case '*':
+	      printf ("@code{INTEGER} or @code{REAL}");
+	      break;
+
+	    case '1': case '2': case '3': case '4': case '5':
+	    case '6': case '7': case '8': case '9':
+	      printf ("@code{INTEGER(KIND=%d)} or @code{REAL(KIND=%d)}",
+		      (kind - '0'), (kind - '0'));
+	      break;
+
+	    case 'A':
+	      printf ("@code{INTEGER} or @code{REAL} with same @samp{KIND=} value as for @var{%s}",
+		      argument_name_string (imp, 0));
+	      break;
+
+	    default:
+	      assert ("Sa" == NULL);
+	      break;
+	    }
+	  break;
+
+	case 'g':
+	  printf ("@samp{*@var{label}}, where @var{label} is the label\n\
+of an executable statement");
+	  break;
+
+	case 's':
+	  printf ("Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})\n\
+or dummy/global @code{INTEGER(KIND=1)} scalar");
+	  break;
+
+	default:
+	  assert ("arg type?" == NULL);
+	  break;
+	}
+
+      switch (optionality)
+	{
+	case '\0':
+	  break;
+
+	case '!':
+	  printf ("; OPTIONAL (must be omitted if @var{%s} is @code{COMPLEX})",
+		  argument_name_string (imp, argno-1));
+	  break;
+
+	case '?':
+	  printf ("; OPTIONAL");
+	  break;
+
+	case '*':
+	  printf ("; OPTIONAL");
+	  break;
+
+	case 'n':
+	case '+':
+	  break;
+
+	case 'p':
+	  printf ("; at least two such arguments must be provided");
+	  break;
+
+	default:
+	  assert ("optionality!" == NULL);
+	  break;
+	}
+
+      switch (elements)
+	{
+	case -1:
+	  break;
+
+	case 0:
+	  if ((basic != 'g')
+	      && (basic != 's'))
+	    printf ("; scalar");
+	  break;
+
+	default:
+	  assert (extra != '\0');
+	  printf ("; DIMENSION(%d)", elements);
+	  break;
+	}
+
+      switch (extra)
+	{
+	case '\0':
+	  if ((basic != 'g')
+	      && (basic != 's'))
+	    printf ("; INTENT(IN)");
+	  break;
+
+	case 'i':
+	  break;
+
+	case '&':
+	  printf ("; cannot be a constant or expression");
+	  break;
+
+	case 'w':
+	  printf ("; INTENT(OUT)");
+	  break;
+
+	case 'x':
+	  printf ("; INTENT(INOUT)");
+	  break;
+	}
+
+      printf (".\n\n");
+    }
+
+  printf ("\
+@noindent\n\
+Intrinsic groups: ");
+  switch (family)
+    {
+    case FFEINTRIN_familyF77:
+      printf ("(standard FORTRAN 77).");
+      break;
+
+    case FFEINTRIN_familyGNU:
+      printf ("@code{gnu}.");
+      break;
+
+    case FFEINTRIN_familyASC:
+      printf ("@code{f2c}, @code{f90}.");
+      break;
+
+    case FFEINTRIN_familyMIL:
+      printf ("@code{mil}, @code{f90}, @code{vxt}.");
+      break;
+
+    case FFEINTRIN_familyF90:
+      printf ("@code{f90}.");
+      break;
+
+    case FFEINTRIN_familyVXT:
+      printf ("@code{vxt}.");
+      break;
+
+    case FFEINTRIN_familyFVZ:
+      printf ("@code{f2c}, @code{vxt}.");
+      break;
+
+    case FFEINTRIN_familyF2C:
+      printf ("@code{f2c}.");
+      break;
+
+    case FFEINTRIN_familyF2U:
+      printf ("@code{unix}.");
+      break;
+
+    case FFEINTRIN_familyBADU77:
+      printf ("@code{badu77}.");
+      break;
+
+    default:
+      assert ("bad family" == NULL);
+      printf ("@code{???}.");
+      break;
+    }
+  printf ("\n\n");
+
+  if (descriptions[imp] != NULL)
+    {
+      const char *c = descriptions[imp];
+
+      printf ("\
+@noindent\n\
+Description:\n\
+\n");
+
+      while (c[0] != '\0')
+	{
+	  if (c[0] == '@' && ISDIGIT (c[1]))
+	    {
+	      int argno = c[1] - '0';
+
+	      c += 2;
+	      while (ISDIGIT (c[0]))
+		{
+		  argno = 10 * argno + (c[0] - '0');
+		  ++c;
+		}
+	      assert (c[0] == '@');
+	      if (argno == 0)
+		printf ("%s", name_uc);
+	      else
+		printf ("%s", argument_name_string (imp, argno - 1));
+	    }
+	  else
+	    fputc (c[0], stdout);
+	  ++c;
+	}
+
+      printf ("\n");
+    }
+}
+
+static const char *
+argument_info_ptr (ffeintrinImp imp, int argno)
+{
+  const char *c = imps[imp].control;
+  static char arginfos[8][32];
+  static int argx = 0;
+  int i;
+
+  if (c[2] == ':')
+    c += 5;
+  else
+    c += 6;
+
+  while (argno--)
+    {
+      while ((c[0] != ',') && (c[0] != '\0'))
+	++c;
+      if (c[0] != ',')
+	break;
+      ++c;
+    }
+
+  if (c[0] == '\0')
+    return NULL;
+
+  for (; (c[0] != '=') && (c[0] != '\0'); ++c)
+    ;
+
+  assert (c[0] == '=');
+
+  for (i = 0, ++c; (c[0] != ',') && (c[0] != '\0'); ++c, ++i)
+    arginfos[argx][i] = c[0];
+
+  arginfos[argx][i] = '\0';
+
+  c = &arginfos[argx][0];
+  ++argx;
+  if (((size_t) argx) >= ARRAY_SIZE (arginfos))
+    argx = 0;
+
+  return c;
+}
+
+static const char *
+argument_info_string (ffeintrinImp imp, int argno)
+{
+  const char *p;
+
+  p = argument_info_ptr (imp, argno);
+  assert (p != NULL);
+  return p;
+}
+
+static const char *
+argument_name_ptr (ffeintrinImp imp, int argno)
+{
+  const char *c = imps[imp].control;
+  static char argnames[8][32];
+  static int argx = 0;
+  int i;
+
+  if (c[2] == ':')
+    c += 5;
+  else
+    c += 6;
+
+  while (argno--)
+    {
+      while ((c[0] != ',') && (c[0] != '\0'))
+	++c;
+      if (c[0] != ',')
+	break;
+      ++c;
+    }
+
+  if (c[0] == '\0')
+    return NULL;
+
+  for (i = 0; (c[0] != '=') && (c[0] != '\0'); ++c, ++i)
+    argnames[argx][i] = c[0];
+
+  assert (c[0] == '=');
+  argnames[argx][i] = '\0';
+
+  c = &argnames[argx][0];
+  ++argx;
+  if (((size_t) argx) >= ARRAY_SIZE (argnames))
+    argx = 0;
+
+  return c;
+}
+
+static const char *
+argument_name_string (ffeintrinImp imp, int argno)
+{
+  const char *p;
+
+  p = argument_name_ptr (imp, argno);
+  assert (p != NULL);
+  return p;
+}
+
+static void
+print_type_string (const char *c)
+{
+  char basic = c[0];
+  char kind = c[1];
+
+  switch (basic)
+    {
+    case 'A':
+      assert ((kind == '1') || (kind == '='));
+      if (c[2] == ':')
+	printf ("@code{CHARACTER*1}");
+      else
+	{
+	  assert (c[2] == '*');
+	  printf ("@code{CHARACTER*(*)}");
+	}
+      break;
+
+    case 'C':
+      switch (kind)
+	{
+	case '=':
+	  printf ("@code{COMPLEX}");
+	  break;
+
+	case '1': case '2': case '3': case '4': case '5':
+	case '6': case '7': case '8': case '9':
+	  printf ("@code{COMPLEX(KIND=%d)}", (kind - '0'));
+	  break;
+
+	default:
+	  assert ("Ca" == NULL);
+	  break;
+	}
+      break;
+
+    case 'I':
+      switch (kind)
+	{
+	case '=':
+	  printf ("@code{INTEGER}");
+	  break;
+
+	case '1': case '2': case '3': case '4': case '5':
+	case '6': case '7': case '8': case '9':
+	  printf ("@code{INTEGER(KIND=%d)}", (kind - '0'));
+	  break;
+
+	default:
+	  assert ("Ia" == NULL);
+	  break;
+	}
+      break;
+
+    case 'L':
+      switch (kind)
+	{
+	case '=':
+	  printf ("@code{LOGICAL}");
+	  break;
+
+	case '1': case '2': case '3': case '4': case '5':
+	case '6': case '7': case '8': case '9':
+	  printf ("@code{LOGICAL(KIND=%d)}", (kind - '0'));
+	  break;
+
+	default:
+	  assert ("La" == NULL);
+	  break;
+	}
+      break;
+
+    case 'R':
+      switch (kind)
+	{
+	case '=':
+	  printf ("@code{REAL}");
+	  break;
+
+	case '1': case '2': case '3': case '4': case '5':
+	case '6': case '7': case '8': case '9':
+	  printf ("@code{REAL(KIND=%d)}", (kind - '0'));
+	  break;
+
+	case 'C':
+	  printf ("@code{REAL}");
+	  break;
+
+	default:
+	  assert ("Ra" == NULL);
+	  break;
+	}
+      break;
+
+    case 'B':
+      switch (kind)
+	{
+	case '=':
+	  printf ("@code{INTEGER} or @code{LOGICAL}");
+	  break;
+
+	case '1': case '2': case '3': case '4': case '5':
+	case '6': case '7': case '8': case '9':
+	  printf ("@code{INTEGER(KIND=%d)} or @code{LOGICAL(KIND=%d)}",
+		  (kind - '0'), (kind - '0'));
+	  break;
+
+	default:
+	  assert ("Ba" == NULL);
+	  break;
+	}
+      break;
+
+    case 'F':
+      switch (kind)
+	{
+	case '=':
+	  printf ("@code{REAL} or @code{COMPLEX}");
+	  break;
+
+	case '1': case '2': case '3': case '4': case '5':
+	case '6': case '7': case '8': case '9':
+	  printf ("@code{REAL(KIND=%d)} or @code{COMPLEX(KIND=%d)}",
+		  (kind - '0'), (kind - '0'));
+	  break;
+
+	default:
+	  assert ("Fa" == NULL);
+	  break;
+	}
+      break;
+
+    case 'N':
+      switch (kind)
+	{
+	case '=':
+	  printf ("@code{INTEGER}, @code{REAL}, or @code{COMPLEX}");
+	  break;
+
+	case '1': case '2': case '3': case '4': case '5':
+	case '6': case '7': case '8': case '9':
+	  printf ("@code{INTEGER(KIND=%d)}, @code{REAL(KIND=%d)}, or @code{COMPLEX(KIND=%d)}",
+		  (kind - '0'), (kind - '0'), (kind - '0'));
+	  break;
+
+	default:
+	  assert ("N1" == NULL);
+	  break;
+	}
+      break;
+
+    case 'S':
+      switch (kind)
+	{
+	case '=':
+	  printf ("@code{INTEGER} or @code{REAL}");
+	  break;
+
+	case '1': case '2': case '3': case '4': case '5':
+	case '6': case '7': case '8': case '9':
+	  printf ("@code{INTEGER(KIND=%d)} or @code{REAL(KIND=%d)}",
+		  (kind - '0'), (kind - '0'));
+	  break;
+
+	default:
+	  assert ("Sa" == NULL);
+	  break;
+	}
+      break;
+
+    default:
+      assert ("type?" == NULL);
+      break;
+    }
+}
diff --git a/gcc/f/intdoc.in b/gcc/f/intdoc.in
new file mode 100644
index 00000000000..6f2423f6cac
--- /dev/null
+++ b/gcc/f/intdoc.in
@@ -0,0 +1,2705 @@
+/* Copyright (C) 1997, 1999, 2003 Free Software Foundation, Inc.
+ * This is part of the G77 manual.
+ * For copying conditions, see the file g77.texi. */
+
+/* This is the file containing the verbage for the
+   intrinsics.  It consists of a data base built up
+   via DEFDOC macros of the form:
+
+   DEFDOC (IMP, SUMMARY, DESCRIPTION)
+
+   IMP is the implementation keyword used in the intrin module.
+   SUMMARY is the short summary to go in the "* Menu:" section
+   of the Info document.  DESCRIPTION is the longer description
+   to go in the documentation itself.
+
+   Note that IMP is leveraged across multiple intrinsic names.
+
+   To make for more accurate and consistent documentation,
+   the translation made by intdoc.c of the text in SUMMARY
+   and DESCRIPTION includes the special sequence
+
+   @ARGNO@
+
+   where ARGNO is a series of digits forming a number that
+   is substituted by intdoc.c as follows:
+
+   0     The initial-caps form of the intrinsic name (e.g. Float).
+   1-98  The initial-caps form of the ARGNO'th argument.
+   99    (SUMMARY only) a newline plus the appropriate # of spaces.
+
+   Hope this info is enough to encourage people to feel free to
+   add documentation to this file!
+
+*/
+
+#define ARCHAIC(upper,mixed) \
+  "Archaic form of @code{" #upper "()} that is specific\n\
+to one type for @var{@1@}.\n\
+@xref{" #mixed " Intrinsic}.\n"
+
+#define ARCHAIC_2nd(upper,mixed) \
+  "Archaic form of @code{" #upper "()} that is specific\n\
+to one type for @var{@2@}.\n\
+@xref{" #mixed " Intrinsic}.\n"
+
+#define ARCHAIC_2(upper,mixed) \
+  "Archaic form of @code{" #upper "()} that is specific\n\
+to one type for @var{@1@} and @var{@2@}.\n\
+@xref{" #mixed " Intrinsic}.\n"
+
+DEFDOC (ABS, "Absolute value.", "\
+Returns the absolute value of @var{@1@}.
+
+If @var{@1@} is type @code{COMPLEX}, the absolute
+value is computed as:
+
+@example
+SQRT(REALPART(@var{@1@})**2+IMAGPART(@var{@1@})**2)
+@end example
+
+@noindent
+Otherwise, it is computed by negating @var{@1@} if
+it is negative, or returning @var{@1@}.
+
+@xref{Sign Intrinsic}, for how to explicitly
+compute the positive or negative form of the absolute
+value of an expression.
+")
+
+DEFDOC (CABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs))
+
+DEFDOC (DABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs))
+
+DEFDOC (IABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs))
+
+DEFDOC (CDABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs))
+
+DEFDOC (ACHAR, "ASCII character from code.", "\
+Returns the ASCII character corresponding to the
+code specified by @var{@1@}.
+
+@xref{IAChar Intrinsic}, for the inverse of this function.
+
+@xref{Char Intrinsic}, for the function corresponding
+to the system's native character set.
+")
+
+DEFDOC (IACHAR, "ASCII code for character.", "\
+Returns the code for the ASCII character in the
+first character position of @var{@1@}.
+
+@xref{AChar Intrinsic}, for the inverse of this function.
+
+@xref{IChar Intrinsic}, for the function corresponding
+to the system's native character set.
+")
+
+DEFDOC (CHAR, "Character from code.", "\
+Returns the character corresponding to the
+code specified by @var{@1@}, using the system's
+native character set.
+
+Because the system's native character set is used,
+the correspondence between character and their codes
+is not necessarily the same between GNU Fortran
+implementations.
+
+Note that no intrinsic exists to convert a numerical
+value to a printable character string.
+For example, there is no intrinsic that, given
+an @code{INTEGER} or @code{REAL} argument with the
+value @samp{154}, returns the @code{CHARACTER}
+result @samp{'154'}.
+
+Instead, you can use internal-file I/O to do this kind
+of conversion.
+For example:
+
+@smallexample
+INTEGER VALUE
+CHARACTER*10 STRING
+VALUE = 154
+WRITE (STRING, '(I10)'), VALUE
+PRINT *, STRING
+END
+@end smallexample
+
+The above program, when run, prints:
+
+@smallexample
+        154
+@end smallexample
+
+@xref{IChar Intrinsic}, for the inverse of the @code{@0@} function.
+
+@xref{AChar Intrinsic}, for the function corresponding
+to the ASCII character set.
+")
+
+DEFDOC (ICHAR, "Code for character.", "\
+Returns the code for the character in the
+first character position of @var{@1@}.
+
+Because the system's native character set is used,
+the correspondence between character and their codes
+is not necessarily the same between GNU Fortran
+implementations.
+
+Note that no intrinsic exists to convert a printable
+character string to a numerical value.
+For example, there is no intrinsic that, given
+the @code{CHARACTER} value @samp{'154'}, returns an
+@code{INTEGER} or @code{REAL} value with the value @samp{154}.
+
+Instead, you can use internal-file I/O to do this kind
+of conversion.
+For example:
+
+@smallexample
+INTEGER VALUE
+CHARACTER*10 STRING
+STRING = '154'
+READ (STRING, '(I10)'), VALUE
+PRINT *, VALUE
+END
+@end smallexample
+
+The above program, when run, prints:
+
+@smallexample
+ 154
+@end smallexample
+
+@xref{Char Intrinsic}, for the inverse of the @code{@0@} function.
+
+@xref{IAChar Intrinsic}, for the function corresponding
+to the ASCII character set.
+")
+
+DEFDOC (ACOS, "Arc cosine.", "\
+Returns the arc-cosine (inverse cosine) of @var{@1@}
+in radians.
+
+@xref{Cos Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (DACOS, "Arc cosine (archaic).", ARCHAIC (ACOS, ACos))
+
+DEFDOC (AIMAG, "Convert/extract imaginary part of complex.", "\
+Returns the (possibly converted) imaginary part of @var{@1@}.
+
+Use of @code{@0@()} with an argument of a type
+other than @code{COMPLEX(KIND=1)} is restricted to the following case:
+
+@example
+REAL(AIMAG(@1@))
+@end example
+
+@noindent
+This expression converts the imaginary part of @1@ to
+@code{REAL(KIND=1)}.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+")
+
+DEFDOC (DIMAG, "Convert/extract imaginary part of complex (archaic).", ARCHAIC (AIMAG, AImag))
+
+DEFDOC (AINT, "Truncate to whole number.", "\
+Returns @var{@1@} with the fractional portion of its
+magnitude truncated and its sign preserved.
+(Also called ``truncation towards zero''.)
+
+@xref{ANInt Intrinsic}, for how to round to nearest
+whole number.
+
+@xref{Int Intrinsic}, for how to truncate and then convert
+number to @code{INTEGER}.
+")
+
+DEFDOC (DINT, "Truncate to whole number (archaic).", ARCHAIC (AINT, AInt))
+
+DEFDOC (INT, "Convert to @code{INTEGER} value truncated@99@to whole number.", "\
+Returns @var{@1@} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=1)}.
+
+If @var{@1@} is type @code{COMPLEX}, its real part is
+truncated and converted, and its imaginary part is disregarded.
+
+@xref{NInt Intrinsic}, for how to convert, rounded to nearest
+whole number.
+
+@xref{AInt Intrinsic}, for how to truncate to whole number
+without converting.
+")
+
+DEFDOC (IDINT, "Convert to @code{INTEGER} value truncated@99@to whole number (archaic).", ARCHAIC (INT, Int))
+
+DEFDOC (ANINT, "Round to nearest whole number.", "\
+Returns @var{@1@} with the fractional portion of its
+magnitude eliminated by rounding to the nearest whole
+number and with its sign preserved.
+
+A fractional portion exactly equal to
+@samp{.5} is rounded to the whole number that
+is larger in magnitude.
+(Also called ``Fortran round''.)
+
+@xref{AInt Intrinsic}, for how to truncate to
+whole number.
+
+@xref{NInt Intrinsic}, for how to round and then convert
+number to @code{INTEGER}.
+")
+
+DEFDOC (DNINT, "Round to nearest whole number (archaic).", ARCHAIC (ANINT, ANInt))
+
+DEFDOC (NINT, "Convert to @code{INTEGER} value rounded@99@to nearest whole number.", "\
+Returns @var{@1@} with the fractional portion of its
+magnitude eliminated by rounding to the nearest whole
+number and with its sign preserved, converted
+to type @code{INTEGER(KIND=1)}.
+
+If @var{@1@} is type @code{COMPLEX}, its real part is
+rounded and converted.
+
+A fractional portion exactly equal to
+@samp{.5} is rounded to the whole number that
+is larger in magnitude.
+(Also called ``Fortran round''.)
+
+@xref{Int Intrinsic}, for how to convert, truncate to
+whole number.
+
+@xref{ANInt Intrinsic}, for how to round to nearest whole number
+without converting.
+")
+
+DEFDOC (IDNINT, "Convert to @code{INTEGER} value rounded@99@to nearest whole number (archaic).", ARCHAIC (NINT, NInt))
+
+DEFDOC (LOG, "Natural logarithm.", "\
+Returns the natural logarithm of @var{@1@}, which must
+be greater than zero or, if type @code{COMPLEX}, must not
+be zero.
+
+@xref{Exp Intrinsic}, for the inverse of this function.
+
+@xref{Log10 Intrinsic}, for the `common' (base-10) logarithm function.
+")
+
+DEFDOC (ALOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log))
+
+DEFDOC (CLOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log))
+
+DEFDOC (DLOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log))
+
+DEFDOC (CDLOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log))
+
+DEFDOC (LOG10, "Common logarithm.", "\
+Returns the common logarithm (base 10) of @var{@1@}, which must
+be greater than zero.
+
+The inverse of this function is @samp{10. ** LOG10(@var{@1@})}.
+
+@xref{Log Intrinsic}, for the natural logarithm function.
+")
+
+DEFDOC (ALOG10, "Common logarithm (archaic).", ARCHAIC (LOG10, Log10))
+
+DEFDOC (DLOG10, "Common logarithm (archaic).", ARCHAIC (LOG10, Log10))
+
+DEFDOC (MAX, "Maximum value.", "\
+Returns the argument with the largest value.
+
+@xref{Min Intrinsic}, for the opposite function.
+")
+
+DEFDOC (AMAX0, "Maximum value (archaic).", "\
+Archaic form of @code{MAX()} that is specific
+to one type for @var{@1@} and a different return type.
+@xref{Max Intrinsic}.
+")
+
+DEFDOC (AMAX1, "Maximum value (archaic).", ARCHAIC (MAX, Max))
+
+DEFDOC (DMAX1, "Maximum value (archaic).", ARCHAIC (MAX, Max))
+
+DEFDOC (MAX0, "Maximum value (archaic).", ARCHAIC (MAX, Max))
+
+DEFDOC (MAX1, "Maximum value (archaic).", "\
+Archaic form of @code{MAX()} that is specific
+to one type for @var{@1@} and a different return type.
+@xref{Max Intrinsic}.
+")
+
+DEFDOC (MIN, "Minimum value.", "\
+Returns the argument with the smallest value.
+
+@xref{Max Intrinsic}, for the opposite function.
+")
+
+DEFDOC (AMIN0, "Minimum value (archaic).", "\
+Archaic form of @code{MIN()} that is specific
+to one type for @var{@1@} and a different return type.
+@xref{Min Intrinsic}.
+")
+
+DEFDOC (AMIN1, "Minimum value (archaic).", ARCHAIC (MIN, Min))
+
+DEFDOC (DMIN1, "Minimum value (archaic).", ARCHAIC (MIN, Min))
+
+DEFDOC (MIN0, "Minimum value (archaic).", ARCHAIC (MIN, Min))
+
+DEFDOC (MIN1, "Minimum value (archaic).", "\
+Archaic form of @code{MIN()} that is specific
+to one type for @var{@1@} and a different return type.
+@xref{Min Intrinsic}.
+")
+
+DEFDOC (MOD, "Remainder.", "\
+Returns remainder calculated as:
+
+@smallexample
+@var{@1@} - (INT(@var{@1@} / @var{@2@}) * @var{@2@})
+@end smallexample
+
+@var{@2@} must not be zero.
+")
+
+DEFDOC (AMOD, "Remainder (archaic).", ARCHAIC (MOD, Mod))
+
+DEFDOC (DMOD, "Remainder (archaic).", ARCHAIC (MOD, Mod))
+
+DEFDOC (AND, "Boolean AND.", "\
+Returns value resulting from boolean AND of
+pair of bits in each of @var{@1@} and @var{@2@}.
+")
+
+DEFDOC (IAND, "Boolean AND.", "\
+Returns value resulting from boolean AND of
+pair of bits in each of @var{@1@} and @var{@2@}.
+")
+
+DEFDOC (OR, "Boolean OR.", "\
+Returns value resulting from boolean OR of
+pair of bits in each of @var{@1@} and @var{@2@}.
+")
+
+DEFDOC (IOR, "Boolean OR.", "\
+Returns value resulting from boolean OR of
+pair of bits in each of @var{@1@} and @var{@2@}.
+")
+
+DEFDOC (XOR, "Boolean XOR.", "\
+Returns value resulting from boolean exclusive-OR of
+pair of bits in each of @var{@1@} and @var{@2@}.
+")
+
+DEFDOC (IEOR, "Boolean XOR.", "\
+Returns value resulting from boolean exclusive-OR of
+pair of bits in each of @var{@1@} and @var{@2@}.
+")
+
+DEFDOC (NOT, "Boolean NOT.", "\
+Returns value resulting from boolean NOT of each bit
+in @var{@1@}.
+")
+
+DEFDOC (ASIN, "Arc sine.", "\
+Returns the arc-sine (inverse sine) of @var{@1@}
+in radians.
+
+@xref{Sin Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (DASIN, "Arc sine (archaic).", ARCHAIC (ASIN, ASin))
+
+DEFDOC (ATAN, "Arc tangent.", "\
+Returns the arc-tangent (inverse tangent) of @var{@1@}
+in radians.
+
+@xref{Tan Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (DATAN, "Arc tangent (archaic).", ARCHAIC (ATAN, ATan))
+
+DEFDOC (ATAN2, "Arc tangent.", "\
+Returns the arc-tangent (inverse tangent) of the complex
+number (@var{@1@}, @var{@2@}) in radians.
+
+@xref{Tan Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (DATAN2, "Arc tangent (archaic).", ARCHAIC_2 (ATAN2, ATan2))
+
+DEFDOC (BIT_SIZE, "Number of bits in argument's type.", "\
+Returns the number of bits (integer precision plus sign bit)
+represented by the type for @var{@1@}.
+
+@xref{BTest Intrinsic}, for how to test the value of a
+bit in a variable or array.
+
+@xref{IBSet Intrinsic}, for how to set a bit in a variable to 1.
+
+@xref{IBClr Intrinsic}, for how to set a bit in a variable to 0.
+
+")
+
+DEFDOC (BTEST, "Test bit.", "\
+Returns @code{.TRUE.} if bit @var{@2@} in @var{@1@} is
+1, @code{.FALSE.} otherwise.
+
+(Bit 0 is the low-order (rightmost) bit, adding the value 
+@ifinfo
+2**0,
+@end ifinfo
+@iftex
+@tex
+$2^0$,
+@end tex
+@end iftex
+or 1,
+to the number if set to 1;
+bit 1 is the next-higher-order bit, adding 
+@ifinfo
+2**1,
+@end ifinfo
+@iftex
+@tex
+$2^1$,
+@end tex
+@end iftex
+or 2;
+bit 2 adds 
+@ifinfo
+2**2,
+@end ifinfo
+@iftex
+@tex
+$2^2$,
+@end tex
+@end iftex
+or 4; and so on.)
+
+@xref{Bit_Size Intrinsic}, for how to obtain the number of bits
+in a type.
+The leftmost bit of @var{@1@} is @samp{BIT_SIZE(@var{@1@}-1)}.
+")
+
+DEFDOC (CMPLX, "Construct @code{COMPLEX(KIND=1)} value.", "\
+If @var{@1@} is not type @code{COMPLEX},
+constructs a value of type @code{COMPLEX(KIND=1)} from the
+real and imaginary values specified by @var{@1@} and
+@var{@2@}, respectively.
+If @var{@2@} is omitted, @samp{0.} is assumed.
+
+If @var{@1@} is type @code{COMPLEX},
+converts it to type @code{COMPLEX(KIND=1)}.
+
+@xref{Complex Intrinsic}, for information on easily constructing
+a @code{COMPLEX} value of arbitrary precision from @code{REAL}
+arguments.
+")
+
+DEFDOC (DCMPLX, "Construct @code{COMPLEX(KIND=2)} value.", "\
+If @var{@1@} is not type @code{COMPLEX},
+constructs a value of type @code{COMPLEX(KIND=2)} from the
+real and imaginary values specified by @var{@1@} and
+@var{@2@}, respectively.
+If @var{@2@} is omitted, @samp{0D0} is assumed.
+
+If @var{@1@} is type @code{COMPLEX},
+converts it to type @code{COMPLEX(KIND=2)}.
+
+Although this intrinsic is not standard Fortran,
+it is a popular extension offered by many compilers
+that support @code{DOUBLE COMPLEX}, since it offers
+the easiest way to convert to @code{DOUBLE COMPLEX}
+without using Fortran 90 features (such as the @samp{KIND=}
+argument to the @code{CMPLX()} intrinsic).
+
+(@samp{CMPLX(0D0, 0D0)} returns a single-precision
+@code{COMPLEX} result, as required by standard FORTRAN 77.
+That's why so many compilers provide @code{DCMPLX()}, since
+@samp{DCMPLX(0D0, 0D0)} returns a @code{DOUBLE COMPLEX}
+result.
+Still, @code{DCMPLX()} converts even @code{REAL*16} arguments
+to their @code{REAL*8} equivalents in most dialects of
+Fortran, so neither it nor @code{CMPLX()} allow easy
+construction of arbitrary-precision values without
+potentially forcing a conversion involving extending or
+reducing precision.
+GNU Fortran provides such an intrinsic, called @code{COMPLEX()}.)
+
+@xref{Complex Intrinsic}, for information on easily constructing
+a @code{COMPLEX} value of arbitrary precision from @code{REAL}
+arguments.
+")
+
+DEFDOC (CONJG, "Complex conjugate.", "\
+Returns the complex conjugate:
+
+@example
+COMPLEX(REALPART(@var{@1@}), -IMAGPART(@var{@1@}))
+@end example
+")
+
+DEFDOC (DCONJG, "Complex conjugate (archaic).", ARCHAIC (CONJG, Conjg))
+
+DEFDOC (COS, "Cosine.", "\
+Returns the cosine of @var{@1@}, an angle measured
+in radians.
+
+@xref{ACos Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (CCOS, "Cosine (archaic).", ARCHAIC (COS, Cos))
+
+DEFDOC (DCOS, "Cosine (archaic).", ARCHAIC (COS, Cos))
+
+DEFDOC (CDCOS, "Cosine (archaic).", ARCHAIC (COS, Cos))
+
+DEFDOC (COSH, "Hyperbolic cosine.", "\
+Returns the hyperbolic cosine of @var{@1@}.
+")
+
+DEFDOC (DCOSH, "Hyperbolic cosine (archaic).", ARCHAIC (COSH, CosH))
+
+DEFDOC (SQRT, "Square root.", "\
+Returns the square root of @var{@1@}, which must
+not be negative.
+
+To calculate and represent the square root of a negative
+number, complex arithmetic must be used.
+For example, @samp{SQRT(COMPLEX(@var{@1@}))}.
+
+The inverse of this function is @samp{SQRT(@var{@1@}) * SQRT(@var{@1@})}.
+")
+
+DEFDOC (CSQRT, "Square root (archaic).", ARCHAIC (SQRT, SqRt))
+
+DEFDOC (DSQRT, "Square root (archaic).", ARCHAIC (SQRT, SqRt))
+
+DEFDOC (CDSQRT, "Square root (archaic).", ARCHAIC (SQRT, SqRt))
+
+DEFDOC (DBLE, "Convert to double precision.", "\
+Returns @var{@1@} converted to double precision
+(@code{REAL(KIND=2)}).
+If @var{@1@} is @code{COMPLEX}, the real part of
+@var{@1@} is used for the conversion
+and the imaginary part disregarded.
+
+@xref{Sngl Intrinsic}, for the function that converts
+to single precision.
+
+@xref{Int Intrinsic}, for the function that converts
+to @code{INTEGER}.
+
+@xref{Complex Intrinsic}, for the function that converts
+to @code{COMPLEX}.
+")
+
+DEFDOC (DIM, "Difference magnitude (non-negative subtract).", "\
+Returns @samp{@var{@1@}-@var{@2@}} if @var{@1@} is greater than
+@var{@2@}; otherwise returns zero.
+")
+
+DEFDOC (DDIM, "Difference magnitude (archaic).", ARCHAIC_2 (DIM, DiM))
+DEFDOC (IDIM, "Difference magnitude (archaic).", ARCHAIC_2 (DIM, DiM))
+
+DEFDOC (DPROD, "Double-precision product.", "\
+Returns @samp{DBLE(@var{@1@})*DBLE(@var{@2@})}.
+")
+
+DEFDOC (EXP, "Exponential.", "\
+Returns @samp{@var{e}**@var{@1@}}, where
+@var{e} is approximately 2.7182818.
+
+@xref{Log Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (CEXP, "Exponential (archaic).", ARCHAIC (EXP, Exp))
+
+DEFDOC (DEXP, "Exponential (archaic).", ARCHAIC (EXP, Exp))
+
+DEFDOC (CDEXP, "Exponential (archaic).", ARCHAIC (EXP, Exp))
+
+DEFDOC (FLOAT, "Conversion (archaic).", ARCHAIC (REAL, Real))
+DEFDOC (DFLOAT, "Conversion (archaic).", ARCHAIC (REAL, Real))
+
+DEFDOC (IFIX, "Conversion (archaic).", ARCHAIC (INT, Int))
+
+DEFDOC (LONG, "Conversion to @code{INTEGER(KIND=1)} (archaic).", "\
+Archaic form of @code{INT()} that is specific
+to one type for @var{@1@}.
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+")
+
+DEFDOC (SHORT, "Convert to @code{INTEGER(KIND=6)} value@99@truncated to whole number.", "\
+Returns @var{@1@} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=6)}.
+
+If @var{@1@} is type @code{COMPLEX}, its real part
+is truncated and converted, and its imaginary part is disregarded.
+
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+")
+
+DEFDOC (INT2, "Convert to @code{INTEGER(KIND=6)} value@99@truncated to whole number.", "\
+Returns @var{@1@} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=6)}.
+
+If @var{@1@} is type @code{COMPLEX}, its real part
+is truncated and converted, and its imaginary part is disregarded.
+
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+")
+
+DEFDOC (INT8, "Convert to @code{INTEGER(KIND=2)} value@99@truncated to whole number.", "\
+Returns @var{@1@} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=2)}.
+
+If @var{@1@} is type @code{COMPLEX}, its real part
+is truncated and converted, and its imaginary part is disregarded.
+
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+")
+
+DEFDOC (LEN, "Length of character entity.", "\
+Returns the length of @var{@1@}.
+
+If @var{@1@} is an array, the length of an element
+of @var{@1@} is returned.
+
+Note that @var{@1@} need not be defined when this
+intrinsic is invoked, since only the length, not
+the content, of @var{@1@} is needed.
+
+@xref{Bit_Size Intrinsic}, for the function that determines
+the size of its argument in bits.
+")
+
+DEFDOC (TAN, "Tangent.", "\
+Returns the tangent of @var{@1@}, an angle measured
+in radians.
+
+@xref{ATan Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (DTAN, "Tangent (archaic).", ARCHAIC (TAN, Tan))
+
+DEFDOC (TANH, "Hyperbolic tangent.", "\
+Returns the hyperbolic tangent of @var{@1@}.
+")
+
+DEFDOC (DTANH, "Hyperbolic tangent (archaic).", ARCHAIC (TANH, TanH))
+
+DEFDOC (SNGL, "Convert (archaic).", ARCHAIC (REAL, Real))
+
+DEFDOC (SIN, "Sine.", "\
+Returns the sine of @var{@1@}, an angle measured
+in radians.
+
+@xref{ASin Intrinsic}, for the inverse of this function.
+")
+
+DEFDOC (CSIN, "Sine (archaic).", ARCHAIC (SIN, Sin))
+
+DEFDOC (DSIN, "Sine (archaic).", ARCHAIC (SIN, Sin))
+
+DEFDOC (CDSIN, "Sine (archaic).", ARCHAIC (SIN, Sin))
+
+DEFDOC (SINH, "Hyperbolic sine.", "\
+Returns the hyperbolic sine of @var{@1@}.
+")
+
+DEFDOC (DSINH, "Hyperbolic sine (archaic).", ARCHAIC (SINH, SinH))
+
+DEFDOC (LSHIFT, "Left-shift bits.", "\
+Returns @var{@1@} shifted to the left
+@var{@2@} bits.
+
+Although similar to the expression
+@samp{@var{@1@}*(2**@var{@2@})}, there
+are important differences.
+For example, the sign of the result is
+not necessarily the same as the sign of
+@var{@1@}.
+
+Currently this intrinsic is defined assuming
+the underlying representation of @var{@1@}
+is as a two's-complement integer.
+It is unclear at this point whether that
+definition will apply when a different
+representation is involved.
+
+@xref{LShift Intrinsic}, for the inverse of this function.
+
+@xref{IShft Intrinsic}, for information
+on a more widely available left-shifting
+intrinsic that is also more precisely defined.
+")
+
+DEFDOC (RSHIFT, "Right-shift bits.", "\
+Returns @var{@1@} shifted to the right
+@var{@2@} bits.
+
+Although similar to the expression
+@samp{@var{@1@}/(2**@var{@2@})}, there
+are important differences.
+For example, the sign of the result is
+undefined.
+
+Currently this intrinsic is defined assuming
+the underlying representation of @var{@1@}
+is as a two's-complement integer.
+It is unclear at this point whether that
+definition will apply when a different
+representation is involved.
+
+@xref{RShift Intrinsic}, for the inverse of this function.
+
+@xref{IShft Intrinsic}, for information
+on a more widely available right-shifting
+intrinsic that is also more precisely defined.
+")
+
+DEFDOC (LGE, "Lexically greater than or equal.", "\
+Returns @samp{.TRUE.} if @samp{@var{@1@}.GE.@var{@2@}},
+@samp{.FALSE.} otherwise.
+@var{@1@} and @var{@2@} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{@1@} and @var{@2@} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+The lexical comparison intrinsics @code{LGe}, @code{LGt},
+@code{LLe}, and @code{LLt} differ from the corresponding
+intrinsic operators @code{.GE.}, @code{.GT.},
+@code{.LE.}, @code{.LT.}.
+Because the ASCII collating sequence is assumed,
+the following expressions always return @samp{.TRUE.}:
+
+@smallexample
+LGE ('0', ' ')
+LGE ('A', '0')
+LGE ('a', 'A')
+@end smallexample
+
+The following related expressions do @emph{not} always
+return @samp{.TRUE.}, as they are not necessarily evaluated
+assuming the arguments use ASCII encoding:
+
+@smallexample
+'0' .GE. ' '
+'A' .GE. '0'
+'a' .GE. 'A'
+@end smallexample
+
+The same difference exists
+between @code{LGt} and @code{.GT.};
+between @code{LLe} and @code{.LE.}; and
+between @code{LLt} and @code{.LT.}.
+")
+
+DEFDOC (LGT, "Lexically greater than.", "\
+Returns @samp{.TRUE.} if @samp{@var{@1@}.GT.@var{@2@}},
+@samp{.FALSE.} otherwise.
+@var{@1@} and @var{@2@} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{@1@} and @var{@2@} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+@xref{LGe Intrinsic}, for information on the distinction
+between the @code{@0@} intrinsic and the @code{.GT.}
+operator.
+")
+
+DEFDOC (LLE, "Lexically less than or equal.", "\
+Returns @samp{.TRUE.} if @samp{@var{@1@}.LE.@var{@2@}},
+@samp{.FALSE.} otherwise.
+@var{@1@} and @var{@2@} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{@1@} and @var{@2@} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+@xref{LGe Intrinsic}, for information on the distinction
+between the @code{@0@} intrinsic and the @code{.LE.}
+operator.
+")
+
+DEFDOC (LLT, "Lexically less than.", "\
+Returns @samp{.TRUE.} if @samp{@var{@1@}.LT.@var{@2@}},
+@samp{.FALSE.} otherwise.
+@var{@1@} and @var{@2@} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{@1@} and @var{@2@} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+@xref{LGe Intrinsic}, for information on the distinction
+between the @code{@0@} intrinsic and the @code{.LT.}
+operator.
+")
+
+DEFDOC (SIGN, "Apply sign to magnitude.", "\
+Returns @samp{ABS(@var{@1@})*@var{s}}, where
+@var{s} is +1 if @samp{@var{@2@}.GE.0},
+-1 otherwise.
+
+@xref{Abs Intrinsic}, for the function that returns
+the magnitude of a value.
+")
+
+DEFDOC (DSIGN, "Apply sign to magnitude (archaic).", ARCHAIC_2 (SIGN, Sign))
+DEFDOC (ISIGN, "Apply sign to magnitude (archaic).", ARCHAIC_2 (SIGN, Sign))
+
+DEFDOC (REAL, "Convert value to type @code{REAL(KIND=1)}.", "\
+Converts @var{@1@} to @code{REAL(KIND=1)}.
+
+Use of @code{@0@()} with a @code{COMPLEX} argument
+(other than @code{COMPLEX(KIND=1)}) is restricted to the following case:
+
+@example
+REAL(REAL(@1@))
+@end example
+
+@noindent
+This expression converts the real part of @1@ to
+@code{REAL(KIND=1)}.
+
+@xref{RealPart Intrinsic}, for information on a GNU Fortran
+intrinsic that extracts the real part of an arbitrary
+@code{COMPLEX} value.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+")
+
+DEFDOC (DREAL, "Convert value to type @code{REAL(KIND=2)}.", "\
+Converts @var{@1@} to @code{REAL(KIND=2)}.
+
+If @var{@1@} is type @code{COMPLEX}, its real part
+is converted (if necessary) to @code{REAL(KIND=2)},
+and its imaginary part is disregarded.
+
+Although this intrinsic is not standard Fortran,
+it is a popular extension offered by many compilers
+that support @code{DOUBLE COMPLEX}, since it offers
+the easiest way to extract the real part of a @code{DOUBLE COMPLEX}
+value without using the Fortran 90 @code{REAL()} intrinsic
+in a way that produces a return value inconsistent with
+the way many FORTRAN 77 compilers handle @code{REAL()} of
+a @code{DOUBLE COMPLEX} value.
+
+@xref{RealPart Intrinsic}, for information on a GNU Fortran
+intrinsic that avoids these areas of confusion.
+
+@xref{Dble Intrinsic}, for information on the standard FORTRAN 77
+replacement for @code{DREAL()}.
+
+@xref{REAL() and AIMAG() of Complex}, for more information on
+this issue.
+")
+
+DEFDOC (IMAGPART, "Extract imaginary part of complex.", "\
+The imaginary part of @var{@1@} is returned, without conversion.
+
+@emph{Note:} The way to do this in standard Fortran 90
+is @samp{AIMAG(@var{@1@})}.
+However, when, for example, @var{@1@} is @code{DOUBLE COMPLEX},
+@samp{AIMAG(@var{@1@})} means something different for some compilers
+that are not true Fortran 90 compilers but offer some
+extensions standardized by Fortran 90 (such as the
+@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}).
+
+The advantage of @code{@0@()} is that, while not necessarily
+more or less portable than @code{AIMAG()}, it is more likely to
+cause a compiler that doesn't support it to produce a diagnostic
+than generate incorrect code.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+")
+
+DEFDOC (COMPLEX, "Build complex value from real and@99@imaginary parts.", "\
+Returns a @code{COMPLEX} value that has @samp{@1@} and @samp{@2@} as its
+real and imaginary parts, respectively.
+
+If @var{@1@} and @var{@2@} are the same type, and that type is not
+@code{INTEGER}, no data conversion is performed, and the type of
+the resulting value has the same kind value as the types
+of @var{@1@} and @var{@2@}.
+
+If @var{@1@} and @var{@2@} are not the same type, the usual type-promotion
+rules are applied to both, converting either or both to the
+appropriate @code{REAL} type.
+The type of the resulting value has the same kind value as the
+type to which both @var{@1@} and @var{@2@} were converted, in this case.
+
+If @var{@1@} and @var{@2@} are both @code{INTEGER}, they are both converted
+to @code{REAL(KIND=1)}, and the result of the @code{@0@()}
+invocation is type @code{COMPLEX(KIND=1)}.
+
+@emph{Note:} The way to do this in standard Fortran 90
+is too hairy to describe here, but it is important to
+note that @samp{CMPLX(D1,D2)} returns a @code{COMPLEX(KIND=1)}
+result even if @samp{D1} and @samp{D2} are type @code{REAL(KIND=2)}.
+Hence the availability of @code{COMPLEX()} in GNU Fortran.
+")
+
+DEFDOC (LOC, "Address of entity in core.", "\
+The @code{LOC()} intrinsic works the
+same way as the @code{%LOC()} construct.
+@xref{%LOC(),,The @code{%LOC()} Construct}, for
+more information.
+")
+
+DEFDOC (REALPART, "Extract real part of complex.", "\
+The real part of @var{@1@} is returned, without conversion.
+
+@emph{Note:} The way to do this in standard Fortran 90
+is @samp{REAL(@var{@1@})}.
+However, when, for example, @var{@1@} is @code{COMPLEX(KIND=2)},
+@samp{REAL(@var{@1@})} means something different for some compilers
+that are not true Fortran 90 compilers but offer some
+extensions standardized by Fortran 90 (such as the
+@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}).
+
+The advantage of @code{@0@()} is that, while not necessarily
+more or less portable than @code{REAL()}, it is more likely to
+cause a compiler that doesn't support it to produce a diagnostic
+than generate incorrect code.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+")
+
+DEFDOC (GETARG, "Obtain command-line argument.", "\
+Sets @var{@2@} to the @var{@1@}-th command-line argument (or to all
+blanks if there are fewer than @var{@2@} command-line arguments);
+@code{CALL @0@(0, @var{value})} sets @var{value} to the name of the
+program (on systems that support this feature).
+
+@xref{IArgC Intrinsic}, for information on how to get the number
+of arguments.
+")
+
+DEFDOC (ABORT, "Abort the program.", "\
+Prints a message and potentially causes a core dump via @code{abort(3)}.
+")
+
+DEFDOC (EXIT, "Terminate the program.", "\
+Exit the program with status @var{@1@} after closing open Fortran
+I/O units and otherwise behaving as @code{exit(2)}.
+If @var{@1@} is omitted the canonical `success' value
+will be returned to the system.
+")
+
+DEFDOC (IARGC, "Obtain count of command-line arguments.", "\
+Returns the number of command-line arguments.
+
+This count does not include the specification of the program
+name itself.
+")
+
+DEFDOC (CTIME_func, "Convert time to Day Mon dd hh:mm:ss yyyy.", "\
+Converts @var{@1@}, a system time value, such as returned by
+@code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995},
+and returns that string as the function value.
+
+@xref{Time8 Intrinsic}.
+")
+
+DEFDOC (CTIME_subr, "Convert time to Day Mon dd hh:mm:ss yyyy.", "\
+Converts @var{@1@}, a system time value, such as returned by
+@code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995},
+and returns that string in @var{@2@}.
+
+@xref{Time8 Intrinsic}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+")
+
+DEFDOC (DATE, "Get current date as dd-Mon-yy.", "\
+Returns @var{@1@} in the form @samp{@var{dd}-@var{mmm}-@var{yy}},
+representing the numeric day of the month @var{dd}, a three-character
+abbreviation of the month name @var{mmm} and the last two digits of
+the year @var{yy}, e.g.@: @samp{25-Nov-96}.
+
+@cindex Y2K compliance
+@cindex Year 2000 compliance
+This intrinsic is not recommended, due to the year 2000 approaching.
+Therefore, programs making use of this intrinsic
+might not be Year 2000 (Y2K) compliant.
+@xref{CTime Intrinsic (subroutine)}, for information on obtaining more digits
+for the current (or any) date.
+")
+
+DEFDOC (DTIME_func, "Get elapsed time since last time.", "\
+Initially, return the number of seconds of runtime
+since the start of the process's execution
+as the function value,
+and the user and system components of this in @samp{@var{@1@}(1)}
+and @samp{@var{@1@}(2)} respectively.
+The functions' value is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}.
+
+Subsequent invocations of @samp{@0@()} return values accumulated since the
+previous invocation.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (DTIME_subr, "Get elapsed time since last time.", "\
+Initially, return the number of seconds of runtime
+since the start of the process's execution
+in @var{@2@},
+and the user and system components of this in @samp{@var{@1@}(1)}
+and @samp{@var{@1@}(2)} respectively.
+The value of @var{@2@} is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}.
+
+Subsequent invocations of @samp{@0@()} set values based on accumulations
+since the previous invocation.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+")
+
+DEFDOC (ETIME_func, "Get elapsed time for process.", "\
+Return the number of seconds of runtime
+since the start of the process's execution
+as the function value,
+and the user and system components of this in @samp{@var{@1@}(1)}
+and @samp{@var{@1@}(2)} respectively.
+The functions' value is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+")
+
+DEFDOC (ETIME_subr, "Get elapsed time for process.", "\
+Return the number of seconds of runtime
+since the start of the process's execution
+in @var{@2@},
+and the user and system components of this in @samp{@var{@1@}(1)}
+and @samp{@var{@1@}(2)} respectively.
+The value of @var{@2@} is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+")
+
+DEFDOC (FDATE_func, "Get current time as Day Mon dd hh:mm:ss yyyy.", "\
+Returns the current date (using the same format as @code{CTIME()}).
+
+Equivalent to:
+
+@example
+CTIME(TIME8())
+@end example
+
+@cindex Y10K compliance
+@cindex Year 10000 compliance
+@cindex wraparound, Y10K
+@cindex limits, Y10K
+Programs making use of this intrinsic
+might not be Year 10000 (Y10K) compliant.
+For example, the date might appear,
+to such programs, to wrap around
+(change from a larger value to a smaller one)
+as of the Year 10000.
+
+@xref{CTime Intrinsic (function)}.
+")
+
+DEFDOC (FDATE_subr, "Get current time as Day Mon dd hh:mm:ss yyyy.", "\
+Returns the current date (using the same format as @code{CTIME()})
+in @var{@1@}.
+
+Equivalent to:
+
+@example
+CALL CTIME(@var{@1@}, TIME8())
+@end example
+
+@cindex Y10K compliance
+@cindex Year 10000 compliance
+@cindex wraparound, Y10K
+@cindex limits, Y10K
+Programs making use of this intrinsic
+might not be Year 10000 (Y10K) compliant.
+For example, the date might appear,
+to such programs, to wrap around
+(change from a larger value to a smaller one)
+as of the Year 10000.
+
+@xref{CTime Intrinsic (subroutine)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+")
+
+DEFDOC (GMTIME, "Convert time to GMT time info.", "\
+Given a system time value @var{@1@}, fills @var{@2@} with values
+extracted from it appropriate to the GMT time zone using
+@code{gmtime(3)}.
+
+The array elements are as follows:
+
+@enumerate
+@item
+Seconds after the minute, range 0--59 or 0--61 to allow for leap
+seconds
+
+@item
+Minutes after the hour, range 0--59
+
+@item
+Hours past midnight, range 0--23
+
+@item
+Day of month, range 0--31
+
+@item
+Number of months since January, range 0--12
+
+@item
+Years since 1900
+
+@item
+Number of days since Sunday, range 0--6
+
+@item
+Days since January 1
+
+@item
+Daylight savings indicator: positive if daylight savings is in effect,
+zero if not, and negative if the information isn't available.
+@end enumerate
+")
+
+DEFDOC (LTIME, "Convert time to local time info.", "\
+Given a system time value @var{@1@}, fills @var{@2@} with values
+extracted from it appropriate to the GMT time zone using
+@code{localtime(3)}.
+
+The array elements are as follows:
+
+@enumerate
+@item
+Seconds after the minute, range 0--59 or 0--61 to allow for leap
+seconds
+
+@item
+Minutes after the hour, range 0--59
+
+@item
+Hours past midnight, range 0--23
+
+@item
+Day of month, range 0--31
+
+@item
+Number of months since January, range 0--12
+
+@item
+Years since 1900
+
+@item
+Number of days since Sunday, range 0--6
+
+@item
+Days since January 1
+
+@item
+Daylight savings indicator: positive if daylight savings is in effect,
+zero if not, and negative if the information isn't available.
+@end enumerate
+")
+
+DEFDOC (IDATE_unix, "Get local time info.", "\
+Fills @var{@1@} with the numerical values at the current local time.
+The day (in the range 1--31), month (in the range 1--12),
+and year appear in elements 1, 2, and 3 of @var{@1@}, respectively.
+The year has four significant digits.
+
+@cindex Y10K compliance
+@cindex Year 10000 compliance
+@cindex wraparound, Y10K
+@cindex limits, Y10K
+Programs making use of this intrinsic
+might not be Year 10000 (Y10K) compliant.
+For example, the date might appear,
+to such programs, to wrap around
+(change from a larger value to a smaller one)
+as of the Year 10000.
+")
+
+DEFDOC (IDATE_vxt, "Get local time info (VAX/VMS).", "\
+Returns the numerical values of the current local time.
+The month (in the range 1--12) is returned in @var{@1@},
+the day (in the range 1--31) in @var{@2@},
+and the year in @var{@3@} (in the range 0--99).
+
+@cindex Y2K compliance
+@cindex Year 2000 compliance
+@cindex wraparound, Y2K
+@cindex limits, Y2K
+This intrinsic is not recommended, due to the fact that
+its return value for year wraps around century boundaries
+(change from a larger value to a smaller one).
+Therefore, programs making use of this intrinsic, for
+instance, might not be Year 2000 (Y2K) compliant.
+For example, the date might appear,
+to such programs, to wrap around
+as of the Year 2000.
+
+@xref{IDate Intrinsic (UNIX)}, for information on obtaining more digits
+for the current date.
+")
+
+DEFDOC (ITIME, "Get local time of day.", "\
+Returns the current local time hour, minutes, and seconds in elements
+1, 2, and 3 of @var{@1@}, respectively.
+")
+
+DEFDOC (MCLOCK, "Get number of clock ticks for process.", "\
+Returns the number of clock ticks since the start of the process.
+Supported on systems with @code{clock(3)} (q.v.).
+
+@cindex wraparound, timings
+@cindex limits, timings
+This intrinsic is not fully portable, such as to systems
+with 32-bit @code{INTEGER} types but supporting times
+wider than 32 bits.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+@xref{MClock8 Intrinsic}, for information on a
+similar intrinsic that might be portable to more
+GNU Fortran implementations, though to fewer
+Fortran compilers.
+
+If the system does not support @code{clock(3)},
+-1 is returned.
+")
+
+DEFDOC (MCLOCK8, "Get number of clock ticks for process.", "\
+Returns the number of clock ticks since the start of the process.
+Supported on systems with @code{clock(3)} (q.v.).
+
+@cindex wraparound, timings
+@cindex limits, timings
+@emph{Warning:} this intrinsic does not increase the range
+of the timing values over that returned by @code{clock(3)}.
+On a system with a 32-bit @code{clock(3)},
+@code{@0@} will return a 32-bit value,
+even though converted to an @samp{INTEGER(KIND=2)} value.
+That means overflows of the 32-bit value can still occur.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+No Fortran implementations other than GNU Fortran are
+known to support this intrinsic at the time of this
+writing.
+@xref{MClock Intrinsic}, for information on a
+similar intrinsic that might be portable to more Fortran
+compilers, though to fewer GNU Fortran implementations.
+
+If the system does not support @code{clock(3)},
+-1 is returned.
+")
+
+DEFDOC (SECNDS, "Get local time offset since midnight.", "\
+Returns the local time in seconds since midnight minus the value
+@var{@1@}.
+
+@cindex wraparound, timings
+@cindex limits, timings
+This values returned by this intrinsic
+become numerically less than previous values
+(they wrap around) during a single run of the
+compiler program, under normal circumstances
+(such as running through the midnight hour).
+")
+
+DEFDOC (SECOND_func, "Get CPU time for process in seconds.", "\
+Returns the process's runtime in seconds---the same value as the
+UNIX function @code{etime} returns.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+")
+
+DEFDOC (SECOND_subr, "Get CPU time for process@99@in seconds.", "\
+Returns the process's runtime in seconds in @var{@1@}---the same value
+as the UNIX function @code{etime} returns.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+This routine is known from Cray Fortran.  @xref{CPU_Time Intrinsic},
+for a standard equivalent.
+")
+
+DEFDOC (SYSTEM_CLOCK, "Get current system clock value.", "\
+Returns in @var{@1@} the current value of the system clock; this is
+the value returned by the UNIX function @code{times(2)}
+in this implementation, but
+isn't in general.
+@var{@2@} is the number of clock ticks per second and
+@var{@3@} is the maximum value this can take, which isn't very useful
+in this implementation since it's just the maximum C @code{unsigned
+int} value.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+")
+
+DEFDOC (CPU_TIME, "Get current CPU time.", "\
+Returns in @var{@1@} the current value of the system time.
+This implementation of the Fortran 95 intrinsic is just an alias for
+@code{second} @xref{Second Intrinsic (subroutine)}.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+")
+
+DEFDOC (TIME8, "Get current time as time value.", "\
+Returns the current time encoded as a long integer
+(in the manner of the UNIX function @code{time(3)}).
+This value is suitable for passing to @code{CTIME},
+@code{GMTIME}, and @code{LTIME}.
+
+@cindex wraparound, timings
+@cindex limits, timings
+@emph{Warning:} this intrinsic does not increase the range
+of the timing values over that returned by @code{time(3)}.
+On a system with a 32-bit @code{time(3)},
+@code{@0@} will return a 32-bit value,
+even though converted to an @samp{INTEGER(KIND=2)} value.
+That means overflows of the 32-bit value can still occur.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+No Fortran implementations other than GNU Fortran are
+known to support this intrinsic at the time of this
+writing.
+@xref{Time Intrinsic (UNIX)}, for information on a
+similar intrinsic that might be portable to more Fortran
+compilers, though to fewer GNU Fortran implementations.
+")
+
+DEFDOC (TIME_unix, "Get current time as time value.", "\
+Returns the current time encoded as an integer
+(in the manner of the UNIX function @code{time(3)}).
+This value is suitable for passing to @code{CTIME},
+@code{GMTIME}, and @code{LTIME}.
+
+@cindex wraparound, timings
+@cindex limits, timings
+This intrinsic is not fully portable, such as to systems
+with 32-bit @code{INTEGER} types but supporting times
+wider than 32 bits.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+@xref{Time8 Intrinsic}, for information on a
+similar intrinsic that might be portable to more
+GNU Fortran implementations, though to fewer
+Fortran compilers.
+")
+
+#define BES(num,n,val) "\
+Calculates the Bessel function of the " #num " kind of \
+order " #n " of @var{@" #val "@}.\n\
+See @code{bessel(3m)}, on whose implementation the \
+function depends.\
+"
+
+DEFDOC (BESJ0, "Bessel function.", BES (first, 0, 1))
+DEFDOC (BESJ1, "Bessel function.", BES (first, 1, 1))
+DEFDOC (BESJN, "Bessel function.", BES (first, @var{N}, 2))
+DEFDOC (BESY0, "Bessel function.", BES (second, 0, 1))
+DEFDOC (BESY1, "Bessel function.", BES (second, 1, 1))
+DEFDOC (BESYN, "Bessel function.", BES (second, @var{N}, 2))
+DEFDOC (DBESJ0, "Bessel function (archaic).", ARCHAIC (BESJ0, BesJ0))
+DEFDOC (DBESJ1, "Bessel function (archaic).", ARCHAIC (BESJ1, BesJ1))
+DEFDOC (DBESJN, "Bessel function (archaic).", ARCHAIC_2nd (BESJN, BesJN))
+DEFDOC (DBESY0, "Bessel function (archaic).", ARCHAIC (BESY0, BesY0))
+DEFDOC (DBESY1, "Bessel function (archaic).", ARCHAIC (BESY1, BesY1))
+DEFDOC (DBESYN, "Bessel function (archaic).", ARCHAIC_2nd (BESYN, BesYN))
+
+DEFDOC (ERF, "Error function.", "\
+Returns the error function of @var{@1@}.
+See @code{erf(3m)}, which provides the implementation.
+")
+
+DEFDOC (ERFC, "Complementary error function.", "\
+Returns the complementary error function of @var{@1@}:
+@samp{ERFC(R) = 1 - ERF(R)} (except that the result might be more
+accurate than explicitly evaluating that formulae would give).
+See @code{erfc(3m)}, which provides the implementation.
+")
+
+DEFDOC (DERF, "Error function (archaic).", ARCHAIC (ERF, ErF))
+DEFDOC (DERFC, "Complementary error function (archaic).", ARCHAIC (ERFC, ErFC))
+
+DEFDOC (IRAND, "Random number.", "\
+Returns a uniform quasi-random number up to a system-dependent limit.
+If @var{@1@} is 0, the next number in sequence is returned; if
+@var{@1@} is 1, the generator is restarted by calling the UNIX function
+@samp{srand(0)}; if @var{@1@} has any other value,
+it is used as a new seed with @code{srand()}.
+
+@xref{SRand Intrinsic}.
+
+@emph{Note:} As typically implemented (by the routine of the same
+name in the C library), this random number generator is a very poor
+one, though the BSD and GNU libraries provide a much better
+implementation than the `traditional' one.
+On a different system you almost certainly want to use something better.
+")
+
+DEFDOC (RAND, "Random number.", "\
+Returns a uniform quasi-random number between 0 and 1.
+If @var{@1@} is 0, the next number in sequence is returned; if
+@var{@1@} is 1, the generator is restarted by calling @samp{srand(0)};
+if @var{@1@} has any other value, it is used as a new seed with
+@code{srand}.
+
+@xref{SRand Intrinsic}.
+
+@emph{Note:} As typically implemented (by the routine of the same
+name in the C library), this random number generator is a very poor
+one, though the BSD and GNU libraries provide a much better
+implementation than the `traditional' one.
+On a different system you
+almost certainly want to use something better.
+")
+
+DEFDOC (SRAND, "Random seed.", "\
+Reinitializes the generator with the seed in @var{@1@}.
+@xref{IRand Intrinsic}.
+@xref{Rand Intrinsic}.
+")
+
+DEFDOC (ACCESS, "Check file accessibility.", "\
+Checks file @var{@1@} for accessibility in the mode specified by @var{@2@} and
+returns 0 if the file is accessible in that mode, otherwise an error
+code if the file is inaccessible or @var{@2@} is invalid.
+See @code{access(2)}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+@var{@2@} may be a concatenation of any of the following characters:
+
+@table @samp
+@item r
+Read permission
+
+@item w
+Write permission
+
+@item x
+Execute permission
+
+@item @kbd{SPC}
+Existence
+@end table
+")
+
+DEFDOC (CHDIR_subr, "Change directory.", "\
+Sets the current working directory to be @var{@1@}.
+If the @var{@2@} argument is supplied, it contains 0
+on success or a nonzero error code otherwise upon return.
+See @code{chdir(3)}.
+
+@emph{Caution:} Using this routine during I/O to a unit connected with a
+non-absolute file name can cause subsequent I/O on such a unit to fail
+because the I/O library might reopen files by name.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@2@} argument.
+")
+
+DEFDOC (CHDIR_func, "Change directory.", "\
+Sets the current working directory to be @var{@1@}.
+Returns 0 on success or a nonzero error code.
+See @code{chdir(3)}.
+
+@emph{Caution:} Using this routine during I/O to a unit connected with a
+non-absolute file name can cause subsequent I/O on such a unit to fail
+because the I/O library might reopen files by name.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (CHMOD_func, "Change file modes.", "\
+Changes the access mode of file @var{@1@} according to the
+specification @var{@2@}, which is given in the format of
+@code{chmod(1)}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+Currently, @var{@1@} must not contain the single quote
+character.
+
+Returns 0 on success or a nonzero error code otherwise.
+
+Note that this currently works
+by actually invoking @code{/bin/chmod} (or the @code{chmod} found when
+the library was configured) and so might fail in some circumstances and
+will, anyway, be slow.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (CHMOD_subr, "Change file modes.", "\
+Changes the access mode of file @var{@1@} according to the
+specification @var{@2@}, which is given in the format of
+@code{chmod(1)}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+Currently, @var{@1@} must not contain the single quote
+character.
+
+If the @var{@3@} argument is supplied, it contains
+0 on success or a nonzero error code upon return.
+
+Note that this currently works
+by actually invoking @code{/bin/chmod} (or the @code{chmod} found when
+the library was configured) and so might fail in some circumstances and
+will, anyway, be slow.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (GETCWD_func, "Get current working directory.", "\
+Places the current working directory in @var{@1@}.
+Returns 0 on
+success, otherwise a nonzero error code
+(@code{ENOSYS} if the system does not provide @code{getcwd(3)}
+or @code{getwd(3)}).
+")
+
+DEFDOC (GETCWD_subr, "Get current working directory.", "\
+Places the current working directory in @var{@1@}.
+If the @var{@2@} argument is supplied, it contains 0
+success or a nonzero error code upon return
+(@code{ENOSYS} if the system does not provide @code{getcwd(3)}
+or @code{getwd(3)}).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@2@} argument.
+")
+
+DEFDOC (FSTAT_func, "Get file information.", "\
+Obtains data about the file open on Fortran I/O unit @var{@1@} and
+places them in the array @var{@2@}.
+The values in this array are
+extracted from the @code{stat} structure as returned by
+@code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+Device ID
+
+@item
+Inode number
+
+@item
+File mode
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+ID of device containing directory entry for file
+(0 if not available)
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size (-1 if not available)
+
+@item
+Number of blocks allocated (-1 if not available)
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+Returns 0 on success or a nonzero error code.
+")
+
+DEFDOC (FSTAT_subr, "Get file information.", "\
+Obtains data about the file open on Fortran I/O unit @var{@1@} and
+places them in the array @var{@2@}.
+The values in this array are
+extracted from the @code{stat} structure as returned by
+@code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+Device ID
+
+@item
+Inode number
+
+@item
+File mode
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+ID of device containing directory entry for file
+(0 if not available)
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size (-1 if not available)
+
+@item
+Number of blocks allocated (-1 if not available)
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+If the @var{@3@} argument is supplied, it contains
+0 on success or a nonzero error code upon return.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (LSTAT_func, "Get file information.", "\
+Obtains data about the given file @var{@1@} and places them in the array
+@var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+If @var{@1@} is a symbolic link it returns data on the
+link itself, so the routine is available only on systems that support
+symbolic links.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+Device ID
+
+@item
+Inode number
+
+@item
+File mode
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+ID of device containing directory entry for file
+(0 if not available)
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size (-1 if not available)
+
+@item
+Number of blocks allocated (-1 if not available)
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+Returns 0 on success or a nonzero error code
+(@code{ENOSYS} if the system does not provide @code{lstat(2)}).
+")
+
+DEFDOC (LSTAT_subr, "Get file information.", "\
+Obtains data about the given file @var{@1@} and places them in the array
+@var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+If @var{@1@} is a symbolic link it returns data on the
+link itself, so the routine is available only on systems that support
+symbolic links.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+Device ID
+
+@item
+Inode number
+
+@item
+File mode
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+ID of device containing directory entry for file
+(0 if not available)
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size (-1 if not available)
+
+@item
+Number of blocks allocated (-1 if not available)
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+If the @var{@3@} argument is supplied, it contains
+0 on success or a nonzero error code upon return
+(@code{ENOSYS} if the system does not provide @code{lstat(2)}).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (STAT_func, "Get file information.", "\
+Obtains data about the given file @var{@1@} and places them in the array
+@var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+Device ID
+
+@item
+Inode number
+
+@item
+File mode
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+ID of device containing directory entry for file
+(0 if not available)
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size (-1 if not available)
+
+@item
+Number of blocks allocated (-1 if not available)
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+Returns 0 on success or a nonzero error code.
+")
+
+DEFDOC (STAT_subr, "Get file information.", "\
+Obtains data about the given file @var{@1@} and places them in the array
+@var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+Device ID
+
+@item
+Inode number
+
+@item
+File mode
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+ID of device containing directory entry for file
+(0 if not available)
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size (-1 if not available)
+
+@item
+Number of blocks allocated (-1 if not available)
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+If the @var{@3@} argument is supplied, it contains
+0 on success or a nonzero error code upon return.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (LINK_subr, "Make hard link in file system.", "\
+Makes a (hard) link from file @var{@1@} to @var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{@1@} and @var{@2@}---otherwise,
+trailing blanks in @var{@1@} and @var{@2@} are ignored.
+If the @var{@3@} argument is supplied, it contains
+0 on success or a nonzero error code upon return.
+See @code{link(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (LINK_func, "Make hard link in file system.", "\
+Makes a (hard) link from file @var{@1@} to @var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{@1@} and @var{@2@}---otherwise,
+trailing blanks in @var{@1@} and @var{@2@} are ignored.
+Returns 0 on success or a nonzero error code.
+See @code{link(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (SYMLNK_subr, "Make symbolic link in file system.", "\
+Makes a symbolic link from file @var{@1@} to @var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{@1@} and @var{@2@}---otherwise,
+trailing blanks in @var{@1@} and @var{@2@} are ignored.
+If the @var{@3@} argument is supplied, it contains
+0 on success or a nonzero error code upon return
+(@code{ENOSYS} if the system does not provide @code{symlink(2)}).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (SYMLNK_func, "Make symbolic link in file system.", "\
+Makes a symbolic link from file @var{@1@} to @var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{@1@} and @var{@2@}---otherwise,
+trailing blanks in @var{@1@} and @var{@2@} are ignored.
+Returns 0 on success or a nonzero error code
+(@code{ENOSYS} if the system does not provide @code{symlink(2)}).
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (RENAME_subr, "Rename file.", "\
+Renames the file @var{@1@} to @var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{@1@} and @var{@2@}---otherwise,
+trailing blanks in @var{@1@} and @var{@2@} are ignored.
+See @code{rename(2)}.
+If the @var{@3@} argument is supplied, it contains
+0 on success or a nonzero error code upon return.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (RENAME_func, "Rename file.", "\
+Renames the file @var{@1@} to @var{@2@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{@1@} and @var{@2@}---otherwise,
+trailing blanks in @var{@1@} and @var{@2@} are ignored.
+See @code{rename(2)}.
+Returns 0 on success or a nonzero error code.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (UMASK_subr, "Set file creation permissions mask.", "\
+Sets the file creation mask to @var{@1@} and returns the old value in
+argument @var{@2@} if it is supplied.
+See @code{umask(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+")
+
+DEFDOC (UMASK_func, "Set file creation permissions mask.", "\
+Sets the file creation mask to @var{@1@} and returns the old value.
+See @code{umask(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (UNLINK_subr, "Unlink file.", "\
+Unlink the file @var{@1@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+If the @var{@2@} argument is supplied, it contains
+0 on success or a nonzero error code upon return.
+See @code{unlink(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@2@} argument.
+")
+
+DEFDOC (UNLINK_func, "Unlink file.", "\
+Unlink the file @var{@1@}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+Returns 0 on success or a nonzero error code.
+See @code{unlink(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (GERROR, "Get error message for last error.", "\
+Returns the system error message corresponding to the last system
+error (C @code{errno}).
+")
+
+DEFDOC (IERRNO, "Get error number for last error.", "\
+Returns the last system error number (corresponding to the C
+@code{errno}).
+")
+
+DEFDOC (PERROR, "Print error message for last error.", "\
+Prints (on the C @code{stderr} stream) a newline-terminated error
+message corresponding to the last system error.
+This is prefixed by @var{@1@}, a colon and a space.
+See @code{perror(3)}.
+")
+ 
+DEFDOC (GETGID, "Get process group id.", "\
+Returns the group id for the current process.
+")
+ 
+DEFDOC (GETUID, "Get process user id.", "\
+Returns the user id for the current process.
+")
+ 
+DEFDOC (GETPID, "Get process id.", "\
+Returns the process id for the current process.
+")
+
+DEFDOC (GETENV, "Get environment variable.", "\
+Sets @var{@2@} to the value of environment variable given by the
+value of @var{@1@} (@code{$name} in shell terms) or to blanks if
+@code{$name} has not been set.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{@1@}---otherwise,
+trailing blanks in @var{@1@} are ignored.
+")
+
+DEFDOC (GETLOG, "Get login name.", "\
+Returns the login name for the process in @var{@1@}.
+
+@emph{Caution:} On some systems, the @code{getlogin(3)}
+function, which this intrinsic calls at run time,
+is either not implemented or returns a null pointer.
+In the latter case, this intrinsic returns blanks
+in @var{@1@}.
+")
+
+DEFDOC (HOSTNM_func, "Get host name.", "\
+Fills @var{@1@} with the system's host name returned by
+@code{gethostname(2)}, returning 0 on success or a nonzero error code
+(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
+
+On some systems (specifically SCO) it might be necessary to link the
+``socket'' library if you call this routine.
+Typically this means adding @samp{-lg2c -lsocket -lm}
+to the @code{g77} command line when linking the program.
+")
+
+DEFDOC (HOSTNM_subr, "Get host name.", "\
+Fills @var{@1@} with the system's host name returned by
+@code{gethostname(2)}.
+If the @var{@2@} argument is supplied, it contains
+0 on success or a nonzero error code upon return
+(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@2@} argument.
+
+On some systems (specifically SCO) it might be necessary to link the
+``socket'' library if you call this routine.
+Typically this means adding @samp{-lg2c -lsocket -lm}
+to the @code{g77} command line when linking the program.
+")
+
+DEFDOC (FLUSH, "Flush buffered output.", "\
+Flushes Fortran unit(s) currently open for output.
+Without the optional argument, all such units are flushed,
+otherwise just the unit specified by @var{@1@}.
+
+Some non-GNU implementations of Fortran provide this intrinsic
+as a library procedure that might or might not support the
+(optional) @var{@1@} argument.
+")
+
+DEFDOC (FNUM, "Get file descriptor from Fortran unit number.", "\
+Returns the Unix file descriptor number corresponding to the open
+Fortran I/O unit @var{@1@}.
+This could be passed to an interface to C I/O routines.
+")
+
+#define IOWARN "
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+"
+
+DEFDOC (FGET_func, "Read a character from unit 5 stream-wise.", "\
+Reads a single character into @var{@1@} in stream mode from unit 5
+(by-passing normal formatted input) using @code{getc(3)}.
+Returns 0 on
+success, @minus{}1 on end-of-file, and the error code from
+@code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FGET_subr, "Read a character from unit 5 stream-wise.", "\
+Reads a single character into @var{@1@} in stream mode from unit 5
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns in
+@var{@2@} 0 on success, @minus{}1 on end-of-file, and the error code
+from @code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FGETC_func, "Read a character stream-wise.", "\
+Reads a single character into @var{@2@} in stream mode from unit @var{@1@}
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns 0 on
+success, @minus{}1 on end-of-file, and the error code from
+@code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FGETC_subr, "Read a character stream-wise.", "\
+Reads a single character into @var{@2@} in stream mode from unit @var{@1@}
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns in
+@var{@3@} 0 on success, @minus{}1 on end-of-file, and the error code from
+@code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FPUT_func, "Write a character to unit 6 stream-wise.", "\
+Writes the single character @var{@1@} in stream mode to unit 6
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns 0 on
+success, the error code from @code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FPUT_subr, "Write a character to unit 6 stream-wise.", "\
+Writes the single character @var{@1@} in stream mode to unit 6
+(by-passing normal formatted output) using @code{putc(3)}.
+Returns in
+@var{@2@} 0 on success, the error code from @code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FPUTC_func, "Write a character stream-wise.", "\
+Writes the single character @var{@2@} in stream mode to unit @var{@1@}
+(by-passing normal formatted output) using @code{putc(3)}.
+Returns 0 on
+success, the error code from @code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FPUTC_subr, "Write a character stream-wise.", "\
+Writes the single character @var{@1@} in stream mode to unit 6
+(by-passing normal formatted output) using @code{putc(3)}.
+Returns in
+@var{@2@} 0 on success, the error code from @code{ferror(3)} otherwise.
+" IOWARN)
+
+DEFDOC (FSEEK, "Position file (low-level).", "\
+Attempts to move Fortran unit @var{@1@} to the specified
+@var{@2@}: absolute offset if @var{@3@}=0; relative to the
+current offset if @var{@3@}=1; relative to the end of the file if
+@var{@3@}=2.
+It branches to label @var{@4@} if @var{@1@} is
+not open or if the call otherwise fails.
+")
+
+DEFDOC (FTELL_func, "Get file position (low-level).", "\
+Returns the current offset of Fortran unit @var{@1@}
+(or @minus{}1 if @var{@1@} is not open).
+")
+
+DEFDOC (FTELL_subr, "Get file position (low-level).", "\
+Sets @var{@2@} to the current offset of Fortran unit @var{@1@}
+(or to @minus{}1 if @var{@1@} is not open).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+")
+
+DEFDOC (ISATTY, "Is unit connected to a terminal?", "\
+Returns @code{.TRUE.} if and only if the Fortran I/O unit
+specified by @var{@1@} is connected
+to a terminal device.
+See @code{isatty(3)}.
+")
+
+DEFDOC (TTYNAM_func, "Get name of terminal device for unit.", "\
+Returns the name of the terminal device open on logical unit
+@var{@1@} or a blank string if @var{@1@} is not connected to a
+terminal.
+")
+
+DEFDOC (TTYNAM_subr, "Get name of terminal device for unit.", "\
+Sets @var{@2@} to the name of the terminal device open on logical unit
+@var{@1@} or to a blank string if @var{@1@} is not connected to a
+terminal.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+")
+
+DEFDOC (SIGNAL_subr, "Muck with signal handling.", "\
+If @var{@2@} is a an @code{EXTERNAL} routine, arranges for it to be
+invoked with a single integer argument (of system-dependent length)
+when signal @var{@1@} occurs.
+If @var{@2@} is an integer, it can be
+used to turn off handling of signal @var{@1@} or revert to its default
+action.
+See @code{signal(2)}.
+
+Note that @var{@2@} will be called using C conventions,
+so the value of its argument in Fortran terms
+Fortran terms is obtained by applying @code{%LOC()} (or @code{LOC()}) to it.
+
+The value returned by @code{signal(2)} is written to @var{@3@}, if
+that argument is supplied.
+Otherwise the return value is ignored.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+
+@emph{Warning:} Use of the @code{libf2c} run-time library function
+@samp{signal_} directly
+(such as via @samp{EXTERNAL SIGNAL})
+requires use of the @code{%VAL()} construct
+to pass an @code{INTEGER} value
+(such as @samp{SIG_IGN} or @samp{SIG_DFL})
+for the @var{@2@} argument.
+
+However, while @samp{CALL SIGNAL(@var{signum}, %VAL(SIG_IGN))}
+works when @samp{SIGNAL} is treated as an external procedure
+(and resolves, at link time, to @code{libf2c}'s @samp{signal_} routine),
+this construct is not valid when @samp{SIGNAL} is recognized
+as the intrinsic of that name.
+
+Therefore, for maximum portability and reliability,
+code such references to the @samp{SIGNAL} facility as follows:
+
+@smallexample
+INTRINSIC SIGNAL
+@dots{}
+CALL SIGNAL(@var{signum}, SIG_IGN)
+@end smallexample
+
+@code{g77} will compile such a call correctly,
+while other compilers will generally either do so as well
+or reject the @samp{INTRINSIC SIGNAL} statement via a diagnostic,
+allowing you to take appropriate action.
+")
+
+DEFDOC (SIGNAL_func, "Muck with signal handling.", "\
+If @var{@2@} is a an @code{EXTERNAL} routine, arranges for it to be
+invoked with a single integer argument (of system-dependent length)
+when signal @var{@1@} occurs.
+If @var{@2@} is an integer, it can be
+used to turn off handling of signal @var{@1@} or revert to its default
+action.
+See @code{signal(2)}.
+
+Note that @var{@2@} will be called using C conventions,
+so the value of its argument in Fortran terms
+is obtained by applying @code{%LOC()} (or @code{LOC()}) to it.
+
+The value returned by @code{signal(2)} is returned.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+@emph{Warning:} If the returned value is stored in
+an @code{INTEGER(KIND=1)} (default @code{INTEGER}) argument,
+truncation of the original return value occurs on some systems
+(such as Alphas, which have 64-bit pointers but 32-bit default integers),
+with no warning issued by @code{g77} under normal circumstances.
+
+Therefore, the following code fragment might silently fail on
+some systems:
+
+@smallexample
+INTEGER RTN
+EXTERNAL MYHNDL
+RTN = SIGNAL(@var{signum}, MYHNDL)
+@dots{}
+! Restore original handler:
+RTN = SIGNAL(@var{signum}, RTN)
+@end smallexample
+
+The reason for the failure is that @samp{RTN} might not hold
+all the information on the original handler for the signal,
+thus restoring an invalid handler.
+This bug could manifest itself as a spurious run-time failure
+at an arbitrary point later during the program's execution,
+for example.
+
+@emph{Warning:} Use of the @code{libf2c} run-time library function
+@samp{signal_} directly
+(such as via @samp{EXTERNAL SIGNAL})
+requires use of the @code{%VAL()} construct
+to pass an @code{INTEGER} value
+(such as @samp{SIG_IGN} or @samp{SIG_DFL})
+for the @var{@2@} argument.
+
+However, while @samp{RTN = SIGNAL(@var{signum}, %VAL(SIG_IGN))}
+works when @samp{SIGNAL} is treated as an external procedure
+(and resolves, at link time, to @code{libf2c}'s @samp{signal_} routine),
+this construct is not valid when @samp{SIGNAL} is recognized
+as the intrinsic of that name.
+
+Therefore, for maximum portability and reliability,
+code such references to the @samp{SIGNAL} facility as follows:
+
+@smallexample
+INTRINSIC SIGNAL
+@dots{}
+RTN = SIGNAL(@var{signum}, SIG_IGN)
+@end smallexample
+
+@code{g77} will compile such a call correctly,
+while other compilers will generally either do so as well
+or reject the @samp{INTRINSIC SIGNAL} statement via a diagnostic,
+allowing you to take appropriate action.
+")
+
+DEFDOC (KILL_func, "Signal a process.", "\
+Sends the signal specified by @var{@2@} to the process @var{@1@}.
+Returns 0 on success or a nonzero error code.
+See @code{kill(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+")
+
+DEFDOC (KILL_subr, "Signal a process.", "\
+Sends the signal specified by @var{@2@} to the process @var{@1@}.
+If the @var{@3@} argument is supplied, it contains
+0 on success or a nonzero error code upon return.
+See @code{kill(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@3@} argument.
+")
+
+DEFDOC (LNBLNK, "Get last non-blank character in string.", "\
+Returns the index of the last non-blank character in @var{@1@}.
+@code{LNBLNK} and @code{LEN_TRIM} are equivalent.
+")
+
+DEFDOC (SLEEP, "Sleep for a specified time.", "\
+Causes the process to pause for @var{@1@} seconds.
+See @code{sleep(2)}.
+")
+
+DEFDOC (SYSTEM_subr, "Invoke shell (system) command.", "\
+Passes the command @var{@1@} to a shell (see @code{system(3)}).
+If argument @var{@2@} is present, it contains the value returned by
+@code{system(3)}, presumably 0 if the shell command succeeded.
+Note that which shell is used to invoke the command is system-dependent
+and environment-dependent.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{@2@} argument.
+")
+
+DEFDOC (SYSTEM_func, "Invoke shell (system) command.", "\
+Passes the command @var{@1@} to a shell (see @code{system(3)}).
+Returns the value returned by
+@code{system(3)}, presumably 0 if the shell command succeeded.
+Note that which shell is used to invoke the command is system-dependent
+and environment-dependent.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+However, the function form can be valid in cases where the
+actual side effects performed by the call are unimportant to
+the application.
+
+For example, on a UNIX system, @samp{SAME = SYSTEM('cmp a b')}
+does not perform any side effects likely to be important to the
+program, so the programmer would not care if the actual system
+call (and invocation of @code{cmp}) was optimized away in a situation
+where the return value could be determined otherwise, or was not
+actually needed (@samp{SAME} not actually referenced after the
+sample assignment statement).
+")
+
+DEFDOC (TIME_vxt, "Get the time as a character value.", "\
+Returns in @var{@1@} a character representation of the current time as
+obtained from @code{ctime(3)}.
+
+@cindex Y10K compliance
+@cindex Year 10000 compliance
+@cindex wraparound, Y10K
+@cindex limits, Y10K
+Programs making use of this intrinsic
+might not be Year 10000 (Y10K) compliant.
+For example, the date might appear,
+to such programs, to wrap around
+(change from a larger value to a smaller one)
+as of the Year 10000.
+
+@xref{FDate Intrinsic (subroutine)}, for an equivalent routine.
+")
+
+DEFDOC (IBCLR, "Clear a bit.", "\
+Returns the value of @var{@1@} with bit @var{@2@} cleared (set to
+zero).
+@xref{BTest Intrinsic}, for information on bit positions.
+")
+
+DEFDOC (IBSET, "Set a bit.", "\
+Returns the value of @var{@1@} with bit @var{@2@} set (to one).
+@xref{BTest Intrinsic}, for information on bit positions.
+")
+
+DEFDOC (IBITS, "Extract a bit subfield of a variable.", "\
+Extracts a subfield of length @var{@3@} from @var{@1@}, starting from
+bit position @var{@2@} and extending left for @var{@3@} bits.
+The result is right-justified and the remaining bits are zeroed.
+The value
+of @samp{@var{@2@}+@var{@3@}} must be less than or equal to the value
+@samp{BIT_SIZE(@var{@1@})}.
+@xref{Bit_Size Intrinsic}.
+")
+
+DEFDOC (ISHFT, "Logical bit shift.", "\
+All bits representing @var{@1@} are shifted @var{@2@} places.
+@samp{@var{@2@}.GT.0} indicates a left shift, @samp{@var{@2@}.EQ.0}
+indicates no shift and @samp{@var{@2@}.LT.0} indicates a right shift.
+If the absolute value of the shift count is greater than
+@samp{BIT_SIZE(@var{@1@})}, the result is undefined.
+Bits shifted out from the left end or the right end are lost.
+Zeros are shifted in from the opposite end.
+
+@xref{IShftC Intrinsic}, for the circular-shift equivalent.
+")
+
+DEFDOC (ISHFTC, "Circular bit shift.", "\
+The rightmost @var{@3@} bits of the argument @var{@1@}
+are shifted circularly @var{@2@}
+places, i.e.@: the bits shifted out of one end are shifted into 
+the opposite end.
+No bits are lost.
+The unshifted bits of the result are the same as
+the unshifted bits of @var{@1@}.
+The  absolute value of the argument @var{@2@}
+must be less than or equal to @var{@3@}.  
+The value of @var{@3@} must be greater than or equal to one and less than 
+or equal to @samp{BIT_SIZE(@var{@1@})}.
+
+@xref{IShft Intrinsic}, for the logical shift equivalent.
+")
+
+DEFDOC (MVBITS, "Moving a bit field.", "\
+Moves @var{@3@} bits from positions @var{@2@} through
+@samp{@var{@2@}+@var{@3@}-1} of @var{@1@} to positions @var{@5@} through
+@samp{@var{@2@}+@var{@3@}-1} of @var{@4@}.  The portion of argument
+@var{@4@} not affected by the movement of bits is unchanged.  Arguments
+@var{@1@} and @var{@4@} are permitted to be the same numeric storage
+unit.  The values of @samp{@var{@2@}+@var{@3@}} and
+@samp{@var{@5@}+@var{@3@}} must be less than or equal to
+@samp{BIT_SIZE(@var{@1@})}.
+")
+
+DEFDOC (INDEX, "Locate a CHARACTER substring.", "\
+Returns the position of the start of the first occurrence of string
+@var{@2@} as a substring in @var{@1@}, counting from one.
+If @var{@2@} doesn't occur in @var{@1@}, zero is returned.
+")
+
+DEFDOC (ALARM, "Execute a routine after a given delay.", "\
+Causes external subroutine @var{@2@} to be executed after a delay of
+@var{@1@} seconds by using @code{alarm(1)} to set up a signal and
+@code{signal(2)} to catch it.
+If @var{@3@} is supplied, it will be
+returned with the number of seconds remaining until any previously
+scheduled alarm was due to be delivered, or zero if there was no
+previously scheduled alarm.
+@xref{Signal Intrinsic (subroutine)}.
+")
+
+DEFDOC (DATE_AND_TIME, "Get the current date and time.", "\
+Returns:
+@table @var
+@item @1@
+The date in the form @var{ccyymmdd}: century, year, month and day;
+@item @2@
+The time in the form @samp{@var{hhmmss.ss}}: hours, minutes, seconds
+and milliseconds;
+@item @3@
+The difference between local time and UTC (GMT) in the form @var{Shhmm}:
+sign, hours and minutes, e.g.@: @samp{-0500} (winter in New York);
+@item @4@
+The year, month of the year, day of the month, time difference in
+minutes from UTC, hour of the day, minutes of the hour, seconds
+of the minute, and milliseconds
+of the second in successive values of the array.
+@end table
+
+@cindex Y10K compliance
+@cindex Year 10000 compliance
+@cindex wraparound, Y10K
+@cindex limits, Y10K
+Programs making use of this intrinsic
+might not be Year 10000 (Y10K) compliant.
+For example, the date might appear,
+to such programs, to wrap around
+(change from a larger value to a smaller one)
+as of the Year 10000.
+
+On systems where a millisecond timer isn't available, the millisecond
+value is returned as zero.
+")
diff --git a/gcc/f/intdoc.texi b/gcc/f/intdoc.texi
new file mode 100644
index 00000000000..e657510a060
--- /dev/null
+++ b/gcc/f/intdoc.texi
@@ -0,0 +1,10931 @@
+@c This file is automatically derived from intdoc.c, intdoc.in,
+@c ansify.c, intrin.def, and intrin.h.  Edit those files instead.
+@menu
+@ifset familyF2U
+* Abort Intrinsic::     Abort the program.
+@end ifset
+@ifset familyF77
+* Abs Intrinsic::       Absolute value.
+@end ifset
+@ifset familyF2U
+* Access Intrinsic::    Check file accessibility.
+@end ifset
+@ifset familyASC
+* AChar Intrinsic::     ASCII character from code.
+@end ifset
+@ifset familyF77
+* ACos Intrinsic::      Arc cosine.
+@end ifset
+@ifset familyVXT
+* ACosD Intrinsic::     (Reserved for future use.)
+@end ifset
+@ifset familyF90
+* AdjustL Intrinsic::   (Reserved for future use.)
+* AdjustR Intrinsic::   (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* AImag Intrinsic::     Convert/extract imaginary part of complex.
+@end ifset
+@ifset familyVXT
+* AIMax0 Intrinsic::    (Reserved for future use.)
+* AIMin0 Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* AInt Intrinsic::      Truncate to whole number.
+@end ifset
+@ifset familyVXT
+* AJMax0 Intrinsic::    (Reserved for future use.)
+* AJMin0 Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* Alarm Intrinsic::     Execute a routine after a given delay.
+@end ifset
+@ifset familyF90
+* All Intrinsic::       (Reserved for future use.)
+* Allocated Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* ALog Intrinsic::      Natural logarithm (archaic).
+* ALog10 Intrinsic::    Common logarithm (archaic).
+* AMax0 Intrinsic::     Maximum value (archaic).
+* AMax1 Intrinsic::     Maximum value (archaic).
+* AMin0 Intrinsic::     Minimum value (archaic).
+* AMin1 Intrinsic::     Minimum value (archaic).
+* AMod Intrinsic::      Remainder (archaic).
+@end ifset
+@ifset familyF2C
+* And Intrinsic::       Boolean AND.
+@end ifset
+@ifset familyF77
+* ANInt Intrinsic::     Round to nearest whole number.
+@end ifset
+@ifset familyF90
+* Any Intrinsic::       (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* ASin Intrinsic::      Arc sine.
+@end ifset
+@ifset familyVXT
+* ASinD Intrinsic::     (Reserved for future use.)
+@end ifset
+@ifset familyF90
+* Associated Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* ATan Intrinsic::      Arc tangent.
+* ATan2 Intrinsic::     Arc tangent.
+@end ifset
+@ifset familyVXT
+* ATan2D Intrinsic::    (Reserved for future use.)
+* ATanD Intrinsic::     (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* BesJ0 Intrinsic::     Bessel function.
+* BesJ1 Intrinsic::     Bessel function.
+* BesJN Intrinsic::     Bessel function.
+* BesY0 Intrinsic::     Bessel function.
+* BesY1 Intrinsic::     Bessel function.
+* BesYN Intrinsic::     Bessel function.
+@end ifset
+@ifset familyVXT
+* BITest Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF90
+* Bit_Size Intrinsic::  Number of bits in argument's type.
+@end ifset
+@ifset familyVXT
+* BJTest Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyMIL
+* BTest Intrinsic::     Test bit.
+@end ifset
+@ifset familyF77
+* CAbs Intrinsic::      Absolute value (archaic).
+* CCos Intrinsic::      Cosine (archaic).
+@end ifset
+@ifset familyFVZ
+* CDAbs Intrinsic::     Absolute value (archaic).
+* CDCos Intrinsic::     Cosine (archaic).
+* CDExp Intrinsic::     Exponential (archaic).
+* CDLog Intrinsic::     Natural logarithm (archaic).
+* CDSin Intrinsic::     Sine (archaic).
+* CDSqRt Intrinsic::    Square root (archaic).
+@end ifset
+@ifset familyF90
+* Ceiling Intrinsic::   (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* CExp Intrinsic::      Exponential (archaic).
+* Char Intrinsic::      Character from code.
+@end ifset
+@ifset familyF2U
+* ChDir Intrinsic (subroutine):: Change directory.
+@end ifset
+@ifset familyBADU77
+* ChDir Intrinsic (function):: Change directory.
+@end ifset
+@ifset familyF2U
+* ChMod Intrinsic (subroutine):: Change file modes.
+@end ifset
+@ifset familyBADU77
+* ChMod Intrinsic (function):: Change file modes.
+@end ifset
+@ifset familyF77
+* CLog Intrinsic::      Natural logarithm (archaic).
+* Cmplx Intrinsic::     Construct @code{COMPLEX(KIND=1)} value.
+@end ifset
+@ifset familyGNU
+* Complex Intrinsic::   Build complex value from real and
+                         imaginary parts.
+@end ifset
+@ifset familyF77
+* Conjg Intrinsic::     Complex conjugate.
+* Cos Intrinsic::       Cosine.
+@end ifset
+@ifset familyVXT
+* CosD Intrinsic::      (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* CosH Intrinsic::      Hyperbolic cosine.
+@end ifset
+@ifset familyF90
+* Count Intrinsic::     (Reserved for future use.)
+* CPU_Time Intrinsic::  Get current CPU time.
+* CShift Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* CSin Intrinsic::      Sine (archaic).
+* CSqRt Intrinsic::     Square root (archaic).
+@end ifset
+@ifset familyF2U
+* CTime Intrinsic (subroutine):: Convert time to Day Mon dd hh:mm:ss yyyy.
+* CTime Intrinsic (function):: Convert time to Day Mon dd hh:mm:ss yyyy.
+@end ifset
+@ifset familyF77
+* DAbs Intrinsic::      Absolute value (archaic).
+* DACos Intrinsic::     Arc cosine (archaic).
+@end ifset
+@ifset familyVXT
+* DACosD Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* DASin Intrinsic::     Arc sine (archaic).
+@end ifset
+@ifset familyVXT
+* DASinD Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* DATan Intrinsic::     Arc tangent (archaic).
+* DATan2 Intrinsic::    Arc tangent (archaic).
+@end ifset
+@ifset familyVXT
+* DATan2D Intrinsic::   (Reserved for future use.)
+* DATanD Intrinsic::    (Reserved for future use.)
+* Date Intrinsic::      Get current date as dd-Mon-yy.
+@end ifset
+@ifset familyF90
+* Date_and_Time Intrinsic:: Get the current date and time.
+@end ifset
+@ifset familyF2U
+* DbesJ0 Intrinsic::    Bessel function (archaic).
+* DbesJ1 Intrinsic::    Bessel function (archaic).
+* DbesJN Intrinsic::    Bessel function (archaic).
+* DbesY0 Intrinsic::    Bessel function (archaic).
+* DbesY1 Intrinsic::    Bessel function (archaic).
+* DbesYN Intrinsic::    Bessel function (archaic).
+@end ifset
+@ifset familyF77
+* Dble Intrinsic::      Convert to double precision.
+@end ifset
+@ifset familyVXT
+* DbleQ Intrinsic::     (Reserved for future use.)
+@end ifset
+@ifset familyFVZ
+* DCmplx Intrinsic::    Construct @code{COMPLEX(KIND=2)} value.
+* DConjg Intrinsic::    Complex conjugate (archaic).
+@end ifset
+@ifset familyF77
+* DCos Intrinsic::      Cosine (archaic).
+@end ifset
+@ifset familyVXT
+* DCosD Intrinsic::     (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* DCosH Intrinsic::     Hyperbolic cosine (archaic).
+* DDiM Intrinsic::      Difference magnitude (archaic).
+@end ifset
+@ifset familyF2U
+* DErF Intrinsic::      Error function (archaic).
+* DErFC Intrinsic::     Complementary error function (archaic).
+@end ifset
+@ifset familyF77
+* DExp Intrinsic::      Exponential (archaic).
+@end ifset
+@ifset familyFVZ
+* DFloat Intrinsic::    Conversion (archaic).
+@end ifset
+@ifset familyVXT
+* DFlotI Intrinsic::    (Reserved for future use.)
+* DFlotJ Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF90
+* Digits Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* DiM Intrinsic::       Difference magnitude (non-negative subtract).
+@end ifset
+@ifset familyFVZ
+* DImag Intrinsic::     Convert/extract imaginary part of complex (archaic).
+@end ifset
+@ifset familyF77
+* DInt Intrinsic::      Truncate to whole number (archaic).
+* DLog Intrinsic::      Natural logarithm (archaic).
+* DLog10 Intrinsic::    Common logarithm (archaic).
+* DMax1 Intrinsic::     Maximum value (archaic).
+* DMin1 Intrinsic::     Minimum value (archaic).
+* DMod Intrinsic::      Remainder (archaic).
+* DNInt Intrinsic::     Round to nearest whole number (archaic).
+@end ifset
+@ifset familyF90
+* Dot_Product Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* DProd Intrinsic::     Double-precision product.
+@end ifset
+@ifset familyVXT
+* DReal Intrinsic::     Convert value to type @code{REAL(KIND=2)}.
+@end ifset
+@ifset familyF77
+* DSign Intrinsic::     Apply sign to magnitude (archaic).
+* DSin Intrinsic::      Sine (archaic).
+@end ifset
+@ifset familyVXT
+* DSinD Intrinsic::     (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* DSinH Intrinsic::     Hyperbolic sine (archaic).
+* DSqRt Intrinsic::     Square root (archaic).
+* DTan Intrinsic::      Tangent (archaic).
+@end ifset
+@ifset familyVXT
+* DTanD Intrinsic::     (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* DTanH Intrinsic::     Hyperbolic tangent (archaic).
+@end ifset
+@ifset familyF2U
+* DTime Intrinsic (subroutine):: Get elapsed time since last time.
+@end ifset
+@ifset familyBADU77
+* DTime Intrinsic (function):: Get elapsed time since last time.
+@end ifset
+@ifset familyF90
+* EOShift Intrinsic::   (Reserved for future use.)
+* Epsilon Intrinsic::   (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* ErF Intrinsic::       Error function.
+* ErFC Intrinsic::      Complementary error function.
+* ETime Intrinsic (subroutine):: Get elapsed time for process.
+* ETime Intrinsic (function):: Get elapsed time for process.
+* Exit Intrinsic::      Terminate the program.
+@end ifset
+@ifset familyF77
+* Exp Intrinsic::       Exponential.
+@end ifset
+@ifset familyF90
+* Exponent Intrinsic::  (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* FDate Intrinsic (subroutine):: Get current time as Day Mon dd hh:mm:ss yyyy.
+* FDate Intrinsic (function):: Get current time as Day Mon dd hh:mm:ss yyyy.
+* FGet Intrinsic (subroutine):: Read a character from unit 5 stream-wise.
+@end ifset
+@ifset familyBADU77
+* FGet Intrinsic (function):: Read a character from unit 5 stream-wise.
+@end ifset
+@ifset familyF2U
+* FGetC Intrinsic (subroutine):: Read a character stream-wise.
+@end ifset
+@ifset familyBADU77
+* FGetC Intrinsic (function):: Read a character stream-wise.
+@end ifset
+@ifset familyF77
+* Float Intrinsic::     Conversion (archaic).
+@end ifset
+@ifset familyVXT
+* FloatI Intrinsic::    (Reserved for future use.)
+* FloatJ Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF90
+* Floor Intrinsic::     (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* Flush Intrinsic::     Flush buffered output.
+* FNum Intrinsic::      Get file descriptor from Fortran unit number.
+* FPut Intrinsic (subroutine):: Write a character to unit 6 stream-wise.
+@end ifset
+@ifset familyBADU77
+* FPut Intrinsic (function):: Write a character to unit 6 stream-wise.
+@end ifset
+@ifset familyF2U
+* FPutC Intrinsic (subroutine):: Write a character stream-wise.
+@end ifset
+@ifset familyBADU77
+* FPutC Intrinsic (function):: Write a character stream-wise.
+@end ifset
+@ifset familyF90
+* Fraction Intrinsic::  (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* FSeek Intrinsic::     Position file (low-level).
+* FStat Intrinsic (subroutine):: Get file information.
+* FStat Intrinsic (function):: Get file information.
+* FTell Intrinsic (subroutine):: Get file position (low-level).
+* FTell Intrinsic (function):: Get file position (low-level).
+* GError Intrinsic::    Get error message for last error.
+* GetArg Intrinsic::    Obtain command-line argument.
+* GetCWD Intrinsic (subroutine):: Get current working directory.
+* GetCWD Intrinsic (function):: Get current working directory.
+* GetEnv Intrinsic::    Get environment variable.
+* GetGId Intrinsic::    Get process group id.
+* GetLog Intrinsic::    Get login name.
+* GetPId Intrinsic::    Get process id.
+* GetUId Intrinsic::    Get process user id.
+* GMTime Intrinsic::    Convert time to GMT time info.
+* HostNm Intrinsic (subroutine):: Get host name.
+* HostNm Intrinsic (function):: Get host name.
+@end ifset
+@ifset familyF90
+* Huge Intrinsic::      (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* IAbs Intrinsic::      Absolute value (archaic).
+@end ifset
+@ifset familyASC
+* IAChar Intrinsic::    ASCII code for character.
+@end ifset
+@ifset familyMIL
+* IAnd Intrinsic::      Boolean AND.
+@end ifset
+@ifset familyF2U
+* IArgC Intrinsic::     Obtain count of command-line arguments.
+@end ifset
+@ifset familyMIL
+* IBClr Intrinsic::     Clear a bit.
+* IBits Intrinsic::     Extract a bit subfield of a variable.
+* IBSet Intrinsic::     Set a bit.
+@end ifset
+@ifset familyF77
+* IChar Intrinsic::     Code for character.
+@end ifset
+@ifset familyF2U
+* IDate Intrinsic (UNIX):: Get local time info.
+@end ifset
+@ifset familyVXT
+* IDate Intrinsic (VXT):: Get local time info (VAX/VMS).
+@end ifset
+@ifset familyF77
+* IDiM Intrinsic::      Difference magnitude (archaic).
+* IDInt Intrinsic::     Convert to @code{INTEGER} value truncated
+                         to whole number (archaic).
+* IDNInt Intrinsic::    Convert to @code{INTEGER} value rounded
+                         to nearest whole number (archaic).
+@end ifset
+@ifset familyMIL
+* IEOr Intrinsic::      Boolean XOR.
+@end ifset
+@ifset familyF2U
+* IErrNo Intrinsic::    Get error number for last error.
+@end ifset
+@ifset familyF77
+* IFix Intrinsic::      Conversion (archaic).
+@end ifset
+@ifset familyVXT
+* IIAbs Intrinsic::     (Reserved for future use.)
+* IIAnd Intrinsic::     (Reserved for future use.)
+* IIBClr Intrinsic::    (Reserved for future use.)
+* IIBits Intrinsic::    (Reserved for future use.)
+* IIBSet Intrinsic::    (Reserved for future use.)
+* IIDiM Intrinsic::     (Reserved for future use.)
+* IIDInt Intrinsic::    (Reserved for future use.)
+* IIDNnt Intrinsic::    (Reserved for future use.)
+* IIEOr Intrinsic::     (Reserved for future use.)
+* IIFix Intrinsic::     (Reserved for future use.)
+* IInt Intrinsic::      (Reserved for future use.)
+* IIOr Intrinsic::      (Reserved for future use.)
+* IIQint Intrinsic::    (Reserved for future use.)
+* IIQNnt Intrinsic::    (Reserved for future use.)
+* IIShftC Intrinsic::   (Reserved for future use.)
+* IISign Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF2C
+* Imag Intrinsic::      Extract imaginary part of complex.
+@end ifset
+@ifset familyGNU
+* ImagPart Intrinsic::  Extract imaginary part of complex.
+@end ifset
+@ifset familyVXT
+* IMax0 Intrinsic::     (Reserved for future use.)
+* IMax1 Intrinsic::     (Reserved for future use.)
+* IMin0 Intrinsic::     (Reserved for future use.)
+* IMin1 Intrinsic::     (Reserved for future use.)
+* IMod Intrinsic::      (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* Index Intrinsic::     Locate a CHARACTER substring.
+@end ifset
+@ifset familyVXT
+* INInt Intrinsic::     (Reserved for future use.)
+* INot Intrinsic::      (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* Int Intrinsic::       Convert to @code{INTEGER} value truncated
+                         to whole number.
+@end ifset
+@ifset familyGNU
+* Int2 Intrinsic::      Convert to @code{INTEGER(KIND=6)} value
+                         truncated to whole number.
+* Int8 Intrinsic::      Convert to @code{INTEGER(KIND=2)} value
+                         truncated to whole number.
+@end ifset
+@ifset familyMIL
+* IOr Intrinsic::       Boolean OR.
+@end ifset
+@ifset familyF2U
+* IRand Intrinsic::     Random number.
+* IsaTty Intrinsic::    Is unit connected to a terminal?
+@end ifset
+@ifset familyMIL
+* IShft Intrinsic::     Logical bit shift.
+* IShftC Intrinsic::    Circular bit shift.
+@end ifset
+@ifset familyF77
+* ISign Intrinsic::     Apply sign to magnitude (archaic).
+@end ifset
+@ifset familyF2U
+* ITime Intrinsic::     Get local time of day.
+@end ifset
+@ifset familyVXT
+* IZExt Intrinsic::     (Reserved for future use.)
+* JIAbs Intrinsic::     (Reserved for future use.)
+* JIAnd Intrinsic::     (Reserved for future use.)
+* JIBClr Intrinsic::    (Reserved for future use.)
+* JIBits Intrinsic::    (Reserved for future use.)
+* JIBSet Intrinsic::    (Reserved for future use.)
+* JIDiM Intrinsic::     (Reserved for future use.)
+* JIDInt Intrinsic::    (Reserved for future use.)
+* JIDNnt Intrinsic::    (Reserved for future use.)
+* JIEOr Intrinsic::     (Reserved for future use.)
+* JIFix Intrinsic::     (Reserved for future use.)
+* JInt Intrinsic::      (Reserved for future use.)
+* JIOr Intrinsic::      (Reserved for future use.)
+* JIQint Intrinsic::    (Reserved for future use.)
+* JIQNnt Intrinsic::    (Reserved for future use.)
+* JIShft Intrinsic::    (Reserved for future use.)
+* JIShftC Intrinsic::   (Reserved for future use.)
+* JISign Intrinsic::    (Reserved for future use.)
+* JMax0 Intrinsic::     (Reserved for future use.)
+* JMax1 Intrinsic::     (Reserved for future use.)
+* JMin0 Intrinsic::     (Reserved for future use.)
+* JMin1 Intrinsic::     (Reserved for future use.)
+* JMod Intrinsic::      (Reserved for future use.)
+* JNInt Intrinsic::     (Reserved for future use.)
+* JNot Intrinsic::      (Reserved for future use.)
+* JZExt Intrinsic::     (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* Kill Intrinsic (subroutine):: Signal a process.
+@end ifset
+@ifset familyBADU77
+* Kill Intrinsic (function):: Signal a process.
+@end ifset
+@ifset familyF90
+* Kind Intrinsic::      (Reserved for future use.)
+* LBound Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* Len Intrinsic::       Length of character entity.
+@end ifset
+@ifset familyF90
+* Len_Trim Intrinsic::  Get last non-blank character in string.
+@end ifset
+@ifset familyF77
+* LGe Intrinsic::       Lexically greater than or equal.
+* LGt Intrinsic::       Lexically greater than.
+@end ifset
+@ifset familyF2U
+* Link Intrinsic (subroutine):: Make hard link in file system.
+@end ifset
+@ifset familyBADU77
+* Link Intrinsic (function):: Make hard link in file system.
+@end ifset
+@ifset familyF77
+* LLe Intrinsic::       Lexically less than or equal.
+* LLt Intrinsic::       Lexically less than.
+@end ifset
+@ifset familyF2U
+* LnBlnk Intrinsic::    Get last non-blank character in string.
+* Loc Intrinsic::       Address of entity in core.
+@end ifset
+@ifset familyF77
+* Log Intrinsic::       Natural logarithm.
+* Log10 Intrinsic::     Common logarithm.
+@end ifset
+@ifset familyF90
+* Logical Intrinsic::   (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* Long Intrinsic::      Conversion to @code{INTEGER(KIND=1)} (archaic).
+@end ifset
+@ifset familyF2C
+* LShift Intrinsic::    Left-shift bits.
+@end ifset
+@ifset familyF2U
+* LStat Intrinsic (subroutine):: Get file information.
+* LStat Intrinsic (function):: Get file information.
+* LTime Intrinsic::     Convert time to local time info.
+@end ifset
+@ifset familyF90
+* MatMul Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* Max Intrinsic::       Maximum value.
+* Max0 Intrinsic::      Maximum value (archaic).
+* Max1 Intrinsic::      Maximum value (archaic).
+@end ifset
+@ifset familyF90
+* MaxExponent Intrinsic:: (Reserved for future use.)
+* MaxLoc Intrinsic::    (Reserved for future use.)
+* MaxVal Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* MClock Intrinsic::    Get number of clock ticks for process.
+* MClock8 Intrinsic::   Get number of clock ticks for process.
+@end ifset
+@ifset familyF90
+* Merge Intrinsic::     (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* Min Intrinsic::       Minimum value.
+* Min0 Intrinsic::      Minimum value (archaic).
+* Min1 Intrinsic::      Minimum value (archaic).
+@end ifset
+@ifset familyF90
+* MinExponent Intrinsic:: (Reserved for future use.)
+* MinLoc Intrinsic::    (Reserved for future use.)
+* MinVal Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* Mod Intrinsic::       Remainder.
+@end ifset
+@ifset familyF90
+* Modulo Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyMIL
+* MvBits Intrinsic::    Moving a bit field.
+@end ifset
+@ifset familyF90
+* Nearest Intrinsic::   (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* NInt Intrinsic::      Convert to @code{INTEGER} value rounded
+                         to nearest whole number.
+@end ifset
+@ifset familyMIL
+* Not Intrinsic::       Boolean NOT.
+@end ifset
+@ifset familyF2C
+* Or Intrinsic::        Boolean OR.
+@end ifset
+@ifset familyF90
+* Pack Intrinsic::      (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* PError Intrinsic::    Print error message for last error.
+@end ifset
+@ifset familyF90
+* Precision Intrinsic:: (Reserved for future use.)
+* Present Intrinsic::   (Reserved for future use.)
+* Product Intrinsic::   (Reserved for future use.)
+@end ifset
+@ifset familyVXT
+* QAbs Intrinsic::      (Reserved for future use.)
+* QACos Intrinsic::     (Reserved for future use.)
+* QACosD Intrinsic::    (Reserved for future use.)
+* QASin Intrinsic::     (Reserved for future use.)
+* QASinD Intrinsic::    (Reserved for future use.)
+* QATan Intrinsic::     (Reserved for future use.)
+* QATan2 Intrinsic::    (Reserved for future use.)
+* QATan2D Intrinsic::   (Reserved for future use.)
+* QATanD Intrinsic::    (Reserved for future use.)
+* QCos Intrinsic::      (Reserved for future use.)
+* QCosD Intrinsic::     (Reserved for future use.)
+* QCosH Intrinsic::     (Reserved for future use.)
+* QDiM Intrinsic::      (Reserved for future use.)
+* QExp Intrinsic::      (Reserved for future use.)
+* QExt Intrinsic::      (Reserved for future use.)
+* QExtD Intrinsic::     (Reserved for future use.)
+* QFloat Intrinsic::    (Reserved for future use.)
+* QInt Intrinsic::      (Reserved for future use.)
+* QLog Intrinsic::      (Reserved for future use.)
+* QLog10 Intrinsic::    (Reserved for future use.)
+* QMax1 Intrinsic::     (Reserved for future use.)
+* QMin1 Intrinsic::     (Reserved for future use.)
+* QMod Intrinsic::      (Reserved for future use.)
+* QNInt Intrinsic::     (Reserved for future use.)
+* QSin Intrinsic::      (Reserved for future use.)
+* QSinD Intrinsic::     (Reserved for future use.)
+* QSinH Intrinsic::     (Reserved for future use.)
+* QSqRt Intrinsic::     (Reserved for future use.)
+* QTan Intrinsic::      (Reserved for future use.)
+* QTanD Intrinsic::     (Reserved for future use.)
+* QTanH Intrinsic::     (Reserved for future use.)
+@end ifset
+@ifset familyF90
+* Radix Intrinsic::     (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* Rand Intrinsic::      Random number.
+@end ifset
+@ifset familyF90
+* Random_Number Intrinsic:: (Reserved for future use.)
+* Random_Seed Intrinsic:: (Reserved for future use.)
+* Range Intrinsic::     (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* Real Intrinsic::      Convert value to type @code{REAL(KIND=1)}.
+@end ifset
+@ifset familyGNU
+* RealPart Intrinsic::  Extract real part of complex.
+@end ifset
+@ifset familyF2U
+* Rename Intrinsic (subroutine):: Rename file.
+@end ifset
+@ifset familyBADU77
+* Rename Intrinsic (function):: Rename file.
+@end ifset
+@ifset familyF90
+* Repeat Intrinsic::    (Reserved for future use.)
+* Reshape Intrinsic::   (Reserved for future use.)
+* RRSpacing Intrinsic:: (Reserved for future use.)
+@end ifset
+@ifset familyF2C
+* RShift Intrinsic::    Right-shift bits.
+@end ifset
+@ifset familyF90
+* Scale Intrinsic::     (Reserved for future use.)
+* Scan Intrinsic::      (Reserved for future use.)
+@end ifset
+@ifset familyVXT
+* Secnds Intrinsic::    Get local time offset since midnight.
+@end ifset
+@ifset familyF2U
+* Second Intrinsic (function):: Get CPU time for process in seconds.
+* Second Intrinsic (subroutine):: Get CPU time for process
+                         in seconds.
+@end ifset
+@ifset familyF90
+* Selected_Int_Kind Intrinsic:: (Reserved for future use.)
+* Selected_Real_Kind Intrinsic:: (Reserved for future use.)
+* Set_Exponent Intrinsic:: (Reserved for future use.)
+* Shape Intrinsic::     (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* Short Intrinsic::     Convert to @code{INTEGER(KIND=6)} value
+                         truncated to whole number.
+@end ifset
+@ifset familyF77
+* Sign Intrinsic::      Apply sign to magnitude.
+@end ifset
+@ifset familyF2U
+* Signal Intrinsic (subroutine):: Muck with signal handling.
+@end ifset
+@ifset familyBADU77
+* Signal Intrinsic (function):: Muck with signal handling.
+@end ifset
+@ifset familyF77
+* Sin Intrinsic::       Sine.
+@end ifset
+@ifset familyVXT
+* SinD Intrinsic::      (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* SinH Intrinsic::      Hyperbolic sine.
+@end ifset
+@ifset familyF2U
+* Sleep Intrinsic::     Sleep for a specified time.
+@end ifset
+@ifset familyF77
+* Sngl Intrinsic::      Convert (archaic).
+@end ifset
+@ifset familyVXT
+* SnglQ Intrinsic::     (Reserved for future use.)
+@end ifset
+@ifset familyF90
+* Spacing Intrinsic::   (Reserved for future use.)
+* Spread Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* SqRt Intrinsic::      Square root.
+@end ifset
+@ifset familyF2U
+* SRand Intrinsic::     Random seed.
+* Stat Intrinsic (subroutine):: Get file information.
+* Stat Intrinsic (function):: Get file information.
+@end ifset
+@ifset familyF90
+* Sum Intrinsic::       (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* SymLnk Intrinsic (subroutine):: Make symbolic link in file system.
+@end ifset
+@ifset familyBADU77
+* SymLnk Intrinsic (function):: Make symbolic link in file system.
+@end ifset
+@ifset familyF2U
+* System Intrinsic (subroutine):: Invoke shell (system) command.
+@end ifset
+@ifset familyBADU77
+* System Intrinsic (function):: Invoke shell (system) command.
+@end ifset
+@ifset familyF90
+* System_Clock Intrinsic:: Get current system clock value.
+@end ifset
+@ifset familyF77
+* Tan Intrinsic::       Tangent.
+@end ifset
+@ifset familyVXT
+* TanD Intrinsic::      (Reserved for future use.)
+@end ifset
+@ifset familyF77
+* TanH Intrinsic::      Hyperbolic tangent.
+@end ifset
+@ifset familyF2U
+* Time Intrinsic (UNIX):: Get current time as time value.
+@end ifset
+@ifset familyVXT
+* Time Intrinsic (VXT):: Get the time as a character value.
+@end ifset
+@ifset familyF2U
+* Time8 Intrinsic::     Get current time as time value.
+@end ifset
+@ifset familyF90
+* Tiny Intrinsic::      (Reserved for future use.)
+* Transfer Intrinsic::  (Reserved for future use.)
+* Transpose Intrinsic:: (Reserved for future use.)
+* Trim Intrinsic::      (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* TtyNam Intrinsic (subroutine):: Get name of terminal device for unit.
+* TtyNam Intrinsic (function):: Get name of terminal device for unit.
+@end ifset
+@ifset familyF90
+* UBound Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF2U
+* UMask Intrinsic (subroutine):: Set file creation permissions mask.
+@end ifset
+@ifset familyBADU77
+* UMask Intrinsic (function):: Set file creation permissions mask.
+@end ifset
+@ifset familyF2U
+* Unlink Intrinsic (subroutine):: Unlink file.
+@end ifset
+@ifset familyBADU77
+* Unlink Intrinsic (function):: Unlink file.
+@end ifset
+@ifset familyF90
+* Unpack Intrinsic::    (Reserved for future use.)
+* Verify Intrinsic::    (Reserved for future use.)
+@end ifset
+@ifset familyF2C
+* XOr Intrinsic::       Boolean XOR.
+* ZAbs Intrinsic::      Absolute value (archaic).
+* ZCos Intrinsic::      Cosine (archaic).
+* ZExp Intrinsic::      Exponential (archaic).
+@end ifset
+@ifset familyVXT
+* ZExt Intrinsic::      (Reserved for future use.)
+@end ifset
+@ifset familyF2C
+* ZLog Intrinsic::      Natural logarithm (archaic).
+* ZSin Intrinsic::      Sine (archaic).
+* ZSqRt Intrinsic::     Square root (archaic).
+@end ifset
+@end menu
+
+@ifset familyF2U
+@node Abort Intrinsic
+@subsubsection Abort Intrinsic
+@cindex Abort intrinsic
+@cindex intrinsics, Abort
+
+@noindent
+@example
+CALL Abort()
+@end example
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Prints a message and potentially causes a core dump via @code{abort(3)}.
+
+@end ifset
+@ifset familyF77
+@node Abs Intrinsic
+@subsubsection Abs Intrinsic
+@cindex Abs intrinsic
+@cindex intrinsics, Abs
+
+@noindent
+@example
+Abs(@var{A})
+@end example
+
+@noindent
+Abs: @code{INTEGER} or @code{REAL} function.
+The exact type depends on that of argument @var{A}---if @var{A} is
+@code{COMPLEX}, this function's type is @code{REAL}
+with the same @samp{KIND=} value as the type of @var{A}.
+Otherwise, this function's type is the same as that of @var{A}.
+
+@noindent
+@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the absolute value of @var{A}.
+
+If @var{A} is type @code{COMPLEX}, the absolute
+value is computed as:
+
+@example
+SQRT(REALPART(@var{A})**2+IMAGPART(@var{A})**2)
+@end example
+
+@noindent
+Otherwise, it is computed by negating @var{A} if
+it is negative, or returning @var{A}.
+
+@xref{Sign Intrinsic}, for how to explicitly
+compute the positive or negative form of the absolute
+value of an expression.
+
+@end ifset
+@ifset familyF2U
+@node Access Intrinsic
+@subsubsection Access Intrinsic
+@cindex Access intrinsic
+@cindex intrinsics, Access
+
+@noindent
+@example
+Access(@var{Name}, @var{Mode})
+@end example
+
+@noindent
+Access: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Mode}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Checks file @var{Name} for accessibility in the mode specified by @var{Mode} and
+returns 0 if the file is accessible in that mode, otherwise an error
+code if the file is inaccessible or @var{Mode} is invalid.
+See @code{access(2)}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{Name}---otherwise,
+trailing blanks in @var{Name} are ignored.
+@var{Mode} may be a concatenation of any of the following characters:
+
+@table @samp
+@item r
+Read permission
+
+@item w
+Write permission
+
+@item x
+Execute permission
+
+@item @kbd{SPC}
+Existence
+@end table
+
+@end ifset
+@ifset familyASC
+@node AChar Intrinsic
+@subsubsection AChar Intrinsic
+@cindex AChar intrinsic
+@cindex intrinsics, AChar
+
+@noindent
+@example
+AChar(@var{I})
+@end example
+
+@noindent
+AChar: @code{CHARACTER*1} function.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{f90}.
+
+@noindent
+Description:
+
+Returns the ASCII character corresponding to the
+code specified by @var{I}.
+
+@xref{IAChar Intrinsic}, for the inverse of this function.
+
+@xref{Char Intrinsic}, for the function corresponding
+to the system's native character set.
+
+@end ifset
+@ifset familyF77
+@node ACos Intrinsic
+@subsubsection ACos Intrinsic
+@cindex ACos intrinsic
+@cindex intrinsics, ACos
+
+@noindent
+@example
+ACos(@var{X})
+@end example
+
+@noindent
+ACos: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the arc-cosine (inverse cosine) of @var{X}
+in radians.
+
+@xref{Cos Intrinsic}, for the inverse of this function.
+
+@end ifset
+@ifset familyVXT
+@node ACosD Intrinsic
+@subsubsection ACosD Intrinsic
+@cindex ACosD intrinsic
+@cindex intrinsics, ACosD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL ACosD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF90
+@node AdjustL Intrinsic
+@subsubsection AdjustL Intrinsic
+@cindex AdjustL intrinsic
+@cindex intrinsics, AdjustL
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL AdjustL} to use this name for an
+external procedure.
+
+@node AdjustR Intrinsic
+@subsubsection AdjustR Intrinsic
+@cindex AdjustR intrinsic
+@cindex intrinsics, AdjustR
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL AdjustR} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node AImag Intrinsic
+@subsubsection AImag Intrinsic
+@cindex AImag intrinsic
+@cindex intrinsics, AImag
+
+@noindent
+@example
+AImag(@var{Z})
+@end example
+
+@noindent
+AImag: @code{REAL} function.
+This intrinsic is valid when argument @var{Z} is
+@code{COMPLEX(KIND=1)}.
+When @var{Z} is any other @code{COMPLEX} type,
+this intrinsic is valid only when used as the argument to
+@code{REAL()}, as explained below.
+
+@noindent
+@var{Z}: @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the (possibly converted) imaginary part of @var{Z}.
+
+Use of @code{AIMAG()} with an argument of a type
+other than @code{COMPLEX(KIND=1)} is restricted to the following case:
+
+@example
+REAL(AIMAG(Z))
+@end example
+
+@noindent
+This expression converts the imaginary part of Z to
+@code{REAL(KIND=1)}.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+
+@end ifset
+@ifset familyVXT
+@node AIMax0 Intrinsic
+@subsubsection AIMax0 Intrinsic
+@cindex AIMax0 intrinsic
+@cindex intrinsics, AIMax0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL AIMax0} to use this name for an
+external procedure.
+
+@node AIMin0 Intrinsic
+@subsubsection AIMin0 Intrinsic
+@cindex AIMin0 intrinsic
+@cindex intrinsics, AIMin0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL AIMin0} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node AInt Intrinsic
+@subsubsection AInt Intrinsic
+@cindex AInt intrinsic
+@cindex intrinsics, AInt
+
+@noindent
+@example
+AInt(@var{A})
+@end example
+
+@noindent
+AInt: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{A}.
+
+@noindent
+@var{A}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @var{A} with the fractional portion of its
+magnitude truncated and its sign preserved.
+(Also called ``truncation towards zero''.)
+
+@xref{ANInt Intrinsic}, for how to round to nearest
+whole number.
+
+@xref{Int Intrinsic}, for how to truncate and then convert
+number to @code{INTEGER}.
+
+@end ifset
+@ifset familyVXT
+@node AJMax0 Intrinsic
+@subsubsection AJMax0 Intrinsic
+@cindex AJMax0 intrinsic
+@cindex intrinsics, AJMax0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL AJMax0} to use this name for an
+external procedure.
+
+@node AJMin0 Intrinsic
+@subsubsection AJMin0 Intrinsic
+@cindex AJMin0 intrinsic
+@cindex intrinsics, AJMin0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL AJMin0} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node Alarm Intrinsic
+@subsubsection Alarm Intrinsic
+@cindex Alarm intrinsic
+@cindex intrinsics, Alarm
+
+@noindent
+@example
+CALL Alarm(@var{Seconds}, @var{Handler}, @var{Status})
+@end example
+
+@noindent
+@var{Seconds}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Handler}: Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})
+or dummy/global @code{INTEGER(KIND=1)} scalar.
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Causes external subroutine @var{Handler} to be executed after a delay of
+@var{Seconds} seconds by using @code{alarm(1)} to set up a signal and
+@code{signal(2)} to catch it.
+If @var{Status} is supplied, it will be
+returned with the number of seconds remaining until any previously
+scheduled alarm was due to be delivered, or zero if there was no
+previously scheduled alarm.
+@xref{Signal Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node All Intrinsic
+@subsubsection All Intrinsic
+@cindex All intrinsic
+@cindex intrinsics, All
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL All} to use this name for an
+external procedure.
+
+@node Allocated Intrinsic
+@subsubsection Allocated Intrinsic
+@cindex Allocated intrinsic
+@cindex intrinsics, Allocated
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Allocated} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node ALog Intrinsic
+@subsubsection ALog Intrinsic
+@cindex ALog intrinsic
+@cindex intrinsics, ALog
+
+@noindent
+@example
+ALog(@var{X})
+@end example
+
+@noindent
+ALog: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{LOG()} that is specific
+to one type for @var{X}.
+@xref{Log Intrinsic}.
+
+@node ALog10 Intrinsic
+@subsubsection ALog10 Intrinsic
+@cindex ALog10 intrinsic
+@cindex intrinsics, ALog10
+
+@noindent
+@example
+ALog10(@var{X})
+@end example
+
+@noindent
+ALog10: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{LOG10()} that is specific
+to one type for @var{X}.
+@xref{Log10 Intrinsic}.
+
+@node AMax0 Intrinsic
+@subsubsection AMax0 Intrinsic
+@cindex AMax0 intrinsic
+@cindex intrinsics, AMax0
+
+@noindent
+@example
+AMax0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+AMax0: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MAX()} that is specific
+to one type for @var{A} and a different return type.
+@xref{Max Intrinsic}.
+
+@node AMax1 Intrinsic
+@subsubsection AMax1 Intrinsic
+@cindex AMax1 intrinsic
+@cindex intrinsics, AMax1
+
+@noindent
+@example
+AMax1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+AMax1: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MAX()} that is specific
+to one type for @var{A}.
+@xref{Max Intrinsic}.
+
+@node AMin0 Intrinsic
+@subsubsection AMin0 Intrinsic
+@cindex AMin0 intrinsic
+@cindex intrinsics, AMin0
+
+@noindent
+@example
+AMin0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+AMin0: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MIN()} that is specific
+to one type for @var{A} and a different return type.
+@xref{Min Intrinsic}.
+
+@node AMin1 Intrinsic
+@subsubsection AMin1 Intrinsic
+@cindex AMin1 intrinsic
+@cindex intrinsics, AMin1
+
+@noindent
+@example
+AMin1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+AMin1: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MIN()} that is specific
+to one type for @var{A}.
+@xref{Min Intrinsic}.
+
+@node AMod Intrinsic
+@subsubsection AMod Intrinsic
+@cindex AMod intrinsic
+@cindex intrinsics, AMod
+
+@noindent
+@example
+AMod(@var{A}, @var{P})
+@end example
+
+@noindent
+AMod: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+@var{P}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MOD()} that is specific
+to one type for @var{A}.
+@xref{Mod Intrinsic}.
+
+@end ifset
+@ifset familyF2C
+@node And Intrinsic
+@subsubsection And Intrinsic
+@cindex And intrinsic
+@cindex intrinsics, And
+
+@noindent
+@example
+And(@var{I}, @var{J})
+@end example
+
+@noindent
+And: @code{INTEGER} or @code{LOGICAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{I}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
+
+@noindent
+@var{J}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Returns value resulting from boolean AND of
+pair of bits in each of @var{I} and @var{J}.
+
+@end ifset
+@ifset familyF77
+@node ANInt Intrinsic
+@subsubsection ANInt Intrinsic
+@cindex ANInt intrinsic
+@cindex intrinsics, ANInt
+
+@noindent
+@example
+ANInt(@var{A})
+@end example
+
+@noindent
+ANInt: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{A}.
+
+@noindent
+@var{A}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @var{A} with the fractional portion of its
+magnitude eliminated by rounding to the nearest whole
+number and with its sign preserved.
+
+A fractional portion exactly equal to
+@samp{.5} is rounded to the whole number that
+is larger in magnitude.
+(Also called ``Fortran round''.)
+
+@xref{AInt Intrinsic}, for how to truncate to
+whole number.
+
+@xref{NInt Intrinsic}, for how to round and then convert
+number to @code{INTEGER}.
+
+@end ifset
+@ifset familyF90
+@node Any Intrinsic
+@subsubsection Any Intrinsic
+@cindex Any intrinsic
+@cindex intrinsics, Any
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Any} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node ASin Intrinsic
+@subsubsection ASin Intrinsic
+@cindex ASin intrinsic
+@cindex intrinsics, ASin
+
+@noindent
+@example
+ASin(@var{X})
+@end example
+
+@noindent
+ASin: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the arc-sine (inverse sine) of @var{X}
+in radians.
+
+@xref{Sin Intrinsic}, for the inverse of this function.
+
+@end ifset
+@ifset familyVXT
+@node ASinD Intrinsic
+@subsubsection ASinD Intrinsic
+@cindex ASinD intrinsic
+@cindex intrinsics, ASinD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL ASinD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF90
+@node Associated Intrinsic
+@subsubsection Associated Intrinsic
+@cindex Associated intrinsic
+@cindex intrinsics, Associated
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Associated} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node ATan Intrinsic
+@subsubsection ATan Intrinsic
+@cindex ATan intrinsic
+@cindex intrinsics, ATan
+
+@noindent
+@example
+ATan(@var{X})
+@end example
+
+@noindent
+ATan: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the arc-tangent (inverse tangent) of @var{X}
+in radians.
+
+@xref{Tan Intrinsic}, for the inverse of this function.
+
+@node ATan2 Intrinsic
+@subsubsection ATan2 Intrinsic
+@cindex ATan2 intrinsic
+@cindex intrinsics, ATan2
+
+@noindent
+@example
+ATan2(@var{Y}, @var{X})
+@end example
+
+@noindent
+ATan2: @code{REAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{Y}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the arc-tangent (inverse tangent) of the complex
+number (@var{Y}, @var{X}) in radians.
+
+@xref{Tan Intrinsic}, for the inverse of this function.
+
+@end ifset
+@ifset familyVXT
+@node ATan2D Intrinsic
+@subsubsection ATan2D Intrinsic
+@cindex ATan2D intrinsic
+@cindex intrinsics, ATan2D
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL ATan2D} to use this name for an
+external procedure.
+
+@node ATanD Intrinsic
+@subsubsection ATanD Intrinsic
+@cindex ATanD intrinsic
+@cindex intrinsics, ATanD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL ATanD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node BesJ0 Intrinsic
+@subsubsection BesJ0 Intrinsic
+@cindex BesJ0 intrinsic
+@cindex intrinsics, BesJ0
+
+@noindent
+@example
+BesJ0(@var{X})
+@end example
+
+@noindent
+BesJ0: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Calculates the Bessel function of the first kind of order 0 of @var{X}.
+See @code{bessel(3m)}, on whose implementation the function depends.
+@node BesJ1 Intrinsic
+@subsubsection BesJ1 Intrinsic
+@cindex BesJ1 intrinsic
+@cindex intrinsics, BesJ1
+
+@noindent
+@example
+BesJ1(@var{X})
+@end example
+
+@noindent
+BesJ1: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Calculates the Bessel function of the first kind of order 1 of @var{X}.
+See @code{bessel(3m)}, on whose implementation the function depends.
+@node BesJN Intrinsic
+@subsubsection BesJN Intrinsic
+@cindex BesJN intrinsic
+@cindex intrinsics, BesJN
+
+@noindent
+@example
+BesJN(@var{N}, @var{X})
+@end example
+
+@noindent
+BesJN: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{N}: @code{INTEGER} not wider than the default kind; scalar; INTENT(IN).
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Calculates the Bessel function of the first kind of order @var{N} of @var{X}.
+See @code{bessel(3m)}, on whose implementation the function depends.
+@node BesY0 Intrinsic
+@subsubsection BesY0 Intrinsic
+@cindex BesY0 intrinsic
+@cindex intrinsics, BesY0
+
+@noindent
+@example
+BesY0(@var{X})
+@end example
+
+@noindent
+BesY0: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Calculates the Bessel function of the second kind of order 0 of @var{X}.
+See @code{bessel(3m)}, on whose implementation the function depends.
+@node BesY1 Intrinsic
+@subsubsection BesY1 Intrinsic
+@cindex BesY1 intrinsic
+@cindex intrinsics, BesY1
+
+@noindent
+@example
+BesY1(@var{X})
+@end example
+
+@noindent
+BesY1: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Calculates the Bessel function of the second kind of order 1 of @var{X}.
+See @code{bessel(3m)}, on whose implementation the function depends.
+@node BesYN Intrinsic
+@subsubsection BesYN Intrinsic
+@cindex BesYN intrinsic
+@cindex intrinsics, BesYN
+
+@noindent
+@example
+BesYN(@var{N}, @var{X})
+@end example
+
+@noindent
+BesYN: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{N}: @code{INTEGER} not wider than the default kind; scalar; INTENT(IN).
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Calculates the Bessel function of the second kind of order @var{N} of @var{X}.
+See @code{bessel(3m)}, on whose implementation the function depends.
+@end ifset
+@ifset familyVXT
+@node BITest Intrinsic
+@subsubsection BITest Intrinsic
+@cindex BITest intrinsic
+@cindex intrinsics, BITest
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL BITest} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF90
+@node Bit_Size Intrinsic
+@subsubsection Bit_Size Intrinsic
+@cindex Bit_Size intrinsic
+@cindex intrinsics, Bit_Size
+
+@noindent
+@example
+Bit_Size(@var{I})
+@end example
+
+@noindent
+Bit_Size: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar.
+
+@noindent
+Intrinsic groups: @code{f90}.
+
+@noindent
+Description:
+
+Returns the number of bits (integer precision plus sign bit)
+represented by the type for @var{I}.
+
+@xref{BTest Intrinsic}, for how to test the value of a
+bit in a variable or array.
+
+@xref{IBSet Intrinsic}, for how to set a bit in a variable to 1.
+
+@xref{IBClr Intrinsic}, for how to set a bit in a variable to 0.
+
+
+@end ifset
+@ifset familyVXT
+@node BJTest Intrinsic
+@subsubsection BJTest Intrinsic
+@cindex BJTest intrinsic
+@cindex intrinsics, BJTest
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL BJTest} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyMIL
+@node BTest Intrinsic
+@subsubsection BTest Intrinsic
+@cindex BTest intrinsic
+@cindex intrinsics, BTest
+
+@noindent
+@example
+BTest(@var{I}, @var{Pos})
+@end example
+
+@noindent
+BTest: @code{LOGICAL(KIND=1)} function.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Pos}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Returns @code{.TRUE.} if bit @var{Pos} in @var{I} is
+1, @code{.FALSE.} otherwise.
+
+(Bit 0 is the low-order (rightmost) bit, adding the value 
+@ifinfo
+2**0,
+@end ifinfo
+@iftex
+@tex
+$2^0$,
+@end tex
+@end iftex
+or 1,
+to the number if set to 1;
+bit 1 is the next-higher-order bit, adding 
+@ifinfo
+2**1,
+@end ifinfo
+@iftex
+@tex
+$2^1$,
+@end tex
+@end iftex
+or 2;
+bit 2 adds 
+@ifinfo
+2**2,
+@end ifinfo
+@iftex
+@tex
+$2^2$,
+@end tex
+@end iftex
+or 4; and so on.)
+
+@xref{Bit_Size Intrinsic}, for how to obtain the number of bits
+in a type.
+The leftmost bit of @var{I} is @samp{BIT_SIZE(@var{I}-1)}.
+
+@end ifset
+@ifset familyF77
+@node CAbs Intrinsic
+@subsubsection CAbs Intrinsic
+@cindex CAbs intrinsic
+@cindex intrinsics, CAbs
+
+@noindent
+@example
+CAbs(@var{A})
+@end example
+
+@noindent
+CAbs: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ABS()} that is specific
+to one type for @var{A}.
+@xref{Abs Intrinsic}.
+
+@node CCos Intrinsic
+@subsubsection CCos Intrinsic
+@cindex CCos intrinsic
+@cindex intrinsics, CCos
+
+@noindent
+@example
+CCos(@var{X})
+@end example
+
+@noindent
+CCos: @code{COMPLEX(KIND=1)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{COS()} that is specific
+to one type for @var{X}.
+@xref{Cos Intrinsic}.
+
+@end ifset
+@ifset familyFVZ
+@node CDAbs Intrinsic
+@subsubsection CDAbs Intrinsic
+@cindex CDAbs intrinsic
+@cindex intrinsics, CDAbs
+
+@noindent
+@example
+CDAbs(@var{A})
+@end example
+
+@noindent
+CDAbs: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{ABS()} that is specific
+to one type for @var{A}.
+@xref{Abs Intrinsic}.
+
+@node CDCos Intrinsic
+@subsubsection CDCos Intrinsic
+@cindex CDCos intrinsic
+@cindex intrinsics, CDCos
+
+@noindent
+@example
+CDCos(@var{X})
+@end example
+
+@noindent
+CDCos: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{COS()} that is specific
+to one type for @var{X}.
+@xref{Cos Intrinsic}.
+
+@node CDExp Intrinsic
+@subsubsection CDExp Intrinsic
+@cindex CDExp intrinsic
+@cindex intrinsics, CDExp
+
+@noindent
+@example
+CDExp(@var{X})
+@end example
+
+@noindent
+CDExp: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{EXP()} that is specific
+to one type for @var{X}.
+@xref{Exp Intrinsic}.
+
+@node CDLog Intrinsic
+@subsubsection CDLog Intrinsic
+@cindex CDLog intrinsic
+@cindex intrinsics, CDLog
+
+@noindent
+@example
+CDLog(@var{X})
+@end example
+
+@noindent
+CDLog: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{LOG()} that is specific
+to one type for @var{X}.
+@xref{Log Intrinsic}.
+
+@node CDSin Intrinsic
+@subsubsection CDSin Intrinsic
+@cindex CDSin intrinsic
+@cindex intrinsics, CDSin
+
+@noindent
+@example
+CDSin(@var{X})
+@end example
+
+@noindent
+CDSin: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{SIN()} that is specific
+to one type for @var{X}.
+@xref{Sin Intrinsic}.
+
+@node CDSqRt Intrinsic
+@subsubsection CDSqRt Intrinsic
+@cindex CDSqRt intrinsic
+@cindex intrinsics, CDSqRt
+
+@noindent
+@example
+CDSqRt(@var{X})
+@end example
+
+@noindent
+CDSqRt: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{SQRT()} that is specific
+to one type for @var{X}.
+@xref{SqRt Intrinsic}.
+
+@end ifset
+@ifset familyF90
+@node Ceiling Intrinsic
+@subsubsection Ceiling Intrinsic
+@cindex Ceiling intrinsic
+@cindex intrinsics, Ceiling
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Ceiling} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node CExp Intrinsic
+@subsubsection CExp Intrinsic
+@cindex CExp intrinsic
+@cindex intrinsics, CExp
+
+@noindent
+@example
+CExp(@var{X})
+@end example
+
+@noindent
+CExp: @code{COMPLEX(KIND=1)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{EXP()} that is specific
+to one type for @var{X}.
+@xref{Exp Intrinsic}.
+
+@node Char Intrinsic
+@subsubsection Char Intrinsic
+@cindex Char intrinsic
+@cindex intrinsics, Char
+
+@noindent
+@example
+Char(@var{I})
+@end example
+
+@noindent
+Char: @code{CHARACTER*1} function.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the character corresponding to the
+code specified by @var{I}, using the system's
+native character set.
+
+Because the system's native character set is used,
+the correspondence between character and their codes
+is not necessarily the same between GNU Fortran
+implementations.
+
+Note that no intrinsic exists to convert a numerical
+value to a printable character string.
+For example, there is no intrinsic that, given
+an @code{INTEGER} or @code{REAL} argument with the
+value @samp{154}, returns the @code{CHARACTER}
+result @samp{'154'}.
+
+Instead, you can use internal-file I/O to do this kind
+of conversion.
+For example:
+
+@smallexample
+INTEGER VALUE
+CHARACTER*10 STRING
+VALUE = 154
+WRITE (STRING, '(I10)'), VALUE
+PRINT *, STRING
+END
+@end smallexample
+
+The above program, when run, prints:
+
+@smallexample
+        154
+@end smallexample
+
+@xref{IChar Intrinsic}, for the inverse of the @code{CHAR} function.
+
+@xref{AChar Intrinsic}, for the function corresponding
+to the ASCII character set.
+
+@end ifset
+@ifset familyF2U
+@node ChDir Intrinsic (subroutine)
+@subsubsection ChDir Intrinsic (subroutine)
+@cindex ChDir intrinsic
+@cindex intrinsics, ChDir
+
+@noindent
+@example
+CALL ChDir(@var{Dir}, @var{Status})
+@end example
+
+@noindent
+@var{Dir}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Sets the current working directory to be @var{Dir}.
+If the @var{Status} argument is supplied, it contains 0
+on success or a nonzero error code otherwise upon return.
+See @code{chdir(3)}.
+
+@emph{Caution:} Using this routine during I/O to a unit connected with a
+non-absolute file name can cause subsequent I/O on such a unit to fail
+because the I/O library might reopen files by name.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{ChDir Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node ChDir Intrinsic (function)
+@subsubsection ChDir Intrinsic (function)
+@cindex ChDir intrinsic
+@cindex intrinsics, ChDir
+
+@noindent
+@example
+ChDir(@var{Dir})
+@end example
+
+@noindent
+ChDir: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Dir}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Sets the current working directory to be @var{Dir}.
+Returns 0 on success or a nonzero error code.
+See @code{chdir(3)}.
+
+@emph{Caution:} Using this routine during I/O to a unit connected with a
+non-absolute file name can cause subsequent I/O on such a unit to fail
+because the I/O library might reopen files by name.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{ChDir Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF2U
+@node ChMod Intrinsic (subroutine)
+@subsubsection ChMod Intrinsic (subroutine)
+@cindex ChMod intrinsic
+@cindex intrinsics, ChMod
+
+@noindent
+@example
+CALL ChMod(@var{Name}, @var{Mode}, @var{Status})
+@end example
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Mode}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Changes the access mode of file @var{Name} according to the
+specification @var{Mode}, which is given in the format of
+@code{chmod(1)}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{Name}---otherwise,
+trailing blanks in @var{Name} are ignored.
+Currently, @var{Name} must not contain the single quote
+character.
+
+If the @var{Status} argument is supplied, it contains
+0 on success or a nonzero error code upon return.
+
+Note that this currently works
+by actually invoking @code{/bin/chmod} (or the @code{chmod} found when
+the library was configured) and so might fail in some circumstances and
+will, anyway, be slow.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{ChMod Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node ChMod Intrinsic (function)
+@subsubsection ChMod Intrinsic (function)
+@cindex ChMod intrinsic
+@cindex intrinsics, ChMod
+
+@noindent
+@example
+ChMod(@var{Name}, @var{Mode})
+@end example
+
+@noindent
+ChMod: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Mode}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Changes the access mode of file @var{Name} according to the
+specification @var{Mode}, which is given in the format of
+@code{chmod(1)}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{Name}---otherwise,
+trailing blanks in @var{Name} are ignored.
+Currently, @var{Name} must not contain the single quote
+character.
+
+Returns 0 on success or a nonzero error code otherwise.
+
+Note that this currently works
+by actually invoking @code{/bin/chmod} (or the @code{chmod} found when
+the library was configured) and so might fail in some circumstances and
+will, anyway, be slow.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{ChMod Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF77
+@node CLog Intrinsic
+@subsubsection CLog Intrinsic
+@cindex CLog intrinsic
+@cindex intrinsics, CLog
+
+@noindent
+@example
+CLog(@var{X})
+@end example
+
+@noindent
+CLog: @code{COMPLEX(KIND=1)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{LOG()} that is specific
+to one type for @var{X}.
+@xref{Log Intrinsic}.
+
+@node Cmplx Intrinsic
+@subsubsection Cmplx Intrinsic
+@cindex Cmplx intrinsic
+@cindex intrinsics, Cmplx
+
+@noindent
+@example
+Cmplx(@var{X}, @var{Y})
+@end example
+
+@noindent
+Cmplx: @code{COMPLEX(KIND=1)} function.
+
+@noindent
+@var{X}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+@var{Y}: @code{INTEGER} or @code{REAL}; OPTIONAL (must be omitted if @var{X} is @code{COMPLEX}); scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+If @var{X} is not type @code{COMPLEX},
+constructs a value of type @code{COMPLEX(KIND=1)} from the
+real and imaginary values specified by @var{X} and
+@var{Y}, respectively.
+If @var{Y} is omitted, @samp{0.} is assumed.
+
+If @var{X} is type @code{COMPLEX},
+converts it to type @code{COMPLEX(KIND=1)}.
+
+@xref{Complex Intrinsic}, for information on easily constructing
+a @code{COMPLEX} value of arbitrary precision from @code{REAL}
+arguments.
+
+@end ifset
+@ifset familyGNU
+@node Complex Intrinsic
+@subsubsection Complex Intrinsic
+@cindex Complex intrinsic
+@cindex intrinsics, Complex
+
+@noindent
+@example
+Complex(@var{Real}, @var{Imag})
+@end example
+
+@noindent
+Complex: @code{COMPLEX} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{Real}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+@var{Imag}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{gnu}.
+
+@noindent
+Description:
+
+Returns a @code{COMPLEX} value that has @samp{Real} and @samp{Imag} as its
+real and imaginary parts, respectively.
+
+If @var{Real} and @var{Imag} are the same type, and that type is not
+@code{INTEGER}, no data conversion is performed, and the type of
+the resulting value has the same kind value as the types
+of @var{Real} and @var{Imag}.
+
+If @var{Real} and @var{Imag} are not the same type, the usual type-promotion
+rules are applied to both, converting either or both to the
+appropriate @code{REAL} type.
+The type of the resulting value has the same kind value as the
+type to which both @var{Real} and @var{Imag} were converted, in this case.
+
+If @var{Real} and @var{Imag} are both @code{INTEGER}, they are both converted
+to @code{REAL(KIND=1)}, and the result of the @code{COMPLEX()}
+invocation is type @code{COMPLEX(KIND=1)}.
+
+@emph{Note:} The way to do this in standard Fortran 90
+is too hairy to describe here, but it is important to
+note that @samp{CMPLX(D1,D2)} returns a @code{COMPLEX(KIND=1)}
+result even if @samp{D1} and @samp{D2} are type @code{REAL(KIND=2)}.
+Hence the availability of @code{COMPLEX()} in GNU Fortran.
+
+@end ifset
+@ifset familyF77
+@node Conjg Intrinsic
+@subsubsection Conjg Intrinsic
+@cindex Conjg intrinsic
+@cindex intrinsics, Conjg
+
+@noindent
+@example
+Conjg(@var{Z})
+@end example
+
+@noindent
+Conjg: @code{COMPLEX} function, the @samp{KIND=} value of the type being that of argument @var{Z}.
+
+@noindent
+@var{Z}: @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the complex conjugate:
+
+@example
+COMPLEX(REALPART(@var{Z}), -IMAGPART(@var{Z}))
+@end example
+
+@node Cos Intrinsic
+@subsubsection Cos Intrinsic
+@cindex Cos intrinsic
+@cindex intrinsics, Cos
+
+@noindent
+@example
+Cos(@var{X})
+@end example
+
+@noindent
+Cos: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the cosine of @var{X}, an angle measured
+in radians.
+
+@xref{ACos Intrinsic}, for the inverse of this function.
+
+@end ifset
+@ifset familyVXT
+@node CosD Intrinsic
+@subsubsection CosD Intrinsic
+@cindex CosD intrinsic
+@cindex intrinsics, CosD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL CosD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node CosH Intrinsic
+@subsubsection CosH Intrinsic
+@cindex CosH intrinsic
+@cindex intrinsics, CosH
+
+@noindent
+@example
+CosH(@var{X})
+@end example
+
+@noindent
+CosH: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the hyperbolic cosine of @var{X}.
+
+@end ifset
+@ifset familyF90
+@node Count Intrinsic
+@subsubsection Count Intrinsic
+@cindex Count intrinsic
+@cindex intrinsics, Count
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Count} to use this name for an
+external procedure.
+
+@node CPU_Time Intrinsic
+@subsubsection CPU_Time Intrinsic
+@cindex CPU_Time intrinsic
+@cindex intrinsics, CPU_Time
+
+@noindent
+@example
+CALL CPU_Time(@var{Seconds})
+@end example
+
+@noindent
+@var{Seconds}: @code{REAL}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{f90}.
+
+@noindent
+Description:
+
+Returns in @var{Seconds} the current value of the system time.
+This implementation of the Fortran 95 intrinsic is just an alias for
+@code{second} @xref{Second Intrinsic (subroutine)}.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+@node CShift Intrinsic
+@subsubsection CShift Intrinsic
+@cindex CShift intrinsic
+@cindex intrinsics, CShift
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL CShift} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node CSin Intrinsic
+@subsubsection CSin Intrinsic
+@cindex CSin intrinsic
+@cindex intrinsics, CSin
+
+@noindent
+@example
+CSin(@var{X})
+@end example
+
+@noindent
+CSin: @code{COMPLEX(KIND=1)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{SIN()} that is specific
+to one type for @var{X}.
+@xref{Sin Intrinsic}.
+
+@node CSqRt Intrinsic
+@subsubsection CSqRt Intrinsic
+@cindex CSqRt intrinsic
+@cindex intrinsics, CSqRt
+
+@noindent
+@example
+CSqRt(@var{X})
+@end example
+
+@noindent
+CSqRt: @code{COMPLEX(KIND=1)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{SQRT()} that is specific
+to one type for @var{X}.
+@xref{SqRt Intrinsic}.
+
+@end ifset
+@ifset familyF2U
+@node CTime Intrinsic (subroutine)
+@subsubsection CTime Intrinsic (subroutine)
+@cindex CTime intrinsic
+@cindex intrinsics, CTime
+
+@noindent
+@example
+CALL CTime(@var{STime}, @var{Result})
+@end example
+
+@noindent
+@var{STime}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Result}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Converts @var{STime}, a system time value, such as returned by
+@code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995},
+and returns that string in @var{Result}.
+
+@xref{Time8 Intrinsic}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+
+For information on other intrinsics with the same name:
+@xref{CTime Intrinsic (function)}.
+
+@node CTime Intrinsic (function)
+@subsubsection CTime Intrinsic (function)
+@cindex CTime intrinsic
+@cindex intrinsics, CTime
+
+@noindent
+@example
+CTime(@var{STime})
+@end example
+
+@noindent
+CTime: @code{CHARACTER*(*)} function.
+
+@noindent
+@var{STime}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Converts @var{STime}, a system time value, such as returned by
+@code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995},
+and returns that string as the function value.
+
+@xref{Time8 Intrinsic}.
+
+For information on other intrinsics with the same name:
+@xref{CTime Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF77
+@node DAbs Intrinsic
+@subsubsection DAbs Intrinsic
+@cindex DAbs intrinsic
+@cindex intrinsics, DAbs
+
+@noindent
+@example
+DAbs(@var{A})
+@end example
+
+@noindent
+DAbs: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ABS()} that is specific
+to one type for @var{A}.
+@xref{Abs Intrinsic}.
+
+@node DACos Intrinsic
+@subsubsection DACos Intrinsic
+@cindex DACos intrinsic
+@cindex intrinsics, DACos
+
+@noindent
+@example
+DACos(@var{X})
+@end example
+
+@noindent
+DACos: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ACOS()} that is specific
+to one type for @var{X}.
+@xref{ACos Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node DACosD Intrinsic
+@subsubsection DACosD Intrinsic
+@cindex DACosD intrinsic
+@cindex intrinsics, DACosD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DACosD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node DASin Intrinsic
+@subsubsection DASin Intrinsic
+@cindex DASin intrinsic
+@cindex intrinsics, DASin
+
+@noindent
+@example
+DASin(@var{X})
+@end example
+
+@noindent
+DASin: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ASIN()} that is specific
+to one type for @var{X}.
+@xref{ASin Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node DASinD Intrinsic
+@subsubsection DASinD Intrinsic
+@cindex DASinD intrinsic
+@cindex intrinsics, DASinD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DASinD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node DATan Intrinsic
+@subsubsection DATan Intrinsic
+@cindex DATan intrinsic
+@cindex intrinsics, DATan
+
+@noindent
+@example
+DATan(@var{X})
+@end example
+
+@noindent
+DATan: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ATAN()} that is specific
+to one type for @var{X}.
+@xref{ATan Intrinsic}.
+
+@node DATan2 Intrinsic
+@subsubsection DATan2 Intrinsic
+@cindex DATan2 intrinsic
+@cindex intrinsics, DATan2
+
+@noindent
+@example
+DATan2(@var{Y}, @var{X})
+@end example
+
+@noindent
+DATan2: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{Y}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ATAN2()} that is specific
+to one type for @var{Y} and @var{X}.
+@xref{ATan2 Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node DATan2D Intrinsic
+@subsubsection DATan2D Intrinsic
+@cindex DATan2D intrinsic
+@cindex intrinsics, DATan2D
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DATan2D} to use this name for an
+external procedure.
+
+@node DATanD Intrinsic
+@subsubsection DATanD Intrinsic
+@cindex DATanD intrinsic
+@cindex intrinsics, DATanD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DATanD} to use this name for an
+external procedure.
+
+@node Date Intrinsic
+@subsubsection Date Intrinsic
+@cindex Date intrinsic
+@cindex intrinsics, Date
+
+@noindent
+@example
+CALL Date(@var{Date})
+@end example
+
+@noindent
+@var{Date}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{vxt}.
+
+@noindent
+Description:
+
+Returns @var{Date} in the form @samp{@var{dd}-@var{mmm}-@var{yy}},
+representing the numeric day of the month @var{dd}, a three-character
+abbreviation of the month name @var{mmm} and the last two digits of
+the year @var{yy}, e.g.@: @samp{25-Nov-96}.
+
+@cindex Y2K compliance
+@cindex Year 2000 compliance
+This intrinsic is not recommended, due to the year 2000 approaching.
+Therefore, programs making use of this intrinsic
+might not be Year 2000 (Y2K) compliant.
+@xref{CTime Intrinsic (subroutine)}, for information on obtaining more digits
+for the current (or any) date.
+
+@end ifset
+@ifset familyF90
+@node Date_and_Time Intrinsic
+@subsubsection Date_and_Time Intrinsic
+@cindex Date_and_Time intrinsic
+@cindex intrinsics, Date_and_Time
+
+@noindent
+@example
+CALL Date_and_Time(@var{Date}, @var{Time}, @var{Zone}, @var{Values})
+@end example
+
+@noindent
+@var{Date}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+@var{Time}: @code{CHARACTER}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+@var{Zone}: @code{CHARACTER}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+@var{Values}: @code{INTEGER(KIND=1)}; OPTIONAL; DIMENSION(8); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{f90}.
+
+@noindent
+Description:
+
+Returns:
+@table @var
+@item Date
+The date in the form @var{ccyymmdd}: century, year, month and day;
+@item Time
+The time in the form @samp{@var{hhmmss.ss}}: hours, minutes, seconds
+and milliseconds;
+@item Zone
+The difference between local time and UTC (GMT) in the form @var{Shhmm}:
+sign, hours and minutes, e.g.@: @samp{-0500} (winter in New York);
+@item Values
+The year, month of the year, day of the month, time difference in
+minutes from UTC, hour of the day, minutes of the hour, seconds
+of the minute, and milliseconds
+of the second in successive values of the array.
+@end table
+
+@cindex Y10K compliance
+@cindex Year 10000 compliance
+@cindex wraparound, Y10K
+@cindex limits, Y10K
+Programs making use of this intrinsic
+might not be Year 10000 (Y10K) compliant.
+For example, the date might appear,
+to such programs, to wrap around
+(change from a larger value to a smaller one)
+as of the Year 10000.
+
+On systems where a millisecond timer isn't available, the millisecond
+value is returned as zero.
+
+@end ifset
+@ifset familyF2U
+@node DbesJ0 Intrinsic
+@subsubsection DbesJ0 Intrinsic
+@cindex DbesJ0 intrinsic
+@cindex intrinsics, DbesJ0
+
+@noindent
+@example
+DbesJ0(@var{X})
+@end example
+
+@noindent
+DbesJ0: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{BESJ0()} that is specific
+to one type for @var{X}.
+@xref{BesJ0 Intrinsic}.
+
+@node DbesJ1 Intrinsic
+@subsubsection DbesJ1 Intrinsic
+@cindex DbesJ1 intrinsic
+@cindex intrinsics, DbesJ1
+
+@noindent
+@example
+DbesJ1(@var{X})
+@end example
+
+@noindent
+DbesJ1: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{BESJ1()} that is specific
+to one type for @var{X}.
+@xref{BesJ1 Intrinsic}.
+
+@node DbesJN Intrinsic
+@subsubsection DbesJN Intrinsic
+@cindex DbesJN intrinsic
+@cindex intrinsics, DbesJN
+
+@noindent
+@example
+DbesJN(@var{N}, @var{X})
+@end example
+
+@noindent
+DbesJN: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{N}: @code{INTEGER} not wider than the default kind; scalar; INTENT(IN).
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{BESJN()} that is specific
+to one type for @var{X}.
+@xref{BesJN Intrinsic}.
+
+@node DbesY0 Intrinsic
+@subsubsection DbesY0 Intrinsic
+@cindex DbesY0 intrinsic
+@cindex intrinsics, DbesY0
+
+@noindent
+@example
+DbesY0(@var{X})
+@end example
+
+@noindent
+DbesY0: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{BESY0()} that is specific
+to one type for @var{X}.
+@xref{BesY0 Intrinsic}.
+
+@node DbesY1 Intrinsic
+@subsubsection DbesY1 Intrinsic
+@cindex DbesY1 intrinsic
+@cindex intrinsics, DbesY1
+
+@noindent
+@example
+DbesY1(@var{X})
+@end example
+
+@noindent
+DbesY1: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{BESY1()} that is specific
+to one type for @var{X}.
+@xref{BesY1 Intrinsic}.
+
+@node DbesYN Intrinsic
+@subsubsection DbesYN Intrinsic
+@cindex DbesYN intrinsic
+@cindex intrinsics, DbesYN
+
+@noindent
+@example
+DbesYN(@var{N}, @var{X})
+@end example
+
+@noindent
+DbesYN: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{N}: @code{INTEGER} not wider than the default kind; scalar; INTENT(IN).
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{BESYN()} that is specific
+to one type for @var{X}.
+@xref{BesYN Intrinsic}.
+
+@end ifset
+@ifset familyF77
+@node Dble Intrinsic
+@subsubsection Dble Intrinsic
+@cindex Dble intrinsic
+@cindex intrinsics, Dble
+
+@noindent
+@example
+Dble(@var{A})
+@end example
+
+@noindent
+Dble: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @var{A} converted to double precision
+(@code{REAL(KIND=2)}).
+If @var{A} is @code{COMPLEX}, the real part of
+@var{A} is used for the conversion
+and the imaginary part disregarded.
+
+@xref{Sngl Intrinsic}, for the function that converts
+to single precision.
+
+@xref{Int Intrinsic}, for the function that converts
+to @code{INTEGER}.
+
+@xref{Complex Intrinsic}, for the function that converts
+to @code{COMPLEX}.
+
+@end ifset
+@ifset familyVXT
+@node DbleQ Intrinsic
+@subsubsection DbleQ Intrinsic
+@cindex DbleQ intrinsic
+@cindex intrinsics, DbleQ
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DbleQ} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyFVZ
+@node DCmplx Intrinsic
+@subsubsection DCmplx Intrinsic
+@cindex DCmplx intrinsic
+@cindex intrinsics, DCmplx
+
+@noindent
+@example
+DCmplx(@var{X}, @var{Y})
+@end example
+
+@noindent
+DCmplx: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+@var{Y}: @code{INTEGER} or @code{REAL}; OPTIONAL (must be omitted if @var{X} is @code{COMPLEX}); scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+If @var{X} is not type @code{COMPLEX},
+constructs a value of type @code{COMPLEX(KIND=2)} from the
+real and imaginary values specified by @var{X} and
+@var{Y}, respectively.
+If @var{Y} is omitted, @samp{0D0} is assumed.
+
+If @var{X} is type @code{COMPLEX},
+converts it to type @code{COMPLEX(KIND=2)}.
+
+Although this intrinsic is not standard Fortran,
+it is a popular extension offered by many compilers
+that support @code{DOUBLE COMPLEX}, since it offers
+the easiest way to convert to @code{DOUBLE COMPLEX}
+without using Fortran 90 features (such as the @samp{KIND=}
+argument to the @code{CMPLX()} intrinsic).
+
+(@samp{CMPLX(0D0, 0D0)} returns a single-precision
+@code{COMPLEX} result, as required by standard FORTRAN 77.
+That's why so many compilers provide @code{DCMPLX()}, since
+@samp{DCMPLX(0D0, 0D0)} returns a @code{DOUBLE COMPLEX}
+result.
+Still, @code{DCMPLX()} converts even @code{REAL*16} arguments
+to their @code{REAL*8} equivalents in most dialects of
+Fortran, so neither it nor @code{CMPLX()} allow easy
+construction of arbitrary-precision values without
+potentially forcing a conversion involving extending or
+reducing precision.
+GNU Fortran provides such an intrinsic, called @code{COMPLEX()}.)
+
+@xref{Complex Intrinsic}, for information on easily constructing
+a @code{COMPLEX} value of arbitrary precision from @code{REAL}
+arguments.
+
+@node DConjg Intrinsic
+@subsubsection DConjg Intrinsic
+@cindex DConjg intrinsic
+@cindex intrinsics, DConjg
+
+@noindent
+@example
+DConjg(@var{Z})
+@end example
+
+@noindent
+DConjg: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{Z}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{CONJG()} that is specific
+to one type for @var{Z}.
+@xref{Conjg Intrinsic}.
+
+@end ifset
+@ifset familyF77
+@node DCos Intrinsic
+@subsubsection DCos Intrinsic
+@cindex DCos intrinsic
+@cindex intrinsics, DCos
+
+@noindent
+@example
+DCos(@var{X})
+@end example
+
+@noindent
+DCos: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{COS()} that is specific
+to one type for @var{X}.
+@xref{Cos Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node DCosD Intrinsic
+@subsubsection DCosD Intrinsic
+@cindex DCosD intrinsic
+@cindex intrinsics, DCosD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DCosD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node DCosH Intrinsic
+@subsubsection DCosH Intrinsic
+@cindex DCosH intrinsic
+@cindex intrinsics, DCosH
+
+@noindent
+@example
+DCosH(@var{X})
+@end example
+
+@noindent
+DCosH: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{COSH()} that is specific
+to one type for @var{X}.
+@xref{CosH Intrinsic}.
+
+@node DDiM Intrinsic
+@subsubsection DDiM Intrinsic
+@cindex DDiM intrinsic
+@cindex intrinsics, DDiM
+
+@noindent
+@example
+DDiM(@var{X}, @var{Y})
+@end example
+
+@noindent
+DDiM: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+@var{Y}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{DIM()} that is specific
+to one type for @var{X} and @var{Y}.
+@xref{DiM Intrinsic}.
+
+@end ifset
+@ifset familyF2U
+@node DErF Intrinsic
+@subsubsection DErF Intrinsic
+@cindex DErF intrinsic
+@cindex intrinsics, DErF
+
+@noindent
+@example
+DErF(@var{X})
+@end example
+
+@noindent
+DErF: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{ERF()} that is specific
+to one type for @var{X}.
+@xref{ErF Intrinsic}.
+
+@node DErFC Intrinsic
+@subsubsection DErFC Intrinsic
+@cindex DErFC intrinsic
+@cindex intrinsics, DErFC
+
+@noindent
+@example
+DErFC(@var{X})
+@end example
+
+@noindent
+DErFC: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{ERFC()} that is specific
+to one type for @var{X}.
+@xref{ErFC Intrinsic}.
+
+@end ifset
+@ifset familyF77
+@node DExp Intrinsic
+@subsubsection DExp Intrinsic
+@cindex DExp intrinsic
+@cindex intrinsics, DExp
+
+@noindent
+@example
+DExp(@var{X})
+@end example
+
+@noindent
+DExp: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{EXP()} that is specific
+to one type for @var{X}.
+@xref{Exp Intrinsic}.
+
+@end ifset
+@ifset familyFVZ
+@node DFloat Intrinsic
+@subsubsection DFloat Intrinsic
+@cindex DFloat intrinsic
+@cindex intrinsics, DFloat
+
+@noindent
+@example
+DFloat(@var{A})
+@end example
+
+@noindent
+DFloat: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{REAL()} that is specific
+to one type for @var{A}.
+@xref{Real Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node DFlotI Intrinsic
+@subsubsection DFlotI Intrinsic
+@cindex DFlotI intrinsic
+@cindex intrinsics, DFlotI
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DFlotI} to use this name for an
+external procedure.
+
+@node DFlotJ Intrinsic
+@subsubsection DFlotJ Intrinsic
+@cindex DFlotJ intrinsic
+@cindex intrinsics, DFlotJ
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DFlotJ} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF90
+@node Digits Intrinsic
+@subsubsection Digits Intrinsic
+@cindex Digits intrinsic
+@cindex intrinsics, Digits
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Digits} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node DiM Intrinsic
+@subsubsection DiM Intrinsic
+@cindex DiM intrinsic
+@cindex intrinsics, DiM
+
+@noindent
+@example
+DiM(@var{X}, @var{Y})
+@end example
+
+@noindent
+DiM: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{X}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+@var{Y}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{@var{X}-@var{Y}} if @var{X} is greater than
+@var{Y}; otherwise returns zero.
+
+@end ifset
+@ifset familyFVZ
+@node DImag Intrinsic
+@subsubsection DImag Intrinsic
+@cindex DImag intrinsic
+@cindex intrinsics, DImag
+
+@noindent
+@example
+DImag(@var{Z})
+@end example
+
+@noindent
+DImag: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{Z}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{vxt}.
+
+@noindent
+Description:
+
+Archaic form of @code{AIMAG()} that is specific
+to one type for @var{Z}.
+@xref{AImag Intrinsic}.
+
+@end ifset
+@ifset familyF77
+@node DInt Intrinsic
+@subsubsection DInt Intrinsic
+@cindex DInt intrinsic
+@cindex intrinsics, DInt
+
+@noindent
+@example
+DInt(@var{A})
+@end example
+
+@noindent
+DInt: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{AINT()} that is specific
+to one type for @var{A}.
+@xref{AInt Intrinsic}.
+
+@node DLog Intrinsic
+@subsubsection DLog Intrinsic
+@cindex DLog intrinsic
+@cindex intrinsics, DLog
+
+@noindent
+@example
+DLog(@var{X})
+@end example
+
+@noindent
+DLog: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{LOG()} that is specific
+to one type for @var{X}.
+@xref{Log Intrinsic}.
+
+@node DLog10 Intrinsic
+@subsubsection DLog10 Intrinsic
+@cindex DLog10 intrinsic
+@cindex intrinsics, DLog10
+
+@noindent
+@example
+DLog10(@var{X})
+@end example
+
+@noindent
+DLog10: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{LOG10()} that is specific
+to one type for @var{X}.
+@xref{Log10 Intrinsic}.
+
+@node DMax1 Intrinsic
+@subsubsection DMax1 Intrinsic
+@cindex DMax1 intrinsic
+@cindex intrinsics, DMax1
+
+@noindent
+@example
+DMax1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+DMax1: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MAX()} that is specific
+to one type for @var{A}.
+@xref{Max Intrinsic}.
+
+@node DMin1 Intrinsic
+@subsubsection DMin1 Intrinsic
+@cindex DMin1 intrinsic
+@cindex intrinsics, DMin1
+
+@noindent
+@example
+DMin1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+DMin1: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MIN()} that is specific
+to one type for @var{A}.
+@xref{Min Intrinsic}.
+
+@node DMod Intrinsic
+@subsubsection DMod Intrinsic
+@cindex DMod intrinsic
+@cindex intrinsics, DMod
+
+@noindent
+@example
+DMod(@var{A}, @var{P})
+@end example
+
+@noindent
+DMod: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+@var{P}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MOD()} that is specific
+to one type for @var{A}.
+@xref{Mod Intrinsic}.
+
+@node DNInt Intrinsic
+@subsubsection DNInt Intrinsic
+@cindex DNInt intrinsic
+@cindex intrinsics, DNInt
+
+@noindent
+@example
+DNInt(@var{A})
+@end example
+
+@noindent
+DNInt: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ANINT()} that is specific
+to one type for @var{A}.
+@xref{ANInt Intrinsic}.
+
+@end ifset
+@ifset familyF90
+@node Dot_Product Intrinsic
+@subsubsection Dot_Product Intrinsic
+@cindex Dot_Product intrinsic
+@cindex intrinsics, Dot_Product
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Dot_Product} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node DProd Intrinsic
+@subsubsection DProd Intrinsic
+@cindex DProd intrinsic
+@cindex intrinsics, DProd
+
+@noindent
+@example
+DProd(@var{X}, @var{Y})
+@end example
+
+@noindent
+DProd: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+@var{Y}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{DBLE(@var{X})*DBLE(@var{Y})}.
+
+@end ifset
+@ifset familyVXT
+@node DReal Intrinsic
+@subsubsection DReal Intrinsic
+@cindex DReal intrinsic
+@cindex intrinsics, DReal
+
+@noindent
+@example
+DReal(@var{A})
+@end example
+
+@noindent
+DReal: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{vxt}.
+
+@noindent
+Description:
+
+Converts @var{A} to @code{REAL(KIND=2)}.
+
+If @var{A} is type @code{COMPLEX}, its real part
+is converted (if necessary) to @code{REAL(KIND=2)},
+and its imaginary part is disregarded.
+
+Although this intrinsic is not standard Fortran,
+it is a popular extension offered by many compilers
+that support @code{DOUBLE COMPLEX}, since it offers
+the easiest way to extract the real part of a @code{DOUBLE COMPLEX}
+value without using the Fortran 90 @code{REAL()} intrinsic
+in a way that produces a return value inconsistent with
+the way many FORTRAN 77 compilers handle @code{REAL()} of
+a @code{DOUBLE COMPLEX} value.
+
+@xref{RealPart Intrinsic}, for information on a GNU Fortran
+intrinsic that avoids these areas of confusion.
+
+@xref{Dble Intrinsic}, for information on the standard FORTRAN 77
+replacement for @code{DREAL()}.
+
+@xref{REAL() and AIMAG() of Complex}, for more information on
+this issue.
+
+@end ifset
+@ifset familyF77
+@node DSign Intrinsic
+@subsubsection DSign Intrinsic
+@cindex DSign intrinsic
+@cindex intrinsics, DSign
+
+@noindent
+@example
+DSign(@var{A}, @var{B})
+@end example
+
+@noindent
+DSign: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+@var{B}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{SIGN()} that is specific
+to one type for @var{A} and @var{B}.
+@xref{Sign Intrinsic}.
+
+@node DSin Intrinsic
+@subsubsection DSin Intrinsic
+@cindex DSin intrinsic
+@cindex intrinsics, DSin
+
+@noindent
+@example
+DSin(@var{X})
+@end example
+
+@noindent
+DSin: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{SIN()} that is specific
+to one type for @var{X}.
+@xref{Sin Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node DSinD Intrinsic
+@subsubsection DSinD Intrinsic
+@cindex DSinD intrinsic
+@cindex intrinsics, DSinD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DSinD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node DSinH Intrinsic
+@subsubsection DSinH Intrinsic
+@cindex DSinH intrinsic
+@cindex intrinsics, DSinH
+
+@noindent
+@example
+DSinH(@var{X})
+@end example
+
+@noindent
+DSinH: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{SINH()} that is specific
+to one type for @var{X}.
+@xref{SinH Intrinsic}.
+
+@node DSqRt Intrinsic
+@subsubsection DSqRt Intrinsic
+@cindex DSqRt intrinsic
+@cindex intrinsics, DSqRt
+
+@noindent
+@example
+DSqRt(@var{X})
+@end example
+
+@noindent
+DSqRt: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{SQRT()} that is specific
+to one type for @var{X}.
+@xref{SqRt Intrinsic}.
+
+@node DTan Intrinsic
+@subsubsection DTan Intrinsic
+@cindex DTan intrinsic
+@cindex intrinsics, DTan
+
+@noindent
+@example
+DTan(@var{X})
+@end example
+
+@noindent
+DTan: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{TAN()} that is specific
+to one type for @var{X}.
+@xref{Tan Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node DTanD Intrinsic
+@subsubsection DTanD Intrinsic
+@cindex DTanD intrinsic
+@cindex intrinsics, DTanD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL DTanD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node DTanH Intrinsic
+@subsubsection DTanH Intrinsic
+@cindex DTanH intrinsic
+@cindex intrinsics, DTanH
+
+@noindent
+@example
+DTanH(@var{X})
+@end example
+
+@noindent
+DTanH: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{TANH()} that is specific
+to one type for @var{X}.
+@xref{TanH Intrinsic}.
+
+@end ifset
+@ifset familyF2U
+@node DTime Intrinsic (subroutine)
+@subsubsection DTime Intrinsic (subroutine)
+@cindex DTime intrinsic
+@cindex intrinsics, DTime
+
+@noindent
+@example
+CALL DTime(@var{TArray}, @var{Result})
+@end example
+
+@noindent
+@var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT).
+
+@noindent
+@var{Result}: @code{REAL(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Initially, return the number of seconds of runtime
+since the start of the process's execution
+in @var{Result},
+and the user and system components of this in @samp{@var{TArray}(1)}
+and @samp{@var{TArray}(2)} respectively.
+The value of @var{Result} is equal to @samp{@var{TArray}(1) + @var{TArray}(2)}.
+
+Subsequent invocations of @samp{DTIME()} set values based on accumulations
+since the previous invocation.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+
+For information on other intrinsics with the same name:
+@xref{DTime Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node DTime Intrinsic (function)
+@subsubsection DTime Intrinsic (function)
+@cindex DTime intrinsic
+@cindex intrinsics, DTime
+
+@noindent
+@example
+DTime(@var{TArray})
+@end example
+
+@noindent
+DTime: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Initially, return the number of seconds of runtime
+since the start of the process's execution
+as the function value,
+and the user and system components of this in @samp{@var{TArray}(1)}
+and @samp{@var{TArray}(2)} respectively.
+The functions' value is equal to @samp{@var{TArray}(1) + @var{TArray}(2)}.
+
+Subsequent invocations of @samp{DTIME()} return values accumulated since the
+previous invocation.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{DTime Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node EOShift Intrinsic
+@subsubsection EOShift Intrinsic
+@cindex EOShift intrinsic
+@cindex intrinsics, EOShift
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL EOShift} to use this name for an
+external procedure.
+
+@node Epsilon Intrinsic
+@subsubsection Epsilon Intrinsic
+@cindex Epsilon intrinsic
+@cindex intrinsics, Epsilon
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Epsilon} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node ErF Intrinsic
+@subsubsection ErF Intrinsic
+@cindex ErF intrinsic
+@cindex intrinsics, ErF
+
+@noindent
+@example
+ErF(@var{X})
+@end example
+
+@noindent
+ErF: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the error function of @var{X}.
+See @code{erf(3m)}, which provides the implementation.
+
+@node ErFC Intrinsic
+@subsubsection ErFC Intrinsic
+@cindex ErFC intrinsic
+@cindex intrinsics, ErFC
+
+@noindent
+@example
+ErFC(@var{X})
+@end example
+
+@noindent
+ErFC: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the complementary error function of @var{X}:
+@samp{ERFC(R) = 1 - ERF(R)} (except that the result might be more
+accurate than explicitly evaluating that formulae would give).
+See @code{erfc(3m)}, which provides the implementation.
+
+@node ETime Intrinsic (subroutine)
+@subsubsection ETime Intrinsic (subroutine)
+@cindex ETime intrinsic
+@cindex intrinsics, ETime
+
+@noindent
+@example
+CALL ETime(@var{TArray}, @var{Result})
+@end example
+
+@noindent
+@var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT).
+
+@noindent
+@var{Result}: @code{REAL(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Return the number of seconds of runtime
+since the start of the process's execution
+in @var{Result},
+and the user and system components of this in @samp{@var{TArray}(1)}
+and @samp{@var{TArray}(2)} respectively.
+The value of @var{Result} is equal to @samp{@var{TArray}(1) + @var{TArray}(2)}.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+
+For information on other intrinsics with the same name:
+@xref{ETime Intrinsic (function)}.
+
+@node ETime Intrinsic (function)
+@subsubsection ETime Intrinsic (function)
+@cindex ETime intrinsic
+@cindex intrinsics, ETime
+
+@noindent
+@example
+ETime(@var{TArray})
+@end example
+
+@noindent
+ETime: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Return the number of seconds of runtime
+since the start of the process's execution
+as the function value,
+and the user and system components of this in @samp{@var{TArray}(1)}
+and @samp{@var{TArray}(2)} respectively.
+The functions' value is equal to @samp{@var{TArray}(1) + @var{TArray}(2)}.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+For information on other intrinsics with the same name:
+@xref{ETime Intrinsic (subroutine)}.
+
+@node Exit Intrinsic
+@subsubsection Exit Intrinsic
+@cindex Exit intrinsic
+@cindex intrinsics, Exit
+
+@noindent
+@example
+CALL Exit(@var{Status})
+@end example
+
+@noindent
+@var{Status}: @code{INTEGER} not wider than the default kind; OPTIONAL; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Exit the program with status @var{Status} after closing open Fortran
+I/O units and otherwise behaving as @code{exit(2)}.
+If @var{Status} is omitted the canonical `success' value
+will be returned to the system.
+
+@end ifset
+@ifset familyF77
+@node Exp Intrinsic
+@subsubsection Exp Intrinsic
+@cindex Exp intrinsic
+@cindex intrinsics, Exp
+
+@noindent
+@example
+Exp(@var{X})
+@end example
+
+@noindent
+Exp: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{@var{e}**@var{X}}, where
+@var{e} is approximately 2.7182818.
+
+@xref{Log Intrinsic}, for the inverse of this function.
+
+@end ifset
+@ifset familyF90
+@node Exponent Intrinsic
+@subsubsection Exponent Intrinsic
+@cindex Exponent intrinsic
+@cindex intrinsics, Exponent
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Exponent} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node FDate Intrinsic (subroutine)
+@subsubsection FDate Intrinsic (subroutine)
+@cindex FDate intrinsic
+@cindex intrinsics, FDate
+
+@noindent
+@example
+CALL FDate(@var{Date})
+@end example
+
+@noindent
+@var{Date}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the current date (using the same format as @code{CTIME()})
+in @var{Date}.
+
+Equivalent to:
+
+@example
+CALL CTIME(@var{Date}, TIME8())
+@end example
+
+@cindex Y10K compliance
+@cindex Year 10000 compliance
+@cindex wraparound, Y10K
+@cindex limits, Y10K
+Programs making use of this intrinsic
+might not be Year 10000 (Y10K) compliant.
+For example, the date might appear,
+to such programs, to wrap around
+(change from a larger value to a smaller one)
+as of the Year 10000.
+
+@xref{CTime Intrinsic (subroutine)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+
+For information on other intrinsics with the same name:
+@xref{FDate Intrinsic (function)}.
+
+@node FDate Intrinsic (function)
+@subsubsection FDate Intrinsic (function)
+@cindex FDate intrinsic
+@cindex intrinsics, FDate
+
+@noindent
+@example
+FDate()
+@end example
+
+@noindent
+FDate: @code{CHARACTER*(*)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the current date (using the same format as @code{CTIME()}).
+
+Equivalent to:
+
+@example
+CTIME(TIME8())
+@end example
+
+@cindex Y10K compliance
+@cindex Year 10000 compliance
+@cindex wraparound, Y10K
+@cindex limits, Y10K
+Programs making use of this intrinsic
+might not be Year 10000 (Y10K) compliant.
+For example, the date might appear,
+to such programs, to wrap around
+(change from a larger value to a smaller one)
+as of the Year 10000.
+
+@xref{CTime Intrinsic (function)}.
+
+For information on other intrinsics with the same name:
+@xref{FDate Intrinsic (subroutine)}.
+
+@node FGet Intrinsic (subroutine)
+@subsubsection FGet Intrinsic (subroutine)
+@cindex FGet intrinsic
+@cindex intrinsics, FGet
+
+@noindent
+@example
+CALL FGet(@var{C}, @var{Status})
+@end example
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Reads a single character into @var{C} in stream mode from unit 5
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns in
+@var{Status} 0 on success, @minus{}1 on end-of-file, and the error code
+from @code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FGet Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node FGet Intrinsic (function)
+@subsubsection FGet Intrinsic (function)
+@cindex FGet intrinsic
+@cindex intrinsics, FGet
+
+@noindent
+@example
+FGet(@var{C})
+@end example
+
+@noindent
+FGet: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Reads a single character into @var{C} in stream mode from unit 5
+(by-passing normal formatted input) using @code{getc(3)}.
+Returns 0 on
+success, @minus{}1 on end-of-file, and the error code from
+@code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FGet Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF2U
+@node FGetC Intrinsic (subroutine)
+@subsubsection FGetC Intrinsic (subroutine)
+@cindex FGetC intrinsic
+@cindex intrinsics, FGetC
+
+@noindent
+@example
+CALL FGetC(@var{Unit}, @var{C}, @var{Status})
+@end example
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Reads a single character into @var{C} in stream mode from unit @var{Unit}
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns in
+@var{Status} 0 on success, @minus{}1 on end-of-file, and the error code from
+@code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FGetC Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node FGetC Intrinsic (function)
+@subsubsection FGetC Intrinsic (function)
+@cindex FGetC intrinsic
+@cindex intrinsics, FGetC
+
+@noindent
+@example
+FGetC(@var{Unit}, @var{C})
+@end example
+
+@noindent
+FGetC: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Reads a single character into @var{C} in stream mode from unit @var{Unit}
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns 0 on
+success, @minus{}1 on end-of-file, and the error code from
+@code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FGetC Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF77
+@node Float Intrinsic
+@subsubsection Float Intrinsic
+@cindex Float intrinsic
+@cindex intrinsics, Float
+
+@noindent
+@example
+Float(@var{A})
+@end example
+
+@noindent
+Float: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{REAL()} that is specific
+to one type for @var{A}.
+@xref{Real Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node FloatI Intrinsic
+@subsubsection FloatI Intrinsic
+@cindex FloatI intrinsic
+@cindex intrinsics, FloatI
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL FloatI} to use this name for an
+external procedure.
+
+@node FloatJ Intrinsic
+@subsubsection FloatJ Intrinsic
+@cindex FloatJ intrinsic
+@cindex intrinsics, FloatJ
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL FloatJ} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF90
+@node Floor Intrinsic
+@subsubsection Floor Intrinsic
+@cindex Floor intrinsic
+@cindex intrinsics, Floor
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Floor} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node Flush Intrinsic
+@subsubsection Flush Intrinsic
+@cindex Flush intrinsic
+@cindex intrinsics, Flush
+
+@noindent
+@example
+CALL Flush(@var{Unit})
+@end example
+
+@noindent
+@var{Unit}: @code{INTEGER}; OPTIONAL; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Flushes Fortran unit(s) currently open for output.
+Without the optional argument, all such units are flushed,
+otherwise just the unit specified by @var{Unit}.
+
+Some non-GNU implementations of Fortran provide this intrinsic
+as a library procedure that might or might not support the
+(optional) @var{Unit} argument.
+
+@node FNum Intrinsic
+@subsubsection FNum Intrinsic
+@cindex FNum intrinsic
+@cindex intrinsics, FNum
+
+@noindent
+@example
+FNum(@var{Unit})
+@end example
+
+@noindent
+FNum: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the Unix file descriptor number corresponding to the open
+Fortran I/O unit @var{Unit}.
+This could be passed to an interface to C I/O routines.
+
+@node FPut Intrinsic (subroutine)
+@subsubsection FPut Intrinsic (subroutine)
+@cindex FPut intrinsic
+@cindex intrinsics, FPut
+
+@noindent
+@example
+CALL FPut(@var{C}, @var{Status})
+@end example
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Writes the single character @var{C} in stream mode to unit 6
+(by-passing normal formatted output) using @code{putc(3)}.
+Returns in
+@var{Status} 0 on success, the error code from @code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FPut Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node FPut Intrinsic (function)
+@subsubsection FPut Intrinsic (function)
+@cindex FPut intrinsic
+@cindex intrinsics, FPut
+
+@noindent
+@example
+FPut(@var{C})
+@end example
+
+@noindent
+FPut: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Writes the single character @var{C} in stream mode to unit 6
+(by-passing normal formatted output) using @code{getc(3)}.
+Returns 0 on
+success, the error code from @code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FPut Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF2U
+@node FPutC Intrinsic (subroutine)
+@subsubsection FPutC Intrinsic (subroutine)
+@cindex FPutC intrinsic
+@cindex intrinsics, FPutC
+
+@noindent
+@example
+CALL FPutC(@var{Unit}, @var{C}, @var{Status})
+@end example
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Writes the single character @var{Unit} in stream mode to unit 6
+(by-passing normal formatted output) using @code{putc(3)}.
+Returns in
+@var{C} 0 on success, the error code from @code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FPutC Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node FPutC Intrinsic (function)
+@subsubsection FPutC Intrinsic (function)
+@cindex FPutC intrinsic
+@cindex intrinsics, FPutC
+
+@noindent
+@example
+FPutC(@var{Unit}, @var{C})
+@end example
+
+@noindent
+FPutC: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Writes the single character @var{C} in stream mode to unit @var{Unit}
+(by-passing normal formatted output) using @code{putc(3)}.
+Returns 0 on
+success, the error code from @code{ferror(3)} otherwise.
+
+Stream I/O should not be mixed with normal record-oriented (formatted or
+unformatted) I/O on the same unit; the results are unpredictable.
+
+For information on other intrinsics with the same name:
+@xref{FPutC Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node Fraction Intrinsic
+@subsubsection Fraction Intrinsic
+@cindex Fraction intrinsic
+@cindex intrinsics, Fraction
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Fraction} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node FSeek Intrinsic
+@subsubsection FSeek Intrinsic
+@cindex FSeek intrinsic
+@cindex intrinsics, FSeek
+
+@noindent
+@example
+CALL FSeek(@var{Unit}, @var{Offset}, @var{Whence}, @var{ErrLab})
+@end example
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Offset}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Whence}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{ErrLab}: @samp{*@var{label}}, where @var{label} is the label
+of an executable statement; OPTIONAL.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Attempts to move Fortran unit @var{Unit} to the specified
+@var{Offset}: absolute offset if @var{Whence}=0; relative to the
+current offset if @var{Whence}=1; relative to the end of the file if
+@var{Whence}=2.
+It branches to label @var{ErrLab} if @var{Unit} is
+not open or if the call otherwise fails.
+
+@node FStat Intrinsic (subroutine)
+@subsubsection FStat Intrinsic (subroutine)
+@cindex FStat intrinsic
+@cindex intrinsics, FStat
+
+@noindent
+@example
+CALL FStat(@var{Unit}, @var{SArray}, @var{Status})
+@end example
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Obtains data about the file open on Fortran I/O unit @var{Unit} and
+places them in the array @var{SArray}.
+The values in this array are
+extracted from the @code{stat} structure as returned by
+@code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+Device ID
+
+@item
+Inode number
+
+@item
+File mode
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+ID of device containing directory entry for file
+(0 if not available)
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size (-1 if not available)
+
+@item
+Number of blocks allocated (-1 if not available)
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+If the @var{Status} argument is supplied, it contains
+0 on success or a nonzero error code upon return.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{FStat Intrinsic (function)}.
+
+@node FStat Intrinsic (function)
+@subsubsection FStat Intrinsic (function)
+@cindex FStat intrinsic
+@cindex intrinsics, FStat
+
+@noindent
+@example
+FStat(@var{Unit}, @var{SArray})
+@end example
+
+@noindent
+FStat: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Obtains data about the file open on Fortran I/O unit @var{Unit} and
+places them in the array @var{SArray}.
+The values in this array are
+extracted from the @code{stat} structure as returned by
+@code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+Device ID
+
+@item
+Inode number
+
+@item
+File mode
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+ID of device containing directory entry for file
+(0 if not available)
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size (-1 if not available)
+
+@item
+Number of blocks allocated (-1 if not available)
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+Returns 0 on success or a nonzero error code.
+
+For information on other intrinsics with the same name:
+@xref{FStat Intrinsic (subroutine)}.
+
+@node FTell Intrinsic (subroutine)
+@subsubsection FTell Intrinsic (subroutine)
+@cindex FTell intrinsic
+@cindex intrinsics, FTell
+
+@noindent
+@example
+CALL FTell(@var{Unit}, @var{Offset})
+@end example
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Offset}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Sets @var{Offset} to the current offset of Fortran unit @var{Unit}
+(or to @minus{}1 if @var{Unit} is not open).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+
+For information on other intrinsics with the same name:
+@xref{FTell Intrinsic (function)}.
+
+@node FTell Intrinsic (function)
+@subsubsection FTell Intrinsic (function)
+@cindex FTell intrinsic
+@cindex intrinsics, FTell
+
+@noindent
+@example
+FTell(@var{Unit})
+@end example
+
+@noindent
+FTell: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the current offset of Fortran unit @var{Unit}
+(or @minus{}1 if @var{Unit} is not open).
+
+For information on other intrinsics with the same name:
+@xref{FTell Intrinsic (subroutine)}.
+
+@node GError Intrinsic
+@subsubsection GError Intrinsic
+@cindex GError intrinsic
+@cindex intrinsics, GError
+
+@noindent
+@example
+CALL GError(@var{Message})
+@end example
+
+@noindent
+@var{Message}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the system error message corresponding to the last system
+error (C @code{errno}).
+
+@node GetArg Intrinsic
+@subsubsection GetArg Intrinsic
+@cindex GetArg intrinsic
+@cindex intrinsics, GetArg
+
+@noindent
+@example
+CALL GetArg(@var{Pos}, @var{Value})
+@end example
+
+@noindent
+@var{Pos}: @code{INTEGER} not wider than the default kind; scalar; INTENT(IN).
+
+@noindent
+@var{Value}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Sets @var{Value} to the @var{Pos}-th command-line argument (or to all
+blanks if there are fewer than @var{Value} command-line arguments);
+@code{CALL GETARG(0, @var{value})} sets @var{value} to the name of the
+program (on systems that support this feature).
+
+@xref{IArgC Intrinsic}, for information on how to get the number
+of arguments.
+
+@node GetCWD Intrinsic (subroutine)
+@subsubsection GetCWD Intrinsic (subroutine)
+@cindex GetCWD intrinsic
+@cindex intrinsics, GetCWD
+
+@noindent
+@example
+CALL GetCWD(@var{Name}, @var{Status})
+@end example
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Places the current working directory in @var{Name}.
+If the @var{Status} argument is supplied, it contains 0
+success or a nonzero error code upon return
+(@code{ENOSYS} if the system does not provide @code{getcwd(3)}
+or @code{getwd(3)}).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{GetCWD Intrinsic (function)}.
+
+@node GetCWD Intrinsic (function)
+@subsubsection GetCWD Intrinsic (function)
+@cindex GetCWD intrinsic
+@cindex intrinsics, GetCWD
+
+@noindent
+@example
+GetCWD(@var{Name})
+@end example
+
+@noindent
+GetCWD: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Places the current working directory in @var{Name}.
+Returns 0 on
+success, otherwise a nonzero error code
+(@code{ENOSYS} if the system does not provide @code{getcwd(3)}
+or @code{getwd(3)}).
+
+For information on other intrinsics with the same name:
+@xref{GetCWD Intrinsic (subroutine)}.
+
+@node GetEnv Intrinsic
+@subsubsection GetEnv Intrinsic
+@cindex GetEnv intrinsic
+@cindex intrinsics, GetEnv
+
+@noindent
+@example
+CALL GetEnv(@var{Name}, @var{Value})
+@end example
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Value}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Sets @var{Value} to the value of environment variable given by the
+value of @var{Name} (@code{$name} in shell terms) or to blanks if
+@code{$name} has not been set.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{Name}---otherwise,
+trailing blanks in @var{Name} are ignored.
+
+@node GetGId Intrinsic
+@subsubsection GetGId Intrinsic
+@cindex GetGId intrinsic
+@cindex intrinsics, GetGId
+
+@noindent
+@example
+GetGId()
+@end example
+
+@noindent
+GetGId: @code{INTEGER(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the group id for the current process.
+
+@node GetLog Intrinsic
+@subsubsection GetLog Intrinsic
+@cindex GetLog intrinsic
+@cindex intrinsics, GetLog
+
+@noindent
+@example
+CALL GetLog(@var{Login})
+@end example
+
+@noindent
+@var{Login}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the login name for the process in @var{Login}.
+
+@emph{Caution:} On some systems, the @code{getlogin(3)}
+function, which this intrinsic calls at run time,
+is either not implemented or returns a null pointer.
+In the latter case, this intrinsic returns blanks
+in @var{Login}.
+
+@node GetPId Intrinsic
+@subsubsection GetPId Intrinsic
+@cindex GetPId intrinsic
+@cindex intrinsics, GetPId
+
+@noindent
+@example
+GetPId()
+@end example
+
+@noindent
+GetPId: @code{INTEGER(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the process id for the current process.
+
+@node GetUId Intrinsic
+@subsubsection GetUId Intrinsic
+@cindex GetUId intrinsic
+@cindex intrinsics, GetUId
+
+@noindent
+@example
+GetUId()
+@end example
+
+@noindent
+GetUId: @code{INTEGER(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the user id for the current process.
+
+@node GMTime Intrinsic
+@subsubsection GMTime Intrinsic
+@cindex GMTime intrinsic
+@cindex intrinsics, GMTime
+
+@noindent
+@example
+CALL GMTime(@var{STime}, @var{TArray})
+@end example
+
+@noindent
+@var{STime}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(9); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Given a system time value @var{STime}, fills @var{TArray} with values
+extracted from it appropriate to the GMT time zone using
+@code{gmtime(3)}.
+
+The array elements are as follows:
+
+@enumerate
+@item
+Seconds after the minute, range 0--59 or 0--61 to allow for leap
+seconds
+
+@item
+Minutes after the hour, range 0--59
+
+@item
+Hours past midnight, range 0--23
+
+@item
+Day of month, range 0--31
+
+@item
+Number of months since January, range 0--12
+
+@item
+Years since 1900
+
+@item
+Number of days since Sunday, range 0--6
+
+@item
+Days since January 1
+
+@item
+Daylight savings indicator: positive if daylight savings is in effect,
+zero if not, and negative if the information isn't available.
+@end enumerate
+
+@node HostNm Intrinsic (subroutine)
+@subsubsection HostNm Intrinsic (subroutine)
+@cindex HostNm intrinsic
+@cindex intrinsics, HostNm
+
+@noindent
+@example
+CALL HostNm(@var{Name}, @var{Status})
+@end example
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Fills @var{Name} with the system's host name returned by
+@code{gethostname(2)}.
+If the @var{Status} argument is supplied, it contains
+0 on success or a nonzero error code upon return
+(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+On some systems (specifically SCO) it might be necessary to link the
+``socket'' library if you call this routine.
+Typically this means adding @samp{-lg2c -lsocket -lm}
+to the @code{g77} command line when linking the program.
+
+For information on other intrinsics with the same name:
+@xref{HostNm Intrinsic (function)}.
+
+@node HostNm Intrinsic (function)
+@subsubsection HostNm Intrinsic (function)
+@cindex HostNm intrinsic
+@cindex intrinsics, HostNm
+
+@noindent
+@example
+HostNm(@var{Name})
+@end example
+
+@noindent
+HostNm: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Fills @var{Name} with the system's host name returned by
+@code{gethostname(2)}, returning 0 on success or a nonzero error code
+(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
+
+On some systems (specifically SCO) it might be necessary to link the
+``socket'' library if you call this routine.
+Typically this means adding @samp{-lg2c -lsocket -lm}
+to the @code{g77} command line when linking the program.
+
+For information on other intrinsics with the same name:
+@xref{HostNm Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node Huge Intrinsic
+@subsubsection Huge Intrinsic
+@cindex Huge intrinsic
+@cindex intrinsics, Huge
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Huge} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node IAbs Intrinsic
+@subsubsection IAbs Intrinsic
+@cindex IAbs intrinsic
+@cindex intrinsics, IAbs
+
+@noindent
+@example
+IAbs(@var{A})
+@end example
+
+@noindent
+IAbs: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{ABS()} that is specific
+to one type for @var{A}.
+@xref{Abs Intrinsic}.
+
+@end ifset
+@ifset familyASC
+@node IAChar Intrinsic
+@subsubsection IAChar Intrinsic
+@cindex IAChar intrinsic
+@cindex intrinsics, IAChar
+
+@noindent
+@example
+IAChar(@var{C})
+@end example
+
+@noindent
+IAChar: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}, @code{f90}.
+
+@noindent
+Description:
+
+Returns the code for the ASCII character in the
+first character position of @var{C}.
+
+@xref{AChar Intrinsic}, for the inverse of this function.
+
+@xref{IChar Intrinsic}, for the function corresponding
+to the system's native character set.
+
+@end ifset
+@ifset familyMIL
+@node IAnd Intrinsic
+@subsubsection IAnd Intrinsic
+@cindex IAnd intrinsic
+@cindex intrinsics, IAnd
+
+@noindent
+@example
+IAnd(@var{I}, @var{J})
+@end example
+
+@noindent
+IAnd: @code{INTEGER} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{J}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Returns value resulting from boolean AND of
+pair of bits in each of @var{I} and @var{J}.
+
+@end ifset
+@ifset familyF2U
+@node IArgC Intrinsic
+@subsubsection IArgC Intrinsic
+@cindex IArgC intrinsic
+@cindex intrinsics, IArgC
+
+@noindent
+@example
+IArgC()
+@end example
+
+@noindent
+IArgC: @code{INTEGER(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the number of command-line arguments.
+
+This count does not include the specification of the program
+name itself.
+
+@end ifset
+@ifset familyMIL
+@node IBClr Intrinsic
+@subsubsection IBClr Intrinsic
+@cindex IBClr intrinsic
+@cindex intrinsics, IBClr
+
+@noindent
+@example
+IBClr(@var{I}, @var{Pos})
+@end example
+
+@noindent
+IBClr: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Pos}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Returns the value of @var{I} with bit @var{Pos} cleared (set to
+zero).
+@xref{BTest Intrinsic}, for information on bit positions.
+
+@node IBits Intrinsic
+@subsubsection IBits Intrinsic
+@cindex IBits intrinsic
+@cindex intrinsics, IBits
+
+@noindent
+@example
+IBits(@var{I}, @var{Pos}, @var{Len})
+@end example
+
+@noindent
+IBits: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Pos}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Len}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Extracts a subfield of length @var{Len} from @var{I}, starting from
+bit position @var{Pos} and extending left for @var{Len} bits.
+The result is right-justified and the remaining bits are zeroed.
+The value
+of @samp{@var{Pos}+@var{Len}} must be less than or equal to the value
+@samp{BIT_SIZE(@var{I})}.
+@xref{Bit_Size Intrinsic}.
+
+@node IBSet Intrinsic
+@subsubsection IBSet Intrinsic
+@cindex IBSet intrinsic
+@cindex intrinsics, IBSet
+
+@noindent
+@example
+IBSet(@var{I}, @var{Pos})
+@end example
+
+@noindent
+IBSet: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Pos}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Returns the value of @var{I} with bit @var{Pos} set (to one).
+@xref{BTest Intrinsic}, for information on bit positions.
+
+@end ifset
+@ifset familyF77
+@node IChar Intrinsic
+@subsubsection IChar Intrinsic
+@cindex IChar intrinsic
+@cindex intrinsics, IChar
+
+@noindent
+@example
+IChar(@var{C})
+@end example
+
+@noindent
+IChar: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the code for the character in the
+first character position of @var{C}.
+
+Because the system's native character set is used,
+the correspondence between character and their codes
+is not necessarily the same between GNU Fortran
+implementations.
+
+Note that no intrinsic exists to convert a printable
+character string to a numerical value.
+For example, there is no intrinsic that, given
+the @code{CHARACTER} value @samp{'154'}, returns an
+@code{INTEGER} or @code{REAL} value with the value @samp{154}.
+
+Instead, you can use internal-file I/O to do this kind
+of conversion.
+For example:
+
+@smallexample
+INTEGER VALUE
+CHARACTER*10 STRING
+STRING = '154'
+READ (STRING, '(I10)'), VALUE
+PRINT *, VALUE
+END
+@end smallexample
+
+The above program, when run, prints:
+
+@smallexample
+ 154
+@end smallexample
+
+@xref{Char Intrinsic}, for the inverse of the @code{ICHAR} function.
+
+@xref{IAChar Intrinsic}, for the function corresponding
+to the ASCII character set.
+
+@end ifset
+@ifset familyF2U
+@node IDate Intrinsic (UNIX)
+@subsubsection IDate Intrinsic (UNIX)
+@cindex IDate intrinsic
+@cindex intrinsics, IDate
+
+@noindent
+@example
+CALL IDate(@var{TArray})
+@end example
+
+@noindent
+@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(3); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Fills @var{TArray} with the numerical values at the current local time.
+The day (in the range 1--31), month (in the range 1--12),
+and year appear in elements 1, 2, and 3 of @var{TArray}, respectively.
+The year has four significant digits.
+
+@cindex Y10K compliance
+@cindex Year 10000 compliance
+@cindex wraparound, Y10K
+@cindex limits, Y10K
+Programs making use of this intrinsic
+might not be Year 10000 (Y10K) compliant.
+For example, the date might appear,
+to such programs, to wrap around
+(change from a larger value to a smaller one)
+as of the Year 10000.
+
+For information on other intrinsics with the same name:
+@xref{IDate Intrinsic (VXT)}.
+
+@end ifset
+@ifset familyVXT
+@node IDate Intrinsic (VXT)
+@subsubsection IDate Intrinsic (VXT)
+@cindex IDate intrinsic
+@cindex intrinsics, IDate
+
+@noindent
+@example
+CALL IDate(@var{M}, @var{D}, @var{Y})
+@end example
+
+@noindent
+@var{M}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+@var{D}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+@var{Y}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{vxt}.
+
+@noindent
+Description:
+
+Returns the numerical values of the current local time.
+The month (in the range 1--12) is returned in @var{M},
+the day (in the range 1--31) in @var{D},
+and the year in @var{Y} (in the range 0--99).
+
+@cindex Y2K compliance
+@cindex Year 2000 compliance
+@cindex wraparound, Y2K
+@cindex limits, Y2K
+This intrinsic is not recommended, due to the fact that
+its return value for year wraps around century boundaries
+(change from a larger value to a smaller one).
+Therefore, programs making use of this intrinsic, for
+instance, might not be Year 2000 (Y2K) compliant.
+For example, the date might appear,
+to such programs, to wrap around
+as of the Year 2000.
+
+@xref{IDate Intrinsic (UNIX)}, for information on obtaining more digits
+for the current date.
+
+For information on other intrinsics with the same name:
+@xref{IDate Intrinsic (UNIX)}.
+
+@end ifset
+@ifset familyF77
+@node IDiM Intrinsic
+@subsubsection IDiM Intrinsic
+@cindex IDiM intrinsic
+@cindex intrinsics, IDiM
+
+@noindent
+@example
+IDiM(@var{X}, @var{Y})
+@end example
+
+@noindent
+IDiM: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{X}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+@var{Y}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{DIM()} that is specific
+to one type for @var{X} and @var{Y}.
+@xref{DiM Intrinsic}.
+
+@node IDInt Intrinsic
+@subsubsection IDInt Intrinsic
+@cindex IDInt intrinsic
+@cindex intrinsics, IDInt
+
+@noindent
+@example
+IDInt(@var{A})
+@end example
+
+@noindent
+IDInt: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{INT()} that is specific
+to one type for @var{A}.
+@xref{Int Intrinsic}.
+
+@node IDNInt Intrinsic
+@subsubsection IDNInt Intrinsic
+@cindex IDNInt intrinsic
+@cindex intrinsics, IDNInt
+
+@noindent
+@example
+IDNInt(@var{A})
+@end example
+
+@noindent
+IDNInt: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{NINT()} that is specific
+to one type for @var{A}.
+@xref{NInt Intrinsic}.
+
+@end ifset
+@ifset familyMIL
+@node IEOr Intrinsic
+@subsubsection IEOr Intrinsic
+@cindex IEOr intrinsic
+@cindex intrinsics, IEOr
+
+@noindent
+@example
+IEOr(@var{I}, @var{J})
+@end example
+
+@noindent
+IEOr: @code{INTEGER} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{J}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Returns value resulting from boolean exclusive-OR of
+pair of bits in each of @var{I} and @var{J}.
+
+@end ifset
+@ifset familyF2U
+@node IErrNo Intrinsic
+@subsubsection IErrNo Intrinsic
+@cindex IErrNo intrinsic
+@cindex intrinsics, IErrNo
+
+@noindent
+@example
+IErrNo()
+@end example
+
+@noindent
+IErrNo: @code{INTEGER(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the last system error number (corresponding to the C
+@code{errno}).
+
+@end ifset
+@ifset familyF77
+@node IFix Intrinsic
+@subsubsection IFix Intrinsic
+@cindex IFix intrinsic
+@cindex intrinsics, IFix
+
+@noindent
+@example
+IFix(@var{A})
+@end example
+
+@noindent
+IFix: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{INT()} that is specific
+to one type for @var{A}.
+@xref{Int Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node IIAbs Intrinsic
+@subsubsection IIAbs Intrinsic
+@cindex IIAbs intrinsic
+@cindex intrinsics, IIAbs
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIAbs} to use this name for an
+external procedure.
+
+@node IIAnd Intrinsic
+@subsubsection IIAnd Intrinsic
+@cindex IIAnd intrinsic
+@cindex intrinsics, IIAnd
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIAnd} to use this name for an
+external procedure.
+
+@node IIBClr Intrinsic
+@subsubsection IIBClr Intrinsic
+@cindex IIBClr intrinsic
+@cindex intrinsics, IIBClr
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIBClr} to use this name for an
+external procedure.
+
+@node IIBits Intrinsic
+@subsubsection IIBits Intrinsic
+@cindex IIBits intrinsic
+@cindex intrinsics, IIBits
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIBits} to use this name for an
+external procedure.
+
+@node IIBSet Intrinsic
+@subsubsection IIBSet Intrinsic
+@cindex IIBSet intrinsic
+@cindex intrinsics, IIBSet
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIBSet} to use this name for an
+external procedure.
+
+@node IIDiM Intrinsic
+@subsubsection IIDiM Intrinsic
+@cindex IIDiM intrinsic
+@cindex intrinsics, IIDiM
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIDiM} to use this name for an
+external procedure.
+
+@node IIDInt Intrinsic
+@subsubsection IIDInt Intrinsic
+@cindex IIDInt intrinsic
+@cindex intrinsics, IIDInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIDInt} to use this name for an
+external procedure.
+
+@node IIDNnt Intrinsic
+@subsubsection IIDNnt Intrinsic
+@cindex IIDNnt intrinsic
+@cindex intrinsics, IIDNnt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIDNnt} to use this name for an
+external procedure.
+
+@node IIEOr Intrinsic
+@subsubsection IIEOr Intrinsic
+@cindex IIEOr intrinsic
+@cindex intrinsics, IIEOr
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIEOr} to use this name for an
+external procedure.
+
+@node IIFix Intrinsic
+@subsubsection IIFix Intrinsic
+@cindex IIFix intrinsic
+@cindex intrinsics, IIFix
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIFix} to use this name for an
+external procedure.
+
+@node IInt Intrinsic
+@subsubsection IInt Intrinsic
+@cindex IInt intrinsic
+@cindex intrinsics, IInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IInt} to use this name for an
+external procedure.
+
+@node IIOr Intrinsic
+@subsubsection IIOr Intrinsic
+@cindex IIOr intrinsic
+@cindex intrinsics, IIOr
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIOr} to use this name for an
+external procedure.
+
+@node IIQint Intrinsic
+@subsubsection IIQint Intrinsic
+@cindex IIQint intrinsic
+@cindex intrinsics, IIQint
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIQint} to use this name for an
+external procedure.
+
+@node IIQNnt Intrinsic
+@subsubsection IIQNnt Intrinsic
+@cindex IIQNnt intrinsic
+@cindex intrinsics, IIQNnt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIQNnt} to use this name for an
+external procedure.
+
+@node IIShftC Intrinsic
+@subsubsection IIShftC Intrinsic
+@cindex IIShftC intrinsic
+@cindex intrinsics, IIShftC
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IIShftC} to use this name for an
+external procedure.
+
+@node IISign Intrinsic
+@subsubsection IISign Intrinsic
+@cindex IISign intrinsic
+@cindex intrinsics, IISign
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IISign} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2C
+@node Imag Intrinsic
+@subsubsection Imag Intrinsic
+@cindex Imag intrinsic
+@cindex intrinsics, Imag
+
+@noindent
+@example
+Imag(@var{Z})
+@end example
+
+@noindent
+Imag: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{Z}.
+
+@noindent
+@var{Z}: @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+The imaginary part of @var{Z} is returned, without conversion.
+
+@emph{Note:} The way to do this in standard Fortran 90
+is @samp{AIMAG(@var{Z})}.
+However, when, for example, @var{Z} is @code{DOUBLE COMPLEX},
+@samp{AIMAG(@var{Z})} means something different for some compilers
+that are not true Fortran 90 compilers but offer some
+extensions standardized by Fortran 90 (such as the
+@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}).
+
+The advantage of @code{IMAG()} is that, while not necessarily
+more or less portable than @code{AIMAG()}, it is more likely to
+cause a compiler that doesn't support it to produce a diagnostic
+than generate incorrect code.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+
+@end ifset
+@ifset familyGNU
+@node ImagPart Intrinsic
+@subsubsection ImagPart Intrinsic
+@cindex ImagPart intrinsic
+@cindex intrinsics, ImagPart
+
+@noindent
+@example
+ImagPart(@var{Z})
+@end example
+
+@noindent
+ImagPart: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{Z}.
+
+@noindent
+@var{Z}: @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{gnu}.
+
+@noindent
+Description:
+
+The imaginary part of @var{Z} is returned, without conversion.
+
+@emph{Note:} The way to do this in standard Fortran 90
+is @samp{AIMAG(@var{Z})}.
+However, when, for example, @var{Z} is @code{DOUBLE COMPLEX},
+@samp{AIMAG(@var{Z})} means something different for some compilers
+that are not true Fortran 90 compilers but offer some
+extensions standardized by Fortran 90 (such as the
+@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}).
+
+The advantage of @code{IMAGPART()} is that, while not necessarily
+more or less portable than @code{AIMAG()}, it is more likely to
+cause a compiler that doesn't support it to produce a diagnostic
+than generate incorrect code.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+
+@end ifset
+@ifset familyVXT
+@node IMax0 Intrinsic
+@subsubsection IMax0 Intrinsic
+@cindex IMax0 intrinsic
+@cindex intrinsics, IMax0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IMax0} to use this name for an
+external procedure.
+
+@node IMax1 Intrinsic
+@subsubsection IMax1 Intrinsic
+@cindex IMax1 intrinsic
+@cindex intrinsics, IMax1
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IMax1} to use this name for an
+external procedure.
+
+@node IMin0 Intrinsic
+@subsubsection IMin0 Intrinsic
+@cindex IMin0 intrinsic
+@cindex intrinsics, IMin0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IMin0} to use this name for an
+external procedure.
+
+@node IMin1 Intrinsic
+@subsubsection IMin1 Intrinsic
+@cindex IMin1 intrinsic
+@cindex intrinsics, IMin1
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IMin1} to use this name for an
+external procedure.
+
+@node IMod Intrinsic
+@subsubsection IMod Intrinsic
+@cindex IMod intrinsic
+@cindex intrinsics, IMod
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IMod} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node Index Intrinsic
+@subsubsection Index Intrinsic
+@cindex Index intrinsic
+@cindex intrinsics, Index
+
+@noindent
+@example
+Index(@var{String}, @var{Substring})
+@end example
+
+@noindent
+Index: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{String}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Substring}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the position of the start of the first occurrence of string
+@var{Substring} as a substring in @var{String}, counting from one.
+If @var{Substring} doesn't occur in @var{String}, zero is returned.
+
+@end ifset
+@ifset familyVXT
+@node INInt Intrinsic
+@subsubsection INInt Intrinsic
+@cindex INInt intrinsic
+@cindex intrinsics, INInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL INInt} to use this name for an
+external procedure.
+
+@node INot Intrinsic
+@subsubsection INot Intrinsic
+@cindex INot intrinsic
+@cindex intrinsics, INot
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL INot} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node Int Intrinsic
+@subsubsection Int Intrinsic
+@cindex Int intrinsic
+@cindex intrinsics, Int
+
+@noindent
+@example
+Int(@var{A})
+@end example
+
+@noindent
+Int: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @var{A} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=1)}.
+
+If @var{A} is type @code{COMPLEX}, its real part is
+truncated and converted, and its imaginary part is disregarded.
+
+@xref{NInt Intrinsic}, for how to convert, rounded to nearest
+whole number.
+
+@xref{AInt Intrinsic}, for how to truncate to whole number
+without converting.
+
+@end ifset
+@ifset familyGNU
+@node Int2 Intrinsic
+@subsubsection Int2 Intrinsic
+@cindex Int2 intrinsic
+@cindex intrinsics, Int2
+
+@noindent
+@example
+Int2(@var{A})
+@end example
+
+@noindent
+Int2: @code{INTEGER(KIND=6)} function.
+
+@noindent
+@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{gnu}.
+
+@noindent
+Description:
+
+Returns @var{A} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=6)}.
+
+If @var{A} is type @code{COMPLEX}, its real part
+is truncated and converted, and its imaginary part is disregarded.
+
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+
+@node Int8 Intrinsic
+@subsubsection Int8 Intrinsic
+@cindex Int8 intrinsic
+@cindex intrinsics, Int8
+
+@noindent
+@example
+Int8(@var{A})
+@end example
+
+@noindent
+Int8: @code{INTEGER(KIND=2)} function.
+
+@noindent
+@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{gnu}.
+
+@noindent
+Description:
+
+Returns @var{A} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=2)}.
+
+If @var{A} is type @code{COMPLEX}, its real part
+is truncated and converted, and its imaginary part is disregarded.
+
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+
+@end ifset
+@ifset familyMIL
+@node IOr Intrinsic
+@subsubsection IOr Intrinsic
+@cindex IOr intrinsic
+@cindex intrinsics, IOr
+
+@noindent
+@example
+IOr(@var{I}, @var{J})
+@end example
+
+@noindent
+IOr: @code{INTEGER} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{J}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Returns value resulting from boolean OR of
+pair of bits in each of @var{I} and @var{J}.
+
+@end ifset
+@ifset familyF2U
+@node IRand Intrinsic
+@subsubsection IRand Intrinsic
+@cindex IRand intrinsic
+@cindex intrinsics, IRand
+
+@noindent
+@example
+IRand(@var{Flag})
+@end example
+
+@noindent
+IRand: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Flag}: @code{INTEGER}; OPTIONAL; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns a uniform quasi-random number up to a system-dependent limit.
+If @var{Flag} is 0, the next number in sequence is returned; if
+@var{Flag} is 1, the generator is restarted by calling the UNIX function
+@samp{srand(0)}; if @var{Flag} has any other value,
+it is used as a new seed with @code{srand()}.
+
+@xref{SRand Intrinsic}.
+
+@emph{Note:} As typically implemented (by the routine of the same
+name in the C library), this random number generator is a very poor
+one, though the BSD and GNU libraries provide a much better
+implementation than the `traditional' one.
+On a different system you almost certainly want to use something better.
+
+@node IsaTty Intrinsic
+@subsubsection IsaTty Intrinsic
+@cindex IsaTty intrinsic
+@cindex intrinsics, IsaTty
+
+@noindent
+@example
+IsaTty(@var{Unit})
+@end example
+
+@noindent
+IsaTty: @code{LOGICAL(KIND=1)} function.
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns @code{.TRUE.} if and only if the Fortran I/O unit
+specified by @var{Unit} is connected
+to a terminal device.
+See @code{isatty(3)}.
+
+@end ifset
+@ifset familyMIL
+@node IShft Intrinsic
+@subsubsection IShft Intrinsic
+@cindex IShft intrinsic
+@cindex intrinsics, IShft
+
+@noindent
+@example
+IShft(@var{I}, @var{Shift})
+@end example
+
+@noindent
+IShft: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Shift}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+All bits representing @var{I} are shifted @var{Shift} places.
+@samp{@var{Shift}.GT.0} indicates a left shift, @samp{@var{Shift}.EQ.0}
+indicates no shift and @samp{@var{Shift}.LT.0} indicates a right shift.
+If the absolute value of the shift count is greater than
+@samp{BIT_SIZE(@var{I})}, the result is undefined.
+Bits shifted out from the left end or the right end are lost.
+Zeros are shifted in from the opposite end.
+
+@xref{IShftC Intrinsic}, for the circular-shift equivalent.
+
+@node IShftC Intrinsic
+@subsubsection IShftC Intrinsic
+@cindex IShftC intrinsic
+@cindex intrinsics, IShftC
+
+@noindent
+@example
+IShftC(@var{I}, @var{Shift}, @var{Size})
+@end example
+
+@noindent
+IShftC: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Shift}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Size}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+The rightmost @var{Size} bits of the argument @var{I}
+are shifted circularly @var{Shift}
+places, i.e.@: the bits shifted out of one end are shifted into 
+the opposite end.
+No bits are lost.
+The unshifted bits of the result are the same as
+the unshifted bits of @var{I}.
+The  absolute value of the argument @var{Shift}
+must be less than or equal to @var{Size}.  
+The value of @var{Size} must be greater than or equal to one and less than 
+or equal to @samp{BIT_SIZE(@var{I})}.
+
+@xref{IShft Intrinsic}, for the logical shift equivalent.
+
+@end ifset
+@ifset familyF77
+@node ISign Intrinsic
+@subsubsection ISign Intrinsic
+@cindex ISign intrinsic
+@cindex intrinsics, ISign
+
+@noindent
+@example
+ISign(@var{A}, @var{B})
+@end example
+
+@noindent
+ISign: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+@var{B}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{SIGN()} that is specific
+to one type for @var{A} and @var{B}.
+@xref{Sign Intrinsic}.
+
+@end ifset
+@ifset familyF2U
+@node ITime Intrinsic
+@subsubsection ITime Intrinsic
+@cindex ITime intrinsic
+@cindex intrinsics, ITime
+
+@noindent
+@example
+CALL ITime(@var{TArray})
+@end example
+
+@noindent
+@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(3); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the current local time hour, minutes, and seconds in elements
+1, 2, and 3 of @var{TArray}, respectively.
+
+@end ifset
+@ifset familyVXT
+@node IZExt Intrinsic
+@subsubsection IZExt Intrinsic
+@cindex IZExt intrinsic
+@cindex intrinsics, IZExt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL IZExt} to use this name for an
+external procedure.
+
+@node JIAbs Intrinsic
+@subsubsection JIAbs Intrinsic
+@cindex JIAbs intrinsic
+@cindex intrinsics, JIAbs
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIAbs} to use this name for an
+external procedure.
+
+@node JIAnd Intrinsic
+@subsubsection JIAnd Intrinsic
+@cindex JIAnd intrinsic
+@cindex intrinsics, JIAnd
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIAnd} to use this name for an
+external procedure.
+
+@node JIBClr Intrinsic
+@subsubsection JIBClr Intrinsic
+@cindex JIBClr intrinsic
+@cindex intrinsics, JIBClr
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIBClr} to use this name for an
+external procedure.
+
+@node JIBits Intrinsic
+@subsubsection JIBits Intrinsic
+@cindex JIBits intrinsic
+@cindex intrinsics, JIBits
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIBits} to use this name for an
+external procedure.
+
+@node JIBSet Intrinsic
+@subsubsection JIBSet Intrinsic
+@cindex JIBSet intrinsic
+@cindex intrinsics, JIBSet
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIBSet} to use this name for an
+external procedure.
+
+@node JIDiM Intrinsic
+@subsubsection JIDiM Intrinsic
+@cindex JIDiM intrinsic
+@cindex intrinsics, JIDiM
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIDiM} to use this name for an
+external procedure.
+
+@node JIDInt Intrinsic
+@subsubsection JIDInt Intrinsic
+@cindex JIDInt intrinsic
+@cindex intrinsics, JIDInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIDInt} to use this name for an
+external procedure.
+
+@node JIDNnt Intrinsic
+@subsubsection JIDNnt Intrinsic
+@cindex JIDNnt intrinsic
+@cindex intrinsics, JIDNnt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIDNnt} to use this name for an
+external procedure.
+
+@node JIEOr Intrinsic
+@subsubsection JIEOr Intrinsic
+@cindex JIEOr intrinsic
+@cindex intrinsics, JIEOr
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIEOr} to use this name for an
+external procedure.
+
+@node JIFix Intrinsic
+@subsubsection JIFix Intrinsic
+@cindex JIFix intrinsic
+@cindex intrinsics, JIFix
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIFix} to use this name for an
+external procedure.
+
+@node JInt Intrinsic
+@subsubsection JInt Intrinsic
+@cindex JInt intrinsic
+@cindex intrinsics, JInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JInt} to use this name for an
+external procedure.
+
+@node JIOr Intrinsic
+@subsubsection JIOr Intrinsic
+@cindex JIOr intrinsic
+@cindex intrinsics, JIOr
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIOr} to use this name for an
+external procedure.
+
+@node JIQint Intrinsic
+@subsubsection JIQint Intrinsic
+@cindex JIQint intrinsic
+@cindex intrinsics, JIQint
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIQint} to use this name for an
+external procedure.
+
+@node JIQNnt Intrinsic
+@subsubsection JIQNnt Intrinsic
+@cindex JIQNnt intrinsic
+@cindex intrinsics, JIQNnt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIQNnt} to use this name for an
+external procedure.
+
+@node JIShft Intrinsic
+@subsubsection JIShft Intrinsic
+@cindex JIShft intrinsic
+@cindex intrinsics, JIShft
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIShft} to use this name for an
+external procedure.
+
+@node JIShftC Intrinsic
+@subsubsection JIShftC Intrinsic
+@cindex JIShftC intrinsic
+@cindex intrinsics, JIShftC
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JIShftC} to use this name for an
+external procedure.
+
+@node JISign Intrinsic
+@subsubsection JISign Intrinsic
+@cindex JISign intrinsic
+@cindex intrinsics, JISign
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JISign} to use this name for an
+external procedure.
+
+@node JMax0 Intrinsic
+@subsubsection JMax0 Intrinsic
+@cindex JMax0 intrinsic
+@cindex intrinsics, JMax0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JMax0} to use this name for an
+external procedure.
+
+@node JMax1 Intrinsic
+@subsubsection JMax1 Intrinsic
+@cindex JMax1 intrinsic
+@cindex intrinsics, JMax1
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JMax1} to use this name for an
+external procedure.
+
+@node JMin0 Intrinsic
+@subsubsection JMin0 Intrinsic
+@cindex JMin0 intrinsic
+@cindex intrinsics, JMin0
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JMin0} to use this name for an
+external procedure.
+
+@node JMin1 Intrinsic
+@subsubsection JMin1 Intrinsic
+@cindex JMin1 intrinsic
+@cindex intrinsics, JMin1
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JMin1} to use this name for an
+external procedure.
+
+@node JMod Intrinsic
+@subsubsection JMod Intrinsic
+@cindex JMod intrinsic
+@cindex intrinsics, JMod
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JMod} to use this name for an
+external procedure.
+
+@node JNInt Intrinsic
+@subsubsection JNInt Intrinsic
+@cindex JNInt intrinsic
+@cindex intrinsics, JNInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JNInt} to use this name for an
+external procedure.
+
+@node JNot Intrinsic
+@subsubsection JNot Intrinsic
+@cindex JNot intrinsic
+@cindex intrinsics, JNot
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JNot} to use this name for an
+external procedure.
+
+@node JZExt Intrinsic
+@subsubsection JZExt Intrinsic
+@cindex JZExt intrinsic
+@cindex intrinsics, JZExt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL JZExt} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node Kill Intrinsic (subroutine)
+@subsubsection Kill Intrinsic (subroutine)
+@cindex Kill intrinsic
+@cindex intrinsics, Kill
+
+@noindent
+@example
+CALL Kill(@var{Pid}, @var{Signal}, @var{Status})
+@end example
+
+@noindent
+@var{Pid}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Signal}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Sends the signal specified by @var{Signal} to the process @var{Pid}.
+If the @var{Status} argument is supplied, it contains
+0 on success or a nonzero error code upon return.
+See @code{kill(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{Kill Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node Kill Intrinsic (function)
+@subsubsection Kill Intrinsic (function)
+@cindex Kill intrinsic
+@cindex intrinsics, Kill
+
+@noindent
+@example
+Kill(@var{Pid}, @var{Signal})
+@end example
+
+@noindent
+Kill: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Pid}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Signal}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Sends the signal specified by @var{Signal} to the process @var{Pid}.
+Returns 0 on success or a nonzero error code.
+See @code{kill(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{Kill Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node Kind Intrinsic
+@subsubsection Kind Intrinsic
+@cindex Kind intrinsic
+@cindex intrinsics, Kind
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Kind} to use this name for an
+external procedure.
+
+@node LBound Intrinsic
+@subsubsection LBound Intrinsic
+@cindex LBound intrinsic
+@cindex intrinsics, LBound
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL LBound} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node Len Intrinsic
+@subsubsection Len Intrinsic
+@cindex Len intrinsic
+@cindex intrinsics, Len
+
+@noindent
+@example
+Len(@var{String})
+@end example
+
+@noindent
+Len: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{String}: @code{CHARACTER}; scalar.
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the length of @var{String}.
+
+If @var{String} is an array, the length of an element
+of @var{String} is returned.
+
+Note that @var{String} need not be defined when this
+intrinsic is invoked, since only the length, not
+the content, of @var{String} is needed.
+
+@xref{Bit_Size Intrinsic}, for the function that determines
+the size of its argument in bits.
+
+@end ifset
+@ifset familyF90
+@node Len_Trim Intrinsic
+@subsubsection Len_Trim Intrinsic
+@cindex Len_Trim intrinsic
+@cindex intrinsics, Len_Trim
+
+@noindent
+@example
+Len_Trim(@var{String})
+@end example
+
+@noindent
+Len_Trim: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{String}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f90}.
+
+@noindent
+Description:
+
+Returns the index of the last non-blank character in @var{String}.
+@code{LNBLNK} and @code{LEN_TRIM} are equivalent.
+
+@end ifset
+@ifset familyF77
+@node LGe Intrinsic
+@subsubsection LGe Intrinsic
+@cindex LGe intrinsic
+@cindex intrinsics, LGe
+
+@noindent
+@example
+LGe(@var{String_A}, @var{String_B})
+@end example
+
+@noindent
+LGe: @code{LOGICAL(KIND=1)} function.
+
+@noindent
+@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{.TRUE.} if @samp{@var{String_A}.GE.@var{String_B}},
+@samp{.FALSE.} otherwise.
+@var{String_A} and @var{String_B} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{String_A} and @var{String_B} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+The lexical comparison intrinsics @code{LGe}, @code{LGt},
+@code{LLe}, and @code{LLt} differ from the corresponding
+intrinsic operators @code{.GE.}, @code{.GT.},
+@code{.LE.}, @code{.LT.}.
+Because the ASCII collating sequence is assumed,
+the following expressions always return @samp{.TRUE.}:
+
+@smallexample
+LGE ('0', ' ')
+LGE ('A', '0')
+LGE ('a', 'A')
+@end smallexample
+
+The following related expressions do @emph{not} always
+return @samp{.TRUE.}, as they are not necessarily evaluated
+assuming the arguments use ASCII encoding:
+
+@smallexample
+'0' .GE. ' '
+'A' .GE. '0'
+'a' .GE. 'A'
+@end smallexample
+
+The same difference exists
+between @code{LGt} and @code{.GT.};
+between @code{LLe} and @code{.LE.}; and
+between @code{LLt} and @code{.LT.}.
+
+@node LGt Intrinsic
+@subsubsection LGt Intrinsic
+@cindex LGt intrinsic
+@cindex intrinsics, LGt
+
+@noindent
+@example
+LGt(@var{String_A}, @var{String_B})
+@end example
+
+@noindent
+LGt: @code{LOGICAL(KIND=1)} function.
+
+@noindent
+@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{.TRUE.} if @samp{@var{String_A}.GT.@var{String_B}},
+@samp{.FALSE.} otherwise.
+@var{String_A} and @var{String_B} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{String_A} and @var{String_B} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+@xref{LGe Intrinsic}, for information on the distinction
+between the @code{LGT} intrinsic and the @code{.GT.}
+operator.
+
+@end ifset
+@ifset familyF2U
+@node Link Intrinsic (subroutine)
+@subsubsection Link Intrinsic (subroutine)
+@cindex Link intrinsic
+@cindex intrinsics, Link
+
+@noindent
+@example
+CALL Link(@var{Path1}, @var{Path2}, @var{Status})
+@end example
+
+@noindent
+@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Makes a (hard) link from file @var{Path1} to @var{Path2}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{Path1} and @var{Path2}---otherwise,
+trailing blanks in @var{Path1} and @var{Path2} are ignored.
+If the @var{Status} argument is supplied, it contains
+0 on success or a nonzero error code upon return.
+See @code{link(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{Link Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node Link Intrinsic (function)
+@subsubsection Link Intrinsic (function)
+@cindex Link intrinsic
+@cindex intrinsics, Link
+
+@noindent
+@example
+Link(@var{Path1}, @var{Path2})
+@end example
+
+@noindent
+Link: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Makes a (hard) link from file @var{Path1} to @var{Path2}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{Path1} and @var{Path2}---otherwise,
+trailing blanks in @var{Path1} and @var{Path2} are ignored.
+Returns 0 on success or a nonzero error code.
+See @code{link(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{Link Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF77
+@node LLe Intrinsic
+@subsubsection LLe Intrinsic
+@cindex LLe intrinsic
+@cindex intrinsics, LLe
+
+@noindent
+@example
+LLe(@var{String_A}, @var{String_B})
+@end example
+
+@noindent
+LLe: @code{LOGICAL(KIND=1)} function.
+
+@noindent
+@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{.TRUE.} if @samp{@var{String_A}.LE.@var{String_B}},
+@samp{.FALSE.} otherwise.
+@var{String_A} and @var{String_B} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{String_A} and @var{String_B} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+@xref{LGe Intrinsic}, for information on the distinction
+between the @code{LLE} intrinsic and the @code{.LE.}
+operator.
+
+@node LLt Intrinsic
+@subsubsection LLt Intrinsic
+@cindex LLt intrinsic
+@cindex intrinsics, LLt
+
+@noindent
+@example
+LLt(@var{String_A}, @var{String_B})
+@end example
+
+@noindent
+LLt: @code{LOGICAL(KIND=1)} function.
+
+@noindent
+@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{.TRUE.} if @samp{@var{String_A}.LT.@var{String_B}},
+@samp{.FALSE.} otherwise.
+@var{String_A} and @var{String_B} are interpreted as containing
+ASCII character codes.
+If either value contains a character not in the ASCII
+character set, the result is processor dependent.
+
+If the @var{String_A} and @var{String_B} are not the same length,
+the shorter is compared as if spaces were appended to
+it to form a value that has the same length as the longer.
+
+@xref{LGe Intrinsic}, for information on the distinction
+between the @code{LLT} intrinsic and the @code{.LT.}
+operator.
+
+@end ifset
+@ifset familyF2U
+@node LnBlnk Intrinsic
+@subsubsection LnBlnk Intrinsic
+@cindex LnBlnk intrinsic
+@cindex intrinsics, LnBlnk
+
+@noindent
+@example
+LnBlnk(@var{String})
+@end example
+
+@noindent
+LnBlnk: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{String}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the index of the last non-blank character in @var{String}.
+@code{LNBLNK} and @code{LEN_TRIM} are equivalent.
+
+@node Loc Intrinsic
+@subsubsection Loc Intrinsic
+@cindex Loc intrinsic
+@cindex intrinsics, Loc
+
+@noindent
+@example
+Loc(@var{Entity})
+@end example
+
+@noindent
+Loc: @code{INTEGER(KIND=7)} function.
+
+@noindent
+@var{Entity}: Any type; cannot be a constant or expression.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+The @code{LOC()} intrinsic works the
+same way as the @code{%LOC()} construct.
+@xref{%LOC(),,The @code{%LOC()} Construct}, for
+more information.
+
+@end ifset
+@ifset familyF77
+@node Log Intrinsic
+@subsubsection Log Intrinsic
+@cindex Log intrinsic
+@cindex intrinsics, Log
+
+@noindent
+@example
+Log(@var{X})
+@end example
+
+@noindent
+Log: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the natural logarithm of @var{X}, which must
+be greater than zero or, if type @code{COMPLEX}, must not
+be zero.
+
+@xref{Exp Intrinsic}, for the inverse of this function.
+
+@xref{Log10 Intrinsic}, for the `common' (base-10) logarithm function.
+
+@node Log10 Intrinsic
+@subsubsection Log10 Intrinsic
+@cindex Log10 intrinsic
+@cindex intrinsics, Log10
+
+@noindent
+@example
+Log10(@var{X})
+@end example
+
+@noindent
+Log10: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the common logarithm (base 10) of @var{X}, which must
+be greater than zero.
+
+The inverse of this function is @samp{10. ** LOG10(@var{X})}.
+
+@xref{Log Intrinsic}, for the natural logarithm function.
+
+@end ifset
+@ifset familyF90
+@node Logical Intrinsic
+@subsubsection Logical Intrinsic
+@cindex Logical intrinsic
+@cindex intrinsics, Logical
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Logical} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node Long Intrinsic
+@subsubsection Long Intrinsic
+@cindex Long intrinsic
+@cindex intrinsics, Long
+
+@noindent
+@example
+Long(@var{A})
+@end example
+
+@noindent
+Long: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER(KIND=6)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Archaic form of @code{INT()} that is specific
+to one type for @var{A}.
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+
+@end ifset
+@ifset familyF2C
+@node LShift Intrinsic
+@subsubsection LShift Intrinsic
+@cindex LShift intrinsic
+@cindex intrinsics, LShift
+
+@noindent
+@example
+LShift(@var{I}, @var{Shift})
+@end example
+
+@noindent
+LShift: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Shift}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Returns @var{I} shifted to the left
+@var{Shift} bits.
+
+Although similar to the expression
+@samp{@var{I}*(2**@var{Shift})}, there
+are important differences.
+For example, the sign of the result is
+not necessarily the same as the sign of
+@var{I}.
+
+Currently this intrinsic is defined assuming
+the underlying representation of @var{I}
+is as a two's-complement integer.
+It is unclear at this point whether that
+definition will apply when a different
+representation is involved.
+
+@xref{LShift Intrinsic}, for the inverse of this function.
+
+@xref{IShft Intrinsic}, for information
+on a more widely available left-shifting
+intrinsic that is also more precisely defined.
+
+@end ifset
+@ifset familyF2U
+@node LStat Intrinsic (subroutine)
+@subsubsection LStat Intrinsic (subroutine)
+@cindex LStat intrinsic
+@cindex intrinsics, LStat
+
+@noindent
+@example
+CALL LStat(@var{File}, @var{SArray}, @var{Status})
+@end example
+
+@noindent
+@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Obtains data about the given file @var{File} and places them in the array
+@var{SArray}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{File}---otherwise,
+trailing blanks in @var{File} are ignored.
+If @var{File} is a symbolic link it returns data on the
+link itself, so the routine is available only on systems that support
+symbolic links.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+Device ID
+
+@item
+Inode number
+
+@item
+File mode
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+ID of device containing directory entry for file
+(0 if not available)
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size (-1 if not available)
+
+@item
+Number of blocks allocated (-1 if not available)
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+If the @var{Status} argument is supplied, it contains
+0 on success or a nonzero error code upon return
+(@code{ENOSYS} if the system does not provide @code{lstat(2)}).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{LStat Intrinsic (function)}.
+
+@node LStat Intrinsic (function)
+@subsubsection LStat Intrinsic (function)
+@cindex LStat intrinsic
+@cindex intrinsics, LStat
+
+@noindent
+@example
+LStat(@var{File}, @var{SArray})
+@end example
+
+@noindent
+LStat: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Obtains data about the given file @var{File} and places them in the array
+@var{SArray}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{File}---otherwise,
+trailing blanks in @var{File} are ignored.
+If @var{File} is a symbolic link it returns data on the
+link itself, so the routine is available only on systems that support
+symbolic links.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+Device ID
+
+@item
+Inode number
+
+@item
+File mode
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+ID of device containing directory entry for file
+(0 if not available)
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size (-1 if not available)
+
+@item
+Number of blocks allocated (-1 if not available)
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+Returns 0 on success or a nonzero error code
+(@code{ENOSYS} if the system does not provide @code{lstat(2)}).
+
+For information on other intrinsics with the same name:
+@xref{LStat Intrinsic (subroutine)}.
+
+@node LTime Intrinsic
+@subsubsection LTime Intrinsic
+@cindex LTime intrinsic
+@cindex intrinsics, LTime
+
+@noindent
+@example
+CALL LTime(@var{STime}, @var{TArray})
+@end example
+
+@noindent
+@var{STime}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(9); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Given a system time value @var{STime}, fills @var{TArray} with values
+extracted from it appropriate to the GMT time zone using
+@code{localtime(3)}.
+
+The array elements are as follows:
+
+@enumerate
+@item
+Seconds after the minute, range 0--59 or 0--61 to allow for leap
+seconds
+
+@item
+Minutes after the hour, range 0--59
+
+@item
+Hours past midnight, range 0--23
+
+@item
+Day of month, range 0--31
+
+@item
+Number of months since January, range 0--12
+
+@item
+Years since 1900
+
+@item
+Number of days since Sunday, range 0--6
+
+@item
+Days since January 1
+
+@item
+Daylight savings indicator: positive if daylight savings is in effect,
+zero if not, and negative if the information isn't available.
+@end enumerate
+
+@end ifset
+@ifset familyF90
+@node MatMul Intrinsic
+@subsubsection MatMul Intrinsic
+@cindex MatMul intrinsic
+@cindex intrinsics, MatMul
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL MatMul} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node Max Intrinsic
+@subsubsection Max Intrinsic
+@cindex Max intrinsic
+@cindex intrinsics, Max
+
+@noindent
+@example
+Max(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+Max: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{A}: @code{INTEGER} or @code{REAL}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the argument with the largest value.
+
+@xref{Min Intrinsic}, for the opposite function.
+
+@node Max0 Intrinsic
+@subsubsection Max0 Intrinsic
+@cindex Max0 intrinsic
+@cindex intrinsics, Max0
+
+@noindent
+@example
+Max0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+Max0: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MAX()} that is specific
+to one type for @var{A}.
+@xref{Max Intrinsic}.
+
+@node Max1 Intrinsic
+@subsubsection Max1 Intrinsic
+@cindex Max1 intrinsic
+@cindex intrinsics, Max1
+
+@noindent
+@example
+Max1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+Max1: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MAX()} that is specific
+to one type for @var{A} and a different return type.
+@xref{Max Intrinsic}.
+
+@end ifset
+@ifset familyF90
+@node MaxExponent Intrinsic
+@subsubsection MaxExponent Intrinsic
+@cindex MaxExponent intrinsic
+@cindex intrinsics, MaxExponent
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL MaxExponent} to use this name for an
+external procedure.
+
+@node MaxLoc Intrinsic
+@subsubsection MaxLoc Intrinsic
+@cindex MaxLoc intrinsic
+@cindex intrinsics, MaxLoc
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL MaxLoc} to use this name for an
+external procedure.
+
+@node MaxVal Intrinsic
+@subsubsection MaxVal Intrinsic
+@cindex MaxVal intrinsic
+@cindex intrinsics, MaxVal
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL MaxVal} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node MClock Intrinsic
+@subsubsection MClock Intrinsic
+@cindex MClock intrinsic
+@cindex intrinsics, MClock
+
+@noindent
+@example
+MClock()
+@end example
+
+@noindent
+MClock: @code{INTEGER(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the number of clock ticks since the start of the process.
+Supported on systems with @code{clock(3)} (q.v.).
+
+@cindex wraparound, timings
+@cindex limits, timings
+This intrinsic is not fully portable, such as to systems
+with 32-bit @code{INTEGER} types but supporting times
+wider than 32 bits.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+@xref{MClock8 Intrinsic}, for information on a
+similar intrinsic that might be portable to more
+GNU Fortran implementations, though to fewer
+Fortran compilers.
+
+If the system does not support @code{clock(3)},
+-1 is returned.
+
+@node MClock8 Intrinsic
+@subsubsection MClock8 Intrinsic
+@cindex MClock8 intrinsic
+@cindex intrinsics, MClock8
+
+@noindent
+@example
+MClock8()
+@end example
+
+@noindent
+MClock8: @code{INTEGER(KIND=2)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the number of clock ticks since the start of the process.
+Supported on systems with @code{clock(3)} (q.v.).
+
+@cindex wraparound, timings
+@cindex limits, timings
+@emph{Warning:} this intrinsic does not increase the range
+of the timing values over that returned by @code{clock(3)}.
+On a system with a 32-bit @code{clock(3)},
+@code{MCLOCK8} will return a 32-bit value,
+even though converted to an @samp{INTEGER(KIND=2)} value.
+That means overflows of the 32-bit value can still occur.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+No Fortran implementations other than GNU Fortran are
+known to support this intrinsic at the time of this
+writing.
+@xref{MClock Intrinsic}, for information on a
+similar intrinsic that might be portable to more Fortran
+compilers, though to fewer GNU Fortran implementations.
+
+If the system does not support @code{clock(3)},
+-1 is returned.
+
+@end ifset
+@ifset familyF90
+@node Merge Intrinsic
+@subsubsection Merge Intrinsic
+@cindex Merge intrinsic
+@cindex intrinsics, Merge
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Merge} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node Min Intrinsic
+@subsubsection Min Intrinsic
+@cindex Min intrinsic
+@cindex intrinsics, Min
+
+@noindent
+@example
+Min(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+Min: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{A}: @code{INTEGER} or @code{REAL}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the argument with the smallest value.
+
+@xref{Max Intrinsic}, for the opposite function.
+
+@node Min0 Intrinsic
+@subsubsection Min0 Intrinsic
+@cindex Min0 intrinsic
+@cindex intrinsics, Min0
+
+@noindent
+@example
+Min0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+Min0: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MIN()} that is specific
+to one type for @var{A}.
+@xref{Min Intrinsic}.
+
+@node Min1 Intrinsic
+@subsubsection Min1 Intrinsic
+@cindex Min1 intrinsic
+@cindex intrinsics, Min1
+
+@noindent
+@example
+Min1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
+@end example
+
+@noindent
+Min1: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{MIN()} that is specific
+to one type for @var{A} and a different return type.
+@xref{Min Intrinsic}.
+
+@end ifset
+@ifset familyF90
+@node MinExponent Intrinsic
+@subsubsection MinExponent Intrinsic
+@cindex MinExponent intrinsic
+@cindex intrinsics, MinExponent
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL MinExponent} to use this name for an
+external procedure.
+
+@node MinLoc Intrinsic
+@subsubsection MinLoc Intrinsic
+@cindex MinLoc intrinsic
+@cindex intrinsics, MinLoc
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL MinLoc} to use this name for an
+external procedure.
+
+@node MinVal Intrinsic
+@subsubsection MinVal Intrinsic
+@cindex MinVal intrinsic
+@cindex intrinsics, MinVal
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL MinVal} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node Mod Intrinsic
+@subsubsection Mod Intrinsic
+@cindex Mod intrinsic
+@cindex intrinsics, Mod
+
+@noindent
+@example
+Mod(@var{A}, @var{P})
+@end example
+
+@noindent
+Mod: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{A}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+@var{P}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns remainder calculated as:
+
+@smallexample
+@var{A} - (INT(@var{A} / @var{P}) * @var{P})
+@end smallexample
+
+@var{P} must not be zero.
+
+@end ifset
+@ifset familyF90
+@node Modulo Intrinsic
+@subsubsection Modulo Intrinsic
+@cindex Modulo intrinsic
+@cindex intrinsics, Modulo
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Modulo} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyMIL
+@node MvBits Intrinsic
+@subsubsection MvBits Intrinsic
+@cindex MvBits intrinsic
+@cindex intrinsics, MvBits
+
+@noindent
+@example
+CALL MvBits(@var{From}, @var{FromPos}, @var{Len}, @var{TO}, @var{ToPos})
+@end example
+
+@noindent
+@var{From}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{FromPos}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Len}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{TO}: @code{INTEGER} with same @samp{KIND=} value as for @var{From}; scalar; INTENT(INOUT).
+
+@noindent
+@var{ToPos}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Moves @var{Len} bits from positions @var{FromPos} through
+@samp{@var{FromPos}+@var{Len}-1} of @var{From} to positions @var{ToPos} through
+@samp{@var{FromPos}+@var{Len}-1} of @var{TO}.  The portion of argument
+@var{TO} not affected by the movement of bits is unchanged.  Arguments
+@var{From} and @var{TO} are permitted to be the same numeric storage
+unit.  The values of @samp{@var{FromPos}+@var{Len}} and
+@samp{@var{ToPos}+@var{Len}} must be less than or equal to
+@samp{BIT_SIZE(@var{From})}.
+
+@end ifset
+@ifset familyF90
+@node Nearest Intrinsic
+@subsubsection Nearest Intrinsic
+@cindex Nearest intrinsic
+@cindex intrinsics, Nearest
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Nearest} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node NInt Intrinsic
+@subsubsection NInt Intrinsic
+@cindex NInt intrinsic
+@cindex intrinsics, NInt
+
+@noindent
+@example
+NInt(@var{A})
+@end example
+
+@noindent
+NInt: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @var{A} with the fractional portion of its
+magnitude eliminated by rounding to the nearest whole
+number and with its sign preserved, converted
+to type @code{INTEGER(KIND=1)}.
+
+If @var{A} is type @code{COMPLEX}, its real part is
+rounded and converted.
+
+A fractional portion exactly equal to
+@samp{.5} is rounded to the whole number that
+is larger in magnitude.
+(Also called ``Fortran round''.)
+
+@xref{Int Intrinsic}, for how to convert, truncate to
+whole number.
+
+@xref{ANInt Intrinsic}, for how to round to nearest whole number
+without converting.
+
+@end ifset
+@ifset familyMIL
+@node Not Intrinsic
+@subsubsection Not Intrinsic
+@cindex Not intrinsic
+@cindex intrinsics, Not
+
+@noindent
+@example
+Not(@var{I})
+@end example
+
+@noindent
+Not: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
+
+@noindent
+Description:
+
+Returns value resulting from boolean NOT of each bit
+in @var{I}.
+
+@end ifset
+@ifset familyF2C
+@node Or Intrinsic
+@subsubsection Or Intrinsic
+@cindex Or intrinsic
+@cindex intrinsics, Or
+
+@noindent
+@example
+Or(@var{I}, @var{J})
+@end example
+
+@noindent
+Or: @code{INTEGER} or @code{LOGICAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{I}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
+
+@noindent
+@var{J}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Returns value resulting from boolean OR of
+pair of bits in each of @var{I} and @var{J}.
+
+@end ifset
+@ifset familyF90
+@node Pack Intrinsic
+@subsubsection Pack Intrinsic
+@cindex Pack intrinsic
+@cindex intrinsics, Pack
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Pack} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node PError Intrinsic
+@subsubsection PError Intrinsic
+@cindex PError intrinsic
+@cindex intrinsics, PError
+
+@noindent
+@example
+CALL PError(@var{String})
+@end example
+
+@noindent
+@var{String}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Prints (on the C @code{stderr} stream) a newline-terminated error
+message corresponding to the last system error.
+This is prefixed by @var{String}, a colon and a space.
+See @code{perror(3)}.
+
+@end ifset
+@ifset familyF90
+@node Precision Intrinsic
+@subsubsection Precision Intrinsic
+@cindex Precision intrinsic
+@cindex intrinsics, Precision
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Precision} to use this name for an
+external procedure.
+
+@node Present Intrinsic
+@subsubsection Present Intrinsic
+@cindex Present intrinsic
+@cindex intrinsics, Present
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Present} to use this name for an
+external procedure.
+
+@node Product Intrinsic
+@subsubsection Product Intrinsic
+@cindex Product intrinsic
+@cindex intrinsics, Product
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Product} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyVXT
+@node QAbs Intrinsic
+@subsubsection QAbs Intrinsic
+@cindex QAbs intrinsic
+@cindex intrinsics, QAbs
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QAbs} to use this name for an
+external procedure.
+
+@node QACos Intrinsic
+@subsubsection QACos Intrinsic
+@cindex QACos intrinsic
+@cindex intrinsics, QACos
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QACos} to use this name for an
+external procedure.
+
+@node QACosD Intrinsic
+@subsubsection QACosD Intrinsic
+@cindex QACosD intrinsic
+@cindex intrinsics, QACosD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QACosD} to use this name for an
+external procedure.
+
+@node QASin Intrinsic
+@subsubsection QASin Intrinsic
+@cindex QASin intrinsic
+@cindex intrinsics, QASin
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QASin} to use this name for an
+external procedure.
+
+@node QASinD Intrinsic
+@subsubsection QASinD Intrinsic
+@cindex QASinD intrinsic
+@cindex intrinsics, QASinD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QASinD} to use this name for an
+external procedure.
+
+@node QATan Intrinsic
+@subsubsection QATan Intrinsic
+@cindex QATan intrinsic
+@cindex intrinsics, QATan
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QATan} to use this name for an
+external procedure.
+
+@node QATan2 Intrinsic
+@subsubsection QATan2 Intrinsic
+@cindex QATan2 intrinsic
+@cindex intrinsics, QATan2
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QATan2} to use this name for an
+external procedure.
+
+@node QATan2D Intrinsic
+@subsubsection QATan2D Intrinsic
+@cindex QATan2D intrinsic
+@cindex intrinsics, QATan2D
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QATan2D} to use this name for an
+external procedure.
+
+@node QATanD Intrinsic
+@subsubsection QATanD Intrinsic
+@cindex QATanD intrinsic
+@cindex intrinsics, QATanD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QATanD} to use this name for an
+external procedure.
+
+@node QCos Intrinsic
+@subsubsection QCos Intrinsic
+@cindex QCos intrinsic
+@cindex intrinsics, QCos
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QCos} to use this name for an
+external procedure.
+
+@node QCosD Intrinsic
+@subsubsection QCosD Intrinsic
+@cindex QCosD intrinsic
+@cindex intrinsics, QCosD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QCosD} to use this name for an
+external procedure.
+
+@node QCosH Intrinsic
+@subsubsection QCosH Intrinsic
+@cindex QCosH intrinsic
+@cindex intrinsics, QCosH
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QCosH} to use this name for an
+external procedure.
+
+@node QDiM Intrinsic
+@subsubsection QDiM Intrinsic
+@cindex QDiM intrinsic
+@cindex intrinsics, QDiM
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QDiM} to use this name for an
+external procedure.
+
+@node QExp Intrinsic
+@subsubsection QExp Intrinsic
+@cindex QExp intrinsic
+@cindex intrinsics, QExp
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QExp} to use this name for an
+external procedure.
+
+@node QExt Intrinsic
+@subsubsection QExt Intrinsic
+@cindex QExt intrinsic
+@cindex intrinsics, QExt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QExt} to use this name for an
+external procedure.
+
+@node QExtD Intrinsic
+@subsubsection QExtD Intrinsic
+@cindex QExtD intrinsic
+@cindex intrinsics, QExtD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QExtD} to use this name for an
+external procedure.
+
+@node QFloat Intrinsic
+@subsubsection QFloat Intrinsic
+@cindex QFloat intrinsic
+@cindex intrinsics, QFloat
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QFloat} to use this name for an
+external procedure.
+
+@node QInt Intrinsic
+@subsubsection QInt Intrinsic
+@cindex QInt intrinsic
+@cindex intrinsics, QInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QInt} to use this name for an
+external procedure.
+
+@node QLog Intrinsic
+@subsubsection QLog Intrinsic
+@cindex QLog intrinsic
+@cindex intrinsics, QLog
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QLog} to use this name for an
+external procedure.
+
+@node QLog10 Intrinsic
+@subsubsection QLog10 Intrinsic
+@cindex QLog10 intrinsic
+@cindex intrinsics, QLog10
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QLog10} to use this name for an
+external procedure.
+
+@node QMax1 Intrinsic
+@subsubsection QMax1 Intrinsic
+@cindex QMax1 intrinsic
+@cindex intrinsics, QMax1
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QMax1} to use this name for an
+external procedure.
+
+@node QMin1 Intrinsic
+@subsubsection QMin1 Intrinsic
+@cindex QMin1 intrinsic
+@cindex intrinsics, QMin1
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QMin1} to use this name for an
+external procedure.
+
+@node QMod Intrinsic
+@subsubsection QMod Intrinsic
+@cindex QMod intrinsic
+@cindex intrinsics, QMod
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QMod} to use this name for an
+external procedure.
+
+@node QNInt Intrinsic
+@subsubsection QNInt Intrinsic
+@cindex QNInt intrinsic
+@cindex intrinsics, QNInt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QNInt} to use this name for an
+external procedure.
+
+@node QSin Intrinsic
+@subsubsection QSin Intrinsic
+@cindex QSin intrinsic
+@cindex intrinsics, QSin
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QSin} to use this name for an
+external procedure.
+
+@node QSinD Intrinsic
+@subsubsection QSinD Intrinsic
+@cindex QSinD intrinsic
+@cindex intrinsics, QSinD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QSinD} to use this name for an
+external procedure.
+
+@node QSinH Intrinsic
+@subsubsection QSinH Intrinsic
+@cindex QSinH intrinsic
+@cindex intrinsics, QSinH
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QSinH} to use this name for an
+external procedure.
+
+@node QSqRt Intrinsic
+@subsubsection QSqRt Intrinsic
+@cindex QSqRt intrinsic
+@cindex intrinsics, QSqRt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QSqRt} to use this name for an
+external procedure.
+
+@node QTan Intrinsic
+@subsubsection QTan Intrinsic
+@cindex QTan intrinsic
+@cindex intrinsics, QTan
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QTan} to use this name for an
+external procedure.
+
+@node QTanD Intrinsic
+@subsubsection QTanD Intrinsic
+@cindex QTanD intrinsic
+@cindex intrinsics, QTanD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QTanD} to use this name for an
+external procedure.
+
+@node QTanH Intrinsic
+@subsubsection QTanH Intrinsic
+@cindex QTanH intrinsic
+@cindex intrinsics, QTanH
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL QTanH} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF90
+@node Radix Intrinsic
+@subsubsection Radix Intrinsic
+@cindex Radix intrinsic
+@cindex intrinsics, Radix
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Radix} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node Rand Intrinsic
+@subsubsection Rand Intrinsic
+@cindex Rand intrinsic
+@cindex intrinsics, Rand
+
+@noindent
+@example
+Rand(@var{Flag})
+@end example
+
+@noindent
+Rand: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{Flag}: @code{INTEGER}; OPTIONAL; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns a uniform quasi-random number between 0 and 1.
+If @var{Flag} is 0, the next number in sequence is returned; if
+@var{Flag} is 1, the generator is restarted by calling @samp{srand(0)};
+if @var{Flag} has any other value, it is used as a new seed with
+@code{srand}.
+
+@xref{SRand Intrinsic}.
+
+@emph{Note:} As typically implemented (by the routine of the same
+name in the C library), this random number generator is a very poor
+one, though the BSD and GNU libraries provide a much better
+implementation than the `traditional' one.
+On a different system you
+almost certainly want to use something better.
+
+@end ifset
+@ifset familyF90
+@node Random_Number Intrinsic
+@subsubsection Random_Number Intrinsic
+@cindex Random_Number intrinsic
+@cindex intrinsics, Random_Number
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Random_Number} to use this name for an
+external procedure.
+
+@node Random_Seed Intrinsic
+@subsubsection Random_Seed Intrinsic
+@cindex Random_Seed intrinsic
+@cindex intrinsics, Random_Seed
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Random_Seed} to use this name for an
+external procedure.
+
+@node Range Intrinsic
+@subsubsection Range Intrinsic
+@cindex Range intrinsic
+@cindex intrinsics, Range
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Range} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node Real Intrinsic
+@subsubsection Real Intrinsic
+@cindex Real intrinsic
+@cindex intrinsics, Real
+
+@noindent
+@example
+Real(@var{A})
+@end example
+
+@noindent
+Real: @code{REAL} function.
+The exact type is @samp{REAL(KIND=1)} when argument @var{A} is
+any type other than @code{COMPLEX}, or when it is @code{COMPLEX(KIND=1)}.
+When @var{A} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)},
+this intrinsic is valid only when used as the argument to
+@code{REAL()}, as explained below.
+
+@noindent
+@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Converts @var{A} to @code{REAL(KIND=1)}.
+
+Use of @code{REAL()} with a @code{COMPLEX} argument
+(other than @code{COMPLEX(KIND=1)}) is restricted to the following case:
+
+@example
+REAL(REAL(A))
+@end example
+
+@noindent
+This expression converts the real part of A to
+@code{REAL(KIND=1)}.
+
+@xref{RealPart Intrinsic}, for information on a GNU Fortran
+intrinsic that extracts the real part of an arbitrary
+@code{COMPLEX} value.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+
+@end ifset
+@ifset familyGNU
+@node RealPart Intrinsic
+@subsubsection RealPart Intrinsic
+@cindex RealPart intrinsic
+@cindex intrinsics, RealPart
+
+@noindent
+@example
+RealPart(@var{Z})
+@end example
+
+@noindent
+RealPart: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{Z}.
+
+@noindent
+@var{Z}: @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{gnu}.
+
+@noindent
+Description:
+
+The real part of @var{Z} is returned, without conversion.
+
+@emph{Note:} The way to do this in standard Fortran 90
+is @samp{REAL(@var{Z})}.
+However, when, for example, @var{Z} is @code{COMPLEX(KIND=2)},
+@samp{REAL(@var{Z})} means something different for some compilers
+that are not true Fortran 90 compilers but offer some
+extensions standardized by Fortran 90 (such as the
+@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}).
+
+The advantage of @code{REALPART()} is that, while not necessarily
+more or less portable than @code{REAL()}, it is more likely to
+cause a compiler that doesn't support it to produce a diagnostic
+than generate incorrect code.
+
+@xref{REAL() and AIMAG() of Complex}, for more information.
+
+@end ifset
+@ifset familyF2U
+@node Rename Intrinsic (subroutine)
+@subsubsection Rename Intrinsic (subroutine)
+@cindex Rename intrinsic
+@cindex intrinsics, Rename
+
+@noindent
+@example
+CALL Rename(@var{Path1}, @var{Path2}, @var{Status})
+@end example
+
+@noindent
+@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Renames the file @var{Path1} to @var{Path2}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{Path1} and @var{Path2}---otherwise,
+trailing blanks in @var{Path1} and @var{Path2} are ignored.
+See @code{rename(2)}.
+If the @var{Status} argument is supplied, it contains
+0 on success or a nonzero error code upon return.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{Rename Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node Rename Intrinsic (function)
+@subsubsection Rename Intrinsic (function)
+@cindex Rename intrinsic
+@cindex intrinsics, Rename
+
+@noindent
+@example
+Rename(@var{Path1}, @var{Path2})
+@end example
+
+@noindent
+Rename: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Renames the file @var{Path1} to @var{Path2}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{Path1} and @var{Path2}---otherwise,
+trailing blanks in @var{Path1} and @var{Path2} are ignored.
+See @code{rename(2)}.
+Returns 0 on success or a nonzero error code.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{Rename Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node Repeat Intrinsic
+@subsubsection Repeat Intrinsic
+@cindex Repeat intrinsic
+@cindex intrinsics, Repeat
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Repeat} to use this name for an
+external procedure.
+
+@node Reshape Intrinsic
+@subsubsection Reshape Intrinsic
+@cindex Reshape intrinsic
+@cindex intrinsics, Reshape
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Reshape} to use this name for an
+external procedure.
+
+@node RRSpacing Intrinsic
+@subsubsection RRSpacing Intrinsic
+@cindex RRSpacing intrinsic
+@cindex intrinsics, RRSpacing
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL RRSpacing} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2C
+@node RShift Intrinsic
+@subsubsection RShift Intrinsic
+@cindex RShift intrinsic
+@cindex intrinsics, RShift
+
+@noindent
+@example
+RShift(@var{I}, @var{Shift})
+@end example
+
+@noindent
+RShift: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
+
+@noindent
+@var{I}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Shift}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Returns @var{I} shifted to the right
+@var{Shift} bits.
+
+Although similar to the expression
+@samp{@var{I}/(2**@var{Shift})}, there
+are important differences.
+For example, the sign of the result is
+undefined.
+
+Currently this intrinsic is defined assuming
+the underlying representation of @var{I}
+is as a two's-complement integer.
+It is unclear at this point whether that
+definition will apply when a different
+representation is involved.
+
+@xref{RShift Intrinsic}, for the inverse of this function.
+
+@xref{IShft Intrinsic}, for information
+on a more widely available right-shifting
+intrinsic that is also more precisely defined.
+
+@end ifset
+@ifset familyF90
+@node Scale Intrinsic
+@subsubsection Scale Intrinsic
+@cindex Scale intrinsic
+@cindex intrinsics, Scale
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Scale} to use this name for an
+external procedure.
+
+@node Scan Intrinsic
+@subsubsection Scan Intrinsic
+@cindex Scan intrinsic
+@cindex intrinsics, Scan
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Scan} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyVXT
+@node Secnds Intrinsic
+@subsubsection Secnds Intrinsic
+@cindex Secnds intrinsic
+@cindex intrinsics, Secnds
+
+@noindent
+@example
+Secnds(@var{T})
+@end example
+
+@noindent
+Secnds: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{T}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{vxt}.
+
+@noindent
+Description:
+
+Returns the local time in seconds since midnight minus the value
+@var{T}.
+
+@cindex wraparound, timings
+@cindex limits, timings
+This values returned by this intrinsic
+become numerically less than previous values
+(they wrap around) during a single run of the
+compiler program, under normal circumstances
+(such as running through the midnight hour).
+
+@end ifset
+@ifset familyF2U
+@node Second Intrinsic (function)
+@subsubsection Second Intrinsic (function)
+@cindex Second intrinsic
+@cindex intrinsics, Second
+
+@noindent
+@example
+Second()
+@end example
+
+@noindent
+Second: @code{REAL(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the process's runtime in seconds---the same value as the
+UNIX function @code{etime} returns.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+For information on other intrinsics with the same name:
+@xref{Second Intrinsic (subroutine)}.
+
+@node Second Intrinsic (subroutine)
+@subsubsection Second Intrinsic (subroutine)
+@cindex Second intrinsic
+@cindex intrinsics, Second
+
+@noindent
+@example
+CALL Second(@var{Seconds})
+@end example
+
+@noindent
+@var{Seconds}: @code{REAL}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the process's runtime in seconds in @var{Seconds}---the same value
+as the UNIX function @code{etime} returns.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+This routine is known from Cray Fortran.  @xref{CPU_Time Intrinsic},
+for a standard equivalent.
+
+For information on other intrinsics with the same name:
+@xref{Second Intrinsic (function)}.
+
+@end ifset
+@ifset familyF90
+@node Selected_Int_Kind Intrinsic
+@subsubsection Selected_Int_Kind Intrinsic
+@cindex Selected_Int_Kind intrinsic
+@cindex intrinsics, Selected_Int_Kind
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Selected_Int_Kind} to use this name for an
+external procedure.
+
+@node Selected_Real_Kind Intrinsic
+@subsubsection Selected_Real_Kind Intrinsic
+@cindex Selected_Real_Kind intrinsic
+@cindex intrinsics, Selected_Real_Kind
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Selected_Real_Kind} to use this name for an
+external procedure.
+
+@node Set_Exponent Intrinsic
+@subsubsection Set_Exponent Intrinsic
+@cindex Set_Exponent intrinsic
+@cindex intrinsics, Set_Exponent
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Set_Exponent} to use this name for an
+external procedure.
+
+@node Shape Intrinsic
+@subsubsection Shape Intrinsic
+@cindex Shape intrinsic
+@cindex intrinsics, Shape
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Shape} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node Short Intrinsic
+@subsubsection Short Intrinsic
+@cindex Short intrinsic
+@cindex intrinsics, Short
+
+@noindent
+@example
+Short(@var{A})
+@end example
+
+@noindent
+Short: @code{INTEGER(KIND=6)} function.
+
+@noindent
+@var{A}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns @var{A} with the fractional portion of its
+magnitude truncated and its sign preserved, converted
+to type @code{INTEGER(KIND=6)}.
+
+If @var{A} is type @code{COMPLEX}, its real part
+is truncated and converted, and its imaginary part is disregarded.
+
+@xref{Int Intrinsic}.
+
+The precise meaning of this intrinsic might change
+in a future version of the GNU Fortran language,
+as more is learned about how it is used.
+
+@end ifset
+@ifset familyF77
+@node Sign Intrinsic
+@subsubsection Sign Intrinsic
+@cindex Sign intrinsic
+@cindex intrinsics, Sign
+
+@noindent
+@example
+Sign(@var{A}, @var{B})
+@end example
+
+@noindent
+Sign: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{A}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+@var{B}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns @samp{ABS(@var{A})*@var{s}}, where
+@var{s} is +1 if @samp{@var{B}.GE.0},
+-1 otherwise.
+
+@xref{Abs Intrinsic}, for the function that returns
+the magnitude of a value.
+
+@end ifset
+@ifset familyF2U
+@node Signal Intrinsic (subroutine)
+@subsubsection Signal Intrinsic (subroutine)
+@cindex Signal intrinsic
+@cindex intrinsics, Signal
+
+@noindent
+@example
+CALL Signal(@var{Number}, @var{Handler}, @var{Status})
+@end example
+
+@noindent
+@var{Number}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Handler}: Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})
+or dummy/global @code{INTEGER(KIND=1)} scalar.
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=7)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+If @var{Handler} is a an @code{EXTERNAL} routine, arranges for it to be
+invoked with a single integer argument (of system-dependent length)
+when signal @var{Number} occurs.
+If @var{Handler} is an integer, it can be
+used to turn off handling of signal @var{Number} or revert to its default
+action.
+See @code{signal(2)}.
+
+Note that @var{Handler} will be called using C conventions,
+so the value of its argument in Fortran terms
+Fortran terms is obtained by applying @code{%LOC()} (or @code{LOC()}) to it.
+
+The value returned by @code{signal(2)} is written to @var{Status}, if
+that argument is supplied.
+Otherwise the return value is ignored.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+@emph{Warning:} Use of the @code{libf2c} run-time library function
+@samp{signal_} directly
+(such as via @samp{EXTERNAL SIGNAL})
+requires use of the @code{%VAL()} construct
+to pass an @code{INTEGER} value
+(such as @samp{SIG_IGN} or @samp{SIG_DFL})
+for the @var{Handler} argument.
+
+However, while @samp{CALL SIGNAL(@var{signum}, %VAL(SIG_IGN))}
+works when @samp{SIGNAL} is treated as an external procedure
+(and resolves, at link time, to @code{libf2c}'s @samp{signal_} routine),
+this construct is not valid when @samp{SIGNAL} is recognized
+as the intrinsic of that name.
+
+Therefore, for maximum portability and reliability,
+code such references to the @samp{SIGNAL} facility as follows:
+
+@smallexample
+INTRINSIC SIGNAL
+@dots{}
+CALL SIGNAL(@var{signum}, SIG_IGN)
+@end smallexample
+
+@code{g77} will compile such a call correctly,
+while other compilers will generally either do so as well
+or reject the @samp{INTRINSIC SIGNAL} statement via a diagnostic,
+allowing you to take appropriate action.
+
+For information on other intrinsics with the same name:
+@xref{Signal Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node Signal Intrinsic (function)
+@subsubsection Signal Intrinsic (function)
+@cindex Signal intrinsic
+@cindex intrinsics, Signal
+
+@noindent
+@example
+Signal(@var{Number}, @var{Handler})
+@end example
+
+@noindent
+Signal: @code{INTEGER(KIND=7)} function.
+
+@noindent
+@var{Number}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Handler}: Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})
+or dummy/global @code{INTEGER(KIND=1)} scalar.
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+If @var{Handler} is a an @code{EXTERNAL} routine, arranges for it to be
+invoked with a single integer argument (of system-dependent length)
+when signal @var{Number} occurs.
+If @var{Handler} is an integer, it can be
+used to turn off handling of signal @var{Number} or revert to its default
+action.
+See @code{signal(2)}.
+
+Note that @var{Handler} will be called using C conventions,
+so the value of its argument in Fortran terms
+is obtained by applying @code{%LOC()} (or @code{LOC()}) to it.
+
+The value returned by @code{signal(2)} is returned.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+@emph{Warning:} If the returned value is stored in
+an @code{INTEGER(KIND=1)} (default @code{INTEGER}) argument,
+truncation of the original return value occurs on some systems
+(such as Alphas, which have 64-bit pointers but 32-bit default integers),
+with no warning issued by @code{g77} under normal circumstances.
+
+Therefore, the following code fragment might silently fail on
+some systems:
+
+@smallexample
+INTEGER RTN
+EXTERNAL MYHNDL
+RTN = SIGNAL(@var{signum}, MYHNDL)
+@dots{}
+! Restore original handler:
+RTN = SIGNAL(@var{signum}, RTN)
+@end smallexample
+
+The reason for the failure is that @samp{RTN} might not hold
+all the information on the original handler for the signal,
+thus restoring an invalid handler.
+This bug could manifest itself as a spurious run-time failure
+at an arbitrary point later during the program's execution,
+for example.
+
+@emph{Warning:} Use of the @code{libf2c} run-time library function
+@samp{signal_} directly
+(such as via @samp{EXTERNAL SIGNAL})
+requires use of the @code{%VAL()} construct
+to pass an @code{INTEGER} value
+(such as @samp{SIG_IGN} or @samp{SIG_DFL})
+for the @var{Handler} argument.
+
+However, while @samp{RTN = SIGNAL(@var{signum}, %VAL(SIG_IGN))}
+works when @samp{SIGNAL} is treated as an external procedure
+(and resolves, at link time, to @code{libf2c}'s @samp{signal_} routine),
+this construct is not valid when @samp{SIGNAL} is recognized
+as the intrinsic of that name.
+
+Therefore, for maximum portability and reliability,
+code such references to the @samp{SIGNAL} facility as follows:
+
+@smallexample
+INTRINSIC SIGNAL
+@dots{}
+RTN = SIGNAL(@var{signum}, SIG_IGN)
+@end smallexample
+
+@code{g77} will compile such a call correctly,
+while other compilers will generally either do so as well
+or reject the @samp{INTRINSIC SIGNAL} statement via a diagnostic,
+allowing you to take appropriate action.
+
+For information on other intrinsics with the same name:
+@xref{Signal Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF77
+@node Sin Intrinsic
+@subsubsection Sin Intrinsic
+@cindex Sin intrinsic
+@cindex intrinsics, Sin
+
+@noindent
+@example
+Sin(@var{X})
+@end example
+
+@noindent
+Sin: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the sine of @var{X}, an angle measured
+in radians.
+
+@xref{ASin Intrinsic}, for the inverse of this function.
+
+@end ifset
+@ifset familyVXT
+@node SinD Intrinsic
+@subsubsection SinD Intrinsic
+@cindex SinD intrinsic
+@cindex intrinsics, SinD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL SinD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node SinH Intrinsic
+@subsubsection SinH Intrinsic
+@cindex SinH intrinsic
+@cindex intrinsics, SinH
+
+@noindent
+@example
+SinH(@var{X})
+@end example
+
+@noindent
+SinH: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the hyperbolic sine of @var{X}.
+
+@end ifset
+@ifset familyF2U
+@node Sleep Intrinsic
+@subsubsection Sleep Intrinsic
+@cindex Sleep intrinsic
+@cindex intrinsics, Sleep
+
+@noindent
+@example
+CALL Sleep(@var{Seconds})
+@end example
+
+@noindent
+@var{Seconds}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Causes the process to pause for @var{Seconds} seconds.
+See @code{sleep(2)}.
+
+@end ifset
+@ifset familyF77
+@node Sngl Intrinsic
+@subsubsection Sngl Intrinsic
+@cindex Sngl intrinsic
+@cindex intrinsics, Sngl
+
+@noindent
+@example
+Sngl(@var{A})
+@end example
+
+@noindent
+Sngl: @code{REAL(KIND=1)} function.
+
+@noindent
+@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Archaic form of @code{REAL()} that is specific
+to one type for @var{A}.
+@xref{Real Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node SnglQ Intrinsic
+@subsubsection SnglQ Intrinsic
+@cindex SnglQ intrinsic
+@cindex intrinsics, SnglQ
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL SnglQ} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF90
+@node Spacing Intrinsic
+@subsubsection Spacing Intrinsic
+@cindex Spacing intrinsic
+@cindex intrinsics, Spacing
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Spacing} to use this name for an
+external procedure.
+
+@node Spread Intrinsic
+@subsubsection Spread Intrinsic
+@cindex Spread intrinsic
+@cindex intrinsics, Spread
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Spread} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node SqRt Intrinsic
+@subsubsection SqRt Intrinsic
+@cindex SqRt intrinsic
+@cindex intrinsics, SqRt
+
+@noindent
+@example
+SqRt(@var{X})
+@end example
+
+@noindent
+SqRt: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the square root of @var{X}, which must
+not be negative.
+
+To calculate and represent the square root of a negative
+number, complex arithmetic must be used.
+For example, @samp{SQRT(COMPLEX(@var{X}))}.
+
+The inverse of this function is @samp{SQRT(@var{X}) * SQRT(@var{X})}.
+
+@end ifset
+@ifset familyF2U
+@node SRand Intrinsic
+@subsubsection SRand Intrinsic
+@cindex SRand intrinsic
+@cindex intrinsics, SRand
+
+@noindent
+@example
+CALL SRand(@var{Seed})
+@end example
+
+@noindent
+@var{Seed}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Reinitializes the generator with the seed in @var{Seed}.
+@xref{IRand Intrinsic}.
+@xref{Rand Intrinsic}.
+
+@node Stat Intrinsic (subroutine)
+@subsubsection Stat Intrinsic (subroutine)
+@cindex Stat intrinsic
+@cindex intrinsics, Stat
+
+@noindent
+@example
+CALL Stat(@var{File}, @var{SArray}, @var{Status})
+@end example
+
+@noindent
+@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Obtains data about the given file @var{File} and places them in the array
+@var{SArray}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{File}---otherwise,
+trailing blanks in @var{File} are ignored.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+Device ID
+
+@item
+Inode number
+
+@item
+File mode
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+ID of device containing directory entry for file
+(0 if not available)
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size (-1 if not available)
+
+@item
+Number of blocks allocated (-1 if not available)
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+If the @var{Status} argument is supplied, it contains
+0 on success or a nonzero error code upon return.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{Stat Intrinsic (function)}.
+
+@node Stat Intrinsic (function)
+@subsubsection Stat Intrinsic (function)
+@cindex Stat intrinsic
+@cindex intrinsics, Stat
+
+@noindent
+@example
+Stat(@var{File}, @var{SArray})
+@end example
+
+@noindent
+Stat: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Obtains data about the given file @var{File} and places them in the array
+@var{SArray}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{File}---otherwise,
+trailing blanks in @var{File} are ignored.
+The values in this array are extracted from the
+@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
+
+@enumerate
+@item
+Device ID
+
+@item
+Inode number
+
+@item
+File mode
+
+@item
+Number of links
+
+@item
+Owner's uid
+
+@item
+Owner's gid
+
+@item
+ID of device containing directory entry for file
+(0 if not available)
+
+@item
+File size (bytes)
+
+@item
+Last access time
+
+@item
+Last modification time
+
+@item
+Last file status change time
+
+@item
+Preferred I/O block size (-1 if not available)
+
+@item
+Number of blocks allocated (-1 if not available)
+@end enumerate
+
+Not all these elements are relevant on all systems.
+If an element is not relevant, it is returned as 0.
+
+Returns 0 on success or a nonzero error code.
+
+For information on other intrinsics with the same name:
+@xref{Stat Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node Sum Intrinsic
+@subsubsection Sum Intrinsic
+@cindex Sum intrinsic
+@cindex intrinsics, Sum
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Sum} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node SymLnk Intrinsic (subroutine)
+@subsubsection SymLnk Intrinsic (subroutine)
+@cindex SymLnk intrinsic
+@cindex intrinsics, SymLnk
+
+@noindent
+@example
+CALL SymLnk(@var{Path1}, @var{Path2}, @var{Status})
+@end example
+
+@noindent
+@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Makes a symbolic link from file @var{Path1} to @var{Path2}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{Path1} and @var{Path2}---otherwise,
+trailing blanks in @var{Path1} and @var{Path2} are ignored.
+If the @var{Status} argument is supplied, it contains
+0 on success or a nonzero error code upon return
+(@code{ENOSYS} if the system does not provide @code{symlink(2)}).
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{SymLnk Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node SymLnk Intrinsic (function)
+@subsubsection SymLnk Intrinsic (function)
+@cindex SymLnk intrinsic
+@cindex intrinsics, SymLnk
+
+@noindent
+@example
+SymLnk(@var{Path1}, @var{Path2})
+@end example
+
+@noindent
+SymLnk: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Makes a symbolic link from file @var{Path1} to @var{Path2}.
+A null character (@samp{CHAR(0)}) marks the end of
+the names in @var{Path1} and @var{Path2}---otherwise,
+trailing blanks in @var{Path1} and @var{Path2} are ignored.
+Returns 0 on success or a nonzero error code
+(@code{ENOSYS} if the system does not provide @code{symlink(2)}).
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{SymLnk Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF2U
+@node System Intrinsic (subroutine)
+@subsubsection System Intrinsic (subroutine)
+@cindex System intrinsic
+@cindex intrinsics, System
+
+@noindent
+@example
+CALL System(@var{Command}, @var{Status})
+@end example
+
+@noindent
+@var{Command}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Passes the command @var{Command} to a shell (see @code{system(3)}).
+If argument @var{Status} is present, it contains the value returned by
+@code{system(3)}, presumably 0 if the shell command succeeded.
+Note that which shell is used to invoke the command is system-dependent
+and environment-dependent.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{System Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node System Intrinsic (function)
+@subsubsection System Intrinsic (function)
+@cindex System intrinsic
+@cindex intrinsics, System
+
+@noindent
+@example
+System(@var{Command})
+@end example
+
+@noindent
+System: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Command}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Passes the command @var{Command} to a shell (see @code{system(3)}).
+Returns the value returned by
+@code{system(3)}, presumably 0 if the shell command succeeded.
+Note that which shell is used to invoke the command is system-dependent
+and environment-dependent.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+However, the function form can be valid in cases where the
+actual side effects performed by the call are unimportant to
+the application.
+
+For example, on a UNIX system, @samp{SAME = SYSTEM('cmp a b')}
+does not perform any side effects likely to be important to the
+program, so the programmer would not care if the actual system
+call (and invocation of @code{cmp}) was optimized away in a situation
+where the return value could be determined otherwise, or was not
+actually needed (@samp{SAME} not actually referenced after the
+sample assignment statement).
+
+For information on other intrinsics with the same name:
+@xref{System Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node System_Clock Intrinsic
+@subsubsection System_Clock Intrinsic
+@cindex System_Clock intrinsic
+@cindex intrinsics, System_Clock
+
+@noindent
+@example
+CALL System_Clock(@var{Count}, @var{Rate}, @var{Max})
+@end example
+
+@noindent
+@var{Count}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
+
+@noindent
+@var{Rate}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+@var{Max}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{f90}.
+
+@noindent
+Description:
+
+Returns in @var{Count} the current value of the system clock; this is
+the value returned by the UNIX function @code{times(2)}
+in this implementation, but
+isn't in general.
+@var{Rate} is the number of clock ticks per second and
+@var{Max} is the maximum value this can take, which isn't very useful
+in this implementation since it's just the maximum C @code{unsigned
+int} value.
+
+@cindex wraparound, timings
+@cindex limits, timings
+On some systems, the underlying timings are represented
+using types with sufficiently small limits that overflows
+(wraparounds) are possible, such as 32-bit types.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+@end ifset
+@ifset familyF77
+@node Tan Intrinsic
+@subsubsection Tan Intrinsic
+@cindex Tan intrinsic
+@cindex intrinsics, Tan
+
+@noindent
+@example
+Tan(@var{X})
+@end example
+
+@noindent
+Tan: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the tangent of @var{X}, an angle measured
+in radians.
+
+@xref{ATan Intrinsic}, for the inverse of this function.
+
+@end ifset
+@ifset familyVXT
+@node TanD Intrinsic
+@subsubsection TanD Intrinsic
+@cindex TanD intrinsic
+@cindex intrinsics, TanD
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL TanD} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF77
+@node TanH Intrinsic
+@subsubsection TanH Intrinsic
+@cindex TanH intrinsic
+@cindex intrinsics, TanH
+
+@noindent
+@example
+TanH(@var{X})
+@end example
+
+@noindent
+TanH: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
+
+@noindent
+@var{X}: @code{REAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: (standard FORTRAN 77).
+
+@noindent
+Description:
+
+Returns the hyperbolic tangent of @var{X}.
+
+@end ifset
+@ifset familyF2U
+@node Time Intrinsic (UNIX)
+@subsubsection Time Intrinsic (UNIX)
+@cindex Time intrinsic
+@cindex intrinsics, Time
+
+@noindent
+@example
+Time()
+@end example
+
+@noindent
+Time: @code{INTEGER(KIND=1)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the current time encoded as an integer
+(in the manner of the UNIX function @code{time(3)}).
+This value is suitable for passing to @code{CTIME},
+@code{GMTIME}, and @code{LTIME}.
+
+@cindex wraparound, timings
+@cindex limits, timings
+This intrinsic is not fully portable, such as to systems
+with 32-bit @code{INTEGER} types but supporting times
+wider than 32 bits.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+@xref{Time8 Intrinsic}, for information on a
+similar intrinsic that might be portable to more
+GNU Fortran implementations, though to fewer
+Fortran compilers.
+
+For information on other intrinsics with the same name:
+@xref{Time Intrinsic (VXT)}.
+
+@end ifset
+@ifset familyVXT
+@node Time Intrinsic (VXT)
+@subsubsection Time Intrinsic (VXT)
+@cindex Time intrinsic
+@cindex intrinsics, Time
+
+@noindent
+@example
+CALL Time(@var{Time})
+@end example
+
+@noindent
+@var{Time}: @code{CHARACTER*8}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{vxt}.
+
+@noindent
+Description:
+
+Returns in @var{Time} a character representation of the current time as
+obtained from @code{ctime(3)}.
+
+@cindex Y10K compliance
+@cindex Year 10000 compliance
+@cindex wraparound, Y10K
+@cindex limits, Y10K
+Programs making use of this intrinsic
+might not be Year 10000 (Y10K) compliant.
+For example, the date might appear,
+to such programs, to wrap around
+(change from a larger value to a smaller one)
+as of the Year 10000.
+
+@xref{FDate Intrinsic (subroutine)}, for an equivalent routine.
+
+For information on other intrinsics with the same name:
+@xref{Time Intrinsic (UNIX)}.
+
+@end ifset
+@ifset familyF2U
+@node Time8 Intrinsic
+@subsubsection Time8 Intrinsic
+@cindex Time8 intrinsic
+@cindex intrinsics, Time8
+
+@noindent
+@example
+Time8()
+@end example
+
+@noindent
+Time8: @code{INTEGER(KIND=2)} function.
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the current time encoded as a long integer
+(in the manner of the UNIX function @code{time(3)}).
+This value is suitable for passing to @code{CTIME},
+@code{GMTIME}, and @code{LTIME}.
+
+@cindex wraparound, timings
+@cindex limits, timings
+@emph{Warning:} this intrinsic does not increase the range
+of the timing values over that returned by @code{time(3)}.
+On a system with a 32-bit @code{time(3)},
+@code{TIME8} will return a 32-bit value,
+even though converted to an @samp{INTEGER(KIND=2)} value.
+That means overflows of the 32-bit value can still occur.
+Therefore, the values returned by this intrinsic
+might be, or become, negative,
+or numerically less than previous values,
+during a single run of the compiled program.
+
+No Fortran implementations other than GNU Fortran are
+known to support this intrinsic at the time of this
+writing.
+@xref{Time Intrinsic (UNIX)}, for information on a
+similar intrinsic that might be portable to more Fortran
+compilers, though to fewer GNU Fortran implementations.
+
+@end ifset
+@ifset familyF90
+@node Tiny Intrinsic
+@subsubsection Tiny Intrinsic
+@cindex Tiny intrinsic
+@cindex intrinsics, Tiny
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Tiny} to use this name for an
+external procedure.
+
+@node Transfer Intrinsic
+@subsubsection Transfer Intrinsic
+@cindex Transfer intrinsic
+@cindex intrinsics, Transfer
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Transfer} to use this name for an
+external procedure.
+
+@node Transpose Intrinsic
+@subsubsection Transpose Intrinsic
+@cindex Transpose intrinsic
+@cindex intrinsics, Transpose
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Transpose} to use this name for an
+external procedure.
+
+@node Trim Intrinsic
+@subsubsection Trim Intrinsic
+@cindex Trim intrinsic
+@cindex intrinsics, Trim
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Trim} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node TtyNam Intrinsic (subroutine)
+@subsubsection TtyNam Intrinsic (subroutine)
+@cindex TtyNam intrinsic
+@cindex intrinsics, TtyNam
+
+@noindent
+@example
+CALL TtyNam(@var{Unit}, @var{Name})
+@end example
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Sets @var{Name} to the name of the terminal device open on logical unit
+@var{Unit} or to a blank string if @var{Unit} is not connected to a
+terminal.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+
+For information on other intrinsics with the same name:
+@xref{TtyNam Intrinsic (function)}.
+
+@node TtyNam Intrinsic (function)
+@subsubsection TtyNam Intrinsic (function)
+@cindex TtyNam intrinsic
+@cindex intrinsics, TtyNam
+
+@noindent
+@example
+TtyNam(@var{Unit})
+@end example
+
+@noindent
+TtyNam: @code{CHARACTER*(*)} function.
+
+@noindent
+@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Returns the name of the terminal device open on logical unit
+@var{Unit} or a blank string if @var{Unit} is not connected to a
+terminal.
+
+For information on other intrinsics with the same name:
+@xref{TtyNam Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node UBound Intrinsic
+@subsubsection UBound Intrinsic
+@cindex UBound intrinsic
+@cindex intrinsics, UBound
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL UBound} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2U
+@node UMask Intrinsic (subroutine)
+@subsubsection UMask Intrinsic (subroutine)
+@cindex UMask intrinsic
+@cindex intrinsics, UMask
+
+@noindent
+@example
+CALL UMask(@var{Mask}, @var{Old})
+@end example
+
+@noindent
+@var{Mask}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+@var{Old}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Sets the file creation mask to @var{Mask} and returns the old value in
+argument @var{Old} if it is supplied.
+See @code{umask(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine.
+
+For information on other intrinsics with the same name:
+@xref{UMask Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node UMask Intrinsic (function)
+@subsubsection UMask Intrinsic (function)
+@cindex UMask intrinsic
+@cindex intrinsics, UMask
+
+@noindent
+@example
+UMask(@var{Mask})
+@end example
+
+@noindent
+UMask: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{Mask}: @code{INTEGER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Sets the file creation mask to @var{Mask} and returns the old value.
+See @code{umask(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{UMask Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF2U
+@node Unlink Intrinsic (subroutine)
+@subsubsection Unlink Intrinsic (subroutine)
+@cindex Unlink intrinsic
+@cindex intrinsics, Unlink
+
+@noindent
+@example
+CALL Unlink(@var{File}, @var{Status})
+@end example
+
+@noindent
+@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
+
+@noindent
+Intrinsic groups: @code{unix}.
+
+@noindent
+Description:
+
+Unlink the file @var{File}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{File}---otherwise,
+trailing blanks in @var{File} are ignored.
+If the @var{Status} argument is supplied, it contains
+0 on success or a nonzero error code upon return.
+See @code{unlink(2)}.
+
+Some non-GNU implementations of Fortran provide this intrinsic as
+only a function, not as a subroutine, or do not support the
+(optional) @var{Status} argument.
+
+For information on other intrinsics with the same name:
+@xref{Unlink Intrinsic (function)}.
+
+@end ifset
+@ifset familyBADU77
+@node Unlink Intrinsic (function)
+@subsubsection Unlink Intrinsic (function)
+@cindex Unlink intrinsic
+@cindex intrinsics, Unlink
+
+@noindent
+@example
+Unlink(@var{File})
+@end example
+
+@noindent
+Unlink: @code{INTEGER(KIND=1)} function.
+
+@noindent
+@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{badu77}.
+
+@noindent
+Description:
+
+Unlink the file @var{File}.
+A null character (@samp{CHAR(0)}) marks the end of
+the name in @var{File}---otherwise,
+trailing blanks in @var{File} are ignored.
+Returns 0 on success or a nonzero error code.
+See @code{unlink(2)}.
+
+Due to the side effects performed by this intrinsic, the function
+form is not recommended.
+
+For information on other intrinsics with the same name:
+@xref{Unlink Intrinsic (subroutine)}.
+
+@end ifset
+@ifset familyF90
+@node Unpack Intrinsic
+@subsubsection Unpack Intrinsic
+@cindex Unpack intrinsic
+@cindex intrinsics, Unpack
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Unpack} to use this name for an
+external procedure.
+
+@node Verify Intrinsic
+@subsubsection Verify Intrinsic
+@cindex Verify intrinsic
+@cindex intrinsics, Verify
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL Verify} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2C
+@node XOr Intrinsic
+@subsubsection XOr Intrinsic
+@cindex XOr intrinsic
+@cindex intrinsics, XOr
+
+@noindent
+@example
+XOr(@var{I}, @var{J})
+@end example
+
+@noindent
+XOr: @code{INTEGER} or @code{LOGICAL} function, the exact type being the result of cross-promoting the
+types of all the arguments.
+
+@noindent
+@var{I}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
+
+@noindent
+@var{J}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Returns value resulting from boolean exclusive-OR of
+pair of bits in each of @var{I} and @var{J}.
+
+@node ZAbs Intrinsic
+@subsubsection ZAbs Intrinsic
+@cindex ZAbs intrinsic
+@cindex intrinsics, ZAbs
+
+@noindent
+@example
+ZAbs(@var{A})
+@end example
+
+@noindent
+ZAbs: @code{REAL(KIND=2)} function.
+
+@noindent
+@var{A}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Archaic form of @code{ABS()} that is specific
+to one type for @var{A}.
+@xref{Abs Intrinsic}.
+
+@node ZCos Intrinsic
+@subsubsection ZCos Intrinsic
+@cindex ZCos intrinsic
+@cindex intrinsics, ZCos
+
+@noindent
+@example
+ZCos(@var{X})
+@end example
+
+@noindent
+ZCos: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Archaic form of @code{COS()} that is specific
+to one type for @var{X}.
+@xref{Cos Intrinsic}.
+
+@node ZExp Intrinsic
+@subsubsection ZExp Intrinsic
+@cindex ZExp intrinsic
+@cindex intrinsics, ZExp
+
+@noindent
+@example
+ZExp(@var{X})
+@end example
+
+@noindent
+ZExp: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Archaic form of @code{EXP()} that is specific
+to one type for @var{X}.
+@xref{Exp Intrinsic}.
+
+@end ifset
+@ifset familyVXT
+@node ZExt Intrinsic
+@subsubsection ZExt Intrinsic
+@cindex ZExt intrinsic
+@cindex intrinsics, ZExt
+
+This intrinsic is not yet implemented.
+The name is, however, reserved as an intrinsic.
+Use @samp{EXTERNAL ZExt} to use this name for an
+external procedure.
+
+@end ifset
+@ifset familyF2C
+@node ZLog Intrinsic
+@subsubsection ZLog Intrinsic
+@cindex ZLog intrinsic
+@cindex intrinsics, ZLog
+
+@noindent
+@example
+ZLog(@var{X})
+@end example
+
+@noindent
+ZLog: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Archaic form of @code{LOG()} that is specific
+to one type for @var{X}.
+@xref{Log Intrinsic}.
+
+@node ZSin Intrinsic
+@subsubsection ZSin Intrinsic
+@cindex ZSin intrinsic
+@cindex intrinsics, ZSin
+
+@noindent
+@example
+ZSin(@var{X})
+@end example
+
+@noindent
+ZSin: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Archaic form of @code{SIN()} that is specific
+to one type for @var{X}.
+@xref{Sin Intrinsic}.
+
+@node ZSqRt Intrinsic
+@subsubsection ZSqRt Intrinsic
+@cindex ZSqRt intrinsic
+@cindex intrinsics, ZSqRt
+
+@noindent
+@example
+ZSqRt(@var{X})
+@end example
+
+@noindent
+ZSqRt: @code{COMPLEX(KIND=2)} function.
+
+@noindent
+@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
+
+@noindent
+Intrinsic groups: @code{f2c}.
+
+@noindent
+Description:
+
+Archaic form of @code{SQRT()} that is specific
+to one type for @var{X}.
+@xref{SqRt Intrinsic}.
+
+@end ifset
diff --git a/gcc/f/intrin.c b/gcc/f/intrin.c
new file mode 100644
index 00000000000..a379684ae4c
--- /dev/null
+++ b/gcc/f/intrin.c
@@ -0,0 +1,2119 @@
+/* intrin.c -- Recognize references to intrinsics
+   Copyright (C) 1995, 1996, 1997, 1998, 2002,
+   2003 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+*/
+
+#include "proj.h"
+#include "intrin.h"
+#include "expr.h"
+#include "info.h"
+#include "src.h"
+#include "symbol.h"
+#include "target.h"
+#include "top.h"
+
+struct _ffeintrin_name_
+  {
+    const char *const name_uc;
+    const char *const name_lc;
+    const char *const name_ic;
+    const ffeintrinGen generic;
+    const ffeintrinSpec specific;
+  };
+
+struct _ffeintrin_gen_
+  {
+    const char *const name;			/* Name as seen in program. */
+    const ffeintrinSpec specs[2];
+  };
+
+struct _ffeintrin_spec_
+  {
+    const char *const name;	/* Uppercase name as seen in source code,
+				   lowercase if no source name, "none" if no
+				   name at all (NONE case). */
+    const bool is_actualarg;	/* Ok to pass as actual arg if -pedantic. */
+    const ffeintrinFamily family;
+    const ffeintrinImp implementation;
+  };
+
+struct _ffeintrin_imp_
+  {
+    const char *const name;	/* Name of implementation. */
+    const ffecomGfrt gfrt_direct;/* library routine, direct-callable form. */
+    const ffecomGfrt gfrt_f2c;	/* library routine, f2c-callable form. */
+    const ffecomGfrt gfrt_gnu;	/* library routine, gnu-callable form. */
+    const char *const control;
+    const char y2kbad;
+  };
+
+static ffebad ffeintrin_check_ (ffeintrinImp imp, ffebldOp op,
+				ffebld args, ffeinfoBasictype *xbt,
+				ffeinfoKindtype *xkt,
+				ffetargetCharacterSize *xsz,
+				bool *check_intrin,
+				ffelexToken t,
+				bool commit);
+static bool ffeintrin_check_any_ (ffebld arglist);
+static int ffeintrin_cmp_name_ (const void *name, const void *intrinsic);
+
+static const struct _ffeintrin_name_ ffeintrin_names_[]
+=
+{				/* Alpha order. */
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC) \
+  { UPPER, LOWER, MIXED, FFEINTRIN_ ## GEN, FFEINTRIN_ ## SPEC },
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+#undef DEFIMPY
+};
+
+static const struct _ffeintrin_gen_ ffeintrin_gens_[]
+=
+{
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2) \
+  { NAME, { SPEC1, SPEC2, }, },
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+#undef DEFIMPY
+};
+
+static const struct _ffeintrin_imp_ ffeintrin_imps_[]
+=
+{
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
+      { NAME, FFECOM_gfrt ## GFRTDIRECT, FFECOM_gfrt ## GFRTF2C, \
+	FFECOM_gfrt ## GFRTGNU, CONTROL, FALSE },
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
+      { NAME, FFECOM_gfrt ## GFRTDIRECT, FFECOM_gfrt ## GFRTF2C, \
+	FFECOM_gfrt ## GFRTGNU, CONTROL, Y2KBAD },
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+#undef DEFIMPY
+};
+
+static const struct _ffeintrin_spec_ ffeintrin_specs_[]
+=
+{
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \
+  { NAME, CALLABLE, FAMILY, IMP, },
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
+#include "intrin.def"
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+#undef DEFIMPY
+};
+
+
+static ffebad
+ffeintrin_check_ (ffeintrinImp imp, ffebldOp op,
+		  ffebld args, ffeinfoBasictype *xbt,
+		  ffeinfoKindtype *xkt,
+		  ffetargetCharacterSize *xsz,
+		  bool *check_intrin,
+		  ffelexToken t,
+		  bool commit)
+{
+  const char *c = ffeintrin_imps_[imp].control;
+  bool subr = (c[0] == '-');
+  const char *argc;
+  ffebld arg;
+  ffeinfoBasictype bt;
+  ffeinfoKindtype kt;
+  ffetargetCharacterSize sz = FFETARGET_charactersizeNONE;
+  ffeinfoKindtype firstarg_kt;
+  bool need_col;
+  ffeinfoBasictype col_bt = FFEINFO_basictypeNONE;
+  ffeinfoKindtype col_kt = FFEINFO_kindtypeNONE;
+  int colon = (c[2] == ':') ? 2 : 3;
+  int argno;
+
+  /* Check procedure type (function vs. subroutine) against
+     invocation.  */
+
+  if (op == FFEBLD_opSUBRREF)
+    {
+      if (!subr)
+	return FFEBAD_INTRINSIC_IS_FUNC;
+    }
+  else if (op == FFEBLD_opFUNCREF)
+    {
+      if (subr)
+	return FFEBAD_INTRINSIC_IS_SUBR;
+    }
+  else
+    return FFEBAD_INTRINSIC_REF;
+
+  /* Check the arglist for validity.  */
+
+  if ((args != NULL)
+      && (ffebld_head (args) != NULL))
+    firstarg_kt = ffeinfo_kindtype (ffebld_info (ffebld_head (args)));
+  else
+    firstarg_kt = FFEINFO_kindtype;
+
+  for (argc = &c[colon + 3],
+	 arg = args;
+       *argc != '\0';
+       )
+    {
+      char optional = '\0';
+      char required = '\0';
+      char extra = '\0';
+      char basic;
+      char kind;
+      int length;
+      int elements;
+      bool lastarg_complex = FALSE;
+
+      /* We don't do anything with keywords yet.  */
+      do
+	{
+	} while (*(++argc) != '=');
+
+      ++argc;
+      if ((*argc == '?')
+	  || (*argc == '!')
+	  || (*argc == '*'))
+	optional = *(argc++);
+      if ((*argc == '+')
+	  || (*argc == 'n')
+	  || (*argc == 'p'))
+	required = *(argc++);
+      basic = *(argc++);
+      kind = *(argc++);
+      if (*argc == '[')
+	{
+	  length = *++argc - '0';
+	  if (*++argc != ']')
+	    length = 10 * length + (*(argc++) - '0');
+	  ++argc;
+	}
+      else
+	length = -1;
+      if (*argc == '(')
+	{
+	  elements = *++argc - '0';
+	  if (*++argc != ')')
+	    elements = 10 * elements + (*(argc++) - '0');
+	  ++argc;
+	}
+      else if (*argc == '&')
+	{
+	  elements = -1;
+	  ++argc;
+	}
+      else
+	elements = 0;
+      if ((*argc == '&')
+	  || (*argc == 'i')
+	  || (*argc == 'w')
+	  || (*argc == 'x'))
+	extra = *(argc++);
+      if (*argc == ',')
+	++argc;
+
+      /* Break out of this loop only when current arg spec completely
+	 processed.  */
+
+      do
+	{
+	  bool okay;
+	  ffebld a;
+	  ffeinfo i;
+	  bool anynum;
+	  ffeinfoBasictype abt = FFEINFO_basictypeNONE;
+	  ffeinfoKindtype akt = FFEINFO_kindtypeNONE;
+
+	  if ((arg == NULL)
+	      || (ffebld_head (arg) == NULL))
+	    {
+	      if (required != '\0')
+		return FFEBAD_INTRINSIC_TOOFEW;
+	      if (optional == '\0')
+		return FFEBAD_INTRINSIC_TOOFEW;
+	      if (arg != NULL)
+		arg = ffebld_trail (arg);
+	      break;	/* Try next argspec. */
+	    }
+
+	  a = ffebld_head (arg);
+	  i = ffebld_info (a);
+	  anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)
+	    || (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);
+
+	  /* See how well the arg matches up to the spec.  */
+
+	  switch (basic)
+	    {
+	    case 'A':
+	      okay = (ffeinfo_basictype (i) == FFEINFO_basictypeCHARACTER)
+		&& ((length == -1)
+		    || (ffeinfo_size (i) == (ffetargetCharacterSize) length));
+	      break;
+
+	    case 'C':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
+	      abt = FFEINFO_basictypeCOMPLEX;
+	      break;
+
+	    case 'I':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER);
+	      abt = FFEINFO_basictypeINTEGER;
+	      break;
+
+	    case 'L':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
+	      abt = FFEINFO_basictypeLOGICAL;
+	      break;
+
+	    case 'R':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+	      abt = FFEINFO_basictypeREAL;
+	      break;
+
+	    case 'B':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
+	      break;
+
+	    case 'F':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+	      break;
+
+	    case 'N':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+	      break;
+
+	    case 'S':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+	      break;
+
+	    case 'g':
+	      okay = ((ffebld_op (a) == FFEBLD_opLABTER)
+		      || (ffebld_op (a) == FFEBLD_opLABTOK));
+	      elements = -1;
+	      extra = '-';
+	      break;
+
+	    case 's':
+	      okay = (((((ffeinfo_basictype (i) == FFEINFO_basictypeNONE)
+			 && (ffeinfo_kindtype (i) == FFEINFO_kindtypeNONE)
+			 && (ffeinfo_kind (i) == FFEINFO_kindSUBROUTINE))
+			|| ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+			    && (ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGERDEFAULT)
+			    && (ffeinfo_kind (i) == FFEINFO_kindFUNCTION))
+			|| (ffeinfo_kind (i) == FFEINFO_kindNONE))
+		       && ((ffeinfo_where (i) == FFEINFO_whereDUMMY)
+			   || (ffeinfo_where (i) == FFEINFO_whereGLOBAL)))
+		      || ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+			  && (ffeinfo_kind (i) == FFEINFO_kindENTITY)));
+	      elements = -1;
+	      extra = '-';
+	      break;
+
+	    case '-':
+	    default:
+	      okay = TRUE;
+	      break;
+	    }
+
+	  switch (kind)
+	    {
+	    case '1': case '2': case '3': case '4': case '5':
+	    case '6': case '7': case '8': case '9':
+	      akt = (kind - '0');
+	      if ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+		  || (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL))
+		{
+		  switch (akt)
+		    {	/* Translate to internal kinds for now! */
+		    default:
+		      break;
+
+		    case 2:
+		      akt = 4;
+		      break;
+
+		    case 3:
+		      akt = 2;
+		      break;
+
+		    case 4:
+		      akt = 5;
+		      break;
+
+		    case 6:
+		      akt = 3;
+		      break;
+
+		    case 7:
+		      akt = ffecom_pointer_kind ();
+		      break;
+		    }
+		}
+	      okay &= anynum || (ffeinfo_kindtype (i) == akt);
+	      break;
+
+	    case 'A':
+	      okay &= anynum || (ffeinfo_kindtype (i) == firstarg_kt);
+	      akt = (firstarg_kt == FFEINFO_kindtype) ? FFEINFO_kindtypeNONE
+		: firstarg_kt;
+	      break;
+
+	    case 'N':
+	      /* Accept integers and logicals not wider than the default integer/logical.  */
+	      if (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+		{
+		  okay &= anynum || (ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGER1
+					|| ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGER2
+					|| ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGER3);
+		  akt = FFEINFO_kindtypeINTEGER1;	/* The default.  */
+		}
+	      else if (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL)
+		{
+		  okay &= anynum || (ffeinfo_kindtype (i) == FFEINFO_kindtypeLOGICAL1
+					|| ffeinfo_kindtype (i) == FFEINFO_kindtypeLOGICAL2
+					|| ffeinfo_kindtype (i) == FFEINFO_kindtypeLOGICAL3);
+		  akt = FFEINFO_kindtypeLOGICAL1;	/* The default.  */
+		}
+	      break;
+
+	    case '*':
+	    default:
+	      break;
+	    }
+
+	  switch (elements)
+	    {
+	      ffebld b;
+
+	    case -1:
+	      break;
+
+	    case 0:
+	      if (ffeinfo_rank (i) != 0)
+		okay = FALSE;
+	      break;
+
+	    default:
+	      if ((ffeinfo_rank (i) != 1)
+		  || (ffebld_op (a) != FFEBLD_opSYMTER)
+		  || ((b = ffesymbol_arraysize (ffebld_symter (a))) == NULL)
+		  || (ffebld_op (b) != FFEBLD_opCONTER)
+		  || (ffeinfo_basictype (ffebld_info (b)) != FFEINFO_basictypeINTEGER)
+		  || (ffeinfo_kindtype (ffebld_info (b)) != FFEINFO_kindtypeINTEGERDEFAULT)
+		  || (ffebld_constant_integer1 (ffebld_conter (b)) != elements))
+		okay = FALSE;
+	      break;
+	    }
+
+	  switch (extra)
+	    {
+	    case '&':
+	      if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
+		  || ((ffebld_op (a) != FFEBLD_opSYMTER)
+		      && (ffebld_op (a) != FFEBLD_opSUBSTR)
+		      && (ffebld_op (a) != FFEBLD_opARRAYREF)))
+		okay = FALSE;
+	      break;
+
+	    case 'w':
+	    case 'x':
+	      if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
+		  || ((ffebld_op (a) != FFEBLD_opSYMTER)
+		      && (ffebld_op (a) != FFEBLD_opARRAYREF)
+		      && (ffebld_op (a) != FFEBLD_opSUBSTR)))
+		okay = FALSE;
+	      break;
+
+	    case '-':
+	    case 'i':
+	      break;
+
+	    default:
+	      if (ffeinfo_kind (i) != FFEINFO_kindENTITY)
+		okay = FALSE;
+	      break;
+	    }
+
+	  if ((optional == '!')
+	      && lastarg_complex)
+	    okay = FALSE;
+
+	  if (!okay)
+	    {
+	      /* If it wasn't optional, it's an error,
+		 else maybe it could match a later argspec.  */
+	      if (optional == '\0')
+		return FFEBAD_INTRINSIC_REF;
+	      break;	/* Try next argspec. */
+	    }
+
+	  lastarg_complex
+	    = (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
+
+	  if (anynum)
+	    {
+	      /* If we know dummy arg type, convert to that now.  */
+
+	      if ((abt != FFEINFO_basictypeNONE)
+		  && (akt != FFEINFO_kindtypeNONE)
+		  && commit)
+		{
+		  /* We have a known type, convert hollerith/typeless
+		     to it.  */
+
+		  a = ffeexpr_convert (a, t, NULL,
+				       abt, akt, 0,
+				       FFETARGET_charactersizeNONE,
+				       FFEEXPR_contextLET);
+		  ffebld_set_head (arg, a);
+		}
+	    }
+
+	  arg = ffebld_trail (arg);	/* Arg accepted, now move on. */
+
+	  if (optional == '*')
+	    continue;	/* Go ahead and try another arg. */
+	  if (required == '\0')
+	    break;
+	  if ((required == 'n')
+	      || (required == '+'))
+	    {
+	      optional = '*';
+	      required = '\0';
+	    }
+	  else if (required == 'p')
+	    required = 'n';
+	} while (TRUE);
+    }
+
+  if (arg != NULL)
+    return FFEBAD_INTRINSIC_TOOMANY;
+
+  /* Set up the initial type for the return value of the function.  */
+
+  need_col = FALSE;
+  switch (c[0])
+    {
+    case 'A':
+      bt = FFEINFO_basictypeCHARACTER;
+      sz = (c[2] == '*') ? FFETARGET_charactersizeNONE : 1;
+      break;
+
+    case 'C':
+      bt = FFEINFO_basictypeCOMPLEX;
+      break;
+
+    case 'I':
+      bt = FFEINFO_basictypeINTEGER;
+      break;
+
+    case 'L':
+      bt = FFEINFO_basictypeLOGICAL;
+      break;
+
+    case 'R':
+      bt = FFEINFO_basictypeREAL;
+      break;
+
+    case 'B':
+    case 'F':
+    case 'N':
+    case 'S':
+      need_col = TRUE;
+      /* Fall through.  */
+    case '-':
+    default:
+      bt = FFEINFO_basictypeNONE;
+      break;
+    }
+
+  switch (c[1])
+    {
+    case '1': case '2': case '3': case '4': case '5':
+    case '6': case '7': case '8': case '9':
+      kt = (c[1] - '0');
+      if ((bt == FFEINFO_basictypeINTEGER)
+	  || (bt == FFEINFO_basictypeLOGICAL))
+	{
+	  switch (kt)
+	    {	/* Translate to internal kinds for now! */
+	    default:
+	      break;
+
+	    case 2:
+	      kt = 4;
+	      break;
+
+	    case 3:
+	      kt = 2;
+	      break;
+
+	    case 4:
+	      kt = 5;
+	      break;
+
+	    case 6:
+	      kt = 3;
+	      break;
+
+	    case 7:
+	      kt = ffecom_pointer_kind ();
+	      break;
+	    }
+	}
+      break;
+
+    case 'C':
+      if (ffe_is_90 ())
+	need_col = TRUE;
+      kt = 1;
+      break;
+
+    case '=':
+      need_col = TRUE;
+      /* Fall through.  */
+    case '-':
+    default:
+      kt = FFEINFO_kindtypeNONE;
+      break;
+    }
+
+  /* Determine collective type of COL, if there is one.  */
+
+  if (need_col || c[colon + 1] != '-')
+    {
+      bool okay = TRUE;
+      bool have_anynum = FALSE;
+      int  arg_count=0;
+
+      for (arg = args, arg_count=0;
+	   arg != NULL;
+	   arg = ffebld_trail (arg), arg_count++ )
+	{
+	  ffebld a = ffebld_head (arg);
+	  ffeinfo i;
+	  bool anynum;
+
+	  if (a == NULL)
+	    continue;
+	  i = ffebld_info (a);
+
+	  if ( c[colon+1] != '*' && (c[colon+1]-'0') != arg_count )
+	    continue;
+
+	  anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)
+	    || (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);
+	  if (anynum)
+	    {
+	      have_anynum = TRUE;
+	      continue;
+	    }
+
+	  if ((col_bt == FFEINFO_basictypeNONE)
+	      && (col_kt == FFEINFO_kindtypeNONE))
+	    {
+	      col_bt = ffeinfo_basictype (i);
+	      col_kt = ffeinfo_kindtype (i);
+	    }
+	  else
+	    {
+	      ffeexpr_type_combine (&col_bt, &col_kt,
+				    col_bt, col_kt,
+				    ffeinfo_basictype (i),
+				    ffeinfo_kindtype (i),
+				    NULL);
+	      if ((col_bt == FFEINFO_basictypeNONE)
+		  || (col_kt == FFEINFO_kindtypeNONE))
+		return FFEBAD_INTRINSIC_REF;
+	    }
+	}
+
+      if (have_anynum
+	  && ((col_bt == FFEINFO_basictypeNONE)
+	      || (col_kt == FFEINFO_kindtypeNONE)))
+	{
+	  /* No type, but have hollerith/typeless.  Use type of return
+	     value to determine type of COL.  */
+
+	  switch (c[0])
+	    {
+	    case 'A':
+	      return FFEBAD_INTRINSIC_REF;
+
+	    case 'B':
+	    case 'I':
+	    case 'L':
+	      if ((col_bt != FFEINFO_basictypeNONE)
+		  && (col_bt != FFEINFO_basictypeINTEGER))
+		return FFEBAD_INTRINSIC_REF;
+	      /* Fall through.  */
+	    case 'N':
+	    case 'S':
+	    case '-':
+	    default:
+	      col_bt = FFEINFO_basictypeINTEGER;
+	      col_kt = FFEINFO_kindtypeINTEGER1;
+	      break;
+
+	    case 'C':
+	      if ((col_bt != FFEINFO_basictypeNONE)
+		  && (col_bt != FFEINFO_basictypeCOMPLEX))
+		return FFEBAD_INTRINSIC_REF;
+	      col_bt = FFEINFO_basictypeCOMPLEX;
+	      col_kt = FFEINFO_kindtypeREAL1;
+	      break;
+
+	    case 'R':
+	      if ((col_bt != FFEINFO_basictypeNONE)
+		  && (col_bt != FFEINFO_basictypeREAL))
+		return FFEBAD_INTRINSIC_REF;
+	      /* Fall through.  */
+	    case 'F':
+	      col_bt = FFEINFO_basictypeREAL;
+	      col_kt = FFEINFO_kindtypeREAL1;
+	      break;
+	    }
+	}
+
+      switch (c[0])
+	{
+	case 'B':
+	  okay = (col_bt == FFEINFO_basictypeINTEGER)
+	    || (col_bt == FFEINFO_basictypeLOGICAL);
+	  if (need_col)
+	    bt = col_bt;
+	  break;
+
+	case 'F':
+	  okay = (col_bt == FFEINFO_basictypeCOMPLEX)
+	    || (col_bt == FFEINFO_basictypeREAL);
+	  if (need_col)
+	    bt = col_bt;
+	  break;
+
+	case 'N':
+	  okay = (col_bt == FFEINFO_basictypeCOMPLEX)
+	    || (col_bt == FFEINFO_basictypeINTEGER)
+	    || (col_bt == FFEINFO_basictypeREAL);
+	  if (need_col)
+	    bt = col_bt;
+	  break;
+
+	case 'S':
+	  okay = (col_bt == FFEINFO_basictypeINTEGER)
+	    || (col_bt == FFEINFO_basictypeREAL)
+	    || (col_bt == FFEINFO_basictypeCOMPLEX);
+	  if (need_col)
+	    bt = ((col_bt != FFEINFO_basictypeCOMPLEX) ? col_bt
+		  : FFEINFO_basictypeREAL);
+	  break;
+	}
+
+      switch (c[1])
+	{
+	case '=':
+	  if (need_col)
+	    kt = col_kt;
+	  break;
+
+	case 'C':
+	  if (col_bt == FFEINFO_basictypeCOMPLEX)
+	    {
+	      if (col_kt != FFEINFO_kindtypeREALDEFAULT)
+		*check_intrin = TRUE;
+	      if (need_col)
+		kt = col_kt;
+	    }
+	  break;
+	}
+
+      if (!okay)
+	return FFEBAD_INTRINSIC_REF;
+    }
+
+  /* Now, convert args in the arglist to the final type of the COL.  */
+
+  for (argno = 0, argc = &c[colon + 3],
+	 arg = args;
+       *argc != '\0';
+       ++argno)
+    {
+      char optional = '\0';
+      char required = '\0';
+      char extra = '\0';
+      char basic;
+      char kind;
+      int length;
+      int elements;
+      bool lastarg_complex = FALSE;
+
+      /* We don't do anything with keywords yet.  */
+      do
+	{
+	} while (*(++argc) != '=');
+
+      ++argc;
+      if ((*argc == '?')
+	  || (*argc == '!')
+	  || (*argc == '*'))
+	optional = *(argc++);
+      if ((*argc == '+')
+	  || (*argc == 'n')
+	  || (*argc == 'p'))
+	required = *(argc++);
+      basic = *(argc++);
+      kind = *(argc++);
+      if (*argc == '[')
+	{
+	  length = *++argc - '0';
+	  if (*++argc != ']')
+	    length = 10 * length + (*(argc++) - '0');
+	  ++argc;
+	}
+      else
+	length = -1;
+      if (*argc == '(')
+	{
+	  elements = *++argc - '0';
+	  if (*++argc != ')')
+	    elements = 10 * elements + (*(argc++) - '0');
+	  ++argc;
+	}
+      else if (*argc == '&')
+	{
+	  elements = -1;
+	  ++argc;
+	}
+      else
+	elements = 0;
+      if ((*argc == '&')
+	  || (*argc == 'i')
+	  || (*argc == 'w')
+	  || (*argc == 'x'))
+	extra = *(argc++);
+      if (*argc == ',')
+	++argc;
+
+      /* Break out of this loop only when current arg spec completely
+	 processed.  */
+
+      do
+	{
+	  bool okay;
+	  ffebld a;
+	  ffeinfo i;
+	  bool anynum;
+	  ffeinfoBasictype abt = FFEINFO_basictypeNONE;
+	  ffeinfoKindtype akt = FFEINFO_kindtypeNONE;
+
+	  if ((arg == NULL)
+	      || (ffebld_head (arg) == NULL))
+	    {
+	      if (arg != NULL)
+		arg = ffebld_trail (arg);
+	      break;	/* Try next argspec. */
+	    }
+
+	  a = ffebld_head (arg);
+	  i = ffebld_info (a);
+	  anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)
+	    || (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);
+
+	  /* Determine what the default type for anynum would be.  */
+
+	  if (anynum)
+	    {
+	      switch (c[colon + 1])
+		{
+		case '-':
+		  break;
+		case '0': case '1': case '2': case '3': case '4':
+		case '5': case '6': case '7': case '8': case '9':
+		  if (argno != (c[colon + 1] - '0'))
+		    break;
+		case '*':
+		  abt = col_bt;
+		  akt = col_kt;
+		  break;
+		}
+	    }
+
+	  /* Again, match arg up to the spec.  We go through all of
+	     this again to properly follow the contour of optional
+	     arguments.  Probably this level of flexibility is not
+	     needed, perhaps it's even downright naughty.  */
+
+	  switch (basic)
+	    {
+	    case 'A':
+	      okay = (ffeinfo_basictype (i) == FFEINFO_basictypeCHARACTER)
+		&& ((length == -1)
+		    || (ffeinfo_size (i) == (ffetargetCharacterSize) length));
+	      break;
+
+	    case 'C':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
+	      abt = FFEINFO_basictypeCOMPLEX;
+	      break;
+
+	    case 'I':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER);
+	      abt = FFEINFO_basictypeINTEGER;
+	      break;
+
+	    case 'L':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
+	      abt = FFEINFO_basictypeLOGICAL;
+	      break;
+
+	    case 'R':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+	      abt = FFEINFO_basictypeREAL;
+	      break;
+
+	    case 'B':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
+	      break;
+
+	    case 'F':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+	      break;
+
+	    case 'N':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+	      break;
+
+	    case 'S':
+	      okay = anynum
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
+	      break;
+
+	    case 'g':
+	      okay = ((ffebld_op (a) == FFEBLD_opLABTER)
+		      || (ffebld_op (a) == FFEBLD_opLABTOK));
+	      elements = -1;
+	      extra = '-';
+	      break;
+
+	    case 's':
+	      okay = (((((ffeinfo_basictype (i) == FFEINFO_basictypeNONE)
+			 && (ffeinfo_kindtype (i) == FFEINFO_kindtypeNONE)
+			 && (ffeinfo_kind (i) == FFEINFO_kindSUBROUTINE))
+			|| ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+			    && (ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGERDEFAULT)
+			    && (ffeinfo_kind (i) == FFEINFO_kindFUNCTION))
+			|| (ffeinfo_kind (i) == FFEINFO_kindNONE))
+		       && ((ffeinfo_where (i) == FFEINFO_whereDUMMY)
+			   || (ffeinfo_where (i) == FFEINFO_whereGLOBAL)))
+		      || ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+			  && (ffeinfo_kind (i) == FFEINFO_kindENTITY)));
+	      elements = -1;
+	      extra = '-';
+	      break;
+
+	    case '-':
+	    default:
+	      okay = TRUE;
+	      break;
+	    }
+
+	  switch (kind)
+	    {
+	    case '1': case '2': case '3': case '4': case '5':
+	    case '6': case '7': case '8': case '9':
+	      akt = (kind - '0');
+	      if ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
+		  || (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL))
+		{
+		  switch (akt)
+		    {	/* Translate to internal kinds for now! */
+		    default:
+		      break;
+
+		    case 2:
+		      akt = 4;
+		      break;
+
+		    case 3:
+		      akt = 2;
+		      break;
+
+		    case 4:
+		      akt = 5;
+		      break;
+
+		    case 6:
+		      akt = 3;
+		      break;
+
+		    case 7:
+		      akt = ffecom_pointer_kind ();
+		      break;
+		    }
+		}
+	      okay &= anynum || (ffeinfo_kindtype (i) == akt);
+	      break;
+
+	    case 'A':
+	      okay &= anynum || (ffeinfo_kindtype (i) == firstarg_kt);
+	      akt = (firstarg_kt == FFEINFO_kindtype) ? FFEINFO_kindtypeNONE
+		: firstarg_kt;
+	      break;
+
+	    case '*':
+	    default:
+	      break;
+	    }
+
+	  switch (elements)
+	    {
+	      ffebld b;
+
+	    case -1:
+	      break;
+
+	    case 0:
+	      if (ffeinfo_rank (i) != 0)
+		okay = FALSE;
+	      break;
+
+	    default:
+	      if ((ffeinfo_rank (i) != 1)
+		  || (ffebld_op (a) != FFEBLD_opSYMTER)
+		  || ((b = ffesymbol_arraysize (ffebld_symter (a))) == NULL)
+		  || (ffebld_op (b) != FFEBLD_opCONTER)
+		  || (ffeinfo_basictype (ffebld_info (b)) != FFEINFO_basictypeINTEGER)
+		  || (ffeinfo_kindtype (ffebld_info (b)) != FFEINFO_kindtypeINTEGERDEFAULT)
+		  || (ffebld_constant_integer1 (ffebld_conter (b)) != elements))
+		okay = FALSE;
+	      break;
+	    }
+
+	  switch (extra)
+	    {
+	    case '&':
+	      if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
+		  || ((ffebld_op (a) != FFEBLD_opSYMTER)
+		      && (ffebld_op (a) != FFEBLD_opSUBSTR)
+		      && (ffebld_op (a) != FFEBLD_opARRAYREF)))
+		okay = FALSE;
+	      break;
+
+	    case 'w':
+	    case 'x':
+	      if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
+		  || ((ffebld_op (a) != FFEBLD_opSYMTER)
+		      && (ffebld_op (a) != FFEBLD_opARRAYREF)
+		      && (ffebld_op (a) != FFEBLD_opSUBSTR)))
+		okay = FALSE;
+	      break;
+
+	    case '-':
+	    case 'i':
+	      break;
+
+	    default:
+	      if (ffeinfo_kind (i) != FFEINFO_kindENTITY)
+		okay = FALSE;
+	      break;
+	    }
+
+	  if ((optional == '!')
+	      && lastarg_complex)
+	    okay = FALSE;
+
+	  if (!okay)
+	    {
+	      /* If it wasn't optional, it's an error,
+		 else maybe it could match a later argspec.  */
+	      if (optional == '\0')
+		return FFEBAD_INTRINSIC_REF;
+	      break;	/* Try next argspec. */
+	    }
+
+	  lastarg_complex
+	    = (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
+
+	  if (anynum && commit)
+	    {
+	      /* If we know dummy arg type, convert to that now.  */
+
+	      if (abt == FFEINFO_basictypeNONE)
+		abt = FFEINFO_basictypeINTEGER;
+	      if (akt == FFEINFO_kindtypeNONE)
+		akt = FFEINFO_kindtypeINTEGER1;
+
+	      /* We have a known type, convert hollerith/typeless to it.  */
+
+	      a = ffeexpr_convert (a, t, NULL,
+				   abt, akt, 0,
+				   FFETARGET_charactersizeNONE,
+				   FFEEXPR_contextLET);
+	      ffebld_set_head (arg, a);
+	    }
+	  else if ((c[colon + 1] == '*') && commit)
+	    {
+	      /* This is where we promote types to the consensus
+		 type for the COL.  Maybe this is where -fpedantic
+		 should issue a warning as well.  */
+
+	      a = ffeexpr_convert (a, t, NULL,
+				   col_bt, col_kt, 0,
+				   ffeinfo_size (i),
+				   FFEEXPR_contextLET);
+	      ffebld_set_head (arg, a);
+	    }
+
+	  arg = ffebld_trail (arg);	/* Arg accepted, now move on. */
+
+	  if (optional == '*')
+	    continue;	/* Go ahead and try another arg. */
+	  if (required == '\0')
+	    break;
+	  if ((required == 'n')
+	      || (required == '+'))
+	    {
+	      optional = '*';
+	      required = '\0';
+	    }
+	  else if (required == 'p')
+	    required = 'n';
+	} while (TRUE);
+    }
+
+  *xbt = bt;
+  *xkt = kt;
+  *xsz = sz;
+  return FFEBAD;
+}
+
+static bool
+ffeintrin_check_any_ (ffebld arglist)
+{
+  ffebld item;
+
+  for (; arglist != NULL; arglist = ffebld_trail (arglist))
+    {
+      item = ffebld_head (arglist);
+      if ((item != NULL)
+	  && (ffebld_op (item) == FFEBLD_opANY))
+	return TRUE;
+    }
+
+  return FALSE;
+}
+
+/* Compare a forced-to-uppercase name with a known-upper-case name.  */
+
+static int
+upcasecmp_ (const char *name, const char *ucname)
+{
+  for ( ; *name != 0 && *ucname != 0; name++, ucname++)
+    {
+      int i = TOUPPER(*name) - *ucname;
+
+      if (i != 0)
+        return i;
+    }
+
+  return *name - *ucname;
+}
+
+/* Compare name to intrinsic's name.
+   The intrinsics table is sorted on the upper case entries; so first
+   compare irrespective of case on the `uc' entry.  If it matches,
+   compare according to the setting of intrinsics case comparison mode.  */
+
+static int
+ffeintrin_cmp_name_ (const void *name, const void *intrinsic)
+{
+  const char *const uc = ((const struct _ffeintrin_name_ *) intrinsic)->name_uc;
+  const char *const lc = ((const struct _ffeintrin_name_ *) intrinsic)->name_lc;
+  const char *const ic = ((const struct _ffeintrin_name_ *) intrinsic)->name_ic;
+  int i;
+
+  if ((i = upcasecmp_ (name, uc)) == 0)
+    {
+      switch (ffe_case_intrin ())
+	{
+	case FFE_caseLOWER:
+	  return strcmp(name, lc);
+	case FFE_caseINITCAP:
+	  return strcmp(name, ic);
+	default:
+	  return 0;
+	}
+    }
+
+  return i;
+}
+
+/* Return basic type of intrinsic implementation, based on its
+   run-time implementation *only*.  (This is used only when
+   the type of an intrinsic name is needed without having a
+   list of arguments, i.e. an interface signature, such as when
+   passing the intrinsic itself, or really the run-time-library
+   function, as an argument.)
+
+   If there's no eligible intrinsic implementation, there must be
+   a bug somewhere else; no such reference should have been permitted
+   to go this far.  (Well, this might be wrong.)  */
+
+ffeinfoBasictype
+ffeintrin_basictype (ffeintrinSpec spec)
+{
+  ffeintrinImp imp;
+  ffecomGfrt gfrt;
+
+  assert (spec < FFEINTRIN_spec);
+  imp = ffeintrin_specs_[spec].implementation;
+  assert (imp < FFEINTRIN_imp);
+
+  if (ffe_is_f2c ())
+    gfrt = ffeintrin_imps_[imp].gfrt_f2c;
+  else
+    gfrt = ffeintrin_imps_[imp].gfrt_gnu;
+
+  assert (gfrt != FFECOM_gfrt);
+
+  return ffecom_gfrt_basictype (gfrt);
+}
+
+/* Return family to which specific intrinsic belongs.  */
+
+ffeintrinFamily
+ffeintrin_family (ffeintrinSpec spec)
+{
+  if (spec >= FFEINTRIN_spec)
+    return FALSE;
+  return ffeintrin_specs_[spec].family;
+}
+
+/* Check and fill in info on func/subr ref node.
+
+   ffebld expr;			// FUNCREF or SUBRREF with no info (caller
+				// gets it from the modified info structure).
+   ffeinfo info;		// Already filled in, will be overwritten.
+   ffelexToken token;		// Used for error message.
+   ffeintrin_fulfill_generic (&expr, &info, token);
+
+   Based on the generic id, figure out which specific procedure is meant and
+   pick that one.  Else return an error, a la _specific.  */
+
+void
+ffeintrin_fulfill_generic (ffebld *expr, ffeinfo *info, ffelexToken t)
+{
+  ffebld symter;
+  ffebldOp op;
+  ffeintrinGen gen;
+  ffeintrinSpec spec = FFEINTRIN_specNONE;
+  ffeinfoBasictype bt = FFEINFO_basictypeNONE;
+  ffeinfoKindtype kt = FFEINFO_kindtypeNONE;
+  ffetargetCharacterSize sz = FFETARGET_charactersizeNONE;
+  ffeintrinImp imp;
+  ffeintrinSpec tspec;
+  ffeintrinImp nimp = FFEINTRIN_impNONE;
+  ffebad error;
+  bool any = FALSE;
+  bool highly_specific = FALSE;
+  int i;
+
+  op = ffebld_op (*expr);
+  assert ((op == FFEBLD_opFUNCREF) || (op == FFEBLD_opSUBRREF));
+  assert (ffebld_op (ffebld_left (*expr)) == FFEBLD_opSYMTER);
+
+  gen = ffebld_symter_generic (ffebld_left (*expr));
+  assert (gen != FFEINTRIN_genNONE);
+
+  imp = FFEINTRIN_impNONE;
+  error = FFEBAD;
+
+  any = ffeintrin_check_any_ (ffebld_right (*expr));
+
+  for (i = 0;
+       (((size_t) i) < ARRAY_SIZE (ffeintrin_gens_[gen].specs))
+	 && ((tspec = ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE)
+	 && !any;
+       ++i)
+    {
+      ffeintrinImp timp = ffeintrin_specs_[tspec].implementation;
+      ffeinfoBasictype tbt;
+      ffeinfoKindtype tkt;
+      ffetargetCharacterSize tsz;
+      ffeIntrinsicState state
+      = ffeintrin_state_family (ffeintrin_specs_[tspec].family);
+      ffebad terror;
+
+      if (state == FFE_intrinsicstateDELETED)
+	continue;
+
+      if (timp != FFEINTRIN_impNONE)
+	{
+	  if (!(ffeintrin_imps_[timp].control[0] == '-')
+	      != !(ffebld_op (*expr) == FFEBLD_opSUBRREF))
+	    continue;		/* Form of reference must match form of specific. */
+	}
+
+      if (state == FFE_intrinsicstateDISABLED)
+	terror = FFEBAD_INTRINSIC_DISABLED;
+      else if (timp == FFEINTRIN_impNONE)
+	terror = FFEBAD_INTRINSIC_UNIMPL;
+      else
+	{
+	  terror = ffeintrin_check_ (timp, ffebld_op (*expr),
+				     ffebld_right (*expr),
+				     &tbt, &tkt, &tsz, NULL, t, FALSE);
+	  if (terror == FFEBAD)
+	    {
+	      if (imp != FFEINTRIN_impNONE)
+		{
+		  ffebad_start (FFEBAD_INTRINSIC_AMBIG);
+		  ffebad_here (0, ffelex_token_where_line (t),
+			       ffelex_token_where_column (t));
+		  ffebad_string (ffeintrin_gens_[gen].name);
+		  ffebad_string (ffeintrin_specs_[spec].name);
+		  ffebad_string (ffeintrin_specs_[tspec].name);
+		  ffebad_finish ();
+		}
+	      else
+		{
+		  if (ffebld_symter_specific (ffebld_left (*expr))
+		      == tspec)
+		    highly_specific = TRUE;
+		  imp = timp;
+		  spec = tspec;
+		  bt = tbt;
+		  kt = tkt;
+		  sz = tkt;
+		  error = terror;
+		}
+	    }
+	  else if (terror != FFEBAD)
+	    {			/* This error has precedence over others. */
+	      if ((error == FFEBAD_INTRINSIC_DISABLED)
+		  || (error == FFEBAD_INTRINSIC_UNIMPL))
+		error = FFEBAD;
+	    }
+	}
+
+      if (error == FFEBAD)
+	error = terror;
+    }
+
+  if (any || (imp == FFEINTRIN_impNONE))
+    {
+      if (!any)
+	{
+	  if (error == FFEBAD)
+	    error = FFEBAD_INTRINSIC_REF;
+	  ffebad_start (error);
+	  ffebad_here (0, ffelex_token_where_line (t),
+		       ffelex_token_where_column (t));
+	  ffebad_string (ffeintrin_gens_[gen].name);
+	  ffebad_finish ();
+	}
+
+      *expr = ffebld_new_any ();
+      *info = ffeinfo_new_any ();
+    }
+  else
+    {
+      if (!highly_specific && (nimp != FFEINTRIN_impNONE))
+	{
+	  fprintf (stderr, "lineno=%ld, gen=%s, imp=%s, timp=%s\n",
+		   (long) input_line,
+		   ffeintrin_gens_[gen].name,
+		   ffeintrin_imps_[imp].name,
+		   ffeintrin_imps_[nimp].name);
+	  assert ("Ambiguous generic reference" == NULL);
+	  abort ();
+	}
+      error = ffeintrin_check_ (imp, ffebld_op (*expr),
+				ffebld_right (*expr),
+				&bt, &kt, &sz, NULL, t, TRUE);
+      assert (error == FFEBAD);
+      *info = ffeinfo_new (bt,
+			   kt,
+			   0,
+			   FFEINFO_kindENTITY,
+			   FFEINFO_whereFLEETING,
+			   sz);
+      symter = ffebld_left (*expr);
+      ffebld_symter_set_specific (symter, spec);
+      ffebld_symter_set_implementation (symter, imp);
+      ffebld_set_info (symter,
+		       ffeinfo_new (bt,
+				    kt,
+				    0,
+				    (bt == FFEINFO_basictypeNONE)
+				    ? FFEINFO_kindSUBROUTINE
+				    : FFEINFO_kindFUNCTION,
+				    FFEINFO_whereINTRINSIC,
+				    sz));
+
+      if ((ffesymbol_attrs (ffebld_symter (symter)) & FFESYMBOL_attrsTYPE)
+	  && (((bt != ffesymbol_basictype (ffebld_symter (symter)))
+	       || (kt != ffesymbol_kindtype (ffebld_symter (symter)))
+	       || ((sz != FFETARGET_charactersizeNONE)
+		   && (sz != ffesymbol_size (ffebld_symter (symter)))))))
+	{
+	  ffebad_start (FFEBAD_INTRINSIC_TYPE);
+	  ffebad_here (0, ffelex_token_where_line (t),
+		       ffelex_token_where_column (t));
+	  ffebad_string (ffeintrin_gens_[gen].name);
+	  ffebad_finish ();
+	}
+      if (ffeintrin_imps_[imp].y2kbad)
+	{
+	  ffebad_start (FFEBAD_INTRINSIC_Y2KBAD);
+	  ffebad_here (0, ffelex_token_where_line (t),
+		       ffelex_token_where_column (t));
+	  ffebad_string (ffeintrin_gens_[gen].name);
+	  ffebad_finish ();
+	}
+    }
+}
+
+/* Check and fill in info on func/subr ref node.
+
+   ffebld expr;			// FUNCREF or SUBRREF with no info (caller
+				// gets it from the modified info structure).
+   ffeinfo info;		// Already filled in, will be overwritten.
+   bool check_intrin;           // May be omitted, else set TRUE if intrinsic needs checking.
+   ffelexToken token;		// Used for error message.
+   ffeintrin_fulfill_specific (&expr, &info, &check_intrin, token);
+
+   Based on the specific id, determine whether the arg list is valid
+   (number, type, rank, and kind of args) and fill in the info structure
+   accordingly.	 Currently don't rewrite the expression, but perhaps
+   someday do so for constant collapsing, except when an error occurs,
+   in which case it is overwritten with ANY and info is also overwritten
+   accordingly.	 */
+
+void
+ffeintrin_fulfill_specific (ffebld *expr, ffeinfo *info,
+			    bool *check_intrin, ffelexToken t)
+{
+  ffebld symter;
+  ffebldOp op;
+  ffeintrinGen gen;
+  ffeintrinSpec spec;
+  ffeintrinImp imp;
+  ffeinfoBasictype bt = FFEINFO_basictypeNONE;
+  ffeinfoKindtype kt = FFEINFO_kindtypeNONE;
+  ffetargetCharacterSize sz = FFETARGET_charactersizeNONE;
+  ffeIntrinsicState state;
+  ffebad error;
+  bool any = FALSE;
+  const char *name;
+
+  op = ffebld_op (*expr);
+  assert ((op == FFEBLD_opFUNCREF) || (op == FFEBLD_opSUBRREF));
+  assert (ffebld_op (ffebld_left (*expr)) == FFEBLD_opSYMTER);
+
+  gen = ffebld_symter_generic (ffebld_left (*expr));
+  spec = ffebld_symter_specific (ffebld_left (*expr));
+  assert (spec != FFEINTRIN_specNONE);
+
+  if (gen != FFEINTRIN_genNONE)
+    name = ffeintrin_gens_[gen].name;
+  else
+    name = ffeintrin_specs_[spec].name;
+
+  state = ffeintrin_state_family (ffeintrin_specs_[spec].family);
+
+  imp = ffeintrin_specs_[spec].implementation;
+  if (check_intrin != NULL)
+    *check_intrin = FALSE;
+
+  any = ffeintrin_check_any_ (ffebld_right (*expr));
+
+  if (state == FFE_intrinsicstateDISABLED)
+    error = FFEBAD_INTRINSIC_DISABLED;
+  else if (imp == FFEINTRIN_impNONE)
+    error = FFEBAD_INTRINSIC_UNIMPL;
+  else if (!any)
+    {
+      error = ffeintrin_check_ (imp, ffebld_op (*expr),
+				ffebld_right (*expr),
+				&bt, &kt, &sz, check_intrin, t, TRUE);
+    }
+  else
+    error = FFEBAD;	/* Not really needed, but quiet -Wuninitialized. */
+
+  if (any || (error != FFEBAD))
+    {
+      if (!any)
+	{
+
+	  ffebad_start (error);
+	  ffebad_here (0, ffelex_token_where_line (t),
+		       ffelex_token_where_column (t));
+	  ffebad_string (name);
+	  ffebad_finish ();
+	}
+
+      *expr = ffebld_new_any ();
+      *info = ffeinfo_new_any ();
+    }
+  else
+    {
+      *info = ffeinfo_new (bt,
+			   kt,
+			   0,
+			   FFEINFO_kindENTITY,
+			   FFEINFO_whereFLEETING,
+			   sz);
+      symter = ffebld_left (*expr);
+      ffebld_set_info (symter,
+		       ffeinfo_new (bt,
+				    kt,
+				    0,
+				    (bt == FFEINFO_basictypeNONE)
+				    ? FFEINFO_kindSUBROUTINE
+				    : FFEINFO_kindFUNCTION,
+				    FFEINFO_whereINTRINSIC,
+				    sz));
+
+      if ((ffesymbol_attrs (ffebld_symter (symter)) & FFESYMBOL_attrsTYPE)
+	  && (((bt != ffesymbol_basictype (ffebld_symter (symter)))
+	       || (kt != ffesymbol_kindtype (ffebld_symter (symter)))
+	       || (sz != ffesymbol_size (ffebld_symter (symter))))))
+	{
+	  ffebad_start (FFEBAD_INTRINSIC_TYPE);
+	  ffebad_here (0, ffelex_token_where_line (t),
+		       ffelex_token_where_column (t));
+	  ffebad_string (name);
+	  ffebad_finish ();
+	}
+      if (ffeintrin_imps_[imp].y2kbad)
+	{
+	  ffebad_start (FFEBAD_INTRINSIC_Y2KBAD);
+	  ffebad_here (0, ffelex_token_where_line (t),
+		       ffelex_token_where_column (t));
+	  ffebad_string (name);
+	  ffebad_finish ();
+	}
+    }
+}
+
+/* Return run-time index of intrinsic implementation as direct call.  */
+
+ffecomGfrt
+ffeintrin_gfrt_direct (ffeintrinImp imp)
+{
+  assert (imp < FFEINTRIN_imp);
+
+  return ffeintrin_imps_[imp].gfrt_direct;
+}
+
+/* Return run-time index of intrinsic implementation as actual argument.  */
+
+ffecomGfrt
+ffeintrin_gfrt_indirect (ffeintrinImp imp)
+{
+  assert (imp < FFEINTRIN_imp);
+
+  if (! ffe_is_f2c ())
+    return ffeintrin_imps_[imp].gfrt_gnu;
+  return ffeintrin_imps_[imp].gfrt_f2c;
+}
+
+void
+ffeintrin_init_0 (void)
+{
+  int i;
+  const char *p1;
+  const char *p2;
+  const char *p3;
+  int colon;
+
+  if (!ffe_is_do_internal_checks ())
+    return;
+
+  assert (FFEINTRIN_gen == ARRAY_SIZE (ffeintrin_gens_));
+  assert (FFEINTRIN_imp == ARRAY_SIZE (ffeintrin_imps_));
+  assert (FFEINTRIN_spec == ARRAY_SIZE (ffeintrin_specs_));
+
+  for (i = 1; ((size_t) i) < ARRAY_SIZE (ffeintrin_names_); ++i)
+    {				/* Make sure binary-searched list is in alpha
+				   order. */
+      if (strcmp (ffeintrin_names_[i - 1].name_uc,
+		  ffeintrin_names_[i].name_uc) >= 0)
+	assert ("name list out of order" == NULL);
+    }
+
+  for (i = 0; ((size_t) i) < ARRAY_SIZE (ffeintrin_names_); ++i)
+    {
+      assert ((ffeintrin_names_[i].generic == FFEINTRIN_genNONE)
+	      || (ffeintrin_names_[i].specific == FFEINTRIN_specNONE));
+
+      p1 = ffeintrin_names_[i].name_uc;
+      p2 = ffeintrin_names_[i].name_lc;
+      p3 = ffeintrin_names_[i].name_ic;
+      for (; *p1 != '\0' && *p2 != '\0' && *p3 != '\0'; ++p1, ++p2, ++p3)
+	{
+	  if ((ISDIGIT (*p1) || (*p1 == '_')) && (*p1 == *p2) && (*p1 == *p3))
+	    continue;
+	  if (! ISUPPER ((unsigned char)*p1) || ! ISLOWER ((unsigned char)*p2)
+	      || (*p1 != TOUPPER (*p2))
+	      || ((*p3 != *p1) && (*p3 != *p2)))
+	    break;
+	}
+      assert ((*p1 == *p2) && (*p1 == *p3) && (*p1 == '\0'));
+    }
+
+  for (i = 0; ((size_t) i) < ARRAY_SIZE (ffeintrin_imps_); ++i)
+    {
+      const char *c = ffeintrin_imps_[i].control;
+
+      if (c[0] == '\0')
+	continue;
+
+      if ((c[0] != '-')
+	  && (c[0] != 'A')
+	  && (c[0] != 'C')
+	  && (c[0] != 'I')
+	  && (c[0] != 'L')
+	  && (c[0] != 'R')
+	  && (c[0] != 'B')
+	  && (c[0] != 'F')
+	  && (c[0] != 'N')
+	  && (c[0] != 'S'))
+	{
+	  fprintf (stderr, "%s: bad return-base-type\n",
+		   ffeintrin_imps_[i].name);
+	  continue;
+	}
+      if ((c[1] != '-')
+	  && (c[1] != '=')
+	  && ((c[1] < '1')
+	      || (c[1] > '9'))
+	  && (c[1] != 'C'))
+	{
+	  fprintf (stderr, "%s: bad return-kind-type\n",
+		   ffeintrin_imps_[i].name);
+	  continue;
+	}
+      if (c[2] == ':')
+	colon = 2;
+      else
+	{
+	  if (c[2] != '*')
+	    {
+	      fprintf (stderr, "%s: bad return-modifier\n",
+		       ffeintrin_imps_[i].name);
+	      continue;
+	    }
+	  colon = 3;
+	}
+      if ((c[colon] != ':') || (c[colon + 2] != ':'))
+	{
+	  fprintf (stderr, "%s: bad control\n",
+		   ffeintrin_imps_[i].name);
+	  continue;
+	}
+      if ((c[colon + 1] != '-')
+	  && (c[colon + 1] != '*')
+	  && (! ISDIGIT (c[colon + 1])))
+	{
+	  fprintf (stderr, "%s: bad COL-spec\n",
+		   ffeintrin_imps_[i].name);
+	  continue;
+	}
+      c += (colon + 3);
+      while (c[0] != '\0')
+	{
+	  while ((c[0] != '=')
+		 && (c[0] != ',')
+		 && (c[0] != '\0'))
+	    ++c;
+	  if (c[0] != '=')
+	    {
+	      fprintf (stderr, "%s: bad keyword\n",
+		       ffeintrin_imps_[i].name);
+	      break;
+	    }
+	  if ((c[1] == '?')
+	      || (c[1] == '!')
+	      || (c[1] == '+')
+	      || (c[1] == '*')
+	      || (c[1] == 'n')
+	      || (c[1] == 'p'))
+	    ++c;
+	  if ((c[1] != '-')
+	      && (c[1] != 'A')
+	      && (c[1] != 'C')
+	      && (c[1] != 'I')
+	      && (c[1] != 'L')
+	      && (c[1] != 'R')
+	      && (c[1] != 'B')
+	      && (c[1] != 'F')
+	      && (c[1] != 'N')
+	      && (c[1] != 'S')
+	      && (c[1] != 'g')
+	      && (c[1] != 's'))
+	    {
+	      fprintf (stderr, "%s: bad arg-base-type\n",
+		       ffeintrin_imps_[i].name);
+	      break;
+	    }
+	  if ((c[2] != '*')
+	      && ((c[2] < '1')
+		  || (c[2] > '9'))
+	      && (c[2] != 'A'))
+	    {
+	      fprintf (stderr, "%s: bad arg-kind-type\n",
+		       ffeintrin_imps_[i].name);
+	      break;
+	    }
+	  if (c[3] == '[')
+	    {
+	      if ((! ISDIGIT (c[4]))
+		  || ((c[5] != ']')
+		      && (++c, ! ISDIGIT (c[4])
+			  || (c[5] != ']'))))
+		{
+		  fprintf (stderr, "%s: bad arg-len\n",
+			   ffeintrin_imps_[i].name);
+		  break;
+		}
+	      c += 3;
+	    }
+	  if (c[3] == '(')
+	    {
+	      if ((! ISDIGIT (c[4]))
+		  || ((c[5] != ')')
+		      && (++c, ! ISDIGIT (c[4])
+			  || (c[5] != ')'))))
+		{
+		  fprintf (stderr, "%s: bad arg-rank\n",
+			   ffeintrin_imps_[i].name);
+		  break;
+		}
+	      c += 3;
+	    }
+	  else if ((c[3] == '&')
+		   && (c[4] == '&'))
+	    ++c;
+	  if ((c[3] == '&')
+	      || (c[3] == 'i')
+	      || (c[3] == 'w')
+	      || (c[3] == 'x'))
+	    ++c;
+	  if (c[3] == ',')
+	    {
+	      c += 4;
+	      continue;
+	    }
+	  if (c[3] != '\0')
+	    {
+	      fprintf (stderr, "%s: bad arg-list\n",
+		       ffeintrin_imps_[i].name);
+	    }
+	  break;
+	}
+    }
+}
+
+/* Determine whether intrinsic is okay as an actual argument.  */
+
+bool
+ffeintrin_is_actualarg (ffeintrinSpec spec)
+{
+  ffeIntrinsicState state;
+
+  if (spec >= FFEINTRIN_spec)
+    return FALSE;
+
+  state = ffeintrin_state_family (ffeintrin_specs_[spec].family);
+
+  return (!ffe_is_pedantic () || ffeintrin_specs_[spec].is_actualarg)
+    && (ffe_is_f2c ()
+	? (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt_f2c
+	   != FFECOM_gfrt)
+	: (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt_gnu
+	   != FFECOM_gfrt))
+    && ((state == FFE_intrinsicstateENABLED)
+	|| (state == FFE_intrinsicstateHIDDEN));
+}
+
+/* Determine if name is intrinsic, return info.
+
+   const char *name;		// C-string name of possible intrinsic.
+   ffelexToken t;		// NULL if no diagnostic to be given.
+   bool explicit;		// TRUE if INTRINSIC name.
+   ffeintrinGen gen;		// (TRUE only) Generic id of intrinsic.
+   ffeintrinSpec spec;		// (TRUE only) Specific id of intrinsic.
+   ffeintrinImp imp;		// (TRUE only) Implementation id of intrinsic.
+   if (ffeintrin_is_intrinsic (name, t, explicit,
+			       &gen, &spec, &imp))
+				// is an intrinsic, use gen, spec, imp, and
+				// kind accordingly.  */
+
+bool
+ffeintrin_is_intrinsic (const char *name, ffelexToken t, bool explicit,
+			ffeintrinGen *xgen, ffeintrinSpec *xspec,
+			ffeintrinImp *ximp)
+{
+  struct _ffeintrin_name_ *intrinsic;
+  ffeintrinGen gen;
+  ffeintrinSpec spec;
+  ffeintrinImp imp;
+  ffeIntrinsicState state;
+  bool disabled = FALSE;
+  bool unimpl = FALSE;
+
+  intrinsic = bsearch (name, &ffeintrin_names_[0],
+		       ARRAY_SIZE (ffeintrin_names_),
+		       sizeof (struct _ffeintrin_name_),
+		         (void *) ffeintrin_cmp_name_);
+
+  if (intrinsic == NULL)
+    return FALSE;
+
+  gen = intrinsic->generic;
+  spec = intrinsic->specific;
+  imp = ffeintrin_specs_[spec].implementation;
+
+  /* Generic is okay only if at least one of its specifics is okay.  */
+
+  if (gen != FFEINTRIN_genNONE)
+    {
+      int i;
+      ffeintrinSpec tspec;
+      bool ok = FALSE;
+
+      name = ffeintrin_gens_[gen].name;
+
+      for (i = 0;
+	   (((size_t) i) < ARRAY_SIZE (ffeintrin_gens_[gen].specs))
+	   && ((tspec
+		= ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE);
+	   ++i)
+	{
+	  state = ffeintrin_state_family (ffeintrin_specs_[tspec].family);
+
+	  if (state == FFE_intrinsicstateDELETED)
+	    continue;
+
+	  if (state == FFE_intrinsicstateDISABLED)
+	    {
+	      disabled = TRUE;
+	      continue;
+	    }
+
+	  if (ffeintrin_specs_[tspec].implementation == FFEINTRIN_impNONE)
+	    {
+	      unimpl = TRUE;
+	      continue;
+	    }
+
+	  if ((state == FFE_intrinsicstateENABLED)
+	      || (explicit
+		  && (state == FFE_intrinsicstateHIDDEN)))
+	    {
+	      ok = TRUE;
+	      break;
+	    }
+	}
+      if (!ok)
+	gen = FFEINTRIN_genNONE;
+    }
+
+  /* Specific is okay only if not: unimplemented, disabled, deleted, or
+     hidden and not explicit.  */
+
+  if (spec != FFEINTRIN_specNONE)
+    {
+      if (gen != FFEINTRIN_genNONE)
+	name = ffeintrin_gens_[gen].name;
+      else
+	name = ffeintrin_specs_[spec].name;
+
+      if (((state = ffeintrin_state_family (ffeintrin_specs_[spec].family))
+	   == FFE_intrinsicstateDELETED)
+	  || (!explicit
+	      && (state == FFE_intrinsicstateHIDDEN)))
+	spec = FFEINTRIN_specNONE;
+      else if (state == FFE_intrinsicstateDISABLED)
+	{
+	  disabled = TRUE;
+	  spec = FFEINTRIN_specNONE;
+	}
+      else if (imp == FFEINTRIN_impNONE)
+	{
+	  unimpl = TRUE;
+	  spec = FFEINTRIN_specNONE;
+	}
+    }
+
+  /* If neither is okay, not an intrinsic.  */
+
+  if ((gen == FFEINTRIN_genNONE) && (spec == FFEINTRIN_specNONE))
+    {
+      /* Here is where we produce a diagnostic about a reference to a
+	 disabled or unimplemented intrinsic, if the diagnostic is desired.  */
+
+      if ((disabled || unimpl)
+	  && (t != NULL))
+	{
+	  ffebad_start (disabled
+			? FFEBAD_INTRINSIC_DISABLED
+			: FFEBAD_INTRINSIC_UNIMPLW);
+	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
+	  ffebad_string (name);
+	  ffebad_finish ();
+	}
+
+      return FALSE;
+    }
+
+  /* Determine whether intrinsic is function or subroutine.  If no specific
+     id, scan list of possible specifics for generic to get consensus.  If
+     not unanimous, or clear from the context, return NONE.  */
+
+  if (spec == FFEINTRIN_specNONE)
+    {
+      int i;
+      ffeintrinSpec tspec;
+      ffeintrinImp timp;
+      bool at_least_one_ok = FALSE;
+
+      for (i = 0;
+	   (((size_t) i) < ARRAY_SIZE (ffeintrin_gens_[gen].specs))
+	   && ((tspec
+		= ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE);
+	   ++i)
+	{
+	  if (((state = ffeintrin_state_family (ffeintrin_specs_[tspec].family))
+	       == FFE_intrinsicstateDELETED)
+	      || (state == FFE_intrinsicstateDISABLED))
+	    continue;
+
+	  if ((timp = ffeintrin_specs_[tspec].implementation)
+	      == FFEINTRIN_impNONE)
+	    continue;
+
+	  at_least_one_ok = TRUE;
+	  break;
+	}
+
+      if (!at_least_one_ok)
+	{
+	  *xgen = FFEINTRIN_genNONE;
+	  *xspec = FFEINTRIN_specNONE;
+	  *ximp = FFEINTRIN_impNONE;
+	  return FALSE;
+	}
+    }
+
+  *xgen = gen;
+  *xspec = spec;
+  *ximp = imp;
+  return TRUE;
+}
+
+/* Return TRUE if intrinsic is standard F77 (or, if -ff90, F90).  */
+
+bool
+ffeintrin_is_standard (ffeintrinGen gen, ffeintrinSpec spec)
+{
+  if (spec == FFEINTRIN_specNONE)
+    {
+      if (gen == FFEINTRIN_genNONE)
+	return FALSE;
+
+      spec = ffeintrin_gens_[gen].specs[0];
+      if (spec == FFEINTRIN_specNONE)
+	return FALSE;
+    }
+
+  if ((ffeintrin_specs_[spec].family == FFEINTRIN_familyF77)
+      || (ffe_is_90 ()
+	  && ((ffeintrin_specs_[spec].family == FFEINTRIN_familyF90)
+	      || (ffeintrin_specs_[spec].family == FFEINTRIN_familyMIL)
+	      || (ffeintrin_specs_[spec].family == FFEINTRIN_familyASC))))
+    return TRUE;
+  return FALSE;
+}
+
+/* Return kind type of intrinsic implementation.  See ffeintrin_basictype,
+   its sibling.  */
+
+ffeinfoKindtype
+ffeintrin_kindtype (ffeintrinSpec spec)
+{
+  ffeintrinImp imp;
+  ffecomGfrt gfrt;
+
+  assert (spec < FFEINTRIN_spec);
+  imp = ffeintrin_specs_[spec].implementation;
+  assert (imp < FFEINTRIN_imp);
+
+  if (ffe_is_f2c ())
+    gfrt = ffeintrin_imps_[imp].gfrt_f2c;
+  else
+    gfrt = ffeintrin_imps_[imp].gfrt_gnu;
+
+  assert (gfrt != FFECOM_gfrt);
+
+  return ffecom_gfrt_kindtype (gfrt);
+}
+
+/* Return name of generic intrinsic.  */
+
+const char *
+ffeintrin_name_generic (ffeintrinGen gen)
+{
+  assert (gen < FFEINTRIN_gen);
+  return ffeintrin_gens_[gen].name;
+}
+
+/* Return name of intrinsic implementation.  */
+
+const char *
+ffeintrin_name_implementation (ffeintrinImp imp)
+{
+  assert (imp < FFEINTRIN_imp);
+  return ffeintrin_imps_[imp].name;
+}
+
+/* Return external/internal name of specific intrinsic.	 */
+
+const char *
+ffeintrin_name_specific (ffeintrinSpec spec)
+{
+  assert (spec < FFEINTRIN_spec);
+  return ffeintrin_specs_[spec].name;
+}
+
+/* Return state of family.  */
+
+ffeIntrinsicState
+ffeintrin_state_family (ffeintrinFamily family)
+{
+  ffeIntrinsicState state;
+
+  switch (family)
+    {
+    case FFEINTRIN_familyNONE:
+      return FFE_intrinsicstateDELETED;
+
+    case FFEINTRIN_familyF77:
+      return FFE_intrinsicstateENABLED;
+
+    case FFEINTRIN_familyASC:
+      state = ffe_intrinsic_state_f2c ();
+      state = ffe_state_max (state, ffe_intrinsic_state_f90 ());
+      return state;
+
+    case FFEINTRIN_familyMIL:
+      state = ffe_intrinsic_state_vxt ();
+      state = ffe_state_max (state, ffe_intrinsic_state_f90 ());
+      state = ffe_state_max (state, ffe_intrinsic_state_mil ());
+      return state;
+
+    case FFEINTRIN_familyGNU:
+      state = ffe_intrinsic_state_gnu ();
+      return state;
+
+    case FFEINTRIN_familyF90:
+      state = ffe_intrinsic_state_f90 ();
+      return state;
+
+    case FFEINTRIN_familyVXT:
+      state = ffe_intrinsic_state_vxt ();
+      return state;
+
+    case FFEINTRIN_familyFVZ:
+      state = ffe_intrinsic_state_f2c ();
+      state = ffe_state_max (state, ffe_intrinsic_state_vxt ());
+      return state;
+
+    case FFEINTRIN_familyF2C:
+      state = ffe_intrinsic_state_f2c ();
+      return state;
+
+    case FFEINTRIN_familyF2U:
+      state = ffe_intrinsic_state_unix ();
+      return state;
+
+    case FFEINTRIN_familyBADU77:
+      state = ffe_intrinsic_state_badu77 ();
+      return state;
+
+    default:
+      assert ("bad family" == NULL);
+      return FFE_intrinsicstateDELETED;
+    }
+}
diff --git a/gcc/f/intrin.def b/gcc/f/intrin.def
new file mode 100644
index 00000000000..5d712ba21c0
--- /dev/null
+++ b/gcc/f/intrin.def
@@ -0,0 +1,3358 @@
+/* intrin.def -- Public #include File (module.h template V1.0)
+   The Free Software Foundation has released this file into the
+   public domain.
+
+   Owning Modules:
+      intrin.c
+
+   Modifications:
+*/
+
+/* Intrinsic names listed in alphabetical order, sorted by uppercase name.
+   This list is keyed to the names of intrinsics as seen in source code.  */
+
+DEFNAME	("ABORT",	"abort",	"Abort",	genNONE,	specABORT)	/* UNIX */
+DEFNAME	("ABS",		"abs",		"Abs",		genNONE,	specABS)
+DEFNAME	("ACCESS",	"access",	"Access",	genNONE,	specACCESS)	/* UNIX */
+DEFNAME	("ACHAR",	"achar",	"AChar",	genNONE,	specACHAR)	/* F90,	F2C */
+DEFNAME	("ACOS",	"acos",		"ACos",		genNONE,	specACOS)
+DEFNAME	("ACOSD",	"acosd",	"ACosD",	genNONE,	specACOSD)	/* VXT */
+DEFNAME	("ADJUSTL",	"adjustl",	"AdjustL",	genNONE,	specADJUSTL)	/* F90 */
+DEFNAME	("ADJUSTR",	"adjustr",	"AdjustR",	genNONE,	specADJUSTR)	/* F90 */
+DEFNAME	("AIMAG",	"aimag",	"AImag",	genNONE,	specAIMAG)
+DEFNAME	("AIMAX0",	"aimax0",	"AIMax0",	genNONE,	specAIMAX0)	/* VXT */
+DEFNAME	("AIMIN0",	"aimin0",	"AIMin0",	genNONE,	specAIMIN0)	/* VXT */
+DEFNAME	("AINT",	"aint",		"AInt",		genNONE,	specAINT)
+DEFNAME	("AJMAX0",	"ajmax0",	"AJMax0",	genNONE,	specAJMAX0)	/* VXT */
+DEFNAME	("AJMIN0",	"ajmin0",	"AJMin0",	genNONE,	specAJMIN0)	/* VXT */
+DEFNAME	("ALARM",	"alarm",	"Alarm",	genNONE,	specALARM)	/* UNIX */
+DEFNAME	("ALL",		"all",		"All",		genNONE,	specALL)	/* F90 */
+DEFNAME	("ALLOCATED",	"allocated",	"Allocated",	genNONE,	specALLOCATED)	/* F90 */
+DEFNAME	("ALOG",	"alog",		"ALog",		genNONE,	specALOG)
+DEFNAME	("ALOG10",	"alog10",	"ALog10",	genNONE,	specALOG10)
+DEFNAME	("AMAX0",	"amax0",	"AMax0",	genNONE,	specAMAX0)
+DEFNAME	("AMAX1",	"amax1",	"AMax1",	genNONE,	specAMAX1)
+DEFNAME	("AMIN0",	"amin0",	"AMin0",	genNONE,	specAMIN0)
+DEFNAME	("AMIN1",	"amin1",	"AMin1",	genNONE,	specAMIN1)
+DEFNAME	("AMOD",	"amod",		"AMod",		genNONE,	specAMOD)
+DEFNAME	("AND",		"and",		"And",		genNONE,	specAND)	/* F2C */
+DEFNAME	("ANINT",	"anint",	"ANInt",	genNONE,	specANINT)
+DEFNAME	("ANY",		"any",		"Any",		genNONE,	specANY)	/* F90 */
+DEFNAME	("ASIN",	"asin",		"ASin",		genNONE,	specASIN)
+DEFNAME	("ASIND",	"asind",	"ASinD",	genNONE,	specASIND)	/* VXT */
+DEFNAME	("ASSOCIATED",	"associated",	"Associated",	genNONE,	specASSOCIATED)	/* F90 */
+DEFNAME	("ATAN",	"atan",		"ATan",		genNONE,	specATAN)
+DEFNAME	("ATAN2",	"atan2",	"ATan2",	genNONE,	specATAN2)
+DEFNAME	("ATAN2D",	"atan2d",	"ATan2D",	genNONE,	specATAN2D)	/* VXT */
+DEFNAME	("ATAND",	"atand",	"ATanD",	genNONE,	specATAND)	/* VXT */
+DEFNAME	("BESJ0",	"besj0",	"BesJ0",	genNONE,	specBESJ0)	/* UNIX */
+DEFNAME	("BESJ1",	"besj1",	"BesJ1",	genNONE,	specBESJ1)	/* UNIX */
+DEFNAME	("BESJN",	"besjn",	"BesJN",	genNONE,	specBESJN)	/* UNIX */
+DEFNAME	("BESY0",	"besy0",	"BesY0",	genNONE,	specBESY0)	/* UNIX */
+DEFNAME	("BESY1",	"besy1",	"BesY1",	genNONE,	specBESY1)	/* UNIX */
+DEFNAME	("BESYN",	"besyn",	"BesYN",	genNONE,	specBESYN)	/* UNIX */
+DEFNAME	("BITEST",	"bitest",	"BITest",	genNONE,	specBITEST)	/* VXT */
+DEFNAME	("BIT_SIZE",	"bit_size",	"Bit_Size",	genNONE,	specBIT_SIZE)	/* F90 */
+DEFNAME	("BJTEST",	"bjtest",	"BJTest",	genNONE,	specBJTEST)	/* VXT */
+DEFNAME	("BTEST",	"btest",	"BTest",	genNONE,	specBTEST)	/* F90,	VXT */
+DEFNAME	("CABS",	"cabs",		"CAbs",		genNONE,	specCABS)
+DEFNAME	("CCOS",	"ccos",		"CCos",		genNONE,	specCCOS)
+DEFNAME	("CDABS",	"cdabs",	"CDAbs",	genNONE,	specCDABS)	/* VXT */
+DEFNAME	("CDCOS",	"cdcos",	"CDCos",	genNONE,	specCDCOS)	/* VXT */
+DEFNAME	("CDEXP",	"cdexp",	"CDExp",	genNONE,	specCDEXP)	/* VXT */
+DEFNAME	("CDLOG",	"cdlog",	"CDLog",	genNONE,	specCDLOG)	/* VXT */
+DEFNAME	("CDSIN",	"cdsin",	"CDSin",	genNONE,	specCDSIN)	/* VXT */
+DEFNAME	("CDSQRT",	"cdsqrt",	"CDSqRt",	genNONE,	specCDSQRT)	/* VXT */
+DEFNAME	("CEILING",	"ceiling",	"Ceiling",	genNONE,	specCEILING)	/* F90 */
+DEFNAME	("CEXP",	"cexp",		"CExp",		genNONE,	specCEXP)
+DEFNAME	("CHAR",	"char",		"Char",		genNONE,	specCHAR)
+DEFNAME	("CHDIR",	"chdir",	"ChDir",	genCHDIR,	specNONE)	/* UNIX */
+DEFNAME	("CHMOD",	"chmod",	"ChMod",	genCHMOD,	specNONE)	/* UNIX */
+DEFNAME	("CLOG",	"clog",		"CLog",		genNONE,	specCLOG)
+DEFNAME	("CMPLX",	"cmplx",	"Cmplx",	genNONE,	specCMPLX)
+DEFNAME	("COMPLEX",	"complex",	"Complex",	genNONE,	specCOMPLEX)
+DEFNAME	("CONJG",	"conjg",	"Conjg",	genNONE,	specCONJG)
+DEFNAME	("COS",		"cos",		"Cos",		genNONE,	specCOS)
+DEFNAME	("COSD",	"cosd",		"CosD",		genNONE,	specCOSD)	/* VXT */
+DEFNAME	("COSH",	"cosh",		"CosH",		genNONE,	specCOSH)
+DEFNAME	("COUNT",	"count",	"Count",	genNONE,	specCOUNT)	/* F90 */
+DEFNAME	("CPU_TIME",	"cpu_time",	"CPU_Time",	genNONE,	specCPU_TIME)	/* F95 */
+DEFNAME	("CSHIFT",	"cshift",	"CShift",	genNONE,	specCSHIFT)	/* F90 */
+DEFNAME	("CSIN",	"csin",		"CSin",		genNONE,	specCSIN)
+DEFNAME	("CSQRT",	"csqrt",	"CSqRt",	genNONE,	specCSQRT)
+DEFNAME	("CTIME",	"ctime",	"CTime",	genCTIME,	specNONE)	/* UNIX */
+DEFNAME	("DABS",	"dabs",		"DAbs",		genNONE,	specDABS)
+DEFNAME	("DACOS",	"dacos",	"DACos",	genNONE,	specDACOS)
+DEFNAME	("DACOSD",	"dacosd",	"DACosD",	genNONE,	specDACOSD)	/* VXT */
+DEFNAME	("DASIN",	"dasin",	"DASin",	genNONE,	specDASIN)
+DEFNAME	("DASIND",	"dasind",	"DASinD",	genNONE,	specDASIND)	/* VXT */
+DEFNAME	("DATAN",	"datan",	"DATan",	genNONE,	specDATAN)
+DEFNAME	("DATAN2",	"datan2",	"DATan2",	genNONE,	specDATAN2)
+DEFNAME	("DATAN2D",	"datan2d",	"DATan2D",	genNONE,	specDATAN2D)	/* VXT */
+DEFNAME	("DATAND",	"datand",	"DATanD",	genNONE,	specDATAND)	/* VXT */
+DEFNAME	("DATE",	"date",		"Date",		genNONE,	specDATE)	/* VXT */
+DEFNAME	("DATE_AND_TIME",	"date_and_time",	"Date_and_Time",	genNONE,	specDATE_AND_TIME)	/* F90 */
+DEFNAME	("DBESJ0",	"dbesj0",	"DbesJ0",	genNONE,	specDBESJ0)	/* UNIX */
+DEFNAME	("DBESJ1",	"dbesj1",	"DbesJ1",	genNONE,	specDBESJ1)	/* UNIX */
+DEFNAME	("DBESJN",	"dbesjn",	"DbesJN",	genNONE,	specDBESJN)	/* UNIX */
+DEFNAME	("DBESY0",	"dbesy0",	"DbesY0",	genNONE,	specDBESY0)	/* UNIX */
+DEFNAME	("DBESY1",	"dbesy1",	"DbesY1",	genNONE,	specDBESY1)	/* UNIX */
+DEFNAME	("DBESYN",	"dbesyn",	"DbesYN",	genNONE,	specDBESYN)	/* UNIX */
+DEFNAME	("DBLE",	"dble",		"Dble",		genNONE,	specDBLE)
+DEFNAME	("DBLEQ",	"dbleq",	"DbleQ",	genNONE,	specDBLEQ)	/* VXT */
+DEFNAME	("DCMPLX",	"dcmplx",	"DCmplx",	genNONE,	specDCMPLX)	/* F2C,	VXT */
+DEFNAME	("DCONJG",	"dconjg",	"DConjg",	genNONE,	specDCONJG)	/* F2C,	VXT */
+DEFNAME	("DCOS",	"dcos",		"DCos",		genNONE,	specDCOS)
+DEFNAME	("DCOSD",	"dcosd",	"DCosD",	genNONE,	specDCOSD)	/* VXT */
+DEFNAME	("DCOSH",	"dcosh",	"DCosH",	genNONE,	specDCOSH)
+DEFNAME	("DDIM",	"ddim",		"DDiM",		genNONE,	specDDIM)
+DEFNAME	("DERF",	"derf",		"DErF",		genNONE,	specDERF)	/* UNIX */
+DEFNAME	("DERFC",	"derfc",	"DErFC",	genNONE,	specDERFC)	/* UNIX */
+DEFNAME	("DEXP",	"dexp",		"DExp",		genNONE,	specDEXP)
+DEFNAME	("DFLOAT",	"dfloat",	"DFloat",	genNONE,	specDFLOAT)	/* F2C,	VXT */
+DEFNAME	("DFLOTI",	"dfloti",	"DFlotI",	genNONE,	specDFLOTI)	/* VXT */
+DEFNAME	("DFLOTJ",	"dflotj",	"DFlotJ",	genNONE,	specDFLOTJ)	/* VXT */
+DEFNAME	("DIGITS",	"digits",	"Digits",	genNONE,	specDIGITS)	/* F90 */
+DEFNAME	("DIM",		"dim",		"DiM",		genNONE,	specDIM)
+DEFNAME	("DIMAG",	"dimag",	"DImag",	genNONE,	specDIMAG)	/* F2C, VXT */
+DEFNAME	("DINT",	"dint",		"DInt",		genNONE,	specDINT)
+DEFNAME	("DLOG",	"dlog",		"DLog",		genNONE,	specDLOG)
+DEFNAME	("DLOG10",	"dlog10",	"DLog10",	genNONE,	specDLOG10)
+DEFNAME	("DMAX1",	"dmax1",	"DMax1",	genNONE,	specDMAX1)
+DEFNAME	("DMIN1",	"dmin1",	"DMin1",	genNONE,	specDMIN1)
+DEFNAME	("DMOD",	"dmod",		"DMod",		genNONE,	specDMOD)
+DEFNAME	("DNINT",	"dnint",	"DNInt",	genNONE,	specDNINT)
+DEFNAME	("DOT_PRODUCT",	"dot_product",	"Dot_Product",	genNONE,	specDOT_PRODUCT)	/* F90 */
+DEFNAME	("DPROD",	"dprod",	"DProd",	genNONE,	specDPROD)
+DEFNAME	("DREAL",	"dreal",	"DReal",	genNONE,	specDREAL)	/* VXT */
+DEFNAME	("DSIGN",	"dsign",	"DSign",	genNONE,	specDSIGN)
+DEFNAME	("DSIN",	"dsin",		"DSin",		genNONE,	specDSIN)
+DEFNAME	("DSIND",	"dsind",	"DSinD",	genNONE,	specDSIND)	/* VXT */
+DEFNAME	("DSINH",	"dsinh",	"DSinH",	genNONE,	specDSINH)
+DEFNAME	("DSQRT",	"dsqrt",	"DSqRt",	genNONE,	specDSQRT)
+DEFNAME	("DTAN",	"dtan",		"DTan",		genNONE,	specDTAN)
+DEFNAME	("DTAND",	"dtand",	"DTanD",	genNONE,	specDTAND)	/* VXT */
+DEFNAME	("DTANH",	"dtanh",	"DTanH",	genNONE,	specDTANH)
+DEFNAME	("DTIME",	"dtime",	"DTime",	genDTIME,	specNONE)	/* UNIX */
+DEFNAME	("EOSHIFT",	"eoshift",	"EOShift",	genNONE,	specEOSHIFT)	/* F90 */
+DEFNAME	("EPSILON",	"epsilon",	"Epsilon",	genNONE,	specEPSILON)	/* F90 */
+DEFNAME	("ERF",		"erf",		"ErF",		genNONE,	specERF)	/* UNIX */
+DEFNAME	("ERFC",	"erfc",		"ErFC",		genNONE,	specERFC)	/* UNIX */
+DEFNAME	("ETIME",	"etime",	"ETime",	genETIME,	specNONE)	/* UNIX */
+DEFNAME	("EXIT",	"exit",		"Exit",		genNONE,	specEXIT)	/* UNIX */
+DEFNAME	("EXP",		"exp",		"Exp",		genNONE,	specEXP)
+DEFNAME	("EXPONENT",	"exponent",	"Exponent",	genNONE,	specEXPONENT)	/* F90 */
+DEFNAME	("FDATE",	"fdate",	"FDate",	genFDATE,	specNONE)	/* UNIX */
+DEFNAME	("FGET",	"fget",		"FGet",		genFGET,	specNONE)	/* UNIX */
+DEFNAME	("FGETC",	"fgetc",	"FGetC",	genFGETC,	specNONE)	/* UNIX */
+DEFNAME	("FLOAT",	"float",	"Float",	genNONE,	specFLOAT)
+DEFNAME	("FLOATI",	"floati",	"FloatI",	genNONE,	specFLOATI)	/* VXT */
+DEFNAME	("FLOATJ",	"floatj",	"FloatJ",	genNONE,	specFLOATJ)	/* VXT */
+DEFNAME	("FLOOR",	"floor",	"Floor",	genNONE,	specFLOOR)	/* F90 */
+DEFNAME	("FLUSH",	"flush",	"Flush",	genNONE,	specFLUSH)	/* UNIX */
+DEFNAME	("FNUM",	"fnum",		"FNum",		genNONE,	specFNUM)	/* UNIX */
+DEFNAME	("FPABSP",	"fpabsp",	"FPAbsP",	genFPABSP,	specNONE)	/* F2C */
+DEFNAME	("FPEXPN",	"fpexpn",	"FPExpn",	genFPEXPN,	specNONE)	/* F2C */
+DEFNAME	("FPFRAC",	"fpfrac",	"FPFrac",	genFPFRAC,	specNONE)	/* F2C */
+DEFNAME	("FPMAKE",	"fpmake",	"FPMake",	genFPMAKE,	specNONE)	/* F2C */
+DEFNAME	("FPRRSP",	"fprrsp",	"FPRRSp",	genFPRRSP,	specNONE)	/* F2C */
+DEFNAME	("FPSCAL",	"fpscal",	"FPScal",	genFPSCAL,	specNONE)	/* F2C */
+DEFNAME	("FPUT",	"fput",		"FPut",		genFPUT,	specNONE)	/* UNIX */
+DEFNAME	("FPUTC",	"fputc",	"FPutC",	genFPUTC,	specNONE)	/* UNIX */
+DEFNAME	("FRACTION",	"fraction",	"Fraction",	genNONE,	specFRACTION)	/* F90 */
+DEFNAME	("FSEEK",	"fseek",	"FSeek",	genNONE,	specFSEEK)	/* UNIX */
+DEFNAME	("FSTAT",	"fstat",	"FStat",	genFSTAT,	specNONE)	/* UNIX */
+DEFNAME	("FTELL",	"ftell",	"FTell",	genFTELL,	specNONE)	/* UNIX */
+DEFNAME	("GERROR",	"gerror",	"GError",	genNONE,	specGERROR)	/* UNIX */
+DEFNAME	("GETARG",	"getarg",	"GetArg",	genNONE,	specGETARG)	/* UNIX */
+DEFNAME	("GETCWD",	"getcwd",	"GetCWD",	genGETCWD,	specNONE)	/* UNIX */
+DEFNAME	("GETENV",	"getenv",	"GetEnv",	genNONE,	specGETENV)	/* UNIX */
+DEFNAME	("GETGID",	"getgid",	"GetGId",	genNONE,	specGETGID)	/* UNIX */
+DEFNAME	("GETLOG",	"getlog",	"GetLog",	genNONE,	specGETLOG)	/* UNIX */
+DEFNAME	("GETPID",	"getpid",	"GetPId",	genNONE,	specGETPID)	/* UNIX */
+DEFNAME	("GETUID",	"getuid",	"GetUId",	genNONE,	specGETUID)	/* UNIX */
+DEFNAME	("GMTIME",	"gmtime",	"GMTime",	genNONE,	specGMTIME)	/* UNIX */
+DEFNAME	("HOSTNM",	"hostnm",	"HostNm",	genHOSTNM,	specNONE)	/* UNIX */
+DEFNAME	("HUGE",	"huge",		"Huge",		genNONE,	specHUGE)	/* F90 */
+DEFNAME	("IABS",	"iabs",		"IAbs",		genNONE,	specIABS)
+DEFNAME	("IACHAR",	"iachar",	"IAChar",	genNONE,	specIACHAR)	/* F90,	F2C */
+DEFNAME	("IAND",	"iand",		"IAnd",		genNONE,	specIAND)	/* F90,	VXT */
+DEFNAME	("IARGC",	"iargc",	"IArgC",	genNONE,	specIARGC)	/* UNIX */
+DEFNAME	("IBCLR",	"ibclr",	"IBClr",	genNONE,	specIBCLR)	/* F90,	VXT */
+DEFNAME	("IBITS",	"ibits",	"IBits",	genNONE,	specIBITS)	/* F90,	VXT */
+DEFNAME	("IBSET",	"ibset",	"IBSet",	genNONE,	specIBSET)	/* F90,	VXT */
+DEFNAME	("ICHAR",	"ichar",	"IChar",	genNONE,	specICHAR)
+DEFNAME	("IDATE",	"idate",	"IDate",	genIDATE,	specNONE)	/* UNIX, VXT */
+DEFNAME	("IDIM",	"idim",		"IDiM",		genNONE,	specIDIM)
+DEFNAME	("IDINT",	"idint",	"IDInt",	genNONE,	specIDINT)
+DEFNAME	("IDNINT",	"idnint",	"IDNInt",	genNONE,	specIDNINT)
+DEFNAME	("IEOR",	"ieor",		"IEOr",		genNONE,	specIEOR)	/* F90,	VXT */
+DEFNAME	("IERRNO",	"ierrno",	"IErrNo",	genNONE,	specIERRNO)	/* UNIX */
+DEFNAME	("IFIX",	"ifix",		"IFix",		genNONE,	specIFIX)
+DEFNAME	("IIABS",	"iiabs",	"IIAbs",	genNONE,	specIIABS)	/* VXT */
+DEFNAME	("IIAND",	"iiand",	"IIAnd",	genNONE,	specIIAND)	/* VXT */
+DEFNAME	("IIBCLR",	"iibclr",	"IIBClr",	genNONE,	specIIBCLR)	/* VXT */
+DEFNAME	("IIBITS",	"iibits",	"IIBits",	genNONE,	specIIBITS)	/* VXT */
+DEFNAME	("IIBSET",	"iibset",	"IIBSet",	genNONE,	specIIBSET)	/* VXT */
+DEFNAME	("IIDIM",	"iidim",	"IIDiM",	genNONE,	specIIDIM)	/* VXT */
+DEFNAME	("IIDINT",	"iidint",	"IIDInt",	genNONE,	specIIDINT)	/* VXT */
+DEFNAME	("IIDNNT",	"iidnnt",	"IIDNnt",	genNONE,	specIIDNNT)	/* VXT */
+DEFNAME	("IIEOR",	"iieor",	"IIEOr",	genNONE,	specIIEOR)	/* VXT */
+DEFNAME	("IIFIX",	"iifix",	"IIFix",	genNONE,	specIIFIX)	/* VXT */
+DEFNAME	("IINT",	"iint",		"IInt",		genNONE,	specIINT)	/* VXT */
+DEFNAME	("IIOR",	"iior",		"IIOr",		genNONE,	specIIOR)	/* VXT */
+DEFNAME	("IIQINT",	"iiqint",	"IIQint",	genNONE,	specIIQINT)	/* VXT */
+DEFNAME	("IIQNNT",	"iiqnnt",	"IIQNnt",	genNONE,	specIIQNNT)	/* VXT */
+DEFNAME	("IISHFT",	"iishft",	"IIShft",	genNONE,	specNONE)	/* VXT */
+DEFNAME	("IISHFTC",	"iishftc",	"IIShftC",	genNONE,	specIISHFTC)	/* VXT */
+DEFNAME	("IISIGN",	"iisign",	"IISign",	genNONE,	specIISIGN)	/* VXT */
+DEFNAME	("IMAG",	"imag",		"Imag",		genNONE,	specIMAG)	/* F2C */
+DEFNAME	("IMAGPART",	"imagpart",	"ImagPart",	genNONE,	specIMAGPART)	/* GNU */
+DEFNAME	("IMAX0",	"imax0",	"IMax0",	genNONE,	specIMAX0)	/* VXT */
+DEFNAME	("IMAX1",	"imax1",	"IMax1",	genNONE,	specIMAX1)	/* VXT */
+DEFNAME	("IMIN0",	"imin0",	"IMin0",	genNONE,	specIMIN0)	/* VXT */
+DEFNAME	("IMIN1",	"imin1",	"IMin1",	genNONE,	specIMIN1)	/* VXT */
+DEFNAME	("IMOD",	"imod",		"IMod",		genNONE,	specIMOD)	/* VXT */
+DEFNAME	("INDEX",	"index",	"Index",	genNONE,	specINDEX)
+DEFNAME	("ININT",	"inint",	"INInt",	genNONE,	specININT)	/* VXT */
+DEFNAME	("INOT",	"inot",		"INot",		genNONE,	specINOT)	/* VXT */
+DEFNAME	("INT",		"int",		"Int",		genNONE,	specINT)
+DEFNAME	("INT2",	"int2",		"Int2",		genNONE,	specINT2)	/* MS */
+DEFNAME	("INT8",	"int8",		"Int8",		genNONE,	specINT8)	/* GNU */
+DEFNAME	("IOR",		"ior",		"IOr",		genNONE,	specIOR)	/* F90,	VXT */
+DEFNAME	("IRAND",	"irand",	"IRand",	genNONE,	specIRAND)	/* UNIX */
+DEFNAME	("ISATTY",	"isatty",	"IsaTty",	genNONE,	specISATTY)	/* UNIX */
+DEFNAME	("ISHFT",	"ishft",	"IShft",	genNONE,	specISHFT)	/* F90 */
+DEFNAME	("ISHFTC",	"ishftc",	"IShftC",	genNONE,	specISHFTC)	/* F90,	VXT */
+DEFNAME	("ISIGN",	"isign",	"ISign",	genNONE,	specISIGN)
+DEFNAME	("ITIME",	"itime",	"ITime",	genNONE,	specITIME)	/* UNIX */
+DEFNAME	("IZEXT",	"izext",	"IZExt",	genNONE,	specIZEXT)	/* VXT */
+DEFNAME	("JIABS",	"jiabs",	"JIAbs",	genNONE,	specJIABS)	/* VXT */
+DEFNAME	("JIAND",	"jiand",	"JIAnd",	genNONE,	specJIAND)	/* VXT */
+DEFNAME	("JIBCLR",	"jibclr",	"JIBClr",	genNONE,	specJIBCLR)	/* VXT */
+DEFNAME	("JIBITS",	"jibits",	"JIBits",	genNONE,	specJIBITS)	/* VXT */
+DEFNAME	("JIBSET",	"jibset",	"JIBSet",	genNONE,	specJIBSET)	/* VXT */
+DEFNAME	("JIDIM",	"jidim",	"JIDiM",	genNONE,	specJIDIM)	/* VXT */
+DEFNAME	("JIDINT",	"jidint",	"JIDInt",	genNONE,	specJIDINT)	/* VXT */
+DEFNAME	("JIDNNT",	"jidnnt",	"JIDNnt",	genNONE,	specJIDNNT)	/* VXT */
+DEFNAME	("JIEOR",	"jieor",	"JIEOr",	genNONE,	specJIEOR)	/* VXT */
+DEFNAME	("JIFIX",	"jifix",	"JIFix",	genNONE,	specJIFIX)	/* VXT */
+DEFNAME	("JINT",	"jint",		"JInt",		genNONE,	specJINT)	/* VXT */
+DEFNAME	("JIOR",	"jior",		"JIOr",		genNONE,	specJIOR)	/* VXT */
+DEFNAME	("JIQINT",	"jiqint",	"JIQint",	genNONE,	specJIQINT)	/* VXT */
+DEFNAME	("JIQNNT",	"jiqnnt",	"JIQNnt",	genNONE,	specJIQNNT)	/* VXT */
+DEFNAME	("JISHFT",	"jishft",	"JIShft",	genNONE,	specJISHFT)	/* VXT */
+DEFNAME	("JISHFTC",	"jishftc",	"JIShftC",	genNONE,	specJISHFTC)	/* VXT */
+DEFNAME	("JISIGN",	"jisign",	"JISign",	genNONE,	specJISIGN)	/* VXT */
+DEFNAME	("JMAX0",	"jmax0",	"JMax0",	genNONE,	specJMAX0)	/* VXT */
+DEFNAME	("JMAX1",	"jmax1",	"JMax1",	genNONE,	specJMAX1)	/* VXT */
+DEFNAME	("JMIN0",	"jmin0",	"JMin0",	genNONE,	specJMIN0)	/* VXT */
+DEFNAME	("JMIN1",	"jmin1",	"JMin1",	genNONE,	specJMIN1)	/* VXT */
+DEFNAME	("JMOD",	"jmod",		"JMod",		genNONE,	specJMOD)	/* VXT */
+DEFNAME	("JNINT",	"jnint",	"JNInt",	genNONE,	specJNINT)	/* VXT */
+DEFNAME	("JNOT",	"jnot",		"JNot",		genNONE,	specJNOT)	/* VXT */
+DEFNAME	("JZEXT",	"jzext",	"JZExt",	genNONE,	specJZEXT)	/* VXT */
+DEFNAME	("KILL",	"kill",		"Kill",		genKILL,	specNONE)	/* UNIX */
+DEFNAME	("KIND",	"kind",		"Kind",		genNONE,	specKIND)	/* F90 */
+DEFNAME	("LBOUND",	"lbound",	"LBound",	genNONE,	specLBOUND)	/* F90 */
+DEFNAME	("LEN",		"len",		"Len",		genNONE,	specLEN)
+DEFNAME	("LEN_TRIM",	"len_trim",	"Len_Trim",	genNONE,	specLEN_TRIM)	/* F90 */
+DEFNAME	("LGE",		"lge",		"LGe",		genNONE,	specLGE)
+DEFNAME	("LGT",		"lgt",		"LGt",		genNONE,	specLGT)
+DEFNAME	("LINK",	"link",		"Link",		genLINK,	specNONE)	/* UNIX */
+DEFNAME	("LLE",		"lle",		"LLe",		genNONE,	specLLE)
+DEFNAME	("LLT",		"llt",		"LLt",		genNONE,	specLLT)
+DEFNAME	("LNBLNK",	"lnblnk",	"LnBlnk",	genNONE,	specLNBLNK)	/* UNIX */
+DEFNAME	("LOC",		"loc",		"Loc",		genNONE,	specLOC)	/* VXT */
+DEFNAME	("LOG",		"log",		"Log",		genNONE,	specLOG)
+DEFNAME	("LOG10",	"log10",	"Log10",	genNONE,	specLOG10)
+DEFNAME	("LOGICAL",	"logical",	"Logical",	genNONE,	specLOGICAL)	/* F90 */
+DEFNAME	("LONG",	"long",		"Long",		genNONE,	specLONG)	/* UNIX */
+DEFNAME	("LSHIFT",	"lshift",	"LShift",	genNONE,	specLSHIFT)	/* F2C */
+DEFNAME	("LSTAT",	"lstat",	"LStat",	genLSTAT,	specNONE)	/* UNIX */
+DEFNAME	("LTIME",	"ltime",	"LTime",	genNONE,	specLTIME)	/* UNIX */
+DEFNAME	("MATMUL",	"matmul",	"MatMul",	genNONE,	specMATMUL)	/* F90 */
+DEFNAME	("MAX",		"max",		"Max",		genNONE,	specMAX)
+DEFNAME	("MAX0",	"max0",		"Max0",		genNONE,	specMAX0)
+DEFNAME	("MAX1",	"max1",		"Max1",		genNONE,	specMAX1)
+DEFNAME	("MAXEXPONENT",	"maxexponent",	"MaxExponent",	genNONE,	specMAXEXPONENT)	/* F90 */
+DEFNAME	("MAXLOC",	"maxloc",	"MaxLoc",	genNONE,	specMAXLOC)	/* F90 */
+DEFNAME	("MAXVAL",	"maxval",	"MaxVal",	genNONE,	specMAXVAL)	/* F90 */
+DEFNAME	("MCLOCK",	"mclock",	"MClock",	genNONE,	specMCLOCK)	/* UNIX */
+DEFNAME	("MCLOCK8",	"mclock8",	"MClock8",	genNONE,	specMCLOCK8)	/* UNIX */
+DEFNAME	("MERGE",	"merge",	"Merge",	genNONE,	specMERGE)	/* F90 */
+DEFNAME	("MIN",		"min",		"Min",		genNONE,	specMIN)
+DEFNAME	("MIN0",	"min0",		"Min0",		genNONE,	specMIN0)
+DEFNAME	("MIN1",	"min1",		"Min1",		genNONE,	specMIN1)
+DEFNAME	("MINEXPONENT",	"minexponent",	"MinExponent",	genNONE,	specMINEXPONENT)	/* F90 */
+DEFNAME	("MINLOC",	"minloc",	"MinLoc",	genNONE,	specMINLOC)	/* F90 */
+DEFNAME	("MINVAL",	"minval",	"MinVal",	genNONE,	specMINVAL)	/* F90 */
+DEFNAME	("MOD",		"mod",		"Mod",		genNONE,	specMOD)
+DEFNAME	("MODULO",	"modulo",	"Modulo",	genNONE,	specMODULO)	/* F90 */
+DEFNAME	("MVBITS",	"mvbits",	"MvBits",	genNONE,	specMVBITS)	/* F90 */
+DEFNAME	("NEAREST",	"nearest",	"Nearest",	genNONE,	specNEAREST)	/* F90 */
+DEFNAME	("NINT",	"nint",		"NInt",		genNONE,	specNINT)
+DEFNAME	("NOT",		"not",		"Not",		genNONE,	specNOT)	/* F2C,	F90,	VXT */
+DEFNAME	("OR",		"or",		"Or",		genNONE,	specOR)	/* F2C */
+DEFNAME	("PACK",	"pack",		"Pack",		genNONE,	specPACK)	/* F90 */
+DEFNAME	("PERROR",	"perror",	"PError",	genNONE,	specPERROR)	/* UNIX */
+DEFNAME	("PRECISION",	"precision",	"Precision",	genNONE,	specPRECISION)	/* F90 */
+DEFNAME	("PRESENT",	"present",	"Present",	genNONE,	specPRESENT)	/* F90 */
+DEFNAME	("PRODUCT",	"product",	"Product",	genNONE,	specPRODUCT)	/* F90 */
+DEFNAME	("QABS",	"qabs",		"QAbs",		genNONE,	specQABS)	/* VXT */
+DEFNAME	("QACOS",	"qacos",	"QACos",	genNONE,	specQACOS)	/* VXT */
+DEFNAME	("QACOSD",	"qacosd",	"QACosD",	genNONE,	specQACOSD)	/* VXT */
+DEFNAME	("QASIN",	"qasin",	"QASin",	genNONE,	specQASIN)	/* VXT */
+DEFNAME	("QASIND",	"qasind",	"QASinD",	genNONE,	specQASIND)	/* VXT */
+DEFNAME	("QATAN",	"qatan",	"QATan",	genNONE,	specQATAN)	/* VXT */
+DEFNAME	("QATAN2",	"qatan2",	"QATan2",	genNONE,	specQATAN2)	/* VXT */
+DEFNAME	("QATAN2D",	"qatan2d",	"QATan2D",	genNONE,	specQATAN2D)	/* VXT */
+DEFNAME	("QATAND",	"qatand",	"QATanD",	genNONE,	specQATAND)	/* VXT */
+DEFNAME	("QCOS",	"qcos",		"QCos",		genNONE,	specQCOS)	/* VXT */
+DEFNAME	("QCOSD",	"qcosd",	"QCosD",	genNONE,	specQCOSD)	/* VXT */
+DEFNAME	("QCOSH",	"qcosh",	"QCosH",	genNONE,	specQCOSH)	/* VXT */
+DEFNAME	("QDIM",	"qdim",		"QDiM",		genNONE,	specQDIM)	/* VXT */
+DEFNAME	("QEXP",	"qexp",		"QExp",		genNONE,	specQEXP)	/* VXT */
+DEFNAME	("QEXT",	"qext",		"QExt",		genNONE,	specQEXT)	/* VXT */
+DEFNAME	("QEXTD",	"qextd",	"QExtD",	genNONE,	specQEXTD)	/* VXT */
+DEFNAME	("QFLOAT",	"qfloat",	"QFloat",	genNONE,	specQFLOAT)	/* VXT */
+DEFNAME	("QINT",	"qint",		"QInt",		genNONE,	specQINT)	/* VXT */
+DEFNAME	("QLOG",	"qlog",		"QLog",		genNONE,	specQLOG)	/* VXT */
+DEFNAME	("QLOG10",	"qlog10",	"QLog10",	genNONE,	specQLOG10)	/* VXT */
+DEFNAME	("QMAX1",	"qmax1",	"QMax1",	genNONE,	specQMAX1)	/* VXT */
+DEFNAME	("QMIN1",	"qmin1",	"QMin1",	genNONE,	specQMIN1)	/* VXT */
+DEFNAME	("QMOD",	"qmod",		"QMod",		genNONE,	specQMOD)	/* VXT */
+DEFNAME	("QNINT",	"qnint",	"QNInt",	genNONE,	specQNINT)	/* VXT */
+DEFNAME	("QSIN",	"qsin",		"QSin",		genNONE,	specQSIN)	/* VXT */
+DEFNAME	("QSIND",	"qsind",	"QSinD",	genNONE,	specQSIND)	/* VXT */
+DEFNAME	("QSINH",	"qsinh",	"QSinH",	genNONE,	specQSINH)	/* VXT */
+DEFNAME	("QSQRT",	"qsqrt",	"QSqRt",	genNONE,	specQSQRT)	/* VXT */
+DEFNAME	("QTAN",	"qtan",		"QTan",		genNONE,	specQTAN)	/* VXT */
+DEFNAME	("QTAND",	"qtand",	"QTanD",	genNONE,	specQTAND)	/* VXT */
+DEFNAME	("QTANH",	"qtanh",	"QTanH",	genNONE,	specQTANH)	/* VXT */
+DEFNAME	("RADIX",	"radix",	"Radix",	genNONE,	specRADIX)	/* F90 */
+DEFNAME	("RAND",	"rand",		"Rand",		genNONE,	specRAND)	/* UNIX */
+DEFNAME	("RANDOM_NUMBER",	"random_number",	"Random_Number",	genNONE,	specRANDOM_NUMBER)	/* F90 */
+DEFNAME	("RANDOM_SEED",	"random_seed",	"Random_Seed",	genNONE,	specRANDOM_SEED)	/* F90 */
+DEFNAME	("RANGE",	"range",	"Range",	genNONE,	specRANGE)	/* F90 */
+DEFNAME	("REAL",	"real",		"Real",		genNONE,	specREAL)
+DEFNAME	("REALPART",	"realpart",	"RealPart",	genNONE,	specREALPART)	/* GNU */
+DEFNAME	("RENAME",	"rename",	"Rename",	genRENAME,	specNONE)	/* UNIX */
+DEFNAME	("REPEAT",	"repeat",	"Repeat",	genNONE,	specREPEAT)	/* F90 */
+DEFNAME	("RESHAPE",	"reshape",	"Reshape",	genNONE,	specRESHAPE)	/* F90 */
+DEFNAME	("RRSPACING",	"rrspacing",	"RRSpacing",	genNONE,	specRRSPACING)	/* F90 */
+DEFNAME	("RSHIFT",	"rshift",	"RShift",	genNONE,	specRSHIFT)	/* F2C */
+DEFNAME	("SCALE",	"scale",	"Scale",	genNONE,	specSCALE)	/* F90 */
+DEFNAME	("SCAN",	"scan",		"Scan",		genNONE,	specSCAN)	/* F90 */
+DEFNAME	("SECNDS",	"secnds",	"Secnds",	genNONE,	specSECNDS)	/* VXT */
+DEFNAME	("SECOND",	"second",	"Second",	genSECOND,	specNONE)	/* UNIX */
+DEFNAME	("SELECTED_INT_KIND",	"selected_int_kind",	"Selected_Int_Kind",	genNONE,	specSEL_INT_KIND)	/* F90 */
+DEFNAME	("SELECTED_REAL_KIND",	"selected_real_kind",	"Selected_Real_Kind",	genNONE,	specSEL_REAL_KIND)	/* F90 */
+DEFNAME	("SET_EXPONENT",	"set_exponent",	"Set_Exponent",	genNONE,	specSET_EXPONENT)	/* F90 */
+DEFNAME	("SHAPE",	"shape",	"Shape",	genNONE,	specSHAPE)	/* F90 */
+DEFNAME	("SHORT",	"short",	"Short",	genNONE,	specSHORT)	/* UNIX */
+DEFNAME	("SIGN",	"sign",		"Sign",		genNONE,	specSIGN)
+DEFNAME	("SIGNAL",	"signal",	"Signal",	genSIGNAL,	specNONE)	/* UNIX */
+DEFNAME	("SIN",		"sin",		"Sin",		genNONE,	specSIN)
+DEFNAME	("SIND",	"sind",		"SinD",		genNONE,	specSIND)	/* VXT */
+DEFNAME	("SINH",	"sinh",		"SinH",		genNONE,	specSINH)
+DEFNAME	("SLEEP",	"sleep",	"Sleep",	genNONE,	specSLEEP)	/* UNIX */
+DEFNAME	("SNGL",	"sngl",		"Sngl",		genNONE,	specSNGL)
+DEFNAME	("SNGLQ",	"snglq",	"SnglQ",	genNONE,	specSNGLQ)	/* VXT */
+DEFNAME	("SPACING",	"spacing",	"Spacing",	genNONE,	specSPACING)	/* F90 */
+DEFNAME	("SPREAD",	"spread",	"Spread",	genNONE,	specSPREAD)	/* F90 */
+DEFNAME	("SQRT",	"sqrt",		"SqRt",		genNONE,	specSQRT)
+DEFNAME	("SRAND",	"srand",	"SRand",	genNONE,	specSRAND)	/* UNIX */
+DEFNAME	("STAT",	"stat",		"Stat",		genSTAT,	specNONE)	/* UNIX */
+DEFNAME	("SUM",		"sum",		"Sum",		genNONE,	specSUM)	/* F90 */
+DEFNAME	("SYMLNK",	"symlnk",	"SymLnk",	genSYMLNK,	specNONE)	/* UNIX */
+DEFNAME	("SYSTEM",	"system",	"System",	genSYSTEM,	specNONE)	/* UNIX */
+DEFNAME	("SYSTEM_CLOCK",	"system_clock",	"System_Clock",	genNONE,	specSYSTEM_CLOCK)	/* F90 */
+DEFNAME	("TAN",		"tan",		"Tan",		genNONE,	specTAN)
+DEFNAME	("TAND",	"tand",		"TanD",		genNONE,	specTAND)	/* VXT */
+DEFNAME	("TANH",	"tanh",		"TanH",		genNONE,	specTANH)
+DEFNAME	("TIME",	"time",		"Time",		genTIME,	specNONE)	/* UNIX, VXT */
+DEFNAME	("TIME8",	"time8",	"Time8",	genNONE,	specTIME8)	/* UNIX */
+DEFNAME	("TINY",	"tiny",		"Tiny",		genNONE,	specTINY)	/* F90 */
+DEFNAME	("TRANSFER",	"transfer",	"Transfer",	genNONE,	specTRANSFER)	/* F90 */
+DEFNAME	("TRANSPOSE",	"transpose",	"Transpose",	genNONE,	specTRANSPOSE)	/* F90 */
+DEFNAME	("TRIM",	"trim",		"Trim",		genNONE,	specTRIM)	/* F90 */
+DEFNAME	("TTYNAM",	"ttynam",	"TtyNam",	genTTYNAM,	specNONE)	/* UNIX */
+DEFNAME	("UBOUND",	"ubound",	"UBound",	genNONE,	specUBOUND)	/* F90 */
+DEFNAME	("UMASK",	"umask",	"UMask",	genUMASK,	specNONE)	/* UNIX */
+DEFNAME	("UNLINK",	"unlink",	"Unlink",	genUNLINK,	specNONE)	/* UNIX */
+DEFNAME	("UNPACK",	"unpack",	"Unpack",	genNONE,	specUNPACK)	/* F90 */
+DEFNAME	("VERIFY",	"verify",	"Verify",	genNONE,	specVERIFY)	/* F90 */
+DEFNAME	("XOR",		"xor",		"XOr",		genNONE,	specXOR)	/* F2C */
+DEFNAME	("ZABS",	"zabs",		"ZAbs",		genNONE,	specZABS)	/* F2C */
+DEFNAME	("ZCOS",	"zcos",		"ZCos",		genNONE,	specZCOS)	/* F2C */
+DEFNAME	("ZEXP",	"zexp",		"ZExp",		genNONE,	specZEXP)	/* F2C */
+DEFNAME	("ZEXT",	"zext",		"ZExt",		genNONE,	specZEXT)	/* VXT */
+DEFNAME	("ZLOG",	"zlog",		"ZLog",		genNONE,	specZLOG)	/* F2C */
+DEFNAME	("ZSIN",	"zsin",		"ZSin",		genNONE,	specZSIN)	/* F2C */
+DEFNAME	("ZSQRT",	"zsqrt",	"ZSqRt",	genNONE,	specZSQRT)	/* F2C */
+
+/* Internally generic intrinsics.
+
+   Should properly be called "mapped" intrinsics.  These are intrinsics
+   that map to one or more generally different implementations -- e.g.
+   that have differing interpretations depending on the Fortran dialect
+   being used.  Also, this includes the placeholder intrinsics that
+   have no specific versions, but we want to reserve the names for now.  */
+
+DEFGEN (CTIME, "CTIME",		/* UNIX */
+    FFEINTRIN_specCTIME_subr,
+    FFEINTRIN_specCTIME_func
+  )
+DEFGEN (CHDIR, "CHDIR", 	/* UNIX */
+    FFEINTRIN_specCHDIR_subr,
+    FFEINTRIN_specCHDIR_func
+  )
+DEFGEN (CHMOD, "CHMOD", 	/* UNIX */
+    FFEINTRIN_specCHMOD_subr,
+    FFEINTRIN_specCHMOD_func
+  )
+DEFGEN (DTIME, "DTIME", 	/* UNIX */
+    FFEINTRIN_specDTIME_subr,
+    FFEINTRIN_specDTIME_func
+  )
+DEFGEN (ETIME, "ETIME", 	/* UNIX */
+    FFEINTRIN_specETIME_subr,
+    FFEINTRIN_specETIME_func
+  )
+DEFGEN (FDATE, "FDATE", 	/* UNIX */
+    FFEINTRIN_specFDATE_subr,
+    FFEINTRIN_specFDATE_func
+  )
+DEFGEN (FGET, "FGET",	 	/* UNIX */
+    FFEINTRIN_specFGET_subr,
+    FFEINTRIN_specFGET_func
+  )
+DEFGEN (FGETC, "FGETC", 	/* UNIX */
+    FFEINTRIN_specFGETC_subr,
+    FFEINTRIN_specFGETC_func
+  )
+DEFGEN (FPABSP, "FPABSP",	/* F2C */
+    FFEINTRIN_specNONE,
+    FFEINTRIN_specNONE
+  )
+DEFGEN (FPEXPN, "FPEXPN",	/* F2C */
+    FFEINTRIN_specNONE,
+    FFEINTRIN_specNONE
+  )
+DEFGEN (FPFRAC, "FPFRAC",	/* F2C */
+    FFEINTRIN_specNONE,
+    FFEINTRIN_specNONE
+  )
+DEFGEN (FPMAKE, "FPMAKE",	/* F2C */
+    FFEINTRIN_specNONE,
+    FFEINTRIN_specNONE
+  )
+DEFGEN (FPRRSP, "FPRRSP",	/* F2C */
+    FFEINTRIN_specNONE,
+    FFEINTRIN_specNONE
+  )
+DEFGEN (FPSCAL, "FPSCAL",	/* F2C */
+    FFEINTRIN_specNONE,
+    FFEINTRIN_specNONE
+  )
+DEFGEN (FPUT, "FPUT",	 	/* UNIX */
+    FFEINTRIN_specFPUT_subr,
+    FFEINTRIN_specFPUT_func
+  )
+DEFGEN (FPUTC, "FPUTC", 	/* UNIX */
+    FFEINTRIN_specFPUTC_subr,
+    FFEINTRIN_specFPUTC_func
+  )
+DEFGEN (FSTAT, "FSTAT", 	/* UNIX */
+    FFEINTRIN_specFSTAT_subr,
+    FFEINTRIN_specFSTAT_func
+  )
+DEFGEN (FTELL, "FTELL", 	/* UNIX */
+    FFEINTRIN_specFTELL_subr,
+    FFEINTRIN_specFTELL_func
+  )
+DEFGEN (GETCWD, "GETCWD", 	/* UNIX */
+    FFEINTRIN_specGETCWD_subr,
+    FFEINTRIN_specGETCWD_func
+  )
+DEFGEN (HOSTNM, "HOSTNM", 	/* UNIX */
+    FFEINTRIN_specHOSTNM_subr,
+    FFEINTRIN_specHOSTNM_func
+  )
+DEFGEN (IDATE, "IDATE",		/* UNIX/VXT */
+    FFEINTRIN_specIDATE_unix,
+    FFEINTRIN_specIDATE_vxt
+  )
+DEFGEN (KILL, "KILL", 		/* UNIX */
+    FFEINTRIN_specKILL_subr,
+    FFEINTRIN_specKILL_func
+  )
+DEFGEN (LINK, "LINK", 		/* UNIX */
+    FFEINTRIN_specLINK_subr,
+    FFEINTRIN_specLINK_func
+  )
+DEFGEN (LSTAT, "LSTAT", 	/* UNIX */
+    FFEINTRIN_specLSTAT_subr,
+    FFEINTRIN_specLSTAT_func
+  )
+DEFGEN (RENAME, "RENAME", 	/* UNIX */
+    FFEINTRIN_specRENAME_subr,
+    FFEINTRIN_specRENAME_func
+  )
+DEFGEN (SECOND, "SECOND",	/* UNIX/CRAY */
+    FFEINTRIN_specSECOND_func,
+    FFEINTRIN_specSECOND_subr
+  )
+DEFGEN (SIGNAL, "SIGNAL", 	/* UNIX */
+    FFEINTRIN_specSIGNAL_subr,
+    FFEINTRIN_specSIGNAL_func
+  )
+DEFGEN (STAT, "STAT", 		/* UNIX */
+    FFEINTRIN_specSTAT_subr,
+    FFEINTRIN_specSTAT_func
+  )
+DEFGEN (SYMLNK, "SYMLNK", 	/* UNIX */
+    FFEINTRIN_specSYMLNK_subr,
+    FFEINTRIN_specSYMLNK_func
+  )
+DEFGEN (SYSTEM, "SYSTEM", 	/* UNIX */
+    FFEINTRIN_specSYSTEM_subr,
+    FFEINTRIN_specSYSTEM_func
+  )
+DEFGEN (TIME, "TIME",		/* UNIX/VXT */
+    FFEINTRIN_specTIME_unix,
+    FFEINTRIN_specTIME_vxt
+  )
+DEFGEN (TTYNAM, "TTYNAM",	/* UNIX/VXT */
+    FFEINTRIN_specTTYNAM_subr,
+    FFEINTRIN_specTTYNAM_func
+  )
+DEFGEN (UMASK, "UMASK", 	/* UNIX */
+    FFEINTRIN_specUMASK_subr,
+    FFEINTRIN_specUMASK_func
+  )
+DEFGEN (UNLINK, "UNLINK", 	/* UNIX */
+    FFEINTRIN_specUNLINK_subr,
+    FFEINTRIN_specUNLINK_func
+  )
+DEFGEN (NONE, "none",
+    FFEINTRIN_specNONE,
+    FFEINTRIN_specNONE
+  )
+
+/* Specific intrinsic information.
+
+   Currently this list starts with the list of F77-standard intrinsics
+   in alphabetical order, then continues with the list of all other
+   intrinsics.
+
+   The second boolean argument specifies whether the intrinsic is
+   allowed by the standard to be passed as an actual argument.  */
+
+DEFSPEC (ABS,
+    "ABS",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impABS
+  )
+DEFSPEC (ACOS,
+    "ACOS",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impACOS
+  )
+DEFSPEC (AIMAG,
+    "AIMAG",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impAIMAG
+  )
+DEFSPEC (AINT,
+    "AINT",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impAINT
+  )
+DEFSPEC (ALOG,
+    "ALOG",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impALOG
+  )
+DEFSPEC (ALOG10,
+    "ALOG10",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impALOG10
+  )
+DEFSPEC (AMAX0,
+    "AMAX0",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impAMAX0
+  )
+DEFSPEC (AMAX1,
+    "AMAX1",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impAMAX1
+  )
+DEFSPEC (AMIN0,
+    "AMIN0",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impAMIN0
+  )
+DEFSPEC (AMIN1,
+    "AMIN1",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impAMIN1
+  )
+DEFSPEC (AMOD,
+    "AMOD",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impAMOD
+  )
+DEFSPEC (ANINT,
+    "ANINT",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impANINT
+  )
+DEFSPEC (ASIN,
+    "ASIN",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impASIN
+  )
+DEFSPEC (ATAN,
+    "ATAN",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impATAN
+  )
+DEFSPEC (ATAN2,
+    "ATAN2",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impATAN2
+  )
+DEFSPEC (CABS,
+    "CABS",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impCABS
+  )
+DEFSPEC (CCOS,
+    "CCOS",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impCCOS
+  )
+DEFSPEC (CEXP,
+    "CEXP",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impCEXP
+  )
+DEFSPEC (CHAR,
+    "CHAR",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impCHAR
+  )
+DEFSPEC (CLOG,
+    "CLOG",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impCLOG
+  )
+DEFSPEC (CMPLX,
+    "CMPLX",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impCMPLX
+  )
+DEFSPEC (CONJG,
+    "CONJG",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impCONJG
+  )
+DEFSPEC (COS,
+    "COS",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impCOS
+  )
+DEFSPEC (COSH,
+    "COSH",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impCOSH
+  )
+DEFSPEC (CSIN,
+    "CSIN",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impCSIN
+  )
+DEFSPEC (CSQRT,
+    "CSQRT",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impCSQRT
+  )
+DEFSPEC (DABS,
+    "DABS",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDABS
+  )
+DEFSPEC (DACOS,
+    "DACOS",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDACOS
+  )
+DEFSPEC (DASIN,
+    "DASIN",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDASIN
+  )
+DEFSPEC (DATAN,
+    "DATAN",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDATAN
+  )
+DEFSPEC (DATAN2,
+    "DATAN2",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDATAN2
+  )
+DEFSPEC (DBLE,
+    "DBLE",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDBLE
+  )
+DEFSPEC (DCOS,
+    "DCOS",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDCOS
+  )
+DEFSPEC (DCOSH,
+    "DCOSH",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDCOSH
+  )
+DEFSPEC (DDIM,
+    "DDIM",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDDIM
+  )
+DEFSPEC (DEXP,
+    "DEXP",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDEXP
+  )
+DEFSPEC (DIM,
+    "DIM",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDIM
+  )
+DEFSPEC (DINT,
+    "DINT",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDINT
+  )
+DEFSPEC (DLOG,
+    "DLOG",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDLOG
+  )
+DEFSPEC (DLOG10,
+    "DLOG10",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDLOG10
+  )
+DEFSPEC (DMAX1,
+    "DMAX1",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDMAX1
+  )
+DEFSPEC (DMIN1,
+    "DMIN1",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDMIN1
+  )
+DEFSPEC (DMOD,
+    "DMOD",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDMOD
+  )
+DEFSPEC (DNINT,
+    "DNINT",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDNINT
+  )
+DEFSPEC (DPROD,
+    "DPROD",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDPROD
+  )
+DEFSPEC (DSIGN,
+    "DSIGN",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDSIGN
+  )
+DEFSPEC (DSIN,
+    "DSIN",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDSIN
+  )
+DEFSPEC (DSINH,
+    "DSINH",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDSINH
+  )
+DEFSPEC (DSQRT,
+    "DSQRT",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDSQRT
+  )
+DEFSPEC (DTAN,
+    "DTAN",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDTAN
+  )
+DEFSPEC (DTANH,
+    "DTANH",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impDTANH
+  )
+DEFSPEC (EXP,
+    "EXP",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impEXP
+  )
+DEFSPEC (FLOAT,
+    "FLOAT",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impFLOAT
+  )
+DEFSPEC (IABS,
+    "IABS",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impIABS
+  )
+DEFSPEC (ICHAR,
+    "ICHAR",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impICHAR
+  )
+DEFSPEC (IDIM,
+    "IDIM",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impIDIM
+  )
+DEFSPEC (IDINT,
+    "IDINT",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impIDINT
+  )
+DEFSPEC (IDNINT,
+    "IDNINT",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impIDNINT
+  )
+DEFSPEC (IFIX,
+    "IFIX",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impIFIX
+  )
+DEFSPEC (INDEX,
+    "INDEX",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impINDEX
+  )
+DEFSPEC (INT,
+    "INT",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impINT
+  )
+DEFSPEC (ISIGN,
+    "ISIGN",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impISIGN
+  )
+DEFSPEC (LEN,
+    "LEN",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impLEN
+  )
+DEFSPEC (LGE,
+    "LGE",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impLGE
+  )
+DEFSPEC (LGT,
+    "LGT",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impLGT
+  )
+DEFSPEC (LLE,
+    "LLE",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impLLE
+  )
+DEFSPEC (LLT,
+    "LLT",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impLLT
+  )
+DEFSPEC (LOG,
+    "LOG",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impLOG
+  )
+DEFSPEC (LOG10,
+    "LOG10",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impLOG10
+  )
+DEFSPEC (MAX,
+    "MAX",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impMAX
+  )
+DEFSPEC (MAX0,
+    "MAX0",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impMAX0
+  )
+DEFSPEC (MAX1,
+    "MAX1",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impMAX1
+  )
+DEFSPEC (MIN,
+    "MIN",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impMIN
+  )
+DEFSPEC (MIN0,
+    "MIN0",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impMIN0
+  )
+DEFSPEC (MIN1,
+    "MIN1",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impMIN1
+  )
+DEFSPEC (MOD,
+    "MOD",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impMOD
+  )
+DEFSPEC (NINT,
+    "NINT",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impNINT
+  )
+DEFSPEC (REAL,
+    "REAL",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impREAL
+  )
+DEFSPEC (SIGN,
+    "SIGN",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impSIGN
+  )
+DEFSPEC (SIN,
+    "SIN",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impSIN
+  )
+DEFSPEC (SINH,
+    "SINH",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impSINH
+  )
+DEFSPEC (SNGL,
+    "SNGL",
+    FALSE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impSNGL
+  )
+DEFSPEC (SQRT,
+    "SQRT",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impSQRT
+  )
+DEFSPEC (TAN,
+    "TAN",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impTAN
+  )
+DEFSPEC (TANH,
+    "TANH",
+    TRUE,
+    FFEINTRIN_familyF77,
+    FFEINTRIN_impTANH
+  )
+
+DEFSPEC (ABORT,
+    "ABORT",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impABORT
+  )
+DEFSPEC (ACCESS,
+    "ACCESS",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impACCESS
+)
+DEFSPEC (ACHAR,
+    "ACHAR",
+    FALSE,
+    FFEINTRIN_familyASC,
+    FFEINTRIN_impACHAR
+  )
+DEFSPEC (ACOSD,
+    "ACOSD",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (ADJUSTL,
+    "ADJUSTL",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (ADJUSTR,
+    "ADJUSTR",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (AIMAX0,
+    "AIMAX0",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (AIMIN0,
+    "AIMIN0",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (AJMAX0,
+    "AJMAX0",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (AJMIN0,
+    "AJMIN0",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (ALARM,
+    "ALARM",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impALARM
+  )
+DEFSPEC (ALL,
+    "ALL",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (ALLOCATED,
+    "ALLOCATED",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (AND,
+    "AND",
+    FALSE,
+    FFEINTRIN_familyF2C,
+    FFEINTRIN_impAND
+  )
+DEFSPEC (ANY,
+    "ANY",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (ASIND,
+    "ASIND",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (ASSOCIATED,
+    "ASSOCIATED",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (ATAN2D,
+    "ATAN2D",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (ATAND,
+    "ATAND",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (BESJ0,
+    "BESJ0",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impBESJ0
+)
+DEFSPEC (BESJ1,
+    "BESJ1",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impBESJ1
+)
+DEFSPEC (BESJN,
+    "BESJN",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impBESJN
+)
+DEFSPEC (BESY0,
+    "BESY0",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impBESY0
+)
+DEFSPEC (BESY1,
+    "BESY1",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impBESY1
+)
+DEFSPEC (BESYN,
+    "BESYN",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impBESYN
+)
+DEFSPEC (BIT_SIZE,
+    "BIT_SIZE",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impBIT_SIZE
+  )
+DEFSPEC (BITEST,
+    "BITEST",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (BJTEST,
+    "BJTEST",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (BTEST,
+    "BTEST",
+    FALSE,
+    FFEINTRIN_familyMIL,
+    FFEINTRIN_impBTEST
+  )
+DEFSPEC (CDABS,
+    "CDABS",
+    TRUE,
+    FFEINTRIN_familyFVZ,
+    FFEINTRIN_impCDABS
+  )
+DEFSPEC (CDCOS,
+    "CDCOS",
+    TRUE,
+    FFEINTRIN_familyFVZ,
+    FFEINTRIN_impCDCOS
+  )
+DEFSPEC (CDEXP,
+    "CDEXP",
+    TRUE,
+    FFEINTRIN_familyFVZ,
+    FFEINTRIN_impCDEXP
+  )
+DEFSPEC (CDLOG,
+    "CDLOG",
+    TRUE,
+    FFEINTRIN_familyFVZ,
+    FFEINTRIN_impCDLOG
+  )
+DEFSPEC (CDSIN,
+    "CDSIN",
+    TRUE,
+    FFEINTRIN_familyFVZ,
+    FFEINTRIN_impCDSIN
+  )
+DEFSPEC (CDSQRT,
+    "CDSQRT",
+    TRUE,
+    FFEINTRIN_familyFVZ,
+    FFEINTRIN_impCDSQRT
+  )
+DEFSPEC (CEILING,
+    "CEILING",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (CHDIR_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyBADU77,
+    FFEINTRIN_impCHDIR_func
+)
+DEFSPEC (CHDIR_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impCHDIR_subr
+)
+DEFSPEC (CHMOD_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyBADU77,
+    FFEINTRIN_impCHMOD_func
+)
+DEFSPEC (CHMOD_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impCHMOD_subr
+)
+DEFSPEC (COMPLEX,
+    "COMPLEX",
+    FALSE,
+    FFEINTRIN_familyGNU,
+    FFEINTRIN_impCOMPLEX
+  )
+DEFSPEC (COSD,
+    "COSD",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (COUNT,
+    "COUNT",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (CSHIFT,
+    "CSHIFT",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (CPU_TIME,
+    "CPU_TIME",
+    FALSE,
+    FFEINTRIN_familyF95,
+    FFEINTRIN_impCPU_TIME
+)
+DEFSPEC (CTIME_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impCTIME_func
+)
+DEFSPEC (CTIME_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impCTIME_subr
+)
+DEFSPEC (DACOSD,
+    "DACOSD",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (DASIND,
+    "DASIND",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (DATAN2D,
+    "DATAN2D",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (DATAND,
+    "DATAND",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (DATE,
+    "DATE",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impDATE
+)
+DEFSPEC (DATE_AND_TIME,
+    "DATE_AND_TIME",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impDATE_AND_TIME
+  )
+DEFSPEC (DBESJ0,
+    "DBESJ0",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impDBESJ0
+)
+DEFSPEC (DBESJ1,
+    "DBESJ1",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impDBESJ1
+)
+DEFSPEC (DBESJN,
+    "DBESJN",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impDBESJN
+)
+DEFSPEC (DBESY0,
+    "DBESY0",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impDBESY0
+)
+DEFSPEC (DBESY1,
+    "DBESY1",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impDBESY1
+)
+DEFSPEC (DBESYN,
+    "DBESYN",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impDBESYN
+)
+DEFSPEC (DBLEQ,
+    "DBLEQ",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (DCMPLX,
+    "DCMPLX",
+    FALSE,
+    FFEINTRIN_familyFVZ,
+    FFEINTRIN_impDCMPLX
+  )
+DEFSPEC (DCONJG,
+    "DCONJG",
+    TRUE,
+    FFEINTRIN_familyFVZ,
+    FFEINTRIN_impDCONJG
+  )
+DEFSPEC (DCOSD,
+    "DCOSD",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (DERF,
+    "DERF",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impDERF
+  )
+DEFSPEC (DERFC,
+    "DERFC",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impDERFC
+  )
+DEFSPEC (DFLOAT,
+    "DFLOAT",
+    FALSE,
+    FFEINTRIN_familyFVZ,
+    FFEINTRIN_impDFLOAT
+  )
+DEFSPEC (DFLOTI,
+    "DFLOTI",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (DFLOTJ,
+    "DFLOTJ",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (DIGITS,
+    "DIGITS",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (DIMAG,
+    "DIMAG",
+    TRUE,
+    FFEINTRIN_familyFVZ,
+    FFEINTRIN_impDIMAG
+  )
+DEFSPEC (DOT_PRODUCT,
+    "DOT_PRODUCT",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (DREAL,
+    "DREAL",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impDREAL
+  )
+DEFSPEC (DSIND,
+    "DSIND",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (DTAND,
+    "DTAND",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (DTIME_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyBADU77,
+    FFEINTRIN_impDTIME_func
+)
+DEFSPEC (DTIME_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impDTIME_subr
+)
+DEFSPEC (EOSHIFT,
+    "EOSHIFT",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (EPSILON,
+    "EPSILON",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (ERF,
+    "ERF",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impERF
+  )
+DEFSPEC (ERFC,
+    "ERFC",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impERFC
+  )
+DEFSPEC (ETIME_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impETIME_func
+)
+DEFSPEC (ETIME_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impETIME_subr
+)
+DEFSPEC (EXIT,
+    "EXIT",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impEXIT
+  )
+DEFSPEC (EXPONENT,
+    "EXPONENT",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (FDATE_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impFDATE_func
+)
+DEFSPEC (FDATE_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impFDATE_subr
+)
+DEFSPEC (FGET_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyBADU77,
+    FFEINTRIN_impFGET_func
+)
+DEFSPEC (FGET_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impFGET_subr
+)
+DEFSPEC (FGETC_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyBADU77,
+    FFEINTRIN_impFGETC_func
+)
+DEFSPEC (FGETC_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impFGETC_subr
+)
+DEFSPEC (FLOATI,
+    "FLOATI",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (FLOATJ,
+    "FLOATJ",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (FLOOR,
+    "FLOOR",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (FLUSH,
+    "FLUSH",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impFLUSH
+  )
+DEFSPEC (FNUM,
+    "FNUM",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impFNUM
+)
+DEFSPEC (FPUT_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyBADU77,
+    FFEINTRIN_impFPUT_func
+)
+DEFSPEC (FPUT_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impFPUT_subr
+)
+DEFSPEC (FPUTC_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyBADU77,
+    FFEINTRIN_impFPUTC_func
+)
+DEFSPEC (FPUTC_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impFPUTC_subr
+)
+DEFSPEC (FRACTION,
+    "FRACTION",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (FSEEK,
+    "FSEEK",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impFSEEK
+  )
+DEFSPEC (FSTAT_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impFSTAT_func
+)
+DEFSPEC (FSTAT_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impFSTAT_subr
+)
+DEFSPEC (FTELL_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impFTELL_func
+  )
+DEFSPEC (FTELL_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impFTELL_subr
+  )
+DEFSPEC (GERROR,
+    "GERROR",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impGERROR
+)
+DEFSPEC (GETARG,
+    "GETARG",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impGETARG
+  )
+DEFSPEC (GETCWD_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impGETCWD_func
+)
+DEFSPEC (GETCWD_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impGETCWD_subr
+)
+DEFSPEC (GETENV,
+    "GETENV",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impGETENV
+  )
+DEFSPEC (GETGID,
+    "GETGID",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impGETGID
+)
+DEFSPEC (GETLOG,
+    "GETLOG",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impGETLOG
+)
+DEFSPEC (GETPID,
+    "GETPID",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impGETPID
+)
+DEFSPEC (GETUID,
+    "GETUID",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impGETUID
+)
+DEFSPEC (GMTIME,
+    "GMTIME",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impGMTIME
+)
+DEFSPEC (HOSTNM_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impHOSTNM_func
+)
+DEFSPEC (HOSTNM_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impHOSTNM_subr
+)
+DEFSPEC (HUGE,
+    "HUGE",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IACHAR,
+    "IACHAR",
+    FALSE,
+    FFEINTRIN_familyASC,
+    FFEINTRIN_impIACHAR
+  )
+DEFSPEC (IAND,
+    "IAND",
+    FALSE,
+    FFEINTRIN_familyMIL,
+    FFEINTRIN_impIAND
+  )
+DEFSPEC (IARGC,
+    "IARGC",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impIARGC
+  )
+DEFSPEC (IBCLR,
+    "IBCLR",
+    FALSE,
+    FFEINTRIN_familyMIL,
+    FFEINTRIN_impIBCLR
+  )
+DEFSPEC (IBITS,
+    "IBITS",
+    FALSE,
+    FFEINTRIN_familyMIL,
+    FFEINTRIN_impIBITS
+  )
+DEFSPEC (IBSET,
+    "IBSET",
+    FALSE,
+    FFEINTRIN_familyMIL,
+    FFEINTRIN_impIBSET
+  )
+DEFSPEC (IDATE_unix,
+    "UNIX",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impIDATE_unix
+)
+DEFSPEC (IDATE_vxt,
+    "VXT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impIDATE_vxt
+)
+DEFSPEC (IEOR,
+    "IEOR",
+    FALSE,
+    FFEINTRIN_familyMIL,
+    FFEINTRIN_impIEOR
+  )
+DEFSPEC (IERRNO,
+    "IERRNO",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impIERRNO
+)
+DEFSPEC (IIABS,
+    "IIABS",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IIAND,
+    "IIAND",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IIBCLR,
+    "IIBCLR",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IIBITS,
+    "IIBITS",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IIBSET,
+    "IIBSET",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IIDIM,
+    "IIDIM",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IIDINT,
+    "IIDINT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IIDNNT,
+    "IIDNNT",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IIEOR,
+    "IIEOR",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IIFIX,
+    "IIFIX",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IINT,
+    "IINT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IIOR,
+    "IIOR",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IIQINT,
+    "IIQINT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IIQNNT,
+    "IIQNNT",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IISHFT,
+    "IISHFT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IISHFTC,
+    "IISHFTC",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IISIGN,
+    "IISIGN",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IMAG,
+    "IMAG",
+    FALSE,
+    FFEINTRIN_familyF2C,
+    FFEINTRIN_impIMAGPART
+  )
+DEFSPEC (IMAGPART,
+    "IMAGPART",
+    FALSE,
+    FFEINTRIN_familyGNU,
+    FFEINTRIN_impIMAGPART
+  )
+DEFSPEC (IMAX0,
+    "IMAX0",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IMAX1,
+    "IMAX1",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IMIN0,
+    "IMIN0",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IMIN1,
+    "IMIN1",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (IMOD,
+    "IMOD",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (ININT,
+    "ININT",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (INOT,
+    "INOT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (INT2,
+    "INT2",
+    FALSE,
+    FFEINTRIN_familyGNU,
+    FFEINTRIN_impINT2
+  )
+DEFSPEC (INT8,
+    "INT8",
+    FALSE,
+    FFEINTRIN_familyGNU,
+    FFEINTRIN_impINT8
+  )
+DEFSPEC (IOR,
+    "IOR",
+    FALSE,
+    FFEINTRIN_familyMIL,
+    FFEINTRIN_impIOR
+  )
+DEFSPEC (IRAND,
+    "IRAND",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impIRAND
+)
+DEFSPEC (ISATTY,
+    "ISATTY",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impISATTY
+)
+DEFSPEC (ISHFT,
+    "ISHFT",
+    FALSE,
+    FFEINTRIN_familyMIL,
+    FFEINTRIN_impISHFT
+  )
+DEFSPEC (ISHFTC,
+    "ISHFTC",
+    FALSE,
+    FFEINTRIN_familyMIL,
+    FFEINTRIN_impISHFTC
+  )
+DEFSPEC (ITIME,
+    "ITIME",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impITIME
+)
+DEFSPEC (IZEXT,
+    "IZEXT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JIABS,
+    "JIABS",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JIAND,
+    "JIAND",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JIBCLR,
+    "JIBCLR",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JIBITS,
+    "JIBITS",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JIBSET,
+    "JIBSET",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JIDIM,
+    "JIDIM",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JIDINT,
+    "JIDINT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JIDNNT,
+    "JIDNNT",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JIEOR,
+    "JIEOR",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JIFIX,
+    "JIFIX",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JINT,
+    "JINT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JIOR,
+    "JIOR",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JIQINT,
+    "JIQINT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JIQNNT,
+    "JIQNNT",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JISHFT,
+    "JISHFT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JISHFTC,
+    "JISHFTC",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JISIGN,
+    "JISIGN",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JMAX0,
+    "JMAX0",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JMAX1,
+    "JMAX1",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JMIN0,
+    "JMIN0",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JMIN1,
+    "JMIN1",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JMOD,
+    "JMOD",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JNINT,
+    "JNINT",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JNOT,
+    "JNOT",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (JZEXT,
+    "JZEXT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (KILL_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyBADU77,
+    FFEINTRIN_impKILL_func
+)
+DEFSPEC (KILL_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impKILL_subr
+)
+DEFSPEC (KIND,
+    "KIND",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (LBOUND,
+    "LBOUND",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (LINK_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyBADU77,
+    FFEINTRIN_impLINK_func
+)
+DEFSPEC (LINK_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impLINK_subr
+)
+DEFSPEC (LEN_TRIM,
+    "LEN_TRIM",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impLNBLNK
+  )
+DEFSPEC (LNBLNK,
+    "LNBLNK",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impLNBLNK
+)
+DEFSPEC (LOC,
+    "LOC",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impLOC
+  )
+DEFSPEC (LOGICAL,
+    "LOGICAL",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (LONG,
+    "LONG",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impLONG
+  )
+DEFSPEC (LSHIFT,
+    "LSHIFT",
+    FALSE,
+    FFEINTRIN_familyF2C,
+    FFEINTRIN_impLSHIFT
+  )
+DEFSPEC (LSTAT_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impLSTAT_func
+)
+DEFSPEC (LSTAT_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impLSTAT_subr
+)
+DEFSPEC (LTIME,
+    "LTIME",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impLTIME
+)
+DEFSPEC (MATMUL,
+    "MATMUL",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (MAXEXPONENT,
+    "MAXEXPONENT",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (MAXLOC,
+    "MAXLOC",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (MAXVAL,
+    "MAXVAL",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (MCLOCK,
+    "MCLOCK",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impMCLOCK
+)
+DEFSPEC (MCLOCK8,
+    "MCLOCK8",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impMCLOCK8
+)
+DEFSPEC (MERGE,
+    "MERGE",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (MINEXPONENT,
+    "MINEXPONENT",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (MINLOC,
+    "MINLOC",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (MINVAL,
+    "MINVAL",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (MODULO,
+    "MODULO",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (MVBITS,
+    "MVBITS",
+    FALSE,
+    FFEINTRIN_familyMIL,
+    FFEINTRIN_impMVBITS
+  )
+DEFSPEC (NEAREST,
+    "NEAREST",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (NOT,
+    "NOT",
+    FALSE,
+    FFEINTRIN_familyMIL,
+    FFEINTRIN_impNOT
+  )
+DEFSPEC (OR,
+    "OR",
+    FALSE,
+    FFEINTRIN_familyF2C,
+    FFEINTRIN_impOR
+  )
+DEFSPEC (PACK,
+    "PACK",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (PERROR,
+    "PERROR",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impPERROR
+)
+DEFSPEC (PRECISION,
+    "PRECISION",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (PRESENT,
+    "PRESENT",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (PRODUCT,
+    "PRODUCT",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QABS,
+    "QABS",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QACOS,
+    "QACOS",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QACOSD,
+    "QACOSD",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QASIN,
+    "QASIN",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QASIND,
+    "QASIND",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QATAN,
+    "QATAN",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QATAN2,
+    "QATAN2",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QATAN2D,
+    "QATAN2D",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QATAND,
+    "QATAND",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QCOS,
+    "QCOS",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QCOSD,
+    "QCOSD",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QCOSH,
+    "QCOSH",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QDIM,
+    "QDIM",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QEXP,
+    "QEXP",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QEXT,
+    "QEXT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QEXTD,
+    "QEXTD",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QFLOAT,
+    "QFLOAT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QINT,
+    "QINT",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QLOG,
+    "QLOG",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QLOG10,
+    "QLOG10",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QMAX1,
+    "QMAX1",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QMIN1,
+    "QMIN1",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QMOD,
+    "QMOD",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QNINT,
+    "QNINT",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QSIGN,
+    "QSIGN",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QSIN,
+    "QSIN",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QSIND,
+    "QSIND",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QSINH,
+    "QSINH",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QSQRT,
+    "QSQRT",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QTAN,
+    "QTAN",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QTAND,
+    "QTAND",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (QTANH,
+    "QTANH",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (RADIX,
+    "RADIX",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (RAND,
+    "RAND",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impRAND
+)
+DEFSPEC (RANDOM_NUMBER,
+    "RANDOM_NUMBER",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (RANDOM_SEED,
+    "RANDOM_SEED",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (RANGE,
+    "RANGE",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (REALPART,
+    "REALPART",
+    FALSE,
+    FFEINTRIN_familyGNU,
+    FFEINTRIN_impREALPART
+  )
+DEFSPEC (RENAME_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyBADU77,
+    FFEINTRIN_impRENAME_func
+)
+DEFSPEC (RENAME_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impRENAME_subr
+)
+DEFSPEC (REPEAT,
+    "REPEAT",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (RESHAPE,
+    "RESHAPE",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (RRSPACING,
+    "RRSPACING",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (RSHIFT,
+    "RSHIFT",
+    FALSE,
+    FFEINTRIN_familyF2C,
+    FFEINTRIN_impRSHIFT
+  )
+DEFSPEC (SCALE,
+    "SCALE",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (SCAN,
+    "SCAN",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (SECNDS,
+    "SECNDS",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impSECNDS
+)
+DEFSPEC (SECOND_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impSECOND_func
+)
+DEFSPEC (SECOND_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impSECOND_subr
+)
+DEFSPEC (SEL_INT_KIND,
+    "SEL_INT_KIND",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (SEL_REAL_KIND,
+    "SEL_REAL_KIND",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (SET_EXPONENT,
+    "SET_EXPONENT",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (SHAPE,
+    "SHAPE",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (SHORT,
+    "SHORT",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impSHORT
+  )
+DEFSPEC (SIGNAL_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyBADU77,
+    FFEINTRIN_impSIGNAL_func
+  )
+DEFSPEC (SIGNAL_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impSIGNAL_subr
+  )
+DEFSPEC (SIND,
+    "SIND",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (SLEEP,
+    "SLEEP",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impSLEEP
+)
+DEFSPEC (SNGLQ,
+    "SNGLQ",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (SPACING,
+    "SPACING",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (SPREAD,
+    "SPREAD",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (SRAND,
+    "SRAND",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impSRAND
+)
+DEFSPEC (STAT_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impSTAT_func
+)
+DEFSPEC (STAT_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impSTAT_subr
+)
+DEFSPEC (SUM,
+    "SUM",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (SYMLNK_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyBADU77,
+    FFEINTRIN_impSYMLNK_func
+)
+DEFSPEC (SYMLNK_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impSYMLNK_subr
+)
+DEFSPEC (SYSTEM_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyBADU77,
+    FFEINTRIN_impSYSTEM_func
+  )
+DEFSPEC (SYSTEM_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impSYSTEM_subr
+  )
+DEFSPEC (SYSTEM_CLOCK,
+    "SYSTEM_CLOCK",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impSYSTEM_CLOCK
+  )
+DEFSPEC (TAND,
+    "TAND",
+    TRUE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (TIME8,
+    "UNIX",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impTIME8
+)
+DEFSPEC (TIME_unix,
+    "UNIX",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impTIME_unix
+)
+DEFSPEC (TIME_vxt,
+    "VXT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impTIME_vxt
+)
+DEFSPEC (TINY,
+    "TINY",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (TRANSFER,
+    "TRANSFER",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (TRANSPOSE,
+    "TRANSPOSE",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (TRIM,
+    "TRIM",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (TTYNAM_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impTTYNAM_func
+)
+DEFSPEC (TTYNAM_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impTTYNAM_subr
+)
+DEFSPEC (UBOUND,
+    "UBOUND",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (UMASK_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyBADU77,
+    FFEINTRIN_impUMASK_func
+)
+DEFSPEC (UMASK_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impUMASK_subr
+)
+DEFSPEC (UNLINK_func,
+    "function",
+    FALSE,
+    FFEINTRIN_familyBADU77,
+    FFEINTRIN_impUNLINK_func
+)
+DEFSPEC (UNLINK_subr,
+    "subroutine",
+    FALSE,
+    FFEINTRIN_familyF2U,
+    FFEINTRIN_impUNLINK_subr
+)
+DEFSPEC (UNPACK,
+    "UNPACK",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (VERIFY,
+    "VERIFY",
+    FALSE,
+    FFEINTRIN_familyF90,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (XOR,
+    "XOR",
+    FALSE,
+    FFEINTRIN_familyF2C,
+    FFEINTRIN_impXOR
+  )
+DEFSPEC (ZABS,
+    "ZABS",
+    TRUE,
+    FFEINTRIN_familyF2C,
+    FFEINTRIN_impCDABS
+  )
+DEFSPEC (ZCOS,
+    "ZCOS",
+    TRUE,
+    FFEINTRIN_familyF2C,
+    FFEINTRIN_impCDCOS
+  )
+DEFSPEC (ZEXP,
+    "ZEXP",
+    TRUE,
+    FFEINTRIN_familyF2C,
+    FFEINTRIN_impCDEXP
+  )
+DEFSPEC (ZEXT,
+    "ZEXT",
+    FALSE,
+    FFEINTRIN_familyVXT,
+    FFEINTRIN_impNONE
+  )
+DEFSPEC (ZLOG,
+    "ZLOG",
+    TRUE,
+    FFEINTRIN_familyF2C,
+    FFEINTRIN_impCDLOG
+  )
+DEFSPEC (ZSIN,
+    "ZSIN",
+    TRUE,
+    FFEINTRIN_familyF2C,
+    FFEINTRIN_impCDSIN
+  )
+DEFSPEC (ZSQRT,
+    "ZSQRT",
+    TRUE,
+    FFEINTRIN_familyF2C,
+    FFEINTRIN_impCDSQRT
+  )
+DEFSPEC (NONE,
+    "none",
+    FALSE,
+    FFEINTRIN_familyNONE,
+    FFEINTRIN_impNONE
+  )
+
+/* Intrinsic implementations ordered in two sections:
+   F77, then extensions; secondarily, alphabetical
+   ordering.  */
+
+/* The DEFIMP macro specifies the following fields for an intrinsic:
+
+   CODE	      -- The internal name for this intrinsic; `FFEINTRIN_imp'
+		 prepends this to form the `enum' name.
+
+   NAME       -- The textual name to use when printing information on
+		 this intrinsic.
+
+   GFRTDIRECT -- The run-time library routine that is suitable for
+		 a call to implement a *direct* invocation of the
+		 intrinsic (e.g. `ABS(10)').
+
+   GFRTF2C    -- The run-time library routine that is suitable for
+		 passing as an argument to a procedure that will
+		 invoke the argument as an EXTERNAL procedure, when
+		 f2c calling conventions will be used (e.g.
+		 `CALL FOO(ABS)', when FOO compiled with -ff2c).
+
+   GFRTGNU    -- The run-time library routine that is suitable for
+		 passing as an argument to a procedure that will
+		 invoke the argument as an EXTERNAL procedure, when
+		 GNU calling conventions will be used (e.g.
+		 `CALL FOO(ABS)', when FOO compiled with -fno-f2c).
+
+   CONTROL    -- A control string, described below.
+
+   The DEFIMPY macro specifies the above, plus:
+
+   Y2KBAD     -- TRUE if the intrinsic is known to be non-Y2K-compliant,
+                 FALSE if it is known to be Y2K-compliant.  (In terms of
+                 interface and libg2c implementation.)
+
+*/
+
+/* The control string has the following format:
+
+     <return-type>:<arglist-info>:[<argitem-info>,...]
+
+   <return-type> is:
+
+     <return-base-type><return-kind-type>[<return-modifier>]
+
+   <return-base-type> is:
+
+     -    Subroutine
+     A    Character
+     C    Complex
+     I    Integer
+     L    Logical
+     R    Real
+     B    Boolean (I or L), decided by co-operand list (COL)
+     F    Floating-point (C or R), decided by COL
+     N    Numeric (C, I, or R), decided by co-operand list (COL)
+     S    Scalar numeric (I or R), decided by COL, which may be COMPLEX
+
+   <return-kind-type> is:
+
+     -    Subroutine
+     =    Decided by COL
+     1    (Default)
+     2    (Twice the size of 1)
+     3    (Same size as CHARACTER*1)
+     4    (Twice the size of 2)
+     6    (Twice the size as 3)
+     7    (Same size as `char *')
+     C    Like 1 (F77), except (F90), if COL is COMPLEX, uses kind type of COL
+
+   <return-modifier> is:
+
+     *    Valid for <return-base-type> of `A' only, means program may
+          declare any length for return value, default being (*)
+
+   <arglist-info> is:
+
+     <COL-spec>
+
+   <COL-spec> is:
+
+     -    No COL (return-base-type and return-kind-type must be definitive)
+     *    All arguments form COL (must have more than one argument)
+     n    Argument n (0 for first arg, 1 for second, etc.) forms COL
+
+   <argitem-info> is:
+
+     <name>=[<optionality>]<arg-base-type><arg-kind-type>[<arg-len>][<arg-rank>][<arg-extra>]
+
+   <name> is the standard keyword name for the argument.
+
+   <optionality> is:
+
+     ?    Argument is optional
+     !    Like ?, but argument must be omitted if previous arg was COMPLEX
+     +    One or more of these arguments must be specified
+     *    Zero or more of these arguments must be specified
+     n    Numbered names for arguments, one or more must be specified
+     p    Like n, but two or more must be specified
+
+   <arg-base-type> is:
+
+     -    Any is valid (arg-kind-type is 0)
+     A    Character*(*)
+     C    Complex
+     I    Integer
+     L    Logical
+     R    Real
+     B    Boolean (I or L)
+     F    Floating-point (C or R)
+     N    Numeric (C, I, or R)
+     S    Scalar numeric (I or R)
+     g    GOTO label (alternate-return form of CALL) (arg-kind-type is 0)
+     s    Signal handler (INTEGER FUNCTION, SUBROUTINE or dummy/global
+          default INTEGER variable) (arg-kind-type is 0)
+
+   <arg-kind-type> is:
+
+     *    Any is valid
+     1    (Default)
+     2    (Twice the size of 1)
+     3    (Same size as CHARACTER*1)
+     4    (Twice the size of 2)
+     6    (Twice the size as 3)
+     A    Same as first argument
+     N    Not wider than the default kind
+
+   <arg-len> is:
+
+          (Default) CHARACTER*(*)
+     [n]  CHARACTER*n
+
+   <arg-rank> is:
+
+          (default) Rank-0 (variable or array element)
+     (n)  Rank-1 array n elements long
+     &    Any (arg-extra is &)
+
+   <arg-extra> is:
+
+          (default) Arg is INTENT(IN)
+     i    Arg's attributes are all that matter (inquiry function)
+     w    Arg is INTENT(OUT)
+     x    Arg is INTENT(INOUT)
+     &    Arg can have its address taken (LOC(), for example)
+
+*/
+
+DEFIMP	(ABS,		"ABS",		,ABS,,		"S=:0:A=N*")
+DEFIMP	(ACOS,		"ACOS",		L_ACOS,ACOS,,	"R=:0:X=R*")
+DEFIMP	(AIMAG,		"AIMAG",	,AIMAG,,	"RC:0:Z=C*")
+DEFIMP	(AINT,		"AINT",		,AINT,,		"R=:0:A=R*")
+DEFIMP	(ALOG,		"ALOG",		L_LOG,ALOG,,	"R1:-:X=R1")
+DEFIMP	(ALOG10,	"ALOG10",	L_LOG10,ALOG10,,"R1:-:X=R1")
+DEFIMP	(AMAX0,		"AMAX0",	,,,		"R1:*:A=pI1")
+DEFIMP	(AMAX1,		"AMAX1",	,,,		"R1:*:A=pR1")
+DEFIMP	(AMIN0,		"AMIN0",	,,,		"R1:*:A=pI1")
+DEFIMP	(AMIN1,		"AMIN1",	,,,		"R1:*:A=pR1")
+DEFIMP	(AMOD,		"AMOD",		L_FMOD,AMOD,,	"R1:*:A=R1,P=R1")
+DEFIMP	(ANINT,		"ANINT",	,ANINT,,	"R=:0:A=R*")
+DEFIMP	(ASIN,		"ASIN",		L_ASIN,ASIN,,	"R=:0:X=R*")
+DEFIMP	(ATAN,		"ATAN",		L_ATAN,ATAN,,	"R=:0:X=R*")
+DEFIMP	(ATAN2,		"ATAN2",	L_ATAN2,ATAN2,,	"R=:*:Y=R*,X=R*")
+DEFIMP	(CABS,		"CABS",		,CABS,,		"R1:-:A=C1")
+DEFIMP	(CCOS,		"CCOS",		,CCOS,,		"C1:-:X=C1")
+DEFIMP	(CEXP,		"CEXP",		,CEXP,,		"C1:-:X=C1")
+DEFIMP	(CHAR,		"CHAR",		,,,		"A1:-:I=I*")
+DEFIMP	(CLOG,		"CLOG",		,CLOG,,		"C1:-:X=C1")
+DEFIMP	(CMPLX,		"CMPLX",	,,,		"C1:*:X=N*,Y=!S*")
+DEFIMP	(CONJG,		"CONJG",	,CONJG,,	"C=:0:Z=C*")
+DEFIMP	(COS,		"COS",		L_COS,COS,,	"F=:0:X=F*")
+DEFIMP	(COSH,		"COSH",		L_COSH,COSH,,	"R=:0:X=R*")
+DEFIMP	(CSIN,		"CSIN",		,CSIN,,		"C1:-:X=C1")
+DEFIMP	(CSQRT,		"CSQRT",	,CSQRT,,	"C1:-:X=C1")
+DEFIMP	(DABS,		"DABS",		,DABS,,		"R2:-:A=R2")
+DEFIMP	(DACOS,		"DACOS",	L_ACOS,DACOS,,	"R2:-:X=R2")
+DEFIMP	(DASIN,		"DASIN",	L_ASIN,DASIN,,	"R2:-:X=R2")
+DEFIMP	(DATAN,		"DATAN",	L_ATAN,DATAN,,	"R2:-:X=R2")
+DEFIMP	(DATAN2,	"DATAN2",	L_ATAN2,DATAN2,,"R2:*:Y=R2,X=R2")
+DEFIMP	(DBLE,		"DBLE",		,,,		"R2:-:A=N*")
+DEFIMP	(DCMPLX,	"DCMPLX",	,,,		"C2:*:X=N*,Y=!S*")
+DEFIMP	(DCOS,		"DCOS",		L_COS,DCOS,,	"R2:-:X=R2")
+DEFIMP	(DCOSH,		"DCOSH",	L_COSH,DCOSH,,	"R2:-:X=R2")
+DEFIMP	(DDIM,		"DDIM",		,DDIM,,		"R2:*:X=R2,Y=R2")
+DEFIMP	(DEXP,		"DEXP",		L_EXP,DEXP,,	"R2:-:X=R2")
+DEFIMP	(DIM,		"DIM",		,DIM,,		"S=:*:X=S*,Y=S*")
+DEFIMP	(DINT,		"DINT",		,DINT,,		"R2:-:A=R2")
+DEFIMP	(DLOG,		"DLOG",		L_LOG,DLOG,,	"R2:-:X=R2")
+DEFIMP	(DLOG10,	"DLOG10",	L_LOG10,DLOG10,,"R2:-:X=R2")
+DEFIMP	(DMAX1,		"DMAX1",	,,,		"R2:*:A=pR2")
+DEFIMP	(DMIN1,		"DMIN1",	,,,		"R2:*:A=pR2")
+DEFIMP	(DMOD,		"DMOD",		L_FMOD,DMOD,,	"R2:*:A=R2,P=R2")
+DEFIMP	(DNINT,		"DNINT",	,DNINT,,	"R2:-:A=R2")
+DEFIMP	(DPROD,		"DPROD",	,DPROD,,	"R2:*:X=R1,Y=R1")
+DEFIMP	(DSIGN,		"DSIGN",	,DSIGN,,	"R2:*:A=R2,B=R2")
+DEFIMP	(DSIN,		"DSIN",		L_SIN,DSIN,,	"R2:-:X=R2")
+DEFIMP	(DSINH,		"DSINH",	L_SINH,DSINH,,	"R2:-:X=R2")
+DEFIMP	(DSQRT,		"DSQRT",	L_SQRT,DSQRT,,	"R2:-:X=R2")
+DEFIMP	(DTAN,		"DTAN",		L_TAN,DTAN,,	"R2:-:X=R2")
+DEFIMP	(DTANH,		"DTANH",	L_TANH,DTANH,,	"R2:-:X=R2")
+DEFIMP	(EXP,		"EXP",		L_EXP,EXP,,	"F=:0:X=F*")
+DEFIMP	(FLOAT,		"FLOAT",	,,,		"R1:-:A=I*")
+DEFIMP	(IABS,		"IABS",		,IABS,IABS,	"I1:-:A=I1")
+DEFIMP	(ICHAR,		"ICHAR",	,,,		"I1:-:C=A*")
+DEFIMP	(IDIM,		"IDIM",		,IDIM,IDIM,	"I1:*:X=I1,Y=I1")
+DEFIMP	(IDINT,		"IDINT",	,,,		"I1:-:A=R2")
+DEFIMP	(IDNINT,	"IDNINT",	,IDNINT,IDNINT,	"I1:-:A=R2")
+DEFIMP	(IFIX,		"IFIX",		,,,		"I1:-:A=R1")
+DEFIMP	(INDEX,		"INDEX",	,INDEX,INDEX,	"I1:*:String=A*,Substring=A*")
+DEFIMP	(INT,		"INT",		,,,		"I1:-:A=N*")
+DEFIMP	(ISIGN,		"ISIGN",	,ISIGN,ISIGN,	"I1:*:A=I1,B=I1")
+DEFIMP	(LEN,		"LEN",		,LEN,LEN,	"I1:-:String=A*i")
+DEFIMP	(LGE,		"LGE",		,LGE,LGE,	"L1:*:String_A=A1,String_B=A1")
+DEFIMP	(LGT,		"LGT",		,LGT,LGT,	"L1:*:String_A=A1,String_B=A1")
+DEFIMP	(LLE,		"LLE",		,LLE,LLE,	"L1:*:String_A=A1,String_B=A1")
+DEFIMP	(LLT,		"LLT",		,LLT,LLT,	"L1:*:String_A=A1,String_B=A1")
+DEFIMP	(LOG,		"LOG",		L_LOG,ALOG,,	"F=:0:X=F*")
+DEFIMP	(LOG10,		"LOG10",	L_LOG10,ALOG10,,"R=:0:X=R*")
+DEFIMP	(MAX,		"MAX",		,,,		"S=:*:A=pS*")
+DEFIMP	(MIN,		"MIN",		,,,		"S=:*:A=pS*")
+DEFIMP	(MAX0,		"MAX0",		,,,		"I1:*:A=pI1")
+DEFIMP	(MAX1,		"MAX1",		,,,		"I1:*:A=pR1")
+DEFIMP	(MIN0,		"MIN0",		,,,		"I1:*:A=pI1")
+DEFIMP	(MIN1,		"MIN1",		,,,		"I1:*:A=pR1")
+DEFIMP	(MOD,		"MOD",		,MOD,MOD,	"S=:*:A=S*,P=S*")
+DEFIMP	(NINT,		"NINT",		,NINT,NINT,	"I1:-:A=R*")
+DEFIMP	(REAL,		"REAL",		,,,		"RC:0:A=N*")
+DEFIMP	(SIGN,		"SIGN",		,SIGN,,		"S=:*:A=S*,B=S*")
+DEFIMP	(SIN,		"SIN",		L_SIN,SIN,,	"F=:0:X=F*")
+DEFIMP	(SINH,		"SINH",		L_SINH,SINH,,	"R=:0:X=R*")
+DEFIMP	(SNGL,		"SNGL",		,,,		"R1:-:A=R2")
+DEFIMP	(SQRT,		"SQRT",		L_SQRT,SQRT,,	"F=:0:X=F*")
+DEFIMP	(TAN,		"TAN",		L_TAN,TAN,,	"R=:0:X=R*")
+DEFIMP	(TANH,		"TANH",		L_TANH,TANH,,	"R=:0:X=R*")
+
+DEFIMP	(ABORT,		"ABORT",	ABORT,,,	"--:-:")
+DEFIMP	(ACCESS,	"ACCESS",	ACCESS,,,	"I1:-:Name=A1,Mode=A1")
+DEFIMP	(ACHAR,		"ACHAR",	,,,		"A1:-:I=I*")
+DEFIMP	(ALARM,		"ALARM",	ALARM,,,	"--:-:Seconds=I*,Handler=s*,Status=?I1w")
+DEFIMP	(AND,		"AND",		,,,		"B=:*:I=B*,J=B*")
+DEFIMP	(BESJ0,		"BESJ0",	L_BESJ0,,,	"R=:0:X=R*")
+DEFIMP	(BESJ1,		"BESJ1",	L_BESJ1,,,	"R=:0:X=R*")
+DEFIMP	(BESJN,		"BESJN",	L_BESJN,,,	"R=:1:N=IN,X=R*")
+DEFIMP	(BESY0,		"BESY0",	L_BESY0,,,	"R=:0:X=R*")
+DEFIMP	(BESY1,		"BESY1",	L_BESY1,,,	"R=:0:X=R*")
+DEFIMP	(BESYN,		"BESYN",	L_BESYN,,,	"R=:1:N=IN,X=R*")
+DEFIMP	(BIT_SIZE,	"BIT_SIZE",	,,,		"I=:0:I=I*i")
+DEFIMP	(BTEST,		"BTEST",	,,,		"L1:*:I=I*,Pos=I*")
+DEFIMP	(CDABS,		"CDABS",	,CDABS,,	"R2:-:A=C2")
+DEFIMP	(CDCOS,		"CDCOS",	,CDCOS,,	"C2:-:X=C2")
+DEFIMP	(CDEXP,		"CDEXP",	,CDEXP,,	"C2:-:X=C2")
+DEFIMP	(CDLOG,		"CDLOG",	,CDLOG,,	"C2:-:X=C2")
+DEFIMP	(CDSIN,		"CDSIN",	,CDSIN,,	"C2:-:X=C2")
+DEFIMP	(CDSQRT,	"CDSQRT",	,CDSQRT,,	"C2:-:X=C2")
+DEFIMP	(CHDIR_func,	"CHDIR_func",	CHDIR,,,	"I1:-:Dir=A1")
+DEFIMP	(CHDIR_subr,	"CHDIR_subr",	CHDIR,,,	"--:-:Dir=A1,Status=?I1w")
+DEFIMP	(CHMOD_func,	"CHMOD_func",	CHMOD,,,	"I1:-:Name=A1,Mode=A1")
+DEFIMP	(CHMOD_subr,	"CHMOD_subr",	CHMOD,,,	"--:-:Name=A1,Mode=A1,Status=?I1w")
+DEFIMP	(COMPLEX,	"COMPLEX",	,,,		"C=:*:Real=S*,Imag=S*")
+DEFIMP	(CPU_TIME,	"CPU_TIME",	SECOND,,,	"--:-:Seconds=R*w")
+DEFIMP	(CTIME_func,	"CTIME_func",	CTIME,,,	"A1*:-:STime=I*")
+DEFIMP	(CTIME_subr,	"CTIME_subr",	CTIME,,,	"--:-:STime=I*,Result=A1w")
+DEFIMPY	(DATE,		"DATE",		DATE,,,		"--:-:Date=A1w",	TRUE)
+DEFIMP	(DATE_AND_TIME,	"DATE_AND_TIME", DATE_AND_TIME,,, "--:-:Date=A1w,Time=?A1w,Zone=?A1w,Values=?I1(8)w")
+DEFIMP	(DBESJ0,	"DBESJ0",	L_BESJ0,,,	"R2:-:X=R2")
+DEFIMP	(DBESJ1,	"DBESJ1",	L_BESJ1,,,	"R2:-:X=R2")
+DEFIMP	(DBESJN,	"DBESJN",	L_BESJN,,,	"R2:-:N=IN,X=R2")
+DEFIMP	(DBESY0,	"DBESY0",	L_BESY0,,,	"R2:-:X=R2")
+DEFIMP	(DBESY1,	"DBESY1",	L_BESY1,,,	"R2:-:X=R2")
+DEFIMP	(DBESYN,	"DBESYN",	L_BESYN,,,	"R2:-:N=IN,X=R2")
+DEFIMP	(DCONJG,	"DCONJG",	,DCONJG,,	"C2:-:Z=C2")
+DEFIMP	(DERF,		"DERF",		L_ERF,DERF,,	"R2:-:X=R2")
+DEFIMP	(DERFC,		"DERFC",	L_ERFC,DERFC,,	"R2:-:X=R2")
+DEFIMP	(DFLOAT,	"DFLOAT",	,,,		"R2:-:A=I*")
+DEFIMP	(DIMAG,		"DIMAG",	,DIMAG,,	"R2:-:Z=C2")
+DEFIMP	(DREAL,		"DREAL",	,,,		"R2:-:A=N*")
+DEFIMP	(DTIME_func,	"DTIME_func",	DTIME,,,	"R1:-:TArray=R1(2)w")
+DEFIMP	(DTIME_subr,	"DTIME_subr",	DTIME,,,	"--:-:TArray=R1(2)w,Result=R1w")
+DEFIMP	(ERF,		"ERF",		L_ERF,ERF,,	"R=:0:X=R*")
+DEFIMP	(ERFC,		"ERFC",		L_ERFC,ERFC,,	"R=:0:X=R*")
+DEFIMP	(ETIME_func,	"ETIME_func",	ETIME,,,	"R1:-:TArray=R1(2)w")
+DEFIMP	(ETIME_subr,	"ETIME_subr",	ETIME,,,	"--:-:TArray=R1(2)w,Result=R1w")
+DEFIMP	(EXIT,		"EXIT",		EXIT,,,		"--:-:Status=?IN")
+DEFIMP	(FDATE_func,	"FDATE_func",	FDATE,,,	"A1*:-:")
+DEFIMP	(FDATE_subr,	"FDATE_subr",	FDATE,,,	"--:-:Date=A1w")
+DEFIMP	(FGET_func,	"FGET_func",	FGET,,,		"I1:-:C=A1w")
+DEFIMP	(FGET_subr,	"FGET_subr",	FGET,,,		"--:-:C=A1w,Status=?I1w")
+DEFIMP	(FGETC_func,	"FGETC_func",	FGETC,,,	"I1:-:Unit=I*,C=A1w")
+DEFIMP	(FGETC_subr,	"FGETC_subr",	FGETC,,,	"--:-:Unit=I*,C=A1w,Status=?I1w")
+DEFIMP	(FLUSH,		"FLUSH",	,,,		"--:-:Unit=?I*")
+DEFIMP	(FNUM,		"FNUM",		FNUM,,,		"I1:-:Unit=I*")
+DEFIMP	(FPUT_func,	"FPUT_func",	FPUT,,,		"I1:-:C=A1")
+DEFIMP	(FPUT_subr,	"FPUT_subr",	FPUT,,,		"--:-:C=A1,Status=?I1w")
+DEFIMP	(FPUTC_func,	"FPUTC_func",	FPUTC,,,	"I1:-:Unit=I*,C=A1")
+DEFIMP	(FPUTC_subr,	"FPUTC_subr",	FPUTC,,,	"--:-:Unit=I*,C=A1,Status=?I1w")
+DEFIMP	(FSEEK,		"FSEEK",	FSEEK,,,	"--:-:Unit=I*,Offset=I*,Whence=I*,ErrLab=?g*")
+DEFIMP	(FSTAT_func,	"FSTAT_func",	FSTAT,,,	"I1:-:Unit=I*,SArray=I1(13)w")
+DEFIMP	(FSTAT_subr,	"FSTAT_subr",	FSTAT,,,	"--:-:Unit=I*,SArray=I1(13)w,Status=?I1w")
+DEFIMP	(FTELL_func,	"FTELL_func",	FTELL,,,	"I1:-:Unit=I*")
+DEFIMP	(FTELL_subr,	"FTELL_subr",	FTELL,,,	"--:-:Unit=I*,Offset=I1w")
+DEFIMP	(GERROR,	"GERROR",	GERROR,,,	"--:-:Message=A1w")
+DEFIMP	(GETARG,	"GETARG",	GETARG,,,	"--:-:Pos=IN,Value=A1w")
+DEFIMP	(GETCWD_func,	"GETCWD_func",	GETCWD,,,	"I1:-:Name=A1w")
+DEFIMP	(GETCWD_subr,	"GETCWD_subr",	GETCWD,,,	"--:-:Name=A1w,Status=?I1w")
+DEFIMP	(GETGID,	"GETGID",	GETGID,,,	"I1:-:")
+DEFIMP	(GETLOG,	"GETLOG",	GETLOG,,,	"--:-:Login=A1w")
+DEFIMP	(GETPID,	"GETPID",	GETPID,,,	"I1:-:")
+DEFIMP	(GETUID,	"GETUID",	GETUID,,,	"I1:-:")
+DEFIMP	(GETENV,	"GETENV",	GETENV,,,	"--:-:Name=A1,Value=A1w")
+DEFIMP	(GMTIME,	"GMTIME",	GMTIME,,,	"--:-:STime=I1,TArray=I1(9)w")
+DEFIMP	(HOSTNM_func,	"HOSTNM_func",	HOSTNM,,,	"I1:-:Name=A1w")
+DEFIMP	(HOSTNM_subr,	"HOSTNM_subr",	HOSTNM,,,	"--:-:Name=A1w,Status=?I1w")
+DEFIMP	(IACHAR,	"IACHAR",	,,,		"I1:-:C=A*")
+DEFIMP	(IAND,		"IAND",		,,,		"I=:*:I=I*,J=I*")
+DEFIMP	(IARGC,		"IARGC",	IARGC,,,	"I1:-:")
+DEFIMP	(IBCLR,		"IBCLR",	,,,		"I=:0:I=I*,Pos=I*")
+DEFIMP	(IBITS,		"IBITS",	,,,		"I=:0:I=I*,Pos=I*,Len=I*")
+DEFIMP	(IBSET,		"IBSET",	,,,		"I=:0:I=I*,Pos=I*")
+DEFIMP	(IDATE_unix,	"IDATE_unix",	IDATE,,,	"--:-:TArray=I1(3)w")
+DEFIMPY	(IDATE_vxt,	"IDATE_vxt",	VXTIDATE,,,	"--:-:M=I1w,D=I1w,Y=I1w",	TRUE)
+DEFIMP	(IEOR,		"IEOR",		,,,		"I=:*:I=I*,J=I*")
+DEFIMP	(IOR,		"IOR",		,,,		"I=:*:I=I*,J=I*")
+DEFIMP	(IERRNO,	"IERRNO",	IERRNO,,,	"I1:-:")
+DEFIMP	(IMAGPART,	"IMAGPART",	,,,		"R=:0:Z=C*")
+DEFIMP	(INT2,		"INT2",		,,,		"I6:-:A=N*")
+DEFIMP	(INT8,		"INT8",		,,,		"I2:-:A=N*")
+DEFIMP	(IRAND,		"IRAND",	IRAND,,,	"I1:-:Flag=?I*")
+DEFIMP	(ISATTY,	"ISATTY",	ISATTY,,,	"L1:-:Unit=I*")
+DEFIMP	(ISHFT,		"ISHFT",	,,,		"I=:0:I=I*,Shift=I*")
+DEFIMP	(ISHFTC,	"ISHFTC",	,,,		"I=:0:I=I*,Shift=I*,Size=I*")
+DEFIMP	(ITIME,		"ITIME",	ITIME,,,	"--:-:TArray=I1(3)w")
+DEFIMP	(KILL_func,	"KILL_func",	KILL,,,		"I1:-:Pid=I*,Signal=I*")
+DEFIMP	(KILL_subr,	"KILL_subr",	KILL,,,		"--:-:Pid=I*,Signal=I*,Status=?I1w")
+DEFIMP	(LINK_func,	"LINK_func",	LINK,,,		"I1:-:Path1=A1,Path2=A1")
+DEFIMP	(LINK_subr,	"LINK_subr",	LINK,,,		"--:-:Path1=A1,Path2=A1,Status=?I1w")
+DEFIMP	(LNBLNK,	"LNBLNK",	LNBLNK,,,	"I1:-:String=A1")
+DEFIMP	(LONG,		"LONG",		,,,		"I1:-:A=I6")
+DEFIMP	(LSTAT_func,	"LSTAT_func",	LSTAT,,,	"I1:-:File=A1,SArray=I1(13)w")
+DEFIMP	(LSTAT_subr,	"LSTAT_subr",	LSTAT,,,	"--:-:File=A1,SArray=I1(13)w,Status=?I1w")
+DEFIMP	(LTIME,		"LTIME",	LTIME,,,	"--:-:STime=I1,TArray=I1(9)w")
+DEFIMP	(LOC,		"LOC",		,,,		"I7:-:Entity=-*&&")
+DEFIMP	(LSHIFT,	"LSHIFT",	,,,		"I=:0:I=I*,Shift=I*")
+DEFIMP	(MCLOCK,	"MCLOCK",	MCLOCK,,,	"I1:-:")
+DEFIMP	(MCLOCK8,	"MCLOCK8",	MCLOCK,,,	"I2:-:")
+DEFIMP	(MVBITS,	"MVBITS",	,,,		"--:-:From=I*,FromPos=I*,Len=I*,TO=IAx,ToPos=I*")
+DEFIMP	(NOT,		"NOT",		,,,		"I=:0:I=I*")
+DEFIMP	(OR,		"OR",		,,,		"B=:*:I=B*,J=B*")
+DEFIMP	(PERROR,	"PERROR",	PERROR,,,	"--:-:String=A1")
+DEFIMP	(RAND,		"RAND",		RAND,,,		"R1:-:Flag=?I*")
+DEFIMP	(REALPART,	"REALPART",	,,,		"R=:0:Z=C*")
+DEFIMP	(RENAME_func,	"RENAME_func",	RENAME,,,	"I1:-:Path1=A1,Path2=A1")
+DEFIMP	(RENAME_subr,	"RENAME_subr",	RENAME,,,	"--:-:Path1=A1,Path2=A1,Status=?I1w")
+DEFIMP	(RSHIFT,	"RSHIFT",	,,,		"I=:0:I=I*,Shift=I*")
+DEFIMP	(SECNDS,	"SECNDS",	SECNDS,,,	"R1:-:T=R1")
+DEFIMP	(SECOND_func,	"SECOND_func",	SECOND,SECOND,,	"R1:-:")
+DEFIMP	(SECOND_subr,	"SECOND_subr",	SECOND,,,	"--:-:Seconds=R*w")
+DEFIMP	(SHORT,		"SHORT",	,,,		"I6:-:A=I*")
+DEFIMP	(SIGNAL_func,	"SIGNAL_func",	L_SIGNAL,,,	"I7:-:Number=I*,Handler=s*")
+DEFIMP	(SIGNAL_subr,	"SIGNAL_subr",	L_SIGNAL,,,	"--:-:Number=I*,Handler=s*,Status=?I7w")
+DEFIMP	(SLEEP,		"SLEEP",	SLEEP,,,	"--:-:Seconds=I1")
+DEFIMP	(SRAND,		"SRAND",	SRAND,,,	"--:-:Seed=I*")
+DEFIMP	(STAT_func,	"STAT_func",	STAT,,,		"I1:-:File=A1,SArray=I1(13)w")
+DEFIMP	(STAT_subr,	"STAT_subr",	STAT,,,		"--:-:File=A1,SArray=I1(13)w,Status=?I1w")
+DEFIMP	(SYMLNK_func,	"SYMLNK_func",	SYMLNK,,,	"I1:-:Path1=A1,Path2=A1")
+DEFIMP	(SYMLNK_subr,	"SYMLNK_subr",	SYMLNK,,,	"--:-:Path1=A1,Path2=A1,Status=?I1w")
+DEFIMP	(SYSTEM_func,	"SYSTEM_func",	SYSTEM,SYSTEM,SYSTEM,"I1:-:Command=A1")
+DEFIMP	(SYSTEM_subr,	"SYSTEM_subr",	SYSTEM,,,	"--:-:Command=A1,Status=?I1w")
+DEFIMP	(SYSTEM_CLOCK,	"SYSTEM_CLOCK",	SYSTEM_CLOCK,,,	"--:-:Count=I1w,Rate=?I1w,Max=?I1w")
+DEFIMP	(TIME8,		"TIME8",	TIME,,,		"I2:-:")
+DEFIMP	(TIME_unix,	"TIME_unix",	TIME,,,		"I1:-:")
+DEFIMP	(TIME_vxt,	"TIME_vxt",	VXTTIME,,,	"--:-:Time=A1[8]w")
+DEFIMP	(TTYNAM_func,	"TTYNAM_func",	TTYNAM,,,	"A1*:-:Unit=I*")
+DEFIMP	(TTYNAM_subr,	"TTYNAM_subr",	TTYNAM,,,	"--:-:Unit=I*,Name=A1w")
+DEFIMP	(UMASK_func,	"UMASK_func",	UMASK,,,	"I1:-:Mask=I*")
+DEFIMP	(UMASK_subr,	"UMASK_subr",	UMASK,,,	"--:-:Mask=I*,Old=?I1w")
+DEFIMP	(UNLINK_func,	"UNLINK_func",	UNLINK,,,	"I1:-:File=A1")
+DEFIMP	(UNLINK_subr,	"UNLINK_subr",	UNLINK,,,	"--:-:File=A1,Status=?I1w")
+DEFIMP	(XOR,		"XOR",		,,,		"B=:*:I=B*,J=B*")
+DEFIMP	(NONE,		"none",		,,,		"")
diff --git a/gcc/f/intrin.h b/gcc/f/intrin.h
new file mode 100644
index 00000000000..e741e69b4ec
--- /dev/null
+++ b/gcc/f/intrin.h
@@ -0,0 +1,135 @@
+/* intrin.h -- Public interface for intrin.c
+   Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+*/
+
+#ifndef GCC_F_INTRIN_H
+#define GCC_F_INTRIN_H
+
+#ifndef FFEINTRIN_DOC
+#define FFEINTRIN_DOC 0	/* 1 means intrinsic documentation only (intdoc.c). */
+#endif
+
+typedef enum
+  {
+    FFEINTRIN_familyNONE,	/* Not in any family. */
+    FFEINTRIN_familyF77,	/* ANSI FORTRAN 77. */
+    FFEINTRIN_familyGNU,	/* GNU Fortran intrinsics. */
+    FFEINTRIN_familyF2C,	/* f2c intrinsics. */
+    FFEINTRIN_familyF90,	/* Fortran 90. */
+    FFEINTRIN_familyF95 = FFEINTRIN_familyF90,
+    FFEINTRIN_familyVXT,	/* VAX/VMS FORTRAN. */
+    FFEINTRIN_familyMIL,	/* MIL STD 1753 (MVBITS, etc), in mil, vxt, and f90. */
+    FFEINTRIN_familyASC,	/* ASCII-related (ACHAR, IACHAR), both f2c and f90. */
+    FFEINTRIN_familyFVZ,	/* in both f2c and VAX/VMS FORTRAN. */
+    FFEINTRIN_familyF2U,	/* libf2c/libU77 UNIX system intrinsics. */
+    FFEINTRIN_familyBADU77,	/* libU77 UNIX system intrinsics with bad form. */
+    FFEINTRIN_family
+  } ffeintrinFamily;
+
+typedef enum
+  {
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2) FFEINTRIN_gen ## CODE,
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+#undef DEFIMPY
+    FFEINTRIN_gen
+  } ffeintrinGen;
+
+typedef enum
+  {
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) FFEINTRIN_spec ## CODE,
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+#undef DEFIMPY
+    FFEINTRIN_spec
+  } ffeintrinSpec;
+
+typedef enum
+  {
+#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
+#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
+#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
+#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
+    FFEINTRIN_imp ## CODE,
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
+    FFEINTRIN_imp ## CODE,
+#include "intrin.def"
+#undef DEFNAME
+#undef DEFGEN
+#undef DEFSPEC
+#undef DEFIMP
+#undef DEFIMPY
+    FFEINTRIN_imp
+  } ffeintrinImp;
+
+#if !FFEINTRIN_DOC
+
+#include "bld.h"
+#include "info.h"
+
+ffeinfoBasictype ffeintrin_basictype (ffeintrinSpec spec);
+ffeintrinFamily ffeintrin_family (ffeintrinSpec spec);
+void ffeintrin_fulfill_generic (ffebld *expr, ffeinfo *info, ffelexToken t);
+void ffeintrin_fulfill_specific (ffebld *expr, ffeinfo *info,
+				 bool *check_intrin, ffelexToken t);
+ffecomGfrt ffeintrin_gfrt_direct (ffeintrinImp imp);
+ffecomGfrt ffeintrin_gfrt_indirect (ffeintrinImp imp);
+void ffeintrin_init_0 (void);
+#define ffeintrin_init_1()
+#define ffeintrin_init_2()
+#define ffeintrin_init_3()
+#define ffeintrin_init_4()
+bool ffeintrin_is_actualarg (ffeintrinSpec spec);
+bool ffeintrin_is_intrinsic (const char *name, ffelexToken t, bool explicit,
+			     ffeintrinGen *gen, ffeintrinSpec *spec,
+			     ffeintrinImp *imp);
+bool ffeintrin_is_standard (ffeintrinGen gen, ffeintrinSpec spec);
+ffeinfoKindtype ffeintrin_kindtype (ffeintrinSpec spec);
+const char *ffeintrin_name_generic (ffeintrinGen gen);
+const char *ffeintrin_name_implementation (ffeintrinImp imp);
+const char *ffeintrin_name_specific (ffeintrinSpec spec);
+ffeIntrinsicState ffeintrin_state_family (ffeintrinFamily family);
+#define ffeintrin_terminate_0()
+#define ffeintrin_terminate_1()
+#define ffeintrin_terminate_2()
+#define ffeintrin_terminate_3()
+#define ffeintrin_terminate_4()
+
+#endif	/* !FFEINTRIN_DOC */
+
+/* End of #include file. */
+
+#endif /* ! GCC_F_INTRIN_H */
diff --git a/gcc/f/invoke.texi b/gcc/f/invoke.texi
new file mode 100644
index 00000000000..fd1b80412a6
--- /dev/null
+++ b/gcc/f/invoke.texi
@@ -0,0 +1,2233 @@
+@c Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004
+@c Free Software Foundation, Inc.
+@c This is part of the G77 manual.   
+@c For copying conditions, see the file g77.texi.
+
+@ignore
+@c man begin COPYRIGHT
+Copyright @copyright{} 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004
+Free Software Foundation, Inc.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.2 or
+any later version published by the Free Software Foundation; with the
+Invariant Sections being ``GNU General Public License'' and ``Funding
+Free Software'', the Front-Cover texts being (a) (see below), and with
+the Back-Cover Texts being (b) (see below).  A copy of the license is
+included in the gfdl(7) man page.
+ 
+(a) The FSF's Front-Cover Text is:
+
+     A GNU Manual
+
+(b) The FSF's Back-Cover Text is:
+
+     You have freedom to copy and modify this GNU Manual, like GNU
+     software.  Copies published by the Free Software Foundation raise
+     funds for GNU development.
+@c man end
+@c Set file name and title for the man page.
+@setfilename g77
+@settitle GNU project Fortran 77 compiler.
+@c man begin SYNOPSIS
+g77 [@option{-c}|@option{-S}|@option{-E}]
+    [@option{-g}] [@option{-pg}] [@option{-O}@var{level}]
+    [@option{-W}@var{warn}@dots{}] [@option{-pedantic}]
+    [@option{-I}@var{dir}@dots{}] [@option{-L}@var{dir}@dots{}]
+    [@option{-D}@var{macro}[=@var{defn}]@dots{}] [@option{-U}@var{macro}]
+    [@option{-f}@var{option}@dots{}] [@option{-m}@var{machine-option}@dots{}]
+    [@option{-o} @var{outfile}] @var{infile}@dots{}
+
+Only the most useful options are listed here; see below for the
+remainder.
+@c man end
+@c man begin SEEALSO
+gpl(7), gfdl(7), fsf-funding(7),
+cpp(1), gcov(1), gcc(1), as(1), ld(1), gdb(1), adb(1), dbx(1), sdb(1)
+and the Info entries for @file{gcc}, @file{cpp}, @file{g77}, @file{as},
+@file{ld}, @file{binutils} and @file{gdb}.
+@c man end
+@c man begin BUGS
+For instructions on reporting bugs, see
+@w{@uref{http://gcc.gnu.org/bugs.html}}.  Use of the @command{gccbug}  
+script to report bugs is recommended.
+@c man end
+@c man begin AUTHOR
+See the Info entry for @command{g77} for contributors to GCC and G77@.
+@c man end
+@end ignore
+
+@node Invoking G77
+@chapter GNU Fortran Command Options
+@cindex GNU Fortran command options
+@cindex command options
+@cindex options, GNU Fortran command
+
+@c man begin DESCRIPTION
+
+The @command{g77} command supports all the options supported by the
+@command{gcc} command.
+@xref{Invoking GCC,,GCC Command Options,gcc,Using the GNU Compiler
+Collection (GCC)}, for information
+on the non-Fortran-specific aspects of the @command{gcc} command (and,
+therefore, the @command{g77} command).
+
+@cindex options, negative forms
+@cindex negative forms of options
+All @command{gcc} and @command{g77} options
+are accepted both by @command{g77} and by @command{gcc}
+(as well as any other drivers built at the same time,
+such as @command{g++}),
+since adding @command{g77} to the @command{gcc} distribution
+enables acceptance of @command{g77} options
+by all of the relevant drivers.
+
+In some cases, options have positive and negative forms;
+the negative form of @option{-ffoo} would be @option{-fno-foo}.
+This manual documents only one of these two forms, whichever
+one is not the default.
+
+@c man end
+
+@menu
+* Option Summary::      Brief list of all @command{g77} options,
+                        without explanations.
+* Overall Options::     Controlling the kind of output:
+                        an executable, object files, assembler files,
+                        or preprocessed source.
+* Shorthand Options::   Options that are shorthand for other options.
+* Fortran Dialect Options::  Controlling the variant of Fortran language
+                             compiled.
+* Warning Options::     How picky should the compiler be?
+* Debugging Options::   Symbol tables, measurements, and debugging dumps.
+* Optimize Options::    How much optimization?
+* Preprocessor Options:: Controlling header files and macro definitions.
+                         Also, getting dependency information for Make.
+* Directory Options::   Where to find header files and libraries.
+                        Where to find the compiler executable files.
+* Code Gen Options::    Specifying conventions for function calls, data layout
+                        and register usage.
+* Environment Variables:: Env vars that affect GNU Fortran.
+@end menu
+
+@node Option Summary
+@section Option Summary
+
+@c man begin OPTIONS
+
+Here is a summary of all the options specific to GNU Fortran, grouped
+by type.  Explanations are in the following sections.
+
+@table @emph
+@item Overall Options
+@xref{Overall Options,,Options Controlling the Kind of Output}.
+@gccoptlist{
+-fversion  -fset-g77-defaults  -fno-silent}
+
+@item Shorthand Options
+@xref{Shorthand Options}.
+@gccoptlist{
+-ff66  -fno-f66  -ff77  -fno-f77  -fno-ugly}
+
+@item Fortran Language Options
+@xref{Fortran Dialect Options,,Options Controlling Fortran Dialect}.
+@gccoptlist{
+-ffree-form  -fno-fixed-form  -ff90 @gol
+-fvxt  -fdollar-ok  -fno-backslash @gol
+-fno-ugly-args  -fno-ugly-assign  -fno-ugly-assumed @gol
+-fugly-comma  -fugly-complex  -fugly-init  -fugly-logint @gol
+-fonetrip  -ftypeless-boz @gol
+-fintrin-case-initcap  -fintrin-case-upper @gol
+-fintrin-case-lower  -fintrin-case-any @gol
+-fmatch-case-initcap  -fmatch-case-upper @gol
+-fmatch-case-lower  -fmatch-case-any @gol
+-fsource-case-upper  -fsource-case-lower @gol
+-fsource-case-preserve @gol
+-fsymbol-case-initcap  -fsymbol-case-upper @gol
+-fsymbol-case-lower  -fsymbol-case-any @gol
+-fcase-strict-upper  -fcase-strict-lower @gol
+-fcase-initcap  -fcase-upper  -fcase-lower  -fcase-preserve @gol
+-ff2c-intrinsics-delete  -ff2c-intrinsics-hide @gol
+-ff2c-intrinsics-disable  -ff2c-intrinsics-enable @gol
+-fbadu77-intrinsics-delete  -fbadu77-intrinsics-hide @gol
+-fbadu77-intrinsics-disable  -fbadu77-intrinsics-enable @gol
+-ff90-intrinsics-delete  -ff90-intrinsics-hide @gol
+-ff90-intrinsics-disable  -ff90-intrinsics-enable @gol
+-fgnu-intrinsics-delete  -fgnu-intrinsics-hide @gol
+-fgnu-intrinsics-disable  -fgnu-intrinsics-enable @gol
+-fmil-intrinsics-delete  -fmil-intrinsics-hide @gol
+-fmil-intrinsics-disable  -fmil-intrinsics-enable @gol
+-funix-intrinsics-delete  -funix-intrinsics-hide @gol
+-funix-intrinsics-disable  -funix-intrinsics-enable @gol
+-fvxt-intrinsics-delete  -fvxt-intrinsics-hide @gol
+-fvxt-intrinsics-disable  -fvxt-intrinsics-enable @gol
+-ffixed-line-length-@var{n}  -ffixed-line-length-none}
+
+@item Warning Options
+@xref{Warning Options,,Options to Request or Suppress Warnings}.
+@gccoptlist{
+-fsyntax-only  -pedantic  -pedantic-errors  -fpedantic @gol
+-w  -Wno-globals  -Wimplicit  -Wunused  -Wuninitialized @gol
+-Wall  -Wsurprising @gol
+-Werror  -W}
+
+@item Debugging Options
+@xref{Debugging Options,,Options for Debugging Your Program or GCC}.
+@gccoptlist{
+-g}
+
+@item Optimization Options
+@xref{Optimize Options,,Options that Control Optimization}.
+@gccoptlist{
+-malign-double @gol
+-ffloat-store  -fforce-mem  -fforce-addr  -fno-inline @gol
+-ffast-math  -fstrength-reduce  -frerun-cse-after-loop @gol
+-funsafe-math-optimizations -ffinite-math-only -fno-trapping-math @gol
+-fexpensive-optimizations  -fdelayed-branch @gol
+-fschedule-insns  -fschedule-insn2  -fcaller-saves @gol
+-funroll-loops  -funroll-all-loops @gol
+-fno-move-all-movables  -fno-reduce-all-givs @gol
+-fno-rerun-loop-opt}
+
+@item Directory Options
+@xref{Directory Options,,Options for Directory Search}.
+@gccoptlist{
+-I@var{dir}  -I-}
+
+@item Code Generation Options
+@xref{Code Gen Options,,Options for Code Generation Conventions}.
+@gccoptlist{
+-fno-automatic  -finit-local-zero  -fno-f2c @gol
+-ff2c-library  -fno-underscoring  -fno-ident @gol
+-fpcc-struct-return  -freg-struct-return @gol
+-fshort-double  -fno-common  -fpack-struct @gol
+-fzeros  -fno-second-underscore @gol
+-femulate-complex @gol
+-falias-check  -fargument-alias @gol
+-fargument-noalias  -fno-argument-noalias-global @gol
+-fno-globals  -fflatten-arrays @gol
+-fbounds-check  -ffortran-bounds-check}
+@end table
+
+@c man end
+
+@menu
+* Overall Options::     Controlling the kind of output:
+                        an executable, object files, assembler files,
+                        or preprocessed source.
+* Shorthand Options::   Options that are shorthand for other options.
+* Fortran Dialect Options::  Controlling the variant of Fortran language
+                             compiled.
+* Warning Options::     How picky should the compiler be?
+* Debugging Options::   Symbol tables, measurements, and debugging dumps.
+* Optimize Options::    How much optimization?
+* Preprocessor Options:: Controlling header files and macro definitions.
+                         Also, getting dependency information for Make.
+* Directory Options::   Where to find header files and libraries.
+                        Where to find the compiler executable files.
+* Code Gen Options::    Specifying conventions for function calls, data layout
+                        and register usage.
+@end menu
+
+@node Overall Options
+@section Options Controlling the Kind of Output
+@cindex overall options
+@cindex options, overall
+
+@c man begin OPTIONS
+
+Compilation can involve as many as four stages: preprocessing, code
+generation (often what is really meant by the term ``compilation''),
+assembly, and linking, always in that order.  The first three
+stages apply to an individual source file, and end by producing an
+object file; linking combines all the object files (those newly
+compiled, and those specified as input) into an executable file.
+
+@cindex file name suffix
+@cindex suffixes, file name
+@cindex file name extension
+@cindex extensions, file name
+@cindex file type
+@cindex types, file
+For any given input file, the file name suffix determines what kind of
+program is contained in the file---that is, the language in which the
+program is written is generally indicated by the suffix.
+Suffixes specific to GNU Fortran are listed below.
+@xref{Overall Options,,Options Controlling the Kind of
+Output,gcc,Using the GNU Compiler Collection (GCC)}, for
+information on suffixes recognized by GCC.
+
+@table @gcctabopt
+@cindex .f filename suffix
+@cindex .for filename suffix
+@cindex .FOR filename suffix
+@item @var{file}.f
+@item @var{file}.for
+@item @var{file}.FOR
+Fortran source code that should not be preprocessed.
+
+Such source code cannot contain any preprocessor directives, such
+as @code{#include}, @code{#define}, @code{#if}, and so on.
+
+You can force @samp{.f} files to be preprocessed by @command{cpp} by using
+@option{-x f77-cpp-input}.
+@xref{LEX}.
+
+@cindex preprocessor
+@cindex C preprocessor
+@cindex cpp preprocessor
+@cindex Fortran preprocessor
+@cindex cpp program
+@cindex programs, cpp
+@cindex .F filename suffix
+@cindex .fpp filename suffix
+@cindex .FPP filename suffix
+@item @var{file}.F
+@item @var{file}.fpp
+@item @var{file}.FPP
+Fortran source code that must be preprocessed (by the C preprocessor
+@command{cpp}, which is part of GCC).
+
+Note that preprocessing is not extended to the contents of
+files included by the @code{INCLUDE} directive---the @code{#include}
+preprocessor directive must be used instead.
+
+@cindex Ratfor preprocessor
+@cindex programs, @command{ratfor}
+@cindex @samp{.r} filename suffix
+@cindex @command{ratfor}
+@item @var{file}.r
+Ratfor source code, which must be preprocessed by the @command{ratfor}
+command, which is available separately (as it is not yet part of the GNU
+Fortran distribution).
+A public domain version in C is at
+@uref{http://sepwww.stanford.edu/sep/prof/ratfor.shar.2}.
+@end table
+
+UNIX users typically use the @file{@var{file}.f} and @file{@var{file}.F}
+nomenclature.
+Users of other operating systems, especially those that cannot
+distinguish upper-case
+letters from lower-case letters in their file names, typically use
+the @file{@var{file}.for} and @file{@var{file}.fpp} nomenclature.
+
+@cindex #define
+@cindex #include
+@cindex #if
+Use of the preprocessor @command{cpp} allows use of C-like
+constructs such as @code{#define} and @code{#include}, but can
+lead to unexpected, even mistaken, results due to Fortran's source file
+format.
+It is recommended that use of the C preprocessor
+be limited to @code{#include} and, in
+conjunction with @code{#define}, only @code{#if} and related directives,
+thus avoiding in-line macro expansion entirely.
+This recommendation applies especially
+when using the traditional fixed source form.
+With free source form,
+fewer unexpected transformations are likely to happen, but use of
+constructs such as Hollerith and character constants can nevertheless
+present problems, especially when these are continued across multiple
+source lines.
+These problems result, primarily, from differences between the way
+such constants are interpreted by the C preprocessor and by a Fortran
+compiler.
+
+Another example of a problem that results from using the C preprocessor
+is that a Fortran comment line that happens to contain any
+characters ``interesting'' to the C preprocessor,
+such as a backslash at the end of the line,
+is not recognized by the preprocessor as a comment line,
+so instead of being passed through ``raw'',
+the line is edited according to the rules for the preprocessor.
+For example, the backslash at the end of the line is removed,
+along with the subsequent newline, resulting in the next
+line being effectively commented out---unfortunate if that
+line is a non-comment line of important code!
+
+@emph{Note:} The @option{-traditional} and @option{-undef} flags are supplied
+to @command{cpp} by default, to help avoid unpleasant surprises.
+@xref{Preprocessor Options,,Options Controlling the Preprocessor,
+gcc,Using the GNU Compiler Collection (GCC)}.
+This means that ANSI C preprocessor features (such as the @samp{#}
+operator) aren't available, and only variables in the C reserved
+namespace (generally, names with a leading underscore) are liable to
+substitution by C predefines.
+Thus, if you want to do system-specific
+tests, use, for example, @samp{#ifdef __linux__} rather than @samp{#ifdef linux}.
+Use the @option{-v} option to see exactly how the preprocessor is invoked.
+
+@cindex /*
+Unfortunately, the @option{-traditional} flag will not avoid an error from
+anything that @command{cpp} sees as an unterminated C comment, such as:
+@smallexample
+C Some Fortran compilers accept /* as starting
+C an inline comment.
+@end smallexample
+@xref{Trailing Comment}.
+
+The following options that affect overall processing are recognized
+by the @command{g77} and @command{gcc} commands in a GNU Fortran installation:
+
+@table @gcctabopt
+@cindex -fversion option
+@cindex options, -fversion
+@cindex printing version information
+@cindex version information, printing
+@cindex consistency checks
+@cindex internal consistency checks
+@cindex checks, of internal consistency
+@item -fversion
+Ensure that the @command{g77} version of the compiler phase is reported,
+if run,
+and, starting in @code{egcs} version 1.1,
+that internal consistency checks in the @file{f771} program are run.
+
+This option is supplied automatically when @option{-v} or @option{--verbose}
+is specified as a command-line option for @command{g77} or @command{gcc}
+and when the resulting commands compile Fortran source files.
+
+In GCC 3.1, this is changed back to the behavior @command{gcc} displays
+for @samp{.c} files.
+
+@cindex -fset-g77-defaults option
+@cindex options, -fset-g77-defaults
+@item -fset-g77-defaults
+@emph{Version info:}
+This option was obsolete as of @code{egcs}
+version 1.1.
+The effect is instead achieved
+by the @code{lang_init_options} routine
+in @file{gcc/gcc/f/com.c}.
+
+@cindex consistency checks
+@cindex internal consistency checks
+@cindex checks, of internal consistency
+Set up whatever @command{gcc} options are to apply to Fortran
+compilations, and avoid running internal consistency checks
+that might take some time.
+
+This option is supplied automatically when compiling Fortran code
+via the @command{g77} or @command{gcc} command.
+The description of this option is provided so that users seeing
+it in the output of, say, @samp{g77 -v} understand why it is
+there.
+
+@cindex modifying @command{g77}
+@cindex @command{g77}, modifying
+Also, developers who run @code{f771} directly might want to specify it
+by hand to get the same defaults as they would running @code{f771}
+via @command{g77} or @command{gcc}
+However, such developers should, after linking a new @code{f771}
+executable, invoke it without this option once,
+e.g. via @kbd{./f771 -quiet < /dev/null},
+to ensure that they have not introduced any
+internal inconsistencies (such as in the table of
+intrinsics) before proceeding---@command{g77} will crash
+with a diagnostic if it detects an inconsistency.
+
+@cindex -fno-silent option
+@cindex options, -fno-silent
+@cindex f2c compatibility
+@cindex compatibility, f2c
+@cindex status, compilation
+@cindex compilation, status
+@cindex reporting compilation status
+@cindex printing compilation status
+@item -fno-silent
+Print (to @code{stderr}) the names of the program units as
+they are compiled, in a form similar to that used by popular
+UNIX @command{f77} implementations and @command{f2c}
+@end table
+
+@xref{Overall Options,,Options Controlling the Kind of Output,
+gcc,Using the GNU Compiler Collection (GCC)}, for information
+on more options that control the overall operation of the @command{gcc} command
+(and, by extension, the @command{g77} command).
+
+@node Shorthand Options
+@section Shorthand Options
+@cindex shorthand options
+@cindex options, shorthand
+@cindex macro options
+@cindex options, macro
+
+The following options serve as ``shorthand''
+for other options accepted by the compiler:
+
+@table @gcctabopt
+@cindex -fugly option
+@cindex options, -fugly
+@item -fugly
+@cindex ugly features
+@cindex features, ugly
+@emph{Note:} This option is no longer supported.
+The information, below, is provided to aid
+in the conversion of old scripts.
+
+Specify that certain ``ugly'' constructs are to be quietly accepted.
+Same as:
+
+@smallexample
+-fugly-args -fugly-assign -fugly-assumed
+-fugly-comma -fugly-complex -fugly-init
+-fugly-logint
+@end smallexample
+
+These constructs are considered inappropriate to use in new
+or well-maintained portable Fortran code, but widely used
+in old code.
+@xref{Distensions}, for more information.
+
+@cindex -fno-ugly option
+@cindex options, -fno-ugly
+@item -fno-ugly
+@cindex ugly features
+@cindex features, ugly
+Specify that all ``ugly'' constructs are to be noisily rejected.
+Same as:
+
+@smallexample
+-fno-ugly-args -fno-ugly-assign -fno-ugly-assumed
+-fno-ugly-comma -fno-ugly-complex -fno-ugly-init
+-fno-ugly-logint
+@end smallexample
+
+@xref{Distensions}, for more information.
+
+@cindex -ff66 option
+@cindex options, -ff66
+@item -ff66
+@cindex FORTRAN 66
+@cindex compatibility, FORTRAN 66
+Specify that the program is written in idiomatic FORTRAN 66.
+Same as @samp{-fonetrip -fugly-assumed}.
+
+The @option{-fno-f66} option is the inverse of @option{-ff66}.
+As such, it is the same as @samp{-fno-onetrip -fno-ugly-assumed}.
+
+The meaning of this option is likely to be refined as future
+versions of @command{g77} provide more compatibility with other
+existing and obsolete Fortran implementations.
+
+@cindex -ff77 option
+@cindex options, -ff77
+@item -ff77
+@cindex UNIX f77
+@cindex f2c compatibility
+@cindex compatibility, f2c
+@cindex f77 compatibility
+@cindex compatibility, f77
+Specify that the program is written in idiomatic UNIX FORTRAN 77
+and/or the dialect accepted by the @command{f2c} product.
+Same as @samp{-fbackslash -fno-typeless-boz}.
+
+The meaning of this option is likely to be refined as future
+versions of @command{g77} provide more compatibility with other
+existing and obsolete Fortran implementations.
+
+@cindex -fno-f77 option
+@cindex options, -fno-f77
+@item -fno-f77
+@cindex UNIX f77
+The @option{-fno-f77} option is @emph{not} the inverse
+of @option{-ff77}.
+It specifies that the program is not written in idiomatic UNIX
+FORTRAN 77 or @command{f2c} but in a more widely portable dialect.
+@option{-fno-f77} is the same as @option{-fno-backslash}.
+
+The meaning of this option is likely to be refined as future
+versions of @command{g77} provide more compatibility with other
+existing and obsolete Fortran implementations.
+@end table
+
+@node Fortran Dialect Options
+@section Options Controlling Fortran Dialect
+@cindex dialect options
+@cindex language, dialect options
+@cindex options, dialect
+
+The following options control the dialect of Fortran
+that the compiler accepts:
+
+@table @gcctabopt
+@cindex -ffree-form option
+@cindex options, -ffree-form
+@cindex -fno-fixed-form option
+@cindex options, -fno-fixed-form
+@cindex source file format
+@cindex free form
+@cindex fixed form
+@cindex Fortran 90, features
+@item -ffree-form
+@item -fno-fixed-form
+Specify that the source file is written in free form
+(introduced in Fortran 90) instead of the more-traditional fixed form.
+
+@cindex -ff90 option
+@cindex options, -ff90
+@cindex Fortran 90, features
+@item -ff90
+Allow certain Fortran-90 constructs.
+
+This option controls whether certain
+Fortran 90 constructs are recognized.
+(Other Fortran 90 constructs
+might or might not be recognized depending on other options such as
+@option{-fvxt}, @option{-ff90-intrinsics-enable}, and the
+current level of support for Fortran 90.)
+
+@xref{Fortran 90}, for more information.
+
+@cindex -fvxt option
+@cindex options, -fvxt
+@item -fvxt
+@cindex Fortran 90, features
+@cindex VXT extensions
+Specify the treatment of certain constructs that have different
+meanings depending on whether the code is written in
+GNU Fortran (based on FORTRAN 77 and akin to Fortran 90)
+or VXT Fortran (more like VAX FORTRAN).
+
+The default is @option{-fno-vxt}.
+@option{-fvxt} specifies that the VXT Fortran interpretations
+for those constructs are to be chosen.
+
+@xref{VXT Fortran}, for more information.
+
+@cindex -fdollar-ok option
+@cindex options, -fdollar-ok
+@item -fdollar-ok
+@cindex dollar sign
+@cindex symbol names
+@cindex character set
+Allow @samp{$} as a valid character in a symbol name.
+
+@cindex -fno-backslash option
+@cindex options, -fno-backslash
+@item -fno-backslash
+@cindex backslash
+@cindex character constants
+@cindex Hollerith constants
+Specify that @samp{\} is not to be specially interpreted in character
+and Hollerith constants a la C and many UNIX Fortran compilers.
+
+For example, with @option{-fbackslash} in effect, @samp{A\nB} specifies
+three characters, with the second one being newline.
+With @option{-fno-backslash}, it specifies four characters,
+@samp{A}, @samp{\}, @samp{n}, and @samp{B}.
+
+Note that @command{g77} implements a fairly general form of backslash
+processing that is incompatible with the narrower forms supported
+by some other compilers.
+For example, @samp{'A\003B'} is a three-character string in @command{g77}
+whereas other compilers that support backslash might not support
+the three-octal-digit form, and thus treat that string as longer
+than three characters.
+
+@xref{Backslash in Constants}, for
+information on why @option{-fbackslash} is the default
+instead of @option{-fno-backslash}.
+
+@cindex -fno-ugly-args option
+@cindex options, -fno-ugly-args
+@item -fno-ugly-args
+Disallow passing Hollerith and typeless constants as actual
+arguments (for example, @samp{CALL FOO(4HABCD)}).
+
+@xref{Ugly Implicit Argument Conversion}, for more information.
+
+@cindex -fugly-assign option
+@cindex options, -fugly-assign
+@item -fugly-assign
+Use the same storage for a given variable regardless of
+whether it is used to hold an assigned-statement label
+(as in @samp{ASSIGN 10 TO I}) or used to hold numeric data
+(as in @samp{I = 3}).
+
+@xref{Ugly Assigned Labels}, for more information.
+
+@cindex -fugly-assumed option
+@cindex options, -fugly-assumed
+@item -fugly-assumed
+Assume any dummy array with a final dimension specified as @samp{1}
+is really an assumed-size array, as if @samp{*} had been specified
+for the final dimension instead of @samp{1}.
+
+For example, @samp{DIMENSION X(1)} is treated as if it
+had read @samp{DIMENSION X(*)}.
+
+@xref{Ugly Assumed-Size Arrays}, for more information.
+
+@cindex -fugly-comma option
+@cindex options, -fugly-comma
+@item -fugly-comma
+In an external-procedure invocation,
+treat a trailing comma in the argument list
+as specification of a trailing null argument,
+and treat an empty argument list
+as specification of a single null argument.
+
+For example, @samp{CALL FOO(,)} is treated as
+@samp{CALL FOO(%VAL(0), %VAL(0))}.
+That is, @emph{two} null arguments are specified
+by the procedure call when @option{-fugly-comma} is in force.
+And @samp{F = FUNC()} is treated as @samp{F = FUNC(%VAL(0))}.
+
+The default behavior, @option{-fno-ugly-comma}, is to ignore
+a single trailing comma in an argument list.
+So, by default, @samp{CALL FOO(X,)} is treated
+exactly the same as @samp{CALL FOO(X)}.
+
+@xref{Ugly Null Arguments}, for more information.
+
+@cindex -fugly-complex option
+@cindex options, -fugly-complex
+@item -fugly-complex
+Do not complain about @samp{REAL(@var{expr})} or
+@samp{AIMAG(@var{expr})} when @var{expr} is a @code{COMPLEX}
+type other than @code{COMPLEX(KIND=1)}---usually
+this is used to permit @code{COMPLEX(KIND=2)}
+(@code{DOUBLE COMPLEX}) operands.
+
+The @option{-ff90} option controls the interpretation
+of this construct.
+
+@xref{Ugly Complex Part Extraction}, for more information.
+
+@cindex -fno-ugly-init option
+@cindex options, -fno-ugly-init
+@item -fno-ugly-init
+Disallow use of Hollerith and typeless constants as initial
+values (in @code{PARAMETER} and @code{DATA} statements), and
+use of character constants to
+initialize numeric types and vice versa.
+
+For example, @samp{DATA I/'F'/, CHRVAR/65/, J/4HABCD/} is disallowed by
+@option{-fno-ugly-init}.
+
+@xref{Ugly Conversion of Initializers}, for more information.
+
+@cindex -fugly-logint option
+@cindex options, -fugly-logint
+@item -fugly-logint
+Treat @code{INTEGER} and @code{LOGICAL} variables and
+expressions as potential stand-ins for each other.
+
+For example, automatic conversion between @code{INTEGER} and
+@code{LOGICAL} is enabled, for many contexts, via this option.
+
+@xref{Ugly Integer Conversions}, for more information.
+
+@cindex -fonetrip option
+@cindex options, -fonetrip
+@item -fonetrip
+@cindex FORTRAN 66
+@cindex @code{DO} loops, one-trip
+@cindex one-trip @code{DO} loops
+@cindex @code{DO} loops, zero-trip
+@cindex zero-trip @code{DO} loops
+@cindex compatibility, FORTRAN 66
+Executable iterative @code{DO} loops are to be executed at
+least once each time they are reached.
+
+ANSI FORTRAN 77 and more recent versions of the Fortran standard
+specify that the body of an iterative @code{DO} loop is not executed
+if the number of iterations calculated from the parameters of the
+loop is less than 1.
+(For example, @samp{DO 10 I = 1, 0}.)
+Such a loop is called a @dfn{zero-trip loop}.
+
+Prior to ANSI FORTRAN 77, many compilers implemented @code{DO} loops
+such that the body of a loop would be executed at least once, even
+if the iteration count was zero.
+Fortran code written assuming this behavior is said to require
+@dfn{one-trip loops}.
+For example, some code written to the FORTRAN 66 standard
+expects this behavior from its @code{DO} loops, although that
+standard did not specify this behavior.
+
+The @option{-fonetrip} option specifies that the source file(s) being
+compiled require one-trip loops.
+
+This option affects only those loops specified by the (iterative) @code{DO}
+statement and by implied-@code{DO} lists in I/O statements.
+Loops specified by implied-@code{DO} lists in @code{DATA} and
+specification (non-executable) statements are not affected.
+
+@cindex -ftypeless-boz option
+@cindex options, -ftypeless-boz
+@cindex prefix-radix constants
+@cindex constants, prefix-radix
+@cindex constants, types
+@cindex types, constants
+@item -ftypeless-boz
+Specifies that prefix-radix non-decimal constants, such as
+@samp{Z'ABCD'}, are typeless instead of @code{INTEGER(KIND=1)}.
+
+You can test for yourself whether a particular compiler treats
+the prefix form as @code{INTEGER(KIND=1)} or typeless by running the
+following program:
+
+@smallexample
+EQUIVALENCE (I, R)
+R = Z'ABCD1234'
+J = Z'ABCD1234'
+IF (J .EQ. I) PRINT *, 'Prefix form is TYPELESS'
+IF (J .NE. I) PRINT *, 'Prefix form is INTEGER'
+END
+@end smallexample
+
+Reports indicate that many compilers process this form as
+@code{INTEGER(KIND=1)}, though a few as typeless, and at least one
+based on a command-line option specifying some kind of
+compatibility.
+
+@cindex -fintrin-case-initcap option
+@cindex options, -fintrin-case-initcap
+@item -fintrin-case-initcap
+@cindex -fintrin-case-upper option
+@cindex options, -fintrin-case-upper
+@item -fintrin-case-upper
+@cindex -fintrin-case-lower option
+@cindex options, -fintrin-case-lower
+@item -fintrin-case-lower
+@cindex -fintrin-case-any option
+@cindex options, -fintrin-case-any
+@item -fintrin-case-any
+Specify expected case for intrinsic names.
+@option{-fintrin-case-lower} is the default.
+
+@cindex -fmatch-case-initcap option
+@cindex options, -fmatch-case-initcap
+@item -fmatch-case-initcap
+@cindex -fmatch-case-upper option
+@cindex options, -fmatch-case-upper
+@item -fmatch-case-upper
+@cindex -fmatch-case-lower option
+@cindex options, -fmatch-case-lower
+@item -fmatch-case-lower
+@cindex -fmatch-case-any option
+@cindex options, -fmatch-case-any
+@item -fmatch-case-any
+Specify expected case for keywords.
+@option{-fmatch-case-lower} is the default.
+
+@cindex -fsource-case-upper option
+@cindex options, -fsource-case-upper
+@item -fsource-case-upper
+@cindex -fsource-case-lower option
+@cindex options, -fsource-case-lower
+@item -fsource-case-lower
+@cindex -fsource-case-preserve option
+@cindex options, -fsource-case-preserve
+@item -fsource-case-preserve
+Specify whether source text other than character and Hollerith constants
+is to be translated to uppercase, to lowercase, or preserved as is.
+@option{-fsource-case-lower} is the default.
+
+@cindex -fsymbol-case-initcap option
+@cindex options, -fsymbol-case-initcap
+@item -fsymbol-case-initcap
+@cindex -fsymbol-case-upper option
+@cindex options, -fsymbol-case-upper
+@item -fsymbol-case-upper
+@cindex -fsymbol-case-lower option
+@cindex options, -fsymbol-case-lower
+@item -fsymbol-case-lower
+@cindex -fsymbol-case-any option
+@cindex options, -fsymbol-case-any
+@item -fsymbol-case-any
+Specify valid cases for user-defined symbol names.
+@option{-fsymbol-case-any} is the default.
+
+@cindex -fcase-strict-upper option
+@cindex options, -fcase-strict-upper
+@item -fcase-strict-upper
+Same as @samp{-fintrin-case-upper -fmatch-case-upper -fsource-case-preserve
+-fsymbol-case-upper}.
+(Requires all pertinent source to be in uppercase.)
+
+@cindex -fcase-strict-lower option
+@cindex options, -fcase-strict-lower
+@item -fcase-strict-lower
+Same as @samp{-fintrin-case-lower -fmatch-case-lower -fsource-case-preserve
+-fsymbol-case-lower}.
+(Requires all pertinent source to be in lowercase.)
+
+@cindex -fcase-initcap option
+@cindex options, -fcase-initcap
+@item -fcase-initcap
+Same as @samp{-fintrin-case-initcap -fmatch-case-initcap -fsource-case-preserve
+-fsymbol-case-initcap}.
+(Requires all pertinent source to be in initial capitals,
+as in @samp{Print *,SqRt(Value)}.)
+
+@cindex -fcase-upper option
+@cindex options, -fcase-upper
+@item -fcase-upper
+Same as @samp{-fintrin-case-any -fmatch-case-any -fsource-case-upper
+-fsymbol-case-any}.
+(Maps all pertinent source to uppercase.)
+
+@cindex -fcase-lower option
+@cindex options, -fcase-lower
+@item -fcase-lower
+Same as @samp{-fintrin-case-any -fmatch-case-any -fsource-case-lower
+-fsymbol-case-any}.
+(Maps all pertinent source to lowercase.)
+
+@cindex -fcase-preserve option
+@cindex options, -fcase-preserve
+@item -fcase-preserve
+Same as @samp{-fintrin-case-any -fmatch-case-any -fsource-case-preserve
+-fsymbol-case-any}.
+(Preserves all case in user-defined symbols,
+while allowing any-case matching of intrinsics and keywords.
+For example, @samp{call Foo(i,I)} would pass two @emph{different}
+variables named @samp{i} and @samp{I} to a procedure named @samp{Foo}.)
+
+@cindex -fbadu77-intrinsics-delete option
+@cindex options, -fbadu77-intrinsics-delete
+@item -fbadu77-intrinsics-delete
+@cindex -fbadu77-intrinsics-hide option
+@cindex options, -fbadu77-intrinsics-hide
+@item -fbadu77-intrinsics-hide
+@cindex -fbadu77-intrinsics-disable option
+@cindex options, -fbadu77-intrinsics-disable
+@item -fbadu77-intrinsics-disable
+@cindex -fbadu77-intrinsics-enable option
+@cindex options, -fbadu77-intrinsics-enable
+@item -fbadu77-intrinsics-enable
+@cindex @code{badu77} intrinsics
+@cindex intrinsics, @code{badu77}
+Specify status of UNIX intrinsics having inappropriate forms.
+@option{-fbadu77-intrinsics-enable} is the default.
+@xref{Intrinsic Groups}.
+
+@cindex -ff2c-intrinsics-delete option
+@cindex options, -ff2c-intrinsics-delete
+@item -ff2c-intrinsics-delete
+@cindex -ff2c-intrinsics-hide option
+@cindex options, -ff2c-intrinsics-hide
+@item -ff2c-intrinsics-hide
+@cindex -ff2c-intrinsics-disable option
+@cindex options, -ff2c-intrinsics-disable
+@item -ff2c-intrinsics-disable
+@cindex -ff2c-intrinsics-enable option
+@cindex options, -ff2c-intrinsics-enable
+@item -ff2c-intrinsics-enable
+@cindex @command{f2c} intrinsics
+@cindex intrinsics, @command{f2c}
+Specify status of f2c-specific intrinsics.
+@option{-ff2c-intrinsics-enable} is the default.
+@xref{Intrinsic Groups}.
+
+@cindex -ff90-intrinsics-delete option
+@cindex options, -ff90-intrinsics-delete
+@item -ff90-intrinsics-delete
+@cindex -ff90-intrinsics-hide option
+@cindex options, -ff90-intrinsics-hide
+@item -ff90-intrinsics-hide
+@cindex -ff90-intrinsics-disable option
+@cindex options, -ff90-intrinsics-disable
+@item -ff90-intrinsics-disable
+@cindex -ff90-intrinsics-enable option
+@cindex options, -ff90-intrinsics-enable
+@item -ff90-intrinsics-enable
+@cindex Fortran 90, intrinsics
+@cindex intrinsics, Fortran 90
+Specify status of F90-specific intrinsics.
+@option{-ff90-intrinsics-enable} is the default.
+@xref{Intrinsic Groups}.
+
+@cindex -fgnu-intrinsics-delete option
+@cindex options, -fgnu-intrinsics-delete
+@item -fgnu-intrinsics-delete
+@cindex -fgnu-intrinsics-hide option
+@cindex options, -fgnu-intrinsics-hide
+@item -fgnu-intrinsics-hide
+@cindex -fgnu-intrinsics-disable option
+@cindex options, -fgnu-intrinsics-disable
+@item -fgnu-intrinsics-disable
+@cindex -fgnu-intrinsics-enable option
+@cindex options, -fgnu-intrinsics-enable
+@item -fgnu-intrinsics-enable
+@cindex Digital Fortran features
+@cindex @code{COMPLEX} intrinsics
+@cindex intrinsics, @code{COMPLEX}
+Specify status of Digital's COMPLEX-related intrinsics.
+@option{-fgnu-intrinsics-enable} is the default.
+@xref{Intrinsic Groups}.
+
+@cindex -fmil-intrinsics-delete option
+@cindex options, -fmil-intrinsics-delete
+@item -fmil-intrinsics-delete
+@cindex -fmil-intrinsics-hide option
+@cindex options, -fmil-intrinsics-hide
+@item -fmil-intrinsics-hide
+@cindex -fmil-intrinsics-disable option
+@cindex options, -fmil-intrinsics-disable
+@item -fmil-intrinsics-disable
+@cindex -fmil-intrinsics-enable option
+@cindex options, -fmil-intrinsics-enable
+@item -fmil-intrinsics-enable
+@cindex MIL-STD 1753
+@cindex intrinsics, MIL-STD 1753
+Specify status of MIL-STD-1753-specific intrinsics.
+@option{-fmil-intrinsics-enable} is the default.
+@xref{Intrinsic Groups}.
+
+@cindex -funix-intrinsics-delete option
+@cindex options, -funix-intrinsics-delete
+@item -funix-intrinsics-delete
+@cindex -funix-intrinsics-hide option
+@cindex options, -funix-intrinsics-hide
+@item -funix-intrinsics-hide
+@cindex -funix-intrinsics-disable option
+@cindex options, -funix-intrinsics-disable
+@item -funix-intrinsics-disable
+@cindex -funix-intrinsics-enable option
+@cindex options, -funix-intrinsics-enable
+@item -funix-intrinsics-enable
+@cindex UNIX intrinsics
+@cindex intrinsics, UNIX
+Specify status of UNIX intrinsics.
+@option{-funix-intrinsics-enable} is the default.
+@xref{Intrinsic Groups}.
+
+@cindex -fvxt-intrinsics-delete option
+@cindex options, -fvxt-intrinsics-delete
+@item -fvxt-intrinsics-delete
+@cindex -fvxt-intrinsics-hide option
+@cindex options, -fvxt-intrinsics-hide
+@item -fvxt-intrinsics-hide
+@cindex -fvxt-intrinsics-disable option
+@cindex options, -fvxt-intrinsics-disable
+@item -fvxt-intrinsics-disable
+@cindex -fvxt-intrinsics-enable option
+@cindex options, -fvxt-intrinsics-enable
+@item -fvxt-intrinsics-enable
+@cindex VXT intrinsics
+@cindex intrinsics, VXT
+Specify status of VXT intrinsics.
+@option{-fvxt-intrinsics-enable} is the default.
+@xref{Intrinsic Groups}.
+
+@cindex -ffixed-line-length-@var{n} option
+@cindex options, -ffixed-line-length-@var{n}
+@item -ffixed-line-length-@var{n}
+@cindex source file format
+@cindex lines, length
+@cindex length of source lines
+@cindex fixed form
+@cindex limits, lengths of source lines
+Set column after which characters are ignored in typical fixed-form
+lines in the source file, and through which spaces are assumed (as
+if padded to that length) after the ends of short fixed-form lines.
+
+@cindex card image
+@cindex extended-source option
+Popular values for @var{n} include 72 (the
+standard and the default), 80 (card image), and 132 (corresponds
+to ``extended-source'' options in some popular compilers).
+@var{n} may be @samp{none}, meaning that the entire line is meaningful
+and that continued character constants never have implicit spaces appended
+to them to fill out the line.
+@option{-ffixed-line-length-0} means the same thing as
+@option{-ffixed-line-length-none}.
+
+@xref{Source Form}, for more information.
+@end table
+
+@node Warning Options
+@section Options to Request or Suppress Warnings
+@cindex options, warnings
+@cindex warnings, suppressing
+@cindex messages, warning
+@cindex suppressing warnings
+
+Warnings are diagnostic messages that report constructions which
+are not inherently erroneous but which are risky or suggest there
+might have been an error.
+
+You can request many specific warnings with options beginning @option{-W},
+for example @option{-Wimplicit} to request warnings on implicit
+declarations.  Each of these specific warning options also has a
+negative form beginning @option{-Wno-} to turn off warnings;
+for example, @option{-Wno-implicit}.  This manual lists only one of the
+two forms, whichever is not the default.
+
+These options control the amount and kinds of warnings produced by GNU
+Fortran:
+
+@table @gcctabopt
+@cindex syntax checking
+@cindex -fsyntax-only option
+@cindex options, -fsyntax-only
+@item -fsyntax-only
+Check the code for syntax errors, but don't do anything beyond that.
+
+@cindex -pedantic option
+@cindex options, -pedantic
+@item -pedantic
+Issue warnings for uses of extensions to ANSI FORTRAN 77.
+@option{-pedantic} also applies to C-language constructs where they
+occur in GNU Fortran source files, such as use of @samp{\e} in a
+character constant within a directive like @samp{#include}.
+
+Valid ANSI FORTRAN 77 programs should compile properly with or without
+this option.
+However, without this option, certain GNU extensions and traditional
+Fortran features are supported as well.
+With this option, many of them are rejected.
+
+Some users try to use @option{-pedantic} to check programs for strict ANSI
+conformance.
+They soon find that it does not do quite what they want---it finds some
+non-ANSI practices, but not all.
+However, improvements to @command{g77} in this area are welcome.
+
+@cindex -pedantic-errors option
+@cindex options, -pedantic-errors
+@item -pedantic-errors
+Like @option{-pedantic}, except that errors are produced rather than
+warnings.
+
+@cindex -fpedantic option
+@cindex options, -fpedantic
+@item -fpedantic
+Like @option{-pedantic}, but applies only to Fortran constructs.
+
+@cindex -w option
+@cindex options, -w
+@item -w
+Inhibit all warning messages.
+
+@cindex -Wno-globals option
+@cindex options, -Wno-globals
+@item -Wno-globals
+@cindex global names, warning
+@cindex warnings, global names
+Inhibit warnings about use of a name as both a global name
+(a subroutine, function, or block data program unit, or a
+common block) and implicitly as the name of an intrinsic
+in a source file.
+
+Also inhibit warnings about inconsistent invocations and/or
+definitions of global procedures (function and subroutines).
+Such inconsistencies include different numbers of arguments
+and different types of arguments.
+
+@cindex -Wimplicit option
+@cindex options, -Wimplicit
+@item -Wimplicit
+@cindex implicit declaration, warning
+@cindex warnings, implicit declaration
+@cindex -u option
+@cindex /WARNINGS=DECLARATIONS switch
+@cindex IMPLICIT NONE, similar effect
+@cindex effecting IMPLICIT NONE
+Warn whenever a variable, array, or function is implicitly
+declared.
+Has an effect similar to using the @code{IMPLICIT NONE} statement
+in every program unit.
+(Some Fortran compilers provide this feature by an option
+named @option{-u} or @samp{/WARNINGS=DECLARATIONS}.)
+
+@cindex -Wunused option
+@cindex options, -Wunused
+@item -Wunused
+@cindex unused variables
+@cindex variables, unused
+Warn whenever a variable is unused aside from its declaration.
+
+@cindex -Wuninitialized option
+@cindex options, -Wuninitialized
+@item -Wuninitialized
+@cindex uninitialized variables
+@cindex variables, uninitialized
+Warn whenever an automatic variable is used without first being initialized.
+
+These warnings are possible only in optimizing compilation,
+because they require data-flow information that is computed only
+when optimizing.  If you don't specify @option{-O}, you simply won't
+get these warnings.
+
+These warnings occur only for variables that are candidates for
+register allocation.  Therefore, they do not occur for a variable
+@c that is declared @code{VOLATILE}, or
+whose address is taken, or whose size
+is other than 1, 2, 4 or 8 bytes.  Also, they do not occur for
+arrays, even when they are in registers.
+
+Note that there might be no warning about a variable that is used only
+to compute a value that itself is never used, because such
+computations may be deleted by data-flow analysis before the warnings
+are printed.
+
+These warnings are made optional because GNU Fortran is not smart
+enough to see all the reasons why the code might be correct
+despite appearing to have an error.  Here is one example of how
+this can happen:
+
+@example
+SUBROUTINE DISPAT(J)
+IF (J.EQ.1) I=1
+IF (J.EQ.2) I=4
+IF (J.EQ.3) I=5
+CALL FOO(I)
+END
+@end example
+
+@noindent
+If the value of @code{J} is always 1, 2 or 3, then @code{I} is
+always initialized, but GNU Fortran doesn't know this.  Here is
+another common case:
+
+@example
+SUBROUTINE MAYBE(FLAG)
+LOGICAL FLAG
+IF (FLAG) VALUE = 9.4
+@dots{}
+IF (FLAG) PRINT *, VALUE
+END
+@end example
+
+@noindent
+This has no bug because @code{VALUE} is used only if it is set.
+
+@cindex -Wall option
+@cindex options, -Wall
+@item -Wall
+@cindex all warnings
+@cindex warnings, all
+The @option{-Wunused} and @option{-Wuninitialized} options combined.
+These are all the
+options which pertain to usage that we recommend avoiding and that we
+believe is easy to avoid.
+(As more warnings are added to @command{g77} some might
+be added to the list enabled by @option{-Wall}.)
+@end table
+
+The remaining @option{-W@dots{}} options are not implied by @option{-Wall}
+because they warn about constructions that we consider reasonable to
+use, on occasion, in clean programs.
+
+@table @gcctabopt
+@c @item -W
+@c Print extra warning messages for these events:
+@c
+@c @itemize @bullet
+@c @item
+@c If @option{-Wall} or @option{-Wunused} is also specified, warn about unused
+@c arguments.
+@c
+@c @end itemize
+@c
+@cindex -Wsurprising option
+@cindex options, -Wsurprising
+@item -Wsurprising
+Warn about ``suspicious'' constructs that are interpreted
+by the compiler in a way that might well be surprising to
+someone reading the code.
+These differences can result in subtle, compiler-dependent
+(even machine-dependent) behavioral differences.
+The constructs warned about include:
+
+@itemize @bullet
+@item
+Expressions having two arithmetic operators in a row, such
+as @samp{X*-Y}.
+Such a construct is nonstandard, and can produce
+unexpected results in more complicated situations such
+as @samp{X**-Y*Z}.
+@command{g77} along with many other compilers, interprets
+this example differently than many programmers, and a few
+other compilers.
+Specifically, @command{g77} interprets @samp{X**-Y*Z} as
+@samp{(X**(-Y))*Z}, while others might think it should
+be interpreted as @samp{X**(-(Y*Z))}.
+
+A revealing example is the constant expression @samp{2**-2*1.},
+which @command{g77} evaluates to .25, while others might evaluate
+it to 0., the difference resulting from the way precedence affects
+type promotion.
+
+(The @option{-fpedantic} option also warns about expressions
+having two arithmetic operators in a row.)
+
+@item
+Expressions with a unary minus followed by an operand and then
+a binary operator other than plus or minus.
+For example, @samp{-2**2} produces a warning, because
+the precedence is @samp{-(2**2)}, yielding -4, not
+@samp{(-2)**2}, which yields 4, and which might represent
+what a programmer expects.
+
+An example of an expression producing different results
+in a surprising way is @samp{-I*S}, where @var{I} holds
+the value @samp{-2147483648} and @var{S} holds @samp{0.5}.
+On many systems, negating @var{I} results in the same
+value, not a positive number, because it is already the
+lower bound of what an @code{INTEGER(KIND=1)} variable can hold.
+So, the expression evaluates to a positive number, while
+the ``expected'' interpretation, @samp{(-I)*S}, would
+evaluate to a negative number.
+
+Even cases such as @samp{-I*J} produce warnings,
+even though, in most configurations and situations,
+there is no computational difference between the
+results of the two interpretations---the purpose
+of this warning is to warn about differing interpretations
+and encourage a better style of coding, not to identify
+only those places where bugs might exist in the user's
+code.
+
+@cindex DO statement
+@cindex statements, DO
+@item
+@code{DO} loops with @code{DO} variables that are not
+of integral type---that is, using @code{REAL}
+variables as loop control variables.
+Although such loops can be written to work in the
+``obvious'' way, the way @command{g77} is required by the
+Fortran standard to interpret such code is likely to
+be quite different from the way many programmers expect.
+(This is true of all @code{DO} loops, but the differences
+are pronounced for non-integral loop control variables.)
+
+@xref{Loops}, for more information.
+@end itemize
+
+@cindex -Werror option
+@cindex options, -Werror
+@item -Werror
+Make all warnings into errors.
+
+@cindex -W option
+@cindex options, -W
+@item -W
+@cindex extra warnings
+@cindex warnings, extra
+Turns on ``extra warnings'' and, if optimization is specified
+via @option{-O}, the @option{-Wuninitialized} option.
+(This might change in future versions of @command{g77}
+
+``Extra warnings'' are issued for:
+
+@itemize @bullet
+@item
+@cindex unused parameters
+@cindex parameters, unused
+@cindex unused arguments
+@cindex arguments, unused
+@cindex unused dummies
+@cindex dummies, unused
+Unused parameters to a procedure (when @option{-Wunused} also is
+specified).
+
+@item
+@cindex overflow
+Overflows involving floating-point constants (not available
+for certain configurations).
+@end itemize
+@end table
+
+@xref{Warning Options,,Options to Request or Suppress Warnings,
+gcc,Using the GNU Compiler Collection (GCC)}, for information on more
+options offered
+by the GBE shared by @command{g77} @command{gcc} and other GNU compilers.
+
+Some of these have no effect when compiling programs written in Fortran:
+
+@table @gcctabopt
+@cindex -Wcomment option
+@cindex options, -Wcomment
+@item -Wcomment
+@cindex -Wformat option
+@cindex options, -Wformat
+@item -Wformat
+@cindex -Wparentheses option
+@cindex options, -Wparentheses
+@item -Wparentheses
+@cindex -Wswitch option
+@cindex options, -Wswitch
+@item -Wswitch
+@cindex -Wswitch-default option
+@cindex options, -Wswitch-default
+@item -Wswitch-default
+@cindex -Wswitch-enum option
+@cindex options, -Wswitch-enum
+@item -Wswitch-enum
+@cindex -Wtraditional option
+@cindex options, -Wtraditional
+@item -Wtraditional
+@cindex -Wshadow option
+@cindex options, -Wshadow
+@item -Wshadow
+@cindex -Wid-clash-@var{len} option
+@cindex options, -Wid-clash-@var{len}
+@item -Wid-clash-@var{len}
+@cindex -Wlarger-than-@var{len} option
+@cindex options, -Wlarger-than-@var{len}
+@item -Wlarger-than-@var{len}
+@cindex -Wconversion option
+@cindex options, -Wconversion
+@item -Wconversion
+@cindex -Waggregate-return option
+@cindex options, -Waggregate-return
+@item -Waggregate-return
+@cindex -Wredundant-decls option
+@cindex options, -Wredundant-decls
+@item -Wredundant-decls
+@cindex unsupported warnings
+@cindex warnings, unsupported
+These options all could have some relevant meaning for
+GNU Fortran programs, but are not yet supported.
+@end table
+
+@node Debugging Options
+@section Options for Debugging Your Program or GNU Fortran
+@cindex options, debugging
+@cindex debugging information options
+
+GNU Fortran has various special options that are used for debugging
+either your program or @command{g77}
+
+@table @gcctabopt
+@cindex -g option
+@cindex options, -g
+@item -g
+Produce debugging information in the operating system's native format
+(stabs, COFF, XCOFF, or DWARF).  GDB can work with this debugging
+information.
+
+A sample debugging session looks like this (note the use of the breakpoint):
+@smallexample
+$ cat gdb.f
+      PROGRAM PROG
+      DIMENSION A(10)
+      DATA A /1.,2.,3.,4.,5.,6.,7.,8.,9.,10./
+      A(5) = 4.
+      PRINT*,A
+      END
+$ g77 -g -O gdb.f
+$ gdb a.out
+...
+(gdb) break MAIN__ 
+Breakpoint 1 at 0x8048e96: file gdb.f, line 4.
+(gdb) run
+Starting program: /home/toon/g77-bugs/./a.out 
+Breakpoint 1, MAIN__ () at gdb.f:4
+4             A(5) = 4.
+Current language:  auto; currently fortran
+(gdb) print a(5)
+$1 = 5
+(gdb) step 
+5             PRINT*,A
+(gdb) print a(5)
+$2 = 4
+...
+@end smallexample
+One could also add the setting of the breakpoint and the first run command
+to the file @file{.gdbinit} in the current directory, to simplify the debugging
+session.
+@end table
+
+@xref{Debugging Options,,Options for Debugging Your Program or GCC,
+gcc,Using the GNU Compiler Collection (GCC)}, for more information on
+debugging options.
+
+@node Optimize Options
+@section Options That Control Optimization
+@cindex optimize options
+@cindex options, optimization
+
+Most Fortran users will want to use no optimization when
+developing and testing programs, and use @option{-O} or @option{-O2} when
+compiling programs for late-cycle testing and for production use.
+However, note that certain diagnostics---such as for uninitialized
+variables---depend on the flow analysis done by @option{-O}, i.e.@: you
+must use @option{-O} or @option{-O2} to get such diagnostics.
+
+The following flags have particular applicability when
+compiling Fortran programs:
+
+@table @gcctabopt
+@cindex -malign-double option
+@cindex options, -malign-double
+@item -malign-double
+(Intel x86 architecture only.)
+
+Noticeably improves performance of @command{g77} programs making
+heavy use of @code{REAL(KIND=2)} (@code{DOUBLE PRECISION}) data
+on some systems.
+In particular, systems using Pentium, Pentium Pro, 586, and
+686 implementations
+of the i386 architecture execute programs faster when
+@code{REAL(KIND=2)} (@code{DOUBLE PRECISION}) data are
+aligned on 64-bit boundaries
+in memory.
+
+This option can, at least, make benchmark results more consistent
+across various system configurations, versions of the program,
+and data sets.
+
+@emph{Note:} The warning in the @command{gcc} documentation about
+this option does not apply, generally speaking, to Fortran
+code compiled by @command{g77}
+
+@xref{Aligned Data}, for more information on alignment issues.
+
+@emph{Also also note:} The negative form of @option{-malign-double}
+is @option{-mno-align-double}, not @option{-benign-double}.
+
+@cindex -ffloat-store option
+@cindex options, -ffloat-store
+@item -ffloat-store
+@cindex IEEE 754 conformance
+@cindex conformance, IEEE 754
+@cindex floating-point, precision
+Might help a Fortran program that depends on exact IEEE conformance on
+some machines, but might slow down a program that doesn't.
+
+This option is effective when the floating-point unit is set to work in
+IEEE 854 `extended precision'---as it typically is on x86 and m68k GNU
+systems---rather than IEEE 754 double precision.  @option{-ffloat-store}
+tries to remove the extra precision by spilling data from floating-point
+registers into memory and this typically involves a big performance
+hit.  However, it doesn't affect intermediate results, so that it is
+only partially effective.  `Excess precision' is avoided in code like:
+@smallexample
+a = b + c
+d = a * e
+@end smallexample
+but not in code like:
+@smallexample
+      d = (b + c) * e
+@end smallexample
+
+For another, potentially better, way of controlling the precision,
+see @ref{Floating-point precision}.
+
+@cindex -fforce-mem option
+@cindex options, -fforce-mem
+@item -fforce-mem
+@cindex -fforce-addr option
+@cindex options, -fforce-addr
+@item -fforce-addr
+@cindex loops, speeding up
+@cindex speed, of loops
+Might improve optimization of loops.
+
+@cindex -fno-inline option
+@cindex options, -fno-inline
+@item -fno-inline
+@cindex in-line code
+@cindex compilation, in-line
+@c DL: Only relevant for -O3? TM: No, statement functions are
+@c inlined even at -O1.
+Don't compile statement functions inline.
+Might reduce the size of a program unit---which might be at
+expense of some speed (though it should compile faster).
+Note that if you are not optimizing, no functions can be expanded inline.
+
+@cindex -ffast-math option
+@cindex options, -ffast-math
+@item -ffast-math
+@cindex IEEE 754 conformance
+@cindex conformance, IEEE 754
+Might allow some programs designed to not be too dependent
+on IEEE behavior for floating-point to run faster, or die trying.
+Sets @option{-funsafe-math-optimizations}, @option{-ffinite-math-only},
+and @option{-fno-trapping-math}.
+
+@cindex -funsafe-math-optimizations option
+@cindex options, -funsafe-math-optimizations
+@item -funsafe-math-optimizations
+Allow optimizations that may be give incorrect results
+for certain IEEE inputs.
+
+@cindex -ffinite-math-only option
+@cindex options, -ffinite-math-only
+@item -ffinite-math-only
+Allow optimizations for floating-point arithmetic that assume
+that arguments and results are not NaNs or +-Infs.
+
+This option should never be turned on by any @option{-O} option since
+it can result in incorrect output for programs which depend on
+an exact implementation of IEEE or ISO rules/specifications.
+
+The default is @option{-fno-finite-math-only}.
+
+@cindex -fno-trapping-math option
+@cindex options, -fno-trapping-math
+@item -fno-trapping-math
+Allow the compiler to assume that floating-point arithmetic
+will not generate traps on any inputs.  This is useful, for
+example, when running a program using IEEE "non-stop"
+floating-point arithmetic.
+
+@cindex -fstrength-reduce option
+@cindex options, -fstrength-reduce
+@item -fstrength-reduce
+@cindex loops, speeding up
+@cindex speed, of loops
+@c DL: normally defaulted?
+Might make some loops run faster.
+
+@cindex -frerun-cse-after-loop option
+@cindex options, -frerun-cse-after-loop
+@item -frerun-cse-after-loop
+@cindex -fexpensive-optimizations option
+@cindex options, -fexpensive-optimizations
+@c DL: This is -O2?
+@item -fexpensive-optimizations
+@cindex -fdelayed-branch option
+@cindex options, -fdelayed-branch
+@item -fdelayed-branch
+@cindex -fschedule-insns option
+@cindex options, -fschedule-insns
+@item -fschedule-insns
+@cindex -fschedule-insns2 option
+@cindex options, -fschedule-insns2
+@item -fschedule-insns2
+@cindex -fcaller-saves option
+@cindex options, -fcaller-saves
+@item -fcaller-saves
+Might improve performance on some code.
+
+@cindex -funroll-loops option
+@cindex options, -funroll-loops
+@item -funroll-loops
+@cindex loops, unrolling
+@cindex unrolling loops
+@cindex loops, optimizing
+@cindex indexed (iterative) @code{DO}
+@cindex iterative @code{DO}
+@c DL: fixme: Craig doesn't like `indexed' but f95 doesn't seem to
+@c provide a suitable term
+@c CB: I've decided on `iterative', for the time being, and changed
+@c my previous, rather bizarre, use of `imperative' to that
+@c (though `precomputed-trip' would be a more precise adjective)
+Typically improves performance on code using iterative @code{DO} loops by
+unrolling them and is probably generally appropriate for Fortran, though
+it is not turned on at any optimization level.
+Note that outer loop unrolling isn't done specifically; decisions about
+whether to unroll a loop are made on the basis of its instruction count.
+
+@c DL: Fixme: This should obviously go somewhere else...
+Also, no `loop discovery'@footnote{@dfn{loop discovery} refers to the
+process by which a compiler, or indeed any reader of a program,
+determines which portions of the program are more likely to be executed
+repeatedly as it is being run.  Such discovery typically is done early
+when compiling using optimization techniques, so the ``discovered''
+loops get more attention---and more run-time resources, such as
+registers---from the compiler.  It is easy to ``discover'' loops that are
+constructed out of looping constructs in the language
+(such as Fortran's @code{DO}).  For some programs, ``discovering'' loops
+constructed out of lower-level constructs (such as @code{IF} and
+@code{GOTO}) can lead to generation of more optimal code
+than otherwise.} is done, so only loops written with @code{DO}
+benefit from loop optimizations, including---but not limited
+to---unrolling.  Loops written with @code{IF} and @code{GOTO} are not
+currently recognized as such.  This option unrolls only iterative
+@code{DO} loops, not @code{DO WHILE} loops.
+
+@cindex -funroll-all-loops option
+@cindex options, -funroll-all-loops
+@cindex DO WHILE
+@item -funroll-all-loops
+@c DL: Check my understanding of -funroll-all-loops v. -funroll-loops is correct.
+Probably improves performance on code using @code{DO WHILE} loops by
+unrolling them in addition to iterative @code{DO} loops.  In the absence
+of @code{DO WHILE}, this option is equivalent to @option{-funroll-loops}
+but possibly slower.
+
+@item -fno-move-all-movables
+@cindex -fno-move-all-movables option
+@cindex options, -fno-move-all-movables
+@item -fno-reduce-all-givs
+@cindex -fno-reduce-all-givs option
+@cindex options, -fno-reduce-all-givs
+@item -fno-rerun-loop-opt
+@cindex -fno-rerun-loop-opt option
+@cindex options, -fno-rerun-loop-opt
+In general, the optimizations enabled with these options will lead to
+faster code being generated by GNU Fortran; hence they are enabled by default
+when issuing the @command{g77} command.
+
+@option{-fmove-all-movables} and @option{-freduce-all-givs} will enable
+loop optimization to move all loop-invariant index computations in nested
+loops over multi-rank array dummy arguments out of these loops.
+
+@option{-frerun-loop-opt} will move offset calculations resulting
+from the fact that Fortran arrays by default have a lower bound of 1
+out of the loops.
+
+These three options are intended to be removed someday, once
+loop optimization is sufficiently advanced to perform all those
+transformations without help from these options.
+@end table
+
+@xref{Optimize Options,,Options That Control Optimization,
+gcc,Using the GNU Compiler Collection (GCC)}, for more information on options
+to optimize the generated machine code.
+
+@node Preprocessor Options
+@section Options Controlling the Preprocessor
+@cindex preprocessor options
+@cindex options, preprocessor
+@cindex cpp program
+@cindex programs, cpp
+
+These options control the C preprocessor, which is run on each C source
+file before actual compilation.
+
+@xref{Preprocessor Options,,Options Controlling the Preprocessor,
+gcc,Using the GNU Compiler Collection (GCC)}, for information on C
+preprocessor options.
+
+@cindex INCLUDE directive
+@cindex directive, INCLUDE
+Some of these options also affect how @command{g77} processes the
+@code{INCLUDE} directive.
+Since this directive is processed even when preprocessing
+is not requested, it is not described in this section.
+@xref{Directory Options,,Options for Directory Search}, for
+information on how @command{g77} processes the @code{INCLUDE} directive.
+
+However, the @code{INCLUDE} directive does not apply
+preprocessing to the contents of the included file itself.
+
+Therefore, any file that contains preprocessor directives
+(such as @code{#include}, @code{#define}, and @code{#if})
+must be included via the @code{#include} directive, not
+via the @code{INCLUDE} directive.
+Therefore, any file containing preprocessor directives,
+if included, is necessarily included by a file that itself
+contains preprocessor directives.
+
+@node Directory Options
+@section Options for Directory Search
+@cindex directory, options
+@cindex options, directory search
+@cindex search path
+
+These options affect how the @command{cpp} preprocessor searches
+for files specified via the @code{#include} directive.
+Therefore, when compiling Fortran programs, they are meaningful
+when the preprocessor is used.
+
+@cindex INCLUDE directive
+@cindex directive, INCLUDE
+Some of these options also affect how @command{g77} searches
+for files specified via the @code{INCLUDE} directive,
+although files included by that directive are not,
+themselves, preprocessed.
+These options are:
+
+@table @gcctabopt
+@cindex -I- option
+@cindex options, -I-
+@item -I-
+@cindex -Idir option
+@cindex options, -Idir
+@item -I@var{dir}
+@cindex directory, search paths for inclusion
+@cindex inclusion, directory search paths for
+@cindex search paths, for included files
+@cindex paths, search
+These affect interpretation of the @code{INCLUDE} directive
+(as well as of the @code{#include} directive of the @command{cpp}
+preprocessor).
+
+Note that @option{-I@var{dir}} must be specified @emph{without} any
+spaces between @option{-I} and the directory name---that is,
+@option{-Ifoo/bar} is valid, but @option{-I foo/bar}
+is rejected by the @command{g77} compiler (though the preprocessor supports
+the latter form).
+@c this is due to toplev.c's inflexible option processing
+Also note that the general behavior of @option{-I} and
+@code{INCLUDE} is pretty much the same as of @option{-I} with
+@code{#include} in the @command{cpp} preprocessor, with regard to
+looking for @file{header.gcc} files and other such things.
+
+@xref{Directory Options,,Options for Directory Search,
+gcc,Using the GNU Compiler Collection (GCC)}, for information on the
+@option{-I} option.
+@end table
+
+@node Code Gen Options
+@section Options for Code Generation Conventions
+@cindex code generation, conventions
+@cindex options, code generation
+@cindex run-time, options
+
+These machine-independent options control the interface conventions
+used in code generation.
+
+Most of them have both positive and negative forms; the negative form
+of @option{-ffoo} would be @option{-fno-foo}.  In the table below, only
+one of the forms is listed---the one which is not the default.  You
+can figure out the other form by either removing @option{no-} or adding
+it.
+
+@table @gcctabopt
+@cindex -fno-automatic option
+@cindex options, -fno-automatic
+@item -fno-automatic
+@cindex SAVE statement
+@cindex statements, SAVE
+Treat each program unit as if the @code{SAVE} statement was specified
+for every local variable and array referenced in it.
+Does not affect common blocks.
+(Some Fortran compilers provide this option under
+the name @option{-static}.)
+
+@cindex -finit-local-zero option
+@cindex options, -finit-local-zero
+@item -finit-local-zero
+@cindex DATA statement
+@cindex statements, DATA
+@cindex initialization, of local variables
+@cindex variables, initialization of
+@cindex uninitialized variables
+@cindex variables, uninitialized
+Specify that variables and arrays that are local to a program unit
+(not in a common block and not passed as an argument) are to be initialized
+to binary zeros.
+
+Since there is a run-time penalty for initialization of variables
+that are not given the @code{SAVE} attribute, it might be a
+good idea to also use @option{-fno-automatic} with @option{-finit-local-zero}.
+
+@cindex -fno-f2c option
+@cindex options, -fno-f2c
+@item -fno-f2c
+@cindex @command{f2c} compatibility
+@cindex compatibility, @command{f2c}
+Do not generate code designed to be compatible with code generated
+by @command{f2c} use the GNU calling conventions instead.
+
+The @command{f2c} calling conventions require functions that return
+type @code{REAL(KIND=1)} to actually return the C type @code{double},
+and functions that return type @code{COMPLEX} to return the
+values via an extra argument in the calling sequence that points
+to where to store the return value.
+Under the GNU calling conventions, such functions simply return
+their results as they would in GNU C---@code{REAL(KIND=1)} functions
+return the C type @code{float}, and @code{COMPLEX} functions
+return the GNU C type @code{complex} (or its @code{struct}
+equivalent).
+
+This does not affect the generation of code that interfaces with the
+@code{libg2c} library.
+
+However, because the @code{libg2c} library uses @command{f2c}
+calling conventions, @command{g77} rejects attempts to pass
+intrinsics implemented by routines in this library as actual
+arguments when @option{-fno-f2c} is used, to avoid bugs when
+they are actually called by code expecting the GNU calling
+conventions to work.
+
+For example, @samp{INTRINSIC ABS;CALL FOO(ABS)} is
+rejected when @option{-fno-f2c} is in force.
+(Future versions of the @command{g77} run-time library might
+offer routines that provide GNU-callable versions of the
+routines that implement the @command{f2c} intrinsics
+that may be passed as actual arguments, so that
+valid programs need not be rejected when @option{-fno-f2c}
+is used.)
+
+@strong{Caution:} If @option{-fno-f2c} is used when compiling any
+source file used in a program, it must be used when compiling
+@emph{all} Fortran source files used in that program.
+
+@c seems kinda dumb to tell people about an option they can't use -- jcb
+@c then again, we want users building future-compatible libraries with it.
+@cindex -ff2c-library option
+@cindex options, -ff2c-library
+@item -ff2c-library
+Specify that use of @code{libg2c} (or the original @code{libf2c})
+is required.
+This is the default for the current version of @command{g77}
+
+Currently it is not
+valid to specify @option{-fno-f2c-library}.
+This option is provided so users can specify it in shell
+scripts that build programs and libraries that require the
+@code{libf2c} library, even when being compiled by future
+versions of @command{g77} that might otherwise default to
+generating code for an incompatible library.
+
+@cindex -fno-underscoring option
+@cindex options, -fno-underscoring
+@item -fno-underscoring
+@cindex underscore
+@cindex symbol names, underscores
+@cindex transforming symbol names
+@cindex symbol names, transforming
+Do not transform names of entities specified in the Fortran
+source file by appending underscores to them.
+
+With @option{-funderscoring} in effect, @command{g77} appends two underscores
+to names with underscores and one underscore to external names with
+no underscores.  (@command{g77} also appends two underscores to internal
+names with underscores to avoid naming collisions with external names.
+The @option{-fno-second-underscore} option disables appending of the
+second underscore in all cases.)
+
+This is done to ensure compatibility with code produced by many
+UNIX Fortran compilers, including @command{f2c} which perform the
+same transformations.
+
+Use of @option{-fno-underscoring} is not recommended unless you are
+experimenting with issues such as integration of (GNU) Fortran into
+existing system environments (vis-a-vis existing libraries, tools, and
+so on).
+
+For example, with @option{-funderscoring}, and assuming other defaults like
+@option{-fcase-lower} and that @samp{j()} and @samp{max_count()} are
+external functions while @samp{my_var} and @samp{lvar} are local variables,
+a statement like
+
+@smallexample
+I = J() + MAX_COUNT (MY_VAR, LVAR)
+@end smallexample
+
+@noindent
+is implemented as something akin to:
+
+@smallexample
+i = j_() + max_count__(&my_var__, &lvar);
+@end smallexample
+
+With @option{-fno-underscoring}, the same statement is implemented as:
+
+@smallexample
+i = j() + max_count(&my_var, &lvar);
+@end smallexample
+
+Use of @option{-fno-underscoring} allows direct specification of
+user-defined names while debugging and when interfacing @command{g77}
+code with other languages.
+
+Note that just because the names match does @emph{not} mean that the
+interface implemented by @command{g77} for an external name matches the
+interface implemented by some other language for that same name.
+That is, getting code produced by @command{g77} to link to code produced
+by some other compiler using this or any other method can be only a
+small part of the overall solution---getting the code generated by
+both compilers to agree on issues other than naming can require
+significant effort, and, unlike naming disagreements, linkers normally
+cannot detect disagreements in these other areas.
+
+Also, note that with @option{-fno-underscoring}, the lack of appended
+underscores introduces the very real possibility that a user-defined
+external name will conflict with a name in a system library, which
+could make finding unresolved-reference bugs quite difficult in some
+cases---they might occur at program run time, and show up only as
+buggy behavior at run time.
+
+In future versions of @command{g77} we hope to improve naming and linking
+issues so that debugging always involves using the names as they appear
+in the source, even if the names as seen by the linker are mangled to
+prevent accidental linking between procedures with incompatible
+interfaces.
+
+@cindex -fno-second-underscore option
+@cindex options, -fno-second-underscore
+@item -fno-second-underscore
+@cindex underscore
+@cindex symbol names, underscores
+@cindex transforming symbol names
+@cindex symbol names, transforming
+Do not append a second underscore to names of entities specified
+in the Fortran source file.
+
+This option has no effect if @option{-fno-underscoring} is
+in effect.
+
+Otherwise, with this option, an external name such as @samp{MAX_COUNT}
+is implemented as a reference to the link-time external symbol
+@samp{max_count_}, instead of @samp{max_count__}.
+
+@cindex -fno-ident option
+@cindex options, -fno-ident
+@item -fno-ident
+Ignore the @samp{#ident} directive.
+
+@cindex -fzeros option
+@cindex options, -fzeros
+@item -fzeros
+Treat initial values of zero as if they were any other value.
+
+As of version 0.5.18, @command{g77} normally treats @code{DATA} and
+other statements that are used to specify initial values of zero
+for variables and arrays as if no values were actually specified,
+in the sense that no diagnostics regarding multiple initializations
+are produced.
+
+This is done to speed up compiling of programs that initialize
+large arrays to zeros.
+
+Use @option{-fzeros} to revert to the simpler, slower behavior
+that can catch multiple initializations by keeping track of
+all initializations, zero or otherwise.
+
+@emph{Caution:} Future versions of @command{g77} might disregard this option
+(and its negative form, the default) or interpret it somewhat
+differently.
+The interpretation changes will affect only non-standard
+programs; standard-conforming programs should not be affected.
+
+@cindex -femulate-complex option
+@cindex options, -femulate-complex
+@item -femulate-complex
+Implement @code{COMPLEX} arithmetic via emulation,
+instead of using the facilities of
+the @command{gcc} back end that provide direct support of
+@code{complex} arithmetic.
+
+(@command{gcc} had some bugs in its back-end support
+for @code{complex} arithmetic, due primarily to the support not being
+completed as of version 2.8.1 and @code{egcs} 1.1.2.)
+
+Use @option{-femulate-complex} if you suspect code-generation bugs,
+or experience compiler crashes,
+that might result from @command{g77} using the @code{COMPLEX} support
+in the @command{gcc} back end.
+If using that option fixes the bugs or crashes you are seeing,
+that indicates a likely @command{g77} bugs
+(though, all compiler crashes are considered bugs),
+so, please report it.
+(Note that the known bugs, now believed fixed, produced compiler crashes
+rather than causing the generation of incorrect code.)
+
+Use of this option should not affect how Fortran code compiled
+by @command{g77} works in terms of its interfaces to other code,
+e.g. that compiled by @command{f2c}
+
+As of GCC version 3.0, this option is not necessary anymore.
+
+@emph{Caution:} Future versions of @command{g77} might ignore both forms
+of this option.
+
+@cindex -falias-check option
+@cindex options, -falias-check
+@cindex -fargument-alias option
+@cindex options, -fargument-alias
+@cindex -fargument-noalias option
+@cindex options, -fargument-noalias
+@cindex -fno-argument-noalias-global option
+@cindex options, -fno-argument-noalias-global
+@item -falias-check
+@item -fargument-alias
+@item -fargument-noalias
+@item -fno-argument-noalias-global
+@emph{Version info:}
+These options are not supported by
+versions of @command{g77} based on @command{gcc} version 2.8.
+
+These options specify to what degree aliasing
+(overlap)
+is permitted between
+arguments (passed as pointers) and @code{COMMON} (external, or
+public) storage.
+
+The default for Fortran code, as mandated by the FORTRAN 77 and
+Fortran 90 standards, is @option{-fargument-noalias-global}.
+The default for code written in the C language family is
+@option{-fargument-alias}.
+
+Note that, on some systems, compiling with @option{-fforce-addr} in
+effect can produce more optimal code when the default aliasing
+options are in effect (and when optimization is enabled).
+
+@xref{Aliasing Assumed To Work}, for detailed information on the implications
+of compiling Fortran code that depends on the ability to alias dummy
+arguments.
+
+@cindex -fno-globals option
+@cindex options, -fno-globals
+@item -fno-globals
+@cindex global names, warning
+@cindex warnings, global names
+@cindex in-line code
+@cindex compilation, in-line
+Disable diagnostics about inter-procedural
+analysis problems, such as disagreements about the
+type of a function or a procedure's argument,
+that might cause a compiler crash when attempting
+to inline a reference to a procedure within a
+program unit.
+(The diagnostics themselves are still produced, but
+as warnings, unless @option{-Wno-globals} is specified,
+in which case no relevant diagnostics are produced.)
+
+Further, this option disables such inlining, to
+avoid compiler crashes resulting from incorrect
+code that would otherwise be diagnosed.
+
+As such, this option might be quite useful when
+compiling existing, ``working'' code that happens
+to have a few bugs that do not generally show themselves,
+but which @command{g77} diagnoses.
+
+Use of this option therefore has the effect of
+instructing @command{g77} to behave more like it did
+up through version 0.5.19.1, when it paid little or
+no attention to disagreements between program units
+about a procedure's type and argument information,
+and when it performed no inlining of procedures
+(except statement functions).
+
+Without this option, @command{g77} defaults to performing
+the potentially inlining procedures as it started doing
+in version 0.5.20, but as of version 0.5.21, it also
+diagnoses disagreements that might cause such inlining
+to crash the compiler as (fatal) errors,
+and warns about similar disagreements
+that are currently believed to not
+likely to result in the compiler later crashing
+or producing incorrect code.
+
+@cindex -fflatten-arrays option
+@item -fflatten-arrays
+@cindex array performance
+@cindex arrays, flattening
+Use back end's C-like constructs
+(pointer plus offset)
+instead of its @code{ARRAY_REF} construct
+to handle all array references.
+
+@emph{Note:} This option is not supported.
+It is intended for use only by @command{g77} developers,
+to evaluate code-generation issues.
+It might be removed at any time.
+
+@cindex -fbounds-check option
+@cindex -ffortran-bounds-check option
+@item -fbounds-check
+@itemx -ffortran-bounds-check
+@cindex bounds checking
+@cindex range checking
+@cindex array bounds checking
+@cindex subscript checking
+@cindex substring checking
+@cindex checking subscripts
+@cindex checking substrings
+Enable generation of run-time checks for array subscripts
+and substring start and end points
+against the (locally) declared minimum and maximum values.
+
+The current implementation uses the @code{libf2c}
+library routine @code{s_rnge} to print the diagnostic.
+
+However, whereas @command{f2c} generates a single check per
+reference for a multi-dimensional array, of the computed
+offset against the valid offset range (0 through the size of the array),
+@command{g77} generates a single check per @emph{subscript} expression.
+This catches some cases of potential bugs that @command{f2c} does not,
+such as references to below the beginning of an assumed-size array.
+
+@command{g77} also generates checks for @code{CHARACTER} substring references,
+something @command{f2c} currently does not do.
+
+Use the new @option{-ffortran-bounds-check} option
+to specify bounds-checking for only the Fortran code you are compiling,
+not necessarily for code written in other languages.
+
+@emph{Note:} To provide more detailed information on the offending subscript,
+@command{g77} provides the @code{libg2c} run-time library routine @code{s_rnge}
+with somewhat differently-formatted information.
+Here's a sample diagnostic:
+
+@smallexample
+Subscript out of range on file line 4, procedure rnge.f/bf.
+Attempt to access the -6-th element of variable b[subscript-2-of-2].
+Aborted
+@end smallexample
+
+The above message indicates that the offending source line is
+line 4 of the file @file{rnge.f},
+within the program unit (or statement function) named @samp{bf}.
+The offended array is named @samp{b}.
+The offended array dimension is the second for a two-dimensional array,
+and the offending, computed subscript expression was @samp{-6}.
+
+For a @code{CHARACTER} substring reference, the second line has
+this appearance:
+
+@smallexample
+Attempt to access the 11-th element of variable a[start-substring].
+@end smallexample
+
+This indicates that the offended @code{CHARACTER} variable or array
+is named @samp{a},
+the offended substring position is the starting (leftmost) position,
+and the offending substring expression is @samp{11}.
+
+(Though the verbage of @code{s_rnge} is not ideal
+for the purpose of the @command{g77} compiler,
+the above information should provide adequate diagnostic abilities
+to it users.)
+@end table
+
+@xref{Code Gen Options,,Options for Code Generation Conventions,
+gcc,Using the GNU Compiler Collection (GCC)}, for information on more options
+offered by the GBE
+shared by @command{g77} @command{gcc} and other GNU compilers.
+
+Some of these do @emph{not} work when compiling programs written in Fortran:
+
+@table @gcctabopt
+@cindex -fpcc-struct-return option
+@cindex options, -fpcc-struct-return
+@item -fpcc-struct-return
+@cindex -freg-struct-return option
+@cindex options, -freg-struct-return
+@item -freg-struct-return
+You should not use these except strictly the same way as you
+used them to build the version of @code{libg2c} with which
+you will be linking all code compiled by @command{g77} with the
+same option.
+
+@cindex -fshort-double option
+@cindex options, -fshort-double
+@item -fshort-double
+This probably either has no effect on Fortran programs, or
+makes them act loopy.
+
+@cindex -fno-common option
+@cindex options, -fno-common
+@item -fno-common
+Do not use this when compiling Fortran programs,
+or there will be Trouble.
+
+@cindex -fpack-struct option
+@cindex options, -fpack-struct
+@item -fpack-struct
+This probably will break any calls to the @code{libg2c} library,
+at the very least, even if it is built with the same option.
+@end table
+
+@c man end
+
+@node Environment Variables
+@section Environment Variables Affecting GNU Fortran
+@cindex environment variables
+
+@c man begin ENVIRONMENT
+
+GNU Fortran currently does not make use of any environment
+variables to control its operation above and beyond those
+that affect the operation of @command{gcc}.
+
+@xref{Environment Variables,,Environment Variables Affecting GCC,
+gcc,Using the GNU Compiler Collection (GCC)}, for information on environment
+variables.
+
+@c man end
diff --git a/gcc/f/lab.c b/gcc/f/lab.c
new file mode 100644
index 00000000000..1d278748b21
--- /dev/null
+++ b/gcc/f/lab.c
@@ -0,0 +1,157 @@
+/* lab.c -- Implementation File (module.c template V1.0)
+   Copyright (C) 1995, 2003 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Related Modules:
+
+   Description:
+      Complex data abstraction for Fortran labels.  Maintains a single master
+      list for all labels; it is expected initialization and termination of
+      this list will occur on program-unit boundaries.
+
+   Modifications:
+      22-Aug-89	 JCB  1.1
+	 Change ffelab_new for new ffewhere interface.
+*/
+
+/* Include files. */
+
+#include "proj.h"
+#include "lab.h"
+#include "malloc.h"
+
+/* Externals defined here. */
+
+ffelab ffelab_list_;
+ffelabNumber ffelab_num_news_;
+
+/* Simple definitions and enumerations. */
+
+
+/* Internal typedefs. */
+
+
+/* Private include files. */
+
+
+/* Internal structure definitions. */
+
+
+/* Static objects accessed by functions in this module. */
+
+
+/* Static functions (internal). */
+
+
+/* Internal macros. */
+
+
+/* ffelab_find -- Find the ffelab object having the desired label value
+
+   ffelab l;
+   ffelabValue v;
+   l = ffelab_find(v);
+
+   If the desired ffelab object doesn't exist, returns NULL.
+
+   Straightforward search of list of ffelabs.  */
+
+ffelab
+ffelab_find (ffelabValue v)
+{
+  ffelab l;
+
+  for (l = ffelab_list_; (l != NULL) && (ffelab_value (l) != v); l = l->next)
+    ;
+
+  return l;
+}
+
+/* ffelab_finish -- Shut down label management
+
+   ffelab_finish();
+
+   At the end of processing a program unit, call this routine to shut down
+   label management.
+
+   Kill all the labels on the list.  */
+
+void
+ffelab_finish (void)
+{
+  ffelab l;
+  ffelab pl;
+
+  for (pl = NULL, l = ffelab_list_; l != NULL; pl = l, l = l->next)
+    if (pl != NULL)
+      malloc_kill_ks (ffe_pool_any_unit (), pl, sizeof (*pl));
+
+  if (pl != NULL)
+    malloc_kill_ks (ffe_pool_any_unit (), pl, sizeof (*pl));
+}
+
+/* ffelab_init_3 -- Initialize label management system
+
+   ffelab_init_3();
+
+   Initialize the label management system.  Do this before a new program
+   unit is going to be processed.  */
+
+void
+ffelab_init_3 (void)
+{
+  ffelab_list_ = NULL;
+  ffelab_num_news_ = 0;
+}
+
+/* ffelab_new -- Create an ffelab object.
+
+   ffelab l;
+   ffelabValue v;
+   l = ffelab_new(v);
+
+   Create a label having a given value.	 If the value isn't known, pass
+   FFELAB_valueNONE, and set it later with ffelab_set_value.
+
+   Allocate, initialize, and stick at top of label list.
+
+   22-Aug-89  JCB  1.1
+      Change for new ffewhere interface.  */
+
+ffelab
+ffelab_new (ffelabValue v)
+{
+  ffelab l;
+
+  ++ffelab_num_news_;
+  l = malloc_new_ks (ffe_pool_any_unit (), "FFELAB label", sizeof (*l));
+  l->next = ffelab_list_;
+  l->hook = FFECOM_labelNULL;
+  l->value = v;
+  l->firstref_line = ffewhere_line_unknown ();
+  l->firstref_col = ffewhere_column_unknown ();
+  l->doref_line = ffewhere_line_unknown ();
+  l->doref_col = ffewhere_column_unknown ();
+  l->definition_line = ffewhere_line_unknown ();
+  l->definition_col = ffewhere_column_unknown ();
+  l->type = FFELAB_typeUNKNOWN;
+  ffelab_list_ = l;
+  return l;
+}
diff --git a/gcc/f/lab.h b/gcc/f/lab.h
new file mode 100644
index 00000000000..f3f89868a54
--- /dev/null
+++ b/gcc/f/lab.h
@@ -0,0 +1,152 @@
+/* lab.h -- Public #include File (module.h template V1.0)
+   Copyright (C) 1995, 2003 Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+   Owning Modules:
+      lab.c
+
+   Modifications:
+      22-Aug-89	 JCB  1.1
+	 Change for new ffewhere interface.
+*/
+
+/* Allow multiple inclusion to work. */
+
+#ifndef GCC_F_LAB_H
+#define GCC_F_LAB_H
+
+/* Simple definitions and enumerations. */
+
+typedef enum
+  {
+    FFELAB_typeUNKNOWN,		/* No info yet on label. */
+    FFELAB_typeANY,		/* Label valid for anything, no msgs. */
+    FFELAB_typeUSELESS,		/* No valid way to reference this label. */
+    FFELAB_typeASSIGNABLE,	/* Target of ASSIGN: so FORMAT or BRANCH. */
+    FFELAB_typeFORMAT,		/* FORMAT label. */
+    FFELAB_typeLOOPEND,		/* Target of a labeled DO statement. */
+    FFELAB_typeNOTLOOP,		/* Branch target statement not valid DO
+				   target. */
+    FFELAB_typeENDIF,		/* END IF label. */
+    FFELAB_type
+  } ffelabType;
+
+#define FFELAB_valueNONE 0
+#define FFELAB_valueMAX 99999
+
+/* Typedefs. */
+
+typedef struct _ffelab_ *ffelab;
+typedef ffelab ffelabHandle;
+typedef unsigned long ffelabNumber;	/* Count of new labels. */
+#define ffelabNumber_f "l"
+typedef unsigned long ffelabValue;
+#define ffelabValue_f "l"
+
+/* Include files needed by this one. */
+
+#include "com.h"
+#include "where.h"
+
+/* Structure definitions. */
+
+struct _ffelab_
+  {
+    ffelab next;
+    ffecomLabel hook;
+    ffelabValue value;		/* 1 through 99999, or 100000+ for temp
+				   labels. */
+    unsigned long blocknum;	/* Managed entirely by user of module. */
+    ffewhereLine firstref_line;
+    ffewhereColumn firstref_col;
+    ffewhereLine doref_line;
+    ffewhereColumn doref_col;
+    ffewhereLine definition_line;	/* ffewhere_line_unknown() if not
+					   defined. */
+    ffewhereColumn definition_col;
+    ffelabType type;
+  };
+
+/* Global objects accessed by users of this module. */
+
+extern ffelab ffelab_list_;
+extern ffelabNumber ffelab_num_news_;
+
+/* Declare functions with prototypes. */
+
+ffelab ffelab_find (ffelabValue v);
+void ffelab_finish (void);
+void ffelab_init_3 (void);
+ffelab ffelab_new (ffelabValue v);
+
+/* Define macros. */
+
+#define ffelab_blocknum(l) ((l)->blocknum)
+#define ffelab_definition_column(l) ((l)->definition_col)
+#define ffelab_definition_filename(l) \
+      ffewhere_line_filename((l)->definition_line)
+#define ffelab_definition_filelinenum(l) \
+      ffewhere_line_filelinenum((l)->definition_line)
+#define ffelab_definition_line(l) ((l)->definition_line)
+#define ffelab_definition_line_number(l) \
+      ffewhere_line_number((l)->definition_line)
+#define ffelab_doref_column(l) ((l)->doref_col)
+#define ffelab_doref_filename(l) ffewhere_line_filename((l)->doref_line)
+#define ffelab_doref_filelinenum(l) ffewhere_line_filelinenum((l)->doref_line)
+#define ffelab_doref_line(l) ((l)->doref_line)
+#define ffelab_doref_line_number(l) ffewhere_line_number((l)->doref_line)
+#define ffelab_firstref_column(l) ((l)->firstref_col)
+#define ffelab_firstref_filename(l) ffewhere_line_filename((l)->firstref_line)
+#define ffelab_firstref_filelinenum(l) \
+      ffewhere_line_filelinenum((l)->firstref_line)
+#define ffelab_firstref_line(l) ((l)->firstref_line)
+#define ffelab_firstref_line_number(l) ffewhere_line_number((l)->firstref_line)
+#define ffelab_handle_done(h)
+#define ffelab_handle_first() ((ffelabHandle) ffelab_list_)
+#define ffelab_handle_next(h) ((ffelabHandle) (((ffelab) h)->next))
+#define ffelab_handle_target(h) ((ffelab) h)
+#define ffelab_hook(l) ((l)->hook)
+#define ffelab_init_0()
+#define ffelab_init_1()
+#define ffelab_init_2()
+#define ffelab_init_4()
+#define ffelab_kill(l) ffelab_set_value(l,FFELAB_valueNONE);
+#define ffelab_new_generated() (ffelab_new(ffelab_generated_++))
+#define ffelab_number() (ffelab_num_news_)
+#define ffelab_set_blocknum(l,b) ((l)->blocknum = (b))
+#define ffelab_set_definition_column(l,cn) ((l)->definition_col = (cn))
+#define ffelab_set_definition_line(l,ln) ((l)->definition_line = (ln))
+#define ffelab_set_doref_column(l,cn) ((l)->doref_col = (cn))
+#define ffelab_set_doref_line(l,ln) ((l)->doref_line = (ln))
+#define ffelab_set_firstref_column(l,cn) ((l)->firstref_col = (cn))
+#define ffelab_set_firstref_line(l,ln) ((l)->firstref_line = (ln))
+#define ffelab_set_hook(l,h) ((l)->hook = (h))
+#define ffelab_set_type(l,t) ((l)->type = (t))
+#define ffelab_terminate_0()
+#define ffelab_terminate_1()
+#define ffelab_terminate_2()
+#define ffelab_terminate_3()
+#define ffelab_terminate_4()
+#define ffelab_type(l) ((l)->type)
+#define ffelab_value(l) ((l)->value)
+
+/* End of #include file. */
+
+#endif /* ! GCC_F_LAB_H */
diff --git a/gcc/f/lang-specs.h b/gcc/f/lang-specs.h
new file mode 100644
index 00000000000..9ed51ef5a60
--- /dev/null
+++ b/gcc/f/lang-specs.h
@@ -0,0 +1,47 @@
+/* lang-specs.h file for Fortran
+   Copyright (C) 1995, 1996, 1997, 1999, 2000, 2002, 2003
+   Free Software Foundation, Inc.
+   Contributed by James Craig Burley.
+
+This file is part of GNU Fortran.
+
+GNU Fortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Fortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Fortran; see the file COPYING.  If not, write to
+the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+
+*/
+
+/* This is the contribution to the `default_compilers' array in gcc.c for
+   g77.  */
+
+  {".F",   "@f77-cpp-input", 0},
+  {".fpp", "@f77-cpp-input", 0},
+  {".FPP", "@f77-cpp-input", 0},
+  {"@f77-cpp-input",
+   "cc1 -E -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \
+        %{E|M|MM:%(cpp_debug_options)}\
+        %{!M:%{!MM:%{!E: -o %|.f |\n\
+    f771 %|.f %(cc1_options) %{I*} %{!fsyntax-only:%(invoke_as)}}}}", 0},
+  {".r", "@ratfor", 0},
+  {"@ratfor",
+   "%{C:%{!E:%eGCC does not support -C without using -E}}\
+    %{CC:%{!E:%eGCC does not support -CC without using -E}}\
+    ratfor %{C} %{CC} %{v} %{E:%W{o*}} %{!E: %{!pipe:-o %g.f} %i |\n\
+    f771 %m.f %(cc1_options) %{I*} %{!fsyntax-only:%(invoke_as)}}", 0},
+  {".f",   "@f77", 0},
+  {".for", "@f77", 0},
+  {".FOR", "@f77", 0},
+  {"@f77",
+   "%{!M:%{!MM:%{!E:f771 %i %(cc1_options) %{I*}\
+	%{!fsyntax-only:%(invoke_as)}}}}", 0},
diff --git a/gcc/f/lang.opt b/gcc/f/lang.opt
new file mode 100644
index 00000000000..d6a53b7dcd1
--- /dev/null
+++ b/gcc/f/lang.opt
@@ -0,0 +1,402 @@
+; Options for the Fortran 77 front end.
+; Copyright (C) 2003 Free Software Foundation, Inc.
+;
+; This file is part of GCC.
+;
+; GCC is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free
+; Software Foundation; either version 2, or (at your option) any later
+; version.
+; 
+; GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+; for more details.
+; 
+; You should have received a copy of the GNU General Public License
+; along with GCC; see the file COPYING.  If not, write to the Free
+; Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+; 02111-1307, USA.
+
+; See c.opt for a description of this file's format.
+
+; Please try to keep this file in ASCII collating order.
+
+Language
+F77
+
+I
+F77 Joined
+Add a directory for INCLUDE searching
+
+Wall
+F77
+; Documented in C
+
+Wcomment
+F77
+
+Wcomments
+F77
+
+Wglobals
+F77
+Enable warnings about inter-procedural problems
+
+Wimplicit
+F77
+
+Wimport
+F77
+
+Wsurprising
+F77
+Warn about constructs with surprising meanings
+
+Wtrigraphs
+F77
+
+fautomatic
+F77
+Do not treat local variables and COMMON blocks as if they were named in SAVE statements
+
+fbackslash
+F77
+Backslashes in character and hollerith constants are special (not C-style)
+
+fbadu77-intrinsics-delete
+F77 RejectNegative
+Delete libU77 intrinsics with bad interfaces
+
+fbadu77-intrinsics-disable
+F77 RejectNegative
+Disable libU77 intrinsics with bad interfaces
+
+fbadu77-intrinsics-enable
+F77 RejectNegative
+Enable libU77 intrinsics with bad interfaces
+
+fbadu77-intrinsics-hide
+F77 RejectNegative
+Hide libU77 intrinsics with bad interfaces
+
+fcase-initcap
+F77 RejectNegative
+Program written in strict mixed-case
+
+fcase-lower
+F77 RejectNegative
+Compile as if program written in lowercase
+
+fcase-preserve
+F77 RejectNegative
+Preserve case used in program
+
+fcase-strict-lower
+F77 RejectNegative
+Program written in lowercase
+
+fcase-strict-upper
+F77 RejectNegative
+Program written in uppercase
+
+fcase-upper
+F77 RejectNegative
+Compile as if program written in uppercase
+
+fdebug-kludge
+F77
+Emit special debugging information for COMMON and EQUIVALENCE (disabled)
+
+fdollar-ok
+F77
+Allow '$' in symbol names
+
+femulate-complex
+F77
+Have front end emulate COMPLEX arithmetic to avoid bugs
+
+ff2c
+F77
+f2c-compatible code can be generated
+
+ff2c-intrinsics-delete
+F77 RejectNegative
+Delete non-FORTRAN-77 intrinsics f2c supports
+
+ff2c-intrinsics-disable
+F77 RejectNegative
+Disable non-FORTRAN-77 intrinsics f2c supports
+
+ff2c-intrinsics-enable
+F77 RejectNegative
+Enable non-FORTRAN-77 intrinsics f2c supports
+
+ff2c-intrinsics-hide
+F77 RejectNegative
+Hide non-FORTRAN-77 intrinsics f2c supports
+
+ff2c-library
+F77
+Unsupported; generate libf2c-calling code
+
+ff66
+F77
+Program is written in typical FORTRAN 66 dialect
+
+ff77
+F77
+Program is written in typical Unix-f77 dialect
+
+ff90
+F77
+Program is written in Fortran-90-ish dialect
+
+ff90-intrinsics-delete
+F77 RejectNegative
+Delete non-FORTRAN-77 intrinsics F90 supports
+
+ff90-intrinsics-disable
+F77 RejectNegative
+Disable non-FORTRAN-77 intrinsics F90 supports
+
+ff90-intrinsics-enable
+F77 RejectNegative
+Enable non-FORTRAN-77 intrinsics F90 supports
+
+ff90-intrinsics-hide
+F77 RejectNegative
+Hide non-FORTRAN-77 intrinsics F90 supports
+
+ff90-not-vxt
+F77 RejectNegative
+
+ffixed-form
+F77
+
+ffixed-line-length-
+F77 Joined
+ffixed-line-length-<number>	Set the maximum line length to <number>
+
+fflatten-arrays
+F77
+Unsupported; affects code generation of arrays
+
+ffortran-bounds-check
+F77
+Generate code to check subscript and substring bounds
+
+ffree-form
+F77
+Program is written in Fortran-90-ish free form
+
+fglobals
+F77
+Enable fatal diagnostics about inter-procedural problems
+
+fgnu-intrinsics-delete
+F77 RejectNegative
+Delete non-FORTRAN-77 intrinsics g77 supports
+
+fgnu-intrinsics-disable
+F77 RejectNegative
+Disable non-FORTRAN 77 intrinsics F90 supports
+
+fgnu-intrinsics-enable
+F77 RejectNegative
+Enable non-FORTRAN 77 intrinsics F90 supports
+
+fgnu-intrinsics-hide
+F77 RejectNegative
+Hide non-FORTRAN 77 intrinsics F90 supports
+
+finit-local-zero
+F77
+Initialize local vars and arrays to zero
+
+fintrin-case-any
+F77 RejectNegative
+Intrinsics letters in arbitrary cases
+
+fintrin-case-initcap
+F77 RejectNegative
+Intrinsics spelled as e.g. SqRt
+
+fintrin-case-lower
+F77 RejectNegative
+Intrinsics in lowercase
+
+fintrin-case-upper
+F77 RejectNegative
+Intrinsics in uppercase
+
+fmatch-case-any
+F77 RejectNegative
+Language keyword letters in arbitrary cases
+
+fmatch-case-initcap
+F77 RejectNegative
+Language keywords spelled as e.g. IOStat
+
+fmatch-case-lower
+F77 RejectNegative
+Language keywords in lowercase
+
+fmatch-case-upper
+F77 RejectNegative
+Language keywords in uppercase
+
+fmil-intrinsics-delete
+F77 RejectNegative
+Delete MIL-STD 1753 intrinsics
+
+fmil-intrinsics-disable
+F77 RejectNegative
+Disable MIL-STD 1753 intrinsics
+
+fmil-intrinsics-enable
+F77 RejectNegative
+Enable MIL-STD 1753 intrinsics
+
+fmil-intrinsics-hide
+F77 RejectNegative
+Hide MIL-STD 1753 intrinsics
+
+fonetrip
+F77
+Take at least one trip through each iterative DO loop
+
+fpedantic
+F77
+Warn about use of (only a few for now) Fortran extensions
+
+fpreprocessed
+F77
+
+fsecond-underscore
+F77
+Allow appending a second underscore to externals
+
+fsilent
+F77
+Do not print names of program units as they are compiled
+
+fsource-case-lower
+F77 RejectNegative
+Internally convert most source to lowercase
+
+fsource-case-preserve
+F77 RejectNegative
+Internally preserve source case
+
+fsource-case-upper
+F77 RejectNegative
+Internally convert most source to uppercase
+
+fsymbol-case-any
+F77 RejectNegative
+
+fsymbol-case-initcap
+F77 RejectNegative
+Symbol names spelled in mixed case
+
+fsymbol-case-lower
+F77 RejectNegative
+Symbol names in lowercase
+
+fsymbol-case-upper
+F77 RejectNegative
+Symbol names in uppercase
+
+ftypeless-boz
+F77
+Make prefix-radix non-decimal constants be typeless
+
+fugly
+F77
+Allow all ugly features
+
+fugly-args
+F77
+Hollerith and typeless can be passed as arguments
+
+fugly-assign
+F77
+Allow ordinary copying of ASSIGN'ed vars
+
+fugly-assumed
+F77
+Dummy array dimensioned to (1) is assumed-size
+
+fugly-comma
+F77
+Trailing comma in procedure call denotes null argument
+
+fugly-complex
+F77
+Allow REAL(Z) and AIMAG(Z) given DOUBLE COMPLEX Z
+
+fugly-init
+F77
+Initialization via DATA and PARAMETER is not type-compatible
+
+fugly-logint
+F77
+Allow INTEGER and LOGICAL interchangeability
+
+funderscoring
+F77
+Append underscores to externals
+
+funix-intrinsics-delete
+F77 RejectNegative
+Delete libU77 intrinsics
+
+funix-intrinsics-disable
+F77 RejectNegative
+Disable libU77 intrinsics
+
+funix-intrinsics-enable
+F77 RejectNegative
+Enable libU77 intrinsics
+
+funix-intrinsics-hide
+F77 RejectNegative
+Hide libU77 intrinsics
+
+fversion
+F77 RejectNegative
+Print g77-specific version information and run internal tests
+
+fvxt
+F77
+Program is written in VXT (Digital-like) FORTRAN
+
+fvxt-intrinsics-delete
+F77 RejectNegative
+Delete non-FORTRAN-77 intrinsics VXT FORTRAN supports
+
+fvxt-intrinsics-disable
+F77 RejectNegative
+Disable non-FORTRAN-77 intrinsics VXT FORTRAN supports
+
+fvxt-intrinsics-enable
+F77 RejectNegative
+Enable non-FORTRAN-77 intrinsics VXT FORTRAN supports
+
+fvxt-intrinsics-hide
+F77 RejectNegative
+Hide non-FORTRAN-77 intrinsics VXT FORTRAN supports
+
+fvxt-not-f90
+F77 RejectNegative
+
+fxyzzy
+F77
+Print internal debugging-related information
+
+fzeros
+F77
+Treat initial values of 0 like non-zero values
+
+; This comment is to ensure we retain the blank line above.
diff --git a/gcc/testsuite/g77.f-torture/execute/io1.f b/gcc/testsuite/g77.f-torture/execute/io1.f
new file mode 100644
index 00000000000..c5242446a49
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/execute/io1.f
@@ -0,0 +1,10 @@
+*     Fixed by 1998-09-28 libI77/open.c change.
+      open(90,status='scratch')
+      write(90, '(1X, I1 / 1X, I1)') 1, 2
+      rewind 90
+      write(90, '(1X, I1)') 1
+      rewind 90                 ! implicit ENDFILE expected
+      read(90, *) i
+      read(90, *, end=10) j
+      call abort()
+ 10   end
diff --git a/gcc/testsuite/g77.f-torture/execute/io1.x b/gcc/testsuite/g77.f-torture/execute/io1.x
new file mode 100644
index 00000000000..6a69a3aadab
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/execute/io1.x
@@ -0,0 +1,13 @@
+# Scratch files aren't implemented for mmixware
+# (_stat is a stub and files can't be deleted).
+# Similar restrictions exist for most simulators.
+
+if { [istarget "mmix-knuth-mmixware"]
+     || [istarget "arm*-*-elf"]
+     || [istarget "strongarm*-*-elf"]
+     || [istarget "xscale*-*-elf"]
+     || [istarget "cris-*-elf"] } {
+	set torture_execute_xfail [istarget]
+}
+
+return 0
diff --git a/gcc/testsuite/g77.f-torture/execute/labug1.f b/gcc/testsuite/g77.f-torture/execute/labug1.f
new file mode 100644
index 00000000000..032fa41f899
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/execute/labug1.f
@@ -0,0 +1,57 @@
+      PROGRAM LABUG1
+
+*  This program core dumps on mips-sgi-irix6.2 when compiled
+*  with egcs-19981101, egcs-19981109 and egcs-19981122 snapshots
+*  with -O2
+*
+*  Originally derived from LAPACK test suite.
+*  Almost any change allows it to run.
+*
+*  David Billinghurst, (David.Billinghurst@riotinto.com.au)
+*  25 November 1998
+* 
+*     .. Parameters ..
+      INTEGER   LDA, LDE
+      PARAMETER ( LDA = 2500, LDE = 50  )
+      COMPLEX   CZERO 
+      PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) )
+
+      INTEGER   I, J, M, N
+      REAL      V
+      COMPLEX   A(LDA),B(LDA),C(LDA),E(LDE,LDE),F(LDE,LDE)  
+      COMPLEX   Z
+
+      N=2
+      M=1
+*
+      do i = 1, m
+         do j = 1, n
+            e(i,j) = czero
+            f(i,j) = czero
+        end do
+      end do
+*
+      DO J = 1, N
+         DO I = 1, M
+            V =  ABS( E(I,J) - F(I,J) )
+         END DO
+      END DO
+ 
+      CALL SUB2(M,Z)
+
+      END
+
+      subroutine SUB2(I,A)
+      integer i
+      complex a
+      end
+
+
+
+
+
+
+
+
+
+
diff --git a/gcc/testsuite/g77.f-torture/execute/large_vec.f b/gcc/testsuite/g77.f-torture/execute/large_vec.f
new file mode 100644
index 00000000000..0af5b1b0b3f
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/execute/large_vec.f
@@ -0,0 +1,3 @@
+      parameter (nmax=165000)
+      double precision x(nmax)
+      end
diff --git a/gcc/testsuite/g77.f-torture/execute/le.f b/gcc/testsuite/g77.f-torture/execute/le.f
new file mode 100644
index 00000000000..74e42750d55
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/execute/le.f
@@ -0,0 +1,29 @@
+      program fool
+
+      real     foo
+      integer  n
+      logical  t
+
+      foo = 2.5
+      n = 5
+
+      t = (n > foo)
+      if (t .neqv. .true.) call abort
+      t = (n >= foo)
+      if (t .neqv. .true.) call abort
+      t = (n < foo)
+      if (t .neqv. .false.) call abort
+      t = (n <= 5)
+      if (t .neqv. .true.) call abort
+      t = (n >= 5 )
+      if (t .neqv. .true.) call abort
+      t = (n == 5)
+      if (t .neqv. .true.) call abort
+      t = (n /= 5)
+      if (t .neqv. .false.) call abort
+      t = (n /= foo)
+      if (t .neqv. .true.) call abort
+      t = (n == foo)
+      if (t .neqv. .false.) call abort
+
+      end
diff --git a/gcc/testsuite/g77.f-torture/execute/select.f b/gcc/testsuite/g77.f-torture/execute/select.f
new file mode 100644
index 00000000000..f1024330a71
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/execute/select.f
@@ -0,0 +1,173 @@
+C   integer byte case with integer byte parameters as case(s)
+        subroutine ib
+        integer *1 a /1/
+        integer *1  one,two,three
+        parameter (one=1,two=2,three=3)
+        select case (a)
+        case (one)
+        case (two)
+           call abort
+        case (three)
+           call abort
+        case default
+           call abort
+        end select
+        print*,'normal ib'
+        end
+C   integer halfword case with integer halfword parameters
+        subroutine ih
+        integer *2 a /1/
+        integer *2  one,two,three
+        parameter (one=1,two=2,three=3)
+        select case (a)
+        case (one)
+        case (two)
+           call abort
+        case (three)
+           call abort
+        case default
+           call abort
+        end select
+        print*,'normal ih'
+        end
+C   integer case with integer parameters
+        subroutine iw
+        integer *4 a /1/
+        integer *4  one,two,three
+        parameter (one=1,two=2,three=3)
+        select case (a)
+        case (one)
+        case (two)
+           call abort
+        case (three)
+           call abort
+        case default
+           call abort
+        end select
+        print*,'normal iw'
+        end
+C   integer double case with integer double parameters
+        subroutine id
+        integer *8 a /1/
+        integer *8  one,two,three
+        parameter (one=1,two=2,three=3)
+        select case (a)
+        case (one)
+        case (two)
+           call abort
+        case (three)
+           call abort
+        case default
+           call abort
+        end select
+        print*,'normal id'
+        end
+C   integer byte select with integer case
+       subroutine ib_mixed
+       integer*1 s /1/
+       select case (s)
+       case (1)
+       case (2)
+         call abort
+       end select
+       print*,'ib ok'
+       end
+C   integer halfword with integer case
+       subroutine ih_mixed
+       integer*2 s /1/
+       select case (s)
+       case (1)
+       case default
+         call abort
+       end select
+       print*,'ih ok'
+       end
+C   integer word with integer case
+       subroutine iw_mixed
+       integer s /5/
+       select case (s)
+       case (1)
+          call abort
+       case (2)
+          call abort
+       case (3)
+          call abort
+       case (4)
+          call abort
+       case (5)
+C                   
+       case (6)
+           call abort
+       case default
+           call abort
+       end select
+       print*,'iw ok'
+       end
+C   integer doubleword with integer case
+       subroutine id_mixed
+       integer *8 s /1024/
+       select case (s)
+       case (1)
+           call abort
+       case (1023)
+           call abort
+       case (1025)
+           call abort
+       case (1024)
+C
+       end select
+       print*,'i8 ok'
+       end
+       subroutine l1_mixed
+       logical*1 s /.TRUE./
+       select case (s)
+       case (.TRUE.)
+       case (.FALSE.)
+          call abort
+       end select
+       print*,'l1 ok'
+       end
+       subroutine l2_mixed
+       logical*2 s /.FALSE./
+       select case (s)
+       case (.TRUE.)
+           call abort
+       case (.FALSE.)
+       end select
+       print*,'lh ok'
+       end
+       subroutine l4_mixed
+       logical*4 s /.TRUE./
+       select case (s)
+       case (.FALSE.)
+         call abort
+       case (.TRUE.)
+       end select
+       print*,'lw ok'
+       end
+       subroutine l8_mixed
+       logical*8 s /.TRUE./
+       select case (s)
+       case (.TRUE.)
+       case (.FALSE.)
+          call abort
+       end select
+       print*,'ld ok'
+       end
+C   main
+C -- regression cases
+        call ib
+        call ih
+        call iw
+        call id
+C -- new functionality
+        call ib_mixed
+        call ih_mixed
+        call iw_mixed
+        call id_mixed
+        end
+        
+
+
+
+
diff --git a/gcc/testsuite/g77.f-torture/execute/short.f b/gcc/testsuite/g77.f-torture/execute/short.f
new file mode 100644
index 00000000000..89ae273891c
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/execute/short.f
@@ -0,0 +1,57 @@
+      program short
+
+      parameter   (   N=2  )
+      common /chb/    pi,sig(0:N)
+      common /parm/   h(2,2)
+
+c  initialize some variables
+      h(2,2) = 1117
+      h(2,1) = 1178
+      h(1,2) = 1568
+      h(1,1) = 1621
+      sig(0) = -1.
+      sig(1) = 0.
+      sig(2) = 1.
+
+      call printout
+      stop
+      end
+
+c ******************************************************************
+
+      subroutine printout
+      parameter   (   N=2  )
+      common /chb/    pi,sig(0:N)
+      common /parm/   h(2,2)
+      dimension       yzin1(0:N), yzin2(0:N)
+
+c  function subprograms
+      z(i,j,k) = 0.5*h(i,j)*(sig(k)-1.)
+
+c  a four-way average of rhobar
+      do 260  k=0,N
+        yzin1(k) = 0.25 * 
+     &       ( z(2,2,k) + z(1,2,k) +
+     &         z(2,1,k) + z(1,1,k) )
+  260       continue
+
+c  another four-way average of rhobar
+      do 270  k=0,N
+	rtmp1 = z(2,2,k)
+	rtmp2 = z(1,2,k)
+	rtmp3 = z(2,1,k)
+	rtmp4 = z(1,1,k)
+        yzin2(k) = 0.25 * 
+     &       ( rtmp1 + rtmp2 + rtmp3 + rtmp4 )
+  270       continue
+
+      do k=0,N
+	if (yzin1(k) .ne. yzin2(k)) call abort
+      enddo
+      if (yzin1(0) .ne. -1371.) call abort
+      if (yzin1(1) .ne. -685.5) call abort
+      if (yzin1(2) .ne. 0.) call abort
+
+      return
+      end
+
diff --git a/gcc/testsuite/g77.f-torture/execute/u77-test.f b/gcc/testsuite/g77.f-torture/execute/u77-test.f
new file mode 100644
index 00000000000..f502bc72833
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/execute/u77-test.f
@@ -0,0 +1,421 @@
+***   Some random stuff for testing libU77.  Should be done better.  It's
+*     hard to test things where you can't guarantee the result.  Have a
+*     good squint at what it prints, though detected errors will cause 
+*     starred messages.
+*
+* Currently not tested:
+*   ALARM
+*   CHDIR (func)
+*   CHMOD (func)
+*   FGET (func/subr)
+*   FGETC (func)
+*   FPUT (func/subr)
+*   FPUTC (func)
+*   FSTAT (subr)
+*   GETCWD (subr)
+*   HOSTNM (subr)
+*   IRAND
+*   KILL
+*   LINK (func)
+*   LSTAT (subr)
+*   RENAME (func/subr)
+*   SIGNAL (subr)
+*   SRAND
+*   STAT (subr)
+*   SYMLNK (func/subr)
+*   UMASK (func)
+*   UNLINK (func)
+*
+* NOTE! This is the testsuite version, so it should compile and
+* execute on all targets, and either run to completion (with
+* success status) or fail (by calling abort).  The *other* version,
+* which is a bit more interactive and tests a couple of things
+* this one cannot, should be generally the same, and is in
+* libf2c/libU77/u77-test.f.  Please keep it up-to-date.
+
+      implicit none
+
+      external hostnm
+*     intrinsic hostnm
+      integer hostnm
+
+      integer i, j, k, ltarray (9), idat (3), count, rate, count_max,
+     +     pid, mask
+      real tarray1(2), tarray2(2), r1, r2
+      double precision d1
+      integer(kind=2) bigi
+      logical issum
+      intrinsic getpid, getuid, getgid, ierrno, gerror, time8,
+     +     fnum, isatty, getarg, access, unlink, fstat, iargc,
+     +     stat, lstat, getcwd, gmtime, etime, chmod, itime, date,
+     +     chdir, fgetc, fputc, system_clock, second, idate, secnds,
+     +     time, ctime, fdate, ttynam, date_and_time, mclock, mclock8,
+     +     cpu_time, dtime, ftell, abort
+      external lenstr, ctrlc
+      integer lenstr
+      logical l
+      character gerr*80, c*1
+      character ctim*25, line*80, lognam*20, wd*1000, line2*80, 
+     +     ddate*8, ttime*10, zone*5, ctim2*25
+      integer fstatb (13), statb (13)
+      integer *2 i2zero
+      integer values(8)
+      integer(kind=7) sigret
+
+      i = time ()
+      ctim = ctime (i)
+      WRITE (6,'(A/)') '1 GNU libU77 test at: ' // ctim(:lenstr (ctim))
+      write (6,'(A,I3,'', '',I3)')
+     +     ' Logical units 5 and 6 correspond (FNUM) to'
+     +     // ' Unix i/o units ', fnum(5), fnum(6)
+      if (lnblnk('foo ').ne.3 .or. len_trim('foo ').ne.3) then
+        print *, 'LNBLNK or LEN_TRIM failed'
+        call abort
+      end if
+
+      bigi = time8 ()
+
+      call ctime (i, ctim2)
+      if (ctim .ne. ctim2) then
+        write (6, *) '*** CALL CTIME disagrees with CTIME(): ',
+     +    ctim2(:lenstr (ctim2)), ' vs. ', ctim(:lenstr (ctim))
+        call doabort
+      end if
+
+      j = time ()
+      if (i .gt. bigi .or. bigi .gt. j) then
+        write (6, *) '*** TIME/TIME8/TIME sequence failures: ',
+     +    i, bigi, j
+        call doabort
+      end if
+
+      print *, 'Command-line arguments: ', iargc ()
+      do i = 0, iargc ()
+         call getarg (i, line)
+         print *, 'Arg ', i, ' is: ', line(:lenstr (line))
+      end do
+
+      l= isatty(6)
+      line2 = ttynam(6)
+      if (l) then
+        line = 'and 6 is a tty device (ISATTY) named '//line2
+      else
+        line = 'and 6 isn''t a tty device (ISATTY)'
+      end if
+      write (6,'(1X,A)') line(:lenstr(line))
+      call ttynam (6, line)
+      if (line .ne. line2) then
+        print *, '*** CALL TTYNAM disagrees with TTYNAM: ',
+     +    line(:lenstr (line))
+        call doabort
+      end if
+
+*     regression test for compiler crash fixed by JCB 1998-08-04 com.c
+      sigret = signal(2, ctrlc)
+
+      pid = getpid()
+      WRITE (6,'(A,I10)') ' Process id (GETPID): ', pid
+      WRITE (6,'(A,I10)') ' User id (GETUID): ', GETUID ()
+      WRITE (6,'(A,I10)') ' Group id (GETGID): ', GETGID ()
+      WRITE (6, *) 'If you have the `id'' program, the following call'
+      write (6, *) 'of SYSTEM should agree with the above:'
+      call flush(6)
+      CALL SYSTEM ('echo " " `id`')
+      call flush
+
+      lognam = 'blahblahblah'
+      call getlog (lognam)
+      write (6,*) 'Login name (GETLOG): ', lognam(:lenstr (lognam))
+
+      wd = 'blahblahblah'
+      call getenv ('LOGNAME', wd)
+      write (6,*) 'Login name (GETENV of LOGNAME): ', wd(:lenstr (wd))
+
+      call umask(0, mask)
+      write(6,*) 'UMASK returns', mask
+      call umask(mask)
+
+      ctim = fdate()
+      write (6,*) 'FDATE returns: ', ctim(:lenstr (ctim))
+      call fdate (ctim)
+      write (6,*) 'CALL FDATE returns: ', ctim(:lenstr (ctim))
+
+      j=time()
+      call ltime (j, ltarray)
+      write (6,'(1x,a,9i4)') 'LTIME returns:', ltarray
+      call gmtime (j, ltarray)
+      write (6,'(1x,a,9i4)') 'GMTIME returns:', ltarray
+
+      call system_clock(count)  ! omitting optional args
+      call system_clock(count, rate, count_max)
+      write(6,*) 'SYSTEM_CLOCK returns: ', count, rate, count_max
+
+      call date_and_time(ddate)  ! omitting optional args
+      call date_and_time(ddate, ttime, zone, values)
+      write(6, *) 'DATE_AND_TIME returns: ', ddate, ' ', ttime, ' ',
+     +     zone, ' ', values
+
+      write (6,*) 'Sleeping for 1 second (SLEEP) ...'
+      call sleep (1)
+
+c consistency-check etime vs. dtime for first call
+      r1 = etime (tarray1)
+      r2 = dtime (tarray2)
+      if (abs (r1-r2).gt.1.0) then
+        write (6,*)
+     +       'Results of ETIME and DTIME differ by more than a second:',
+     +       r1, r2
+        call doabort
+      end if
+      if (.not. issum (r1, tarray1(1), tarray1(2))) then
+        write (6,*) '*** ETIME didn''t return sum of the array: ',
+     +       r1, ' /= ', tarray1(1), '+', tarray1(2)
+        call doabort
+      end if
+      if (.not. issum (r2, tarray2(1), tarray2(2))) then
+        write (6,*) '*** DTIME didn''t return sum of the array: ',
+     +       r2, ' /= ', tarray2(1), '+', tarray2(2)
+        call doabort
+      end if
+      write (6, '(A,3F10.3)')
+     +     ' Elapsed total, user, system time (ETIME): ',
+     +     r1, tarray1
+
+c now try to get times to change enough to see in etime/dtime
+      write (6,*) 'Looping until clock ticks at least once...'
+      do i = 1,1000
+      do j = 1,1000
+      end do
+      call dtime (tarray2, r2)
+      if (tarray2(1) .ne. 0. .or. tarray2(2) .ne. 0.) exit
+      end do
+      call etime (tarray1, r1)
+      if (.not. issum (r1, tarray1(1), tarray1(2))) then
+        write (6,*) '*** ETIME didn''t return sum of the array: ',
+     +       r1, ' /= ', tarray1(1), '+', tarray1(2)
+        call doabort
+      end if
+      if (.not. issum (r2, tarray2(1), tarray2(2))) then
+        write (6,*) '*** DTIME didn''t return sum of the array: ',
+     +       r2, ' /= ', tarray2(1), '+', tarray2(2)
+        call doabort
+      end if
+      write (6, '(A,3F10.3)')
+     +     ' Differences in total, user, system time (DTIME): ',
+     +     r2, tarray2
+      write (6, '(A,3F10.3)')
+     +     ' Elapsed total, user, system time (ETIME): ',
+     +     r1, tarray1
+      write (6, *) '(Clock-tick detected after ', i, ' 1K loops.)'
+
+      call idate (i,j,k)
+      call idate (idat)
+      write (6,*) 'IDATE (date,month,year): ',idat
+      print *,  '... and the VXT version (month,date,year): ', i,j,k
+      if (i/=idat(2) .or. j/=idat(1) .or. k/=mod(idat(3),100)) then
+        print *, '*** VXT and U77 versions don''t agree'
+        call doabort
+      end if
+
+      call date (ctim)
+      write (6,*) 'DATE (dd-mmm-yy): ', ctim(:lenstr (ctim))
+
+      call itime (idat)
+      write (6,*) 'ITIME (hour,minutes,seconds): ', idat
+
+      call time(line(:8))
+      print *, 'TIME: ', line(:8)
+
+      write (6,*) 'SECNDS(0.0) returns: ',secnds(0.0)
+
+      write (6,*) 'SECOND returns: ', second()
+      call dumdum(r1)
+      call second(r1)
+      write (6,*) 'CALL SECOND returns: ', r1
+
+*     compiler crash fixed by 1998-10-01 com.c change
+      if (rand(0).lt.0.0 .or. rand(0).gt.1.0) then
+        write (6,*) '*** rand(0) error'
+        call doabort()
+      end if
+
+      i = getcwd(wd)
+      if (i.ne.0) then
+        call perror ('*** getcwd')
+        call doabort
+      else
+        write (6,*) 'Current directory is "'//wd(:lenstr(wd))//'"'
+      end if
+      call chdir ('.',i)
+      if (i.ne.0) then
+        write (6,*) '***CHDIR to ".": ', i
+        call doabort
+      end if
+
+      i=hostnm(wd)
+      if(i.ne.0) then
+        call perror ('*** hostnm')
+        call doabort
+      else
+        write (6,*) 'Host name is ', wd(:lenstr(wd))
+      end if
+
+      i = access('/dev/null ', 'rw')
+      if (i.ne.0) write (6,*) '***Read/write ACCESS to /dev/null: ', i
+      write (6,*) 'Creating file "foo" for testing...'
+      open (3,file='foo',status='UNKNOWN')
+      rewind 3
+      call fputc(3, 'c',i)
+      call fputc(3, 'd',j)      
+      if (i+j.ne.0) write(6,*) '***FPUTC: ', i
+C     why is it necessary to reopen?  (who wrote this?)
+C     the better to test with, my dear!  (-- burley)
+      close(3)
+      open(3,file='foo',status='old')
+      call fseek(3,0,0,*10)
+      go to 20
+ 10   write(6,*) '***FSEEK failed'
+      call doabort
+ 20   call fgetc(3, c,i)
+      if (i.ne.0) then
+        write(6,*) '***FGETC: ', i
+        call doabort
+      end if
+      if (c.ne.'c') then
+        write(6,*) '***FGETC read the wrong thing: ', ichar(c)
+        call doabort
+      end if
+      i= ftell(3)
+      if (i.ne.1) then
+        write(6,*) '***FTELL offset: ', i
+        call doabort
+      end if
+      call ftell(3, i)
+      if (i.ne.1) then
+        write(6,*) '***CALL FTELL offset: ', i
+        call doabort
+      end if
+      call chmod ('foo', 'a+w',i)
+      if (i.ne.0) then
+        write (6,*) '***CHMOD of "foo": ', i
+        call doabort
+      end if
+      i = fstat (3, fstatb)
+      if (i.ne.0) then
+        write (6,*) '***FSTAT of "foo": ', i
+        call doabort
+      end if
+      i = stat ('foo', statb)
+      if (i.ne.0) then
+        write (6,*) '***STAT of "foo": ', i
+        call doabort
+      end if
+      write (6,*) '  with stat array ', statb
+      if (statb(6) .ne. getgid ()) then
+        write (6,*) 'Note: FSTAT gid wrong (happens on some systems).'
+      end if
+      if (statb(5) .ne. getuid () .or. statb(4) .ne. 1) then
+        write (6,*) '*** FSTAT uid or nlink is wrong'
+        call doabort
+      end if
+      do i=1,13
+        if (fstatb (i) .ne. statb (i)) then
+          write (6,*) '*** FSTAT and STAT don''t agree on '// '
+     +         array element ', i, ' value ', fstatb (i), statb (i)
+          call abort
+        end if
+      end do
+      i = lstat ('foo', fstatb)
+      do i=1,13
+        if (fstatb (i) .ne. statb (i)) then
+          write (6,*) '*** LSTAT and STAT don''t agree on '//
+     +         'array element ', i, ' value ', fstatb (i), statb (i)
+          call abort
+        end if
+      end do
+
+C     in case it exists already:
+      call unlink ('bar',i)
+      call link ('foo ', 'bar ',i)
+      if (i.ne.0) then
+        write (6,*) '***LINK "foo" to "bar" failed: ', i
+        call doabort
+      end if
+      call unlink ('foo',i)
+      if (i.ne.0) then
+        write (6,*) '***UNLINK "foo" failed: ', i
+        call doabort
+      end if
+      call unlink ('foo',i)
+      if (i.eq.0) then
+        write (6,*) '***UNLINK "foo" again: ', i
+        call doabort
+      end if
+
+      call gerror (gerr)
+      i = ierrno()
+      write (6,'(A,I3,A/1X,A)') ' The current error number is: ',
+     +     i,
+     +     ' and the corresponding message is:', gerr(:lenstr(gerr))
+      write (6,*) 'This is sent to stderr prefixed by the program name'
+      call getarg (0, line)
+      call perror (line (:lenstr (line)))
+      call unlink ('bar')
+
+      print *, 'MCLOCK returns ', mclock ()
+      print *, 'MCLOCK8 returns ', mclock8 ()
+
+      call cpu_time (d1)
+      print *, 'CPU_TIME returns ', d1
+
+C     WRITE (6,*) 'You should see exit status 1'
+      CALL EXIT(0)
+ 99   END
+
+* Return length of STR not including trailing blanks, but always > 0.
+      integer function lenstr (str)
+      character*(*) str
+      if (str.eq.' ') then
+        lenstr=1
+      else
+        lenstr = lnblnk (str)
+      end if
+      end
+
+* Just make sure SECOND() doesn't "magically" work the second time.
+      subroutine dumdum(r)
+      r = 3.14159
+      end
+
+* Test whether sum is approximately left+right.
+      logical function issum (sum, left, right)
+      implicit none
+      real sum, left, right
+      real mysum, delta, width
+      mysum = left + right
+      delta = abs (mysum - sum)
+      width = abs (left) + abs (right)
+      issum = (delta .le. .0001 * width)
+      end
+
+* Signal handler
+      subroutine ctrlc
+      print *, 'Got ^C'
+      call doabort
+      end
+
+* A problem has been noticed, so maybe abort the test.
+      subroutine doabort
+* For this version, call the ABORT intrinsic.
+      intrinsic abort
+      call abort
+      end
+
+* Testsuite version only.
+* Don't actually reference the HOSTNM intrinsic, because some targets
+* need -lsocket, which we don't have a mechanism for supplying.
+      integer function hostnm(nm)
+      character*(*) nm
+      nm = 'not determined by this version of u77-test.f'
+      hostnm = 0
+      end
diff --git a/gcc/testsuite/g77.f-torture/execute/u77-test.x b/gcc/testsuite/g77.f-torture/execute/u77-test.x
new file mode 100644
index 00000000000..e4b89008c25
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/execute/u77-test.x
@@ -0,0 +1,12 @@
+# Various intrinsics not implemented and not implementable; will fail at
+# link time.
+
+if { [istarget "mmix-knuth-mmixware"]
+     || [istarget "arm*-*-elf"]
+     || [istarget "strongarm*-*-elf"]
+     || [istarget "xscale*-*-elf"]
+     || [istarget "cris-*-elf"] } {
+	set torture_compile_xfail [istarget]
+}
+
+return 0
diff --git a/gcc/testsuite/g77.f-torture/noncompile/19981216-0.f b/gcc/testsuite/g77.f-torture/noncompile/19981216-0.f
new file mode 100644
index 00000000000..0cc9087d6cb
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/noncompile/19981216-0.f
@@ -0,0 +1,89 @@
+* Resent-From: Craig Burley <burley@gnu.org>
+* Resent-To: craig@jcb-sc.com
+* X-Delivered: at request of burley on mescaline.gnu.org
+* Date: Wed, 16 Dec 1998 18:31:24 +0100
+* From: Dieter Stueken <stueken@conterra.de>
+* Organization: con terra GmbH
+* To: fortran@gnu.org
+* Subject: possible bug
+* Content-Type: text/plain; charset=iso-8859-1
+* X-Mime-Autoconverted: from 8bit to quoted-printable by mescaline.gnu.org id KAA09085
+* X-UIDL: 72293bf7f9fac8378ec7feca2bccbce2
+* 
+* Hi,
+* 
+* I'm about to compile a very old, very ugly Fortran program.
+* For one part I got:
+* 
+* f77: Internal compiler error: program f771 got fatal signal 6
+* 
+* instead of any detailed error message. I was able to break down the
+* problem to the following source fragment:
+* 
+* -------------------------------------------
+        PROGRAM WAP
+
+        integer*2  ios
+        character*80  name
+
+        name = 'blah'
+        open(unit=8,status='unknown',file=name,form='formatted',
+     F       iostat=ios)
+
+      END
+* -------------------------------------------
+* 
+* The problem seems to be caused by the "integer*2 ios" declaration.
+* So far I solved it by simply using a plain integer instead.
+* 
+* I'm running gcc on a Linux system compiled/installed
+* with no special options:
+* 
+* -> g77 -v
+* g77 version 0.5.23
+* Driving: g77 -v -c -xf77-version /dev/null -xnone
+* Reading specs from /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/specs
+* gcc version 2.8.1
+*  /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/cpp -lang-c -v -undef
+* -D__GNUC__=2 -D__GNUC_MINOR__=8 -D__ELF__ -D__unix__ -D__linux__
+* -D__unix -D__linux -Asystem(posix) -D_LANGUAGE_FORTRAN -traditional
+* -Di386 -Di686 -Asystem(unix) -Acpu(i386) -Amachine(i386) -D__i386__
+* -D__i686__ -Asystem(unix) -Acpu(i386) -Amachine(i386) /dev/null
+* /dev/null
+* GNU CPP version 2.8.1 (i386 GNU/Linux with ELF)
+* #include "..." search starts here:
+* #include <...> search starts here:
+*  /usr/local/include
+*  /usr/i686-pc-linux-gnulibc1/include
+*  /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/include
+*  /usr/include
+* End of search list.
+*  /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/f771 -fnull-version
+* -quiet -dumpbase g77-version.f -version -fversion -o /tmp/cca24911.s
+* /dev/null
+* GNU F77 version 2.8.1 (i686-pc-linux-gnulibc1) compiled by GNU C version
+* 2.8.1.
+* GNU Fortran Front End version 0.5.23
+*  as -V -Qy -o /tmp/cca24911.o /tmp/cca24911.s
+* GNU assembler version 2.8.1 (i486-linux), using BFD version 2.8.1
+*  ld -m elf_i386 -dynamic-linker /lib/ld-linux.so.1 -o /tmp/cca24911
+* /tmp/cca24911.o /usr/lib/crt1.o /usr/lib/crti.o
+* /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/crtbegin.o
+* -L/usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1 -L/usr -lg2c -lm -lgcc
+* -lc -lgcc /usr/lib/gcc-lib/i686-pc-linux-gnulibc1/2.8.1/crtend.o
+* /usr/lib/crtn.o
+*  /tmp/cca24911
+* __G77_LIBF77_VERSION__: 0.5.23
+* @(#)LIBF77 VERSION 19970919
+* __G77_LIBI77_VERSION__: 0.5.23
+* @(#) LIBI77 VERSION pjw,dmg-mods 19980405
+* __G77_LIBU77_VERSION__: 0.5.23
+* @(#) LIBU77 VERSION 19970919
+* 
+* 
+* Regards, Dieter.
+* -- 
+* Dieter Stüken, con terra GmbH, Münster
+*     stueken@conterra.de         stueken@qgp.uni-muenster.de
+*     http://www.conterra.de/     http://qgp.uni-muenster.de/~stueken
+*     (0)251-980-2027             (0)251-83-334974
diff --git a/gcc/testsuite/g77.f-torture/noncompile/19990218-1.f b/gcc/testsuite/g77.f-torture/noncompile/19990218-1.f
new file mode 100644
index 00000000000..25b7c5b2b52
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/noncompile/19990218-1.f
@@ -0,0 +1,13 @@
+        double precision function fun(a,b)
+        double precision a,b
+        print*,'in sub: a,b=',a,b
+        fun=a*b
+        print*,'in sub: fun=',fun
+        return
+        end
+        program test
+        double precision a,b,c
+        data a,b/1.0d-46,1.0d0/
+        c=fun(a,b)
+        print*,'in main: fun=',c
+        end
diff --git a/gcc/testsuite/g77.f-torture/noncompile/19990826-4.f b/gcc/testsuite/g77.f-torture/noncompile/19990826-4.f
new file mode 100644
index 00000000000..86d2a939064
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/noncompile/19990826-4.f
@@ -0,0 +1,648 @@
+* Culled from 970528-1.f in Burley's g77 test suite.  Copyright
+* status not clear.  Feel free to chop down if the bug is still
+* reproducible (see end of test case for how bug shows up in gdb
+* run of f771).  No particular reason it should be a noncompile
+* case, other than that I didn't want to spend time "fixing" it
+* to compile cleanly (with -O0, which works) while making sure the
+* ICE remained reproducible.  -- burley 1999-08-26
+
+* Date: Mon, 26 May 1997 13:00:19 +0200 (GMT+0200)
+* From: "D. O'Donoghue" <dod@da.saao.ac.za>
+* To: Craig Burley <burley@gnu.ai.mit.edu>
+* Cc: fortran@gnu.ai.mit.edu
+* Subject: Re: g77 problems
+
+	program dophot
+	parameter (napple = 4)
+        common /window/nwindo,ixwin(50),iywin(50),iboxwin(50),itype(50)
+        common/io/luout,ludebg
+	common/search/nstot,thresh
+	common /fitparms / acc(npmax),alim(npmax),mit,mpar,mfit1,
+     +                     mfit2,ind(npmax)
+	common /starlist/ starpar(npmax,nsmax), imtype(nsmax),
+	1shadow(npmax,nsmax),shaderr(npmax,nsmax),idstr(nsmax)
+	common /aperlist/ apple(napple ,nsmax)
+	common /parpred / ava(npmax)
+	common /unitize / ufactor
+	common /undergnd/ nfast, nslow
+	common/bzero/ scale,zero
+	common /ctimes / chiimp, apertime, filltime, addtime
+	common / drfake / needit 
+	common /mfit/ psfpar(npmax),starx(nfmax),stary(nfmax),xlim,ylim
+	common /vers/ version
+ 	logical needit,screen,isub,loop,comd,burn,wrtres,fixedxy
+	logical fixed,piped,debug,ex,clinfo
+	character header*5760,rhead*2880
+	character yn*1,version*40,ccd*4,infile*20
+	character*30 numf,odir,record*80
+	integer*2 instr(8)
+	character*800 line
+	external pseud0d, pseud2d, pseud4d, pseudmd, shape
+C
+C	Initialization
+	data burn,   fixedxy,fixed,  piped 
+     +     /.false.,.false.,.false.,.false./
+	data needit,screen,comd,isub
+     + /.true.,.false.,.true.,.false. /
+	data acc / .01, -.03, -.03, .01, .03, .1, .03 /
+	data alim / -1.0e8, 2*-1.0e3, -1.0e8, 3*-1.0e3 /
+C
+	version = 'DoPHOT Version 1.0 LINUX May 97 '
+        debug=.false.
+        clinfo=.false.
+	line(1:800) = ' '
+	odir = ' '
+C
+C
+C	Read default tuneable parameters 
+	call tuneup ( nccd, ccd, piped, debug )
+	version(33:36) = ccd(1:4)
+C
+      
+        ludebg=6
+        if(piped)then
+          yn='n'
+        else
+	  write(*,'(''****************************************'')')
+	  write(*,1000) version
+	  write(*,'(''****************************************''//)')           
+C                                                             
+          write(*,'(''Screen output (y/[n])? '',$)')             
+	  read(*,1000) yn
+        end if
+	if(yn.eq.'y'.or.yn.eq.'Y') then
+          screen=.true.                
+          luout=6
+        else
+          luout=2
+        end if
+C
+        if(piped)then
+          yn='y'
+        else
+          write(*,'(''Batch mode ([y]/n)? '',$)')
+          read(*,1000) yn
+        end if
+	if(yn.eq.'n'.or.yn.eq.'N') comd = .false.
+C                                          
+	if(.not.comd) then                                     
+          write(*,
+     *         '(''Do you want windowing ([y]/n)? '',$)')
+          read(*,1000)yn
+          iwindo=1
+          if(yn.eq.'n'.or.yn.eq.'N')then
+            nwindo=0
+            iwindo=0
+          end if
+C
+          write(*,
+     *       '(''Star classification info (y/[n]) ?'',$)')
+          read(*,1000)yn
+          clinfo=.false.
+          if(yn.eq.'y'.or.yn.eq.'Y')clinfo=.true.
+C
+	  write(*,
+     *        '(''Create a star-subtracted frame (y/[n])? '',$)')
+	  read(*,1000) yn                                     
+ 	  if(yn.eq.'y'.or.yn.eq.'Y') isub = .true.
+C               
+	  write(*,'(''Apply after-burner (y/[n])? '',$)')
+	  read(*,1000) yn
+	  if ( yn.eq.'y'.or.yn.eq.'Y' ) burn = .true.
+	  wrtres = burn
+C
+	  write(*,'(''Read from fixed (X,Y) list (y/[n])? '',$)')
+	  read(*,1000) yn
+	  if ( yn.eq.'y'.or.yn.eq.'Y' ) then
+	    fixedxy = .true.
+	    fixed = .true.
+	    burn = .true.
+	    wrtres = .true.
+	  endif
+	endif         
+        iopen=0
+C
+C       This is the start of the loop over the input files
+c
+        iframe=0
+        open(10,file='timing',status='unknown',access='append')
+
+1	ifit = 0
+	iapr = 0
+	itmn = 0
+	model = 1
+	xc = 0.0
+	yc = 0.0
+	rc = 0.0
+	ibr = 0
+	ixy = 0
+C	
+        iframe=iframe+1
+        tgetpar=0.0
+        tsearch=0.0
+        tshape=0.0
+        timprove=0.0
+C
+C	Batch mode ...
+
+	if ( comd ) then
+          if(iopen.eq.0)then
+            iopen=1
+            open(11,file='dophot.bat',status='old',err=995)
+          end if
+          read(11,1000,end=999)infile
+c         now read in the parameter instructions. these are:
+c         instr(1) : if 1, specifies uncrowded field, otherwise crowded 
+c         instr(2) : if 1, specifies sequential frames of same field
+c                          with a window around the stars of interest -
+c                          all other objects are ignored
+c         instr(3) : if 0, takes cmin from dophot.inp (via tuneup)
+c                    if>0, sets cmin=instr(3)
+c         instr(4) : if 0, does nothing
+c                    if 1, then opens a file called classifications
+c                    sets clinfo to .true. and writes out the star
+c                    typing info to this file
+c         instr(5) : Delete the shd.nnnnnnn file
+c         instr(6) : Delete the out.nnnnnnn file
+c         instr(7) : Delete the input frame
+c         instr(8) : Create a star-subtracted frame 
+          read(11,*)instr
+          read(11,*)ifit,iapr,tmn,model,xc,yc,rc,ibr,ixy
+          nocrwd = instr(1)
+          iwindo=instr(2)
+          if(iwindo.eq.0)nwindo=0
+          itmn=tmn
+          if ( instr(3).gt.0 ) cmin=instr(3)
+          clinfo=.false.
+          if ( instr(4).gt.0 )then
+            clinfo=.true.
+            open(12,file='classifications',status='unknown')
+            ludebg=12
+          end if
+ 	  if ( instr(8).ne.0 ) then
+	    isub = .true.            
+	  else
+	    isub = .false.
+	  endif
+C
+	  if(ibr.ne.0) burn = .true.
+	  if(ixy.ne.0) then
+	    fixedxy = .true.
+	    fixed = .true.
+	    burn = .true.
+	    goto 20
+          endif
+          if(iwindo.eq.0)then
+            write(6,10)iframe,infile(1:15)
+   10       format('  ***** DoPHOT-ing frame ',i4,': ',a)
+            if(ludebg.eq.12)write(ludebg,11)iframe,infile(1:15)
+   11       format(////'  ',62('*')/
+     *                 '  *     DoPHOT-ing frame ',i4,': ',a,
+     *                 '                 *'/'  ',62('*'))
+          end if
+          if(iwindo.eq.1)then
+            write(6,12)iframe,infile(1:15)
+   12       format('  ***** DoPHOT-ing frame ',i4,': ',a,
+     *             '   - Windowed *****')
+            if(ludebg.eq.12)write(ludebg,13)iframe,infile(1:15)
+   13       format(////'  ',62('*')/
+     *                 '  *     DoPHOT-ing frame ',i4,': ',a,
+     *                 '   - Windowed    *'/2x,62('*'))
+          end if
+C
+C	Interactive...
+	else
+	  write(*,'(''Image name: '',$)')
+	  read(*,1000) infile
+	  if(infile(1:1).eq.' ') goto 999                     
+1000	  format(a)                          
+          write(*,'(''Crowded field mode ([y]/n) ? '',$)')
+          read(*,1000)yn
+          nocrwd=0
+          if(yn.eq.'n'.or.yn.eq.'N')nocrwd=1
+	  if(.not.fixed) then
+	    write(*,1001)
+1001        format('Sky model ([1]=Plane, 2=Power, 3=Hubble)? ',$)
+            read(*,1000)record
+            if(record.ne.' ')then
+	      read(record,*) model
+            else
+              model=1
+            end if
+	  else         
+	    burn=.true.
+	    goto 20           
+	  endif
+	endif
+C
+C       if windowing, open the file and read the window
+        if(iwindo.eq.1)then
+          inquire(file='windows',exist=ex)
+          if(.not.ex)go to 997
+          if(iframe.eq.1)open(9,file='windows',status='old')
+          nwindo=0
+    2     read(9,*,end=3)intype,inx,iny,inbox
+          nwindo=nwindo+1
+          if(nwindo.gt.50)then
+            print *,'too many windows - max = 50'
+            stop
+          end if
+          ixwin(nwindo)=inx
+          iywin(nwindo)=iny
+          iboxwin(nwindo)=inbox
+          itype(nwindo)=intype
+          go to 2
+
+    3     rewind 9
+          if(screen)print 4,(itype(j),ixwin(j),iywin(j),iboxwin(j),
+     *                       j=1,nwindo)
+    4     format(' Windows: Type   X    Y   Size'/
+     *           (I13,i6,i5,i5))
+        end if
+
+	t1 = cputime(0.0)
+C
+C	Read FITS frame.
+	call getfits(1,infile,header,nhead,nfast,nslow,numf,nc,line,ccd)
+C
+C	Ignore frame if not the correct chip
+	if(nc.lt.0) goto 900
+C                     
+C	Estimate starting PSF parameters.
+   15   call getparams(nfast,nslow,gxwid,gywid,skyval,tmin,tmax,
+     *                 iframe)
+        tgetpar = cputime(t1) + tgetpar
+        if(debug)write(ludebg,16)iframe,skyval,gxwid,gywid,tmin,tmax
+   16   format(' Getparams on frame ',i4,'  sky ',f6.1,'  gxwid ',f5.1,
+     *         '  gywid ',f5.1,'  tmin ',f5.1,'  tmax ',f5.1)
+C
+C	Initialize
+	do j=1,nsmax
+	  imtype(j) = 0
+	  do i=1,npmax  
+	    shadow(i,j)=0.                               
+	    shaderr(i,j)=0.
+	  enddo
+	enddo
+C              
+	skyguess=skyval
+	tfac = 1.0            
+C	Use 4.5 X SD as fitting width       
+	fitr=fitfac*(gxwid*asprat*gywid)**0.25 + 0.5                      
+	i=fitr
+	irect(1)=i
+	irect(2)=fitr/asprat 
+C	Use 4/3 X FitFac X SD as aperture width
+	gmax = asprat*gywid
+ 	if(gxwid.gt.gmax) gmax=gxwid
+	aprw = 1.33*fitfac*sqrt(gmax) + 0.5
+	i = aprw
+	arect(1) = i
+	i = aprw/asprat + 0.1
+	arect(2) = i          
+C                                     
+	if(irect(1).gt.50) irect(1)=50
+	if(irect(2).gt.50) irect(2)=50  
+	if(arect(1).gt.45.) arect(1)=45.
+	if(arect(2).gt.45.) arect(2)=45.
+C
+	if (screen) call htype(line,skyval,.false.,fitr,ngr,ncon)
+C
+C       Prompt for further information         
+	if ( .not.comd ) then
+          write(*,1002)
+ 1002     format(/'The above are the inital parameters DoPHOT'/
+     *            'has found. You can change them now or accept'/
+     *            'the values in [ ] by pressing enter'/)
+
+          write(*,1004)tmin
+ 1004     format('Enter Tmin: threshold for star detection',
+     *           ' [',f5.1,']  ',$)
+          read(*,1000)record
+          if(record.ne.' ')read(record,*)tmin
+
+          write(*,1005)cmin
+ 1005     format('Enter Cmin: threshold for PSF stars',
+     *           '      [',f5.1,']  ',$)
+          read(*,1000)record
+          if(record.ne.' ')read(record,*)cmin
+
+          write(*,1006)
+ 1006     format('Do you want to fix the aperture mag size ?',
+     *           ' (y/[n]) ')
+          read(*,1000)record
+          if(record.eq.'y'.or.record.eq.'Y')then
+            write(*,1007)
+ 1007       format('Enter the size in pixels: ',$)
+            read(*,*)iapr
+ 	    if(iapr.gt.0) then          
+              arect(1)=iapr
+              i = iapr/asprat + 0.1
+              arect(2)=i
+            end if
+	  endif                     
+C
+	  write(*,1008)
+ 1008     format('Satisfied with other input parameters ? ([y]/n)?',$)
+	  read(*,1000) yn        
+          if(yn.eq.'n'.or.yn.eq.'N')then
+            yn='n'
+          else
+            yn='y'
+          end if
+	  if(.not.(yn.eq.'y'.or.yn.eq.'Y') ) call input
+	else
+	  if ( ifit.ne.0 ) then
+	    irect(1)=ifit
+	    irect(2)=(ifit/asprat + 0.1)
+	  endif              
+	  if ( iapr.ne.0 ) then
+	    arect(1)=iapr
+	    i = iapr/asprat + 0.1
+	    arect(2)=i
+	  endif                                       
+	  if ( itmn.ne.0 ) tmin = itmn
+ 	  if ( .not.(xc.eq.0.0.and.yc.eq.0.0) ) then
+	    xcen = xc
+ 	    ycen = yc
+          endif
+	endif          
+C
+C--------------------------------
+C
+C
+	call setup ( numf,nc,screen,line,skyval,fitr,ngr,ncon,
+     +nfast, nslow )
+C
+C       if the uncrowded field option has been chosen, jump
+C       straight to the minimum threshold
+C
+        if(nocrwd.eq.1)tmax=tmin
+C             
+C	Adjust tfac so that thresh ends precisely on Tmin.
+	if(tmin/tmax .gt. 0.999) then
+	  thresh = tmin
+	  tfac = 1.          
+	else                                                     
+	  thresh = tmax
+	  xnum = alog10(tmax/tmin)/alog10(2.**tfac)
+	  if(xnum.gt.1.5) then
+	    xnum = float(nint(xnum))
+	  else if(xnum.ge.1) then               
+	    xnum = 2.0
+	  else             
+	    xnum = 1.0             
+	  endif                                         
+	  tfac = alog10(tmax/tmin)/alog10(2.)/xnum                   
+	endif
+C                       
+C------------------------------------------------------------------------
+C                            
+C         This is the BIG LOOP which searches the frame for stars
+C               with intensities > thresh.                
+C        
+C-----------------------------------------------------------------------
+C                           
+	loop = .true.
+	nstot = 0
+	do while ( loop )   
+	  loop = thresh/tmin .ge. 1.01
+	  write(luout,1050) thresh
+1050	  format(/20('-')/'THRESHOLD: ', f10.3)
+	  if(ludebg.eq.12)write(ludebg,1050) thresh
+C
+C         Fit given model to sky values.
+C
+          call varipar(nstot, nfast, nslow )            
+	  t1 = cputime(0.0)
+C               
+C         Identifies potential objects in cleaned array IMG
+ 	  nstar = isearch( pseud2d, nfast, nslow , clinfo)
+	  tsearch = cputime(t1) + tsearch
+C                                                                   
+    	  if ( (nstar .ne. 0).or.(xnum.lt.1.5) ) then
+C                                           
+C           Performs 7-parameter PSF fit and determines nature of object.
+	    t1 = cputime(0.0)
+	    call shape(pseud2d,pseud4d,nfast,nslow,clinfo)
+	    tshape = cputime(t1) + tshape
+C                           
+C           Computes average sky values etc from star list
+ 	    call paravg
+  	    t1 = cputime(0.0)
+C                                                          
+C           Computes 4-parameter fits for all stellar objects using 
+C           new average shape parameters.  
+  	    call improve(pseud2d,nfast,nslow,clinfo)
+	    timprove = cputime(t1) + timprove
+	  end if                         
+C
+C         Calculate aperture photometry on last pass.
+	  if(.not.loop) call aper ( pseud2d, nstot, nfast, nslow )
+C             
+ 	  totaltime = (tgetpar+tsearch+tshape+timprove)
+	  write(3,1060) totaltime
+ 	  write(4,1060) totaltime
+	  write(luout,1060) totaltime
+1060	  format('Total CPU time consumed:',F10.2,' seconds.')
+          write(10,1070)infile,tgetpar,tsearch,tshape,timprove,
+     *                  totaltime
+1070      format(a20,'   T(getp/f)',f5.1,'  T(search)',f5.1,
+     *               '  T(shape)',f5.1,'  T(improve)',f5.1,
+     *               '  Total',f6.1)
+	  call title (line,skyval,.false.,fitr,ngr,ncon,strint,ztot,nums)
+	  rewind(2)          
+ 	  rewind(3)                              
+  	  rewind(4)
+C
+	  call output ( line )
+C
+C         Now reduce the threshold and loop back
+C
+	  thresh = thresh/2.**tfac
+  	end do                   
+C                              
+C--------- END OF BIG LOOP ---------------------------------------
+C                      
+C	If after-burner required, residuals from analytic PSF are computed
+C	and stored in RES.
+C	
+20	if ( burn ) then
+C 	
+C	If using a fixed (X,Y) coordinate list, read it.
+	 if (fixed) then
+C	 Read the image frame
+ 	  call getfits(1,infile,header,nhead,nfast,nslow,numf,nc,line)
+C
+C	 Initialize arrays, open files etc.
+	  call setup ( numf,nc,screen,line,skyval,fitr,ngr,ncon,
+     +nfast, nslow )
+C
+C	 Read the XY list                                 
+	  write(luout,'(''Reading XY list ...'')')
+	  call xylist(numf, nc, ios )
+	  if(ios.ne.0) then
+	   fixed = .false.
+	   write(luout,'(''SXY file absent or incorrect...'')')
+	   goto 15
+	  endif
+C
+	  call htype(line,skyval,.false.,fitr,ngr,ncon)
+C
+C	 Remove good stars
+	  write(luout,'(''Cleaning frame of stars: '',i8)') nstot
+	  call clean ( pseud2d, nstot, nfast, nslow, -1)
+C             
+C	Calculate aperture photometry
+C	  call aper ( pseud2d, nstot, nfast, nslow )
+	 else            
+	   rewind(3)
+	   rewind(4)         
+	 endif 
+C             
+C-----------------------
+C	Flag all stars close together in groups.  Keep making the distance
+C	criterion FITR smaller until the maximum number in a group is less
+C	than NFMAX         
+C                      
+	 fitr = amax1(arect(1),arect(2))
+	 fitr = fitr + 2.0      
+	 nmax = 10000 
+	 write(*,'(''Regrouping ...'')')
+C              
+	 do while ( nmax.gt.nfmax )
+  	  fitr = fitr - 1.0       
+	  write(luout,'(''Min distance ='',f8.1)') fitr
+	  call regroup( fitr, ngr, nmax )     
+	 enddo
+C
+	 xlim = irect(1)/2 
+	 ylim = irect(2)/2
+C
+C	Calculate normalized PSF residual from PSEUD2D
+	 call getres (pseud0d,pseud2d,strint,rmn,rmx,nfast,nslow,irect,
+     +arect,ztot,nums)
+	 if(nums.eq.0) then
+	  write(luout,'(''No suitable PSF stars!'')')
+	  goto 30
+	 endif
+C
+	 write(luout,'(/''AFTERBURNER tuned ON!'')')
+C
+C	Fit multiple stars in a group with enhanced PSF using box size IRECT.
+	 call mulfit( pseud2d,pseudmd,ngr,ncon,nfast,nslow,irect )        
+C
+C	Re-calculate aperture photometry
+	 call aperm ( pseudmd, nstot, nfast, nslow )
+C
+	 call skyadj ( nstot )
+C
+ 	 call title (line,skyval,.true.,fitr,ngr,ncon,strint,ztot,nums)
+	 call output ( line )
+	endif 
+C---------------------                                                
+C
+C-----  This section skipped if PSF residual not written out ------
+C                     
+30	if( isub ) then
+C
+C	Write final Cleaned array.
+ 	 infile = 'x'//numf(1:nc)//'.fits'
+	 call putfits(2,infile,header,nhead,nfast,nslow)
+	 close(2)                 
+C             
+C	If afterburner used, then residual array also written out.
+C	Find suitable scale for writing residual PSF to FITS "R" file.
+C
+ 	 if ( wrtres ) then
+	  scale=20000.0/(rmx-rmn)
+	  zero=-scale*rmn   
+	  do j=-nres,nres
+  	   jj=nres+j+1   
+	   do i=-nres,nres
+  	    ii=nres+i+1                                  
+	    big(ii,jj)=scale*res(i,j)+zero
+	   enddo
+	  enddo
+	  nx=2*nres+1  
+C
+	  infile = 'r'//numf(1:nc)//'.fits'
+  	  zer=-zero/scale
+ 	  scl=1.0/scale            
+C                                           
+C	Create a FITS header for the normalized PSF residual image    
+	  call sethead(rhead,numf,nx,nx,zer,scl)
+ 	  scale=1.0             
+	  zero=0.0    
+C	Write the normalized PSF residual image
+	  call putfits(2,infile,rhead,1,nx,nx)
+	  close(2)
+	 endif
+C                        
+	end if
+C                     
+C                     
+900	close(1)
+	close(3)                                 
+ 	close(4)
+	if ( .not.screen ) close(luout)
+	if(comd) then
+          if(instr(5).eq.1)call system('rm shd.'//numf(1:nc))
+          if(instr(6).eq.1)call system('rm out.'//numf(1:nc))
+          n=1
+          do while(infile(n:n).ne.' ')
+            n=n+1
+          end do
+          if(instr(7).eq.1)call system('rm '//infile(1:n-1))
+        end if
+	fixed = fixedxy
+	goto 1
+C
+995     print 996
+996     format(/'*** Fatal error ***'/
+     *          'You asked for batch processing but'/
+     *          'I cant open the "dophot.bat" file.'/
+     *          'Please make one (using batchdophot)'/
+     *          'and restart DoPHOT'/)
+        go to 999
+
+C
+997     print 998
+998     format(/'*** Fatal error ***'/
+     *          'You asked for "windowed" processing'/
+     *          'but I cant open the "windows" file.'/
+     *          'Please make one and restart DoPHOT'/)
+
+999	call exit(0)
+	end
+
+* (gdb) r
+* Starting program: /home3/craig/gnu/f77-e/gcc/f771 -quiet < ../../play/19990826-4.f -O
+* [...]
+* Breakpoint 2, fancy_abort (
+*     file=0x8285220 "../../g77-e/gcc/config/i386/i386.c", line=4399,
+*     function=0x82860df "output_fp_cc0_set") at ../../g77-e/gcc/rtl.c:1010
+* (gdb) up
+* #1  0x8222fab in output_fp_cc0_set (insn=0x8382324)
+*     at ../../g77-e/gcc/config/i386/i386.c:4399
+* (gdb) p insn
+* $1 = 0x3a
+* (gdb) up
+* #2  0x8222b81 in output_float_compare (insn=0x8382324, operands=0x82acc60)
+*     at ../../g77-e/gcc/config/i386/i386.c:4205
+* (gdb) p insn
+* $2 = 0x8382324
+* (gdb) whatis insn
+* type = rtx
+* (gdb) pr
+* (insn 2181 2180 2191 (parallel[
+*             (set (cc0)
+*                 (compare (reg:SF 8 %st(0))
+*                     (mem:SF (plus:SI (reg:SI 6 %ebp)
+*                             (const_int -9948 [0xffffd924])) 0)))
+*             (clobber (reg:HI 0 %ax))
+*         ] ) 29 {*cmpsf_cc_1} (insn_list 2173 (insn_list 2173 (nil)))
+*     (expr_list:REG_DEAD (reg:DF 8 %st(0))
+*         (expr_list:REG_UNUSED (reg:HI 0 %ax)
+*             (nil))))
+* (gdb)
diff --git a/gcc/testsuite/g77.f-torture/noncompile/19990905-1.f b/gcc/testsuite/g77.f-torture/noncompile/19990905-1.f
new file mode 100644
index 00000000000..026d05e4b3c
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/noncompile/19990905-1.f
@@ -0,0 +1,8 @@
+* =foo7.f in Burley's g77 test suite.
+      subroutine x
+      real a(n)
+      common /foo/n
+      continue
+      entry y(a)
+      call foo(a(1))
+      end
diff --git a/gcc/testsuite/g77.f-torture/noncompile/9263.f b/gcc/testsuite/g77.f-torture/noncompile/9263.f
new file mode 100644
index 00000000000..e68b3e0a65f
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/noncompile/9263.f
@@ -0,0 +1,7 @@
+      PARAMETER (Q=1)
+      PARAMETER (P=10)
+      INTEGER C(10),D(10),E(10),F(10)
+      DATA (C(I),I=1,P)      /10*10/  ! TERMINAL NOT INTEGER
+      DATA (D(I),I=Q,10)     /10*10/  ! START NOT INTEGER
+      DATA (E(I),I=1,10,Q)   /10*10/  ! INCREMENT NOT INTEGER
+      END
diff --git a/gcc/testsuite/g77.f-torture/noncompile/970626-2.f b/gcc/testsuite/g77.f-torture/noncompile/970626-2.f
new file mode 100644
index 00000000000..c1e2348646f
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/noncompile/970626-2.f
@@ -0,0 +1,4 @@
+      SUBROUTINE A(A,ALPHA,IA)
+      COMPLEX  A(IA,*), ALPHA(*)
+      ALPHA(I)=A(I,I).ZERO)
+      END
diff --git a/gcc/testsuite/g77.f-torture/noncompile/980615-0.f b/gcc/testsuite/g77.f-torture/noncompile/980615-0.f
new file mode 100644
index 00000000000..316969f6aa8
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/noncompile/980615-0.f
@@ -0,0 +1,10 @@
+* Fixed by JCB 1998-07-25 change to stc.c.
+
+* Date: Thu, 11 Jun 1998 22:35:20 -0500
+* From: Ian A Watson <WATSON_IAN_A@lilly.com>
+* Subject: crash
+* 
+      CaLL foo(W)
+      END
+      SUBROUTINE foo(W)
+      yy(I)=A(I)Q(X)
diff --git a/gcc/testsuite/g77.f-torture/noncompile/980616-0.f b/gcc/testsuite/g77.f-torture/noncompile/980616-0.f
new file mode 100644
index 00000000000..bd5e74022a3
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/noncompile/980616-0.f
@@ -0,0 +1,8 @@
+* Fixed by 1998-07-11 equiv.c change.
+* ../../gcc/f/equiv.c:666: failed assertion `ffebld_op (subscript) == FFEBLD_opCONTER'
+
+* Date: Mon, 15 Jun 1998 21:54:32 -0500
+* From: Ian A Watson <WATSON_IAN_A@lilly.com>
+* Subject: Mangler Crash
+      EQUIVALENCE(I,glerf(P))
+      COMMON /foo/ glerf(3)
diff --git a/gcc/testsuite/g77.f-torture/noncompile/check0.f b/gcc/testsuite/g77.f-torture/noncompile/check0.f
new file mode 100644
index 00000000000..fc3c6ca730e
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/noncompile/check0.f
@@ -0,0 +1,11 @@
+CCC Abort fixed by:
+CCC1998-04-21  Jim Wilson  <wilson@cygnus.com>
+CCC
+CCC        * stmt.c (check_seenlabel): When search for line number note for
+CCC        warning, handle case where there is no such note.
+      logical l(10)
+      integer i(10)
+      goto (10,20),l
+      goto (10,20),i
+ 10   stop
+ 20   end
diff --git a/gcc/testsuite/g77.f-torture/noncompile/noncompile.exp b/gcc/testsuite/g77.f-torture/noncompile/noncompile.exp
new file mode 100644
index 00000000000..fadd1fbbe5a
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/noncompile/noncompile.exp
@@ -0,0 +1,36 @@
+#   Copyright (C) 1988, 90, 91, 92, 97, 1998 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
+
+# This file was written by Jeff Law. (law@cs.utah.edu)
+
+#
+# These tests come from Torbjorn Granlund (tege@cygnus.com)
+# C torture test suite.
+#
+
+load_lib mike-g77.exp
+
+# Test check0.f
+prebase
+
+set src_code check0.f
+# Not really sure what the error should be here...
+set compiler_output ".*:8.*:9"
+
+set groups {passed gcc-noncompile}
+
+postbase $src_code $run $groups
+
diff --git a/gcc/testsuite/g77.f-torture/noncompile/select_no_compile.f b/gcc/testsuite/g77.f-torture/noncompile/select_no_compile.f
new file mode 100644
index 00000000000..f7dad339a81
--- /dev/null
+++ b/gcc/testsuite/g77.f-torture/noncompile/select_no_compile.f
@@ -0,0 +1,10 @@
+       integer*1 one
+       integer*2 two
+       parameter (one=1)
+       parameter (two=2)
+       select case (I)
+       case (one)
+       case (two)
+       end select
+       end
+    
diff --git a/libjava/doc/cni.sgml b/libjava/doc/cni.sgml
new file mode 100644
index 00000000000..495e3e9c5a5
--- /dev/null
+++ b/libjava/doc/cni.sgml
@@ -0,0 +1,996 @@
+<!DOCTYPE article PUBLIC "-//Davenport//DTD DocBook V3.0//EN">
+<article>
+<artheader>
+<title>The Cygnus Native Interface for C++/Java Integration</title>
+<subtitle>Writing native Java methods in natural C++</subtitle>
+<authorgroup>
+<corpauthor>Cygnus Solutions</corpauthor>
+</authorgroup>
+<date>March, 2000</date>
+</artheader>
+
+<abstract><para>
+This documents CNI, the Cygnus Native Interface,
+which is is a convenient way to write Java native methods using C++.
+This is a more efficient, more convenient, but less portable
+alternative to the standard JNI (Java Native Interface).</para>
+</abstract>
+
+<sect1><title>Basic Concepts</title>
+<para>
+In terms of languages features, Java is mostly a subset
+of C++.  Java has a few important extensions, plus a powerful standard
+class library, but on the whole that does not change the basic similarity.
+Java is a hybrid object-oriented language, with a few native types,
+in addition to class types.  It is class-based, where a class may have
+static as well as per-object fields, and static as well as instance methods.
+Non-static methods may be virtual, and may be overloaded.  Overloading is
+resolved at compile time by matching the actual argument types against
+the parameter types.  Virtual methods are implemented using indirect calls
+through a dispatch table (virtual function table).  Objects are
+allocated on the heap, and initialized using a constructor method.
+Classes are organized in a package hierarchy.
+</para>
+<para>
+All of the listed attributes are also true of C++, though C++ has
+extra features (for example in C++ objects may be allocated not just
+on the heap, but also statically or in a local stack frame).  Because
+<acronym>gcj</acronym> uses the same compiler technology as
+<acronym>g++</acronym> (the GNU C++ compiler), it is possible
+to make the intersection of the two languages use the same
+<acronym>ABI</acronym> (object representation and calling conventions).
+The key idea in <acronym>CNI</acronym> is that Java objects are C++ objects,
+and all Java classes are C++ classes (but not the other way around).
+So the most important task in integrating Java and C++ is to
+remove gratuitous incompatibilities.
+</para>
+<para>
+You write CNI code as a regular C++ source file.  (You do have to use
+a Java/CNI-aware C++ compiler, specifically a recent version of G++.)</para>
+<para>
+You start with:
+<programlisting>
+#include &lt;gcj/cni.h&gt;
+</programlisting></para>
+
+<para>
+You then include header files for the various Java classes you need
+to use:
+<programlisting>
+#include &lt;java/lang/Character.h&gt;
+#include &lt;java/util/Date.h&gt;
+#include &lt;java/lang/IndexOutOfBoundsException.h&gt;
+</programlisting></para>
+
+<para>
+In general, <acronym>CNI</acronym> functions and macros start with the
+`<literal>Jv</literal>' prefix, for example the function
+`<literal>JvNewObjectArray</literal>'.  This convention is used to
+avoid conflicts with other libraries.
+Internal functions in <acronym>CNI</acronym> start with the prefix
+`<literal>_Jv_</literal>'.  You should not call these;
+if you find a need to, let us know and we will try to come up with an
+alternate solution.  (This manual lists <literal>_Jv_AllocBytes</literal>
+as an example;  <acronym>CNI</acronym> should instead provide
+a <literal>JvAllocBytes</literal> function.)</para>
+<para>
+These header files are automatically generated by <command>gcjh</command>.
+</para>
+</sect1>
+
+<sect1><title>Packages</title>
+<para>
+The only global names in Java are class names, and packages.
+A <firstterm>package</firstterm> can contain zero or more classes, and
+also zero or more sub-packages.
+Every class belongs to either an unnamed package or a package that
+has a hierarchical and globally unique name.
+</para>
+<para>
+A Java package is mapped to a C++ <firstterm>namespace</firstterm>.
+The Java class <literal>java.lang.String</literal>
+is in the package <literal>java.lang</literal>, which is a sub-package
+of <literal>java</literal>.  The C++ equivalent is the
+class <literal>java::lang::String</literal>,
+which is in the namespace <literal>java::lang</literal>,
+which is in the namespace <literal>java</literal>.
+</para>
+<para>
+Here is how you could express this:
+<programlisting>
+// Declare the class(es), possibly in a header file:
+namespace java {
+  namespace lang {
+    class Object;
+    class String;
+    ...
+  }
+}
+
+class java::lang::String : public java::lang::Object
+{
+  ...
+};
+</programlisting>
+</para>
+<para>
+The <literal>gcjh</literal> tool automatically generates the
+nessary namespace declarations.</para>
+
+<sect2><title>Nested classes as a substitute for namespaces</title>
+<para>
+<!-- FIXME the next line reads poorly jsm -->
+It is not that long since g++ got complete namespace support,
+and it was very recent (end of February 1999) that <literal>libgcj</literal>
+was changed to uses namespaces.  Releases before then used
+nested classes, which are the C++ equivalent of Java inner classes.
+They provide similar (though less convenient) functionality.
+The old syntax is:
+<programlisting>
+class java {
+  class lang {
+    class Object;
+    class String;
+  };
+};
+</programlisting>
+The obvious difference is the use of <literal>class</literal> instead
+of <literal>namespace</literal>.  The more important difference is
+that all the members of a nested class have to be declared inside
+the parent class definition, while namespaces can be defined in
+multiple places in the source.  This is more convenient, since it
+corresponds more closely to how Java packages are defined.
+The main difference is in the declarations; the syntax for
+using a nested class is the same as with namespaces:
+<programlisting>
+class java::lang::String : public java::lang::Object
+{ ... }
+</programlisting>
+Note that the generated code (including name mangling)
+using nested classes is the same as that using namespaces.</para>
+</sect2>
+
+<sect2><title>Leaving out package names</title>
+<para>
+<!-- FIXME next line reads poorly jsm -->
+Having to always type the fully-qualified class name is verbose.
+It also makes it more difficult to change the package containing a class.
+The Java <literal>package</literal> declaration specifies that the
+following class declarations are in the named package, without having
+to explicitly name the full package qualifiers.
+The <literal>package</literal> declaration can be followed by zero or
+more <literal>import</literal> declarations, which allows either
+a single class or all the classes in a package to be named by a simple
+identifier.  C++ provides something similar
+with the <literal>using</literal> declaration and directive.
+</para>
+<para>
+A Java simple-type-import declaration:
+<programlisting>
+import <replaceable>PackageName</replaceable>.<replaceable>TypeName</replaceable>;
+</programlisting>
+allows using <replaceable>TypeName</replaceable> as a shorthand for
+<literal><replaceable>PackageName</replaceable>.<replaceable>TypeName</replaceable></literal>.
+The C++ (more-or-less) equivalent is a <literal>using</literal>-declaration:
+<programlisting>
+using <replaceable>PackageName</replaceable>::<replaceable>TypeName</replaceable>;
+</programlisting>
+</para>
+<para>
+A Java import-on-demand declaration:
+<programlisting>
+import <replaceable>PackageName</replaceable>.*;
+</programlisting>
+allows using <replaceable>TypeName</replaceable> as a shorthand for
+<literal><replaceable>PackageName</replaceable>.<replaceable>TypeName</replaceable></literal>
+The C++ (more-or-less) equivalent is a <literal>using</literal>-directive:
+<programlisting>
+using namespace <replaceable>PackageName</replaceable>;
+</programlisting>
+</para>
+</sect2>
+</sect1>
+
+<sect1><title>Primitive types</title>
+<para>
+Java provides 8 <quote>primitives</quote> types:
+<literal>byte</literal>, <literal>short</literal>, <literal>int</literal>,
+<literal>long</literal>, <literal>float</literal>, <literal>double</literal>,
+<literal>char</literal>, and <literal>boolean</literal>.
+These are the same as the following C++ <literal>typedef</literal>s
+(which are defined by <literal>gcj/cni.h</literal>):
+<literal>jbyte</literal>, <literal>jshort</literal>, <literal>jint</literal>,
+<literal>jlong</literal>, <literal>jfloat</literal>,
+<literal>jdouble</literal>,
+<literal>jchar</literal>, and <literal>jboolean</literal>.
+You should use the C++ typenames
+(<ForeignPhrase><Abbrev>e.g.</Abbrev></ForeignPhrase> <literal>jint</literal>),
+and not the Java types names
+(<ForeignPhrase><Abbrev>e.g.</Abbrev></ForeignPhrase> <literal>int</literal>),
+even if they are <quote>the same</quote>.
+This is because there is no guarantee that the C++ type
+<literal>int</literal> is a 32-bit type, but <literal>jint</literal>
+<emphasis>is</emphasis> guaranteed to be a 32-bit type.
+
+<informaltable frame="all" colsep="1" rowsep="0">
+<tgroup cols="3">
+<thead>
+<row>
+<entry>Java type</entry>
+<entry>C/C++ typename</entry>
+<entry>Description</entry>
+</thead>
+<tbody>
+<row>
+<entry>byte</entry>
+<entry>jbyte</entry>
+<entry>8-bit signed integer</entry>
+</row>
+<row>
+<entry>short</entry>
+<entry>jshort</entry>
+<entry>16-bit signed integer</entry>
+</row>
+<row>
+<entry>int</entry>
+<entry>jint</entry>
+<entry>32-bit signed integer</entry>
+</row>
+<row>
+<entry>long</entry>
+<entry>jlong</entry>
+<entry>64-bit signed integer</entry>
+</row>
+<row>
+<entry>float</entry>
+<entry>jfloat</entry>
+<entry>32-bit IEEE floating-point number</entry>
+</row>
+<row>
+<entry>double</entry>
+<entry>jdouble</entry>
+<entry>64-bit IEEE floating-point number</entry>
+</row>
+<row>
+<entry>char</entry>
+<entry>jchar</entry>
+<entry>16-bit Unicode character</entry>
+</row>
+<row>
+<entry>boolean</entry>
+<entry>jboolean</entry>
+<entry>logical (Boolean) values</entry>
+</row>
+<row>
+<entry>void</entry>
+<entry>void</entry>
+<entry>no value</entry>
+</row>
+</tbody></tgroup>
+</informaltable>
+</para>
+
+<para>
+<funcsynopsis>
+<funcdef><function>JvPrimClass</function></funcdef>
+<paramdef><parameter>primtype</parameter></paramdef>
+</funcsynopsis>
+This is a macro whose argument should be the name of a primitive
+type, <ForeignPhrase><Abbrev>e.g.</Abbrev></ForeignPhrase>
+<literal>byte</literal>.
+The macro expands to a pointer to the <literal>Class</literal> object
+corresponding to the primitive type.
+<ForeignPhrase><Abbrev>E.g.</Abbrev></ForeignPhrase>,
+<literal>JvPrimClass(void)</literal>
+has the same value as the Java expression
+<literal>Void.TYPE</literal> (or <literal>void.class</literal>).
+</para>
+
+</sect1>
+
+<sect1><title>Objects and Classes</title>
+<sect2><title>Classes</title>
+<para>
+All Java classes are derived from <literal>java.lang.Object</literal>.
+C++ does not have a unique <quote>root</quote>class, but we use
+a C++ <literal>java::lang::Object</literal> as the C++ version
+of the <literal>java.lang.Object</literal> Java class.  All
+other Java classes are mapped into corresponding C++ classes
+derived from <literal>java::lang::Object</literal>.</para>
+<para>
+Interface inheritance (the <quote><literal>implements</literal></quote>
+keyword) is currently not reflected in the C++ mapping.</para>
+</sect2>
+<sect2><title>Object references</title>
+<para>
+We implement a Java object reference as a pointer to the start
+of the referenced object.  It maps to a C++ pointer.
+(We cannot use C++ references for Java references, since
+once a C++ reference has been initialized, you cannot change it to
+point to another object.)
+The <literal>null</literal> Java reference maps to the <literal>NULL</literal>
+C++ pointer.
+</para>
+<para>
+Note that in some Java implementations an object reference is implemented as
+a pointer to a two-word <quote>handle</quote>.  One word of the handle
+points to the fields of the object, while the other points
+to a method table.  Gcj does not use this extra indirection.
+</para>
+</sect2>
+<sect2><title>Object fields</title>
+<para>
+Each object contains an object header, followed by the instance
+fields of the class, in order.  The object header consists of
+a single pointer to a dispatch or virtual function table.
+(There may be extra fields <quote>in front of</quote> the object,
+for example for
+memory management, but this is invisible to the application, and
+the reference to the object points to the dispatch table pointer.)
+</para>
+<para>
+The fields are laid out in the same order, alignment, and size
+as in C++.  Specifically, 8-bite and 16-bit native types
+(<literal>byte</literal>, <literal>short</literal>, <literal>char</literal>,
+and <literal>boolean</literal>) are <emphasis>not</emphasis>
+widened to 32 bits.
+Note that the Java VM does extend 8-bit and 16-bit types to 32 bits
+when on the VM stack or temporary registers.</para>
+<para>
+If you include the <literal>gcjh</literal>-generated header for a
+class, you can access fields of Java classes in the <quote>natural</quote>
+way.  Given the following Java class:
+<programlisting>
+public class Int
+{
+  public int i;
+  public Integer (int i) { this.i = i; }
+  public static zero = new Integer(0);
+}
+</programlisting>
+you can write:
+<programlisting>
+#include &lt;gcj/cni.h&gt;
+#include &lt;Int.h&gt;
+Int*
+mult (Int *p, jint k)
+{
+  if (k == 0)
+    return Int::zero;  // static member access.
+  return new Int(p->i * k);
+}
+</programlisting>
+</para>
+<para>
+<acronym>CNI</acronym> does not strictly enforce the Java access
+specifiers, because Java permissions cannot be directly mapped
+into C++ permission.  Private Java fields and methods are mapped
+to private C++ fields and methods, but other fields and methods
+are mapped to public fields and methods.
+</para>
+</sect2>
+</sect1>
+
+<sect1><title>Arrays</title>
+<para>
+While in many ways Java is similar to C and C++,
+it is quite different in its treatment of arrays.
+C arrays are based on the idea of pointer arithmetic,
+which would be incompatible with Java's security requirements.
+Java arrays are true objects (array types inherit from
+<literal>java.lang.Object</literal>).  An array-valued variable
+is one that contains a reference (pointer) to an array object.
+</para>
+<para>
+Referencing a Java array in C++ code is done using the
+<literal>JArray</literal> template, which as defined as follows:
+<programlisting>
+class __JArray : public java::lang::Object
+{
+public:
+  int length;
+};
+
+template&lt;class T&gt;
+class JArray : public __JArray
+{
+  T data[0];
+public:
+  T&amp; operator[](jint i) { return data[i]; }
+};
+</programlisting></para>
+<para>
+<funcsynopsis> 
+   <funcdef>template&lt;class T&gt;  T *<function>elements</function></funcdef>
+   <paramdef>JArray&lt;T&gt; &amp;<parameter>array</parameter></paramdef>
+</funcsynopsis>
+   This template function can be used to get a pointer to the
+   elements of the <parameter>array</parameter>.
+   For instance, you can fetch a pointer
+   to the integers that make up an <literal>int[]</literal> like so:
+<programlisting>
+extern jintArray foo;
+jint *intp = elements (foo);
+</programlisting>
+The name of this function may change in the future.</para>
+<para>
+There are a number of typedefs which correspond to typedefs from JNI.
+Each is the type of an array holding objects of the appropriate type:
+<programlisting>
+typedef __JArray *jarray;
+typedef JArray&lt;jobject&gt; *jobjectArray;
+typedef JArray&lt;jboolean&gt; *jbooleanArray;
+typedef JArray&lt;jbyte&gt; *jbyteArray;
+typedef JArray&lt;jchar&gt; *jcharArray;
+typedef JArray&lt;jshort&gt; *jshortArray;
+typedef JArray&lt;jint&gt; *jintArray;
+typedef JArray&lt;jlong&gt; *jlongArray;
+typedef JArray&lt;jfloat&gt; *jfloatArray;
+typedef JArray&lt;jdouble&gt; *jdoubleArray;
+</programlisting>
+</para>
+<para>
+ You can create an array of objects using this function:
+<funcsynopsis> 
+   <funcdef>jobjectArray <function>JvNewObjectArray</function></funcdef>
+   <paramdef>jint <parameter>length</parameter></paramdef>
+   <paramdef>jclass <parameter>klass</parameter></paramdef>
+   <paramdef>jobject <parameter>init</parameter></paramdef>
+   </funcsynopsis>
+   Here <parameter>klass</parameter> is the type of elements of the array;
+   <parameter>init</parameter> is the initial
+   value to be put into every slot in the array.
+</para>
+<para>
+For each primitive type there is a function which can be used
+   to create a new array holding that type.  The name of the function
+   is of the form
+   `<literal>JvNew&lt;<replaceable>Type</replaceable>&gt;Array</literal>',
+   where `&lt;<replaceable>Type</replaceable>&gt;' is the name of
+   the primitive type, with its initial letter in upper-case.  For
+   instance, `<literal>JvNewBooleanArray</literal>' can be used to create
+   a new array of booleans.
+   Each such function follows this example:
+<funcsynopsis>  
+   <funcdef>jbooleanArray <function>JvNewBooleanArray</function></funcdef> 
+   <paramdef>jint <parameter>length</parameter></paramdef>
+</funcsynopsis>
+</para>
+<para>
+<funcsynopsis>
+   <funcdef>jsize <function>JvGetArrayLength</function></funcdef>
+   <paramdef>jarray <parameter>array</parameter></paramdef> 
+   </funcsynopsis>
+   Returns the length of <parameter>array</parameter>.</para>
+</sect1>
+
+<sect1><title>Methods</title>
+
+<para>
+Java methods are mapped directly into C++ methods.
+The header files generated by <literal>gcjh</literal>
+include the appropriate method definitions.
+Basically, the generated methods have the same names and
+<quote>corresponding</quote> types as the Java methods,
+and are called in the natural manner.</para>
+
+<sect2><title>Overloading</title>
+<para>
+Both Java and C++ provide method overloading, where multiple
+methods in a class have the same name, and the correct one is chosen
+(at compile time) depending on the argument types.
+The rules for choosing the correct method are (as expected) more complicated
+in C++ than in Java, but given a set of overloaded methods
+generated by <literal>gcjh</literal> the C++ compiler will choose
+the expected one.</para>
+<para>
+Common assemblers and linkers are not aware of C++ overloading,
+so the standard implementation strategy is to encode the
+parameter types of a method into its assembly-level name.
+This encoding is called <firstterm>mangling</firstterm>,
+and the encoded name is the <firstterm>mangled name</firstterm>.
+The same mechanism is used to implement Java overloading.
+For C++/Java interoperability, it is important that both the Java
+and C++ compilers use the <emphasis>same</emphasis> encoding scheme.
+</para>
+</sect2>
+
+<sect2><title>Static methods</title>
+<para>
+Static Java methods are invoked in <acronym>CNI</acronym> using the standard
+C++ syntax, using the `<literal>::</literal>' operator rather
+than the `<literal>.</literal>' operator.  For example:
+</para>
+<programlisting>
+jint i = java::lang::Math::round((jfloat) 2.3);
+</programlisting>
+<para>
+<!-- FIXME this next sentence seems ungammatical jsm -->
+Defining a static native method uses standard C++ method
+definition syntax.  For example:
+<programlisting>
+#include &lt;java/lang/Integer.h&gt;
+java::lang::Integer*
+java::lang::Integer::getInteger(jstring str)
+{
+  ...
+}
+</programlisting>
+</sect2>
+
+<sect2><title>Object Constructors</title>
+<para>
+Constructors are called implicitly as part of object allocation
+using the <literal>new</literal> operator.  For example:
+<programlisting> 
+java::lang::Int x = new java::lang::Int(234);
+</programlisting> 
+</para>
+<para>
+<!-- FIXME rewrite needed here, mine may not be good jsm -->
+Java does not allow a constructor to be a native method.
+Instead, you could define a private method which
+you can have the constructor call.
+</para>
+</sect2>
+
+<sect2><title>Instance methods</title>
+<para>
+<!-- FIXME next para week, I would remove a few words from some sentences jsm -->
+Virtual method dispatch is handled essentially the same way
+in C++ and Java -- <abbrev>i.e.</abbrev> by doing an
+indirect call through a function pointer stored in a per-class virtual
+function table.  C++ is more complicated because it has to support
+multiple inheritance, but this does not effect Java classes.
+However, G++ has historically used a different calling convention
+that is not compatible with the one used by <acronym>gcj</acronym>.
+During 1999, G++ will switch to a new ABI that is compatible with
+<acronym>gcj</acronym>.  Some platforms (including Linux) have already
+changed.  On other platforms, you will have to pass
+the <literal>-fvtable-thunks</literal> flag to g++ when
+compiling <acronym>CNI</acronym> code.  Note that you must also compile
+your C++ source code with <literal>-fno-rtti</literal>.
+</para>
+<para>
+Calling a Java instance method in <acronym>CNI</acronym> is done
+using the standard C++ syntax.  For example:
+<programlisting>
+  java::lang::Number *x;
+  if (x-&gt;doubleValue() &gt; 0.0) ...
+</programlisting>
+</para>
+<para>
+Defining a Java native instance method is also done the natural way:
+<programlisting>
+#include &lt;java/lang/Integer.h&gt;
+jdouble
+java::lang:Integer::doubleValue()
+{
+  return (jdouble) value;
+}
+</programlisting>
+</para>
+</sect2>
+
+<sect2><title>Interface method calls</title>
+<para>
+In Java you can call a method using an interface reference.
+This is not yet supported in <acronym>CNI</acronym>.</para>
+</sect2>
+</sect1>
+
+<sect1><title>Object allocation</title>
+
+<para>
+New Java objects are allocated using a
+<firstterm>class-instance-creation-expression</firstterm>:
+<programlisting>
+new <replaceable>Type</replaceable> ( <replaceable>arguments</replaceable> )
+</programlisting>
+The same syntax is used in C++.  The main difference is that
+C++ objects have to be explicitly deleted; in Java they are
+automatically deleted by the garbage collector.
+Using <acronym>CNI</acronym>, you can allocate a new object
+using standard C++ syntax.  The C++ compiler is smart enough to
+realize the class is a Java class, and hence it needs to allocate
+memory from the garbage collector.  If you have overloaded
+constructors, the compiler will choose the correct one
+using standard C++ overload resolution rules.  For example:
+<programlisting>
+java::util::Hashtable *ht = new java::util::Hashtable(120);
+</programlisting>
+</para>
+<para>
+<funcsynopsis>
+  <funcdef>void *<function>_Jv_AllocBytes</function></funcdef>
+  <paramdef>jsize <parameter>size</parameter></paramdef>
+</funcsynopsis>
+   Allocate <parameter>size</parameter> bytes.  This memory is not
+   scanned by the garbage collector.  However, it will be freed by
+the GC if no references to it are discovered.
+</para>
+</sect1>
+
+<sect1><title>Interfaces</title>
+<para>
+A Java class can <firstterm>implement</firstterm> zero or more
+<firstterm>interfaces</firstterm>, in addition to inheriting from
+a single base class. 
+An interface is a collection of constants and method specifications;
+it is similar to the <firstterm>signatures</firstterm> available
+as a G++ extension.  An interface provides a subset of the
+functionality of C++ abstract virtual base classes, but they
+are currently implemented differently.
+CNI does not currently provide any support for interfaces,
+or calling methods from an interface pointer.
+This is partly because we are planning to re-do how
+interfaces are implemented in <acronym>gcj</acronym>.
+</para>
+</sect1>
+
+<sect1><title>Strings</title>
+<para>
+<acronym>CNI</acronym> provides a number of utility functions for
+working with Java <literal>String</literal> objects.
+The names and interfaces are analogous to those of <acronym>JNI</acronym>.
+</para>
+
+<para>
+<funcsynopsis>
+  <funcdef>jstring <function>JvNewString</function></funcdef>
+  <paramdef>const jchar *<parameter>chars</parameter></paramdef>
+  <paramdef>jsize <parameter>len</parameter></paramdef>
+  </funcsynopsis>
+  Creates a new Java String object, where
+  <parameter>chars</parameter> are the contents, and
+  <parameter>len</parameter> is the number of characters.
+</para>
+
+<para>
+<funcsynopsis>
+  <funcdef>jstring <function>JvNewStringLatin1</function></funcdef>
+  <paramdef>const char *<parameter>bytes</parameter></paramdef>
+  <paramdef>jsize <parameter>len</parameter></paramdef>
+ </funcsynopsis>
+  Creates a new Java String object, where <parameter>bytes</parameter>
+  are the Latin-1 encoded
+  characters, and <parameter>len</parameter> is the length of
+  <parameter>bytes</parameter>, in bytes.
+</para>
+
+<para>
+<funcsynopsis>
+  <funcdef>jstring <function>JvNewStringLatin1</function></funcdef>
+  <paramdef>const char *<parameter>bytes</parameter></paramdef>
+  </funcsynopsis>
+  Like the first JvNewStringLatin1, but computes <parameter>len</parameter>
+  using <literal>strlen</literal>.
+</para>
+
+<para>
+<funcsynopsis>
+  <funcdef>jstring <function>JvNewStringUTF</function></funcdef>
+  <paramdef>const char *<parameter>bytes</parameter></paramdef>
+  </funcsynopsis>
+   Creates a new Java String object, where <parameter>bytes</parameter> are
+   the UTF-8 encoded characters of the string, terminated by a null byte.
+</para>
+
+<para>
+<funcsynopsis>
+   <funcdef>jchar *<function>JvGetStringChars</function></funcdef>
+  <paramdef>jstring <parameter>str</parameter></paramdef>
+  </funcsynopsis>
+   Returns a pointer to the array of characters which make up a string.
+</para>
+
+<para>
+<funcsynopsis>
+   <funcdef> int <function>JvGetStringUTFLength</function></funcdef>
+  <paramdef>jstring <parameter>str</parameter></paramdef>
+  </funcsynopsis>
+   Returns number of bytes required to encode contents
+   of <parameter>str</parameter> as UTF-8.
+</para>
+
+<para>
+<funcsynopsis>
+  <funcdef> jsize <function>JvGetStringUTFRegion</function></funcdef>
+  <paramdef>jstring <parameter>str</parameter></paramdef>
+  <paramdef>jsize <parameter>start</parameter></paramdef>
+  <paramdef>jsize <parameter>len</parameter></paramdef>
+  <paramdef>char *<parameter>buf</parameter></paramdef>
+  </funcsynopsis>
+  This puts the UTF-8 encoding of a region of the
+  string <parameter>str</parameter> into
+  the buffer <parameter>buf</parameter>.
+  The region of the string to fetch is specifued by
+  <parameter>start</parameter> and <parameter>len</parameter>.
+   It is assumed that <parameter>buf</parameter> is big enough
+   to hold the result.  Note
+   that <parameter>buf</parameter> is <emphasis>not</emphasis> null-terminated.
+</para>
+</sect1>
+
+<sect1><title>Class Initialization</title>
+<para>
+Java requires that each class be automatically initialized at the time 
+of the first active use.  Initializing a class involves 
+initializing the static fields, running code in class initializer 
+methods, and initializing base classes.  There may also be 
+some implementation specific actions, such as allocating 
+<classname>String</classname> objects corresponding to string literals in
+the code.</para>
+<para>
+The Gcj compiler inserts calls to <literal>JvInitClass</literal> (actually
+<literal>_Jv_InitClass</literal>) at appropriate places to ensure that a
+class is initialized when required.  The C++ compiler does not
+insert these calls automatically - it is the programmer's
+responsibility to make sure classes are initialized.  However,
+this is fairly painless because of the conventions assumed by the Java
+system.</para>
+<para>
+First, <literal>libgcj</literal> will make sure a class is initialized
+before an instance of that object is created.  This is one
+of the responsibilities of the <literal>new</literal> operation.  This is
+taken care of both in Java code, and in C++ code.  (When the G++
+compiler sees a <literal>new</literal> of a Java class, it will call
+a routine in <literal>libgcj</literal> to allocate the object, and that
+routine will take care of initializing the class.)  It follows that you can
+access an instance field, or call an instance (non-static)
+method and be safe in the knowledge that the class and all
+of its base classes have been initialized.</para>
+<para>
+Invoking a static method is also safe.  This is because the
+Java compiler adds code to the start of a static method to make sure
+the class is initialized.  However, the C++ compiler does not
+add this extra code.  Hence, if you write a native static method
+using CNI, you are responsible for calling <literal>JvInitClass</literal>
+before doing anything else in the method (unless you are sure
+it is safe to leave it out).</para>
+<para>
+Accessing a static field also requires the class of the
+field to be initialized.  The Java compiler will generate code
+to call <literal>_Jv_InitClass</literal> before getting or setting the field.
+However, the C++ compiler will not generate this extra code,
+so it is your responsibility to make sure the class is
+initialized before you access a static field.</para>
+</sect1>
+<sect1><title>Exception Handling</title>
+<para>
+While C++ and Java share a common exception handling framework,
+things are not yet perfectly integrated.  The main issue is that the
+<quote>run-time type information</quote> facilities of the two
+languages are not integrated.</para>
+<para>
+Still, things work fairly well.  You can throw a Java exception from
+C++ using the ordinary <literal>throw</literal> construct, and this
+exception can be caught by Java code.  Similarly, you can catch an
+exception thrown from Java using the C++ <literal>catch</literal>
+construct.
+<para>
+Note that currently you cannot mix C++ catches and Java catches in
+a single C++ translation unit.  We do intend to fix this eventually.
+</para>
+<para>
+Here is an example:
+<programlisting>
+if (i >= count)
+   throw new java::lang::IndexOutOfBoundsException();
+</programlisting>
+</para>
+<para>
+Normally, GNU C++ will automatically detect when you are writing C++
+code that uses Java exceptions, and handle them appropriately.
+However, if C++ code only needs to execute destructors when Java
+exceptions are thrown through it, GCC will guess incorrectly.  Sample
+problematic code:
+<programlisting>
+  struct S { ~S(); };
+  extern void bar();    // is implemented in Java and may throw exceptions
+  void foo()
+  {
+    S s;
+    bar();
+  }
+</programlisting>
+The usual effect of an incorrect guess is a link failure, complaining of
+a missing routine called <literal>__gxx_personality_v0</literal>.
+</para>
+<para>
+You can inform the compiler that Java exceptions are to be used in a
+translation unit, irrespective of what it might think, by writing
+<literal>#pragma GCC java_exceptions</literal> at the head of the
+file.  This <literal>#pragma</literal> must appear before any
+functions that throw or catch exceptions, or run destructors when
+exceptions are thrown through them.</para>
+</sect1>
+
+<sect1><title>Synchronization</title>
+<para>
+Each Java object has an implicit monitor.
+The Java VM uses the instruction <literal>monitorenter</literal> to acquire
+and lock a monitor, and <literal>monitorexit</literal> to release it.
+The JNI has corresponding methods <literal>MonitorEnter</literal>
+and <literal>MonitorExit</literal>.  The corresponding CNI macros
+are <literal>JvMonitorEnter</literal> and <literal>JvMonitorExit</literal>.
+</para>
+<para>
+The Java source language does not provide direct access to these primitives.
+Instead, there is a <literal>synchronized</literal> statement that does an
+implicit <literal>monitorenter</literal> before entry to the block,
+and does a <literal>monitorexit</literal> on exit from the block.
+Note that the lock has to be released even the block is abnormally
+terminated by an exception, which means there is an implicit
+<literal>try</literal>-<literal>finally</literal>.
+</para>
+<para>
+From C++, it makes sense to use a destructor to release a lock.
+CNI defines the following utility class.
+<programlisting>
+class JvSynchronize() {
+  jobject obj;
+  JvSynchronize(jobject o) { obj = o; JvMonitorEnter(o); }
+  ~JvSynchronize() { JvMonitorExit(obj); }
+};
+</programlisting>
+The equivalent of Java's:
+<programlisting>
+synchronized (OBJ) { CODE; }
+</programlisting>
+can be simply expressed:
+<programlisting>
+{ JvSynchronize dummy(OBJ); CODE; }
+</programlisting>
+</para>
+<para>
+Java also has methods with the <literal>synchronized</literal> attribute.
+This is equivalent to wrapping the entire method body in a
+<literal>synchronized</literal> statement.
+(Alternatively, an implementation could require the caller to do
+the synchronization.  This is not practical for a compiler, because
+each virtual method call would have to test at run-time if
+synchronization is needed.)  Since in <literal>gcj</literal>
+the <literal>synchronized</literal> attribute is handled by the
+method implementation, it is up to the programmer
+of a synchronized native method to handle the synchronization
+(in the C++ implementation of the method).
+In otherwords, you need to manually add <literal>JvSynchronize</literal>
+in a <literal>native synchornized</literal> method.</para>
+</sect1>
+
+<sect1><title>Reflection</title>
+<para>The types <literal>jfieldID</literal> and <literal>jmethodID</literal>
+are as in JNI.</para>
+<para>
+The function <literal>JvFromReflectedField</literal>,
+<literal>JvFromReflectedMethod</literal>,
+<literal>JvToReflectedField</literal>, and
+<literal>JvToFromReflectedMethod</literal> (as in Java 2 JNI)
+will be added shortly, as will other functions corresponding to JNI.</para>
+
+<sect1><title>Using gcjh</title>
+<para>
+      The <command>gcjh</command> is used to generate C++ header files from
+      Java class files.  By default, <command>gcjh</command> generates
+      a relatively straightforward C++ header file.  However, there
+      are a few caveats to its use, and a few options which can be
+      used to change how it operates:
+</para>
+<variablelist>
+<varlistentry>
+<term><literal>--classpath</literal> <replaceable>path</replaceable></term>
+<term><literal>--CLASSPATH</literal> <replaceable>path</replaceable></term>
+<term><literal>-I</literal> <replaceable>dir</replaceable></term>
+<listitem><para>
+        These options can be used to set the class path for gcjh.
+        Gcjh searches the class path the same way the compiler does;
+	these options have their familiar meanings.</para>
+</listitem>
+</varlistentry>
+
+<varlistentry>
+<term><literal>-d <replaceable>directory</replaceable></literal></term>
+<listitem><para>
+Puts the generated <literal>.h</literal> files
+beneath <replaceable>directory</replaceable>.</para>
+</listitem>
+</varlistentry>
+
+<varlistentry>
+<term><literal>-o <replaceable>file</replaceable></literal></term>
+<listitem><para>
+        Sets the name of the <literal>.h</literal> file to be generated.
+        By default the <literal>.h</literal> file is named after the class.
+        This option only really makes sense if just a single class file
+        is specified.</para>
+</listitem>
+</varlistentry>
+
+<varlistentry>
+<term><literal>--verbose</literal></term>
+<listitem><para>
+        gcjh will print information to stderr as it works.</para>
+</listitem>
+</varlistentry>
+
+<varlistentry>
+<term><literal>-M</literal></term>
+<term><literal>-MM</literal></term>
+<term><literal>-MD</literal></term>
+<term><literal>-MMD</literal></term>
+<listitem><para>
+        These options can be used to generate dependency information
+        for the generated header file.  They work the same way as the
+        corresponding compiler options.</para>
+</listitem>
+</varlistentry>
+
+<varlistentry>
+<term><literal>-prepend <replaceable>text</replaceable></literal></term>
+<listitem><para>
+This causes the <replaceable>text</replaceable> to be put into the generated
+        header just after class declarations (but before declaration
+        of the current class).  This option should be used with caution.</para>
+</listitem>
+</varlistentry>
+
+<varlistentry> 
+<term><literal>-friend <replaceable>text</replaceable></literal></term>
+<listitem><para>
+This causes the <replaceable>text</replaceable> to be put into the class
+declaration after a <literal>friend</literal> keyword.
+This can be used to declare some
+        other class or function to be a friend of this class.
+        This option should be used with caution.</para>
+</listitem>
+</varlistentry>
+
+<varlistentry>  
+<term><literal>-add <replaceable>text</replaceable></literal></term>
+<listitem><para>
+The <replaceable>text</replaceable> is inserted into the class declaration.
+This option should be used with caution.</para>
+</listitem>
+</varlistentry>
+
+<varlistentry> 
+<term><literal>-append <replaceable>text</replaceable></literal></term>
+<listitem><para>
+The <replaceable>text</replaceable> is inserted into the header file
+after the class declaration.  One use for this is to generate
+inline functions.  This option should be used with caution.
+</listitem>
+</varlistentry>
+</variablelist>
+<para>
+All other options not beginning with a <literal>-</literal> are treated
+as the names of classes for which headers should be generated.</para>
+<para>
+gcjh will generate all the required namespace declarations and
+<literal>#include</literal>'s for the header file.
+In some situations, gcjh will generate simple inline member
+functions.  Note that, while gcjh puts <literal>#pragma
+interface</literal> in the generated header file, you should
+<emphasis>not</emphasis> put <literal>#pragma implementation</literal>
+into your C++ source file.  If you do, duplicate definitions of
+inline functions will sometimes be created, leading to link-time
+errors.
+</para>
+<para>
+There are a few cases where gcjh will fail to work properly:</para>
+<para>
+gcjh assumes that all the methods and fields of a class have ASCII
+names.  The C++ compiler cannot correctly handle non-ASCII
+identifiers.  gcjh does not currently diagnose this problem.</para>
+<para>
+gcjh also cannot fully handle classes where a field and a method have
+the same name.  If the field is static, an error will result.
+Otherwise, the field will be renamed in the generated header; `__'
+will be appended to the field name.</para>
+<para>
+Eventually we hope to change the C++ compiler so that these
+restrictions can be lifted.</para>
+</sect1>
+
+</article>
diff --git a/libjava/gnu/javax/rmi/CORBA/DelegateFactory.java b/libjava/gnu/javax/rmi/CORBA/DelegateFactory.java
new file mode 100644
index 00000000000..c98549b4059
--- /dev/null
+++ b/libjava/gnu/javax/rmi/CORBA/DelegateFactory.java
@@ -0,0 +1,74 @@
+/* DelegateFactory.java -- 
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package gnu.javax.rmi.CORBA;
+
+import java.util.HashMap;
+import javax.rmi.CORBA.Util;
+
+public class DelegateFactory
+{
+  private static HashMap cache = new HashMap(4);
+    
+  public static synchronized Object getInstance(String type)
+    throws GetDelegateInstanceException
+  {
+    Object r = cache.get(type);
+    if (r != null)
+      return r;
+    String dcname = System.getProperty("javax.rmi.CORBA." + type + "Class");
+    if (dcname == null)
+      {
+	//throw new DelegateException
+	//  ("no javax.rmi.CORBA.XXXClass property sepcified.");
+	dcname = "gnu.javax.rmi.CORBA." + type + "DelegateImpl";
+      }
+    try
+      {
+	Class dclass = Class.forName(dcname);
+	r = dclass.newInstance();
+	cache.put(type, r);
+	return r;
+      }
+    catch(Exception e)
+      {
+	throw new GetDelegateInstanceException
+	  ("Exception when trying to get delegate instance:" + dcname, e);
+      }
+  }
+}
diff --git a/libjava/gnu/javax/rmi/CORBA/GetDelegateInstanceException.java b/libjava/gnu/javax/rmi/CORBA/GetDelegateInstanceException.java
new file mode 100644
index 00000000000..27b84f12239
--- /dev/null
+++ b/libjava/gnu/javax/rmi/CORBA/GetDelegateInstanceException.java
@@ -0,0 +1,58 @@
+/* GetDelegateInstanceException.java -- 
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package gnu.javax.rmi.CORBA;
+
+import java.io.PrintStream;
+import java.io.PrintWriter;
+
+public class GetDelegateInstanceException
+  extends Exception
+{
+  private Throwable next;
+  
+  public GetDelegateInstanceException(String msg)
+  {
+    super(msg);
+  }
+  
+  public GetDelegateInstanceException(String msg, Throwable next)
+  {
+    super(msg, next);
+  }
+}
diff --git a/libjava/gnu/javax/rmi/CORBA/PortableRemoteObjectDelegateImpl.java b/libjava/gnu/javax/rmi/CORBA/PortableRemoteObjectDelegateImpl.java
new file mode 100644
index 00000000000..973c4c4f89f
--- /dev/null
+++ b/libjava/gnu/javax/rmi/CORBA/PortableRemoteObjectDelegateImpl.java
@@ -0,0 +1,133 @@
+/* PortableRemoteObjectDelegateImpl.java -- 
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package gnu.javax.rmi.CORBA;
+
+import java.rmi.*;
+import java.rmi.server.*;
+import gnu.javax.rmi.*;
+import javax.rmi.CORBA.*;
+
+public class PortableRemoteObjectDelegateImpl
+  implements PortableRemoteObjectDelegate
+{
+    
+  public PortableRemoteObjectDelegateImpl()
+  {
+  }
+
+  public void connect(Remote remote, Remote remote1)
+    throws RemoteException
+  {
+    throw new Error("Not implemented for PortableRemoteObjectDelegateImpl");
+  }
+        
+  public void exportObject(Remote obj)
+    throws RemoteException
+  {
+    PortableServer.exportObject(obj);
+  }
+
+  public Object narrow(Object narrowFrom, Class narrowTo)
+    throws ClassCastException
+  {
+    if (narrowTo == null)
+      throw new ClassCastException("Can't narrow to null class");
+    if (narrowFrom == null)
+      return null;
+
+    Class fromClass = narrowFrom.getClass();
+    Object result = null;
+        
+    try
+      {
+	if (narrowTo.isAssignableFrom(fromClass))
+	  result = narrowFrom;
+	else
+	  {
+	    System.out.println("We still haven't implement this case: narrow "
+			       + narrowFrom + " of type " + fromClass + " to "
+			       + narrowTo);
+	    Class[] cs = fromClass.getInterfaces();
+	    for (int i = 0; i < cs.length; i++)
+	      System.out.println(cs[i]);
+	    Exception e1 = new Exception();
+	    try
+	      {
+		throw e1;
+	      }
+	    catch(Exception ee)
+	      {
+		ee.printStackTrace();
+	      }
+	    System.exit(2);
+	    //throw new Error("We still haven't implement this case: narrow "
+	    //                + narrowFrom + " of type " + fromClass + " to "
+	    //                + narrowTo);
+	    /*
+	      ObjectImpl objimpl = (ObjectImpl)narrowFrom;
+	      if(objimpl._is_a(PortableServer.getTypeName(narrowTo)))
+	      result = PortableServer.getStubFromObjectImpl(objimpl, narrowTo);
+	    */
+	  }
+      }
+    catch(Exception e)
+      {
+	result = null;
+      }
+        
+    if (result == null)
+      throw new ClassCastException("Can't narrow from "
+				   + fromClass + " to " + narrowTo);
+            
+    return result;
+  }
+        
+  public Remote toStub(Remote obj)
+    throws NoSuchObjectException
+  {
+    return PortableServer.toStub(obj);
+  }
+
+  public void unexportObject(Remote obj)
+    throws NoSuchObjectException
+  {
+    PortableServer.unexportObject(obj);
+  }
+
+}
diff --git a/libjava/gnu/javax/rmi/CORBA/StubDelegateImpl.java b/libjava/gnu/javax/rmi/CORBA/StubDelegateImpl.java
new file mode 100644
index 00000000000..894e50236fd
--- /dev/null
+++ b/libjava/gnu/javax/rmi/CORBA/StubDelegateImpl.java
@@ -0,0 +1,113 @@
+/* StubDelegateImpl.java -- 
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package gnu.javax.rmi.CORBA;
+
+import java.io.IOException;
+import java.io.ObjectInputStream;
+import java.io.ObjectOutputStream;
+//import org.omg.CORBA.portable.Delegate;
+//import org.omg.CORBA.portable.InputStream;
+//import org.omg.CORBA.portable.OutputStream;
+//import org.omg.CORBA_2_3.portable.ObjectImpl;
+//import org.omg.CORBA.portable.ObjectImpl;
+//import org.omg.CORBA.BAD_OPERATION;
+//import org.omg.CORBA.ORB;
+import java.rmi.RemoteException;
+import javax.rmi.CORBA.Stub;
+import javax.rmi.CORBA.StubDelegate;
+import javax.rmi.CORBA.Tie;
+import javax.rmi.CORBA.StubDelegate;
+
+public class StubDelegateImpl
+  implements StubDelegate
+{
+
+  private int hashCode;
+    
+  public StubDelegateImpl(){
+    hashCode = 0;   
+  }
+  // XXX javax.rmi.ORB -> org.omg.CORBA.ORB
+  public void connect(Stub self, javax.rmi.ORB orb)
+    throws RemoteException
+  {
+    throw new Error("Not implemented for StubDelegate");
+  }
+
+  public boolean equals(Stub self, Object obj)
+  {
+    if(self == null || obj == null)
+      return self == obj;
+    if(!(obj instanceof Stub))
+      return false;
+    return self.hashCode() == ((Stub)obj).hashCode();
+  }
+
+  public int hashCode(Stub self)
+  {
+    //FIX ME
+    return hashCode;
+  }
+
+  public String toString(Stub self)
+  {
+    try
+      {
+	return self._orb().object_to_string(self);
+      }
+    // XXX javax.rmi.BAD_OPERATION -> org.omg.CORBA.BAD_OPERATION
+    catch(javax.rmi.BAD_OPERATION bad_operation)
+      {
+	return null;
+      }
+  }
+
+  public void readObject(Stub self, ObjectInputStream s)
+    throws IOException, ClassNotFoundException
+  {
+    throw new Error("Not implemented for StubDelegate");
+  }
+
+  public void writeObject(Stub self, ObjectOutputStream s)
+    throws IOException
+  {
+    throw new Error("Not implemented for StubDelegate");
+  }
+    
+}
diff --git a/libjava/gnu/javax/rmi/CORBA/UtilDelegateImpl.java b/libjava/gnu/javax/rmi/CORBA/UtilDelegateImpl.java
new file mode 100644
index 00000000000..70b2e60c673
--- /dev/null
+++ b/libjava/gnu/javax/rmi/CORBA/UtilDelegateImpl.java
@@ -0,0 +1,152 @@
+/* UtilDelegateImpl.java -- 
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package gnu.javax.rmi.CORBA;
+
+import java.rmi.Remote;
+import java.rmi.RemoteException;
+import java.rmi.server.RMIClassLoader;
+import java.net.MalformedURLException;
+import java.io.*;
+//import org.omg.CORBA.ORB;
+//import org.omg.CORBA.SystemException;
+//import org.omg.CORBA.portable.InputStream;
+//import org.omg.CORBA.portable.OutputStream;
+import javax.rmi.CORBA.*;
+
+public class UtilDelegateImpl
+  implements UtilDelegate
+{
+  // XXX javax.rmi.ORB -> org.omg.CORBA.ORB
+  public Object copyObject(Object obj, javax.rmi.ORB orb)
+    throws RemoteException
+  {
+    throw new Error("Not implemented for UtilDelegate");
+  }
+
+  // XXX javax.rmi.ORB -> org.omg.CORBA.ORB
+  public Object[] copyObjects(Object obj[], javax.rmi.ORB orb)
+    throws RemoteException
+  {
+    throw new Error("Not implemented for UtilDelegate");
+  }
+
+  public ValueHandler createValueHandler()
+  {
+    throw new Error("Not implemented for UtilDelegate");
+  }
+    
+  public String getCodebase(Class clz)
+  {
+    throw new Error("Not implemented for UtilDelegate");
+  }
+    
+  public Tie getTie(Remote target)
+  {
+    throw new Error("Not implemented for UtilDelegate");
+  }
+    
+  public boolean isLocal(Stub stub)
+    throws RemoteException
+  {
+    throw new Error("Not implemented for UtilDelegate");
+  }
+
+  public Class loadClass(String className, String remoteCodebase,
+		  	 ClassLoader loader)
+    throws ClassNotFoundException
+  {
+    try{
+      if (remoteCodebase == null)
+	return RMIClassLoader.loadClass(className);
+      else
+	return RMIClassLoader.loadClass(remoteCodebase, className);
+    }
+    catch (MalformedURLException e1)
+      {
+	throw new ClassNotFoundException(className, e1);
+      }
+    catch(ClassNotFoundException e2)
+      {
+	if(loader != null)
+	  return loader.loadClass(className);
+	else
+	  return null;
+      }
+  }
+
+  public RemoteException mapSystemException(SystemException ex)
+  {
+    throw new Error("Not implemented for UtilDelegate");
+  }
+
+  public Object readAny(InputStream in)
+  {
+    throw new Error("Not implemented for UtilDelegate");
+  }
+
+  public void registerTarget(Tie tie, Remote target)
+  {
+    throw new Error("Not implemented for UtilDelegate");
+  }
+    
+  public void unexportObject(Remote target)
+  {
+    throw new Error("Not implemented for UtilDelegate");
+  }
+    
+  public RemoteException wrapException(Throwable orig)
+  {
+    throw new Error("Not implemented for UtilDelegate");
+  }
+    
+  public void writeAbstractObject(OutputStream out, Object obj)
+  {
+    throw new Error("Not implemented for UtilDelegate");
+  }
+    
+  public void writeAny(OutputStream out, Object obj)
+  {
+    throw new Error("Not implemented for UtilDelegate");
+  }
+
+  public void writeRemoteObject(OutputStream out, Object obj)
+  {
+    throw new Error("Not implemented for UtilDelegate");
+  }
+}
diff --git a/libjava/gnu/javax/rmi/CORBA/ValueHandlerImpl.java b/libjava/gnu/javax/rmi/CORBA/ValueHandlerImpl.java
new file mode 100644
index 00000000000..6935aa68c4c
--- /dev/null
+++ b/libjava/gnu/javax/rmi/CORBA/ValueHandlerImpl.java
@@ -0,0 +1,82 @@
+/* ValueHandlerImpl.java -- 
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package gnu.javax.rmi.CORBA;
+
+import java.io.*;
+//import org.omg.CORBA.portable.InputStream;
+//import org.omg.CORBA.portable.OutputStream;
+//import org.omg.SendingContext.RunTime;
+import javax.rmi.CORBA.ValueHandler;
+
+public class ValueHandlerImpl
+  implements ValueHandler
+{
+
+  public String getRMIRepositoryID(Class clz)
+  {
+    throw new Error("Not implemented for ValueHandler");
+  }
+
+  // XXX - Runtime -> RunTime
+  public Runtime getRunTimeCodeBase()
+  {
+    throw new Error("Not implemented for ValueHandler");
+  }
+    
+  public boolean isCustomMarshaled(Class clz)
+  {
+    throw new Error("Not implemented for ValueHandler");
+  }   
+    
+  // XXX - Runtime -> RunTime
+  public Serializable readValue(InputStream in, int offset, Class clz, String repositoryID, Runtime sender)
+  {
+    throw new Error("Not implemented for ValueHandler");
+  }
+    
+  public Serializable writeReplace(Serializable value)
+  {
+    throw new Error("Not implemented for ValueHandler");
+  }
+    
+  public void writeValue(OutputStream out, Serializable value)
+  {
+    throw new Error("Not implemented for ValueHandler");
+  }
+}
diff --git a/libjava/gnu/javax/rmi/PortableServer.java b/libjava/gnu/javax/rmi/PortableServer.java
new file mode 100644
index 00000000000..b5022cab7b3
--- /dev/null
+++ b/libjava/gnu/javax/rmi/PortableServer.java
@@ -0,0 +1,142 @@
+/* PortableServer.java -- 
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package gnu.javax.rmi;
+
+import java.util.Hashtable;
+import java.rmi.Remote;
+import java.rmi.RemoteException;
+import java.rmi.NoSuchObjectException;
+import java.rmi.server.ExportException;
+import java.rmi.server.UnicastRemoteObject;
+import java.rmi.server.RemoteStub;
+import javax.rmi.CORBA.*;
+//import org.omg.CORBA.portable.ObjectImpl;
+
+/**
+ * The relationship of PortableRemoteObjectImpl with PortableServer
+ * is like that of UnicastRemoteObject with UnicastServer
+ */
+public class PortableServer
+{
+  static private Hashtable tieCache = new Hashtable();
+  static private Object NO_TIE = new Object();
+    
+  public static final synchronized void exportObject(Remote obj)
+    throws RemoteException
+  {
+    if(Util.getTie(obj) != null)
+      return;
+    
+    Tie tie = getTieFromRemote(obj);
+    if (tie != null)
+      Util.registerTarget(tie, obj);
+    else
+      UnicastRemoteObject.exportObject(obj);
+  }
+    
+  public static final void unexportObject(Remote obj)
+  {
+    if (Util.getTie(obj) != null)
+      Util.unexportObject(obj);
+    if (tieCache.get(obj) != null) //??
+      tieCache.remove(obj);
+  }
+  
+  public static final Remote toStub(Remote obj)
+    throws NoSuchObjectException
+  {
+    if (obj instanceof Stub || obj instanceof RemoteStub) 
+      return obj;
+    
+    Tie tie = Util.getTie(obj);
+    Remote stub;
+    if (tie != null)
+      stub = getStubFromTie(tie);
+    else
+      throw new NoSuchObjectException("Can't toStub an unexported object");
+    return stub;
+  }
+    
+  static synchronized Tie getTieFromRemote(Remote obj)
+  {
+    Object tie = tieCache.get(obj);
+    if (tie == null)
+      {
+	tie = getTieFromClass(obj.getClass());
+	if(tie == null)
+	  tieCache.put(obj, NO_TIE);
+	else
+	  tieCache.put(obj, tie);
+      }
+    else
+      if(tie != NO_TIE)
+	{
+	  try
+	    {
+	      tie = obj.getClass().newInstance();
+	    }
+	  catch(Exception _)
+	    {
+	      tie = null;
+	    }
+	}
+      else //NO_TIE
+	tie = null;
+                
+    return (Tie)tie;
+  }
+  
+  static synchronized Tie getTieFromClass(Class clz)
+  {
+    //FIX ME
+    return null;
+  }
+    
+  public static Remote getStubFromTie(Tie tie)
+  {
+    //FIX ME
+    return null;
+  }
+  
+  public static Remote getStubFromObjectImpl(ObjectImpl objimpl, Class toClass)
+  {
+    //FIX ME
+    return null;
+  }
+}
diff --git a/libjava/javax/rmi/BAD_OPERATION.java b/libjava/javax/rmi/BAD_OPERATION.java
new file mode 100644
index 00000000000..36081a47c57
--- /dev/null
+++ b/libjava/javax/rmi/BAD_OPERATION.java
@@ -0,0 +1,4 @@
+package javax.rmi;
+
+/** XXX - Stub till we have org.omg.CORBA */
+public class BAD_OPERATION extends Exception { }
diff --git a/libjava/javax/rmi/CORBA/ClassDesc.java b/libjava/javax/rmi/CORBA/ClassDesc.java
new file mode 100644
index 00000000000..052046df926
--- /dev/null
+++ b/libjava/javax/rmi/CORBA/ClassDesc.java
@@ -0,0 +1,55 @@
+/* ClassDesc.java -- 
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package javax.rmi.CORBA;
+
+import java.io.Serializable;
+
+public class ClassDesc
+  implements Serializable
+{
+  /*
+   * The following is serialized form required by Java API Doc
+   */
+  private String repid;
+  private String codebase;
+  
+  public ClassDesc()
+  {
+  }
+}
diff --git a/libjava/javax/rmi/CORBA/ObjectImpl.java b/libjava/javax/rmi/CORBA/ObjectImpl.java
new file mode 100644
index 00000000000..d76d673cede
--- /dev/null
+++ b/libjava/javax/rmi/CORBA/ObjectImpl.java
@@ -0,0 +1,9 @@
+package javax.rmi.CORBA;
+
+/** XXX - Stub till we have org.omg.CORBA */
+public class ObjectImpl
+{
+  public ObjectImpl _orb() { return null; }
+  public String object_to_string(ObjectImpl o) 
+    throws javax.rmi.BAD_OPERATION { return null; }
+}
diff --git a/libjava/javax/rmi/CORBA/PortableRemoteObjectDelegate.java b/libjava/javax/rmi/CORBA/PortableRemoteObjectDelegate.java
new file mode 100644
index 00000000000..a073cf4705c
--- /dev/null
+++ b/libjava/javax/rmi/CORBA/PortableRemoteObjectDelegate.java
@@ -0,0 +1,63 @@
+/* PortableRemoteObjectDelegate.java -- Interface supporting PortableRemoteObject
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package javax.rmi.CORBA;
+
+import java.rmi.*;
+
+/**
+ * A delegate is a singleton class that support delegation for method
+ * implementation in PortableRemoteObject.
+ */
+public interface PortableRemoteObjectDelegate
+{
+  void connect(Remote target, Remote source)
+    throws RemoteException;
+        
+  void exportObject(Remote obj)
+    throws RemoteException;
+
+  Object narrow(Object narrowFrom, Class narrowTo)
+    throws ClassCastException;
+        
+  Remote toStub(Remote obj)
+    throws NoSuchObjectException;
+  
+  void unexportObject(Remote obj)
+    throws NoSuchObjectException;
+}
diff --git a/libjava/javax/rmi/CORBA/Stub.java b/libjava/javax/rmi/CORBA/Stub.java
new file mode 100644
index 00000000000..c79b85cb46e
--- /dev/null
+++ b/libjava/javax/rmi/CORBA/Stub.java
@@ -0,0 +1,120 @@
+/* Stub.java -- 
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package javax.rmi.CORBA;
+
+import java.io.IOException;
+import java.io.ObjectInputStream;
+import java.io.ObjectOutputStream;
+import java.io.Serializable;
+import java.rmi.RemoteException;
+//import org.omg.CORBA.ORB;
+//import org.omg.CORBA_2_3.portable.ObjectImpl;
+//import org.omg.CORBA.portable.ObjectImpl;
+import gnu.javax.rmi.CORBA.DelegateFactory;
+import gnu.javax.rmi.CORBA.GetDelegateInstanceException;
+
+public abstract class Stub extends ObjectImpl
+  implements Serializable
+{
+  private transient StubDelegate delegate;
+                
+  protected Stub()
+  {
+    try
+      {
+	delegate = (StubDelegate)DelegateFactory.getInstance("Stub");
+      }
+    catch(GetDelegateInstanceException e)
+      {
+	delegate = null;
+      }
+  }
+
+  public int hashCode()
+  {
+    if(delegate != null)
+      return delegate.hashCode(this);
+    else
+      return 0;
+  }
+
+  public boolean equals(Object obj)
+  {
+    if(delegate != null)
+      return delegate.equals(this, obj);
+    else
+      return false;
+  }
+
+  public String toString()
+  {
+    String s = null;
+    if(delegate != null)
+      s = delegate.toString(this);
+    if(s == null)
+      s = super.toString();
+    return s;
+  }
+
+  // XXX javax.rmi.ORB -> org.omg.CORBA.ORB
+  public void connect(javax.rmi.ORB orb)
+    throws RemoteException
+  {
+    if(delegate != null)
+      delegate.connect(this, orb);
+  }
+
+  /**
+   * The following two routines are required by serialized form of Java API doc.
+   */
+  private void readObject(ObjectInputStream stream)
+    throws IOException, ClassNotFoundException
+  {
+    if(delegate != null)
+      delegate.readObject(this, stream);
+  }
+
+  private void writeObject(ObjectOutputStream stream)
+    throws IOException
+  {
+    if(delegate != null)
+      delegate.writeObject(this, stream);
+  }
+
+}
diff --git a/libjava/javax/rmi/CORBA/StubDelegate.java b/libjava/javax/rmi/CORBA/StubDelegate.java
new file mode 100644
index 00000000000..6c7f69fe7dc
--- /dev/null
+++ b/libjava/javax/rmi/CORBA/StubDelegate.java
@@ -0,0 +1,65 @@
+/* StubDelegate.java -- 
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package javax.rmi.CORBA;
+
+import java.io.IOException;
+import java.io.ObjectInputStream;
+import java.io.ObjectOutputStream;
+import java.rmi.RemoteException;
+//import org.omg.CORBA.ORB;
+
+public interface StubDelegate
+{
+
+  // XXX javax.rmi.ORB -> org.omg.CORBA.ORB
+  void connect(Stub self, javax.rmi.ORB orb)
+    throws RemoteException;
+
+  boolean equals(Stub self, Object obj);
+
+  int hashCode(Stub self);
+
+  void readObject(Stub self, ObjectInputStream s)
+    throws IOException, ClassNotFoundException;
+
+  String toString(Stub self);
+
+  void writeObject(Stub self, ObjectOutputStream s)
+    throws IOException;
+}
diff --git a/libjava/javax/rmi/CORBA/SystemException.java b/libjava/javax/rmi/CORBA/SystemException.java
new file mode 100644
index 00000000000..f8afdc35e35
--- /dev/null
+++ b/libjava/javax/rmi/CORBA/SystemException.java
@@ -0,0 +1,4 @@
+package javax.rmi.CORBA;
+
+/** XXX - Stub till we have org.omg.CORBA */
+public class SystemException extends Exception { }
diff --git a/libjava/javax/rmi/CORBA/Tie.java b/libjava/javax/rmi/CORBA/Tie.java
new file mode 100644
index 00000000000..ca14e3d4236
--- /dev/null
+++ b/libjava/javax/rmi/CORBA/Tie.java
@@ -0,0 +1,62 @@
+/* Tie.java -- 
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package javax.rmi.CORBA;
+
+import java.rmi.Remote;
+//import org.omg.CORBA.ORB;
+//import org.omg.CORBA.portable.InvokeHandler;
+
+public interface Tie // XXX extends InvokeHandler
+{
+    
+  void deactivate();
+
+  Remote getTarget();
+
+  // XXX javax.rmi.ORB -> org.omg.CORBA.ORB
+  javax.rmi.ORB orb();
+  
+  // XXX javax.rmi.ORB -> org.omg.CORBA.ORB
+  void orb(javax.rmi.ORB orb);
+  
+  void setTarget(Remote target);
+ 
+  // XXX Object -> org.omg.CORBA.Object
+  Object thisObject();
+}
diff --git a/libjava/javax/rmi/CORBA/Util.java b/libjava/javax/rmi/CORBA/Util.java
new file mode 100644
index 00000000000..45a189d97c5
--- /dev/null
+++ b/libjava/javax/rmi/CORBA/Util.java
@@ -0,0 +1,187 @@
+/* Util.java -- 
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package javax.rmi.CORBA;
+
+import java.rmi.Remote;
+import java.rmi.RemoteException;
+import java.lang.Object;
+import java.io.*;
+//import org.omg.CORBA.*;
+//import org.omg.CORBA.portable.InputStream;
+//import org.omg.CORBA.portable.OutputStream;
+import gnu.javax.rmi.CORBA.DelegateFactory;
+import gnu.javax.rmi.CORBA.GetDelegateInstanceException;
+
+public class Util
+{
+
+  private static UtilDelegate delegate;
+  static
+  {
+    try
+      {
+	delegate = (UtilDelegate)DelegateFactory.getInstance("Util");
+      }
+    catch(GetDelegateInstanceException e)
+      {
+	delegate = null;
+      }
+  }
+
+  private Util()
+  {
+  }
+
+  // XXX - javax.rmi.ORB -> org.omg.CORBA.ORB
+  public static Object copyObject(Object obj, javax.rmi.ORB orb)
+    throws RemoteException
+  {
+    if(delegate != null)
+      return delegate.copyObject(obj, orb);
+    else
+      return null;
+  }
+
+  // XXX - javax.rmi.ORB -> org.omg.CORBA.ORB
+  public static Object[] copyObjects(Object obj[], javax.rmi.ORB orb)
+    throws RemoteException
+  {
+    if(delegate != null)
+      return delegate.copyObjects(obj, orb);
+    else
+      return null;
+  }
+    
+  public static ValueHandler createValueHandler()
+  {
+    if(delegate != null)
+      return delegate.createValueHandler();
+    else
+      return null;
+  }
+    
+  public static String getCodebase(Class clz)
+  {
+    if(delegate != null)
+      return delegate.getCodebase(clz);
+    else
+      return null;
+  }
+    
+  public static Tie getTie(Remote target)
+  {
+    if(delegate != null)
+      return delegate.getTie(target);
+    else
+      return null;
+  }
+
+  public static boolean isLocal(Stub stub)
+    throws RemoteException
+  {
+    if(delegate != null)
+      return delegate.isLocal(stub);
+    else
+      return false;
+  }
+
+  public static Class loadClass(String className, String remoteCodebase, ClassLoader loader)
+    throws ClassNotFoundException
+  {
+    if(delegate != null)
+      return delegate.loadClass(className, remoteCodebase, loader);
+    else
+      throw new ClassNotFoundException(className + ": delegate == null");
+  }
+    
+  public static RemoteException mapSystemException(SystemException ex)
+  {
+    if(delegate != null)
+      return delegate.mapSystemException(ex);
+    else
+      return null;
+  }
+
+  public static Object readAny(InputStream in)
+  {
+    if(delegate != null)
+      return delegate.readAny(in);
+    else
+      return null;
+  }
+
+  public static void registerTarget(Tie tie, Remote target)
+  {
+    if(delegate != null)
+      delegate.registerTarget(tie, target);
+  }
+    
+  public static void unexportObject(Remote target)
+  {
+    if(delegate != null)
+      delegate.unexportObject(target);
+  }
+    
+  public static RemoteException wrapException(Throwable orig)
+  {
+    if(delegate != null)
+      return delegate.wrapException(orig);
+    else
+      return null;
+  }
+    
+  public static void writeAbstractObject(OutputStream out, Object obj)
+  {
+    if(delegate != null)
+      delegate.writeAbstractObject(out, obj);
+  }
+    
+  public static void writeAny(OutputStream out, Object obj)
+  {
+    if(delegate != null)
+      delegate.writeAny(out, obj);
+  }
+    
+  public static void writeRemoteObject(OutputStream out, Object obj)
+  {
+    if(delegate != null)
+      delegate.writeRemoteObject(out, obj);
+  }
+
+}
diff --git a/libjava/javax/rmi/CORBA/UtilDelegate.java b/libjava/javax/rmi/CORBA/UtilDelegate.java
new file mode 100644
index 00000000000..4d611bc8bfb
--- /dev/null
+++ b/libjava/javax/rmi/CORBA/UtilDelegate.java
@@ -0,0 +1,84 @@
+/* UtilDelegate.java -- 
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package javax.rmi.CORBA;
+
+import java.rmi.Remote;
+import java.rmi.RemoteException;
+import java.io.*;
+//import org.omg.CORBA.ORB;
+//import org.omg.CORBA.SystemException;
+//import org.omg.CORBA.portable.InputStream;
+//import org.omg.CORBA.portable.OutputStream;
+
+public interface UtilDelegate
+{
+
+  // XXX javax.rmi.ORB -> org.omg.CORBA.ORB
+  Object copyObject(Object obj, javax.rmi.ORB orb) throws RemoteException;
+  
+  // XXX javax.rmi.ORB -> org.omg.CORBA.ORB
+  Object[] copyObjects(Object obj[], javax.rmi.ORB orb) throws RemoteException;
+
+  ValueHandler createValueHandler();
+    
+  String getCodebase(Class clz);
+    
+  Tie getTie(Remote target);
+    
+  boolean isLocal(Stub stub) throws RemoteException;
+
+  Class loadClass(String className, String remoteCodebase,
+		  ClassLoader loader) throws ClassNotFoundException;
+
+  RemoteException mapSystemException(SystemException ex);
+
+  Object readAny(InputStream in);
+
+  void registerTarget(Tie tie, Remote target);
+    
+  void unexportObject(Remote target);
+    
+  RemoteException wrapException(Throwable orig);
+    
+  void writeAbstractObject(OutputStream out, Object obj);
+    
+  void writeAny(OutputStream out, Object obj);
+
+  void writeRemoteObject(OutputStream out, Object obj);
+}
diff --git a/libjava/javax/rmi/CORBA/ValueHandler.java b/libjava/javax/rmi/CORBA/ValueHandler.java
new file mode 100644
index 00000000000..3a008f18cca
--- /dev/null
+++ b/libjava/javax/rmi/CORBA/ValueHandler.java
@@ -0,0 +1,63 @@
+/* ValueHandler.java -- 
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package javax.rmi.CORBA;
+
+import java.io.*;
+//import org.omg.CORBA.portable.InputStream;
+//import org.omg.CORBA.portable.OutputStream;
+//import org.omg.SendingContext.RunTime;
+
+public interface ValueHandler
+{
+  
+  String getRMIRepositoryID(Class clz);
+ 
+  // XXX Runtime -> RunTime
+  Runtime getRunTimeCodeBase();
+  
+  boolean isCustomMarshaled(Class clz);
+  
+  // XXX Runtime -> RunTime
+  Serializable readValue(InputStream in, int offset, Class clz,
+			 String repositoryID, Runtime sender);
+    
+  Serializable writeReplace(Serializable value);
+    
+  void writeValue(OutputStream out, Serializable value);
+}
diff --git a/libjava/javax/rmi/ORB.java b/libjava/javax/rmi/ORB.java
new file mode 100644
index 00000000000..be7a894e65a
--- /dev/null
+++ b/libjava/javax/rmi/ORB.java
@@ -0,0 +1,4 @@
+package javax.rmi;
+
+/** XXX - Stub till we have org.omg.CORBA */
+public class ORB { }
diff --git a/libjava/javax/rmi/PortableRemoteObject.java b/libjava/javax/rmi/PortableRemoteObject.java
new file mode 100644
index 00000000000..ee40d9c9e74
--- /dev/null
+++ b/libjava/javax/rmi/PortableRemoteObject.java
@@ -0,0 +1,114 @@
+/* PortableRemoteObject.java -- 
+   Copyright (C) 2002 Free Software Foundation, Inc.
+
+This file is part of GNU Classpath.
+
+GNU Classpath is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Classpath is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Classpath; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA.
+
+Linking this library statically or dynamically with other modules is
+making a combined work based on this library.  Thus, the terms and
+conditions of the GNU General Public License cover the whole
+combination.
+
+As a special exception, the copyright holders of this library give you
+permission to link this library with independent modules to produce an
+executable, regardless of the license terms of these independent
+modules, and to copy and distribute the resulting executable under
+terms of your choice, provided that you also meet, for each linked
+independent module, the terms and conditions of the license of that
+module.  An independent module is a module which is not derived from
+or based on this library.  If you modify this library, you may extend
+this exception to your version of the library, but you are not
+obligated to do so.  If you do not wish to do so, delete this
+exception statement from your version. */
+
+
+package javax.rmi;
+
+import java.rmi.Remote;
+import java.rmi.RemoteException;
+import java.rmi.NoSuchObjectException;
+import gnu.javax.rmi.CORBA.DelegateFactory;
+import gnu.javax.rmi.CORBA.GetDelegateInstanceException;
+import javax.rmi.CORBA.PortableRemoteObjectDelegate;
+import javax.rmi.CORBA.Util;
+
+public class PortableRemoteObject
+  implements Remote /* why doc doesn't say should implement Remote */
+{
+
+  private static PortableRemoteObjectDelegate delegate;
+  static
+  {
+    try
+      {
+	delegate = (PortableRemoteObjectDelegate)DelegateFactory.getInstance
+	  ("PortableRemoteObject");
+      }
+    catch(GetDelegateInstanceException e)
+      {
+	e.printStackTrace();
+	delegate = null;
+      }
+  }
+
+  protected PortableRemoteObject()
+    throws RemoteException
+  {
+    if(delegate != null)
+      exportObject((Remote)this);
+  }
+
+  public static void connect(Remote target, Remote source)
+    throws RemoteException
+  {
+    if(delegate != null)
+      delegate.connect(target, source);
+  }
+    
+  public static void exportObject(Remote obj)
+    throws RemoteException
+  {
+    if(delegate != null)
+      delegate.exportObject(obj);
+  }
+
+  public static Object narrow(Object narrowFrom, Class narrowTo)
+    throws ClassCastException
+  {
+    if(delegate != null)
+      return delegate.narrow(narrowFrom, narrowTo);
+    else
+      return null;
+  }
+
+  public static Remote toStub(Remote obj)
+    throws NoSuchObjectException
+  {
+    if(delegate != null)
+      return delegate.toStub(obj);
+    else
+      return null;
+  }
+
+  public static void unexportObject(Remote obj)
+    throws NoSuchObjectException
+  {
+    if(delegate != null)
+      delegate.unexportObject(obj);
+  }
+  
+}
diff --git a/libstdc++-v3/testsuite/20_util/allocator/1.cc b/libstdc++-v3/testsuite/20_util/allocator/1.cc
new file mode 100644
index 00000000000..d34c8daf9c9
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/allocator/1.cc
@@ -0,0 +1,71 @@
+// 2001-06-14  Benjamin Kosnik  <bkoz@redhat.com>
+
+// Copyright (C) 2001, 2002, 2004 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.4.1.1 allocator members
+
+#include <memory>
+#include <stdexcept>
+#include <cstdlib>
+#include <testsuite_hooks.h>
+
+struct gnu { };
+
+bool check_new = false;
+bool check_delete = false;
+
+void* 
+operator new(std::size_t n) throw(std::bad_alloc)
+{
+  check_new = true;
+  return std::malloc(n);
+}
+
+void operator delete(void *v) throw()
+{
+  check_delete = true;
+  return std::free(v);
+}
+
+#if !__GXX_WEAK__ && _MT_ALLOCATOR_H
+// Explicitly instantiate for systems with no COMDAT or weak support.
+template class __gnu_cxx::__mt_alloc<gnu>;
+#endif
+
+void test01()
+{
+  bool test __attribute__((unused)) = true;
+  std::allocator<gnu> obj;
+
+  // NB: These should work for various size allocation and
+  // deallocations.  Currently, they only work as expected for sizes >
+  // _MAX_BYTES as defined in stl_alloc.h, which happes to be 128. 
+  gnu* pobj = obj.allocate(256);
+  VERIFY( check_new );
+
+  obj.deallocate(pobj, 256);
+  VERIFY( check_delete );
+}
+
+int main()
+{
+  test01();
+  return 0;
+}
+
diff --git a/libstdc++-v3/testsuite/20_util/allocator/10378.cc b/libstdc++-v3/testsuite/20_util/allocator/10378.cc
new file mode 100644
index 00000000000..2ac77eaaf16
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/allocator/10378.cc
@@ -0,0 +1,51 @@
+// Copyright (C) 2003, 2004 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.1.5 allocator requirements / 20.4.1.1 allocator members
+
+#include <list>
+#include <cstdlib>
+#include <testsuite_hooks.h>
+
+class Bob
+{
+public:
+  static void* operator new(size_t sz)
+  { return std::malloc(sz); }
+};
+
+// libstdc++/10378
+void test01()
+{
+  using namespace std;
+  bool test __attribute__((unused)) = true;
+
+  list<Bob> uniset;
+  uniset.push_back(Bob());
+}
+
+#if !__GXX_WEAK__ && _MT_ALLOCATOR_H
+// Explicitly instantiate for systems with no COMDAT or weak support.
+template class __gnu_cxx::__mt_alloc<std::_List_node<Bob> >;
+#endif
+
+int main()
+{
+  test01();
+  return 0;
+}
diff --git a/libstdc++-v3/testsuite/20_util/allocator/14176.cc b/libstdc++-v3/testsuite/20_util/allocator/14176.cc
new file mode 100644
index 00000000000..cb8a2f5c4bf
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/allocator/14176.cc
@@ -0,0 +1,42 @@
+// Copyright (C) 2004 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.4.1.1 allocator members
+
+#include <memory>
+#include <testsuite_hooks.h>
+
+// libstdc++/14176
+void test02()
+{
+  unsigned int len = 0;  
+  std::allocator<int> a;
+  int* p = a.allocate(len);
+  a.deallocate(p, len);
+}
+
+#if !__GXX_WEAK__ && _MT_ALLOCATOR_H
+// Explicitly instantiate for systems with no COMDAT or weak support.
+template class __gnu_cxx::__mt_alloc<int>;
+#endif
+
+int main()
+{
+  test02();
+  return 0;
+}
diff --git a/libstdc++-v3/testsuite/20_util/allocator/8230.cc b/libstdc++-v3/testsuite/20_util/allocator/8230.cc
new file mode 100644
index 00000000000..95b6cbee55f
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/allocator/8230.cc
@@ -0,0 +1,59 @@
+// 2001-06-14  Benjamin Kosnik  <bkoz@redhat.com>
+
+// Copyright (C) 2001, 2002, 2004 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.4.1.1 allocator members
+
+#include <memory>
+#include <stdexcept>
+#include <testsuite_hooks.h>
+
+// libstdc++/8230
+void test02()
+{
+  bool test __attribute__((unused)) = true;
+  try 
+    {
+      std::allocator<int> alloc;
+      const std::allocator<int>::size_type n = alloc.max_size();
+      int* p = alloc.allocate(n + 1);
+      p[n] = 2002;
+    } 
+  catch(const std::bad_alloc& e) 
+    {
+      // Allowed.
+      test = true;
+    }
+  catch(...) 
+    {
+      test = false;
+    }
+  VERIFY( test );
+}
+
+#if !__GXX_WEAK__ && _MT_ALLOCATOR_H
+// Explicitly instantiate for systems with no COMDAT or weak support.
+template class __gnu_cxx::__mt_alloc<int>;
+#endif
+
+int main()
+{
+  test02();
+  return 0;
+}
diff --git a/libstdc++-v3/testsuite/20_util/auto_ptr/1.cc b/libstdc++-v3/testsuite/20_util/auto_ptr/1.cc
new file mode 100644
index 00000000000..8e150b0187c
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/auto_ptr/1.cc
@@ -0,0 +1,95 @@
+// Copyright (C) 2000, 2002, 2003, 2004 Free Software Foundation
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.4.5 Template class auto_ptr [lib.auto.ptr]
+
+#include <memory>
+#include <testsuite_hooks.h>
+
+struct A
+{
+  A() { ++ctor_count; }
+  virtual ~A() { ++dtor_count; }
+  static long ctor_count;
+  static long dtor_count;
+};
+long A::ctor_count = 0;
+long A::dtor_count = 0;
+
+struct B : A
+{
+  B() { ++ctor_count; }
+  virtual ~B() { ++dtor_count; }
+  static long ctor_count;
+  static long dtor_count;
+};
+long B::ctor_count = 0;
+long B::dtor_count = 0;
+
+
+struct reset_count_struct
+{
+  ~reset_count_struct()
+  {
+    A::ctor_count = 0;
+    A::dtor_count = 0;
+    B::ctor_count = 0;
+    B::dtor_count = 0;
+  }
+};
+
+
+// 20.4.5.1 auto_ptr constructors [lib.auto.ptr.cons]
+
+// Construction from pointer
+int
+test01()
+{
+  reset_count_struct __attribute__((unused)) reset;
+  bool test __attribute__((unused)) = true;
+
+  std::auto_ptr<A> A_default;
+  VERIFY( A_default.get() == 0 );
+  VERIFY( A::ctor_count == 0 );
+  VERIFY( A::dtor_count == 0 );
+  VERIFY( B::ctor_count == 0 );
+  VERIFY( B::dtor_count == 0 );
+
+  std::auto_ptr<A> A_from_A(new A);
+  VERIFY( A_from_A.get() != 0 );
+  VERIFY( A::ctor_count == 1 );
+  VERIFY( A::dtor_count == 0 );
+  VERIFY( B::ctor_count == 0 );
+  VERIFY( B::dtor_count == 0 );
+
+  std::auto_ptr<A> A_from_B(new B);
+  VERIFY( A_from_B.get() != 0 );
+  VERIFY( A::ctor_count == 2 );
+  VERIFY( A::dtor_count == 0 );
+  VERIFY( B::ctor_count == 1 );
+  VERIFY( B::dtor_count == 0 );
+
+  return 0;
+}
+
+int 
+main()
+{
+  test01();
+  return 0;
+}
diff --git a/libstdc++-v3/testsuite/20_util/auto_ptr/2.cc b/libstdc++-v3/testsuite/20_util/auto_ptr/2.cc
new file mode 100644
index 00000000000..6ce31d1fe88
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/auto_ptr/2.cc
@@ -0,0 +1,85 @@
+// Copyright (C) 2000, 2002, 2003, 2004 Free Software Foundation
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.4.5 Template class auto_ptr [lib.auto.ptr]
+
+#include <memory>
+#include <testsuite_hooks.h>
+
+struct A
+{
+  A() { ++ctor_count; }
+  virtual ~A() { ++dtor_count; }
+  static long ctor_count;
+  static long dtor_count;
+};
+long A::ctor_count = 0;
+long A::dtor_count = 0;
+
+struct B : A
+{
+  B() { ++ctor_count; }
+  virtual ~B() { ++dtor_count; }
+  static long ctor_count;
+  static long dtor_count;
+};
+long B::ctor_count = 0;
+long B::dtor_count = 0;
+
+
+struct reset_count_struct
+{
+  ~reset_count_struct()
+  {
+    A::ctor_count = 0;
+    A::dtor_count = 0;
+    B::ctor_count = 0;
+    B::dtor_count = 0;
+  }
+};
+
+// Construction from std::auto_ptr
+int
+test02()
+{
+  reset_count_struct __attribute__((unused)) reset;
+  bool test __attribute__((unused)) = true;
+
+  std::auto_ptr<A> A_from_A(new A);
+  std::auto_ptr<B> B_from_B(new B);
+
+  std::auto_ptr<A> A_from_ptr_A(A_from_A);
+  std::auto_ptr<A> A_from_ptr_B(B_from_B);
+  VERIFY( A_from_A.get() == 0 );
+  VERIFY( B_from_B.get() == 0 );
+  VERIFY( A_from_ptr_A.get() != 0 );
+  VERIFY( A_from_ptr_B.get() != 0 );
+  VERIFY( A::ctor_count == 2 );
+  VERIFY( A::dtor_count == 0 );
+  VERIFY( B::ctor_count == 1 );
+  VERIFY( B::dtor_count == 0 );
+
+  return 0;
+}
+
+int 
+main()
+{
+  test02();
+  return 0;
+}
diff --git a/libstdc++-v3/testsuite/20_util/auto_ptr/3.cc b/libstdc++-v3/testsuite/20_util/auto_ptr/3.cc
new file mode 100644
index 00000000000..8090d277783
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/auto_ptr/3.cc
@@ -0,0 +1,87 @@
+// Copyright (C) 2000, 2002, 2003, 2004 Free Software Foundation
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.4.5 Template class auto_ptr [lib.auto.ptr]
+
+#include <memory>
+#include <testsuite_hooks.h>
+
+struct A
+{
+  A() { ++ctor_count; }
+  virtual ~A() { ++dtor_count; }
+  static long ctor_count;
+  static long dtor_count;
+};
+long A::ctor_count = 0;
+long A::dtor_count = 0;
+
+struct B : A
+{
+  B() { ++ctor_count; }
+  virtual ~B() { ++dtor_count; }
+  static long ctor_count;
+  static long dtor_count;
+};
+long B::ctor_count = 0;
+long B::dtor_count = 0;
+
+
+struct reset_count_struct
+{
+  ~reset_count_struct()
+  {
+    A::ctor_count = 0;
+    A::dtor_count = 0;
+    B::ctor_count = 0;
+    B::dtor_count = 0;
+  }
+};
+
+// Assignment from std::auto_ptr
+int
+test03()
+{
+  reset_count_struct __attribute__((unused)) reset;
+  bool test __attribute__((unused)) = true;
+
+  std::auto_ptr<A> A_from_ptr_A;
+  std::auto_ptr<A> A_from_ptr_B;
+  std::auto_ptr<A> A_from_A(new A);
+  std::auto_ptr<B> B_from_B(new B);
+
+  A_from_ptr_A = A_from_A;
+  A_from_ptr_B = B_from_B;
+  VERIFY( A_from_A.get() == 0 );
+  VERIFY( B_from_B.get() == 0 );
+  VERIFY( A_from_ptr_A.get() != 0 );
+  VERIFY( A_from_ptr_B.get() != 0 );
+  VERIFY( A::ctor_count == 2 );
+  VERIFY( A::dtor_count == 0 );
+  VERIFY( B::ctor_count == 1 );
+  VERIFY( B::dtor_count == 0 );
+
+  return 0;
+}
+
+int 
+main()
+{
+  test03();
+  return 0;
+}
diff --git a/libstdc++-v3/testsuite/20_util/auto_ptr/3946.cc b/libstdc++-v3/testsuite/20_util/auto_ptr/3946.cc
new file mode 100644
index 00000000000..191ba6f9306
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/auto_ptr/3946.cc
@@ -0,0 +1,45 @@
+// Copyright (C) 2000, 2002, 2003, 2004 Free Software Foundation
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.4.5 Template class auto_ptr [lib.auto.ptr]
+
+#include <memory>
+#include <testsuite_hooks.h>
+
+// libstdc++/3946
+// http://gcc.gnu.org/ml/libstdc++/2002-07/msg00024.html
+struct Base { };
+struct Derived : public Base { };
+
+std::auto_ptr<Derived> 
+conversiontest08() { return std::auto_ptr<Derived>(new Derived); }
+
+void
+test08()
+{
+  std::auto_ptr<Base> ptr;
+  ptr = conversiontest08();
+}
+
+
+int 
+main()
+{
+  test08();
+  return 0;
+}
diff --git a/libstdc++-v3/testsuite/20_util/auto_ptr/4.cc b/libstdc++-v3/testsuite/20_util/auto_ptr/4.cc
new file mode 100644
index 00000000000..18148005573
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/auto_ptr/4.cc
@@ -0,0 +1,83 @@
+// Copyright (C) 2000, 2002, 2003, 2004 Free Software Foundation
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.4.5 Template class auto_ptr [lib.auto.ptr]
+
+#include <memory>
+#include <testsuite_hooks.h>
+
+struct A
+{
+  A() { ++ctor_count; }
+  virtual ~A() { ++dtor_count; }
+  static long ctor_count;
+  static long dtor_count;
+};
+long A::ctor_count = 0;
+long A::dtor_count = 0;
+
+struct B : A
+{
+  B() { ++ctor_count; }
+  virtual ~B() { ++dtor_count; }
+  static long ctor_count;
+  static long dtor_count;
+};
+long B::ctor_count = 0;
+long B::dtor_count = 0;
+
+
+struct reset_count_struct
+{
+  ~reset_count_struct()
+  {
+    A::ctor_count = 0;
+    A::dtor_count = 0;
+    B::ctor_count = 0;
+    B::dtor_count = 0;
+  }
+};
+
+
+// Destruction
+int
+test04()
+{
+  reset_count_struct __attribute__((unused)) reset;
+  bool test __attribute__((unused)) = true;
+
+  {/*lifetine scope*/
+    std::auto_ptr<A> A_from_A(new A);
+    std::auto_ptr<A> A_from_B(new B);
+    std::auto_ptr<B> B_from_B(new B);
+  }/*destructors called here*/
+
+  VERIFY( A::ctor_count == 3 );
+  VERIFY( A::dtor_count == 3 );
+  VERIFY( B::ctor_count == 2 );
+  VERIFY( B::dtor_count == 2 );
+
+  return 0;
+}
+
+int 
+main()
+{
+  test04();
+  return 0;
+}
diff --git a/libstdc++-v3/testsuite/20_util/auto_ptr/5.cc b/libstdc++-v3/testsuite/20_util/auto_ptr/5.cc
new file mode 100644
index 00000000000..77969816496
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/auto_ptr/5.cc
@@ -0,0 +1,87 @@
+// Copyright (C) 2000, 2002, 2003, 2004 Free Software Foundation
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.4.5 Template class auto_ptr [lib.auto.ptr]
+
+#include <memory>
+#include <testsuite_hooks.h>
+
+struct A
+{
+  A() { ++ctor_count; }
+  virtual ~A() { ++dtor_count; }
+  static long ctor_count;
+  static long dtor_count;
+};
+long A::ctor_count = 0;
+long A::dtor_count = 0;
+
+struct B : A
+{
+  B() { ++ctor_count; }
+  virtual ~B() { ++dtor_count; }
+  static long ctor_count;
+  static long dtor_count;
+};
+long B::ctor_count = 0;
+long B::dtor_count = 0;
+
+
+struct reset_count_struct
+{
+  ~reset_count_struct()
+  {
+    A::ctor_count = 0;
+    A::dtor_count = 0;
+    B::ctor_count = 0;
+    B::dtor_count = 0;
+  }
+};
+
+
+// Class member construction/destruction
+template <typename T>
+class pimpl
+{
+public:
+  pimpl() : p_impl(new T) {}
+private:
+  std::auto_ptr<T> p_impl;
+};
+
+int 
+test05()
+{
+  bool test __attribute__((unused)) = true;
+  reset_count_struct __attribute__((unused)) reset;
+
+  pimpl<A>();
+  pimpl<B>();
+  VERIFY( A::ctor_count == 2 );
+  VERIFY( A::dtor_count == 2 );
+  VERIFY( B::ctor_count == 1 );
+  VERIFY( B::dtor_count == 1 );
+  return 0;
+}
+
+int 
+main()
+{
+  test05();
+  return 0;
+}
diff --git a/libstdc++-v3/testsuite/20_util/auto_ptr/6.cc b/libstdc++-v3/testsuite/20_util/auto_ptr/6.cc
new file mode 100644
index 00000000000..e4e13d9d6b0
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/auto_ptr/6.cc
@@ -0,0 +1,91 @@
+// Copyright (C) 2000, 2002, 2003, 2004 Free Software Foundation
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.4.5 Template class auto_ptr [lib.auto.ptr]
+
+#include <memory>
+#include <testsuite_hooks.h>
+
+struct A
+{
+  A() { ++ctor_count; }
+  virtual ~A() { ++dtor_count; }
+  static long ctor_count;
+  static long dtor_count;
+};
+long A::ctor_count = 0;
+long A::dtor_count = 0;
+
+struct B : A
+{
+  B() { ++ctor_count; }
+  virtual ~B() { ++dtor_count; }
+  static long ctor_count;
+  static long dtor_count;
+};
+long B::ctor_count = 0;
+long B::dtor_count = 0;
+
+
+struct reset_count_struct
+{
+  ~reset_count_struct()
+  {
+    A::ctor_count = 0;
+    A::dtor_count = 0;
+    B::ctor_count = 0;
+    B::dtor_count = 0;
+  }
+};
+
+// 20.4.5.2 auto_ptr members [lib.auto.ptr.members]
+
+// Member access
+int
+test06()
+{
+  reset_count_struct __attribute__((unused)) reset;
+  bool test __attribute__((unused)) = true;
+
+  std::auto_ptr<A> A_from_A(new A);
+  std::auto_ptr<A> A_from_A_ptr(A_from_A.release());
+  VERIFY( A_from_A.get() == 0 );
+  VERIFY( A_from_A_ptr.get() != 0 );
+  VERIFY( A_from_A_ptr->ctor_count == 1 );
+  VERIFY( (*A_from_A_ptr).dtor_count == 0 );
+
+  A* A_ptr = A_from_A_ptr.get();
+
+  A_from_A_ptr.reset(A_ptr);
+  VERIFY( A_from_A_ptr.get() == A_ptr );
+  VERIFY( A_from_A_ptr->ctor_count == 1 );
+  VERIFY( (*A_from_A_ptr).dtor_count == 0 );
+
+  A_from_A_ptr.reset(new A);
+  VERIFY( A_from_A_ptr.get() != A_ptr );
+  VERIFY( A_from_A_ptr->ctor_count == 2 );
+  VERIFY( (*A_from_A_ptr).dtor_count == 1 );
+  return 0;
+}
+
+int 
+main()
+{
+  test06();
+  return 0;
+}
diff --git a/libstdc++-v3/testsuite/20_util/auto_ptr/7.cc b/libstdc++-v3/testsuite/20_util/auto_ptr/7.cc
new file mode 100644
index 00000000000..a77ba51cb58
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/auto_ptr/7.cc
@@ -0,0 +1,91 @@
+// Copyright (C) 2000, 2002, 2003, 2004 Free Software Foundation
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.4.5 Template class auto_ptr [lib.auto.ptr]
+
+#include <memory>
+#include <testsuite_hooks.h>
+
+struct A
+{
+  A() { ++ctor_count; }
+  virtual ~A() { ++dtor_count; }
+  static long ctor_count;
+  static long dtor_count;
+};
+long A::ctor_count = 0;
+long A::dtor_count = 0;
+
+struct B : A
+{
+  B() { ++ctor_count; }
+  virtual ~B() { ++dtor_count; }
+  static long ctor_count;
+  static long dtor_count;
+};
+long B::ctor_count = 0;
+long B::dtor_count = 0;
+
+
+struct reset_count_struct
+{
+  ~reset_count_struct()
+  {
+    A::ctor_count = 0;
+    A::dtor_count = 0;
+    B::ctor_count = 0;
+    B::dtor_count = 0;
+  }
+};
+
+// 20.4.5.3 auto_ptr conversions [lib.auto.ptr.conv]
+
+// Parameters and return values
+template <typename T>
+static std::auto_ptr<T> source()
+{
+  return std::auto_ptr<T>(new T);
+}
+
+template <typename T>
+static void drain(std::auto_ptr<T>)
+{}
+
+int
+test07()
+{
+  bool test __attribute__((unused)) = true;
+  reset_count_struct __attribute__((unused)) reset;
+
+  drain(source<A>());
+  // The resolution of core issue 84, now a DR, breaks this call.
+  // drain<A>(source<B>());
+  drain(source<B>());
+  VERIFY( A::ctor_count == 2 );
+  VERIFY( A::dtor_count == 2 );
+  VERIFY( B::ctor_count == 1 );
+  VERIFY( B::dtor_count == 1 );
+  return 0;
+}
+
+int 
+main()
+{
+  test07();
+  return 0;
+}
diff --git a/libstdc++-v3/testsuite/20_util/auto_ptr/assign_neg.cc b/libstdc++-v3/testsuite/20_util/auto_ptr/assign_neg.cc
new file mode 100644
index 00000000000..55291676f3d
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/auto_ptr/assign_neg.cc
@@ -0,0 +1,50 @@
+// { dg-do compile }
+
+// Copyright (C) 2002, 2003, 2004 Free Software Foundation
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.4.5 Template class auto_ptr negative tests [lib.auto.ptr]
+
+#include <memory>
+#include <testsuite_hooks.h>
+
+// via Jack Reeves <jack_reeves@hispeed.ch>
+// libstdc++/3946
+// http://gcc.gnu.org/ml/libstdc++/2002-07/msg00024.html
+struct Base { };
+struct Derived : public Base { };
+
+std::auto_ptr<Derived> 
+foo() { return std::auto_ptr<Derived>(new Derived); }
+
+int
+test01()
+{
+  std::auto_ptr<Base> ptr2;
+  ptr2 = new Base; // { dg-error "no match" }
+  return 0;
+}
+
+int 
+main()
+{
+  test01();
+  return 0;
+}
+// { dg-error "candidates" "" { target *-*-* } 223 } 
+// { dg-error "std::auto_ptr" "" { target *-*-* } 353 } 
diff --git a/libstdc++-v3/testsuite/20_util/pair/1.cc b/libstdc++-v3/testsuite/20_util/pair/1.cc
new file mode 100644
index 00000000000..7ccee6dd569
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/pair/1.cc
@@ -0,0 +1,79 @@
+// 2001-06-18  Benjamin Kosnik  <bkoz@redhat.com>
+
+// Copyright (C) 2001, 2004 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.2.2 Pairs
+
+#include <utility>
+#include <testsuite_hooks.h>
+
+class gnu_obj
+{
+  int i;
+public:
+  gnu_obj(int arg = 0): i(arg) { }
+  bool operator==(const gnu_obj& rhs) const { return i == rhs.i; }
+  bool operator<(const gnu_obj& rhs) const { return i < rhs.i; }
+};
+
+template<typename T>
+  struct gnu_t
+  {
+    bool b;
+  public:
+    gnu_t(bool arg = 0): b(arg) { }
+    bool operator==(const gnu_t& rhs) const { return b == rhs.b; }
+    bool operator<(const gnu_t& rhs) const { return int(b) < int(rhs.b); }
+  };
+
+
+// heterogeneous
+void test01()
+{
+  bool test __attribute__((unused)) = true;
+
+  std::pair<bool, long> p_bl_1(true, 433);
+  std::pair<bool, long> p_bl_2 = std::make_pair(true, 433);
+  VERIFY( p_bl_1 == p_bl_2 );
+  VERIFY( !(p_bl_1 < p_bl_2) );
+
+  std::pair<const char*, float> p_sf_1("total enlightenment", 433.00);
+  std::pair<const char*, float> p_sf_2 = std::make_pair("total enlightenment", 
+							433.00);
+  VERIFY( p_sf_1 == p_sf_2 );
+  VERIFY( !(p_sf_1 < p_sf_2) );
+
+  std::pair<const char*, gnu_obj> p_sg_1("enlightenment", gnu_obj(5));
+  std::pair<const char*, gnu_obj> p_sg_2 = std::make_pair("enlightenment", 
+							  gnu_obj(5));
+  VERIFY( p_sg_1 == p_sg_2 );
+  VERIFY( !(p_sg_1 < p_sg_2) );
+
+  std::pair<gnu_t<long>, gnu_obj> p_st_1(gnu_t<long>(false), gnu_obj(5));
+  std::pair<gnu_t<long>, gnu_obj> p_st_2 = std::make_pair(gnu_t<long>(false),
+							  gnu_obj(5));
+  VERIFY( p_st_1 == p_st_2 );
+  VERIFY( !(p_st_1 < p_st_2) );
+}
+
+int main() 
+{ 
+  test01(); 
+  return 0;
+}
diff --git a/libstdc++-v3/testsuite/20_util/pair/2.cc b/libstdc++-v3/testsuite/20_util/pair/2.cc
new file mode 100644
index 00000000000..82d928c2d01
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/pair/2.cc
@@ -0,0 +1,60 @@
+// 2001-06-18  Benjamin Kosnik  <bkoz@redhat.com>
+
+// Copyright (C) 2001, 2004 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.2.2 Pairs
+
+#include <utility>
+#include <testsuite_hooks.h>
+
+class gnu_obj
+{
+  int i;
+public:
+  gnu_obj(int arg = 0): i(arg) { }
+  bool operator==(const gnu_obj& rhs) const { return i == rhs.i; }
+  bool operator<(const gnu_obj& rhs) const { return i < rhs.i; }
+};
+
+template<typename T>
+  struct gnu_t
+  {
+    bool b;
+  public:
+    gnu_t(bool arg = 0): b(arg) { }
+    bool operator==(const gnu_t& rhs) const { return b == rhs.b; }
+    bool operator<(const gnu_t& rhs) const { return int(b) < int(rhs.b); }
+  };
+
+// homogeneous
+void test02()
+{
+  bool test __attribute__((unused)) = true;
+
+  std::pair<bool, bool> p_bb_1(true, false);
+  std::pair<bool, bool> p_bb_2 = std::make_pair(true, false);
+  VERIFY( p_bb_1 == p_bb_2 );
+  VERIFY( !(p_bb_1 < p_bb_2) );
+}
+
+int main() 
+{ 
+  test02();
+  return 0;
+}
diff --git a/libstdc++-v3/testsuite/20_util/pair/3.cc b/libstdc++-v3/testsuite/20_util/pair/3.cc
new file mode 100644
index 00000000000..bac0e7eb974
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/pair/3.cc
@@ -0,0 +1,79 @@
+// 2001-06-18  Benjamin Kosnik  <bkoz@redhat.com>
+
+// Copyright (C) 2001, 2004 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.2.2 Pairs
+
+#include <utility>
+#include <testsuite_hooks.h>
+
+class gnu_obj
+{
+  int i;
+public:
+  gnu_obj(int arg = 0): i(arg) { }
+  bool operator==(const gnu_obj& rhs) const { return i == rhs.i; }
+  bool operator<(const gnu_obj& rhs) const { return i < rhs.i; }
+};
+
+template<typename T>
+  struct gnu_t
+  {
+    bool b;
+  public:
+    gnu_t(bool arg = 0): b(arg) { }
+    bool operator==(const gnu_t& rhs) const { return b == rhs.b; }
+    bool operator<(const gnu_t& rhs) const { return int(b) < int(rhs.b); }
+  };
+
+
+// const
+void test03()
+{
+  bool test __attribute__((unused)) = true;
+
+  const std::pair<bool, long> p_bl_1(true, 433);
+  const std::pair<bool, long> p_bl_2 = std::make_pair(true, 433);
+  VERIFY( p_bl_1 == p_bl_2 );
+  VERIFY( !(p_bl_1 < p_bl_2) );
+
+  const std::pair<const char*, float> p_sf_1("total enlightenment", 433.00);
+  const std::pair<const char*, float> p_sf_2 = 
+    std::make_pair("total enlightenment", 433.00);
+  VERIFY( p_sf_1 == p_sf_2 );
+  VERIFY( !(p_sf_1 < p_sf_2) );
+
+  const std::pair<const char*, gnu_obj> p_sg_1("enlightenment", gnu_obj(5));
+  const std::pair<const char*, gnu_obj> p_sg_2 = 
+    std::make_pair("enlightenment", gnu_obj(5));
+  VERIFY( p_sg_1 == p_sg_2 );
+  VERIFY( !(p_sg_1 < p_sg_2) );
+
+  const std::pair<gnu_t<long>, gnu_obj> p_st_1(gnu_t<long>(false), gnu_obj(5));
+  const std::pair<gnu_t<long>, gnu_obj> p_st_2 = 
+    std::make_pair(gnu_t<long>(false), gnu_obj(5));
+  VERIFY( p_st_1 == p_st_2 );
+  VERIFY( !(p_st_1 < p_st_2) );
+}
+
+int main() 
+{ 
+  test03();
+  return 0;
+}
diff --git a/libstdc++-v3/testsuite/20_util/pair/4.cc b/libstdc++-v3/testsuite/20_util/pair/4.cc
new file mode 100644
index 00000000000..f6a1b5697d7
--- /dev/null
+++ b/libstdc++-v3/testsuite/20_util/pair/4.cc
@@ -0,0 +1,67 @@
+// 2001-06-18  Benjamin Kosnik  <bkoz@redhat.com>
+
+// Copyright (C) 2001, 2004 Free Software Foundation, Inc.
+//
+// This file is part of the GNU ISO C++ Library.  This library is free
+// software; you can redistribute it and/or modify it under the
+// terms of the GNU General Public License as published by the
+// Free Software Foundation; either version 2, or (at your option)
+// any later version.
+
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License along
+// with this library; see the file COPYING.  If not, write to the Free
+// Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+// USA.
+
+// 20.2.2 Pairs
+
+#include <utility>
+#include <testsuite_hooks.h>
+
+class gnu_obj
+{
+  int i;
+public:
+  gnu_obj(int arg = 0): i(arg) { }
+  bool operator==(const gnu_obj& rhs) const { return i == rhs.i; }
+  bool operator<(const gnu_obj& rhs) const { return i < rhs.i; }
+};
+
+template<typename T>
+  struct gnu_t
+  {
+    bool b;
+  public:
+    gnu_t(bool arg = 0): b(arg) { }
+    bool operator==(const gnu_t& rhs) const { return b == rhs.b; }
+    bool operator<(const gnu_t& rhs) const { return int(b) < int(rhs.b); }
+  };
+
+// const&
+void test04()
+{
+  bool test __attribute__((unused)) = true;
+  const gnu_obj& obj1 = gnu_obj(5);
+  const std::pair<const char*, gnu_obj> p_sg_1("enlightenment", obj1);
+  const std::pair<const char*, gnu_obj> p_sg_2 = 
+    std::make_pair("enlightenment", obj1);
+  VERIFY( p_sg_1 == p_sg_2 );
+  VERIFY( !(p_sg_1 < p_sg_2) );
+
+  const gnu_t<long>& tmpl1 = gnu_t<long>(false);
+  const std::pair<gnu_t<long>, gnu_obj> p_st_1(tmpl1, obj1);
+  const std::pair<gnu_t<long>, gnu_obj> p_st_2 = std::make_pair(tmpl1, obj1);
+  VERIFY( p_st_1 == p_st_2 );
+  VERIFY( !(p_st_1 < p_st_2) );
+}
+
+int main() 
+{ 
+  test04();
+  return 0;
+}
diff --git a/zlib/contrib/asm386/gvmat32.asm b/zlib/contrib/asm386/gvmat32.asm
new file mode 100644
index 00000000000..28d527f47f8
--- /dev/null
+++ b/zlib/contrib/asm386/gvmat32.asm
@@ -0,0 +1,559 @@
+;
+; gvmat32.asm -- Asm portion of the optimized longest_match for 32 bits x86
+; Copyright (C) 1995-1996 Jean-loup Gailly and Gilles Vollant.
+; File written by Gilles Vollant, by modifiying the longest_match
+;  from Jean-loup Gailly in deflate.c
+; It need wmask == 0x7fff
+;     (assembly code is faster with a fixed wmask)
+;
+; For Visual C++ 4.2 and ML 6.11c (version in directory \MASM611C of Win95 DDK)
+;   I compile with : "ml /coff /Zi /c gvmat32.asm"
+;
+
+;uInt longest_match_7fff(s, cur_match)
+;    deflate_state *s;
+;    IPos cur_match;                             /* current match */
+
+        NbStack         equ     76
+        cur_match       equ     dword ptr[esp+NbStack-0]
+        str_s           equ     dword ptr[esp+NbStack-4]
+; 5 dword on top (ret,ebp,esi,edi,ebx)
+        adrret          equ     dword ptr[esp+NbStack-8]
+        pushebp         equ     dword ptr[esp+NbStack-12]
+        pushedi         equ     dword ptr[esp+NbStack-16]
+        pushesi         equ     dword ptr[esp+NbStack-20]
+        pushebx         equ     dword ptr[esp+NbStack-24]
+
+        chain_length    equ     dword ptr [esp+NbStack-28]
+        limit           equ     dword ptr [esp+NbStack-32]
+        best_len        equ     dword ptr [esp+NbStack-36]
+        window          equ     dword ptr [esp+NbStack-40]
+        prev            equ     dword ptr [esp+NbStack-44]
+        scan_start      equ      word ptr [esp+NbStack-48]
+        wmask           equ     dword ptr [esp+NbStack-52]
+        match_start_ptr equ     dword ptr [esp+NbStack-56]
+        nice_match      equ     dword ptr [esp+NbStack-60]
+        scan            equ     dword ptr [esp+NbStack-64]
+
+        windowlen       equ     dword ptr [esp+NbStack-68]
+        match_start     equ     dword ptr [esp+NbStack-72]
+        strend          equ     dword ptr [esp+NbStack-76]
+        NbStackAdd      equ     (NbStack-24)
+
+    .386p
+
+    name    gvmatch
+    .MODEL  FLAT
+
+
+
+;  all the +4 offsets are due to the addition of pending_buf_size (in zlib
+;  in the deflate_state structure since the asm code was first written
+;  (if you compile with zlib 1.0.4 or older, remove the +4).
+;  Note : these value are good with a 8 bytes boundary pack structure
+    dep_chain_length    equ     70h+4
+    dep_window          equ     2ch+4
+    dep_strstart        equ     60h+4
+    dep_prev_length     equ     6ch+4
+    dep_nice_match      equ     84h+4
+    dep_w_size          equ     20h+4
+    dep_prev            equ     34h+4
+    dep_w_mask          equ     28h+4
+    dep_good_match      equ     80h+4
+    dep_match_start     equ     64h+4
+    dep_lookahead       equ     68h+4
+
+
+_TEXT                   segment
+
+IFDEF NOUNDERLINE
+                        public  longest_match_7fff
+;                        public  match_init
+ELSE
+                        public  _longest_match_7fff
+;                        public  _match_init
+ENDIF
+
+    MAX_MATCH           equ     258
+    MIN_MATCH           equ     3
+    MIN_LOOKAHEAD       equ     (MAX_MATCH+MIN_MATCH+1)
+
+
+
+IFDEF NOUNDERLINE
+;match_init      proc near
+;                ret
+;match_init      endp
+ELSE
+;_match_init     proc near
+;                ret
+;_match_init     endp
+ENDIF
+
+
+IFDEF NOUNDERLINE
+longest_match_7fff   proc near
+ELSE
+_longest_match_7fff  proc near
+ENDIF
+
+        mov     edx,[esp+4]
+
+
+
+        push    ebp
+        push    edi
+        push    esi
+        push    ebx
+
+        sub     esp,NbStackAdd
+
+; initialize or check the variables used in match.asm.
+        mov     ebp,edx
+
+; chain_length = s->max_chain_length
+; if (prev_length>=good_match) chain_length >>= 2
+        mov     edx,[ebp+dep_chain_length]
+        mov     ebx,[ebp+dep_prev_length]
+        cmp     [ebp+dep_good_match],ebx
+        ja      noshr
+        shr     edx,2
+noshr:
+; we increment chain_length because in the asm, the --chain_lenght is in the beginning of the loop
+        inc     edx
+        mov     edi,[ebp+dep_nice_match]
+        mov     chain_length,edx
+        mov     eax,[ebp+dep_lookahead]
+        cmp     eax,edi
+; if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead;
+        jae     nolookaheadnicematch
+        mov     edi,eax
+nolookaheadnicematch:
+; best_len = s->prev_length
+        mov     best_len,ebx
+
+; window = s->window
+        mov     esi,[ebp+dep_window]
+        mov     ecx,[ebp+dep_strstart]
+        mov     window,esi
+
+        mov     nice_match,edi
+; scan = window + strstart
+        add     esi,ecx
+        mov     scan,esi
+; dx = *window
+        mov     dx,word ptr [esi]
+; bx = *(window+best_len-1)
+        mov     bx,word ptr [esi+ebx-1]
+        add     esi,MAX_MATCH-1
+; scan_start = *scan
+        mov     scan_start,dx
+; strend = scan + MAX_MATCH-1
+        mov     strend,esi
+; bx = scan_end = *(window+best_len-1)
+
+;    IPos limit = s->strstart > (IPos)MAX_DIST(s) ?
+;        s->strstart - (IPos)MAX_DIST(s) : NIL;
+
+        mov     esi,[ebp+dep_w_size]
+        sub     esi,MIN_LOOKAHEAD
+; here esi = MAX_DIST(s)
+        sub     ecx,esi
+        ja      nodist
+        xor     ecx,ecx
+nodist:
+        mov     limit,ecx
+
+; prev = s->prev
+        mov     edx,[ebp+dep_prev]
+        mov     prev,edx
+
+;
+        mov     edx,dword ptr [ebp+dep_match_start]
+        mov     bp,scan_start
+        mov     eax,cur_match
+        mov     match_start,edx
+
+        mov     edx,window
+        mov     edi,edx
+        add     edi,best_len
+        mov     esi,prev
+        dec     edi
+; windowlen = window + best_len -1
+        mov     windowlen,edi
+
+        jmp     beginloop2
+        align   4
+
+; here, in the loop
+;       eax = ax = cur_match
+;       ecx = limit
+;        bx = scan_end
+;        bp = scan_start
+;       edi = windowlen (window + best_len -1)
+;       esi = prev
+
+
+;// here; chain_length <=16
+normalbeg0add16:
+        add     chain_length,16
+        jz      exitloop
+normalbeg0:
+        cmp     word ptr[edi+eax],bx
+        je      normalbeg2noroll
+rcontlabnoroll:
+; cur_match = prev[cur_match & wmask]
+        and     eax,7fffh
+        mov     ax,word ptr[esi+eax*2]
+; if cur_match > limit, go to exitloop
+        cmp     ecx,eax
+        jnb     exitloop
+; if --chain_length != 0, go to exitloop
+        dec     chain_length
+        jnz     normalbeg0
+        jmp     exitloop
+
+normalbeg2noroll:
+; if (scan_start==*(cur_match+window)) goto normalbeg2
+        cmp     bp,word ptr[edx+eax]
+        jne     rcontlabnoroll
+        jmp     normalbeg2
+
+contloop3:
+        mov     edi,windowlen
+
+; cur_match = prev[cur_match & wmask]
+        and     eax,7fffh
+        mov     ax,word ptr[esi+eax*2]
+; if cur_match > limit, go to exitloop
+        cmp     ecx,eax
+jnbexitloopshort1:
+        jnb     exitloop
+; if --chain_length != 0, go to exitloop
+
+
+; begin the main loop
+beginloop2:
+        sub     chain_length,16+1
+; if chain_length <=16, don't use the unrolled loop
+        jna     normalbeg0add16
+
+do16:
+        cmp     word ptr[edi+eax],bx
+        je      normalbeg2dc0
+
+maccn   MACRO   lab
+        and     eax,7fffh
+        mov     ax,word ptr[esi+eax*2]
+        cmp     ecx,eax
+        jnb     exitloop
+        cmp     word ptr[edi+eax],bx
+        je      lab
+        ENDM
+
+rcontloop0:
+        maccn   normalbeg2dc1
+
+rcontloop1:
+        maccn   normalbeg2dc2
+
+rcontloop2:
+        maccn   normalbeg2dc3
+
+rcontloop3:
+        maccn   normalbeg2dc4
+
+rcontloop4:
+        maccn   normalbeg2dc5
+
+rcontloop5:
+        maccn   normalbeg2dc6
+
+rcontloop6:
+        maccn   normalbeg2dc7
+
+rcontloop7:
+        maccn   normalbeg2dc8
+
+rcontloop8:
+        maccn   normalbeg2dc9
+
+rcontloop9:
+        maccn   normalbeg2dc10
+
+rcontloop10:
+        maccn   short normalbeg2dc11
+
+rcontloop11:
+        maccn   short normalbeg2dc12
+
+rcontloop12:
+        maccn   short normalbeg2dc13
+
+rcontloop13:
+        maccn   short normalbeg2dc14
+
+rcontloop14:
+        maccn   short normalbeg2dc15
+
+rcontloop15:
+        and     eax,7fffh
+        mov     ax,word ptr[esi+eax*2]
+        cmp     ecx,eax
+        jnb     exitloop
+
+        sub     chain_length,16
+        ja      do16
+        jmp     normalbeg0add16
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+normbeg MACRO   rcontlab,valsub
+; if we are here, we know that *(match+best_len-1) == scan_end
+        cmp     bp,word ptr[edx+eax]
+; if (match != scan_start) goto rcontlab
+        jne     rcontlab
+; calculate the good chain_length, and we'll compare scan and match string
+        add     chain_length,16-valsub
+        jmp     iseq
+        ENDM
+
+
+normalbeg2dc11:
+        normbeg rcontloop11,11
+
+normalbeg2dc12:
+        normbeg short rcontloop12,12
+
+normalbeg2dc13:
+        normbeg short rcontloop13,13
+
+normalbeg2dc14:
+        normbeg short rcontloop14,14
+
+normalbeg2dc15:
+        normbeg short rcontloop15,15
+
+normalbeg2dc10:
+        normbeg rcontloop10,10
+
+normalbeg2dc9:
+        normbeg rcontloop9,9
+
+normalbeg2dc8:
+        normbeg rcontloop8,8
+
+normalbeg2dc7:
+        normbeg rcontloop7,7
+
+normalbeg2dc6:
+        normbeg rcontloop6,6
+
+normalbeg2dc5:
+        normbeg rcontloop5,5
+
+normalbeg2dc4:
+        normbeg rcontloop4,4
+
+normalbeg2dc3:
+        normbeg rcontloop3,3
+
+normalbeg2dc2:
+        normbeg rcontloop2,2
+
+normalbeg2dc1:
+        normbeg rcontloop1,1
+
+normalbeg2dc0:
+        normbeg rcontloop0,0
+
+
+; we go in normalbeg2 because *(ushf*)(match+best_len-1) == scan_end
+
+normalbeg2:
+        mov     edi,window
+
+        cmp     bp,word ptr[edi+eax]
+        jne     contloop3                   ; if *(ushf*)match != scan_start, continue
+
+iseq:
+; if we are here, we know that *(match+best_len-1) == scan_end
+; and (match == scan_start)
+
+        mov     edi,edx
+        mov     esi,scan                    ; esi = scan
+        add     edi,eax                     ; edi = window + cur_match = match
+
+        mov     edx,[esi+3]                 ; compare manually dword at match+3
+        xor     edx,[edi+3]                 ; and scan +3
+
+        jz      begincompare                ; if equal, go to long compare
+
+; we will determine the unmatch byte and calculate len (in esi)
+        or      dl,dl
+        je      eq1rr
+        mov     esi,3
+        jmp     trfinval
+eq1rr:
+        or      dx,dx
+        je      eq1
+
+        mov     esi,4
+        jmp     trfinval
+eq1:
+        and     edx,0ffffffh
+        jz      eq11
+        mov     esi,5
+        jmp     trfinval
+eq11:
+        mov     esi,6
+        jmp     trfinval
+
+begincompare:
+        ; here we now scan and match begin same
+        add     edi,6
+        add     esi,6
+        mov     ecx,(MAX_MATCH-(2+4))/4     ; scan for at most MAX_MATCH bytes
+        repe    cmpsd                       ; loop until mismatch
+
+        je      trfin                       ; go to trfin if not unmatch
+; we determine the unmatch byte
+        sub     esi,4
+        mov     edx,[edi-4]
+        xor     edx,[esi]
+
+        or      dl,dl
+        jnz     trfin
+        inc     esi
+
+        or      dx,dx
+        jnz     trfin
+        inc     esi
+
+        and     edx,0ffffffh
+        jnz     trfin
+        inc     esi
+
+trfin:
+        sub     esi,scan          ; esi = len
+trfinval:
+; here we have finised compare, and esi contain len of equal string
+        cmp     esi,best_len        ; if len > best_len, go newbestlen
+        ja      short newbestlen
+; now we restore edx, ecx and esi, for the big loop
+        mov     esi,prev
+        mov     ecx,limit
+        mov     edx,window
+        jmp     contloop3
+
+newbestlen:
+        mov     best_len,esi        ; len become best_len
+
+        mov     match_start,eax     ; save new position as match_start
+        cmp     esi,nice_match      ; if best_len >= nice_match, exit
+        jae     exitloop
+        mov     ecx,scan
+        mov     edx,window          ; restore edx=window
+        add     ecx,esi
+        add     esi,edx
+
+        dec     esi
+        mov     windowlen,esi       ; windowlen = window + best_len-1
+        mov     bx,[ecx-1]          ; bx = *(scan+best_len-1) = scan_end
+
+; now we restore ecx and esi, for the big loop :
+        mov     esi,prev
+        mov     ecx,limit
+        jmp     contloop3
+
+exitloop:
+; exit : s->match_start=match_start
+        mov     ebx,match_start
+        mov     ebp,str_s
+        mov     ecx,best_len
+        mov     dword ptr [ebp+dep_match_start],ebx        
+        mov     eax,dword ptr [ebp+dep_lookahead]
+        cmp     ecx,eax
+        ja      minexlo
+        mov     eax,ecx
+minexlo:
+; return min(best_len,s->lookahead)
+        
+; restore stack and register ebx,esi,edi,ebp
+        add     esp,NbStackAdd
+
+        pop     ebx
+        pop     esi
+        pop     edi
+        pop     ebp
+        ret
+InfoAuthor:
+; please don't remove this string !
+; Your are free use gvmat32 in any fre or commercial apps if you don't remove the string in the binary!
+        db     0dh,0ah,"GVMat32 optimised assembly code written 1996-98 by Gilles Vollant",0dh,0ah
+
+
+
+IFDEF NOUNDERLINE
+longest_match_7fff   endp
+ELSE
+_longest_match_7fff  endp
+ENDIF
+
+
+IFDEF NOUNDERLINE
+cpudetect32     proc near
+ELSE
+_cpudetect32    proc near
+ENDIF
+
+
+	pushfd                  ; push original EFLAGS
+	pop     eax             ; get original EFLAGS
+	mov     ecx, eax        ; save original EFLAGS
+	xor     eax, 40000h     ; flip AC bit in EFLAGS
+	push    eax             ; save new EFLAGS value on stack
+	popfd                   ; replace current EFLAGS value
+	pushfd                  ; get new EFLAGS
+	pop     eax             ; store new EFLAGS in EAX
+	xor     eax, ecx        ; can’t toggle AC bit, processor=80386
+	jz      end_cpu_is_386  ; jump if 80386 processor
+	push    ecx
+	popfd                   ; restore AC bit in EFLAGS first
+
+	pushfd
+	pushfd
+	pop     ecx
+			
+	mov     eax, ecx        ; get original EFLAGS
+	xor     eax, 200000h    ; flip ID bit in EFLAGS
+	push    eax             ; save new EFLAGS value on stack
+	popfd                   ; replace current EFLAGS value
+	pushfd                  ; get new EFLAGS
+	pop		eax	            ; store new EFLAGS in EAX
+	popfd                   ; restore original EFLAGS
+	xor		eax, ecx        ; can’t toggle ID bit,
+	je		is_old_486		; processor=old
+
+	mov     eax,1
+	db      0fh,0a2h        ;CPUID   
+
+exitcpudetect:
+	ret
+
+end_cpu_is_386:
+	mov     eax,0300h
+	jmp     exitcpudetect
+
+is_old_486:
+	mov     eax,0400h
+	jmp     exitcpudetect
+
+IFDEF NOUNDERLINE
+cpudetect32     endp
+ELSE
+_cpudetect32    endp
+ENDIF
+
+_TEXT   ends
+end
diff --git a/zlib/contrib/asm386/gvmat32c.c b/zlib/contrib/asm386/gvmat32c.c
new file mode 100644
index 00000000000..d853bb7ce8a
--- /dev/null
+++ b/zlib/contrib/asm386/gvmat32c.c
@@ -0,0 +1,200 @@
+/* gvmat32.c -- C portion of the optimized longest_match for 32 bits x86
+ * Copyright (C) 1995-1996 Jean-loup Gailly and Gilles Vollant.
+ * File written by Gilles Vollant, by modifiying the longest_match
+ *  from Jean-loup Gailly in deflate.c
+ *  it prepare all parameters and call the assembly longest_match_gvasm
+ *  longest_match execute standard C code is wmask != 0x7fff
+ *     (assembly code is faster with a fixed wmask)
+ *
+ */
+
+#include "deflate.h"
+
+#undef FAR
+#include <windows.h>
+
+#ifdef ASMV
+#define NIL 0
+
+#define UNALIGNED_OK
+
+
+/* if your C compiler don't add underline before function name,
+		define ADD_UNDERLINE_ASMFUNC */
+#ifdef ADD_UNDERLINE_ASMFUNC
+#define longest_match_7fff _longest_match_7fff
+#endif
+
+
+
+void match_init()
+{
+}
+
+unsigned long cpudetect32();
+
+uInt longest_match_c(
+    deflate_state *s,
+    IPos cur_match);                             /* current match */
+
+
+uInt longest_match_7fff(
+    deflate_state *s,
+    IPos cur_match);                             /* current match */
+
+uInt longest_match(
+    deflate_state *s,
+    IPos cur_match)                             /* current match */
+{
+	static uInt iIsPPro=2;
+
+    if ((s->w_mask == 0x7fff) && (iIsPPro==0))
+        return longest_match_7fff(s,cur_match);
+
+	if (iIsPPro==2)
+		iIsPPro = (((cpudetect32()/0x100)&0xf)>=6) ? 1 : 0;
+
+	return longest_match_c(s,cur_match);
+}
+
+
+
+uInt longest_match_c(s, cur_match)
+    deflate_state *s;
+    IPos cur_match;                             /* current match */
+{
+    unsigned chain_length = s->max_chain_length;/* max hash chain length */
+    register Bytef *scan = s->window + s->strstart; /* current string */
+    register Bytef *match;                       /* matched string */
+    register int len;                           /* length of current match */
+    int best_len = s->prev_length;              /* best match length so far */
+    int nice_match = s->nice_match;             /* stop if match long enough */
+    IPos limit = s->strstart > (IPos)MAX_DIST(s) ?
+        s->strstart - (IPos)MAX_DIST(s) : NIL;
+    /* Stop when cur_match becomes <= limit. To simplify the code,
+     * we prevent matches with the string of window index 0.
+     */
+    Posf *prev = s->prev;
+    uInt wmask = s->w_mask;
+
+#ifdef UNALIGNED_OK
+    /* Compare two bytes at a time. Note: this is not always beneficial.
+     * Try with and without -DUNALIGNED_OK to check.
+     */
+    register Bytef *strend = s->window + s->strstart + MAX_MATCH - 1;
+    register ush scan_start = *(ushf*)scan;
+    register ush scan_end   = *(ushf*)(scan+best_len-1);
+#else
+    register Bytef *strend = s->window + s->strstart + MAX_MATCH;
+    register Byte scan_end1  = scan[best_len-1];
+    register Byte scan_end   = scan[best_len];
+#endif
+
+    /* The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
+     * It is easy to get rid of this optimization if necessary.
+     */
+    Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever");
+
+    /* Do not waste too much time if we already have a good match: */
+    if (s->prev_length >= s->good_match) {
+        chain_length >>= 2;
+    }
+    /* Do not look for matches beyond the end of the input. This is necessary
+     * to make deflate deterministic.
+     */
+    if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead;
+
+    Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead");
+
+    do {
+        Assert(cur_match < s->strstart, "no future");
+        match = s->window + cur_match;
+
+        /* Skip to next match if the match length cannot increase
+         * or if the match length is less than 2:
+         */
+#if (defined(UNALIGNED_OK) && MAX_MATCH == 258)
+        /* This code assumes sizeof(unsigned short) == 2. Do not use
+         * UNALIGNED_OK if your compiler uses a different size.
+         */
+        if (*(ushf*)(match+best_len-1) != scan_end ||
+            *(ushf*)match != scan_start) continue;
+
+        /* It is not necessary to compare scan[2] and match[2] since they are
+         * always equal when the other bytes match, given that the hash keys
+         * are equal and that HASH_BITS >= 8. Compare 2 bytes at a time at
+         * strstart+3, +5, ... up to strstart+257. We check for insufficient
+         * lookahead only every 4th comparison; the 128th check will be made
+         * at strstart+257. If MAX_MATCH-2 is not a multiple of 8, it is
+         * necessary to put more guard bytes at the end of the window, or
+         * to check more often for insufficient lookahead.
+         */
+        Assert(scan[2] == match[2], "scan[2]?");
+        scan++, match++;
+        do {
+        } while (*(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
+                 *(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
+                 *(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
+                 *(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
+                 scan < strend);
+        /* The funny "do {}" generates better code on most compilers */
+
+        /* Here, scan <= window+strstart+257 */
+        Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan");
+        if (*scan == *match) scan++;
+
+        len = (MAX_MATCH - 1) - (int)(strend-scan);
+        scan = strend - (MAX_MATCH-1);
+
+#else /* UNALIGNED_OK */
+
+        if (match[best_len]   != scan_end  ||
+            match[best_len-1] != scan_end1 ||
+            *match            != *scan     ||
+            *++match          != scan[1])      continue;
+
+        /* The check at best_len-1 can be removed because it will be made
+         * again later. (This heuristic is not always a win.)
+         * It is not necessary to compare scan[2] and match[2] since they
+         * are always equal when the other bytes match, given that
+         * the hash keys are equal and that HASH_BITS >= 8.
+         */
+        scan += 2, match++;
+        Assert(*scan == *match, "match[2]?");
+
+        /* We check for insufficient lookahead only every 8th comparison;
+         * the 256th check will be made at strstart+258.
+         */
+        do {
+        } while (*++scan == *++match && *++scan == *++match &&
+                 *++scan == *++match && *++scan == *++match &&
+                 *++scan == *++match && *++scan == *++match &&
+                 *++scan == *++match && *++scan == *++match &&
+                 scan < strend);
+
+        Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan");
+
+        len = MAX_MATCH - (int)(strend - scan);
+        scan = strend - MAX_MATCH;
+
+#endif /* UNALIGNED_OK */
+
+        if (len > best_len) {
+            s->match_start = cur_match;
+            best_len = len;
+            if (len >= nice_match) break;
+#ifdef UNALIGNED_OK
+            scan_end = *(ushf*)(scan+best_len-1);
+#else
+            scan_end1  = scan[best_len-1];
+            scan_end   = scan[best_len];
+#endif
+        }
+    } while ((cur_match = prev[cur_match & wmask]) > limit
+             && --chain_length != 0);
+
+    if ((uInt)best_len <= s->lookahead) return (uInt)best_len;
+    return s->lookahead;
+}
+
+#endif /* ASMV */
diff --git a/zlib/contrib/asm386/mkgvmt32.bat b/zlib/contrib/asm386/mkgvmt32.bat
new file mode 100644
index 00000000000..6c5ffd7a024
--- /dev/null
+++ b/zlib/contrib/asm386/mkgvmt32.bat
@@ -0,0 +1 @@
+c:\masm611\bin\ml /coff /Zi /c /Flgvmat32.lst gvmat32.asm
diff --git a/zlib/contrib/asm386/zlibvc.def b/zlib/contrib/asm386/zlibvc.def
new file mode 100644
index 00000000000..7e9d60d55d9
--- /dev/null
+++ b/zlib/contrib/asm386/zlibvc.def
@@ -0,0 +1,74 @@
+LIBRARY		"zlib"
+
+DESCRIPTION	'"""zlib data compression library"""'
+
+
+VERSION		1.11
+
+
+HEAPSIZE	1048576,8192
+
+EXPORTS
+    adler32                        @1
+    compress                       @2
+    crc32                          @3
+    deflate                        @4
+    deflateCopy                    @5
+    deflateEnd                     @6
+    deflateInit2_                  @7
+    deflateInit_                   @8
+    deflateParams                  @9
+    deflateReset                   @10
+    deflateSetDictionary           @11
+    gzclose                        @12
+    gzdopen                        @13
+    gzerror                        @14
+    gzflush                        @15
+    gzopen                         @16
+    gzread                         @17
+    gzwrite                        @18
+    inflate                        @19
+    inflateEnd                     @20
+    inflateInit2_                  @21
+    inflateInit_                   @22
+    inflateReset                   @23
+    inflateSetDictionary           @24
+    inflateSync                    @25
+    uncompress                     @26
+    zlibVersion                    @27
+    gzprintf                       @28
+    gzputc                         @29
+    gzgetc                         @30
+    gzseek                         @31
+    gzrewind                       @32
+    gztell                         @33
+    gzeof                          @34
+    gzsetparams                    @35
+    zError                         @36
+    inflateSyncPoint               @37
+    get_crc_table                  @38
+    compress2                      @39
+    gzputs                         @40
+    gzgets                         @41
+
+	unzOpen                       @61
+	unzClose                      @62
+	unzGetGlobalInfo              @63
+	unzGetCurrentFileInfo         @64
+	unzGoToFirstFile              @65
+	unzGoToNextFile               @66
+	unzOpenCurrentFile            @67
+	unzReadCurrentFile            @68
+	unztell                       @70
+	unzeof                        @71
+	unzCloseCurrentFile           @72
+	unzGetGlobalComment           @73
+	unzStringFileNameCompare      @74
+	unzLocateFile                 @75
+	unzGetLocalExtrafield         @76
+
+	zipOpen                       @80
+	zipOpenNewFileInZip           @81
+	zipWriteInFileInZip           @82
+	zipCloseFileInZip             @83
+	zipClose                      @84
diff --git a/zlib/contrib/asm386/zlibvc.dsp b/zlib/contrib/asm386/zlibvc.dsp
new file mode 100644
index 00000000000..a70d4d4a6b0
--- /dev/null
+++ b/zlib/contrib/asm386/zlibvc.dsp
@@ -0,0 +1,651 @@
+# Microsoft Developer Studio Project File - Name="zlibvc" - Package Owner=<4>
+# Microsoft Developer Studio Generated Build File, Format Version 5.00
+# ** DO NOT EDIT **
+
+# TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102
+# TARGTYPE "Win32 (ALPHA) Dynamic-Link Library" 0x0602
+
+CFG=zlibvc - Win32 Release
+!MESSAGE This is not a valid makefile. To build this project using NMAKE,
+!MESSAGE use the Export Makefile command and run
+!MESSAGE 
+!MESSAGE NMAKE /f "zlibvc.mak".
+!MESSAGE 
+!MESSAGE You can specify a configuration when running NMAKE
+!MESSAGE by defining the macro CFG on the command line. For example:
+!MESSAGE 
+!MESSAGE NMAKE /f "zlibvc.mak" CFG="zlibvc - Win32 Release"
+!MESSAGE 
+!MESSAGE Possible choices for configuration are:
+!MESSAGE 
+!MESSAGE "zlibvc - Win32 Release" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "zlibvc - Win32 Debug" (based on "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "zlibvc - Win32 ReleaseAxp" (based on\
+ "Win32 (ALPHA) Dynamic-Link Library")
+!MESSAGE "zlibvc - Win32 ReleaseWithoutAsm" (based on\
+ "Win32 (x86) Dynamic-Link Library")
+!MESSAGE "zlibvc - Win32 ReleaseWithoutCrtdll" (based on\
+ "Win32 (x86) Dynamic-Link Library")
+!MESSAGE 
+
+# Begin Project
+# PROP Scc_ProjName ""
+# PROP Scc_LocalPath ""
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir ".\Release"
+# PROP BASE Intermediate_Dir ".\Release"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir ".\Release"
+# PROP Intermediate_Dir ".\Release"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+CPP=cl.exe
+# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MT /W3 /GX /O2 /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "_WINDLL" /D "_WIN32" /D "BUILD_ZLIBDLL" /D "ZLIB_DLL" /D "DYNAMIC_CRC_TABLE" /D "ASMV" /FAcs /FR /FD /c
+# SUBTRACT CPP /YX
+MTL=midl.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x40c /d "NDEBUG"
+# ADD RSC /l 0x40c /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /machine:I386
+# ADD LINK32 gvmat32.obj kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib crtdll.lib /nologo /subsystem:windows /dll /map /machine:I386 /nodefaultlib /out:".\Release\zlib.dll"
+# SUBTRACT LINK32 /pdb:none
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 1
+# PROP BASE Output_Dir ".\Debug"
+# PROP BASE Intermediate_Dir ".\Debug"
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 1
+# PROP Output_Dir ".\Debug"
+# PROP Intermediate_Dir ".\Debug"
+# PROP Target_Dir ""
+CPP=cl.exe
+# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /YX /c
+# ADD CPP /nologo /MTd /W3 /Gm /GX /Zi /Od /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "_WINDLL" /D "_WIN32" /D "BUILD_ZLIBDLL" /D "ZLIB_DLL" /FD /c
+# SUBTRACT CPP /YX
+MTL=midl.exe
+# ADD BASE MTL /nologo /D "_DEBUG" /win32
+# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x40c /d "_DEBUG"
+# ADD RSC /l 0x40c /d "_DEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /subsystem:windows /dll /debug /machine:I386
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /debug /machine:I386 /out:".\Debug\zlib.dll"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "zlibvc__"
+# PROP BASE Intermediate_Dir "zlibvc__"
+# PROP BASE Ignore_Export_Lib 0
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "zlibvc__"
+# PROP Intermediate_Dir "zlibvc__"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+MTL=midl.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+CPP=cl.exe
+# ADD BASE CPP /nologo /MT /Gt0 /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_WIN32" /D "BUILD_ZLIBDLL" /D "ZLIB_DLL" /D "DYNAMIC_CRC_TABLE" /FAcs /FR /YX /FD /c
+# ADD CPP /nologo /MT /Gt0 /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_WIN32" /D "BUILD_ZLIBDLL" /D "ZLIB_DLL" /D "DYNAMIC_CRC_TABLE" /FAcs /FR /FD /c
+# SUBTRACT CPP /YX
+RSC=rc.exe
+# ADD BASE RSC /l 0x40c /d "NDEBUG"
+# ADD RSC /l 0x40c /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 crtdll.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /map /machine:ALPHA /nodefaultlib /out:".\Release\zlib.dll"
+# SUBTRACT BASE LINK32 /pdb:none
+# ADD LINK32 crtdll.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:windows /dll /map /machine:ALPHA /nodefaultlib /out:"zlibvc__\zlib.dll"
+# SUBTRACT LINK32 /pdb:none
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "zlibvc_0"
+# PROP BASE Intermediate_Dir "zlibvc_0"
+# PROP BASE Ignore_Export_Lib 0
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "zlibvc_0"
+# PROP Intermediate_Dir "zlibvc_0"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+CPP=cl.exe
+# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "_WINDLL" /D "_WIN32" /D "BUILD_ZLIBDLL" /D "ZLIB_DLL" /D "DYNAMIC_CRC_TABLE" /FAcs /FR /YX /FD /c
+# ADD CPP /nologo /MT /W3 /GX /O2 /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "_WINDLL" /D "_WIN32" /D "BUILD_ZLIBDLL" /D "ZLIB_DLL" /D "DYNAMIC_CRC_TABLE" /FAcs /FR /FD /c
+# SUBTRACT CPP /YX
+MTL=midl.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x40c /d "NDEBUG"
+# ADD RSC /l 0x40c /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib crtdll.lib /nologo /subsystem:windows /dll /map /machine:I386 /nodefaultlib /out:".\Release\zlib.dll"
+# SUBTRACT BASE LINK32 /pdb:none
+# ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib crtdll.lib /nologo /subsystem:windows /dll /map /machine:I386 /nodefaultlib /out:".\zlibvc_0\zlib.dll"
+# SUBTRACT LINK32 /pdb:none
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+# PROP BASE Use_MFC 0
+# PROP BASE Use_Debug_Libraries 0
+# PROP BASE Output_Dir "zlibvc_1"
+# PROP BASE Intermediate_Dir "zlibvc_1"
+# PROP BASE Ignore_Export_Lib 0
+# PROP BASE Target_Dir ""
+# PROP Use_MFC 0
+# PROP Use_Debug_Libraries 0
+# PROP Output_Dir "zlibvc_1"
+# PROP Intermediate_Dir "zlibvc_1"
+# PROP Ignore_Export_Lib 0
+# PROP Target_Dir ""
+CPP=cl.exe
+# ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "_WINDLL" /D "_WIN32" /D "BUILD_ZLIBDLL" /D "ZLIB_DLL" /D "DYNAMIC_CRC_TABLE" /D "ASMV" /FAcs /FR /YX /FD /c
+# ADD CPP /nologo /MT /W3 /GX /O2 /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "_WINDLL" /D "_WIN32" /D "BUILD_ZLIBDLL" /D "ZLIB_DLL" /D "DYNAMIC_CRC_TABLE" /D "ASMV" /FAcs /FR /FD /c
+# SUBTRACT CPP /YX
+MTL=midl.exe
+# ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
+RSC=rc.exe
+# ADD BASE RSC /l 0x40c /d "NDEBUG"
+# ADD RSC /l 0x40c /d "NDEBUG"
+BSC32=bscmake.exe
+# ADD BASE BSC32 /nologo
+# ADD BSC32 /nologo
+LINK32=link.exe
+# ADD BASE LINK32 gvmat32.obj kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib crtdll.lib /nologo /subsystem:windows /dll /map /machine:I386 /nodefaultlib /out:".\Release\zlib.dll"
+# SUBTRACT BASE LINK32 /pdb:none
+# ADD LINK32 gvmat32.obj kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib crtdll.lib /nologo /subsystem:windows /dll /map /machine:I386 /nodefaultlib /out:".\zlibvc_1\zlib.dll"
+# SUBTRACT LINK32 /pdb:none
+
+!ENDIF 
+
+# Begin Target
+
+# Name "zlibvc - Win32 Release"
+# Name "zlibvc - Win32 Debug"
+# Name "zlibvc - Win32 ReleaseAxp"
+# Name "zlibvc - Win32 ReleaseWithoutAsm"
+# Name "zlibvc - Win32 ReleaseWithoutCrtdll"
+# Begin Group "Source Files"
+
+# PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;hpj;bat;for;f90"
+# Begin Source File
+
+SOURCE=.\adler32.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+DEP_CPP_ADLER=\
+	".\zconf.h"\
+	".\zlib.h"\
+	
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\compress.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+DEP_CPP_COMPR=\
+	".\zconf.h"\
+	".\zlib.h"\
+	
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\crc32.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+DEP_CPP_CRC32=\
+	".\zconf.h"\
+	".\zlib.h"\
+	
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\deflate.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+DEP_CPP_DEFLA=\
+	".\deflate.h"\
+	".\zconf.h"\
+	".\zlib.h"\
+	".\zutil.h"\
+	
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\gvmat32c.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\gzio.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+DEP_CPP_GZIO_=\
+	".\zconf.h"\
+	".\zlib.h"\
+	".\zutil.h"\
+	
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\infblock.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+DEP_CPP_INFBL=\
+	".\infblock.h"\
+	".\infcodes.h"\
+	".\inftrees.h"\
+	".\infutil.h"\
+	".\zconf.h"\
+	".\zlib.h"\
+	".\zutil.h"\
+	
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\infcodes.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+DEP_CPP_INFCO=\
+	".\infblock.h"\
+	".\infcodes.h"\
+	".\inffast.h"\
+	".\inftrees.h"\
+	".\infutil.h"\
+	".\zconf.h"\
+	".\zlib.h"\
+	".\zutil.h"\
+	
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\inffast.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+DEP_CPP_INFFA=\
+	".\infblock.h"\
+	".\infcodes.h"\
+	".\inffast.h"\
+	".\inftrees.h"\
+	".\infutil.h"\
+	".\zconf.h"\
+	".\zlib.h"\
+	".\zutil.h"\
+	
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\inflate.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+DEP_CPP_INFLA=\
+	".\infblock.h"\
+	".\zconf.h"\
+	".\zlib.h"\
+	".\zutil.h"\
+	
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\inftrees.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+DEP_CPP_INFTR=\
+	".\inftrees.h"\
+	".\zconf.h"\
+	".\zlib.h"\
+	".\zutil.h"\
+	
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\infutil.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+DEP_CPP_INFUT=\
+	".\infblock.h"\
+	".\infcodes.h"\
+	".\inftrees.h"\
+	".\infutil.h"\
+	".\zconf.h"\
+	".\zlib.h"\
+	".\zutil.h"\
+	
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\trees.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+DEP_CPP_TREES=\
+	".\deflate.h"\
+	".\zconf.h"\
+	".\zlib.h"\
+	".\zutil.h"\
+	
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\uncompr.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+DEP_CPP_UNCOM=\
+	".\zconf.h"\
+	".\zlib.h"\
+	
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\unzip.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\zip.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# Begin Source File
+
+SOURCE=.\zlib.rc
+# End Source File
+# Begin Source File
+
+SOURCE=.\zlibvc.def
+# End Source File
+# Begin Source File
+
+SOURCE=.\zutil.c
+
+!IF  "$(CFG)" == "zlibvc - Win32 Release"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 Debug"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseAxp"
+
+DEP_CPP_ZUTIL=\
+	".\zconf.h"\
+	".\zlib.h"\
+	".\zutil.h"\
+	
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutAsm"
+
+!ELSEIF  "$(CFG)" == "zlibvc - Win32 ReleaseWithoutCrtdll"
+
+!ENDIF 
+
+# End Source File
+# End Group
+# Begin Group "Header Files"
+
+# PROP Default_Filter "h;hpp;hxx;hm;inl;fi;fd"
+# Begin Source File
+
+SOURCE=.\deflate.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\infblock.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\infcodes.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\inffast.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\inftrees.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\infutil.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\zconf.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\zlib.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\zutil.h
+# End Source File
+# End Group
+# Begin Group "Resource Files"
+
+# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;cnt;rtf;gif;jpg;jpeg;jpe"
+# End Group
+# End Target
+# End Project
diff --git a/zlib/contrib/asm386/zlibvc.dsw b/zlib/contrib/asm386/zlibvc.dsw
new file mode 100644
index 00000000000..493cd870365
--- /dev/null
+++ b/zlib/contrib/asm386/zlibvc.dsw
@@ -0,0 +1,41 @@
+Microsoft Developer Studio Workspace File, Format Version 5.00
+# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
+
+###############################################################################
+
+Project: "zlibstat"=.\zlibstat.dsp - Package Owner=<4>
+
+Package=<5>
+{{{
+}}}
+
+Package=<4>
+{{{
+}}}
+
+###############################################################################
+
+Project: "zlibvc"=.\zlibvc.dsp - Package Owner=<4>
+
+Package=<5>
+{{{
+}}}
+
+Package=<4>
+{{{
+}}}
+
+###############################################################################
+
+Global:
+
+Package=<5>
+{{{
+}}}
+
+Package=<3>
+{{{
+}}}
+
+###############################################################################
+
diff --git a/zlib/contrib/delphi2/d_zlib.bpr b/zlib/contrib/delphi2/d_zlib.bpr
new file mode 100644
index 00000000000..78bb254088a
--- /dev/null
+++ b/zlib/contrib/delphi2/d_zlib.bpr
@@ -0,0 +1,224 @@
+# ---------------------------------------------------------------------------
+!if !$d(BCB)
+BCB = $(MAKEDIR)\..
+!endif
+
+# ---------------------------------------------------------------------------
+# IDE SECTION
+# ---------------------------------------------------------------------------
+# The following section of the project makefile is managed by the BCB IDE.
+# It is recommended to use the IDE to change any of the values in this
+# section.
+# ---------------------------------------------------------------------------
+
+VERSION = BCB.03
+# ---------------------------------------------------------------------------
+PROJECT = d_zlib.lib
+OBJFILES = d_zlib.obj adler32.obj deflate.obj infblock.obj infcodes.obj inffast.obj \
+  inflate.obj inftrees.obj infutil.obj trees.obj
+RESFILES =
+RESDEPEN = $(RESFILES)
+LIBFILES =
+LIBRARIES = VCL35.lib
+SPARELIBS = VCL35.lib
+DEFFILE =
+PACKAGES = VCLX35.bpi VCL35.bpi VCLDB35.bpi VCLDBX35.bpi ibsmp35.bpi bcbsmp35.bpi \
+  dclocx35.bpi QRPT35.bpi TEEUI35.bpi TEEDB35.bpi TEE35.bpi DSS35.bpi \
+  NMFAST35.bpi INETDB35.bpi INET35.bpi VCLMID35.bpi
+# ---------------------------------------------------------------------------
+PATHCPP = .;
+PATHASM = .;
+PATHPAS = .;
+PATHRC = .;
+DEBUGLIBPATH = $(BCB)\lib\debug
+RELEASELIBPATH = $(BCB)\lib\release
+# ---------------------------------------------------------------------------
+CFLAG1 = -O2 -Ve -d -k- -vi
+CFLAG2 = -I$(BCB)\include;$(BCB)\include\vcl -H=$(BCB)\lib\vcl35.csm
+CFLAG3 = -ff -pr -5
+PFLAGS = -U;$(DEBUGLIBPATH) -I$(BCB)\include;$(BCB)\include\vcl -H -W -$I- -v -JPHN -M
+RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl 
+AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 /zn
+LFLAGS =
+IFLAGS = -g -Gn
+# ---------------------------------------------------------------------------
+ALLOBJ = c0w32.obj $(OBJFILES)
+ALLRES = $(RESFILES)
+ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mt.lib
+# ---------------------------------------------------------------------------
+!!ifdef IDEOPTIONS
+
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1040
+CodePage=1252
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=2
+Item0=$(BCB)\include
+Item1=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=
+
+[Parameters]
+RunParams=
+HostApplication=
+
+!endif
+
+ ---------------------------------------------------------------------------
+# MAKE SECTION
+# ---------------------------------------------------------------------------
+# This section of the project file is not used by the BCB IDE.  It is for
+# the benefit of building from the command-line using the MAKE utility.
+# ---------------------------------------------------------------------------
+
+.autodepend
+# ---------------------------------------------------------------------------
+!if !$d(BCC32)
+BCC32 = bcc32
+!endif
+
+!if !$d(DCC32)
+DCC32 = dcc32
+!endif
+
+!if !$d(TASM32)
+TASM32 = tasm32
+!endif
+
+!if !$d(LINKER)
+LINKER = TLib
+!endif
+
+!if !$d(BRCC32)
+BRCC32 = brcc32
+!endif
+# ---------------------------------------------------------------------------
+!if $d(PATHCPP)
+.PATH.CPP = $(PATHCPP)
+.PATH.C   = $(PATHCPP)
+!endif
+
+!if $d(PATHPAS)
+.PATH.PAS = $(PATHPAS)
+!endif
+
+!if $d(PATHASM)
+.PATH.ASM = $(PATHASM)
+!endif
+
+!if $d(PATHRC)
+.PATH.RC  = $(PATHRC)
+!endif
+# ---------------------------------------------------------------------------
+!ifdef IDEOPTIONS
+
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1040
+CodePage=1252
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=2
+Item0=$(BCB)\include;$(BCB)\include\vcl
+Item1=$(BCB)\include
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=
+
+[Parameters]
+RunParams=
+HostApplication=
+
+!endif
+
+$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE)
+    $(BCB)\BIN\$(LINKER) @&&!
+    $(LFLAGS) $(IFLAGS) +
+    $(ALLOBJ), +
+    $(PROJECT),, +
+    $(ALLLIB), +
+    $(DEFFILE), +
+    $(ALLRES)
+!
+# ---------------------------------------------------------------------------
+.pas.hpp:
+    $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.pas.obj:
+    $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.cpp.obj:
+    $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< }
+
+.c.obj:
+    $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< }
+
+.asm.obj:
+    $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@
+
+.rc.res:
+    $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $<
+# ---------------------------------------------------------------------------
diff --git a/zlib/contrib/delphi2/d_zlib.cpp b/zlib/contrib/delphi2/d_zlib.cpp
new file mode 100644
index 00000000000..f5dea59b762
--- /dev/null
+++ b/zlib/contrib/delphi2/d_zlib.cpp
@@ -0,0 +1,17 @@
+#include <condefs.h>
+#pragma hdrstop
+//---------------------------------------------------------------------------
+USEUNIT("adler32.c");
+USEUNIT("deflate.c");
+USEUNIT("infblock.c");
+USEUNIT("infcodes.c");
+USEUNIT("inffast.c");
+USEUNIT("inflate.c");
+USEUNIT("inftrees.c");
+USEUNIT("infutil.c");
+USEUNIT("trees.c");
+//---------------------------------------------------------------------------
+#define Library
+
+// To add a file to the library use the Project menu 'Add to Project'.
+
diff --git a/zlib/contrib/delphi2/readme.txt b/zlib/contrib/delphi2/readme.txt
new file mode 100644
index 00000000000..cbd31620d87
--- /dev/null
+++ b/zlib/contrib/delphi2/readme.txt
@@ -0,0 +1,17 @@
+These are files used to compile zlib under Borland C++ Builder 3.
+
+zlib.bpg is the main project group that can be loaded in the BCB IDE and
+loads all other *.bpr projects
+
+zlib.bpr is a project used to create a static zlib.lib library with C calling
+convention for functions.
+
+zlib32.bpr creates a zlib32.dll dynamic link library with Windows standard
+calling convention.
+
+d_zlib.bpr creates a set of .obj files with register calling convention.
+These files are used by zlib.pas to create a Delphi unit containing zlib.
+The d_zlib.lib file generated isn't useful and can be deleted.
+
+zlib.cpp, zlib32.cpp and d_zlib.cpp are used by the above projects.
+
diff --git a/zlib/contrib/delphi2/zlib.bpg b/zlib/contrib/delphi2/zlib.bpg
new file mode 100644
index 00000000000..b6c9acdf8c9
--- /dev/null
+++ b/zlib/contrib/delphi2/zlib.bpg
@@ -0,0 +1,26 @@
+#------------------------------------------------------------------------------
+VERSION = BWS.01
+#------------------------------------------------------------------------------
+!ifndef ROOT
+ROOT = $(MAKEDIR)\..
+!endif
+#------------------------------------------------------------------------------
+MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$**
+DCC = $(ROOT)\bin\dcc32.exe $**
+BRCC = $(ROOT)\bin\brcc32.exe $**
+#------------------------------------------------------------------------------
+PROJECTS = zlib zlib32 d_zlib
+#------------------------------------------------------------------------------
+default: $(PROJECTS)
+#------------------------------------------------------------------------------
+
+zlib: zlib.bpr
+  $(MAKE)
+
+zlib32: zlib32.bpr
+  $(MAKE)
+
+d_zlib: d_zlib.bpr
+  $(MAKE)
+
+
diff --git a/zlib/contrib/delphi2/zlib.bpr b/zlib/contrib/delphi2/zlib.bpr
new file mode 100644
index 00000000000..cf3945b2523
--- /dev/null
+++ b/zlib/contrib/delphi2/zlib.bpr
@@ -0,0 +1,225 @@
+# ---------------------------------------------------------------------------
+!if !$d(BCB)
+BCB = $(MAKEDIR)\..
+!endif
+
+# ---------------------------------------------------------------------------
+# IDE SECTION
+# ---------------------------------------------------------------------------
+# The following section of the project makefile is managed by the BCB IDE.
+# It is recommended to use the IDE to change any of the values in this
+# section.
+# ---------------------------------------------------------------------------
+
+VERSION = BCB.03
+# ---------------------------------------------------------------------------
+PROJECT = zlib.lib
+OBJFILES = zlib.obj adler32.obj compress.obj crc32.obj deflate.obj gzio.obj infblock.obj \
+  infcodes.obj inffast.obj inflate.obj inftrees.obj infutil.obj trees.obj \
+  uncompr.obj zutil.obj
+RESFILES =
+RESDEPEN = $(RESFILES)
+LIBFILES =
+LIBRARIES = VCL35.lib
+SPARELIBS = VCL35.lib
+DEFFILE =
+PACKAGES = VCLX35.bpi VCL35.bpi VCLDB35.bpi VCLDBX35.bpi ibsmp35.bpi bcbsmp35.bpi \
+  dclocx35.bpi QRPT35.bpi TEEUI35.bpi TEEDB35.bpi TEE35.bpi DSS35.bpi \
+  NMFAST35.bpi INETDB35.bpi INET35.bpi VCLMID35.bpi
+# ---------------------------------------------------------------------------
+PATHCPP = .;
+PATHASM = .;
+PATHPAS = .;
+PATHRC = .;
+DEBUGLIBPATH = $(BCB)\lib\debug
+RELEASELIBPATH = $(BCB)\lib\release
+# ---------------------------------------------------------------------------
+CFLAG1 = -O2 -Ve -d -k- -vi
+CFLAG2 = -I$(BCB)\include;$(BCB)\include\vcl -H=$(BCB)\lib\vcl35.csm
+CFLAG3 = -ff -5
+PFLAGS = -U;$(DEBUGLIBPATH) -I$(BCB)\include;$(BCB)\include\vcl -H -W -$I- -v -JPHN -M
+RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl 
+AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 /zn
+LFLAGS =
+IFLAGS = -g -Gn
+# ---------------------------------------------------------------------------
+ALLOBJ = c0w32.obj $(OBJFILES)
+ALLRES = $(RESFILES)
+ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mt.lib
+# ---------------------------------------------------------------------------
+!!ifdef IDEOPTIONS
+
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1040
+CodePage=1252
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=2
+Item0=$(BCB)\include
+Item1=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=
+
+[Parameters]
+RunParams=
+HostApplication=
+
+!endif
+
+ ---------------------------------------------------------------------------
+# MAKE SECTION
+# ---------------------------------------------------------------------------
+# This section of the project file is not used by the BCB IDE.  It is for
+# the benefit of building from the command-line using the MAKE utility.
+# ---------------------------------------------------------------------------
+
+.autodepend
+# ---------------------------------------------------------------------------
+!if !$d(BCC32)
+BCC32 = bcc32
+!endif
+
+!if !$d(DCC32)
+DCC32 = dcc32
+!endif
+
+!if !$d(TASM32)
+TASM32 = tasm32
+!endif
+
+!if !$d(LINKER)
+LINKER = TLib
+!endif
+
+!if !$d(BRCC32)
+BRCC32 = brcc32
+!endif
+# ---------------------------------------------------------------------------
+!if $d(PATHCPP)
+.PATH.CPP = $(PATHCPP)
+.PATH.C   = $(PATHCPP)
+!endif
+
+!if $d(PATHPAS)
+.PATH.PAS = $(PATHPAS)
+!endif
+
+!if $d(PATHASM)
+.PATH.ASM = $(PATHASM)
+!endif
+
+!if $d(PATHRC)
+.PATH.RC  = $(PATHRC)
+!endif
+# ---------------------------------------------------------------------------
+!ifdef IDEOPTIONS
+
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1040
+CodePage=1252
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=2
+Item0=$(BCB)\include;$(BCB)\include\vcl
+Item1=$(BCB)\include
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=
+
+[Parameters]
+RunParams=
+HostApplication=
+
+!endif
+
+$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE)
+    $(BCB)\BIN\$(LINKER) @&&!
+    $(LFLAGS) $(IFLAGS) +
+    $(ALLOBJ), +
+    $(PROJECT),, +
+    $(ALLLIB), +
+    $(DEFFILE), +
+    $(ALLRES)
+!
+# ---------------------------------------------------------------------------
+.pas.hpp:
+    $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.pas.obj:
+    $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.cpp.obj:
+    $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< }
+
+.c.obj:
+    $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< }
+
+.asm.obj:
+    $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@
+
+.rc.res:
+    $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $<
+# ---------------------------------------------------------------------------
diff --git a/zlib/contrib/delphi2/zlib.cpp b/zlib/contrib/delphi2/zlib.cpp
new file mode 100644
index 00000000000..bf6953ba198
--- /dev/null
+++ b/zlib/contrib/delphi2/zlib.cpp
@@ -0,0 +1,22 @@
+#include <condefs.h>
+#pragma hdrstop
+//---------------------------------------------------------------------------
+USEUNIT("adler32.c");
+USEUNIT("compress.c");
+USEUNIT("crc32.c");
+USEUNIT("deflate.c");
+USEUNIT("gzio.c");
+USEUNIT("infblock.c");
+USEUNIT("infcodes.c");
+USEUNIT("inffast.c");
+USEUNIT("inflate.c");
+USEUNIT("inftrees.c");
+USEUNIT("infutil.c");
+USEUNIT("trees.c");
+USEUNIT("uncompr.c");
+USEUNIT("zutil.c");
+//---------------------------------------------------------------------------
+#define Library
+
+// To add a file to the library use the Project menu 'Add to Project'.
+
diff --git a/zlib/contrib/delphi2/zlib.pas b/zlib/contrib/delphi2/zlib.pas
new file mode 100644
index 00000000000..10ae4cae256
--- /dev/null
+++ b/zlib/contrib/delphi2/zlib.pas
@@ -0,0 +1,534 @@
+{*******************************************************}
+{                                                       }
+{       Delphi Supplemental Components                  }
+{       ZLIB Data Compression Interface Unit            }
+{                                                       }
+{       Copyright (c) 1997 Borland International        }
+{                                                       }
+{*******************************************************}
+
+{ Modified for zlib 1.1.3 by Davide Moretti <dave@rimini.com }
+
+unit zlib;
+
+interface
+
+uses Sysutils, Classes;
+
+type
+  TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer;
+  TFree = procedure (AppData, Block: Pointer);
+
+  // Internal structure.  Ignore.
+  TZStreamRec = packed record
+    next_in: PChar;       // next input byte
+    avail_in: Integer;    // number of bytes available at next_in
+    total_in: Integer;    // total nb of input bytes read so far
+
+    next_out: PChar;      // next output byte should be put here
+    avail_out: Integer;   // remaining free space at next_out
+    total_out: Integer;   // total nb of bytes output so far
+
+    msg: PChar;           // last error message, NULL if no error
+    internal: Pointer;    // not visible by applications
+
+    zalloc: TAlloc;       // used to allocate the internal state
+    zfree: TFree;         // used to free the internal state
+    AppData: Pointer;     // private data object passed to zalloc and zfree
+
+    data_type: Integer;   //  best guess about the data type: ascii or binary
+    adler: Integer;       // adler32 value of the uncompressed data
+    reserved: Integer;    // reserved for future use
+  end;
+
+  // Abstract ancestor class
+  TCustomZlibStream = class(TStream)
+  private
+    FStrm: TStream;
+    FStrmPos: Integer;
+    FOnProgress: TNotifyEvent;
+    FZRec: TZStreamRec;
+    FBuffer: array [Word] of Char;
+  protected
+    procedure Progress(Sender: TObject); dynamic;
+    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
+    constructor Create(Strm: TStream);
+  end;
+
+{ TCompressionStream compresses data on the fly as data is written to it, and
+  stores the compressed data to another stream.
+
+  TCompressionStream is write-only and strictly sequential. Reading from the
+  stream will raise an exception. Using Seek to move the stream pointer
+  will raise an exception.
+
+  Output data is cached internally, written to the output stream only when
+  the internal output buffer is full.  All pending output data is flushed
+  when the stream is destroyed.
+
+  The Position property returns the number of uncompressed bytes of
+  data that have been written to the stream so far.
+
+  CompressionRate returns the on-the-fly percentage by which the original
+  data has been compressed:  (1 - (CompressedBytes / UncompressedBytes)) * 100
+  If raw data size = 100 and compressed data size = 25, the CompressionRate
+  is 75%
+
+  The OnProgress event is called each time the output buffer is filled and
+  written to the output stream.  This is useful for updating a progress
+  indicator when you are writing a large chunk of data to the compression
+  stream in a single call.}
+
+
+  TCompressionLevel = (clNone, clFastest, clDefault, clMax);
+
+  TCompressionStream = class(TCustomZlibStream)
+  private
+    function GetCompressionRate: Single;
+  public
+    constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream);
+    destructor Destroy; override;
+    function Read(var Buffer; Count: Longint): Longint; override;
+    function Write(const Buffer; Count: Longint): Longint; override;
+    function Seek(Offset: Longint; Origin: Word): Longint; override;
+    property CompressionRate: Single read GetCompressionRate;
+    property OnProgress;
+  end;
+
+{ TDecompressionStream decompresses data on the fly as data is read from it.
+
+  Compressed data comes from a separate source stream.  TDecompressionStream
+  is read-only and unidirectional; you can seek forward in the stream, but not
+  backwards.  The special case of setting the stream position to zero is
+  allowed.  Seeking forward decompresses data until the requested position in
+  the uncompressed data has been reached.  Seeking backwards, seeking relative
+  to the end of the stream, requesting the size of the stream, and writing to
+  the stream will raise an exception.
+
+  The Position property returns the number of bytes of uncompressed data that
+  have been read from the stream so far.
+
+  The OnProgress event is called each time the internal input buffer of
+  compressed data is exhausted and the next block is read from the input stream.
+  This is useful for updating a progress indicator when you are reading a
+  large chunk of data from the decompression stream in a single call.}
+
+  TDecompressionStream = class(TCustomZlibStream)
+  public
+    constructor Create(Source: TStream);
+    destructor Destroy; override;
+    function Read(var Buffer; Count: Longint): Longint; override;
+    function Write(const Buffer; Count: Longint): Longint; override;
+    function Seek(Offset: Longint; Origin: Word): Longint; override;
+    property OnProgress;
+  end;
+
+
+
+{ CompressBuf compresses data, buffer to buffer, in one call.
+   In: InBuf = ptr to compressed data
+       InBytes = number of bytes in InBuf
+  Out: OutBuf = ptr to newly allocated buffer containing decompressed data
+       OutBytes = number of bytes in OutBuf   }
+procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
+                      out OutBuf: Pointer; out OutBytes: Integer);
+
+
+{ DecompressBuf decompresses data, buffer to buffer, in one call.
+   In: InBuf = ptr to compressed data
+       InBytes = number of bytes in InBuf
+       OutEstimate = zero, or est. size of the decompressed data
+  Out: OutBuf = ptr to newly allocated buffer containing decompressed data
+       OutBytes = number of bytes in OutBuf   }
+procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
+ OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
+
+const
+  zlib_version = '1.1.3';
+
+type
+  EZlibError = class(Exception);
+  ECompressionError = class(EZlibError);
+  EDecompressionError = class(EZlibError);
+
+function adler32(adler: Integer; buf: PChar; len: Integer): Integer;
+
+implementation
+
+const
+  Z_NO_FLUSH      = 0;
+  Z_PARTIAL_FLUSH = 1;
+  Z_SYNC_FLUSH    = 2;
+  Z_FULL_FLUSH    = 3;
+  Z_FINISH        = 4;
+
+  Z_OK            = 0;
+  Z_STREAM_END    = 1;
+  Z_NEED_DICT     = 2;
+  Z_ERRNO         = (-1);
+  Z_STREAM_ERROR  = (-2);
+  Z_DATA_ERROR    = (-3);
+  Z_MEM_ERROR     = (-4);
+  Z_BUF_ERROR     = (-5);
+  Z_VERSION_ERROR = (-6);
+
+  Z_NO_COMPRESSION       =   0;
+  Z_BEST_SPEED           =   1;
+  Z_BEST_COMPRESSION     =   9;
+  Z_DEFAULT_COMPRESSION  = (-1);
+
+  Z_FILTERED            = 1;
+  Z_HUFFMAN_ONLY        = 2;
+  Z_DEFAULT_STRATEGY    = 0;
+
+  Z_BINARY   = 0;
+  Z_ASCII    = 1;
+  Z_UNKNOWN  = 2;
+
+  Z_DEFLATED = 8;
+
+  _z_errmsg: array[0..9] of PChar = (
+    'need dictionary',      // Z_NEED_DICT      (2)
+    'stream end',           // Z_STREAM_END     (1)
+    '',                     // Z_OK             (0)
+    'file error',           // Z_ERRNO          (-1)
+    'stream error',         // Z_STREAM_ERROR   (-2)
+    'data error',           // Z_DATA_ERROR     (-3)
+    'insufficient memory',  // Z_MEM_ERROR      (-4)
+    'buffer error',         // Z_BUF_ERROR      (-5)
+    'incompatible version', // Z_VERSION_ERROR  (-6)
+    ''
+  );
+
+{$L deflate.obj}
+{$L inflate.obj}
+{$L inftrees.obj}
+{$L trees.obj}
+{$L adler32.obj}
+{$L infblock.obj}
+{$L infcodes.obj}
+{$L infutil.obj}
+{$L inffast.obj}
+
+procedure _tr_init; external;
+procedure _tr_tally; external;
+procedure _tr_flush_block; external;
+procedure _tr_align; external;
+procedure _tr_stored_block; external;
+function adler32; external;
+procedure inflate_blocks_new; external;
+procedure inflate_blocks; external;
+procedure inflate_blocks_reset; external;
+procedure inflate_blocks_free; external;
+procedure inflate_set_dictionary; external;
+procedure inflate_trees_bits; external;
+procedure inflate_trees_dynamic; external;
+procedure inflate_trees_fixed; external;
+procedure inflate_codes_new; external;
+procedure inflate_codes; external;
+procedure inflate_codes_free; external;
+procedure _inflate_mask; external;
+procedure inflate_flush; external;
+procedure inflate_fast; external;
+
+procedure _memset(P: Pointer; B: Byte; count: Integer);cdecl;
+begin
+  FillChar(P^, count, B);
+end;
+
+procedure _memcpy(dest, source: Pointer; count: Integer);cdecl;
+begin
+  Move(source^, dest^, count);
+end;
+
+
+
+// deflate compresses data
+function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
+  recsize: Integer): Integer; external;
+function deflate(var strm: TZStreamRec; flush: Integer): Integer; external;
+function deflateEnd(var strm: TZStreamRec): Integer; external;
+
+// inflate decompresses data
+function inflateInit_(var strm: TZStreamRec; version: PChar;
+  recsize: Integer): Integer; external;
+function inflate(var strm: TZStreamRec; flush: Integer): Integer; external;
+function inflateEnd(var strm: TZStreamRec): Integer; external;
+function inflateReset(var strm: TZStreamRec): Integer; external;
+
+
+function zcalloc(AppData: Pointer; Items, Size: Integer): Pointer;
+begin
+  GetMem(Result, Items*Size);
+end;
+
+procedure zcfree(AppData, Block: Pointer);
+begin
+  FreeMem(Block);
+end;
+
+function zlibCheck(code: Integer): Integer;
+begin
+  Result := code;
+  if code < 0 then
+    raise EZlibError.Create('error');    //!!
+end;
+
+function CCheck(code: Integer): Integer;
+begin
+  Result := code;
+  if code < 0 then
+    raise ECompressionError.Create('error'); //!!
+end;
+
+function DCheck(code: Integer): Integer;
+begin
+  Result := code;
+  if code < 0 then
+    raise EDecompressionError.Create('error');  //!!
+end;
+
+procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
+                      out OutBuf: Pointer; out OutBytes: Integer);
+var
+  strm: TZStreamRec;
+  P: Pointer;
+begin
+  FillChar(strm, sizeof(strm), 0);
+  OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
+  GetMem(OutBuf, OutBytes);
+  try
+    strm.next_in := InBuf;
+    strm.avail_in := InBytes;
+    strm.next_out := OutBuf;
+    strm.avail_out := OutBytes;
+    CCheck(deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm)));
+    try
+      while CCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do
+      begin
+        P := OutBuf;
+        Inc(OutBytes, 256);
+        ReallocMem(OutBuf, OutBytes);
+        strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
+        strm.avail_out := 256;
+      end;
+    finally
+      CCheck(deflateEnd(strm));
+    end;
+    ReallocMem(OutBuf, strm.total_out);
+    OutBytes := strm.total_out;
+  except
+    FreeMem(OutBuf);
+    raise
+  end;
+end;
+
+
+procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
+  OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
+var
+  strm: TZStreamRec;
+  P: Pointer;
+  BufInc: Integer;
+begin
+  FillChar(strm, sizeof(strm), 0);
+  BufInc := (InBytes + 255) and not 255;
+  if OutEstimate = 0 then
+    OutBytes := BufInc
+  else
+    OutBytes := OutEstimate;
+  GetMem(OutBuf, OutBytes);
+  try
+    strm.next_in := InBuf;
+    strm.avail_in := InBytes;
+    strm.next_out := OutBuf;
+    strm.avail_out := OutBytes;
+    DCheck(inflateInit_(strm, zlib_version, sizeof(strm)));
+    try
+      while DCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END do
+      begin
+        P := OutBuf;
+        Inc(OutBytes, BufInc);
+        ReallocMem(OutBuf, OutBytes);
+        strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
+        strm.avail_out := BufInc;
+      end;
+    finally
+      DCheck(inflateEnd(strm));
+    end;
+    ReallocMem(OutBuf, strm.total_out);
+    OutBytes := strm.total_out;
+  except
+    FreeMem(OutBuf);
+    raise
+  end;
+end;
+
+
+// TCustomZlibStream
+
+constructor TCustomZLibStream.Create(Strm: TStream);
+begin
+  inherited Create;
+  FStrm := Strm;
+  FStrmPos := Strm.Position;
+end;
+
+procedure TCustomZLibStream.Progress(Sender: TObject);
+begin
+  if Assigned(FOnProgress) then FOnProgress(Sender);
+end;
+
+
+// TCompressionStream
+
+constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel;
+  Dest: TStream);
+const
+  Levels: array [TCompressionLevel] of ShortInt =
+    (Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION);
+begin
+  inherited Create(Dest);
+  FZRec.next_out := FBuffer;
+  FZRec.avail_out := sizeof(FBuffer);
+  CCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlib_version, sizeof(FZRec)));
+end;
+
+destructor TCompressionStream.Destroy;
+begin
+  FZRec.next_in := nil;
+  FZRec.avail_in := 0;
+  try
+    if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
+    while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END)
+      and (FZRec.avail_out = 0) do
+    begin
+      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
+      FZRec.next_out := FBuffer;
+      FZRec.avail_out := sizeof(FBuffer);
+    end;
+    if FZRec.avail_out < sizeof(FBuffer) then
+      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out);
+  finally
+    deflateEnd(FZRec);
+  end;
+  inherited Destroy;
+end;
+
+function TCompressionStream.Read(var Buffer; Count: Longint): Longint;
+begin
+  raise ECompressionError.Create('Invalid stream operation');
+end;
+
+function TCompressionStream.Write(const Buffer; Count: Longint): Longint;
+begin
+  FZRec.next_in := @Buffer;
+  FZRec.avail_in := Count;
+  if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
+  while (FZRec.avail_in > 0) do
+  begin
+    CCheck(deflate(FZRec, 0));
+    if FZRec.avail_out = 0 then
+    begin
+      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
+      FZRec.next_out := FBuffer;
+      FZRec.avail_out := sizeof(FBuffer);
+      FStrmPos := FStrm.Position;
+      Progress(Self);
+    end;
+  end;
+  Result := Count;
+end;
+
+function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
+begin
+  if (Offset = 0) and (Origin = soFromCurrent) then
+    Result := FZRec.total_in
+  else
+    raise ECompressionError.Create('Invalid stream operation');
+end;
+
+function TCompressionStream.GetCompressionRate: Single;
+begin
+  if FZRec.total_in = 0 then
+    Result := 0
+  else
+    Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0;
+end;
+
+
+// TDecompressionStream
+
+constructor TDecompressionStream.Create(Source: TStream);
+begin
+  inherited Create(Source);
+  FZRec.next_in := FBuffer;
+  FZRec.avail_in := 0;
+  DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec)));
+end;
+
+destructor TDecompressionStream.Destroy;
+begin
+  inflateEnd(FZRec);
+  inherited Destroy;
+end;
+
+function TDecompressionStream.Read(var Buffer; Count: Longint): Longint;
+begin
+  FZRec.next_out := @Buffer;
+  FZRec.avail_out := Count;
+  if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
+  while (FZRec.avail_out > 0) do
+  begin
+    if FZRec.avail_in = 0 then
+    begin
+      FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer));
+      if FZRec.avail_in = 0 then
+        begin
+          Result := Count - FZRec.avail_out;
+          Exit;
+        end;
+      FZRec.next_in := FBuffer;
+      FStrmPos := FStrm.Position;
+      Progress(Self);
+    end;
+    DCheck(inflate(FZRec, 0));
+  end;
+  Result := Count;
+end;
+
+function TDecompressionStream.Write(const Buffer; Count: Longint): Longint;
+begin
+  raise EDecompressionError.Create('Invalid stream operation');
+end;
+
+function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
+var
+  I: Integer;
+  Buf: array [0..4095] of Char;
+begin
+  if (Offset = 0) and (Origin = soFromBeginning) then
+  begin
+    DCheck(inflateReset(FZRec));
+    FZRec.next_in := FBuffer;
+    FZRec.avail_in := 0;
+    FStrm.Position := 0;
+    FStrmPos := 0;
+  end
+  else if ( (Offset >= 0) and (Origin = soFromCurrent)) or
+          ( ((Offset - FZRec.total_out) > 0) and (Origin = soFromBeginning)) then
+  begin
+    if Origin = soFromBeginning then Dec(Offset, FZRec.total_out);
+    if Offset > 0 then
+    begin
+      for I := 1 to Offset div sizeof(Buf) do
+        ReadBuffer(Buf, sizeof(Buf));
+      ReadBuffer(Buf, Offset mod sizeof(Buf));
+    end;
+  end
+  else
+    raise EDecompressionError.Create('Invalid stream operation');
+  Result := FZRec.total_out;
+end;
+
+end.
diff --git a/zlib/contrib/delphi2/zlib32.bpr b/zlib/contrib/delphi2/zlib32.bpr
new file mode 100644
index 00000000000..cabcec44947
--- /dev/null
+++ b/zlib/contrib/delphi2/zlib32.bpr
@@ -0,0 +1,174 @@
+# ---------------------------------------------------------------------------
+!if !$d(BCB)
+BCB = $(MAKEDIR)\..
+!endif
+
+# ---------------------------------------------------------------------------
+# IDE SECTION
+# ---------------------------------------------------------------------------
+# The following section of the project makefile is managed by the BCB IDE.
+# It is recommended to use the IDE to change any of the values in this
+# section.
+# ---------------------------------------------------------------------------
+
+VERSION = BCB.03
+# ---------------------------------------------------------------------------
+PROJECT = zlib32.dll
+OBJFILES = zlib32.obj adler32.obj compress.obj crc32.obj deflate.obj gzio.obj infblock.obj \
+  infcodes.obj inffast.obj inflate.obj inftrees.obj infutil.obj trees.obj \
+  uncompr.obj zutil.obj
+RESFILES =
+RESDEPEN = $(RESFILES)
+LIBFILES =
+LIBRARIES = 
+SPARELIBS = 
+DEFFILE =
+PACKAGES = VCLX35.bpi VCL35.bpi VCLDB35.bpi VCLDBX35.bpi ibsmp35.bpi bcbsmp35.bpi \
+  dclocx35.bpi QRPT35.bpi TEEUI35.bpi TEEDB35.bpi TEE35.bpi DSS35.bpi \
+  NMFAST35.bpi INETDB35.bpi INET35.bpi VCLMID35.bpi
+# ---------------------------------------------------------------------------
+PATHCPP = .;
+PATHASM = .;
+PATHPAS = .;
+PATHRC = .;
+DEBUGLIBPATH = $(BCB)\lib\debug
+RELEASELIBPATH = $(BCB)\lib\release
+# ---------------------------------------------------------------------------
+CFLAG1 = -WD -O2 -Ve -d -k- -vi -c -tWD
+CFLAG2 = -D_NO_VCL;ZLIB_DLL -I$(BCB)\include
+CFLAG3 = -ff -5
+PFLAGS = -D_NO_VCL;ZLIB_DLL -U$(BCB)\lib;$(RELEASELIBPATH) -I$(BCB)\include -$I- -v \
+  -JPHN -M
+RFLAGS = -D_NO_VCL;ZLIB_DLL -i$(BCB)\include
+AFLAGS = /i$(BCB)\include /d_NO_VCL /dZLIB_DLL /mx /w2 /zn
+LFLAGS = -L$(BCB)\lib;$(RELEASELIBPATH) -aa -Tpd -x -Gi
+IFLAGS = -Gn -g
+# ---------------------------------------------------------------------------
+ALLOBJ = c0d32.obj $(OBJFILES)
+ALLRES = $(RESFILES)
+ALLLIB = $(LIBFILES)  import32.lib cw32mt.lib
+# ---------------------------------------------------------------------------
+!ifdef IDEOPTIONS
+
+[Version Info]
+IncludeVerInfo=0
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=1
+Locale=1040
+CodePage=1252
+
+[Version Info Keys]
+CompanyName=
+FileDescription=DLL (GUI)
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib
+
+[HistoryLists\hlConditionals]
+Count=1
+Item0=_NO_VCL;ZLIB_DLL
+
+[Debugging]
+DebugSourceDirs=
+
+[Parameters]
+RunParams=
+HostApplication=
+
+!endif
+
+# ---------------------------------------------------------------------------
+# MAKE SECTION
+# ---------------------------------------------------------------------------
+# This section of the project file is not used by the BCB IDE.  It is for
+# the benefit of building from the command-line using the MAKE utility.
+# ---------------------------------------------------------------------------
+
+.autodepend
+# ---------------------------------------------------------------------------
+!if !$d(BCC32)
+BCC32 = bcc32
+!endif
+
+!if !$d(DCC32)
+DCC32 = dcc32
+!endif
+
+!if !$d(TASM32)
+TASM32 = tasm32
+!endif
+
+!if !$d(LINKER)
+LINKER = ilink32
+!endif
+
+!if !$d(BRCC32)
+BRCC32 = brcc32
+!endif
+# ---------------------------------------------------------------------------
+!if $d(PATHCPP)
+.PATH.CPP = $(PATHCPP)
+.PATH.C   = $(PATHCPP)
+!endif
+
+!if $d(PATHPAS)
+.PATH.PAS = $(PATHPAS)
+!endif
+
+!if $d(PATHASM)
+.PATH.ASM = $(PATHASM)
+!endif
+
+!if $d(PATHRC)
+.PATH.RC  = $(PATHRC)
+!endif
+# ---------------------------------------------------------------------------
+$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE)
+    $(BCB)\BIN\$(LINKER) @&&!
+    $(LFLAGS) $(IFLAGS) +
+    $(ALLOBJ), +
+    $(PROJECT),, +
+    $(ALLLIB), +
+    $(DEFFILE), +
+    $(ALLRES)
+!
+# ---------------------------------------------------------------------------
+.pas.hpp:
+    $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.pas.obj:
+    $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.cpp.obj:
+    $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< }
+
+.c.obj:
+    $(BCB)\BIN\$(BCC32) $(CFLAG1) $(CFLAG2) $(CFLAG3) -n$(@D) {$< }
+
+.asm.obj:
+    $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@
+
+.rc.res:
+    $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $<
+# ---------------------------------------------------------------------------
diff --git a/zlib/contrib/delphi2/zlib32.cpp b/zlib/contrib/delphi2/zlib32.cpp
new file mode 100644
index 00000000000..7372f6b985f
--- /dev/null
+++ b/zlib/contrib/delphi2/zlib32.cpp
@@ -0,0 +1,42 @@
+
+#include <windows.h>
+#pragma hdrstop
+#include <condefs.h>
+
+
+//---------------------------------------------------------------------------
+//   Important note about DLL memory management in a VCL DLL:
+//
+//
+//
+// If your DLL uses VCL and exports any functions that pass VCL String objects
+// (or structs/classes containing nested Strings) as parameter or function
+// results, you will need to build both your DLL project and any EXE projects
+// that use your DLL with the dynamic RTL (the RTL DLL).  This will change your
+// DLL and its calling EXE's to use BORLNDMM.DLL as their memory manager. In
+// these cases, the file BORLNDMM.DLL should be deployed along with your DLL
+// and the RTL DLL (CP3240MT.DLL). To avoid the requiring BORLNDMM.DLL in
+// these situations, pass string information using "char *" or ShortString
+// parameters and then link with the static RTL.
+//
+//---------------------------------------------------------------------------
+USEUNIT("adler32.c");
+USEUNIT("compress.c");
+USEUNIT("crc32.c");
+USEUNIT("deflate.c");
+USEUNIT("gzio.c");
+USEUNIT("infblock.c");
+USEUNIT("infcodes.c");
+USEUNIT("inffast.c");
+USEUNIT("inflate.c");
+USEUNIT("inftrees.c");
+USEUNIT("infutil.c");
+USEUNIT("trees.c");
+USEUNIT("uncompr.c");
+USEUNIT("zutil.c");
+//---------------------------------------------------------------------------
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+        return 1;
+}
diff --git a/zlib/nt/Makefile.emx b/zlib/nt/Makefile.emx
new file mode 100644
index 00000000000..2d475b1847e
--- /dev/null
+++ b/zlib/nt/Makefile.emx
@@ -0,0 +1,138 @@
+# Makefile for zlib.  Modified for emx/rsxnt by Chr. Spieler, 6/16/98.
+# Copyright (C) 1995-1998 Jean-loup Gailly.
+# For conditions of distribution and use, see copyright notice in zlib.h 
+
+# To compile, or to compile and test, type:
+# 
+#   make -fmakefile.emx;  make test -fmakefile.emx
+# 
+
+CC=gcc -Zwin32
+
+#CFLAGS=-MMD -O
+#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
+#CFLAGS=-MMD -g -DDEBUG
+CFLAGS=-MMD -O3 $(BUTT) -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
+             -Wstrict-prototypes -Wmissing-prototypes
+
+# If cp.exe is available, replace "copy /Y" with "cp -fp" .
+CP=copy /Y
+# If gnu install.exe is available, replace $(CP) with ginstall.
+INSTALL=$(CP)
+# The default value of RM is "rm -f."  If "rm.exe" is found, comment out:
+RM=del
+LDLIBS=-L. -lzlib
+LD=$(CC) -s -o
+LDSHARED=$(CC)
+
+INCL=zlib.h zconf.h
+LIBS=zlib.a
+
+AR=ar rcs
+
+prefix=/usr/local
+exec_prefix = $(prefix)
+
+OBJS = adler32.o compress.o crc32.o gzio.o uncompr.o deflate.o trees.o \
+       zutil.o inflate.o infblock.o inftrees.o infcodes.o infutil.o inffast.o
+
+TEST_OBJS = example.o minigzip.o
+
+all: example.exe minigzip.exe
+
+test: all
+	./example
+	echo hello world | .\minigzip | .\minigzip -d 
+
+%.o : %.c
+	$(CC) $(CFLAGS) -c $< -o $@
+
+zlib.a: $(OBJS)
+	$(AR) $@ $(OBJS)
+
+%.exe : %.o $(LIBS)
+	$(LD) $@ $< $(LDLIBS)
+
+
+.PHONY : clean
+
+clean:
+	$(RM) *.d
+	$(RM) *.o
+	$(RM) *.exe
+	$(RM) zlib.a
+	$(RM) foo.gz
+
+DEPS := $(wildcard *.d)
+ifneq ($(DEPS),)
+include $(DEPS)
+endif
+# Makefile for zlib.  Modified for emx 0.9c by Chr. Spieler, 6/17/98.
+# Copyright (C) 1995-1998 Jean-loup Gailly.
+# For conditions of distribution and use, see copyright notice in zlib.h 
+
+# To compile, or to compile and test, type:
+# 
+#   make -fmakefile.emx;  make test -fmakefile.emx
+# 
+
+CC=gcc
+
+#CFLAGS=-MMD -O
+#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
+#CFLAGS=-MMD -g -DDEBUG
+CFLAGS=-MMD -O3 $(BUTT) -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
+             -Wstrict-prototypes -Wmissing-prototypes
+
+# If cp.exe is available, replace "copy /Y" with "cp -fp" .
+CP=copy /Y
+# If gnu install.exe is available, replace $(CP) with ginstall.
+INSTALL=$(CP)
+# The default value of RM is "rm -f."  If "rm.exe" is found, comment out:
+RM=del
+LDLIBS=-L. -lzlib
+LD=$(CC) -s -o
+LDSHARED=$(CC)
+
+INCL=zlib.h zconf.h
+LIBS=zlib.a
+
+AR=ar rcs
+
+prefix=/usr/local
+exec_prefix = $(prefix)
+
+OBJS = adler32.o compress.o crc32.o gzio.o uncompr.o deflate.o trees.o \
+       zutil.o inflate.o infblock.o inftrees.o infcodes.o infutil.o inffast.o
+
+TEST_OBJS = example.o minigzip.o
+
+all: example.exe minigzip.exe
+
+test: all
+	./example
+	echo hello world | .\minigzip | .\minigzip -d 
+
+%.o : %.c
+	$(CC) $(CFLAGS) -c $< -o $@
+
+zlib.a: $(OBJS)
+	$(AR) $@ $(OBJS)
+
+%.exe : %.o $(LIBS)
+	$(LD) $@ $< $(LDLIBS)
+
+
+.PHONY : clean
+
+clean:
+	$(RM) *.d
+	$(RM) *.o
+	$(RM) *.exe
+	$(RM) zlib.a
+	$(RM) foo.gz
+
+DEPS := $(wildcard *.d)
+ifneq ($(DEPS),)
+include $(DEPS)
+endif
diff --git a/zlib/nt/Makefile.gcc b/zlib/nt/Makefile.gcc
new file mode 100644
index 00000000000..cdd652f2360
--- /dev/null
+++ b/zlib/nt/Makefile.gcc
@@ -0,0 +1,87 @@
+# Makefile for zlib.  Modified for mingw32 by C. Spieler, 6/16/98.
+# (This Makefile is directly derived from Makefile.dj2)
+# Copyright (C) 1995-1998 Jean-loup Gailly.
+# For conditions of distribution and use, see copyright notice in zlib.h 
+
+# To compile, or to compile and test, type:
+# 
+#   make -fmakefile.gcc;  make test -fmakefile.gcc
+# 
+# To install libz.a, zconf.h and zlib.h in the mingw32 directories, type:
+# 
+#    make install -fmakefile.gcc
+# 
+
+CC=gcc
+
+#CFLAGS=-MMD -O
+#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
+#CFLAGS=-MMD -g -DDEBUG
+CFLAGS=-MMD -O3 $(BUTT) -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
+             -Wstrict-prototypes -Wmissing-prototypes
+
+# If cp.exe is available, replace "copy /Y" with "cp -fp" .
+CP=copy /Y
+# If gnu install.exe is available, replace $(CP) with ginstall.
+INSTALL=$(CP)
+# The default value of RM is "rm -f."  If "rm.exe" is found, comment out:
+RM=del
+LDLIBS=-L. -lz
+LD=$(CC) -s -o
+LDSHARED=$(CC)
+
+INCL=zlib.h zconf.h
+LIBS=libz.a
+
+AR=ar rcs
+
+prefix=/usr/local
+exec_prefix = $(prefix)
+
+OBJS = adler32.o compress.o crc32.o gzio.o uncompr.o deflate.o trees.o \
+       zutil.o inflate.o infblock.o inftrees.o infcodes.o infutil.o inffast.o
+
+TEST_OBJS = example.o minigzip.o
+
+all: example.exe minigzip.exe
+
+test: all
+	./example
+	echo hello world | .\minigzip | .\minigzip -d 
+
+%.o : %.c
+	$(CC) $(CFLAGS) -c $< -o $@
+
+libz.a: $(OBJS)
+	$(AR) $@ $(OBJS)
+
+%.exe : %.o $(LIBS)
+	$(LD) $@ $< $(LDLIBS)
+
+# INCLUDE_PATH and LIBRARY_PATH were set for [make] in djgpp.env .
+
+.PHONY : uninstall clean
+
+install: $(INCL) $(LIBS)
+	-@if not exist $(INCLUDE_PATH)\nul mkdir $(INCLUDE_PATH)
+	-@if not exist $(LIBRARY_PATH)\nul mkdir $(LIBRARY_PATH)
+	$(INSTALL) zlib.h $(INCLUDE_PATH)
+	$(INSTALL) zconf.h $(INCLUDE_PATH)
+	$(INSTALL) libz.a $(LIBRARY_PATH)
+
+uninstall:
+	$(RM) $(INCLUDE_PATH)\zlib.h
+	$(RM) $(INCLUDE_PATH)\zconf.h
+	$(RM) $(LIBRARY_PATH)\libz.a
+
+clean:
+	$(RM) *.d
+	$(RM) *.o
+	$(RM) *.exe
+	$(RM) libz.a
+	$(RM) foo.gz
+
+DEPS := $(wildcard *.d)
+ifneq ($(DEPS),)
+include $(DEPS)
+endif
diff --git a/zlib/nt/Makefile.nt b/zlib/nt/Makefile.nt
new file mode 100644
index 00000000000..b250f2ac7d2
--- /dev/null
+++ b/zlib/nt/Makefile.nt
@@ -0,0 +1,88 @@
+# Makefile for zlib
+
+!include <ntwin32.mak>
+
+CC=cl
+LD=link
+CFLAGS=-O -nologo
+LDFLAGS=
+O=.obj
+
+# variables
+OBJ1 = adler32$(O) compress$(O) crc32$(O) gzio$(O) uncompr$(O) deflate$(O) \
+  trees$(O)
+OBJ2 = zutil$(O) inflate$(O) infblock$(O) inftrees$(O) infcodes$(O) \
+  infutil$(O) inffast$(O)
+
+all:  zlib.dll example.exe minigzip.exe
+
+adler32.obj: adler32.c zutil.h zlib.h zconf.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+compress.obj: compress.c zlib.h zconf.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+crc32.obj: crc32.c zutil.h zlib.h zconf.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+gzio.obj: gzio.c zutil.h zlib.h zconf.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+infblock.obj: infblock.c zutil.h zlib.h zconf.h infblock.h inftrees.h\
+   infcodes.h infutil.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+infcodes.obj: infcodes.c zutil.h zlib.h zconf.h inftrees.h infutil.h\
+   infcodes.h inffast.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+inflate.obj: inflate.c zutil.h zlib.h zconf.h infblock.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+infutil.obj: infutil.c zutil.h zlib.h zconf.h inftrees.h infutil.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h infutil.h inffast.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+trees.obj: trees.c deflate.h zutil.h zlib.h zconf.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+uncompr.obj: uncompr.c zlib.h zconf.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+zutil.obj: zutil.c zutil.h zlib.h zconf.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+example.obj: example.c zlib.h zconf.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+minigzip.obj: minigzip.c zlib.h zconf.h
+	$(CC) -c $(cvarsdll) $(CFLAGS) $*.c
+
+zlib.dll: $(OBJ1) $(OBJ2) zlib.dnt
+	link $(dlllflags) -out:$@ -def:zlib.dnt $(OBJ1) $(OBJ2) $(guilibsdll)
+
+zlib.lib: zlib.dll
+
+example.exe: example.obj zlib.lib
+	$(LD) $(LDFLAGS) example.obj zlib.lib
+
+minigzip.exe: minigzip.obj zlib.lib
+	$(LD) $(LDFLAGS) minigzip.obj zlib.lib
+
+test: example.exe minigzip.exe
+	example
+	echo hello world | minigzip | minigzip -d 
+
+clean:
+	del *.obj
+	del *.exe
+	del *.dll
+	del *.lib
diff --git a/zlib/nt/zlib.dnt b/zlib/nt/zlib.dnt
new file mode 100644
index 00000000000..7f9475cfb0e
--- /dev/null
+++ b/zlib/nt/zlib.dnt
@@ -0,0 +1,47 @@
+LIBRARY		zlib.dll
+EXETYPE WINDOWS
+CODE		 PRELOAD MOVEABLE DISCARDABLE
+DATA		 PRELOAD MOVEABLE MULTIPLE
+
+EXPORTS
+    adler32                        @1
+    compress                       @2
+    crc32                          @3
+    deflate                        @4
+    deflateCopy                    @5
+    deflateEnd                     @6
+    deflateInit2_                  @7
+    deflateInit_                   @8
+    deflateParams                  @9
+    deflateReset                   @10
+    deflateSetDictionary           @11
+    gzclose                        @12
+    gzdopen                        @13
+    gzerror                        @14
+    gzflush                        @15
+    gzopen                         @16
+    gzread                         @17
+    gzwrite                        @18
+    inflate                        @19
+    inflateEnd                     @20
+    inflateInit2_                  @21
+    inflateInit_                   @22
+    inflateReset                   @23
+    inflateSetDictionary           @24
+    inflateSync                    @25
+    uncompress                     @26
+    zlibVersion                    @27
+    gzprintf                       @28
+    gzputc                         @29
+    gzgetc                         @30
+    gzseek                         @31
+    gzrewind                       @32
+    gztell                         @33
+    gzeof                          @34
+    gzsetparams                    @35
+    zError                         @36
+    inflateSyncPoint               @37
+    get_crc_table                  @38
+    compress2                      @39
+    gzputs                         @40
+    gzgets                         @41
diff --git a/zlib/os2/Makefile.os2 b/zlib/os2/Makefile.os2
new file mode 100644
index 00000000000..4f569471eca
--- /dev/null
+++ b/zlib/os2/Makefile.os2
@@ -0,0 +1,136 @@
+# Makefile for zlib under OS/2 using GCC (PGCC)
+# For conditions of distribution and use, see copyright notice in zlib.h 
+
+# To compile and test, type:
+#   cp Makefile.os2 ..
+#   cd ..
+#   make -f Makefile.os2 test
+
+# This makefile will build a static library z.lib, a shared library
+# z.dll and a import library zdll.lib. You can use either z.lib or
+# zdll.lib by specifying either -lz or -lzdll on gcc's command line
+
+CC=gcc -Zomf -s
+
+CFLAGS=-O6 -Wall
+#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
+#CFLAGS=-g -DDEBUG
+#CFLAGS=-O3 -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
+#           -Wstrict-prototypes -Wmissing-prototypes
+
+#################### BUG WARNING: #####################
+## infcodes.c hits a bug in pgcc-1.0, so you have to use either
+## -O# where # <= 4 or one of (-fno-ommit-frame-pointer or -fno-force-mem)
+## This bug is reportedly fixed in pgcc >1.0, but this was not tested
+CFLAGS+=-fno-force-mem
+
+LDFLAGS=-s -L. -lzdll -Zcrtdll
+LDSHARED=$(CC) -s -Zomf -Zdll -Zcrtdll
+
+VER=1.1.0
+ZLIB=z.lib
+SHAREDLIB=z.dll
+SHAREDLIBIMP=zdll.lib
+LIBS=$(ZLIB) $(SHAREDLIB) $(SHAREDLIBIMP)
+
+AR=emxomfar cr
+IMPLIB=emximp
+RANLIB=echo
+TAR=tar
+SHELL=bash
+
+prefix=/usr/local
+exec_prefix = $(prefix)
+
+OBJS = adler32.o compress.o crc32.o gzio.o uncompr.o deflate.o trees.o \
+       zutil.o inflate.o infblock.o inftrees.o infcodes.o infutil.o inffast.o
+
+TEST_OBJS = example.o minigzip.o
+
+DISTFILES = README INDEX ChangeLog configure Make*[a-z0-9] *.[ch] descrip.mms \
+  algorithm.txt zlib.3 msdos/Make*[a-z0-9] msdos/zlib.def msdos/zlib.rc \
+  nt/Makefile.nt nt/zlib.dnt  contrib/README.contrib contrib/*.txt \
+  contrib/asm386/*.asm contrib/asm386/*.c \
+  contrib/asm386/*.bat contrib/asm386/zlibvc.d?? contrib/iostream/*.cpp \
+  contrib/iostream/*.h  contrib/iostream2/*.h contrib/iostream2/*.cpp \
+  contrib/untgz/Makefile contrib/untgz/*.c contrib/untgz/*.w32
+
+all: example.exe minigzip.exe
+
+test: all
+	@LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ; export LD_LIBRARY_PATH; \
+	echo hello world | ./minigzip | ./minigzip -d || \
+	  echo '		*** minigzip test FAILED ***' ; \
+	if ./example; then \
+	  echo '		*** zlib test OK ***'; \
+	else \
+	  echo '		*** zlib test FAILED ***'; \
+	fi
+
+$(ZLIB): $(OBJS)
+	$(AR) $@ $(OBJS)
+	-@ ($(RANLIB) $@ || true) >/dev/null 2>&1
+
+$(SHAREDLIB): $(OBJS) os2/z.def
+	$(LDSHARED) -o $@ $^
+
+$(SHAREDLIBIMP): os2/z.def
+	$(IMPLIB) -o $@ $^
+
+example.exe: example.o $(LIBS)
+	$(CC) $(CFLAGS) -o $@ example.o $(LDFLAGS)
+
+minigzip.exe: minigzip.o $(LIBS)
+	$(CC) $(CFLAGS) -o $@ minigzip.o $(LDFLAGS)
+
+clean:
+	rm -f *.o *~ example minigzip libz.a libz.so* foo.gz
+
+distclean:	clean
+
+zip:
+	mv Makefile Makefile~; cp -p Makefile.in Makefile
+	rm -f test.c ztest*.c
+	v=`sed -n -e 's/\.//g' -e '/VERSION "/s/.*"\(.*\)".*/\1/p' < zlib.h`;\
+	zip -ul9 zlib$$v $(DISTFILES)
+	mv Makefile~ Makefile
+
+dist:
+	mv Makefile Makefile~; cp -p Makefile.in Makefile
+	rm -f test.c ztest*.c
+	d=zlib-`sed -n '/VERSION "/s/.*"\(.*\)".*/\1/p' < zlib.h`;\
+	rm -f $$d.tar.gz; \
+	if test ! -d ../$$d; then rm -f ../$$d; ln -s `pwd` ../$$d; fi; \
+	files=""; \
+	for f in $(DISTFILES); do files="$$files $$d/$$f"; done; \
+	cd ..; \
+	GZIP=-9 $(TAR) chofz $$d/$$d.tar.gz $$files; \
+	if test ! -d $$d; then rm -f $$d; fi
+	mv Makefile~ Makefile
+
+tags:	
+	etags *.[ch]
+
+depend:
+	makedepend -- $(CFLAGS) -- *.[ch]
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
+
+adler32.o: zlib.h zconf.h
+compress.o: zlib.h zconf.h
+crc32.o: zlib.h zconf.h
+deflate.o: deflate.h zutil.h zlib.h zconf.h
+example.o: zlib.h zconf.h
+gzio.o: zutil.h zlib.h zconf.h
+infblock.o: infblock.h inftrees.h infcodes.h infutil.h zutil.h zlib.h zconf.h
+infcodes.o: zutil.h zlib.h zconf.h
+infcodes.o: inftrees.h infblock.h infcodes.h infutil.h inffast.h
+inffast.o: zutil.h zlib.h zconf.h inftrees.h
+inffast.o: infblock.h infcodes.h infutil.h inffast.h
+inflate.o: zutil.h zlib.h zconf.h infblock.h
+inftrees.o: zutil.h zlib.h zconf.h inftrees.h
+infutil.o: zutil.h zlib.h zconf.h infblock.h inftrees.h infcodes.h infutil.h
+minigzip.o:  zlib.h zconf.h 
+trees.o: deflate.h zutil.h zlib.h zconf.h trees.h
+uncompr.o: zlib.h zconf.h
+zutil.o: zutil.h zlib.h zconf.h  
diff --git a/zlib/os2/zlib.def b/zlib/os2/zlib.def
new file mode 100644
index 00000000000..4c753f1a3b9
--- /dev/null
+++ b/zlib/os2/zlib.def
@@ -0,0 +1,51 @@
+;
+; Slightly modified version of ../nt/zlib.dnt :-)
+;
+
+LIBRARY		Z
+DESCRIPTION	"Zlib compression library for OS/2"
+CODE		PRELOAD MOVEABLE DISCARDABLE
+DATA		PRELOAD MOVEABLE MULTIPLE
+
+EXPORTS
+    adler32
+    compress
+    crc32
+    deflate
+    deflateCopy
+    deflateEnd
+    deflateInit2_
+    deflateInit_
+    deflateParams
+    deflateReset
+    deflateSetDictionary
+    gzclose
+    gzdopen
+    gzerror
+    gzflush
+    gzopen
+    gzread
+    gzwrite
+    inflate
+    inflateEnd
+    inflateInit2_
+    inflateInit_
+    inflateReset
+    inflateSetDictionary
+    inflateSync
+    uncompress
+    zlibVersion
+    gzprintf
+    gzputc
+    gzgetc
+    gzseek
+    gzrewind
+    gztell
+    gzeof
+    gzsetparams
+    zError
+    inflateSyncPoint
+    get_crc_table
+    compress2
+    gzputs
+    gzgets