osprey/be/com/wn_fio.cxx

Go to the documentation of this file.

/*
 * Copyright (C) 2006, 2007. QLogic Corporation. All Rights Reserved.
 */
/*
 * Copyright 2003, 2004, 2005, 2006 PathScale, Inc.  All Rights Reserved.
 */

/*

  Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.

  This program is free software; you can redistribute it and/or modify it
  under the terms of version 2 of the GNU General Public License as
  published by the Free Software Foundation.

  This program is distributed in the hope that it would be useful, but
  WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  

  Further, this software is distributed without any warranty that it is
  free of the rightful claim of any third person regarding infringement 
  or the like.  Any license provided herein, whether implied or 
  otherwise, applies only to this software file.  Patent licenses, if 
  any, provided herein do not apply to combinations of this program with 
  other software, or any other product whatsoever.  

  You should have received a copy of the GNU General Public License along
  with this program; if not, write the Free Software Foundation, Inc., 59
  Temple Place - Suite 330, Boston MA 02111-1307, USA.

  Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
  Mountain View, CA 94043, or:

  http://www.sgi.com

  For further information regarding this notice, see:

  http://oss.sgi.com/projects/GenInfo/NoticeExplan

*/



#define __STDC_LIMIT_MACROS
#include <stdint.h>
#ifdef USE_PCH
#include "be_com_pch.h"
#endif /* USE_PCH */
#pragma hdrstop
#if defined(BUILD_OS_DARWIN)
#include <limits.h>
#else /* defined(BUILD_OS_DARWIN) */
#include <values.h>
#endif /* defined(BUILD_OS_DARWIN) */
#include <isam.h>
#include "defs.h"
#include "strtab.h"
#include "stab.h"
#include "wn.h"
#include "wn_util.h"
#include "wio.h"
#include "config.h"
#include "targ_sim.h"
#include "targ_const.h"
#include "targ_const_private.h"
#include "const.h"
#include "flags.h"
#include "wn_lower.h"
#include "srcpos.h"
#include "stblock.h"
#include "be_symtab.h"
#include <isam.h>
#include <wn_fio.h>
#include "opt_points_to.h"
#include "fb_whirl.h"

#define STACK_LENGTH 25
#define DIM_OFFSET 56
#define DIM_SZ 24

#define GLOBAL_LEVEL 1
#define HOST_LEVEL GLOBAL_LEVEL + 1
#define INTERNAL_LEVEL HOST_LEVEL + 1


/* for use with the implied-do loop nesting type */
#define NO_NESTING  0
#define NESTED_DOPE 1 /* items inside an implied-do entry .  These
        ** need to be turned into dope vector
        ** when appropriate */
#define NESTED_ITEM 2 /* I/O list items inside a do loop generated
        ** for an implied-do loop */

#define FIRST_CALL(x) (x & 2)
#define LAST_CALL(x)  (x & 1)
static OPCODE opc_lda;
static OPCODE opc_const;
static INT32  fcd_size;
static ST *stack_st = NULL;
static TY_IDX stack_ty = (TY_IDX) 0;
static ST *cilist_st = NULL;
static WN *cr_iostat1 = NULL;
static WN *cr_iostat2 = NULL;
static WN *copyout_block = NULL;
#define MAX_NESTED_IMPL 50
static ST *impl_idx[MAX_NESTED_IMPL];
static INT32 num_impl;
static INT32 first_last;


typedef struct impdo_info IMPDO_INFO;
struct impdo_info {
   ST *index;
   struct impdo_info *next;
};
struct marked_set {
   ST *st;
   struct marked_set *next;
};
typedef struct marked_set MARKED_SET;
static MARKED_SET *marked_set;

#define Impdo_index(x) ((x)->index)
#define Impdo_next(x) ((x)->next)
#define Marked_st(x) ((x)->st)
#define Marked_next(x) ((x)->next)
#define WNOPR(w) (WN_operator(w))
static BOOL cwh_io_analyse_io_item(WN *tree, IMPDO_INFO *impdo_set, INT32 mode);
static BOOL cwh_io_analyse_expr(WN *tree, IMPDO_INFO *impdo_set, INT32 mode);
static BOOL cwh_io_analyse_arr(WN *tree, IMPDO_INFO *impdo_set, INT32 mode);
static INT32 cwh_io_analyse_index_expr(WN *tree, IMPDO_INFO *impdo_set, INT32 mode);
static void cwh_stab_free_auxst(void);
static INT32 member(ST *st, IMPDO_INFO *impdo_set);
static INT32 cwh_io_search_implied_do_index(WN *tree, IMPDO_INFO *impdo_set);
static WN * Substitute_1_For_Impdo_Index_Val(WN *tree, IMPDO_INFO *impdo);
static void cwh_io_unmark(void);
static void cwh_io_add_st_to_marked_set(ST *st);
static BOOL OPCODE_has_aux(const OPCODE opc);
static INT32 local_sequence; /* to distinguish different structs with same name */
static char seq_buff[10];
static IOLIB current_io_library;


#define MAX_DIM   7
static TY_IDX dope_vector_ty[ MAX_DIM+1 ];

typedef enum {

  FIOOPER_NONE = 0,
  FIOOPER_FIRST = 1,

    /* F77 external I/O operations. */

    FIO_EXT_READ_FORMAT_start   = 1,
    FIO_EXT_READ_UNFORMAT_start = 2,
    FIO_EXT_READ_LIST_start     = 3,
    FIO_EXT_READ_NAMELIST_start = 4,

    FIO_EXT_WRITE_FORMAT_start   = 5,
    FIO_EXT_WRITE_UNFORMAT_start = 6,
    FIO_EXT_WRITE_LIST_start     = 7,
    FIO_EXT_WRITE_NAMELIST_start = 8,

    FIO_EXT_REWRITE_FORMAT_start   = 9,
    FIO_EXT_REWRITE_UNFORMAT_start = 10,
    FIO_EXT_REWRITE_LIST_start     = 11,

    FIO_EXT_READ_FORMAT_end   = 12,
    FIO_EXT_READ_UNFORMAT_end = 13,
    FIO_EXT_READ_LIST_end     = 14,

    FIO_EXT_WRITE_FORMAT_end   = 15,
    FIO_EXT_WRITE_UNFORMAT_end = 16,
    FIO_EXT_WRITE_LIST_end     = 17,

    FIO_EXT_REWRITE_FORMAT_end   = 18,
    FIO_EXT_REWRITE_UNFORMAT_end = 19,
    FIO_EXT_REWRITE_LIST_end     = 20,

    /* F77 internal I/O operations. */

    FIO_INT_READ_FORMAT_start = 21,
    FIO_INT_READ_LIST_start   = 22,

    FIO_INT_WRITE_FORMAT_start = 23,
    FIO_INT_WRITE_LIST_start   = 24,

    FIO_INT_READ_FORMAT_end = 25,
    FIO_INT_READ_LIST_end   = 26,

    FIO_INT_WRITE_FORMAT_end = 27,
    FIO_INT_WRITE_LIST_end   = 28,

    /* F77 direct I/O operations. */

    FIO_DIR_READ_FORMAT_start   = 29,
    FIO_DIR_READ_UNFORMAT_start = 30,

    FIO_DIR_WRITE_FORMAT_start   = 31,
    FIO_DIR_WRITE_UNFORMAT_start = 32,

    FIO_DIR_READ_FORMAT_end   = 33,
    FIO_DIR_READ_UNFORMAT_end = 34,

    FIO_DIR_WRITE_FORMAT_end   = 35,
    FIO_DIR_WRITE_UNFORMAT_end = 36,

    /* F77 file transfer operations */

    FIO_FORMAT_ADDR4_item  = 37,
    FIO_FORMAT_ADDR8_item  = 38,
    FIO_FORMAT_CHAR_item   = 39,
    FIO_FORMAT_I1_item     = 40,
    FIO_FORMAT_I2_item     = 41,
    FIO_FORMAT_I4_item     = 42,
    FIO_FORMAT_I8_item     = 43,
    FIO_FORMAT_L1_item     = 44,
    FIO_FORMAT_L2_item     = 45,
    FIO_FORMAT_L4_item     = 46,
    FIO_FORMAT_L8_item     = 47,
    FIO_FORMAT_R4_item     = 48,
    FIO_FORMAT_R8_item     = 49,
    FIO_FORMAT_R16_item    = 50,
    FIO_FORMAT_C4_item     = 51,
    FIO_FORMAT_C8_item     = 52,
    FIO_FORMAT_C16_item    = 53,

    FIO_FORMAT_ADDR4_value = 54,
    FIO_FORMAT_ADDR8_value = 55,
    FIO_FORMAT_CHAR_value  = 56,
    FIO_FORMAT_I1_value    = 57,
    FIO_FORMAT_I2_value    = 58,
    FIO_FORMAT_I4_value    = 59,
    FIO_FORMAT_I8_value    = 60,
    FIO_FORMAT_L1_value    = 61,
    FIO_FORMAT_L2_value    = 62,
    FIO_FORMAT_L4_value    = 63,
    FIO_FORMAT_L8_value    = 64,
    FIO_FORMAT_R4_value    = 65,
    FIO_FORMAT_R8_value    = 66,
    FIO_FORMAT_R16_value   = 67,
    FIO_FORMAT_C4_value    = 68,
    FIO_FORMAT_C8_value    = 69,
    FIO_FORMAT_C16_value   = 70,

    FIO_UNFORMAT_ADDR4_item  = 71,
    FIO_UNFORMAT_ADDR8_item  = 72,
    FIO_UNFORMAT_CHAR_item   = 73,
    FIO_UNFORMAT_I1_item     = 74,
    FIO_UNFORMAT_I2_item     = 75,
    FIO_UNFORMAT_I4_item     = 76,
    FIO_UNFORMAT_I8_item     = 77,
    FIO_UNFORMAT_L1_item     = 78,
    FIO_UNFORMAT_L2_item     = 79,
    FIO_UNFORMAT_L4_item     = 80,
    FIO_UNFORMAT_L8_item     = 81,
    FIO_UNFORMAT_R4_item     = 82,
    FIO_UNFORMAT_R8_item     = 83,
    FIO_UNFORMAT_R16_item    = 84,
    FIO_UNFORMAT_C4_item     = 85,
    FIO_UNFORMAT_C8_item     = 86,
    FIO_UNFORMAT_C16_item    = 87,

    FIO_UNFORMAT_ADDR4_value = 88,
    FIO_UNFORMAT_ADDR8_value = 89,
    FIO_UNFORMAT_CHAR_value  = 90,
    FIO_UNFORMAT_I1_value    = 91,
    FIO_UNFORMAT_I2_value    = 92,
    FIO_UNFORMAT_I4_value    = 93,
    FIO_UNFORMAT_I8_value    = 94,
    FIO_UNFORMAT_L1_value    = 95,
    FIO_UNFORMAT_L2_value    = 96,
    FIO_UNFORMAT_L4_value    = 97,
    FIO_UNFORMAT_L8_value    = 98,
    FIO_UNFORMAT_R4_value    = 99,
    FIO_UNFORMAT_R8_value    = 100,
    FIO_UNFORMAT_R16_value   = 101,
    FIO_UNFORMAT_C4_value    = 102,
    FIO_UNFORMAT_C8_value    = 103,
    FIO_UNFORMAT_C16_value   = 104,

    FIO_LIST_ADDR4_item  = 105,
    FIO_LIST_ADDR8_item  = 106,
    FIO_LIST_CHAR_item   = 107,
    FIO_LIST_I1_item     = 108,
    FIO_LIST_I2_item     = 109,
    FIO_LIST_I4_item     = 110,
    FIO_LIST_I8_item     = 111,
    FIO_LIST_L1_item     = 112,
    FIO_LIST_L2_item     = 113,
    FIO_LIST_L4_item     = 114,
    FIO_LIST_L8_item     = 115,
    FIO_LIST_R4_item     = 116,
    FIO_LIST_R8_item     = 117,
    FIO_LIST_R16_item    = 118,
    FIO_LIST_C4_item     = 119,
    FIO_LIST_C8_item     = 120,
    FIO_LIST_C16_item    = 121,

    FIO_LIST_ADDR4_value = 122,
    FIO_LIST_ADDR8_value = 123,
    FIO_LIST_CHAR_value  = 124,
    FIO_LIST_I1_value    = 125,
    FIO_LIST_I2_value    = 126,
    FIO_LIST_I4_value    = 127,
    FIO_LIST_I8_value    = 128,
    FIO_LIST_L1_value    = 129,
    FIO_LIST_L2_value    = 130,
    FIO_LIST_L4_value    = 131,
    FIO_LIST_L8_value    = 132,
    FIO_LIST_R4_value    = 133,
    FIO_LIST_R8_value    = 134,
    FIO_LIST_R16_value   = 135,
    FIO_LIST_C4_value    = 136,
    FIO_LIST_C8_value    = 137,
    FIO_LIST_C16_value   = 138,

    /* F77 other I/O operations. */

    FIO_BACKSPACE = 139,
    FIO_CLOSE     = 140,
    FIO_DELETE    = 141,
    FIO_ENDFILE   = 142,
    FIO_FIND      = 143,
    FIO_INQUIRE   = 144,
    FIO_OPEN      = 145,
    FIO_REWIND    = 146,
    FIO_UNLOCK    = 147,
    FIO_DEFINEFILE = 148,

    /* CRAY Library IO Operations */
    FIO_CR_READ_UNFORMATTED = 149,
    FIO_CR_WRITE_UNFORMATTED = 150,
    FIO_CR_READ_FORMATTED = 151,
    FIO_CR_WRITE_FORMATTED = 152,
    FIO_CR_READ_NAMELIST = 153,
    FIO_CR_WRITE_NAMELIST = 154,
    FIO_INQLENGTH = 155,
    FIO_CR_OPEN = 156,
    FIO_CR_CLOSE = 157,
    FIO_CR_ENDFILE = 158,
    FIO_CR_REWIND = 159,
    FIO_CR_INQUIRE = 160,
    FIO_CR_BACKSPACE = 161,
    FIO_CR_BUFFERIN = 162,
    FIO_CR_BUFFEROUT = 163,

  FIOOPER_LAST = 164

} FIOOPER;

typedef enum {

  FIOITEMTYPE_NONE = 0,
  FIOITEMTYPE_FIRST = 1,

    FIT_ADDRESS4  = 1,
    FIT_ADDRESS8  = 2,
    FIT_CHARACTER = 3,
    FIT_INTEGER1  = 4,
    FIT_INTEGER2  = 5,
    FIT_INTEGER4  = 6,
    FIT_INTEGER8  = 7,
    FIT_LOGICAL1  = 8,
    FIT_LOGICAL2  = 9,
    FIT_LOGICAL4  = 10,
    FIT_LOGICAL8  = 11,
    FIT_REAL4     = 12,
    FIT_REAL8     = 13,
    FIT_REAL16    = 14,
    FIT_COMPLEX4  = 15,
    FIT_COMPLEX8  = 16,
    FIT_COMPLEX16 = 17,
    FIT_RECORD    = 18,

  FIOITEMTYPE_LAST = 18

} FIOITEMTYPE;

typedef enum {

  FIOFORMATTYPE_NONE = 0,
  FIOFORMATTYPE_FIRST = 1,

    FFT_FORMAT   = 1,
    FFT_UNFORMAT = 2,
    FFT_LIST     = 3,

  FIOFORMATTYPE_LAST = 3

} FIOFORMATTYPE;

typedef enum {

  FIOSTRUCTID_NONE = 0,
  FIOSTRUCTID_FIRST = 1,

    FID_CILIST = 1,
    FID_ICILIST = 2,
    FID_OLIST = 3,
    FID_FLIST = 4,
    FID_INLIST = 5,
    FID_ALIST = 6,
    FID_CLLIST = 7,
    FID_KEYSPEC = 8,

    FID_CRAY_CLIST = 9,
    FID_CRAY_FCD = 10,
    FID_CRAY_IOLIST = 11,
    FID_CRAY_OPENLIST = 12,
    FID_CRAY_CLOSELIST = 13,
    FID_CRAY_INQLIST = 14,
    FID_CRAY_DOPEVEC = 15,
    FID_IOSCALAR_ENTRY = 16,
    FID_IOARRAY_ENTRY = 17,
    FID_IOIMPLIEDDO_ENTRY = 18,

  FIOSTRUCTID_LAST = 18

} FIOSTRUCTID;

#define FIM_EXIST 0
#define FIM_OPENED 2
#define FIM_NUMBER 4
#define FIM_NAMED 6
#define FIM_RECL 8
#define FIM_NEXTREC 10
#define FIM_ASSOCIATEVARIABLE 12

typedef enum {

  FIOSTRUCT_NONE = 0,
  FIOSTRUCT_FIRST = 1,

    /* F77 cilist structure fields. */

    FSC_CIERR = 1,
    FSC_CIUNIT = 2,
    FSC_CIEND = 3,
    FSC_CIFMT = 4,
    FSC_CIREC = 5,
    FSC_CIMATCH = 6,
    FSC_CIKEYTYPE = 7,
    FSC_CIKEYVAL = 8,
    FSC_CIKEYID = 9,
    FSC_CINML = 10,
    FSC_CIKEYVALLEN = 11,
    FSC_CIADVANCE = 12,
    FSC_CIADVANCELEN = 13,
    FSC_CIEOR = 14,
    FSC_CISIZE = 15,
    FSC_CIVFMT = 16,
    FSC_CIVFMTFP = 17,

    /* F77 icilist structure fields. */

    FSI_ICIERR = 18,
    FSI_ICIUNIT = 19,
    FSI_ICIEND = 20,
    FSI_ICIFMT = 21,
    FSI_ICIRLEN = 22,
    FSI_ICIRNUM = 23,
    FSI_ICIVFMT = 24,
    FSI_ICIVFMTFP = 25,

    /* F77 olist structure fields. */

    FSO_OERR = 26,
    FSO_OUNIT = 27,
    FSO_OFNM = 28,
    FSO_OFNMLEN = 29,
    FSO_OSTA = 30,
    FSO_OACC = 31,
    FSO_OFM = 32,
    FSO_ORL = 33,
    FSO_OBLNK = 34,
    FSO_OCC = 35,
    FSO_OORG = 36,
    FSO_OSHARED = 37,
    FSO_OREADONLY = 38,
    FSO_ONKEYS = 39,
    FSO_OKEYS = 40,
    FSO_OASSOCV = 41,
    FSO_OMAXREC = 42,
    FSO_ODFNM = 43,
    FSO_ODFNMLEN = 44,
    FSO_ODISP = 45,
    FSO_ORECTYPE = 46,
    FSO_OCONV = 47,
    FSO_OCONVLEN = 48,
    FSO_OBUFFSIZE = 49,
    FSO_ODIRECT = 50,
    FSO_OACTION = 51,
    FSO_OACTIONLEN = 52,
    FSO_ODELIM = 53,
    FSO_ODELIMLEN = 54,
    FSO_OPAD = 55,
    FSO_OPADLEN = 56,
    FSO_OPOSITION = 57,
    FSO_OPOSITIONLEN = 58,

    /* F77 flist structure fields. */

    FSF_FERR = 59,
    FSF_FUNIT = 60,
    FSF_FREC = 61,

    /* F77 inlist structure fields. */

    FSN_INERR = 62,
    FSN_INUNIT = 63,
    FSN_INFILE = 64,
    FSN_INFILEN = 65,
    FSN_INEX = 66,
    FSN_INOPEN = 67,
    FSN_INNUM = 68,
    FSN_INNAMED = 69,
    FSN_INNAME = 70,
    FSN_INNAMLEN = 71,
    FSN_INACC = 72,
    FSN_INACCLEN = 73,
    FSN_INSEQ = 74,
    FSN_INSEQLEN = 75,
    FSN_INDIR = 76,
    FSN_INDIRLEN = 77,
    FSN_INFMT = 78,
    FSN_INFMTLEN = 79,
    FSN_INFORM = 80,
    FSN_INFORMLEN = 81,
    FSN_INUNF = 82,
    FSN_INUNFLEN = 83,
    FSN_INRECL = 84,
    FSN_INNREC = 85,
    FSN_INBLANK = 86,
    FSN_INBLANKLEN = 87,
    FSN_INDEFAULTFILE = 88,
    FSN_INDEFAULTFILELEN = 89,
    FSN_INCC = 90,
    FSN_INCCLEN = 91,
    FSN_INKEYED = 92,
    FSN_INKEYEDLEN = 93,
    FSN_INORG = 94,
    FSN_INORGLEN = 95,
    FSN_INRECORDTYPE = 96,
    FSN_INRECORDTYPELEN = 97,
    FSN_INCONV = 98,
    FSN_INCONVLEN = 99,
    FSN_INBUFFSIZE = 100,
    FSN_INACTION = 101,
    FSN_INACTIONLEN = 102,
    FSN_INDELIM = 103,
    FSN_INDELIMLEN = 104,
    FSN_INPAD = 105,
    FSN_INPADLEN = 106,
    FSN_INPOSITION = 107,
    FSN_INPOSITIONLEN = 108,
    FSN_INREAD = 109,
    FSN_INREADLEN = 110,
    FSN_INREADWRITE = 111,
    FSN_INREADWRITELEN = 112,
    FSN_INWRITE = 113,
    FSN_INWRITELEN = 114,

    /* F77 alist structure fields. */

    FSA_AERR = 115,
    FSA_AUNIT = 116,

    /* F77 cllist structure fields. */

    FSL_CLERR = 117,
    FSL_CLUNIT = 118,
    FSL_CLSTA = 119,

    /* F77 Keyspec structure fields */

    FSK_START = 120,
    FSK_END = 121,
    FSK_KEYTYPE = 122,

    /* CRAY Control List Structure Fields */

    FCR_CI_WORD1 = 123,
    FCR_CI_UNIT = 124,
    FCR_CI_IOSTAT = 125,
    FCR_CI_REC = 126,
    FCR_CI_PARSFMT = 127,
    FCR_CI_FMTSRC = 128,
    FCR_CI_ADVANCE = 129,
    FCR_CI_SIZE = 130,

    /* CRAY FCD Structure Fields */
    FCR_FCD_ADDR = 131,
    FCR_FCD_LEN = 132,

    /* Cray IOLIST header */
    FCR_IOL_HEAD = 133,

    /* Cray open descriptor fields */
    FCR_OPEN_VERSION = 134,
    FCR_OPEN_UNIT = 135,
    FCR_OPEN_IOSTAT = 136,
    FCR_OPEN_ERR = 137,
    FCR_OPEN_FILE = 138,
    FCR_OPEN_STATUS = 139,
    FCR_OPEN_ACCESS = 140,
    FCR_OPEN_FORM = 141,
    FCR_OPEN_RECL = 142,
    FCR_OPEN_BLANK = 143,
    FCR_OPEN_POSITION = 144,
    FCR_OPEN_ACTION = 145,
    FCR_OPEN_DELIM = 146,
    FCR_OPEN_PAD = 147,

   /* Cray close descriptor fields */
    FCR_CLOSE_VERSION = 148,
    FCR_CLOSE_UNIT = 149,
    FCR_CLOSE_IOSTAT = 150,
    FCR_CLOSE_ERR = 151,
    FCR_CLOSE_STATUS = 152,

   /* Cray Inquire descriptor fields */
    FCR_INQ_VERSION = 153,
    FCR_INQ_UNIT = 154,
    FCR_INQ_FILE = 155,
    FCR_INQ_IOSTAT = 156,
    FCR_INQ_ERR = 157,
    FCR_INQ_EXIST = 158,
    FCR_INQ_OPENED = 159,
    FCR_INQ_NUMBER = 160,
    FCR_INQ_NAMED = 161,
    FCR_INQ_NAME = 162,
    FCR_INQ_ACCESS = 163,
    FCR_INQ_SEQUENTIAL = 164,
    FCR_INQ_DIRECT = 165,
    FCR_INQ_FORM = 166,
    FCR_INQ_FORMATTED = 167,
    FCR_INQ_UNFORMATTED = 168,
    FCR_INQ_RECL = 169,
    FCR_INQ_NEXTREC = 170,
    FCR_INQ_BLANK = 171,
    FCR_INQ_POSITION = 172,
    FCR_INQ_ACTION = 173,
    FCR_INQ_READ = 174,
    FCR_INQ_WRITE = 175,
    FCR_INQ_READWRITE = 176,
    FCR_INQ_DELIM = 177,
    FCR_INQ_PAD = 178,

    /* Cray Dope Vector descriptor fields */
    FCR_DV_BASE_PTR = 179,
    FCR_DV_BASE_LEN = 180,
    FCR_DV_FLAG_INFO = 181,
    FCR_DV_TYPE_LEN = 182,
    FCR_DV_ORIG_BASE = 183,
    FCR_DV_ORIG_SIZE = 184,
    FCR_DV_DIM1_LB = 185,
    FCR_DV_DIM1_EXTENT = 186,
    FCR_DV_DIM1_STRIDE = 187,
    FCR_DV_DIM2_LB = 188,
    FCR_DV_DIM2_EXTENT = 189,
    FCR_DV_DIM2_STRIDE = 190,
    FCR_DV_DIM3_LB = 191,
    FCR_DV_DIM3_EXTENT = 192,
    FCR_DV_DIM3_STRIDE = 193,
    FCR_DV_DIM4_LB = 194,
    FCR_DV_DIM4_EXTENT = 195,
    FCR_DV_DIM4_STRIDE = 196,
    FCR_DV_DIM5_LB = 197,
    FCR_DV_DIM5_EXTENT = 298,
    FCR_DV_DIM5_STRIDE = 299,
    FCR_DV_DIM6_LB = 200,
    FCR_DV_DIM6_EXTENT = 201,
    FCR_DV_DIM6_STRIDE = 202,
    FCR_DV_DIM7_LB = 203,
    FCR_DV_DIM7_EXTENT = 204,
    FCR_DV_DIM7_STRIDE = 205,

       /* FID_IOSCALAR_ENTRY */
    FCR_IOSCALAR_ENTRY = 206,
    FCR_IOSCALAR_TYPE_T = 207,
    FCR_IOSCALAR_ADDR = 208,
    FCR_IOSCALAR_CHAR_LEN = 209,

      /* FID_IOARRAY_ENTRY */
    FCR_IOARRAY_ENTRY = 210,
    FCR_IOARRAY_DV_ADDR = 211,
    FCR_IOARRAY_FLAG = 212,
    FCR_IOARRAY_IDX1 = 213,
    FCR_IOARRAY_IDX2 = 214,
    FCR_IOARRAY_IDX3 = 215,
    FCR_IOARRAY_IDX4 = 216,
    FCR_IOARRAY_IDX5 = 217,
    FCR_IOARRAY_IDX6= 218,
    FCR_IOARRAY_IDX7 = 219,

    /* FID_IOIMPLIEDDO_ENTRY */
    FCR_IOIMPLIEDDO_ENTRY = 220,
    FCR_IOIMPLIEDDO_VAR_ADDR = 221,
    FCR_IOIMPLIEDDO_BEGIN_CNT = 222,
    FCR_IOIMPLIEDDO_END_CNT = 223,
    FCR_IOIMPLIEDDO_INC_CNT = 224,

  FIOSTRUCT_LAST = 224

} FIOSTRUCT;

typedef enum {

  FIOCLASS_NONE = 0,
  FIOCLASS_FIRST = 1,

    FCL_EXT_FORMATTED = 1,
    FCL_EXT_UNFORMATTED = 2,
    FCL_EXT_LIST = 3,
    FCL_EXT_NAMELIST = 4,

    FCL_INT_FORMATTED = 5,
    FCL_INT_LIST = 6,

    FCL_DIR_FORMATTED = 7,
    FCL_DIR_UNFORMATTED = 8,

  FIOCLASS_LAST = 8

} FIOCLASS;

typedef struct {
    FIOSTRUCT  first;
    FIOSTRUCT  last;
    INT16      size32;
    INT16      size64;
    const char       *name;
    const char       *name_ptr;
    const char       *name_local;
} FIOSTRUCTID_INFO;

typedef struct {
    INT16        offset32;
    INT16        type32;
    INT16        offset64;
    INT16        type64;
    FIOSTRUCTID  iostruct;
    const char  *name;
} FIOSTRUCT_INFO;

static ST * Make_IoRuntime_ST ( FIOOPER );
#define GET_RUNTIME_ST(x) (fio_sts[x] == NULL ? Make_IoRuntime_ST (x) : \
            fio_sts[x])

static void Gen_Io_Calls ( WN *, FIOOPER, WN *, WN *, INT32, WN *, WN *, WN *,
         WN * );
#define GEN_IO_CALL_0(bl, op, ios1, ios2) \
  Gen_Io_Calls (bl, op, ios1, ios2, 0, NULL, NULL, NULL, NULL);
#define GEN_IO_CALL_1(bl, op, ios1, ios2, k1) \
  Gen_Io_Calls (bl, op, ios1, ios2, 1, k1, NULL, NULL, NULL);
#define GEN_IO_CALL_2(bl, op, ios1, ios2, k1, k2) \
  Gen_Io_Calls (bl, op, ios1, ios2, 2, k1, k2, NULL, NULL);
#define GEN_IO_CALL_3(bl, op, ios1, ios2, k1, k2, k3) \
  Gen_Io_Calls (bl, op, ios1, ios2, 3, k1, k2, k3, NULL);
#define GEN_IO_CALL_4(bl, op, ios1, ios2, k1, k2, k3, k4) \
  Gen_Io_Calls (bl, op, ios1, ios2, 4, k1, k2, k3, k4);

#define Action(x)   (actions & (x))

#define WN_type_pointed(x)  TY_pointed(WN_type(x))

inline WN *
WN_CreateNewLabel (void)
{
  LABEL_IDX label;
  (void) New_LABEL (CURRENT_SYMTAB, label);
  return WN_CreateLabel (label, 0, NULL);
}


INT32 mp_io;

/*  This table contains the external names of all I/O runtime routines.  */

static const char * fio_names [FIOOPER_LAST + 1] = {
    "",     /* FIOOPER_NONE */
    "s_rsfe64",   /* FIO_EXT_READ_FORMAT_start */
    "s_rsue64",   /* FIO_EXT_READ_UNFORMAT_start */
    "s_rsle64",   /* FIO_EXT_READ_LIST_start */
    "s_rsNe64",   /* FIO_EXT_READ_NAMELIST_start */
    "s_wsfe64",   /* FIO_EXT_WRITE_FORMAT_start */
    "s_wsue64",   /* FIO_EXT_WRITE_UNFORMAT_start */
    "s_wsle64",   /* FIO_EXT_WRITE_LIST_start */
    "s_wsNe64",   /* FIO_EXT_WRITE_NAMELIST_start */
    "s_xsfe64",   /* FIO_EXT_REWRITE_FORMAT_start */
    "s_xsue64",   /* FIO_EXT_REWRITE_UNFORMAT_start */
    "s_xsle64",   /* FIO_EXT_REWRITE_LIST_start */
    "e_rsfe64",   /* FIO_EXT_READ_FORMAT_end */
    "e_rsue64",   /* FIO_EXT_READ_UNFORMAT_end */
    "e_rsle64",   /* FIO_EXT_READ_LIST_end */
    "e_wsfe64",   /* FIO_EXT_WRITE_FORMAT_end */
    "e_wsue64",   /* FIO_EXT_WRITE_UNFORMAT_end */
    "e_wsle64",   /* FIO_EXT_WRITE_LIST_end */
    "e_xsfe64",   /* FIO_EXT_REWRITE_FORMAT_end */
    "e_xsue64",   /* FIO_EXT_REWRITE_UNFORMAT_end */
    "e_xsle64",   /* FIO_EXT_REWRITE_LIST_end */
    "s_rsfi64",   /* FIO_INT_READ_FORMAT_start */
    "s_rsli64",   /* FIO_INT_READ_LIST_start */
    "s_wsfi64",   /* FIO_INT_WRITE_FORMAT_start */
    "s_wsli64",   /* FIO_INT_WRITE_LIST_start */
    "e_rsfi64",   /* FIO_INT_READ_FORMAT_end */
    "e_rsli64",   /* FIO_INT_READ_LIST_end */
    "e_wsfi64",   /* FIO_INT_WRITE_FORMAT_end */
    "e_wsli64",   /* FIO_INT_WRITE_LIST_end */
    "s_rdfe64",   /* FIO_DIR_READ_FORMAT_start */
    "s_rdue64",   /* FIO_DIR_READ_UNFORMAT_start */
    "s_wdfe64",   /* FIO_DIR_WRITE_FORMAT_start */
    "s_wdue64",   /* FIO_DIR_WRITE_UNFORMAT_start */
    "e_rdfe64",   /* FIO_DIR_READ_FORMAT_end */
    "e_rdue64",   /* FIO_DIR_READ_UNFORMAT_end */
    "e_wdfe64",   /* FIO_DIR_WRITE_FORMAT_end */
    "e_wdue64",   /* FIO_DIR_WRITE_UNFORMAT_end */
    "do_fioxa4",  /* FIO_FORMAT_ADDR4_item */
    "do_fioxa8",  /* FIO_FORMAT_ADDR8_item */
    "do_fioxh1",  /* FIO_FORMAT_CHAR_item */
    "do_fioxi1",  /* FIO_FORMAT_I1_item */
    "do_fioxi2",  /* FIO_FORMAT_I2_item */
    "do_fioxi4",  /* FIO_FORMAT_I4_item */
    "do_fioxi8",  /* FIO_FORMAT_I8_item */
    "do_fioxl1",  /* FIO_FORMAT_L1_item */
    "do_fioxl2",  /* FIO_FORMAT_L2_item */
    "do_fioxl4",  /* FIO_FORMAT_L4_item */
    "do_fioxl8",  /* FIO_FORMAT_L8_item */
    "do_fioxr4",  /* FIO_FORMAT_R4_item */
    "do_fioxr8",  /* FIO_FORMAT_R8_item */
    "do_fioxr16", /* FIO_FORMAT_R16_item */
    "do_fioxc4",  /* FIO_FORMAT_C4_item */
    "do_fioxc8",  /* FIO_FORMAT_C8_item */
    "do_fioxc16", /* FIO_FORMAT_C16_item */
    "do_fioxa4v", /* FIO_FORMAT_ADDR4_value */
    "do_fioxa8v", /* FIO_FORMAT_ADDR8_value */
    "do_fioxh1v", /* FIO_FORMAT_CHAR_value */
    "do_fioxi1v", /* FIO_FORMAT_I1_value */
    "do_fioxi2v", /* FIO_FORMAT_I2_value */
    "do_fioxi4v", /* FIO_FORMAT_I4_value */
    "do_fioxi8v", /* FIO_FORMAT_I8_value */
    "do_fioxl1v", /* FIO_FORMAT_L1_value */
    "do_fioxl2v", /* FIO_FORMAT_L2_value */
    "do_fioxl4v", /* FIO_FORMAT_L4_value */
    "do_fioxl8v", /* FIO_FORMAT_L8_value */
    "do_fioxr4v", /* FIO_FORMAT_R4_value */
    "do_fioxr8v", /* FIO_FORMAT_R8_value */
    "do_fioxr16v",  /* FIO_FORMAT_R16_value */
    "do_fioxc4v", /* FIO_FORMAT_C4_value */
    "do_fioxc8v", /* FIO_FORMAT_C8_value */
    "do_fioxc16v",  /* FIO_FORMAT_C16_value */
    "do_uioxa4",  /* FIO_UNFORMAT_ADDR4_item */
    "do_uioxa8",  /* FIO_UNFORMAT_ADDR8_item */
    "do_uioxh1",  /* FIO_UNFORMAT_CHAR_item */
    "do_uioxi1",  /* FIO_UNFORMAT_I1_item */
    "do_uioxi2",  /* FIO_UNFORMAT_I2_item */
    "do_uioxi4",  /* FIO_UNFORMAT_I4_item */
    "do_uioxi8",  /* FIO_UNFORMAT_I8_item */
    "do_uioxl1",  /* FIO_UNFORMAT_L1_item */
    "do_uioxl2",  /* FIO_UNFORMAT_L2_item */
    "do_uioxl4",  /* FIO_UNFORMAT_L4_item */
    "do_uioxl8",  /* FIO_UNFORMAT_L8_item */
    "do_uioxr4",  /* FIO_UNFORMAT_R4_item */
    "do_uioxr8",  /* FIO_UNFORMAT_R8_item */
    "do_uioxr16", /* FIO_UNFORMAT_R16_item */
    "do_uioxc4",  /* FIO_UNFORMAT_C4_item */
    "do_uioxc8",  /* FIO_UNFORMAT_C8_item */
    "do_uioxc16", /* FIO_UNFORMAT_C16_item */
    "do_uioxa4v", /* FIO_UNFORMAT_ADDR4_value */
    "do_uioxa8v", /* FIO_UNFORMAT_ADDR8_value */
    "do_uioxh1v", /* FIO_UNFORMAT_CHAR_value */
    "do_uioxi1v", /* FIO_UNFORMAT_I1_value */
    "do_uioxi2v", /* FIO_UNFORMAT_I2_value */
    "do_uioxi4v", /* FIO_UNFORMAT_I4_value */
    "do_uioxi8v", /* FIO_UNFORMAT_I8_value */
    "do_uioxl1v", /* FIO_UNFORMAT_L1_value */
    "do_uioxl2v", /* FIO_UNFORMAT_L2_value */
    "do_uioxl4v", /* FIO_UNFORMAT_L4_value */
    "do_uioxl8v", /* FIO_UNFORMAT_L8_value */
    "do_uioxr4v", /* FIO_UNFORMAT_R4_value */
    "do_uioxr8v", /* FIO_UNFORMAT_R8_value */
    "do_uioxr16v",  /* FIO_UNFORMAT_R16_value */
    "do_uioxc4v", /* FIO_UNFORMAT_C4_value */
    "do_uioxc8v", /* FIO_UNFORMAT_C8_value */
    "do_uioxc16v",  /* FIO_UNFORMAT_C16_value */
    "do_lioxa4",  /* FIO_LIST_ADDR4_item */
    "do_lioxa8",  /* FIO_LIST_ADDR8_item */
    "do_lioxh1",  /* FIO_LIST_CHAR_item */
    "do_lioxi1",  /* FIO_LIST_I1_item */
    "do_lioxi2",  /* FIO_LIST_I2_item */
    "do_lioxi4",  /* FIO_LIST_I4_item */
    "do_lioxi8",  /* FIO_LIST_I8_item */
    "do_lioxl1",  /* FIO_LIST_L1_item */
    "do_lioxl2",  /* FIO_LIST_L2_item */
    "do_lioxl4",  /* FIO_LIST_L4_item */
    "do_lioxl8",  /* FIO_LIST_L8_item */
    "do_lioxr4",  /* FIO_LIST_R4_item */
    "do_lioxr8",  /* FIO_LIST_R8_item */
    "do_lioxr16", /* FIO_LIST_R16_item */
    "do_lioxc4",  /* FIO_LIST_C4_item */
    "do_lioxc8",  /* FIO_LIST_C8_item */
    "do_lioxc16", /* FIO_LIST_C16_item */
    "do_lioxa4v", /* FIO_LIST_ADDR4_value */
    "do_lioxa8v", /* FIO_LIST_ADDR8_value */
    "do_lioxh1v", /* FIO_LIST_CHAR_value */
    "do_lioxi1v", /* FIO_LIST_I1_value */
    "do_lioxi2v", /* FIO_LIST_I2_value */
    "do_lioxi4v", /* FIO_LIST_I4_value */
    "do_lioxi8v", /* FIO_LIST_I8_value */
    "do_lioxl1v", /* FIO_LIST_L1_value */
    "do_lioxl2v", /* FIO_LIST_L2_value */
    "do_lioxl4v", /* FIO_LIST_L4_value */
    "do_lioxl8v", /* FIO_LIST_L8_value */
    "do_lioxr4v", /* FIO_LIST_R4_value */
    "do_lioxr8v", /* FIO_LIST_R8_value */
    "do_lioxr16v",  /* FIO_LIST_R16_value */
    "do_lioxc4v", /* FIO_LIST_C4_value */
    "do_lioxc8v", /* FIO_LIST_C8_value */
    "do_lioxc16v",  /* FIO_LIST_C16_value */
    "f_back64",   /* FIO_BACKSPACE */
    "f_clos64",   /* FIO_CLOSE */
    "f_del64",    /* FIO_DELETE */
    "f_end64",    /* FIO_ENDFILE */
    "f_find64",   /* FIO_FIND */
    "f_inqu064x", /* FIO_INQUIRE */
    "f_open064x", /* FIO_OPEN */
    "f_rew64",    /* FIO_REWIND */
    "f_unl64",    /* FIO_UNLOCK */
    "f_df64x",    /* FIO_DEFINEFILE */
    "_FRU",   /* FIO_CR_READ_UNFORMATTED */
    "_FWU",   /* FIO_CR_WRITE_UNFORMATTED */
    "_FRF",   /* FIO_CR_READ_FORMATTED */
    "_FWF",   /* FIO_CR_WRITE_FORMATTED */
    "_FRN",   /* FIO_CR_READ_NAMELIST */
    "_FWN",   /* FIO_CR_WRITE_NAMELIST */
    "_INQIL",   /* FIO_INQLENGTH */
    "_OPEN",    /* FIO_CR_OPEN */
    "_CLOSE",   /* FIO_CR_CLOSE */
    "_EOFW",    /* FIO_CR_ENDFILE */
    "_REWF",    /* FIO_CR_REWIND */
    "_INQUIRE",   /* IOS_CR_INQUIRE */
    "_BACK",    /* IOS_CR_BACKSPACE */
    "_BUFFERIN",  /* IOS_CR_BUFFERIN */
    "_BUFFEROUT"  /* IOS_CR_BUFFEROUT */

};

/*  This table contains pointers to the global ST entries for each of the  */
/*  I/O runtime routines.  These entries allow efficient sharing of all    */
/*  calls to a particular runtime routine.                                 */

static ST * fio_sts [FIOOPER_LAST + 1] = {
    NULL, /* FIOOPER_NONE */
    NULL, /* FIO_EXT_READ_FORMAT_start */
    NULL, /* FIO_EXT_READ_UNFORMAT_start */
    NULL, /* FIO_EXT_READ_LIST_start */
    NULL, /* FIO_EXT_READ_NAMELIST_start */
    NULL, /* FIO_EXT_WRITE_FORMAT_start */
    NULL, /* FIO_EXT_WRITE_UNFORMAT_start */
    NULL, /* FIO_EXT_WRITE_LIST_start */
    NULL, /* FIO_EXT_WRITE_NAMELIST_start */
    NULL, /* FIO_EXT_REWRITE_FORMAT_start */
    NULL, /* FIO_EXT_REWRITE_UNFORMAT_start */
    NULL, /* FIO_EXT_REWRITE_LIST_start */
    NULL, /* FIO_EXT_READ_FORMAT_end */
    NULL, /* FIO_EXT_READ_UNFORMAT_end */
    NULL, /* FIO_EXT_READ_LIST_end */
    NULL, /* FIO_EXT_WRITE_FORMAT_end */
    NULL, /* FIO_EXT_WRITE_UNFORMAT_end */
    NULL, /* FIO_EXT_WRITE_LIST_end */
    NULL, /* FIO_EXT_REWRITE_FORMAT_end */
    NULL, /* FIO_EXT_REWRITE_UNFORMAT_end */
    NULL, /* FIO_EXT_REWRITE_LIST_end */
    NULL, /* FIO_INT_READ_FORMAT_start */
    NULL, /* FIO_INT_READ_LIST_start */
    NULL, /* FIO_INT_WRITE_FORMAT_start */
    NULL, /* FIO_INT_WRITE_LIST_start */
    NULL, /* FIO_INT_READ_FORMAT_end */
    NULL, /* FIO_INT_READ_LIST_end */
    NULL, /* FIO_INT_WRITE_FORMAT_end */
    NULL, /* FIO_INT_WRITE_LIST_end */
    NULL, /* FIO_DIR_READ_FORMAT_start */
    NULL, /* FIO_DIR_READ_UNFORMAT_start */
    NULL, /* FIO_DIR_WRITE_FORMAT_start */
    NULL, /* FIO_DIR_WRITE_UNFORMAT_start */
    NULL, /* FIO_DIR_READ_FORMAT_end */
    NULL, /* FIO_DIR_READ_UNFORMAT_end */
    NULL, /* FIO_DIR_WRITE_FORMAT_end */
    NULL, /* FIO_DIR_WRITE_UNFORMAT_end */
    NULL, /* FIO_FORMAT_ADDR4_item */
    NULL, /* FIO_FORMAT_ADDR8_item */
    NULL, /* FIO_FORMAT_CHAR_item */
    NULL, /* FIO_FORMAT_I1_item */
    NULL, /* FIO_FORMAT_I2_item */
    NULL, /* FIO_FORMAT_I4_item */
    NULL, /* FIO_FORMAT_I8_item */
    NULL, /* FIO_FORMAT_L1_item */
    NULL, /* FIO_FORMAT_L2_item */
    NULL, /* FIO_FORMAT_L4_item */
    NULL, /* FIO_FORMAT_L8_item */
    NULL, /* FIO_FORMAT_R4_item */
    NULL, /* FIO_FORMAT_R8_item */
    NULL, /* FIO_FORMAT_R16_item */
    NULL, /* FIO_FORMAT_C4_item */
    NULL, /* FIO_FORMAT_C8_item */
    NULL, /* FIO_FORMAT_C16_item */
    NULL, /* FIO_FORMAT_ADDR4_value */
    NULL, /* FIO_FORMAT_ADDR8_value */
    NULL, /* FIO_FORMAT_CHAR_value */
    NULL, /* FIO_FORMAT_I1_value */
    NULL, /* FIO_FORMAT_I2_value */
    NULL, /* FIO_FORMAT_I4_value */
    NULL, /* FIO_FORMAT_I8_value */
    NULL, /* FIO_FORMAT_L1_value */
    NULL, /* FIO_FORMAT_L2_value */
    NULL, /* FIO_FORMAT_L4_value */
    NULL, /* FIO_FORMAT_L8_value */
    NULL, /* FIO_FORMAT_R4_value */
    NULL, /* FIO_FORMAT_R8_value */
    NULL, /* FIO_FORMAT_R16_value */
    NULL, /* FIO_FORMAT_C4_value */
    NULL, /* FIO_FORMAT_C8_value */
    NULL, /* FIO_FORMAT_C16_value */
    NULL, /* FIO_UNFORMAT_ADDR4_item */
    NULL, /* FIO_UNFORMAT_ADDR8_item */
    NULL, /* FIO_UNFORMAT_CHAR_item */
    NULL, /* FIO_UNFORMAT_I1_item */
    NULL, /* FIO_UNFORMAT_I2_item */
    NULL, /* FIO_UNFORMAT_I4_item */
    NULL, /* FIO_UNFORMAT_I8_item */
    NULL, /* FIO_UNFORMAT_L1_item */
    NULL, /* FIO_UNFORMAT_L2_item */
    NULL, /* FIO_UNFORMAT_L4_item */
    NULL, /* FIO_UNFORMAT_L8_item */
    NULL, /* FIO_UNFORMAT_R4_item */
    NULL, /* FIO_UNFORMAT_R8_item */
    NULL, /* FIO_UNFORMAT_R16_item */
    NULL, /* FIO_UNFORMAT_C4_item */
    NULL, /* FIO_UNFORMAT_C8_item */
    NULL, /* FIO_UNFORMAT_C16_item */
    NULL, /* FIO_UNFORMAT_ADDR4_value */
    NULL, /* FIO_UNFORMAT_ADDR8_value */
    NULL, /* FIO_UNFORMAT_CHAR_value */
    NULL, /* FIO_UNFORMAT_I1_value */
    NULL, /* FIO_UNFORMAT_I2_value */
    NULL, /* FIO_UNFORMAT_I4_value */
    NULL, /* FIO_UNFORMAT_I8_value */
    NULL, /* FIO_UNFORMAT_L1_value */
    NULL, /* FIO_UNFORMAT_L2_value */
    NULL, /* FIO_UNFORMAT_L4_value */
    NULL, /* FIO_UNFORMAT_L8_value */
    NULL, /* FIO_UNFORMAT_R4_value */
    NULL, /* FIO_UNFORMAT_R8_value */
    NULL, /* FIO_UNFORMAT_R16_value */
    NULL, /* FIO_UNFORMAT_C4_value */
    NULL, /* FIO_UNFORMAT_C8_value */
    NULL, /* FIO_UNFORMAT_C16_value */
    NULL, /* FIO_LIST_ADDR4_item */
    NULL, /* FIO_LIST_ADDR8_item */
    NULL, /* FIO_LIST_CHAR_item */
    NULL, /* FIO_LIST_I1_item */
    NULL, /* FIO_LIST_I2_item */
    NULL, /* FIO_LIST_I4_item */
    NULL, /* FIO_LIST_I8_item */
    NULL, /* FIO_LIST_L1_item */
    NULL, /* FIO_LIST_L2_item */
    NULL, /* FIO_LIST_L4_item */
    NULL, /* FIO_LIST_L8_item */
    NULL, /* FIO_LIST_R4_item */
    NULL, /* FIO_LIST_R8_item */
    NULL, /* FIO_LIST_R16_item */
    NULL, /* FIO_LIST_C4_item */
    NULL, /* FIO_LIST_C8_item */
    NULL, /* FIO_LIST_C16_item */
    NULL, /* FIO_LIST_ADDR4_value */
    NULL, /* FIO_LIST_ADDR8_value */
    NULL, /* FIO_LIST_CHAR_value */
    NULL, /* FIO_LIST_I1_value */
    NULL, /* FIO_LIST_I2_value */
    NULL, /* FIO_LIST_I4_value */
    NULL, /* FIO_LIST_I8_value */
    NULL, /* FIO_LIST_L1_value */
    NULL, /* FIO_LIST_L2_value */
    NULL, /* FIO_LIST_L4_value */
    NULL, /* FIO_LIST_L8_value */
    NULL, /* FIO_LIST_R4_value */
    NULL, /* FIO_LIST_R8_value */
    NULL, /* FIO_LIST_R16_value */
    NULL, /* FIO_LIST_C4_value */
    NULL, /* FIO_LIST_C8_value */
    NULL, /* FIO_LIST_C16_value */
    NULL, /* FIO_BACKSPACE */
    NULL, /* FIO_CLOSE */
    NULL, /* FIO_DELETE */
    NULL, /* FIO_ENDFILE */
    NULL, /* FIO_FIND */
    NULL, /* FIO_INQUIRE */
    NULL, /* FIO_OPEN */
    NULL, /* FIO_REWIND */
    NULL, /* FIO_UNLOCK */
    NULL, /* FIO_DEFINEFILE */
    NULL, /* FIO_CR_READ_UNFORMATTED */
    NULL, /* FIO_CR_WRITE_UNFORMATTED */
    NULL, /* FIO_CR_READ_FORMATTED */
    NULL, /* FIO_CR_WRITE_FORMATTED */
    NULL, /* FIO_CR_READ_NAMELIST */
    NULL, /* FIO_CR_WRITE_NAMELIST */
    NULL, /* FIO_INQLENGTH */
    NULL, /* IOS_CR_OPEN */
    NULL, /* IOS_CR_CLOSE */
    NULL, /* IOS_CR_ENDFILE */
    NULL, /* IOS_CR_REWIND */
    NULL, /* IOS_CR_INQUIRE */
    NULL, /* IOS_CR_BACKSPACE */
    NULL, /* IOS_CR_BUFFERIN */
    NULL  /* IOS_CR_BUFFEROUT */
};


/*  These tables contain the FIOOPER codes for each I/O item or value.     */
/*  The tables are indexed by the type of I/O (formatted, unformatted,     */
/*  list-directed) and the data type of the item/value.        */

static FIOOPER fio_item_ops  [FIOFORMATTYPE_LAST +1] [FIOITEMTYPE_LAST + 1] = {
    FIOOPER_NONE,   /* unknown, FIOITEMTYPE_NONE */
    FIOOPER_NONE,   /* unknown, FIT_ADDRESS4 */
    FIOOPER_NONE,   /* unknown, FIT_ADDRESS8 */
    FIOOPER_NONE,   /* unknown, FIT_CHARACTER */
    FIOOPER_NONE,   /* unknown, FIT_INTEGER1 */
    FIOOPER_NONE,   /* unknown, FIT_INTEGER2 */
    FIOOPER_NONE,   /* unknown, FIT_INTEGER4 */
    FIOOPER_NONE,   /* unknown, FIT_INTEGER8 */
    FIOOPER_NONE,   /* unknown, FIT_LOGICAL1 */
    FIOOPER_NONE,   /* unknown, FIT_LOGICAL2 */
    FIOOPER_NONE,   /* unknown, FIT_LOGICAL4 */
    FIOOPER_NONE,   /* unknown, FIT_LOGICAL8 */
    FIOOPER_NONE,   /* unknown, FIT_REAL4 */
    FIOOPER_NONE,   /* unknown, FIT_REAL8 */
    FIOOPER_NONE,   /* unknown, FIT_REAL16 */
    FIOOPER_NONE,   /* unknown, FIT_COMPLEX4 */
    FIOOPER_NONE,   /* unknown, FIT_COMPLEX8 */
    FIOOPER_NONE,   /* unknown, FIT_COMPLEX16 */
    FIOOPER_NONE,   /* unknown, FIT_RECORD */
    FIOOPER_NONE,   /* formatted, FIOITEMTYPE_NONE */
    FIO_FORMAT_ADDR4_item,  /* formatted, FIT_ADDRESS4 */
    FIO_FORMAT_ADDR8_item,  /* formatted, FIT_ADDRESS8 */
    FIO_FORMAT_CHAR_item, /* formatted, FIT_CHARACTER */
    FIO_FORMAT_I1_item,   /* formatted, FIT_INTEGER1 */
    FIO_FORMAT_I2_item,   /* formatted, FIT_INTEGER2 */
    FIO_FORMAT_I4_item,   /* formatted, FIT_INTEGER4 */
    FIO_FORMAT_I8_item,   /* formatted, FIT_INTEGER8 */
    FIO_FORMAT_L1_item,   /* formatted, FIT_LOGICAL1 */
    FIO_FORMAT_L2_item,   /* formatted, FIT_LOGICAL2 */
    FIO_FORMAT_L4_item,   /* formatted, FIT_LOGICAL4 */
    FIO_FORMAT_L8_item,   /* formatted, FIT_LOGICAL8 */
    FIO_FORMAT_R4_item,   /* formatted, FIT_REAL4 */
    FIO_FORMAT_R8_item,   /* formatted, FIT_REAL8 */
    FIO_FORMAT_R16_item,  /* formatted, FIT_REAL16 */
    FIO_FORMAT_C4_item,   /* formatted, FIT_COMPLEX4 */
    FIO_FORMAT_C8_item,   /* formatted, FIT_COMPLEX8 */
    FIO_FORMAT_C16_item,  /* formatted, FIT_COMPLEX16 */
    FIOOPER_NONE,   /* formatted, FIT_RECORD */
    FIOOPER_NONE,   /* unformatted, FIOITEMTYPE_NONE */
    FIO_UNFORMAT_ADDR4_item,  /* unformatted, FIT_ADDRESS4 */
    FIO_UNFORMAT_ADDR8_item,  /* unformatted, FIT_ADDRESS8 */
    FIO_UNFORMAT_CHAR_item, /* unformatted, FIT_CHARACTER */
    FIO_UNFORMAT_I1_item, /* unformatted, FIT_INTEGER1 */
    FIO_UNFORMAT_I2_item, /* unformatted, FIT_INTEGER2 */
    FIO_UNFORMAT_I4_item, /* unformatted, FIT_INTEGER4 */
    FIO_UNFORMAT_I8_item, /* unformatted, FIT_INTEGER8 */
    FIO_UNFORMAT_L1_item, /* unformatted, FIT_LOGICAL1 */
    FIO_UNFORMAT_L2_item, /* unformatted, FIT_LOGICAL2 */
    FIO_UNFORMAT_L4_item, /* unformatted, FIT_LOGICAL4 */
    FIO_UNFORMAT_L8_item, /* unformatted, FIT_LOGICAL8 */
    FIO_UNFORMAT_R4_item, /* unformatted, FIT_REAL4 */
    FIO_UNFORMAT_R8_item, /* unformatted, FIT_REAL8 */
    FIO_UNFORMAT_R16_item,  /* unformatted, FIT_REAL16 */
    FIO_UNFORMAT_C4_item, /* unformatted, FIT_COMPLEX4 */
    FIO_UNFORMAT_C8_item, /* unformatted, FIT_COMPLEX8 */
    FIO_UNFORMAT_C16_item,  /* unformatted, FIT_COMPLEX16 */
    FIOOPER_NONE,   /* unformatted, FIT_RECORD */
    FIOOPER_NONE,   /* list-directed, FIOITEMTYPE_NONE */
    FIO_LIST_ADDR4_item,  /* list-directed, FIT_ADDRESS4 */
    FIO_LIST_ADDR8_item,  /* list-directed, FIT_ADDRESS8 */
    FIO_LIST_CHAR_item,   /* list-directed, FIT_CHARACTER */
    FIO_LIST_I1_item,   /* list-directed, FIT_INTEGER1 */
    FIO_LIST_I2_item,   /* list-directed, FIT_INTEGER2 */
    FIO_LIST_I4_item,   /* list-directed, FIT_INTEGER4 */
    FIO_LIST_I8_item,   /* list-directed, FIT_INTEGER8 */
    FIO_LIST_L1_item,   /* list-directed, FIT_LOGICAL1 */
    FIO_LIST_L2_item,   /* list-directed, FIT_LOGICAL2 */
    FIO_LIST_L4_item,   /* list-directed, FIT_LOGICAL4 */
    FIO_LIST_L8_item,   /* list-directed, FIT_LOGICAL8 */
    FIO_LIST_R4_item,   /* list-directed, FIT_REAL4 */
    FIO_LIST_R8_item,   /* list-directed, FIT_REAL8 */
    FIO_LIST_R16_item,    /* list-directed, FIT_REAL16 */
    FIO_LIST_C4_item,   /* list-directed, FIT_COMPLEX4 */
    FIO_LIST_C8_item,   /* list-directed, FIT_COMPLEX8 */
    FIO_LIST_C16_item,    /* list-directed, FIT_COMPLEX16 */
    FIOOPER_NONE    /* list-directed, FIT_RECORD */
};

static FIOOPER fio_value_ops [FIOFORMATTYPE_LAST +1] [FIOITEMTYPE_LAST + 1] = {
    FIOOPER_NONE,   /* unknown, FIOITEMTYPE_NONE */
    FIOOPER_NONE,   /* unknown, FIT_ADDRESS4 */
    FIOOPER_NONE,   /* unknown, FIT_ADDRESS8 */
    FIOOPER_NONE,   /* unknown, FIT_CHARACTER */
    FIOOPER_NONE,   /* unknown, FIT_INTEGER1 */
    FIOOPER_NONE,   /* unknown, FIT_INTEGER2 */
    FIOOPER_NONE,   /* unknown, FIT_INTEGER4 */
    FIOOPER_NONE,   /* unknown, FIT_INTEGER8 */
    FIOOPER_NONE,   /* unknown, FIT_LOGICAL1 */
    FIOOPER_NONE,   /* unknown, FIT_LOGICAL2 */
    FIOOPER_NONE,   /* unknown, FIT_LOGICAL4 */
    FIOOPER_NONE,   /* unknown, FIT_LOGICAL8 */
    FIOOPER_NONE,   /* unknown, FIT_REAL4 */
    FIOOPER_NONE,   /* unknown, FIT_REAL8 */
    FIOOPER_NONE,   /* unknown, FIT_REAL16 */
    FIOOPER_NONE,   /* unknown, FIT_COMPLEX4 */
    FIOOPER_NONE,   /* unknown, FIT_COMPLEX8 */
    FIOOPER_NONE,   /* unknown, FIT_COMPLEX16 */
    FIOOPER_NONE,   /* unknown, FIT_RECORD */
    FIOOPER_NONE,   /* formatted, FIOITEMTYPE_NONE */
    FIO_FORMAT_ADDR4_value, /* formatted, FIT_ADDRESS4 */
    FIO_FORMAT_ADDR8_value, /* formatted, FIT_ADDRESS8 */
    FIO_FORMAT_CHAR_value,  /* formatted, FIT_CHARACTER */
    FIO_FORMAT_I1_value,  /* formatted, FIT_INTEGER1 */
    FIO_FORMAT_I2_value,  /* formatted, FIT_INTEGER2 */
    FIO_FORMAT_I4_value,  /* formatted, FIT_INTEGER4 */
    FIO_FORMAT_I8_value,  /* formatted, FIT_INTEGER8 */
    FIO_FORMAT_L1_value,  /* formatted, FIT_LOGICAL1 */
    FIO_FORMAT_L2_value,  /* formatted, FIT_LOGICAL2 */
    FIO_FORMAT_L4_value,  /* formatted, FIT_LOGICAL4 */
    FIO_FORMAT_L8_value,  /* formatted, FIT_LOGICAL8 */
    FIO_FORMAT_R4_value,  /* formatted, FIT_REAL4 */
    FIO_FORMAT_R8_value,  /* formatted, FIT_REAL8 */
    FIO_FORMAT_R16_value, /* formatted, FIT_REAL16 */
    FIO_FORMAT_C4_value,  /* formatted, FIT_COMPLEX4 */
    FIO_FORMAT_C8_value,  /* formatted, FIT_COMPLEX8 */
    FIO_FORMAT_C16_value, /* formatted, FIT_COMPLEX16 */
    FIOOPER_NONE,   /* formatted, FIT_RECORD */
    FIOOPER_NONE,   /* unformatted, FIOITEMTYPE_NONE */
    FIO_UNFORMAT_ADDR4_value, /* unformatted, FIT_ADDRESS4 */
    FIO_UNFORMAT_ADDR8_value, /* unformatted, FIT_ADDRESS8 */
    FIO_UNFORMAT_CHAR_value,  /* unformatted, FIT_CHARACTER */
    FIO_UNFORMAT_I1_value,  /* unformatted, FIT_INTEGER1 */
    FIO_UNFORMAT_I2_value,  /* unformatted, FIT_INTEGER2 */
    FIO_UNFORMAT_I4_value,  /* unformatted, FIT_INTEGER4 */
    FIO_UNFORMAT_I8_value,  /* unformatted, FIT_INTEGER8 */
    FIO_UNFORMAT_L1_value,  /* unformatted, FIT_LOGICAL1 */
    FIO_UNFORMAT_L2_value,  /* unformatted, FIT_LOGICAL2 */
    FIO_UNFORMAT_L4_value,  /* unformatted, FIT_LOGICAL4 */
    FIO_UNFORMAT_L8_value,  /* unformatted, FIT_LOGICAL8 */
    FIO_UNFORMAT_R4_value,  /* unformatted, FIT_REAL4 */
    FIO_UNFORMAT_R8_value,  /* unformatted, FIT_REAL8 */
    FIO_UNFORMAT_R16_value, /* unformatted, FIT_REAL16 */
    FIO_UNFORMAT_C4_value,  /* unformatted, FIT_COMPLEX4 */
    FIO_UNFORMAT_C8_value,  /* unformatted, FIT_COMPLEX8 */
    FIO_UNFORMAT_C16_value, /* unformatted, FIT_COMPLEX16 */
    FIOOPER_NONE,   /* unformatted, FIT_RECORD */
    FIOOPER_NONE,   /* list-directed, FIOITEMTYPE_NONE */
    FIO_LIST_ADDR4_value, /* list-directed, FIT_ADDRESS4 */
    FIO_LIST_ADDR8_value, /* list-directed, FIT_ADDRESS8 */
    FIO_LIST_CHAR_value,  /* list-directed, FIT_CHARACTER */
    FIO_LIST_I1_value,    /* list-directed, FIT_INTEGER1 */
    FIO_LIST_I2_value,    /* list-directed, FIT_INTEGER2 */
    FIO_LIST_I4_value,    /* list-directed, FIT_INTEGER4 */
    FIO_LIST_I8_value,    /* list-directed, FIT_INTEGER8 */
    FIO_LIST_L1_value,    /* list-directed, FIT_LOGICAL1 */
    FIO_LIST_L2_value,    /* list-directed, FIT_LOGICAL2 */
    FIO_LIST_L4_value,    /* list-directed, FIT_LOGICAL4 */
    FIO_LIST_L8_value,    /* list-directed, FIT_LOGICAL8 */
    FIO_LIST_R4_value,    /* list-directed, FIT_REAL4 */
    FIO_LIST_R8_value,    /* list-directed, FIT_REAL8 */
    FIO_LIST_R16_value,   /* list-directed, FIT_REAL16 */
    FIO_LIST_C4_value,    /* list-directed, FIT_COMPLEX4 */
    FIO_LIST_C8_value,    /* list-directed, FIT_COMPLEX8 */
    FIO_LIST_C16_value,   /* list-directed, FIT_COMPLEX16 */
    FIOOPER_NONE    /* list-directed, FIT_RECORD */
};


/*  These variables contain a set of ST's (and their count) which   */
/*  represent user variables whose address has been passed to an    */
/*  I/O routine indirectly through a control structure.  Since the  */
/*  reference is hidden, the optimizer may not properly allocate,   */
/*  home or reload the user variable.  So, what we do is generate   */
/*  a set of 'dummy' parameter nodes on the call which list all     */
/*  such variables referenced.  Every call to Gen_Io_PutAddrWN      */
/*  saves the referenced ST in the table.  The next (first) call    */
/*  to an I/O routine has these dummy parameters appended to it.    */

static INT32     fio_dummy_max = 0;
static INT32     fio_dummy_count;
static BOOL      *fio_dummy_ref;
static ST      ** fio_dummy_st;
static TY_IDX    *fio_dummy_tyidx;
static WN_OFFSET *fio_dummy_ofst;

/*  These variables and tables contain the TY & ST pointers to the I/O   */
/*  global types and local symbols.  The variable fio_current_symtab is  */
/*  to validate the entries in fiostruct_st.  When a new PU is first   */
/*  entered, the ST pointers to old PU must be cleared.      */

static TY_IDX  fioruntime_ty = (TY_IDX) 0;

static TY_IDX  fiostruct_ty [FIOSTRUCTID_LAST + 1] = {
    (TY_IDX) 0, /* FIOSTRUCT_NONE */
    (TY_IDX) 0, /* FID_CILIST */
    (TY_IDX) 0, /* FID_ICILIST */
    (TY_IDX) 0, /* FID_OLIST */
    (TY_IDX) 0, /* FID_FLIST */
    (TY_IDX) 0, /* FID_INLIST */
    (TY_IDX) 0, /* FID_ALIST */
    (TY_IDX) 0, /* FID_CLLIST */
    (TY_IDX) 0, /* FID_KEYSPEC */
    (TY_IDX) 0, /* FID_CRAY_CLIST */
    (TY_IDX) 0,       /* FID_CRAY_FCD */
    (TY_IDX) 0, /* FID_CRAY_IOLIST */
    (TY_IDX) 0, /* FID_CRAY_OPENLIST */
    (TY_IDX) 0, /* FID_CRAY_CLOSELIST */
    (TY_IDX) 0, /* FID_CRAY_INQLIST */
    (TY_IDX) 0, /* FID_CRAY_DOPEVEC */
    (TY_IDX) 0, /* FID_IOSCALAR_ENTRY */
    (TY_IDX) 0, /* FID_IOARRAY_ENTRY */
    (TY_IDX) 0  /* FID_IOIMPLIEDDO_ENTRY */
};

static ST * fiostruct_st [FIOSTRUCTID_LAST + 1] = {
    NULL, /* FIOSTRUCT_NONE */
    NULL, /* FID_CILIST */
    NULL, /* FID_ICILIST */
    NULL, /* FID_OLIST */
    NULL, /* FID_FLIST */
    NULL, /* FID_INLIST */
    NULL, /* FID_ALIST */
    NULL, /* FID_CLLIST */
    NULL, /* FID_KEYSPEC */
    NULL, /* FID_CRAY_CLIST */
    NULL,       /* FID_CRAY_FCD */
    NULL, /* FID_CRAY_IOLIST */
    NULL, /* FID_CRAY_OPENLIST */
    NULL, /* FID_CRAY_CLOSELIST */
    NULL, /* FID_CRAY_INQLIST */
    NULL, /* FID_CRAY_DOPEVEC */
    NULL, /* FID_IOSCALAR_ENTRY */
    NULL, /* FID_IOARRAY_ENTRY */
    NULL  /* FID_IOIMPLIEDDO_ENTRY */
};

static PU * fio_current_pu = NULL;
static PU * mp_fio_current_pu = NULL;

static PU * namelist_current_pu = NULL;
static PU * cray_iolist_current_pu = NULL;
static WN     * namelist_node_list = NULL;
static WN     * namelist_node = NULL;
static ST     * container_block_for_iolists = NULL;
static INT32  num_iolists = 0;

/*  The following two tables describe all of the information about the       */
/*  I/O runtime structures which are used to pass information between user   */
/*  code and the runtime routines.               */
/*                       */
/*  WARNING:  It is absolutely critical that the following two structures    */
/*        track any changes made to /usr/include/cmplrs/fioext.h.        */

static FIOSTRUCTID_INFO fiostructid_info [FIOSTRUCTID_LAST + 1] = {
    FIOSTRUCT_NONE, FIOSTRUCT_NONE,   0,    0,  "",          "",
            "",        /* FIOSTRUCT_NONE */
    FSC_CIERR,   FSC_CISIZE,         72,  112,  ".cilist",   ".cilist_ptr",
            "_cilist",  /* FID_CILIST */
    FSI_ICIERR,  FSI_ICIRNUM,        32,   64,  ".icilist",  ".icilist_ptr",
            "_icilist",    /* FID_ICILIST */
    FSO_OERR,    FSO_OPOSITIONLEN,  136,  240,  ".olist",    ".olist_ptr",
            "_olist", /* FID_OLIST */
    FSF_FERR,    FSF_FREC,           16,   16,  ".flist",    ".flist_ptr",
            "_flist", /* FID_FLIST */
    FSN_INERR,   FSN_INWRITELEN,    216,  416,  ".inlist",   ".inlist_ptr",
            "_inlist",  /* FID_INLIST */
    FSA_AERR,    FSA_AUNIT,           8,    8,  ".alist",    ".alist_ptr",
            "_alist", /* FID_ALIST */
    FSL_CLERR,   FSL_CLSTA,          16,   16,  ".cllist",   ".cllist_ptr",
            "_cllist",  /* FID_CLLIST */
    FSK_START,   FSK_KEYTYPE,        6,   6,    ".keyspec",   ".keyspec_ptr",
            "_keyspec", /* FID_KEYSPEC*/
    FCR_CI_WORD1,  FCR_CI_SIZE,      48,  88, ".cray_clist",   ".cray_clist_ptr",
                "_cray_clist", /*FID_CRAY_CLIST*/
   FCR_FCD_ADDR,  FCR_FCD_LEN,       8,   16,   ".cray_fcd",    ".cray_fcd_ptr",
            "cray_fcd",   /* FID_CRAY_FCD */
   FCR_IOL_HEAD,  FCR_IOL_HEAD,      8,   8,    ".cray_iolist",  ".cray_iolist_ptr",
            "_cray_iolist",  /*FID_CRAY_IOLIST */
   FCR_OPEN_VERSION, FCR_OPEN_PAD,  96, 184,    ".cray_open_desc", ".cray_open_desc_ptr",
            "_cray_open_desc", /* FID_CRAY_OPENLIST */
   FCR_CLOSE_VERSION, FCR_CLOSE_STATUS, 28, 48, ".cray_close_desc", ".cray_close_desc_ptr",
            "_cray_close_desc", /* FID_CRAY_CLOSELIST */
   FCR_INQ_VERSION, FCR_INQ_PAD,   172, 336,    ".cray_inq_desc",  ".cray_inq_desc_ptr",
            "_cray_inq_desc", /* FID_CRAY_INQLIST */
   FCR_DV_BASE_PTR, FCR_DV_DIM7_EXTENT, 116,    216,  ".cray_dv_desc", ".cray_dv_desc_ptr",
            "_cray_dv_desc",  /* CRAY_DOPEVEC */
  FCR_IOSCALAR_ENTRY, FCR_IOSCALAR_CHAR_LEN, 24, 32, ".ioscalar_entry", "_ioscalar_ptr",
            "_ioscalar_entry",
  FCR_IOARRAY_ENTRY, FCR_IOARRAY_FLAG, 20, 24, ".ioarray_entry", "_ioarray_ptr",
            "_ioarray_entry",
  FCR_IOIMPLIEDDO_ENTRY, FCR_IOIMPLIEDDO_INC_CNT, 24, 40, ".ioimplieddo_entry", "_ioimplieddo_ptr",
            "_ioimplieddo_entry"
};

static FIOSTRUCT_INFO fiostruct_info [FIOSTRUCT_LAST + 1] = {
      0,         0,      0,         0,    FIOSTRUCTID_NONE,  "",
              /* FIOSTRUCT_NONE */

      0,  MTYPE_I4,      0,  MTYPE_I4,    FID_CILIST, "cierr",
              /* FSC_CIERR */
      4,  MTYPE_I4,      4,  MTYPE_I4,    FID_CILIST, "ciunit",
              /* FSC_CIUNIT */
      8,  MTYPE_I4,      8,  MTYPE_I4,    FID_CILIST, "ciend",
              /* FSC_CIEND */
     12,  MTYPE_U4,     16,  MTYPE_U8,    FID_CILIST, "cifmt",
              /* FSC_CIFMT */
     16,  MTYPE_I8,     24,  MTYPE_I8,    FID_CILIST, "cirec",
              /* FSC_CIREC */
     24,  MTYPE_I4,     32,  MTYPE_I4,    FID_CILIST, "cimatch",
              /* FSC_CIMATCH */
     28,  MTYPE_I4,     36,  MTYPE_I4,    FID_CILIST, "cikeytype",
              /* FSC_CIKEYTYPE */
     32,  MTYPE_I4,     40,  MTYPE_I8,    FID_CILIST, "cikeyval",
              /* FSC_CIKEYVAL */
     36,  MTYPE_I4,     48,  MTYPE_I4,    FID_CILIST, "cikeyid",
              /* FSC_CIKEYID */
     40,  MTYPE_U4,     56,  MTYPE_U8,    FID_CILIST, "cinml",
              /* FSC_CINML */
     44,  MTYPE_I4,     64,  MTYPE_I4,    FID_CILIST, "cikeyvallen",
              /* FSC_CIKEYVALLEN */
     48,  MTYPE_U4,     72,  MTYPE_U8,    FID_CILIST, "ciadvance",
              /* FSC_CIADVANCE */
     52,  MTYPE_I4,     80,  MTYPE_I4,    FID_CILIST, "ciadvancelen",
              /* FSC_CIADVANCELEN */
     56,  MTYPE_I4,     84,  MTYPE_I4,    FID_CILIST, "cieor",
              /* FSC_CIEOR */
     60,  MTYPE_U4,     88,  MTYPE_U8,    FID_CILIST, "cisize",
              /* FSC_CISIZE */
     64,  MTYPE_U4,     96,  MTYPE_U8,    FID_CILIST, "civfmt",
              /* FSC_CIVFMT */
     68,  MTYPE_U4,    104,  MTYPE_U8,    FID_CILIST, "civfmtfp",
              /* FSC_CIVFMTFP */

      0,  MTYPE_I4,      0,  MTYPE_I4,    FID_ICILIST,  "icierr",
              /* FSI_ICIERR */
      4,  MTYPE_U4,      8,  MTYPE_U8,    FID_ICILIST,  "iciunit",
              /* FSI_ICIUNIT */
      8,  MTYPE_I4,     16,  MTYPE_I4,    FID_ICILIST,  "iciend",
              /* FSI_ICIEND */
     12,  MTYPE_U4,     24,  MTYPE_U8,    FID_ICILIST,  "icifmt",
              /* FSI_ICIFMT */
     16,  MTYPE_I4,     32,  MTYPE_I8,    FID_ICILIST,  "icirlen",
              /* FSI_ICIRLEN */
     20,  MTYPE_I4,     40,  MTYPE_I8,    FID_ICILIST,  "icirnum",
              /* FSI_ICIRNUM */
     24,  MTYPE_U4,     48,  MTYPE_U8,    FID_ICILIST,  "icivfmt",
              /* FSI_ICIVFMT */
     28,  MTYPE_U4,     56,  MTYPE_U8,    FID_ICILIST,  "icivfmtfp",
              /* FSI_ICIVFMTFP */

      0,  MTYPE_I4,      0,  MTYPE_I4,    FID_OLIST,  "oerr",
              /* FSO_OERR */
      4,  MTYPE_I4,      4,  MTYPE_I4,    FID_OLIST,  "ounit",
              /* FSO_OUNIT */
      8,  MTYPE_U4,      8,  MTYPE_U8,    FID_OLIST,  "ofnm",
              /* FSO_OFNM */
     12,  MTYPE_I4,     16,  MTYPE_I4,    FID_OLIST,  "ofnmlen",
              /* FSO_OFNMLEN */
     16,  MTYPE_U4,     24,  MTYPE_U8,    FID_OLIST,  "osta",
              /* FSO_OSTA */
     20,  MTYPE_U4,     32,  MTYPE_U8,    FID_OLIST,  "oacc",
              /* FSO_OACC */
     24,  MTYPE_U4,     40,  MTYPE_U8,    FID_OLIST,  "ofm",
              /* FSO_OFM */
     28,  MTYPE_I4,     48,  MTYPE_I8,    FID_OLIST,  "orl",
              /* FSO_ORL */
     32,  MTYPE_U4,     56,  MTYPE_U8,    FID_OLIST,  "oblnk",
              /* FSO_OBLNK */
     36,  MTYPE_U4,     64,  MTYPE_U8,    FID_OLIST,  "occ",
              /* FSO_OCC */
     40,  MTYPE_U4,     72,  MTYPE_U8,    FID_OLIST,  "oorg",
              /* FSO_OORG */
     44,  MTYPE_I4,     80,  MTYPE_I4,    FID_OLIST,  "oshared",
              /* FSO_OSHARED */
     48,  MTYPE_I4,     84,  MTYPE_I4,    FID_OLIST,  "oreadonly",
              /* FSO_OREADONLY */
     52,  MTYPE_I4,     88,  MTYPE_I4,    FID_OLIST,  "onkeys",
              /* FSO_ONKEYS */
     56,  MTYPE_U4,     96,  MTYPE_U8,    FID_OLIST,  "okeys",
              /* FSO_OKEYS */
     60,  MTYPE_U4,    104,  MTYPE_U8,    FID_OLIST,  "oassocv",
              /* FSO_OASSOCV */
     64,  MTYPE_I8,    112,  MTYPE_I8,    FID_OLIST,  "omaxrec",
              /* FSO_OMAXREC */
     72,  MTYPE_U4,    120,  MTYPE_U8,    FID_OLIST,  "odfnm",
              /* FSO_ODFNM */
     76,  MTYPE_I4,    128,  MTYPE_I4,    FID_OLIST,  "odfnmlen",
              /* FSO_ODFNMLEN */
     80,  MTYPE_U4,    136,  MTYPE_U8,    FID_OLIST,  "odisp",
              /* FSO_ODISP */
     84,  MTYPE_U4,    144,  MTYPE_U8,    FID_OLIST,  "orectype",
              /* FSO_ORECTYPE */
     88,  MTYPE_U4,    152,  MTYPE_U8,    FID_OLIST,  "oconv",
              /* FSO_OCONV */
     92,  MTYPE_I4,    160,  MTYPE_I4,    FID_OLIST,  "oconvlen",
              /* FSO_OCONVLEN */
     96,  MTYPE_I4,    164,  MTYPE_I4,    FID_OLIST,  "obuffsize",
              /* FSO_OBUFFSIZE */
    100,  MTYPE_I4,    168,  MTYPE_I4,    FID_OLIST,  "odirect",
              /* FSO_ODIRECT */
    104,  MTYPE_U4,    176,  MTYPE_U8,    FID_OLIST,  "oaction",
              /* FSO_OACTION */
    108,  MTYPE_I4,    184,  MTYPE_I4,    FID_OLIST,  "oactionlen",
              /* FSO_OACTIONLEN */
    112,  MTYPE_U4,    192,  MTYPE_U8,    FID_OLIST,  "odelim",
              /* FSO_ODELIM */
    116,  MTYPE_I4,    200,  MTYPE_I4,    FID_OLIST,  "odelimlen",
              /* FSO_ODELIMLEN */
    120,  MTYPE_U4,    208,  MTYPE_U8,    FID_OLIST,  "opad",
              /* FSO_OPAD */
    124,  MTYPE_I4,    216,  MTYPE_I4,    FID_OLIST,  "opadlen",
              /* FSO_OPADLEN */
    128,  MTYPE_U4,    224,  MTYPE_U8,    FID_OLIST,  "oposition",
              /* FSO_OPOSITION */
    132,  MTYPE_I4,    232,  MTYPE_I4,    FID_OLIST,  "opositionlen",
              /* FSO_OPOSITIONLEN */

      0,  MTYPE_I4,      0,  MTYPE_I4,    FID_FLIST,  "ferr",
              /* FSF_FERR */
      4,  MTYPE_I4,      4,  MTYPE_I4,    FID_FLIST,  "funit",
              /* FSF_FUNIT */
      8,  MTYPE_I8,      8,  MTYPE_I8,    FID_FLIST,  "frec",
              /* FSF_FREC */

      0,  MTYPE_I4,      0,  MTYPE_I4,    FID_INLIST, "inerr",
              /* FSN_INERR */
      4,  MTYPE_I4,      4,  MTYPE_I4,    FID_INLIST, "inunit",
              /* FSN_INUNIT */
      8,  MTYPE_U4,      8,  MTYPE_U8,    FID_INLIST, "infile",
              /* FSN_INFILE */
     12,  MTYPE_I4,     16,  MTYPE_I4,    FID_INLIST, "infilen",
              /* FSN_INFILEN */
     16,  MTYPE_U4,     24,  MTYPE_U8,    FID_INLIST, "inex",
              /* FSN_INEX */
     20,  MTYPE_U4,     32,  MTYPE_U8,    FID_INLIST, "inopen",
              /* FSN_INOPEN */
     24,  MTYPE_U4,     40,  MTYPE_U8,    FID_INLIST, "innum",
              /* FSN_INNUM */
     28,  MTYPE_U4,     48,  MTYPE_U8,    FID_INLIST, "innamed",
              /* FSN_INNAMED */
     32,  MTYPE_U4,     56,  MTYPE_U8,    FID_INLIST, "inname",
              /* FSN_INNAME */
     36,  MTYPE_I4,     64,  MTYPE_I4,    FID_INLIST, "innamlen",
              /* FSN_INNAMLEN */
     40,  MTYPE_U4,     72,  MTYPE_U8,    FID_INLIST, "inacc",
              /* FSN_INACC */
     44,  MTYPE_I4,     80,  MTYPE_I4,    FID_INLIST, "inacclen",
              /* FSN_INACCLEN */
     48,  MTYPE_U4,     88,  MTYPE_U8,    FID_INLIST, "inseq",
              /* FSN_INSEQ */
     52,  MTYPE_I4,     96,  MTYPE_I4,    FID_INLIST, "inseqlen",
              /* FSN_INSEQLEN */
     56,  MTYPE_U4,    104,  MTYPE_U8,    FID_INLIST, "indir",
              /* FSN_INDIR */
     60,  MTYPE_I4,    112,  MTYPE_I4,    FID_INLIST, "indirlen",
              /* FSN_INDIRLEN */
     64,  MTYPE_U4,    120,  MTYPE_U8,    FID_INLIST, "infmt",
              /* FSN_INFMT */
     68,  MTYPE_I4,    128,  MTYPE_I4,    FID_INLIST, "infmtlen",
              /* FSN_INFMTLEN */
     72,  MTYPE_U4,    136,  MTYPE_U8,    FID_INLIST, "inform",
              /* FSN_INFORM */
     76,  MTYPE_I4,    144,  MTYPE_I4,    FID_INLIST, "informlen",
              /* FSN_INFORMLEN */
     80,  MTYPE_U4,    152,  MTYPE_U8,    FID_INLIST, "inunf",
              /* FSN_INUNF */
     84,  MTYPE_I4,    160,  MTYPE_I4,    FID_INLIST, "inunflen",
              /* FSN_INUNFLEN */
     88,  MTYPE_U4,    168,  MTYPE_U8,    FID_INLIST, "inrecl",
              /* FSN_INRECL */
     92,  MTYPE_U4,    176,  MTYPE_U8,    FID_INLIST, "innrec",
              /* FSN_INNREC */
     96,  MTYPE_U4,    184,  MTYPE_U8,    FID_INLIST, "inblank",
              /* FSN_INBLANK */
    100,  MTYPE_I4,    192,  MTYPE_I4,    FID_INLIST, "inblanklen",
              /* FSN_INBLANKLEN */
    104,  MTYPE_U4,    200,  MTYPE_U8,    FID_INLIST, "indefaultfile",
              /* FSN_INDEFAULTFILE */
    108,  MTYPE_I4,    208,  MTYPE_I4,    FID_INLIST, "indefaultfilelen",
                  /* FSN_INDEFAULTFILELEN */
    112,  MTYPE_U4,    216,  MTYPE_U8,    FID_INLIST, "incc",
              /* FSN_INCC */
    116,  MTYPE_I4,    224,  MTYPE_I4,    FID_INLIST, "incclen",
              /* FSN_INCCLEN */
    120,  MTYPE_U4,    232,  MTYPE_U8,    FID_INLIST, "inkeyed",
              /* FSN_INKEYED */
    124,  MTYPE_I4,    240,  MTYPE_I4,    FID_INLIST, "inkeyedlen",
              /* FSN_INKEYEDLEN */
    128,  MTYPE_U4,    248,  MTYPE_U8,    FID_INLIST, "inorg",
              /* FSN_INORG */
    132,  MTYPE_I4,    256,  MTYPE_I4,    FID_INLIST, "inorglen",
              /* FSN_INORGLEN */
    136,  MTYPE_U4,    264,  MTYPE_U8,    FID_INLIST, "inrecordtype",
              /* FSN_INRECORDTYPE */
    140,  MTYPE_I4,    272,  MTYPE_I4,    FID_INLIST, "inrecordtypelen",
                   /* FSN_INRECORDTYPELEN */
    144,  MTYPE_U4,    280,  MTYPE_U8,    FID_INLIST, "inconv",
              /* FSN_INCONV */
    148,  MTYPE_I4,    288,  MTYPE_I4,    FID_INLIST, "inconvlen",
              /* FSN_INCONVLEN */
    152,  MTYPE_U4,    296,  MTYPE_U8,    FID_INLIST, "inbuffsize",
              /* FSN_INBUFFSIZE */
    156,  MTYPE_U4,    304,  MTYPE_U8,    FID_INLIST, "inaction",
              /* FSN_INACTION */
    160,  MTYPE_I4,    312,  MTYPE_I4,    FID_INLIST, "inactionlen",
              /* FSN_INACTIONLEN */
    164,  MTYPE_U4,    320,  MTYPE_U8,    FID_INLIST, "indelim",
              /* FSN_INDELIM */
    168,  MTYPE_I4,    328,  MTYPE_I4,    FID_INLIST, "indelimlen",
              /* FSN_INDELIMLEN */
    172,  MTYPE_U4,    336,  MTYPE_U8,    FID_INLIST, "inpad",
              /* FSN_INPAD */
    176,  MTYPE_I4,    344,  MTYPE_I4,    FID_INLIST, "inpadlen",
              /* FSN_INPADLEN */
    180,  MTYPE_U4,    352,  MTYPE_U8,    FID_INLIST, "inposition",
              /* FSN_INPOSITION */
    184,  MTYPE_I4,    360,  MTYPE_I4,    FID_INLIST, "inpositionlen",
              /* FSN_INPOSITIONLEN */
    188,  MTYPE_U4,    368,  MTYPE_U8,    FID_INLIST, "inread",
              /* FSN_INREAD */
    192,  MTYPE_I4,    376,  MTYPE_I4,    FID_INLIST, "inreadlen",
              /* FSN_INREADLEN */
    196,  MTYPE_U4,    384,  MTYPE_U8,    FID_INLIST, "inreadwrite",
              /* FSN_INREADWRITE */
    200,  MTYPE_I4,    392,  MTYPE_I4,    FID_INLIST, "inreadwritelen",
              /* FSN_INREADWRITELEN */
    204,  MTYPE_U4,    400,  MTYPE_U8,    FID_INLIST, "inwrite",
              /* FSN_INWRITE */
    208,  MTYPE_I4,    408,  MTYPE_I4,    FID_INLIST, "inwritelen",
              /* FSN_INWRITELEN */

      0,  MTYPE_I4,      0,  MTYPE_I4,    FID_ALIST,  "aerr",
              /* FSA_AERR */
      4,  MTYPE_I4,      4,  MTYPE_I4,    FID_ALIST,  "aunit",
              /* FSA_AUNIT */

      0,  MTYPE_I4,      0,  MTYPE_I4,    FID_CLLIST, "clerr",
              /* FSL_CLERR */
      4,  MTYPE_I4,      4,  MTYPE_I4,    FID_CLLIST, "clunit",
              /* FSL_CLUNIT */
      8,  MTYPE_U4,      8,  MTYPE_U8,    FID_CLLIST, "clsta",
              /* FSL_CLSTA */
  
      0, MTYPE_I2,   0,  MTYPE_I2,    FID_KEYSPEC, "keystart",
              /* FSK_KEYSTART */
      2, MTYPE_I2,       2,  MTYPE_I2,    FID_KEYSPEC, "keyend",
              /* FSK_KEYEND */
      4, MTYPE_I2,       4,  MTYPE_I2,    FID_KEYSPEC, "keytype",
              /* FSK_KEYTYPE */

      0, MTYPE_U8,       0,  MTYPE_U8,    FID_CRAY_CLIST, "cray_ci_word1",
              /* FCR_CI_WORD1 */
      8, MTYPE_M,        8,  MTYPE_M,     FID_CRAY_CLIST, "cray_ci_unit",
              /* FCR_CI_UNIT */
     16, MTYPE_U4,      24,  MTYPE_U8,    FID_CRAY_CLIST, "cray_ci_iostat",
              /* FCR_CI_IOSTAT */
     20, MTYPE_U4,      32,  MTYPE_U8,    FID_CRAY_CLIST, "cray_ci_rec",
              /* FCR_CI_REC */
     24, MTYPE_U4,      40,  MTYPE_U8,    FID_CRAY_CLIST, "cray_ci_parsfmt",
              /* FCR_CI_PARSFMT */
     28, MTYPE_M,       48,  MTYPE_M,     FID_CRAY_CLIST, "cray_ci_fmtsrc",
              /* FCR_CI_FMTSRC */
     36, MTYPE_M,       64,  MTYPE_M,     FID_CRAY_CLIST, "cray_ci_advance",
              /* FCR_CI_ADVANCE */
     44, MTYPE_U4,      80, MTYPE_U8,     FID_CRAY_CLIST, "cray_ci_size",
              /* FCR_CI_SIZE */

      0, MTYPE_U4,  0, MTYPE_U8,    FID_CRAY_FCD,   "cray_fcd_addr",
              /* FCR_FCD_ADDR */
      4, MTYPE_U4,      8, MTYPE_U8,      FID_CRAY_FCD,   "cray_fcd_len",
              /* FCR_FCD_LEN */

      0, MTYPE_U8,  0, MTYPE_U8,    FID_CRAY_IOLIST, "cray_iol_head",
              /* FCR_IOL_HEAD */

      0, MTYPE_U8,  0, MTYPE_U8,      FID_CRAY_OPENLIST, "cray_open_version",
              /* FCR_OPEN_VERSION */
      8, MTYPE_U4,  8, MTYPE_U8,      FID_CRAY_OPENLIST, "cray_open_unit",
              /* FCR_OPEN_UNIT */
     12, MTYPE_U4,     16, MTYPE_U8,      FID_CRAY_OPENLIST, "cray_open_iostat",
              /* FCR_OPEN_IOSTAT */
     16, MTYPE_U4,     24, MTYPE_U8,      FID_CRAY_OPENLIST, "cray_open_err",
              /* FCR_OPEN_ERR */
     20, MTYPE_M,      32, MTYPE_M,       FID_CRAY_OPENLIST, "cray_open_file",
              /* FCR_OPEN_FILE */
     28, MTYPE_M,      48, MTYPE_M,       FID_CRAY_OPENLIST, "cray_open_status",
              /* FCR_OPEN_STATUS */
     36, MTYPE_M,      64, MTYPE_M,       FID_CRAY_OPENLIST, "cray_open_access",
              /* FCR_OPEN_ACCESS */
     44, MTYPE_M,      80, MTYPE_M,       FID_CRAY_OPENLIST, "cray_open_form",
              /* FCR_OPEN_FORM */
     52, MTYPE_U4,     96, MTYPE_U8,      FID_CRAY_OPENLIST, "cray_open_recl",
              /* FCR_OPEN_RECL */
     56, MTYPE_M,     104, MTYPE_M,       FID_CRAY_OPENLIST, "cray_open_blank",
              /* FCR_OPEN_BLANK */
     64, MTYPE_M,     120, MTYPE_M,       FID_CRAY_OPENLIST, "cray_open_position",
              /* FCR_OPEN_POSITION */
     72, MTYPE_M,     136, MTYPE_M,       FID_CRAY_OPENLIST, "cray_open_action",
              /* FCR_OPEN_ACTION */
     80, MTYPE_M,     152, MTYPE_M,       FID_CRAY_OPENLIST, "cray_open_delim",
              /* FCR_OPEN_DELIM */
     88, MTYPE_M,     168, MTYPE_M,       FID_CRAY_OPENLIST, "cray_open_pad",
              /* FCR_OPEN_PAD */

     0, MTYPE_U8,      0, MTYPE_U8,       FID_CRAY_CLOSELIST, "cray_close_version",
              /* FCR_CLOSE_VERSION */
     8, MTYPE_U4,      8, MTYPE_U8,       FID_CRAY_CLOSELIST, "cray_close_unit",
              /* FCR_CLOSE_UNIT */
    12, MTYPE_U4,     16, MTYPE_U8,       FID_CRAY_CLOSELIST, "cray_close_iostat",
              /* FCR_CLOSE_IOSTAT */
    16, MTYPE_U4,     24, MTYPE_U8,       FID_CRAY_CLOSELIST, "cray_close_err",
              /* FCR_CLOSE_ERR */
    20, MTYPE_M,      32, MTYPE_M,        FID_CRAY_CLOSELIST, "cray_close_status",
              /* FCR_CLOSE_STATUS */

     0, MTYPE_U8,      0, MTYPE_U8,       FID_CRAY_INQLIST,   "cray_inq_version",
              /* FCR_INQ_VERSION */ 
     8, MTYPE_U4,      8, MTYPE_U8,       FID_CRAY_INQLIST,   "cray_inq_unit",
              /* FCR_INQ_UNIT */
    12, MTYPE_M,      16, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_file",
              /* FCR_INQ_FILE */
    20, MTYPE_U4,     32, MTYPE_U8,       FID_CRAY_INQLIST,   "cray_inq_iostat",
              /* FCR_INQ_IOSTAT */
    24, MTYPE_U4,     40, MTYPE_U8,       FID_CRAY_INQLIST,   "cray_inq_err",
              /* FCR_INQ_ERR */
    28, MTYPE_U4,     48, MTYPE_U8,       FID_CRAY_INQLIST,   "cray_inq_exist",
              /* FCR_INQ_EXIST */
    32, MTYPE_U4,     56, MTYPE_U8,       FID_CRAY_INQLIST,   "cray_inq_opened",
              /* FCR_INQ_OPENED */
    36, MTYPE_U4,     64, MTYPE_U8,       FID_CRAY_INQLIST,   "cray_inq_number",
              /* FCR_INQ_NUMBER */
    40, MTYPE_U4,     72, MTYPE_U8,       FID_CRAY_INQLIST,   "cray_inq_named",
              /* FCR_INQ_NAMED */
    44, MTYPE_M,      80, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_name",
              /* FCR_INQ_NAME */
    52, MTYPE_M,      96, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_access",
              /* FCR_INQ_ACCESS */
    60, MTYPE_M,     112, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_sequential",
              /* FCR_INQ_SEQUENTIAL */
    68, MTYPE_M,     128, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_direct",
              /* FCR_INQ_DIRECT */
    76, MTYPE_M,     144, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_form",
              /* FCR_INQ_FORM */
    84, MTYPE_M,     160, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_formatted",
              /* FCR_INQ_FORMATTED */
    92, MTYPE_M,     176, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_unformatted",
              /* FCR_INQ_UNFORMATTED */
   100, MTYPE_U4,    192, MTYPE_U8,       FID_CRAY_INQLIST,   "cray_inq_recl",
              /* FCR_INQ_RECL */
   104, MTYPE_U4,    200, MTYPE_U8,       FID_CRAY_INQLIST,   "cray_inq_nextrec",
              /* FCR_INQ_NEXTREC */
   108, MTYPE_M,     208, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_blank",
              /* FCR_INQ_BLANK */
   116, MTYPE_M,     224, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_position",
              /* FCR_INQ_POSITION */
   124, MTYPE_M,     240, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_action",
              /* FCR_INQ_ACTION */
   132, MTYPE_M,     256, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_read",
              /* FCR_INQ_READ */
   140, MTYPE_M,     272, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_write",
              /* FCR_INQ_WRITE */
   148, MTYPE_M,     288, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_readwrite",
              /* FCR_INQ_READWRITE */
   156, MTYPE_M,     304, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_delim",
              /* FCR_INQ_DELIM */
   164, MTYPE_M,     320, MTYPE_M,        FID_CRAY_INQLIST,   "cray_inq_pad",
              /* FCR_INQ_PAD */

     0, MTYPE_U4,      0, MTYPE_U8, FID_CRAY_DOPEVEC, "cray_dv_base_addr",
              /* FCR_DV_BASE_PTR */
     4, MTYPE_I4,      8, MTYPE_I8, FID_CRAY_DOPEVEC, "cray_dv_base_len",
              /* FCR_DV_BASE_LEN */
     8, MTYPE_U8,      16, MTYPE_U8,  FID_CRAY_DOPEVEC, "cray_dv_flag_info",
              /* FCR_DV_FLAG_INFO */
     16, MTYPE_U8,     24, MTYPE_U8,  FID_CRAY_DOPEVEC, "cray_dv_type_len",
              /* FCR_DV_TYPE_LEN */
     24, MTYPE_U4,     32, MTYPE_U8,  FID_CRAY_DOPEVEC, "cray_dv_orig_base",
              /* FCR_DV_ORIG_BASE */
     28, MTYPE_I4,     40, MTYPE_I8,  FID_CRAY_DOPEVEC, "cray_dv_orig_size",
              /* FCR_DV_ORIG_SIZE */
     32, MTYPE_I4,     48, MTYPE_I8,  FID_CRAY_DOPEVEC, "cray_dv_dim1_lb",
              /* FCR_DV_DIM1_LB */
     36, MTYPE_I4,     56, MTYPE_I8,  FID_CRAY_DOPEVEC, "cray_dv_dim1_extent",
              /* FCR_DV_DIM1_EXTENT */
     40, MTYPE_I4,     64, MTYPE_I8,  FID_CRAY_DOPEVEC, "cray_dv_dim1_stride",
              /* FCR_DV_DIM1_STRIDE */
     44, MTYPE_I4,     72, MTYPE_I8,  FID_CRAY_DOPEVEC, "cray_dv_dim2_lb",
              /* FCR_DV_DIM2_LB */
     48, MTYPE_I4,     80, MTYPE_I8,  FID_CRAY_DOPEVEC, "cray_dv_dim2_extent",
              /* FCR_DV_DIM2_EXTENT */
     52, MTYPE_I4,     88, MTYPE_I8,  FID_CRAY_DOPEVEC, "cray_dv_dim2_stride",
              /* FCR_DV_DIM2_STRIDE */
     56, MTYPE_I4,     96, MTYPE_I8,  FID_CRAY_DOPEVEC, "cray_dv_dim3_lb",
              /* FCR_DV_DIM3_LB */
     60, MTYPE_I4,     104, MTYPE_I8, FID_CRAY_DOPEVEC, "cray_dv_dim3_extent",
              /* FCR_DV_DIM3_EXTENT */
     64, MTYPE_I4,     112, MTYPE_I8, FID_CRAY_DOPEVEC, "cray_dv_dim3_stride",
              /* FCR_DV_DIM3_STRIDE */
     68, MTYPE_I4,     120, MTYPE_I8, FID_CRAY_DOPEVEC, "cray_dv_dim4_lb",
              /* FCR_DV_DIM4_LB */
     72, MTYPE_I4,     128, MTYPE_I8, FID_CRAY_DOPEVEC, "cray_dv_dim4_extent",
              /* FCR_DV_DIM4_EXTENT */
     76, MTYPE_I4,     136, MTYPE_I8, FID_CRAY_DOPEVEC, "cray_dv_dim4_stride",
              /* FCR_DV_DIM4_STRIDE */
     80, MTYPE_I4,     144, MTYPE_I8, FID_CRAY_DOPEVEC, "cray_dv_dim5_lb",
              /* FCR_DV_DIM5_LB */
     84, MTYPE_I4,     152, MTYPE_I8, FID_CRAY_DOPEVEC, "cray_dv_dim5_extent",
              /* FCR_DV_DIM5_EXTENT */
     88, MTYPE_I4,     160, MTYPE_I8, FID_CRAY_DOPEVEC, "cray_dv_dim5_stride",
              /* FCR_DV_DIM5_STRIDE */
     92, MTYPE_I4,     168, MTYPE_I8, FID_CRAY_DOPEVEC, "cray_dv_dim6_lb",
              /* FCR_DV_DIM6_LB */
     96, MTYPE_I4,     176, MTYPE_I8, FID_CRAY_DOPEVEC, "cray_dv_dim6_extent",
              /* FCR_DV_DIM6_EXTENT */
     100, MTYPE_I4,    184, MTYPE_I8, FID_CRAY_DOPEVEC, "cray_dv_dim6_stride",
              /* FCR_DV_DIM6_STRIDE */
     104, MTYPE_I4,    192, MTYPE_I8, FID_CRAY_DOPEVEC, "cray_dv_dim7_lb",
              /* FCR_DV_DIM7_LB */
     108, MTYPE_I4,    200, MTYPE_I8, FID_CRAY_DOPEVEC, "cray_dv_dim7_extent",
              /* FCR_DV_DIM7_EXTENT */
     112, MTYPE_I4,    208, MTYPE_I8, FID_CRAY_DOPEVEC, "cray_dv_dim7_stride",
              /* FCR_DV_DIM7_STRIDE */
       /* FCR_IOSCALAR_ENTRY */
       0, MTYPE_I8, 0, MTYPE_I8,    FID_IOSCALAR_ENTRY, "scalar_header",
       8, MTYPE_I8, 8, MTYPE_I8,    FID_IOSCALAR_ENTRY, "scalar_type_t",
      16, MTYPE_U4,    16, MTYPE_U8,  FID_IOSCALAR_ENTRY, "iovar_address",
      20, MTYPE_I4,    24, MTYPE_I8,    FID_IOSCALAR_ENTRY, "scalar_char_len",

      /* FCR_IOARRAY_ENTRY */
       0, MTYPE_I8,     0, MTYPE_I8,    FID_IOARRAY_ENTRY, "array_header",
       8, MTYPE_U4,     8, MTYPE_U8,    FID_IOARRAY_ENTRY, "dope_vector_addr",
      12, MTYPE_I8,    16, MTYPE_I8,    FID_IOARRAY_ENTRY, "array_flag",
      20, MTYPE_U4,    24, MTYPE_U8,    FID_IOARRAY_ENTRY, "array_indx_1",
      24, MTYPE_U4,    32, MTYPE_U8,    FID_IOARRAY_ENTRY, "array_indx_2",
      28, MTYPE_U4,    40, MTYPE_U8,    FID_IOARRAY_ENTRY, "array_indx_3",
      32, MTYPE_U4,    48, MTYPE_U8,    FID_IOARRAY_ENTRY, "array_indx_4",
      36, MTYPE_U4,    56, MTYPE_U8,    FID_IOARRAY_ENTRY, "array_indx_5",
      40, MTYPE_U4,    64, MTYPE_U8,    FID_IOARRAY_ENTRY, "array_indx_6",
      44, MTYPE_U4,    72, MTYPE_U8,    FID_IOARRAY_ENTRY, "array_indx_7",

      /* FCR_IOIMPLIEDDO_ENTRY */
       0, MTYPE_I8,     0, MTYPE_I8,    FID_IOIMPLIEDDO_ENTRY, "implieddo_header",
       8, MTYPE_U4,     8, MTYPE_U8,    FID_IOIMPLIEDDO_ENTRY, "loop_var_addr",
      12, MTYPE_U4,    16, MTYPE_U8,    FID_IOIMPLIEDDO_ENTRY, "begin_cnt_addr",
      16, MTYPE_U4,    24, MTYPE_U8,    FID_IOIMPLIEDDO_ENTRY, "end_cnt__addr",
      20, MTYPE_U4,    32, MTYPE_U8,    FID_IOIMPLIEDDO_ENTRY, "inc_cnt_addr",
};


#define FIO_OFFSET(i) ((Pointer_Size == 4) ? fiostruct_info[i].offset32 \
            : fiostruct_info[i].offset64)
#define FIO_TYPE(i) ((Pointer_Size == 4) ? fiostruct_info[i].type32 \
            : fiostruct_info[i].type64)
#define FIO_SIZE(i) ((Pointer_Size == 4) ? fiostructid_info[i].size32 \
            : fiostructid_info[i].size64)
#define Int_Type        ((Pointer_Size == 4) ? MTYPE_I4 : MTYPE_I8)
#define OPC_IntWord ((Pointer_Size == 4) ? OPC_I4INTCONST : OPC_I8INTCONST)


static WN *extract_calls ( WN *, WN * );
static INT32
lower_f77_io_items ( WN *, WN *, WN *, WN*, WN*, FIOOPER, BOOL, INT32 *,
      INT32, INT32 );
static void
lower_f77_record_items (WN *, WN *, WN *, WN *, WN *, WN *,
      FIOOPER, ST **, TY_IDX*, INT32 *, FLD_HANDLE&,
      INT32 *, INT32 *, INT32, TY_IDX , INT64);

/*  The following table gives the I/O mask code for each of the basic types.  */

static INT32 fio_maskcode [MTYPE_LAST + 1] = {
  0,  /* MTYPE_UNKNOWN */
  0,  /* MTYPE_B */
  1,  /* MTYPE_I1 */
  2,  /* MTYPE_I2 */
  0,  /* MTYPE_I4 */
  3,  /* MTYPE_I8 */
  1,  /* MTYPE_U1 */
  2,  /* MTYPE_U2 */
  0,  /* MTYPE_U4 */
  3,  /* MTYPE_U8 */
  0,  /* MTYPE_F4 */
  0,  /* MTYPE_F8 */
  0,  /* MTYPE_F10 */
  0,  /* MTYPE_F16 */
  0,  /* MTYPE_STRING */
  0,  /* MTYPE_FQ */
  0,  /* MTYPE_M */
  0,  /* MTYPE_C4 */
  0,  /* MTYPE_C8 */
  0,  /* MTYPE_CQ */
  0 /* MTYPE_V */
};



typedef enum {
   ARB_UBOUND,
   ARB_LBOUND,
   ARB_STRIDE
} arb_enum;

static WN *
Get_ST_Ldid(ST_IDX st)
{
   WN *r;
   TY_IDX ty;
   ty = ST_type(st);
   r = WN_Ldid(TY_mtype(ty),0,st,ty);
   return (r);
}

static void io_set_addr_passed_flag(ST *st) {
   if ( WHIRL_Addr_Passed_On ) 
      Set_ST_addr_passed(st);
   if (WHIRL_Addr_Saved_For_Passed_On)
      Set_ST_addr_saved(st);
}

static void io_set_addr_saved_flag(ST *st) {
   if (WHIRL_Addr_Saved_On)
      Set_ST_addr_saved(st);
}

// Utility to return as a WHIRL node the value of an ARB
static WN *
Get_ARB_WN(const ARB_HANDLE arb, arb_enum whattoget)
{
   switch (whattoget) {
    case ARB_UBOUND:
       if (ARB_const_ubnd(arb)) {
    return (WN_Intconst(MTYPE_I8,ARB_ubnd_val(arb)));
       } else {
    return (Get_ST_Ldid(ARB_ubnd_var(arb)));
       }
    case ARB_LBOUND:
       if (ARB_const_lbnd(arb)) {
    return (WN_Intconst(MTYPE_I8,ARB_lbnd_val(arb)));
       } else {
    return (Get_ST_Ldid(ARB_lbnd_var(arb)));
       }
    case ARB_STRIDE:
       if (ARB_const_stride(arb)) {
    return (WN_Intconst(MTYPE_I8,ARB_stride_val(arb)));
       } else {
    return (Get_ST_Ldid(ARB_stride_var(arb)));
       }
   }
   Fail_FmtAssertion("bad arguments to Get_ARB_WN");
   return NULL;
}


static TY_IDX
Make_Simple_Array_Type (const char *name, INT32 n_elems, TY_IDX elem_ty)
{
    TY_IDX ty_idx;
    TY& ty = New_TY (ty_idx);

    UINT32 elem_size = TY_size (elem_ty);

    TY_Init (ty, elem_size * n_elems, KIND_ARRAY, MTYPE_UNKNOWN,
       Save_Str (name));
    Set_TY_etype (ty, elem_ty);

    ARB_HANDLE arb = New_ARB ();
    ARB_Init (arb, 0, n_elems - 1, elem_size);
    Set_ARB_first_dimen (arb);
    Set_ARB_last_dimen (arb);

    Set_TY_arb (ty, arb);
    Set_TY_align_exp (ty_idx, TY_align_exp (elem_ty));
    return ty_idx;
}


static void
Alloc_More_For_Dummy_Array(void)
{
   if (fio_dummy_max == 0) {
      fio_dummy_max = 32;
      fio_dummy_ref = (BOOL *)  malloc (sizeof(BOOL) * fio_dummy_max);
      fio_dummy_st = (ST **) malloc (sizeof(ST *) * fio_dummy_max);
      fio_dummy_tyidx = (TY_IDX *) malloc (sizeof(TY_IDX *) * fio_dummy_max);
      fio_dummy_ofst = (WN_OFFSET *) malloc (sizeof(WN_OFFSET) *
                                                    fio_dummy_max);
   } else {
      fio_dummy_max = fio_dummy_max + (fio_dummy_max >> 1);
      fio_dummy_ref = (BOOL *) realloc (fio_dummy_ref,
                                    sizeof(BOOL) * fio_dummy_max);
      fio_dummy_st = (ST **) realloc (fio_dummy_st,
                                      sizeof(ST *) * fio_dummy_max);
      fio_dummy_tyidx = (TY_IDX *) realloc (fio_dummy_tyidx,
                                      sizeof(TY_IDX *) * fio_dummy_max);
      fio_dummy_ofst = (WN_OFFSET *) realloc (fio_dummy_ofst,
                                     sizeof(WN_OFFSET) * fio_dummy_max);
   }
}

static void
Add_To_Dummy_List(WN *dummy) 
{
    while ((WN_operator(dummy) != OPR_LDA) && 
     (WN_operator(dummy) != OPR_LDID))
  if ((WN_operator(dummy) == OPR_ADD) &&
      (WN_operator(WN_kid0(dummy)) == OPR_MPY))
      dummy = WN_kid1(dummy);
  else
      dummy = WN_kid0(dummy);

    if (fio_dummy_count == fio_dummy_max)
  Alloc_More_For_Dummy_Array();

    ST* st = WN_st (dummy);
    fio_dummy_ref[fio_dummy_count]    = WN_operator(dummy) == OPR_LDA;
    fio_dummy_st[fio_dummy_count]     = st;
    fio_dummy_tyidx[fio_dummy_count]  = WN_ty(dummy);
    fio_dummy_ofst[fio_dummy_count++] = WN_offset(dummy);
    if (ST_class(st) == CLASS_VAR)
       io_set_addr_saved_flag(st);
}

static char *
Remove_Trailing_Blanks(char *s)
{
  char *c;
  c = s + strlen(s) - 1;
  while (*c == ' ')
    c--;
  c++;
  *c = '\0';
  return s;
}
/*===================================================
 *
 * Find_array_TY
 *
 * Given a TY, find its array ty, ie: the bottom
 * of any KIND_POINTERS to a KIND_ARRAY etc...
 * Given a scalar, just hand it back..
 *
 ====================================================
*/
extern TY_IDX 
Find_array_TY(TY_IDX  ty)
{
  TY_IDX  rty ;

  switch(TY_kind(ty)) {
  case KIND_ARRAY:
  case KIND_SCALAR:
  case KIND_STRUCT:
  case KIND_FUNCTION:
  case KIND_VOID:
    rty = ty;
    break;

  case KIND_POINTER:
    rty = Find_array_TY(TY_pointed(Ty_Table[ty])) ;
    break;

  default:
    DevAssert((0),("Odd array ty"));
    break;
  }

  return(rty);
}

/*===================================================
 *
 * Find_scalar_TY
 *
 * Given a TY, find its scalar ty, ie: the bottom
 * of any KIND_ARRAYs
 *
 ====================================================
*/
extern TY_IDX 
Find_scalar_TY(TY_IDX  ty)
{
  TY_IDX  rty ;

  switch(TY_kind(ty)) {

  case KIND_VOID:
  case KIND_SCALAR:
  case KIND_STRUCT:
  case KIND_POINTER:
  case KIND_FUNCTION:
    rty = ty;
    break;

  case KIND_ARRAY:
    rty = Find_scalar_TY(TY_AR_etype(ty)) ;
    break;

  default:
    DevAssert((0),("Odd ty"));
    break;
  }

  return(rty);
}
/* ====================================================================
 *
 * WN *create_lda_of_temp(WN *block, WN *tree, TY_IDX ty)
 *
 * Store tree into a temp and create lda of that temp
 *
 * ==================================================================== */
static WN *create_lda_of_temp(WN *block, WN *tree, TY_IDX ty)
{
      TYPE_ID   type;
      ST  *st;
      WN  *stid;

      Is_True((WN_operator_is(tree, OPR_PARM)==FALSE),("bad parm"));
      /*
       *  store value to an addressible temporary, and take the address of that
       */
      if (ty)
         type = TY_mtype(ty);
      else
         type = WN_rtype(tree);

      st = Gen_Temp_Symbol( MTYPE_To_TY(type), "complex-temp-expr");
      stid = WN_Stid (type, 0, st, ST_type(st), WN_COPY_Tree(tree));
      WN_INSERT_BlockLast(block, stid);

      return WN_Lda(Pointer_type, WN_store_offset(stid), st);
}

/* ====================================================================
 *
 * WN *create_pointer_to_node(WN *block, WN *tree, TY_IDX ty, BOOL deref)
 *
 * Return the address of tree.
 *  for ILOAD and LDID use address directly if desc type and rtype is same.
 *  if a ty is passed, rtype is determined from this ty rather than from the
 *  rtype of the whirl node we are dealing with
 *
 *      for ISTORE we can use the address directly
 *      for LDID/STID we can create an LDA
 *      otherwise we need to create an addressable temp, store to it
 *      and try again.
 *  
 *  When 'deref' is FALSE, then for an LDA and ARRAY node, we will still
 *  store into a temp and pass the address of the temp; this is needed for
 *  example in write(*,*) loc(x); we don't want the library to dereference
 *  x, we just want to print the address of x.
 * ==================================================================== */

static WN *create_pointer_to_node(WN *block, WN *tree, TY_IDX ty, BOOL deref)
{

  TYPE_ID rtype;
  TYPE_ID desc;
  WN  *add;

  /* Need to deal with the INTRINSIC_OP */
  tree = extract_calls( block, tree );
  switch (WN_operator(tree))
  {
  case OPR_ILOAD:
      if (ty)
  rtype = TY_mtype( ty );
     else
        rtype = WN_rtype(tree);

      desc = WN_desc(tree);

      if (rtype == desc) {
   add = WN_Add(Pointer_Mtype,WN_kid0(tree),
          WN_Intconst(Pointer_Mtype,WN_load_offset(tree)));
   return (add);
      } else {
         return create_lda_of_temp(block, tree, ty); 
      }
    
  case OPR_ISTORE:
    return WN_kid1(tree);

  case OPR_LDID:
      if ((Language == LANG_F77) && TY_is_character(Ty_Table [ty])) {
   /* When the incoming tree is an INTRIN_OP to handle concatenation
      of strings extract_calls could return with an LDID that is the 
      address of a string; PV 550165; in this situation we can just
      return what extract_calls gave us*/
   return tree;
      }
      if (ty)
  rtype = TY_mtype( ty );
      else
        rtype = WN_rtype(tree);

      desc = WN_desc(tree);
      if ((ST_class(WN_st(tree)) != CLASS_PREG) &&
    (rtype == desc)) {
         return WN_Lda(Pointer_type, WN_load_offset(tree), WN_st(tree));
      } else {
         return create_lda_of_temp(block, tree, ty);
      }

  case OPR_STID:
    return WN_Lda(Pointer_type, WN_store_offset(tree), WN_st(tree));

  case OPR_ARRAY:
  case OPR_LDA:
    if (deref) {
       return tree;
    } else {
      return create_lda_of_temp(block, tree, ty);
    }

  case OPR_ADD:

#ifdef KEY
    // Under -IPA, different PUs may have different src_lang, but the driver
    // always passes -LANG:=ansi_c
    if (!PU_f90_lang(Get_Current_PU())) {
#else
    if (Language != LANG_F90) {
#endif // KEY
       /* If address expression, return the tree */
  
       if (WN_opcode(tree) == OPC_U4ADD || WN_opcode(tree) == OPC_U8ADD)
           return(tree);
       else 
           return create_lda_of_temp(block, tree, ty);
    } else {
       return create_lda_of_temp(block, tree, ty);
    }

  case OPR_INTRINSIC_OP:
    {
      /* If it is an INTRINSIC_OP to get a VALTMP then cannot load that
      ** value and store in a temp.  Need to get kid(0) instead.
      */
    }
  default:
       return create_lda_of_temp(block, tree, ty);  
  }
}


/*===================================================
 *
 * Type_is_logical
 *
 * return T if this is a logical TY
 *
 ====================================================
*/
extern BOOL
Type_is_logical(TY_IDX  ty)
{
  TY_IDX  ts ;

#ifdef KEY
  // Under -IPA, different PUs may have different src_lang, but the driver
  // always passes -LANG:=ansi_c
  if (!PU_f90_lang(Get_Current_PU())) {
#else
  if (Language != LANG_F90) {
#endif // KEY
    ts = Find_array_TY(ty);
    ts = Find_scalar_TY(ts);
    return (TY_is_logical(Ty_Table[ts]));
  } else {
    return (TY_is_logical(Ty_Table[ty]));
  }
}

/*  This routine creates a global type for the selected I/O structure.    */
/*  These struct types are only created on demand when they are needed    */
/*  to support the creation of a local struct.  Once created, they have   */
/*  persistence throughout compiling the entire source file.  All of the  */
/*  information needed to create the structs (size, name, fields, etc)    */
/*  is contained in the fiostructid_info and fiostruct_info tables.       */ 
/*  This routine also creates a global type which is a pointer to the     */
/*  appropriate structure type.             */

static void Make_IoStruct_TY ( FIOSTRUCTID id )
{
    INT32 /* FIOSTRUCT */ i;
    FIOSTRUCT first = fiostructid_info[id].first;
    FIOSTRUCT last = fiostructid_info[id].last;

    /* Create the structure TY and fill in the appropriate fields. */

    /*
     ** If it is an iolist then make the type local so not to polute the
     ** global space with thousands of local types
     */

    TY_IDX ty_idx;
    TY& ty = New_TY (ty_idx);

    if (id == FID_CRAY_IOLIST) {
  sprintf( seq_buff, "_%d", local_sequence );
  TY_Init (ty, (Pointer_Size == 4 ? fiostructid_info[id].size32 :
          fiostructid_info[id].size64),
           KIND_STRUCT, MTYPE_M,
     Save_Str2 (fiostructid_info[id].name, seq_buff));
    } else {
  TY_Init (ty, (Pointer_Size == 4 ? fiostructid_info[id].size32 :
          fiostructid_info[id].size64),
     KIND_STRUCT, MTYPE_M,
     Save_Str (fiostructid_info[id].name));
    }
    
    if (current_io_library == IOLIB_MIPS) {
  if (id != FID_KEYSPEC)
      Set_TY_align (ty_idx, MTYPE_align_req(MTYPE_I8));
  else
      Set_TY_align (ty_idx, MTYPE_align_req(MTYPE_I2));
    } else {
  Set_TY_align (ty_idx, MTYPE_align_req(MTYPE_I8));
    }

    /* Create all of the subordinate field entries. */
    FLD_HANDLE fld;

    for (i = first; i <= last; ++i) {
  fld = New_FLD ();
  if (Pointer_Size == 4) {
      FLD_Init (fld, Save_Str (fiostruct_info[i].name),
          Be_Type_Tbl (fiostruct_info[i].type32),
          fiostruct_info[i].offset32);
  } else
      FLD_Init (fld, Save_Str (fiostruct_info[i].name),
          Be_Type_Tbl (fiostruct_info[i].type64),
          fiostruct_info[i].offset64);
    }
    Set_FLD_last_field (fld);
    Set_TY_fld (ty, FLD_HANDLE (fld.Idx () - (last - first)));


    /* Create the structure pointer TY and fill in the appropriate fields. */

    /*
     ** If it is an iolist then make the type local so not to polute the
     ** global space with thousands of local types
     */
    TY_IDX tyx_idx;
    TY& tyx = New_TY (tyx_idx);
    TY_Init (tyx, Pointer_Size, KIND_POINTER, Pointer_Mtype,
       Save_Str (fiostructid_info[id].name_ptr));
    Set_TY_align (tyx_idx, Pointer_Size);
    Set_TY_pointed (tyx, ty_idx);
    fiostruct_ty[id] = ty_idx;
}


/*  This routine returns the ST for a local structure of the requested type.  */
/*  If this is the first time in this PU, all saved ST pointers are cleared.  */
/*  If the ST already exists, just return it.  If the ST doesn't exist then   */
/*  create it.  If the global type doesn't exist, create that.  Finally, if   */
/*  requested, generate code to clear the structure.            */

static ST * Get_IoStruct_ST ( WN * block, FIOSTRUCTID id, BOOL clear )
{
  INT32 i;
  ST * st;
  WN * wn;

  /*  Clear ST pointers in fiostruct_st when first entering a new PU.  */

  if (Current_pu != fio_current_pu) {
    local_sequence = 1;
    fio_current_pu = Current_pu;
    for (i=FIOSTRUCTID_FIRST; i<=FIOSTRUCTID_LAST; i++)
      fiostruct_st[i] = NULL;
  }

  /*  If a (previously created) ST doesn't exist, create it.  */

  if ((st = fiostruct_st[id]) == NULL) {

    /*  Get the global struct TY if it exists, otherwise create it.  */
    /* For iolist, always needs a new type since the struture is 
    ** different each time */
    if ((id == FID_CRAY_IOLIST) || 
  (fiostruct_ty[id] == (TY_IDX) 0))
      Make_IoStruct_TY ( id );

    /*  Create the local ST and enter into the local symbol table and save  */
    /*  the pointer.  */

    st = New_ST ();
    ST_Init (st, 0, CLASS_VAR, SCLASS_AUTO, EXPORT_LOCAL, fiostruct_ty[id]);
    io_set_addr_passed_flag(st);
    /* 
    ** Never set fiostruct_st for the following cases which use a
    ** local ST each time
    */
    if ((id != FID_CRAY_FCD) && (id != FID_CRAY_IOLIST) 
  && (id != FID_CRAY_DOPEVEC)) {
  Set_ST_name_idx (st, Save_Str ( fiostructid_info[id].name_local ));
  fiostruct_st[id] = st;
    } else {
  sprintf( seq_buff, "_%d", local_sequence++ );
  Set_ST_name_idx (st, Save_Str2( fiostructid_info[id].name_local,
             seq_buff ));
    }
  }

  /*  Clear the structure if requested.  */

  if (clear) {
    if (Pointer_Size == 4)
      wn = WN_CreateMstore ( 0, TY_pointer(ST_type(st)),
     WN_CreateIntconst ( OPC_U8INTCONST, 0 ),
     WN_CreateLda ( OPC_U4LDA, 0, TY_pointer(ST_type(st)), st),
     WN_CreateIntconst ( OPC_U4INTCONST, TY_size(ST_type(st)) ));
    else
      wn = WN_CreateMstore ( 0, TY_pointer(ST_type(st)),
     WN_CreateIntconst ( OPC_U8INTCONST, 0 ),
     WN_CreateLda ( OPC_U8LDA, 0, TY_pointer(ST_type(st)), st),
     WN_CreateIntconst ( OPC_U8INTCONST, TY_size(ST_type(st)) ));
    WN_INSERT_BlockLast ( block, wn );
  }

  return (st);
}

/*  This routine returns an ST for a local array of key struct elements.      */
/*  If the global key struct type doesn't exist, create it.  No attempt to    */
/*  share local arrays is made, usually they will be of different sizes       */
/*  anyway.                                                                   */

static ST * Get_KeyStruct_ST ( INT32 nitems )
{
  INT32 nelem = nitems/3;
  char  ty_name[30];
  char  ptr_name[30];
  char  st_name[30];

  /*  If the global key struct TY doesn't exist, create it.  */

  if (fiostruct_ty[FID_KEYSPEC] == (TY_IDX) 0)
    Make_IoStruct_TY ( FID_KEYSPEC );

  /*  Create a local TY which is an array of key structs.  */

  TY_IDX ty_idx;
  TY& ty = New_TY (ty_idx);
  sprintf( ty_name, ".key_type.%d", nelem );
  TY_Init (ty, nelem * TY_size(fiostruct_ty[FID_KEYSPEC]), KIND_ARRAY,
     MTYPE_UNKNOWN, Save_Str ( ty_name ));
  Set_TY_etype (ty, fiostruct_ty[FID_KEYSPEC]);
  Set_TY_align (ty_idx, MTYPE_align_req(MTYPE_I8));

  ARB_HANDLE arb = New_ARB ();
  ARB_Init (arb, 0, nelem - 1, TY_size(fiostruct_ty[FID_KEYSPEC]));
  Set_ARB_first_dimen (arb);
  Set_ARB_last_dimen (arb);

  Set_TY_arb (ty, arb);


  /*  Create the local array pointer TY. */

  TY_IDX tyx_idx;
  TY& tyx = New_TY (tyx_idx);
  sprintf( ptr_name, ".key_pointer.%d", nelem );
  TY_Init (tyx, Pointer_Size, KIND_POINTER, Pointer_Mtype,
     Save_Str (ptr_name));
  Set_TY_align (tyx_idx, Pointer_Size);

  /*  Complete the TY entries and enter them in the local symbol table.  */

  Set_TY_pointed (tyx, ty_idx);

  /*  Create the local ST.  */

  ST* st = New_ST ();
  sprintf( st_name, ".key_array.%d", nelem );
  ST_Init (st, Save_Str (st_name), CLASS_VAR, SCLASS_AUTO, EXPORT_LOCAL,
     ty_idx);

  io_set_addr_saved_flag(st);
  fiostruct_st[ FID_KEYSPEC ] = st;

  return (st);
}


/*  This routines creates a local ST for a variable of type pointer to       */
/*  save the the UNIT structure pointer. between the different steps of a    */
/*  multiple-step I/O operations such as READ/WRITE.   This is needed        */
/*  in the case of MP I/O as we can no longer depend on a static variable    */
/*  in the runtime library to preserve the setup of the initialization       */
/*  step.                                                                    */

static ST * Get_UnitPointer_ST ( void )
{
  static ST    * mpunit_ptr_var;

  if (Current_pu  != mp_fio_current_pu) {
    mp_fio_current_pu = Current_pu;
    mpunit_ptr_var = NULL;
  }

  if (mpunit_ptr_var)
    return( mpunit_ptr_var );

  static TY_IDX mpunit_ptr_ty_idx;

  if (mpunit_ptr_ty_idx == 0) {
      TY& mpunit_ptr_ty = New_TY (mpunit_ptr_ty_idx);
      TY_Init (mpunit_ptr_ty, Pointer_Size, KIND_POINTER, Pointer_Mtype, 
         Save_Str( ".mpunit_pointer" ));
      Set_TY_pointed (mpunit_ptr_ty, Be_Type_Tbl(MTYPE_I4));
      Set_TY_align (mpunit_ptr_ty_idx, Pointer_Size);
  }

  mpunit_ptr_var = New_ST ();
  ST_Init (mpunit_ptr_var, Save_Str (".mpunit_var"), CLASS_VAR,
     SCLASS_AUTO, EXPORT_LOCAL, mpunit_ptr_ty_idx);
  io_set_addr_saved_flag(mpunit_ptr_var);
  return mpunit_ptr_var;
}


static void
Init_fioruntime_ty ()
{
    TY& ty = New_TY (fioruntime_ty);
    TY_Init (ty, 0, KIND_FUNCTION, MTYPE_UNKNOWN, Save_Str (".ioruntime"));
    Set_TY_align (fioruntime_ty, 1);
#ifdef KEY
    ty.Set_pu_flag(TY_HAS_PROTOTYPE);
#endif

    TYLIST_IDX tylist_idx;
    TYLIST& tylist = New_TYLIST (tylist_idx);
    Set_TY_tylist (ty, tylist_idx);
    Set_TYLIST_type (tylist, Be_Type_Tbl ( MTYPE_I4 ));
    Set_TYLIST_type (New_TYLIST (tylist_idx), 0);

    TY_IDX tyx_idx;
    TY& tyx = New_TY (tyx_idx);
    TY_Init (tyx, Pointer_Size, KIND_POINTER, Pointer_Mtype,
       Save_Str (".ioruntime_ptr"));
    Set_TY_pointed (tyx, fioruntime_ty);
} // Init_fioruntime_ty


/*  This routine creates a global ST for the requested I/O runtime routine.  */
/*  If the global type of the runtime routines does not exist, it is       */
/*  created.                     */

static ST * Make_IoRuntime_ST ( FIOOPER op )
{
  ST *st;
  char mpname[ 40 ];
  INT32 i;

  /*  Do a little validation of the requested routine.  */

  if (op == FIOOPER_NONE)
    Fail_FmtAssertion("Make_IoRuntime_ST:"
          " null runtime operation in I/O processing");


  /*  If the global type doesn't exist, create it and it's pointer type.  */

  if (fioruntime_ty == (TY_IDX) 0) {
      Init_fioruntime_ty ();
  }
  
  /*  Create the ST, fill in all appropriate fields */

  fio_sts[op] = st = New_ST (GLOBAL_SYMTAB);
  STR_IDX st_name;
  if (mp_io && (current_io_library == IOLIB_MIPS)) {
    strcpy (mpname, fio_names[op] );
    i = strlen( mpname );
    mpname[i] = '_'; mpname[i+1] = 'm'; mpname[i+2] = 'p'; mpname[i+3] = '\0';
    st_name = Save_Str ( mpname );
  } else {
    if (op == FIO_CR_OPEN && Language == LANG_F77 && current_io_library == IOLIB_CRAY)
       st_name = Save_Str ("_OPENF77");
    else
       st_name = Save_Str ( fio_names[op] );
  }

  PU_IDX pu_idx;
  PU&    pu = New_PU (pu_idx);

  PU_Init (pu, fioruntime_ty, CURRENT_SYMTAB);

  ST_Init (st, st_name, CLASS_FUNC, SCLASS_EXTERN, EXPORT_PREEMPTIBLE,
     TY_IDX (pu_idx));

  return st;

}


/*  This routine takes an ST and generates an OPC_U4LDA or OPC_U8LDA  */
/*  node depending on pointer size.                                   */

static WN * Make_IoAddr_WN ( ST * st )
{
    WN * wn;
    TY_IDX ty = ST_type (st);
    TY_IDX ty_ptr = TY_pointer (ty);

    if (ty_ptr == (TY_IDX) 0) {
  ty_ptr = Make_Pointer_Type (ty);
    }

    if (Pointer_Size == 4)
  wn = WN_CreateLda ( OPC_U4LDA, 0, ty_ptr, st);
    else
  wn = WN_CreateLda ( OPC_U8LDA, 0, ty_ptr, st);

    io_set_addr_passed_flag(st);

    return (wn);
}

/*  This routine takes a WN and generates a PARM node over it.  */

static WN * Gen_Parm_WN ( WN * wn )
{
    OPCODE opc = WN_opcode(wn);
    TYPE_ID rtype = OPCODE_rtype(opc);

    if (rtype == MTYPE_U4 || rtype == MTYPE_U8) {
      wn = WN_CreateParm (rtype, wn,
                          (OPCODE_has_1ty(opc))?WN_ty(wn):Be_Type_Tbl(rtype),
                          WN_PARM_BY_REFERENCE );
    }
    else
      wn = WN_CreateParm ( rtype, wn, Be_Type_Tbl(rtype), WN_PARM_BY_VALUE );

    return (wn);
}


/*  This routine is the main work horse of the I/O lowerer.  Given       */
/*  information about an I/O runtime routine to be called, it generates  */
/*  the call and any required handling of the status return.  Note the   */
/*  special handling of dummy parms.  Any user variable/constant whose   */
/*  address is put in an I/O control structure could be referenced or    */
/*  modified without the knowledge of the optimizer.  So a set of dummy  */
/*  parms is created for each such variable and attached to each I/O     */
/*  call. A similar problem exists for namelist I/O where the variables  */
/*  being referenced are not "visible" in the I/O statement.  Here again */
/*  dummy parms are created for these variables.       */

static void Gen_Io_Calls ( WN * block, FIOOPER op, WN * iostat1, WN * iostat2,
         INT32 kids, WN * kid0, WN * kid1, WN * kid2,
         WN * kid3 )
{
  WN * wn;
  INT32 i;
  INT32 fio_namelist_count = (namelist_node) ? WN_kid_count(namelist_node) - 2
               : 0;

  /*  Create the appropriate call node.  */

  if (iostat1 != NULL || iostat2 != NULL || 
      op == FIO_INQLENGTH)
    wn = WN_Create ( OPC_I4CALL, kids + fio_dummy_count + fio_namelist_count);
  else
    wn = WN_Create ( OPC_VCALL, kids + fio_dummy_count + fio_namelist_count);
  WN_st_idx(wn) = ST_st_idx (GET_RUNTIME_ST ( op ));
  WN_Set_Call_Non_Data_Mod ( wn );
  WN_Set_Call_Non_Data_Ref ( wn );
  WN_Set_Call_Parm_Mod ( wn );
  WN_Set_Call_Parm_Ref ( wn );
  if (op == FIO_CR_READ_NAMELIST || op == FIO_CR_WRITE_NAMELIST) 
     WN_Set_Call_Non_Parm_Ref( wn );

  /*  Fill in any or all function arguments to the call.  */

  switch (kids) {
    case 4:
      WN_kid3(wn) = Gen_Parm_WN ( kid3 );
    case 3:
      WN_kid2(wn) = Gen_Parm_WN ( kid2 );
    case 2:
      WN_kid1(wn) = Gen_Parm_WN ( kid1 );
    case 1:
      WN_kid0(wn) = Gen_Parm_WN ( kid0 );
    case 0:
      break;
    default:
      Fail_FmtAssertion("Gen_Io_Calls: unexpected number of kids (%d)"
      " in I/O processing", kids);
  }

  /*  Generate any dummy parms needed and attach to the call.  */

  for (i = 0; i < fio_dummy_count; i++) {
    if (ST_class(fio_dummy_st[i]) == CLASS_VAR) {
      io_set_addr_passed_flag(fio_dummy_st[i]);
    }
    if (fio_dummy_ref[i])
      WN_kid(wn, kids++) = WN_CreateParm ( Pointer_type,
             WN_Lda ( Pointer_type,
                fio_dummy_ofst[i],
                fio_dummy_st[i] ),
             Be_Type_Tbl(Pointer_type),
             WN_PARM_BY_REFERENCE |
             WN_PARM_DUMMY );
    else
      WN_kid(wn, kids++) = WN_CreateParm ( Pointer_type,
             WN_Ldid ( Pointer_type,
                 fio_dummy_ofst[i],
                 fio_dummy_st[i],
                 fio_dummy_tyidx[i]),
             Be_Type_Tbl(Pointer_type),
             WN_PARM_BY_REFERENCE |
             WN_PARM_DUMMY );
  }

  for (i = 0; i < fio_namelist_count; i++) {
    WN_kid(wn, kids++) = WN_CreateParm ( Pointer_type,
           WN_COPY_Tree (WN_kid0(WN_kid(namelist_node, i+2))),
           Be_Type_Tbl(Pointer_type),
           WN_PARM_BY_REFERENCE |
           WN_PARM_DUMMY );
  }

  /*  Insert the call into the statement block being created for the I/O  */
  /*  statement.                */

  WN_INSERT_BlockLast ( block, wn );

  /*  Add any statements needed to handle the status result.  */

 if (iostat1 != NULL || iostat2 != NULL)
    if (iostat2 == NULL)
      WN_INSERT_BlockLast ( block, WN_COPY_Tree ( iostat1 ) );
    else {
      WN_INSERT_BlockLast ( block, iostat2 );
      if (iostat1 != NULL) {
  WN_DELETE_Tree ( iostat1 );
      }
    }
}


/* This is copied from file libI77/fmt.h */
#define TYUNKNOWN 0
#define TYADDR 1
#define TYBYTE 2
#define TYSHORT 3
#define TYINT 4
#define TYLONGLONG 5
#define TYREAL 6
#define TYDREAL 7
#define TYCOMPLEX 8
#define TYDCOMPLEX 9
#define TYLOGICAL1 10
#define TYLOGICAL2 11
#define TYLOGICAL4 12
#define TYLOGICAL8 13
#define TYCHAR 14
#define TYSUBR 15
#define TYSTRUCTURE 16
#define TYNML 17
#define TYQUAD 18
#define TYQUADCOMPLEX 19
#define TYQUADLONG 20


static void Gen_Impld_Io_Calls ( WN * block, FIOFORMATTYPE form, 
         FIOITEMTYPE type, WN * iostat1, WN * impld_item, 
         WN *arr_item, WN * mp_unit_ptr)
/* 
  This function generates a single call to the runtime routine do_xxxx_1dim()
  for implied-do loop instead of having a loop generated to do I/O on one 
  element at a time.  The implied-DO loop must satisfy the following
  conditions to be converted:
        - must have one and only one I/O item in the implied-do list
        - the item must be an array
        - every subscript of the array must be a simple variable
        - the leftmost index must be the same as the implied-do variable
        and all other indices must be different from the leftmost index.
        E.g:  (ARR(I,J), I=1,10) will be converted whereas
        (ARR(I,J), J=1,10) and (ARR(I,I), I=1,10) will not.
  - the array is not character type
  - there can be no nested calls in the subscript expression

  These cases are not converted into a single call (could be done later but
  not very important):
  - the index is not a simple variable but an expression,
  For example: (ARR(I+1), I = 1,10)
  
  The following arguments will be passed to the do_xxxx_1dim() runtime 
  routine.  Thay are all passed by reference unless otherwise indicated:
        1) the item type (for formatted I/O only)
        2) address of the array with the leftmost index replaced by
        constant 1.  Note that this could cause a problem once the
        -check_bounds option is implemented for implied-do I/O if it
  is done after the I/O lowering phase for this reference without
  considering the implied-do bounds.
        3) The implied-do loop variable:  Its value will be modified
        appropriately when the I/O is completed.   This is the main
  reason why we need to implement the implied-do optimization
  this way as the implied-do loop variable has to be defined
  once execution goes into the implied-do I/O.  This is especially
  important for READ statement where people deliberately read a
  very large array with implied-do loop and expect the
  do loop variable to hold the number of elements sucessfully read
  into the array before the end-of-record.   We can't set this
  implied-do variable if we treat the implied-do loop as an array
  as in fcom.
        4) the lower-bound of the do-loop
        5) the upper bound of the do-loop
        6) the step size
        7) the length of one element in the implied-do (passed by value)
        8) the size of the implied-do variable (passed by value)

  CAVEAT:
  -------
  - As noted in argument 2) above.  In the case of an array declared
  as ARR(20:30) for example and used in an implied-do loop 
  (ARR(I), I = 20,30) then this function will make a reference to
  ARR(1) and passes to the I/O library to be used as the base to
  calculate the offset.  If the check_bounds implementation generates
  code to check on this reference then it will cause an error where there
  should be none.
  - An array fio_types is created to map the FE types to the types
  defined in the Fortran I/O library.   Changes to the type table either
  from the FE or from the I/O library could cause serious regression if
  this table is not updated.
*/
{
  WN * wn, *dovar;
  INT32 i, size;
  char impld_name[48];
  ST *tmp_st;
  static ST * impld_fio_sts [FIOFORMATTYPE_LAST + 1];
  static const char *impld_fio_names [ FIOFORMATTYPE_LAST + 1] =
  { "", "do_fio64", "do_uio64", "do_Lio64" };
  INT32 nkids;
  TY_IDX aty;
  ST *st;
  static INT32 fio_types[FIOITEMTYPE_LAST + 1];

  /* Update this static table at runtime to lessen the chance of regression
  ** in case the type tables are changed either in the FE or in the I/O
  ** library
  */
  if (fio_types[ FIT_COMPLEX16 ] == 0) {
    fio_types[FIOITEMTYPE_NONE] = TYUNKNOWN;  
    fio_types[FIT_ADDRESS4] = TYADDR;   
    fio_types[FIT_ADDRESS8] = TYADDR; 
    fio_types[FIT_CHARACTER] = TYCHAR;
    fio_types[FIT_INTEGER1] = TYBYTE;
    fio_types[FIT_INTEGER2] = TYSHORT;  
    fio_types[FIT_INTEGER4] = TYINT;
    fio_types[FIT_INTEGER8] = TYLONGLONG; 
    fio_types[FIT_LOGICAL1] = TYLOGICAL1;
    fio_types[FIT_LOGICAL2] = TYLOGICAL2;
    fio_types[FIT_LOGICAL4] = TYLOGICAL4;
    fio_types[FIT_LOGICAL8] = TYLOGICAL8;
    fio_types[FIT_REAL4] = TYREAL;  
    fio_types[FIT_REAL8] = TYDREAL;
    fio_types[FIT_REAL16] = TYQUAD;
    fio_types[FIT_COMPLEX4] = TYCOMPLEX;
    fio_types[FIT_COMPLEX8] = TYDCOMPLEX; 
    fio_types[FIT_COMPLEX16] = TYQUADCOMPLEX;
    fio_types[FIT_RECORD] = TYSTRUCTURE;
  }

  /*  Create the appropriate call node.  */
  wn = WN_Create ( OPC_I4CALL, 7 + (mp_unit_ptr ? 1 : 0)
      + (form == FFT_UNFORMAT ? 0 : 1) );
  if (impld_fio_sts[form] == NULL) {
  
    /*  Do a little validation of the requested routine.  */
  
    /*  If the global type doesn't exist, create it and it's pointer type.  */

    if (fioruntime_ty == (TY_IDX) 0) {

      Init_fioruntime_ty ();

    }

    /*  Create the ST, fill in all appropriate fields and enter into the  */
    /*  global symbol table. */

    strcpy( impld_name, impld_fio_names[form] );
    i = strlen( impld_name );
    if (mp_unit_ptr) {
      impld_name[i] = '_'; impld_name[i+1] = 'm'; impld_name[i+2] = 'p'; 
      strcpy( &impld_name[i+3], "_1dim" );
    } else {
      strcpy( &impld_name[i], "_1dim" );
    }
    impld_fio_sts[form] = st = New_ST ( GLOBAL_SYMTAB );

    PU_IDX pu_idx;
    PU&    pu = New_PU (pu_idx);

    PU_Init (pu, fioruntime_ty, CURRENT_SYMTAB);

    ST_Init ( st, Save_Str ( impld_name ), CLASS_FUNC, SCLASS_EXTERN,
              EXPORT_PREEMPTIBLE, (TY_IDX) pu_idx);
    WN_st_idx (wn) =  ST_st_idx (st);
    impld_fio_sts[form] = st;
  } else
    WN_st_idx (wn) = ST_st_idx (impld_fio_sts[form]);

  WN_Set_Call_Non_Data_Mod ( wn );
  WN_Set_Call_Non_Data_Ref ( wn );
  WN_Set_Call_Parm_Mod ( wn );
  WN_Set_Call_Parm_Ref ( wn );

  /*  Fill in any or all function arguments to the call.  */

  nkids = 0;
  switch (form) {
    case FFT_FORMAT   :
    case FFT_LIST     :
      /* For Formatted & List-directed, first argument is the element type */
      tmp_st = Gen_Temp_Symbol( Be_Type_Tbl(MTYPE_I4), "io_item_type" );
      WN_INSERT_BlockLast ( block, WN_CreateStid( OPC_I4STID, 0, tmp_st,
      Be_Type_Tbl(MTYPE_I4), 
      WN_CreateIntconst( OPC_I4INTCONST, fio_types[type] )));
      WN_kid(wn, nkids++) = Gen_Parm_WN ( Make_IoAddr_WN( tmp_st ) );
    case FFT_UNFORMAT :

      /* Second/First argument is the array element */
      WN_kid(wn, nkids++) = Gen_Parm_WN ( arr_item );

      /* Third/Second argument is the Implied-do variables */
      dovar = WN_COPY_Tree(WN_index (impld_item));
      WN_kid(wn, nkids++) = Gen_Parm_WN( Make_IoAddr_WN( WN_st( dovar ) ) );

      /* Fourth/third argument is the lower bound */
      tmp_st = Gen_Temp_Symbol( Be_Type_Tbl(
    (Pointer_Size == 4) ? MTYPE_I4 : MTYPE_I8), "lower_bound" );
      WN_INSERT_BlockLast ( block, WN_CreateStid( 
    (Pointer_Size == 4) ? OPC_I4STID : OPC_I8STID, 0, tmp_st,
        Be_Type_Tbl(
    (Pointer_Size == 4) ? MTYPE_I4 : MTYPE_I8), 
        WN_COPY_Tree(WN_start(impld_item))));
      WN_kid(wn, nkids++) = Gen_Parm_WN( Make_IoAddr_WN( tmp_st ) );

      /* Fifth/Fourth argument is the upper bound */
      tmp_st = Gen_Temp_Symbol( Be_Type_Tbl(
    (Pointer_Size == 4) ? MTYPE_I4 : MTYPE_I8), "upper_bound" );
      WN_INSERT_BlockLast ( block, WN_CreateStid( 
    (Pointer_Size == 4) ? OPC_I4STID : OPC_I8STID, 0, tmp_st,
        Be_Type_Tbl(
    (Pointer_Size == 4) ? MTYPE_I4 : MTYPE_I8), 
        WN_COPY_Tree(WN_end(impld_item))));
      WN_kid(wn, nkids++) = Gen_Parm_WN( Make_IoAddr_WN( tmp_st ) );

      /* Sixth/Fifth argument is the step */
      tmp_st = Gen_Temp_Symbol( Be_Type_Tbl(
    (Pointer_Size == 4) ? MTYPE_I4 : MTYPE_I8), "do_step" );
      WN_INSERT_BlockLast ( block, WN_CreateStid( 
    (Pointer_Size == 4) ? OPC_I4STID : OPC_I8STID, 0, tmp_st,
        Be_Type_Tbl(
    (Pointer_Size == 4) ? MTYPE_I4 : MTYPE_I8), 
        WN_COPY_Tree(WN_step(impld_item))));
      WN_kid(wn, nkids++) = Gen_Parm_WN( Make_IoAddr_WN( tmp_st ) );

      /* Seventh/Sixth argument is the mp_unit_ptr if needed */
      if (mp_unit_ptr) {
  WN_kid(wn, nkids++) = Gen_Parm_WN( mp_unit_ptr );
      }

      /* Eighth/Seventh argument is the size of the array element, 
   passed by value */
      aty = TY_pointed( WN_ty( WN_kid0(arr_item) ) );
      size = TY_size( TY_AR_etype(aty) );
      WN_kid(wn, nkids++) = Gen_Parm_WN( 
      WN_CreateIntconst ( OPC_I4INTCONST, size ) );

      /* Ninth/Eighth argument is the size of the implied-do variable, 
  passed by value */
      size = TY_size( Ty_Table[ ST_type( WN_st( dovar) ) ]);
      WN_kid(wn, nkids++) = Gen_Parm_WN( 
      WN_CreateIntconst ( OPC_I4INTCONST, size ) );
      break;
    default:
      Fail_FmtAssertion("Gen_Impld_Io_Calls: illegal format type (%d)"
      " in I/O processing", form);
  }

  /*  Insert the call into the statement block being created for the I/O  */
  /*  statement.                */

  WN_INSERT_BlockLast ( block, wn );

  /*  Add any statements needed to handle the status result.  */

 if (iostat1 != NULL)
   WN_INSERT_BlockLast ( block, WN_COPY_Tree ( iostat1 ) );
}

/*  This routine is one of a set to manage the structures passed between    */
/*  user code and the I/O runtime routines.  This routine will take an      */
/*  integer constant value and put it at the specified offset within the
    structure */

static void Gen_Iolist_PutFieldConst ( WN * block, ST * st, INT32 foffset, 
                                       INT32 ftype, INT64 value )
{
  WN * wn = NULL;

  /*  Generate an appropriate INTCONST node and store it into the structure  */
  /*  field.                                                                 */

  if (ftype == MTYPE_I4)
    wn = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
         WN_CreateIntconst ( OPC_I4INTCONST, value ));
  else if (ftype == MTYPE_U4)
    wn = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4),
         WN_CreateIntconst ( OPC_U4INTCONST, value ));
  else if (ftype == MTYPE_I8)
    wn = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
         WN_CreateIntconst ( OPC_I8INTCONST, value ));
  else if (ftype == MTYPE_U8)
    wn = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
         WN_CreateIntconst ( OPC_U8INTCONST, value ));
  else
    Fail_FmtAssertion("Gen_Iolist_PutFieldConst: unexpected field type (%s) "
          "in I/O processing", MTYPE_name(ftype));

  /*  Add the generated load/store into the statement block being created  */
  /*  for the I/O statement.                                               */

  WN_INSERT_BlockLast ( block, wn );

}

/*  The mload/mstore generates WHIRL based on the TY_align, which must     */
/*  be correct. Create a new TY based on the alignment and offset    */

static TY_IDX Create_Maligned_TY(INT32 offset, TY_IDX ty) 
{
  INT32 align=  compute_offset_alignment(offset, TY_align(ty));

  if (align) {
    TY_IDX newTY;
    newTY = Make_Align_Type(MTYPE_To_TY(MTYPE_M), align);

    return Make_Pointer_Type(newTY, FALSE);
  }
  ty = Make_Align_Type (MTYPE_To_TY (MTYPE_M), TY_align(ty));
  return TY_pointer(ty);
}

/*  This routine is one of a set to manage the structures passed between    */
/*  user code and the I/O runtime routines.  This routine will take the     */
/*  value of a user expression specified by a WN and put it at the          */
/*  specified offset within the I/O structures.                             */

static void Gen_Iolist_PutFieldWN ( WN * block, ST * st, INT32 foffset, 
                                                         INT32 ftype, WN * wn ) 
{
  WN * wnx = NULL;
  INT32 etype;
  INT32 vtype;

  /*  Determine kind and type of expression node.  Then convert the node as  */
  /*  appropriate to match the structure field type.  Finally, generate the  */
  /*  store into the field.                */
  /*                       */
  /*  The three cases handled are:               */
  /*  1) OPC_I4INTCONST or OPC_I8INTCONST - this will be used directly     */
  /*                or have it's size adjusted.    */
  /*  2) any expression tree - this will be used directly with the       */
  /*         addition of a CVT node if needed.       */

  if (WN_opcode(wn) == OPC_I4INTCONST)

    if (ftype == MTYPE_I4)
      wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
          wn );
    else if (ftype == MTYPE_U4) {
      wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4), 
      WN_CreateIntconst ( OPC_U4INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else if (ftype == MTYPE_I8) {
      wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
      WN_CreateIntconst ( OPC_I8INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else if (ftype == MTYPE_U8) {
      wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
      WN_CreateIntconst ( OPC_U8INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else
      Fail_FmtAssertion("Gen_Iolist_PutFieldWN, I4INTCONST: unexpected field"
      " type (%s) in I/O processing", MTYPE_name(ftype));

  else if (WN_opcode(wn) == OPC_I8INTCONST)

    if (ftype == MTYPE_I4) {
      wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
      WN_CreateIntconst ( OPC_I4INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else if (ftype == MTYPE_U4) {
      wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4),
      WN_CreateIntconst ( OPC_U4INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else if (ftype == MTYPE_U8) {
      wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
      WN_CreateIntconst ( OPC_U8INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else if (ftype == MTYPE_I8)
      wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
          wn );
    else
      Fail_FmtAssertion("Gen_Iolist_PutFieldWN, I8INTCONST: unexpected field"
      " type (%s) in I/O processing", MTYPE_name(ftype));

  else if (WN_opcode(wn) == OPC_U4INTCONST)

    if (ftype == MTYPE_U4)
      wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4),
          wn );
    else if (ftype == MTYPE_U8) {
      wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
      WN_CreateIntconst ( OPC_U8INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else
      Fail_FmtAssertion("Gen_Iolist_PutFieldWN, U4INTCONST: unexpected field"
      " type (%s) in I/O processing", MTYPE_name(ftype));

  else if (WN_opcode(wn) == OPC_U8INTCONST)

    if (ftype == MTYPE_U4) {
      wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4),
      WN_CreateIntconst ( OPC_U4INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else if (ftype == MTYPE_U8)
      wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
          wn );
    else
      Fail_FmtAssertion("Gen_Iolist_PutFieldWN, U8INTCONST: unexpected field"
      " type (%s) in I/O processing", MTYPE_name(ftype));

  else if (WN_opcode(wn) == OPC_U4LDA || WN_opcode(wn) == OPC_U8LDA) {

    vtype = ST_btype(WN_st(wn));
    if (ftype == MTYPE_I4)
      if (vtype == MTYPE_I4)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateLdid ( OPC_I4I4LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_I4) ));
      else if (vtype == MTYPE_I8)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4I8CVT,
        WN_CreateLdid ( OPC_I8I8LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_I8) )));
      else if (vtype == MTYPE_F4)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4F4CVT,
        WN_CreateLdid ( OPC_F4F4LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_F4) )));
      else if (vtype == MTYPE_F8)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4F8CVT,
        WN_CreateLdid ( OPC_F8F8LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_F8) )));
#if defined(TARG_IA64)
      else if (vtype == MTYPE_F10)
        wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
              WN_CreateExp1 ( OPC_I4F10CVT,
              WN_CreateLdid ( OPC_F10F10LDID, WN_offset(wn), WN_st(wn),
                              Be_Type_Tbl(MTYPE_F10) )));
#endif
      else if (vtype == MTYPE_FQ)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4FQCVT,
        WN_CreateLdid ( OPC_FQFQLDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_FQ) )));
      else
  Fail_FmtAssertion("Gen_Iolist_PutFieldWN, LDA,I4: unexpected item"
        " type (%s) in I/O processing", MTYPE_name(vtype));
    else if (ftype == MTYPE_I8)
      if (vtype == MTYPE_I4)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateLdid ( OPC_I8I4LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_I8) ));
      else if (vtype == MTYPE_I8)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateLdid ( OPC_I8I8LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_I8) ));
      else if (vtype == MTYPE_F4)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateExp1 ( OPC_I8F4CVT,
        WN_CreateLdid ( OPC_F4F4LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_F4) )));
      else if (vtype == MTYPE_F8)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateExp1 ( OPC_I8F8CVT,
        WN_CreateLdid ( OPC_F8F8LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_F8) )));
#if defined(TARG_IA64)
      else if (vtype == MTYPE_F10)
        wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
              WN_CreateExp1 ( OPC_I8F10CVT,
              WN_CreateLdid ( OPC_F10F10LDID, WN_offset(wn), WN_st(wn),
                              Be_Type_Tbl(MTYPE_F10) )));
#endif
      else if (vtype == MTYPE_FQ)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateExp1 ( OPC_I8FQCVT,
        WN_CreateLdid ( OPC_FQFQLDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_FQ) )));
      else
  Fail_FmtAssertion("Gen_Iolist_PutFieldWN, LDA,I8: unexpected item"
        " type (%s) in I/O processing", MTYPE_name(vtype));
    else
      Fail_FmtAssertion("Gen_Iolist_PutFieldWN, U4LDA/U8LDA: unexpected field"
      " type (%s) in I/O processing", MTYPE_name(ftype));
    WN_Delete ( wn );

  } else if (OPCODE_is_expression(WN_opcode(wn))) {

    etype = WN_rtype(wn);
    if (ftype == MTYPE_I4)
      if (etype == MTYPE_I4)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
            wn );
      else if (etype == MTYPE_U4)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
                  wn );
      else if (etype == MTYPE_I8)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4I8CVT, wn ));
      else if (etype == MTYPE_U8)
        wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
              WN_CreateExp1 ( OPC_I4U8CVT, wn ));
      else if (etype == MTYPE_F4)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4F4CVT, wn ));
      else if (etype == MTYPE_F8)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4F8CVT, wn ));
      else if (etype == MTYPE_F10)
        wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
              WN_CreateExp1 ( OPC_I4F10CVT, wn ));
      else if (etype == MTYPE_FQ)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4FQCVT, wn ));
      else
  Fail_FmtAssertion("Gen_Iolist_PutFieldWN, exp,I4: unexpected expression"
        " type (%s) in I/O processing", MTYPE_name(etype));
    else if (ftype == MTYPE_U4)
      if (etype == MTYPE_U4 || etype == MTYPE_I4)
  wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4),
                  wn );
      else if (etype == MTYPE_U8)
        wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4),
              WN_CreateExp1 ( OPC_U4U8CVT, wn ));
      else if (etype == MTYPE_I8)
        wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4),
              WN_CreateExp1 ( OPC_U4I8CVT, wn ));
      else
  Fail_FmtAssertion("Gen_Iolist_PutFieldWN, exp,U4: unexpected expression"
        " type (%s) in I/O processing", MTYPE_name(etype));
    else if (ftype == MTYPE_I8)
      if (etype == MTYPE_I4)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateExp1 ( OPC_I8I4CVT, wn ));
      else if (etype == MTYPE_U4)
        wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
              WN_CreateExp1 ( OPC_I8U4CVT, wn ));
      else if (etype == MTYPE_I8)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
            wn );
      else if (etype == MTYPE_U8)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
            wn );
      else if (etype == MTYPE_F4)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateExp1 ( OPC_I8F4CVT, wn ));
      else if (etype == MTYPE_F8)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateExp1 ( OPC_I8F8CVT, wn ));
      else if (etype == MTYPE_F10)
        wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
              WN_CreateExp1 ( OPC_I8F10CVT, wn ));
      else if (etype == MTYPE_FQ)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateExp1 ( OPC_I8FQCVT, wn ));
      else
  Fail_FmtAssertion("Gen_Iolist_PutFieldWN, exp,I8: unexpected expression"
        " type (%s) in I/O processing", MTYPE_name(etype));
    else if (ftype == MTYPE_U8)
      if (etype == MTYPE_U8 || etype == MTYPE_I8)
  wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
            wn );
      else if (etype == MTYPE_U4)
        wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
              WN_CreateExp1 ( OPC_U8U4CVT, wn ));
      else if (etype == MTYPE_I4)
        wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
              WN_CreateExp1 ( OPC_U8I4CVT, wn ));
      else
  Fail_FmtAssertion("Gen_Iolist_PutFieldWN, exp,U8: unexpected expression"
        " type (%s) in I/O processing", MTYPE_name(etype));
    else
      Fail_FmtAssertion("Gen_Iolist_PutFieldWN, expression: unexpected field"
      " type (%s) in I/O processing", MTYPE_name(ftype));

  } else

    Fail_FmtAssertion("Gen_Iolist_PutFieldWN: unexpected WN_opcode (%s) in"
          " I/O processing", OPCODE_name(WN_opcode(wn)));

  /*  Add the generated load/store into the statement block being created  */
  /*  for the I/O statement.               */

  WN_INSERT_BlockLast ( block, wnx );

}

/*  This routine is one of a set to manage the structures passed between    */
/*  user code and the I/O runtime routines.  This routine will take an      */
/*  address (given by an LDA node, ARRAY node or an LDID node) and put it   */
/*  at the specified offset within the structure */

static void Gen_Iolist_PutAddrWN ( WN * block, ST * st, INT32 foffset,
           INT32 ftype, WN * wn )
{
  WN * wnx;

  /*  Save the ST info for building dummy parm lists.  */

#ifdef KEY
  // Bug 10413: IPA may have constant propagated a non-existing optional
  // argument to an IO_ITEM, skip it.
  if (WN_operator(wn) == OPR_INTCONST)
  {
    // The constant must be zero.
    FmtAssert (WN_const_val(wn) == 0,
               ("Get_Iolist_PutAddrWN: INTCONST can only be zero"));
    return;
  }
#endif

  wnx = wn;
  Add_To_Dummy_List(wnx);

  /*  Generate the appropriate STID depending on the field type and  */
  /*  child node.                */

  if ((WN_opcode(wn) == OPC_U4LDA   || WN_opcode(wn) == OPC_U4U4LDID  ||
       WN_opcode(wn) == OPC_U4ARRAY || WN_opcode(wn) == OPC_U4U4ILOAD ||
       WN_opcode(wn) == OPC_U4ADD || WN_opcode(wn) == OPC_I4I4LDID)  &&
      (ftype == MTYPE_U4 || ftype == MTYPE_I4 || ftype == MTYPE_M ))
    wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4), wn );

  else if ((WN_opcode(wn) == OPC_U4LDA   || WN_opcode(wn) == OPC_U4U4LDID  ||
       WN_opcode(wn) == OPC_U4ARRAY || WN_opcode(wn) == OPC_U4U4ILOAD ||
       WN_opcode(wn) == OPC_U4ADD)  &&
      (ftype == MTYPE_U8 || ftype == MTYPE_I8 ))
    wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8), 
          WN_CreateExp1 ( OPC_U8U4CVT, wn));

  else if ((WN_opcode(wn) == OPC_U8LDA   || WN_opcode(wn) == OPC_U8U8LDID  ||
      WN_opcode(wn) == OPC_U8ARRAY || WN_opcode(wn) == OPC_U8U8ILOAD ||
      WN_opcode(wn) == OPC_U8ADD || WN_opcode(wn) == OPC_I8I8LDID)  &&
     (ftype == MTYPE_U8 || ftype == MTYPE_I8 || ftype == MTYPE_M))
    wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8), wn );

  else if ((WN_opcode(wn) == OPC_U8LDA   || WN_opcode(wn) == OPC_U8U8LDID  ||
      WN_opcode(wn) == OPC_U8ARRAY || WN_opcode(wn) == OPC_U8U8ILOAD ||
      WN_opcode(wn) == OPC_U8ADD)  &&
     (ftype == MTYPE_U4 || ftype == MTYPE_I4 ))
    wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8), 
          WN_CreateExp1 ( OPC_U4U8CVT, wn ));

  else if (WN_opcode(wn) == OPC_MLOAD) 
    wnx = WN_CreateMstore(foffset, Create_Maligned_TY(foffset, ST_type(st)), wn,
    WN_CreateLda(opc_lda, 0, TY_pointer(ST_type(st)), st),
    WN_CreateIntconst ( OPC_U4INTCONST, fcd_size));
  else 
    Fail_FmtAssertion("Gen_Iolist_PutAddrWN: unexpected WN_opcode (%s) and"
          " field type (%s) in I/O processing",
          OPCODE_name(WN_opcode(wn)), MTYPE_name(ftype));

  /*  Add the generated load/store into the statement block being created  */
  /*  for the I/O statement.               */

  WN_INSERT_BlockLast ( block, wnx );

}

/*  This routine is one of a set to manage the structures passed between     */
/*  user code and the I/O runtime routines.  This routine will get any       */
/*  field within any of the I/O structures and store the value into a        */
/*  user variable specified by an ST entry.  All necessary data conversions  */
/*  are generated.                   */

static void Gen_Io_GetFieldST ( WN * block, ST * var, ST * st, FIOSTRUCT field )
{
  WN * wn;
  INT32 foffset;
  INT32 ftype;
  INT32 vtype = ST_btype(var);

  /*  Lookup the offset and type of the requested field.  */

  if (Pointer_Size == 4) {
    foffset = fiostruct_info[field].offset32;
    ftype = fiostruct_info[field].type32;
  } else {
    foffset = fiostruct_info[field].offset64;
    ftype = fiostruct_info[field].type64;
  }

  /*  Based on the field type and the user variable type, generate the  */
  /*  ldid/stid pair plus any additional conversion needed.   */

  if (vtype == MTYPE_I4)

    if (ftype == MTYPE_I4)
      wn = WN_CreateStid ( OPC_I4STID, 0, var, ST_type(var),
     WN_CreateLdid ( OPC_I4I4LDID, foffset, st, Be_Type_Tbl(MTYPE_I4) ));
    else if (ftype == MTYPE_I8)
      wn = WN_CreateStid ( OPC_I4STID, 0, var, ST_type(var),
     WN_CreateExp1 ( OPC_I4I8CVT,
     WN_CreateLdid ( OPC_I8I8LDID, foffset, st, Be_Type_Tbl(MTYPE_I8) )));
    else
      Fail_FmtAssertion("Gen_Io_GetFieldST, I4: unexpected field type (%s)"
      " in I/O processing", MTYPE_name(ftype));

  else if (vtype == MTYPE_I8)

    if (ftype == MTYPE_I4)
      wn = WN_CreateStid ( OPC_I8STID, 0, var, ST_type(var),
     WN_CreateLdid ( OPC_I8I4LDID, foffset, st, Be_Type_Tbl(MTYPE_I8) ));
    else if (ftype == MTYPE_I8)
      wn = WN_CreateStid ( OPC_I8STID, 0, var, ST_type(var),
     WN_CreateLdid ( OPC_I8I8LDID, foffset, st, Be_Type_Tbl(MTYPE_I8) ));
    else
      Fail_FmtAssertion("Gen_Io_GetFieldST, I8: unexpected field type (%s)"
      " in I/O processing", MTYPE_name(ftype));

  else

    Fail_FmtAssertion("Gen_Io_GetFieldST: unexpected item type (%s) in"
          " I/O processing", MTYPE_name(vtype));

  /*  Add the generated load/store into the statement block being created  */
  /*  for the I/O statement.               */

  WN_INSERT_BlockLast ( block, wn );

}


/*  This routine is one of a set to manage the structures passed between     */
/*  user code and the I/O runtime routines.  This routine will get any       */
/*  field within any of the I/O structures and store the value into a        */
/*  user variable specified by an WN node.  All necessary data conversions   */
/*  are generated.                   */

static void Gen_Io_GetFieldWN ( WN * block, WN * wn, ST * st, FIOSTRUCT field )
{
  WN * wnx;
  INT32 foffset;
  INT32 ftype;
  ST * var = WN_st(wn);
  INT32 vtype = ST_btype(var);

  /*  Lookup the offset and type of the requested field.  */

  if (Pointer_Size == 4) {
    foffset = fiostruct_info[field].offset32;
    ftype = fiostruct_info[field].type32;
  } else {
    foffset = fiostruct_info[field].offset64;
    ftype = fiostruct_info[field].type64;
  }

  /*  Based on the field type and the user variable type, generate the  */
  /*  ldid/stid pair plus any additional conversion needed.   */

  if (vtype == MTYPE_I4)

    if (ftype == MTYPE_I4)
      wnx = WN_CreateStid ( OPC_I4STID, 0, var, ST_type(var),
      WN_CreateLdid ( OPC_I4I4LDID, foffset, st, Be_Type_Tbl(MTYPE_I4) ));
    else if (ftype == MTYPE_I8)
      wnx = WN_CreateStid ( OPC_I4STID, 0, var, ST_type(var),
      WN_CreateExp1 ( OPC_I4I8CVT,
      WN_CreateLdid ( OPC_I8I8LDID, foffset, st,
          Be_Type_Tbl(MTYPE_I8) )));
    else
      Fail_FmtAssertion("Gen_Io_GetFieldWN, I4: unexpected field type (%s)"
      " in I/O processing", MTYPE_name(ftype));

  else if (vtype == MTYPE_I8)

    if (ftype == MTYPE_I4)
      wnx = WN_CreateStid ( OPC_I8STID, 0, var, ST_type(var),
      WN_CreateLdid ( OPC_I8I4LDID, foffset, st, Be_Type_Tbl(MTYPE_I8) ));
    else if (ftype == MTYPE_I8)
      wnx = WN_CreateStid ( OPC_I8STID, 0, var, ST_type(var),
      WN_CreateLdid ( OPC_I8I8LDID, foffset, st, Be_Type_Tbl(MTYPE_I8) ));
    else
      Fail_FmtAssertion("Gen_Io_GetFieldWN, I8: unexpected field type (%s)"
      " in I/O processing", MTYPE_name(ftype));

  else

    Fail_FmtAssertion("Gen_Io_GetFieldWN: unexpected item type (%s)"
          " in I/O processing", MTYPE_name(vtype));

  /*  Add the generated load/store into the statement block being created  */
  /*  for the I/O statement.               */

  WN_INSERT_BlockLast ( block, wnx );

  /*  Delete the old load node.  */

  WN_Delete ( wn );

}


/*  This routine is one of a set to manage the structures passed between    */
/*  user code and the I/O runtime routines.  This routine will take the     */
/*  value of a user variable specified by an ST and put it into any field   */
/*  within any of the I/O structures.  All necessary data conversions are   */
/*  generated.                    */

static void Gen_Io_PutFieldST ( WN * block, ST * st, FIOSTRUCT field, ST * var )
{
  WN * wn;
  INT32 foffset;
  INT32 ftype;
  INT32 vtype = ST_btype(var);

  /*  Lookup the offset and type of the requested field.  */

  if (Pointer_Size == 4) {
    foffset = fiostruct_info[field].offset32;
    ftype = fiostruct_info[field].type32;
  } else {
    foffset = fiostruct_info[field].offset64;
    ftype = fiostruct_info[field].type64;
  }

  /*  Based on the field type and the user variable type, generate the  */
  /*  ldid/stid pair plus any additional conversion needed.   */

  if (ftype == MTYPE_I4)

    if (vtype == MTYPE_I4)
      wn = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
     WN_CreateLdid ( OPC_I4I4LDID, 0, var, Be_Type_Tbl(MTYPE_I4) ));
    else if (vtype == MTYPE_I8)
      wn = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
     WN_CreateExp1 ( OPC_I4I8CVT,
     WN_CreateLdid ( OPC_I8I8LDID, 0, var, Be_Type_Tbl(MTYPE_I8) )));
    else if (vtype == MTYPE_F4)
      wn = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
     WN_CreateExp1 ( OPC_I4F4CVT,
     WN_CreateLdid ( OPC_F4F4LDID, 0, var, Be_Type_Tbl(MTYPE_F4) )));
    else if (vtype == MTYPE_F8)
      wn = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
     WN_CreateExp1 ( OPC_I4F8CVT,
     WN_CreateLdid ( OPC_F8F8LDID, 0, var, Be_Type_Tbl(MTYPE_F8) )));
    else if (vtype == MTYPE_F10)
      wn = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
           WN_CreateExp1 ( OPC_I4F10CVT,
           WN_CreateLdid ( OPC_F10F10LDID, 0, var, Be_Type_Tbl(MTYPE_F10) )));
    else if (vtype == MTYPE_FQ)
      wn = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
     WN_CreateExp1 ( OPC_I4FQCVT,
     WN_CreateLdid ( OPC_FQFQLDID, 0, var, Be_Type_Tbl(MTYPE_FQ) )));
    else
      Fail_FmtAssertion("Gen_Io_PutFieldST, I4: unexpected item type (%s)"
      " in I/O processing", MTYPE_name(vtype));

  else if (ftype == MTYPE_I8)

    if (vtype == MTYPE_I4)
      wn = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
     WN_CreateLdid ( OPC_I8I4LDID, 0, var, Be_Type_Tbl(MTYPE_I8) ));
    else if (vtype == MTYPE_I8)
      wn = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
     WN_CreateLdid ( OPC_I8I8LDID, 0, var, Be_Type_Tbl(MTYPE_I8) ));
    else if (vtype == MTYPE_F4)
      wn = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
     WN_CreateExp1 ( OPC_I8F4CVT,
     WN_CreateLdid ( OPC_F4F4LDID, 0, var, Be_Type_Tbl(MTYPE_F4) )));
    else if (vtype == MTYPE_F8)
      wn = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
     WN_CreateExp1 ( OPC_I8F8CVT,
     WN_CreateLdid ( OPC_F8F8LDID, 0, var, Be_Type_Tbl(MTYPE_F8) )));
    else if (vtype == MTYPE_F10)
      wn = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
           WN_CreateExp1 ( OPC_I8F10CVT,
           WN_CreateLdid ( OPC_F10F10LDID, 0, var, Be_Type_Tbl(MTYPE_F10) )));
    else if (vtype == MTYPE_FQ)
      wn = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
     WN_CreateExp1 ( OPC_I8FQCVT,
     WN_CreateLdid ( OPC_FQFQLDID, 0, var, Be_Type_Tbl(MTYPE_FQ) )));
    else
      Fail_FmtAssertion("Gen_Io_PutFieldST, I8: unexpected item type (%s)"
      " in I/O processing", MTYPE_name(vtype));

  else

    Fail_FmtAssertion("Gen_Io_PutFieldST: unexpected field type (%s)"
          " in I/O processing", MTYPE_name(ftype));

  /*  Add the generated load/store into the statement block being created  */
  /*  for the I/O statement.               */

  WN_INSERT_BlockLast ( block, wn );

}


/*  This routine is one of a set to manage the structures passed between    */
/*  user code and the I/O runtime routines.  This routine will take the     */
/*  value of a user expression specified by a WN and put it into any field  */
/*  within any of the I/O structures.  All necessary data conversions are   */
/*  generated.                    */

static void Gen_Io_PutFieldWN ( WN * block, ST * st, FIOSTRUCT field, WN * wn )
{
  WN * wnx = NULL;
  INT32 foffset;
  INT32 ftype;
  INT32 etype;
  INT32 vtype;

  /*  Lookup the offset and type of the requested field.  */

  if (Pointer_Size == 4) {
    foffset = fiostruct_info[field].offset32;
    ftype = fiostruct_info[field].type32;
  } else {
    foffset = fiostruct_info[field].offset64;
    ftype = fiostruct_info[field].type64;
  }

  /*  Determine kind and type of expression node.  Then convert the node as  */
  /*  appropriate to match the structure field type.  Finally, generate the  */
  /*  store into the field.                */
  /*                       */
  /*  The three cases handled are:               */
  /*  1) OPC_I4INTCONST or OPC_I8INTCONST - this will be used directly     */
  /*                or have it's size adjusted.    */
  /*  2) OPC_U4LDA or OPC_U8LDA - this will be replaced with an LDID node  */
  /*            with the same ST entry and possibly a    */
  /*            CVT node.            */
  /*  3) any expression tree - this will be used directly with the       */
  /*         addition of a CVT node if needed.       */

  if (WN_opcode(wn) == OPC_I4INTCONST)

    if (ftype == MTYPE_I4)
      wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
          wn );
    else if (ftype == MTYPE_U4) {
      wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4),
            WN_CreateIntconst ( OPC_U4INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else if (ftype == MTYPE_I8) {
      wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
            WN_CreateIntconst ( OPC_I8INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else if (ftype == MTYPE_U8) {
      wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
            WN_CreateIntconst ( OPC_U8INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else
      Fail_FmtAssertion("Gen_Io_PutFieldWN, I4INTCONST: unexpected field"
      " type (%s) in I/O processing", MTYPE_name(ftype));

  else if (WN_opcode(wn) == OPC_I8INTCONST)

    if (ftype == MTYPE_I4) {
      wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
            WN_CreateIntconst ( OPC_I4INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else if (ftype == MTYPE_U4) {
      wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4),
            WN_CreateIntconst ( OPC_U4INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else if (ftype == MTYPE_U8) {
      wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
            WN_CreateIntconst ( OPC_U8INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else if (ftype == MTYPE_I8)
      wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
          wn );
    else
      Fail_FmtAssertion("Gen_Io_PutFieldWN, I8INTCONST: unexpected field"
      " type (%s) in I/O processing", MTYPE_name(ftype));

  else if (WN_opcode(wn) == OPC_U4INTCONST)

    if (ftype == MTYPE_U4)
      wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4),
          wn );
    else if (ftype == MTYPE_U8) {
      wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
      WN_CreateIntconst ( OPC_U8INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else
      Fail_FmtAssertion("Gen_Io_PutFieldWN, U4INTCONST: unexpected field"
      " type (%s) in I/O processing", MTYPE_name(ftype));

  else if (WN_opcode(wn) == OPC_U8INTCONST)

    if (ftype == MTYPE_U4) {
      wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4),
      WN_CreateIntconst ( OPC_U4INTCONST, WN_const_val(wn) ));
      WN_Delete ( wn );
    } else if (ftype == MTYPE_U8)
      wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
          wn );
    else
      Fail_FmtAssertion("Gen_Io_PutFieldWN, U8INTCONST: unexpected field"
      " type (%s) in I/O processing", MTYPE_name(ftype));

  else if (WN_opcode(wn) == OPC_U4LDA || WN_opcode(wn) == OPC_U8LDA) {

    vtype = ST_btype(WN_st(wn));
    if (ftype == MTYPE_I4)
      if (vtype == MTYPE_I4)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateLdid ( OPC_I4I4LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_I4) ));
      else if (vtype == MTYPE_I8)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4I8CVT,
        WN_CreateLdid ( OPC_I8I8LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_I8) )));
      else if (vtype == MTYPE_F4)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4F4CVT,
        WN_CreateLdid ( OPC_F4F4LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_F4) )));
      else if (vtype == MTYPE_F8)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4F8CVT,
        WN_CreateLdid ( OPC_F8F8LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_F8) )));
      else if (vtype == MTYPE_F10)
        wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
              WN_CreateExp1 ( OPC_I4F10CVT,
              WN_CreateLdid ( OPC_F10F10LDID, WN_offset(wn), WN_st(wn),
                              Be_Type_Tbl(MTYPE_F10) )));
      else if (vtype == MTYPE_FQ)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4FQCVT,
        WN_CreateLdid ( OPC_FQFQLDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_FQ) )));
      else
  Fail_FmtAssertion("Gen_Io_PutFieldWN, LDA,I4: unexpected item type"
        " (%s) in I/O processing", MTYPE_name(vtype));
    else if (ftype == MTYPE_I8)
      if (vtype == MTYPE_I4)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateLdid ( OPC_I8I4LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_I8) ));
      else if (vtype == MTYPE_I8)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateLdid ( OPC_I8I8LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_I8) ));
      else if (vtype == MTYPE_F4)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateExp1 ( OPC_I8F4CVT,
        WN_CreateLdid ( OPC_F4F4LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_F4) )));
      else if (vtype == MTYPE_F8)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateExp1 ( OPC_I8F8CVT,
        WN_CreateLdid ( OPC_F8F8LDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_F8) )));
      else if (vtype == MTYPE_F10)
        wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
              WN_CreateExp1 ( OPC_I8F10CVT,
              WN_CreateLdid ( OPC_F10F10LDID, WN_offset(wn), WN_st(wn),
                              Be_Type_Tbl(MTYPE_F10) )));
      else if (vtype == MTYPE_FQ)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateExp1 ( OPC_I8FQCVT,
        WN_CreateLdid ( OPC_FQFQLDID, WN_offset(wn), WN_st(wn),
            Be_Type_Tbl(MTYPE_FQ) )));
      else
  Fail_FmtAssertion("Gen_Io_PutFieldWN, LDA,I8: unexpected item type"
        " (%s) in I/O processing", MTYPE_name(vtype));
    else
      Fail_FmtAssertion("Gen_Io_PutFieldWN, U4LDA/U8LDA: unexpected field"
      " type (%s) in I/O processing", MTYPE_name(ftype));
    WN_Delete ( wn );

  } else if (OPCODE_is_expression(WN_opcode(wn))) {

    etype = WN_rtype(wn);
    if (ftype == MTYPE_I4)
      if (etype == MTYPE_I4)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
            wn );
      else if (etype == MTYPE_U4)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
                  wn );
      else if (etype == MTYPE_I8)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4I8CVT, wn ));
      else if (etype == MTYPE_U8)
        wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
              WN_CreateExp1 ( OPC_I4U8CVT, wn ));
      else if (etype == MTYPE_F4)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4F4CVT, wn ));
      else if (etype == MTYPE_F8)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4F8CVT, wn ));
      else if (etype == MTYPE_F10)
        wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
              WN_CreateExp1 ( OPC_I4F10CVT, wn ));
      else if (etype == MTYPE_FQ)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
        WN_CreateExp1 ( OPC_I4FQCVT, wn ));
      else
  Fail_FmtAssertion("Gen_Io_PutFieldWN, exp,I4: unexpected expression"
        " type (%s) in I/O processing", MTYPE_name(etype));
    else if (ftype == MTYPE_U4)
      if (etype == MTYPE_U4 || etype == MTYPE_I4)
  wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4),
                  wn );
      else if (etype == MTYPE_U8)
        wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4),
              WN_CreateExp1 ( OPC_U4U8CVT, wn ));
      else if (etype == MTYPE_I8)
        wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4),
              WN_CreateExp1 ( OPC_U4I8CVT, wn ));
      else
  Fail_FmtAssertion("Gen_Io_PutFieldWN, exp,U4: unexpected expression"
        " type (%s) in I/O processing", MTYPE_name(etype));
    else if (ftype == MTYPE_I8)
      if (etype == MTYPE_I4)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateExp1 ( OPC_I8I4CVT, wn ));
      else if (etype == MTYPE_U4)
        wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
              WN_CreateExp1 ( OPC_I8U4CVT, wn ));
      else if (etype == MTYPE_I8)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
            wn );
      else if (etype == MTYPE_U8)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
            wn );
      else if (etype == MTYPE_F4)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateExp1 ( OPC_I8F4CVT, wn ));
      else if (etype == MTYPE_F8)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateExp1 ( OPC_I8F8CVT, wn ));
      else if (etype == MTYPE_F10)
        wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
              WN_CreateExp1 ( OPC_I8F10CVT, wn ));
      else if (etype == MTYPE_FQ)
  wnx = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
        WN_CreateExp1 ( OPC_I8FQCVT, wn ));
      else
  Fail_FmtAssertion("Gen_Io_PutFieldWN, exp,I8: unexpected expression"
        " type (%s) in I/O processing", MTYPE_name(etype));
    else if (ftype == MTYPE_U8)
      if (etype == MTYPE_U8 || etype == MTYPE_I8)
  wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
            wn );
      else if (etype == MTYPE_U4)
        wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
              WN_CreateExp1 ( OPC_U8U4CVT, wn ));
      else if (etype == MTYPE_I4)
        wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
              WN_CreateExp1 ( OPC_U8I4CVT, wn ));
      else
  Fail_FmtAssertion("Gen_Io_PutFieldWN, exp,U8: unexpected expression"
        " type (%s) in I/O processing", MTYPE_name(etype));
    else
      Fail_FmtAssertion("Gen_Io_PutFieldWN, expression: unexpected field"
      " type (%s) in I/O processing", MTYPE_name(ftype));

  } else

    Fail_FmtAssertion("Gen_Io_PutFieldWN: unexpected node (%s)"
          " in I/O processing", OPCODE_name(WN_opcode(wn)));

  /*  Add the generated load/store into the statement block being created  */
  /*  for the I/O statement.               */

  WN_INSERT_BlockLast ( block, wnx );

}


/*  This routine is used to set the Keyspec structure.  This routine will   */
/*  take an array of values specified by a WN and put it into an array of   */
/*  structures specified by the ST. All necessary data conversions are      */
/*  generated.                    */

static void Gen_Io_PutKeyFieldWN ( WN * block, ST * st, WN ** wn, INT32 nkeys )
{
  WN * wnx = NULL;
  INT32 foffset;
  INT32 etype;
  INT32 vtype;
  INT32 i;

  /*  Lookup the offset and type of the requested field.  */

  foffset = 0;

  /*  Go through the list of all nkeys and assign the WN values into the     */
  /*  array of Keyspec structure                                             */

  for (i = 0; i < nkeys; i++, wn++, foffset += 2) {
  /*  Determine kind and type of expression node.  Then convert the node to  */
  /*  INT16 as needed.  Finally, store into the field.                       */

    if (WN_opcode(*wn) == OPC_I4INTCONST) {

      wnx = WN_CreateStid ( OPC_I2STID, foffset, st, Be_Type_Tbl(MTYPE_I2),
      WN_CreateIntconst ( OPC_I4INTCONST, WN_const_val(*wn) ));
      WN_Delete ( *wn );

    } else if (WN_opcode(*wn) == OPC_I8INTCONST) {

      wnx = WN_CreateStid ( OPC_I2STID, foffset, st, Be_Type_Tbl(MTYPE_I2),
        WN_CreateIntconst ( OPC_I4INTCONST, WN_const_val(*wn) ));
      WN_Delete ( *wn );

    } else if (WN_opcode(*wn) == OPC_U4LDA || WN_opcode(*wn) == OPC_U8LDA) {

      vtype = ST_btype(WN_st(*wn));
      if (vtype == MTYPE_I4)
  wnx = WN_CreateStid ( OPC_I2STID, foffset, st, Be_Type_Tbl(MTYPE_I2),
        WN_CreateLdid ( OPC_I4I4LDID, WN_offset(*wn), WN_st(*wn),
            Be_Type_Tbl(MTYPE_I4) ));
      else if (vtype == MTYPE_I8)
  wnx = WN_CreateStid ( OPC_I2STID, foffset, st, Be_Type_Tbl(MTYPE_I2),
        WN_CreateExp1 ( OPC_I4I8CVT,
        WN_CreateLdid ( OPC_I8I8LDID, WN_offset(*wn), WN_st(*wn),
            Be_Type_Tbl(MTYPE_I8) )));
      else if (vtype == MTYPE_F4)
  wnx = WN_CreateStid ( OPC_I2STID, foffset, st, Be_Type_Tbl(MTYPE_I2),
        WN_CreateExp1 ( OPC_I4F4CVT,
        WN_CreateLdid ( OPC_F4F4LDID, WN_offset(*wn), WN_st(*wn),
            Be_Type_Tbl(MTYPE_F4) )));
      else if (vtype == MTYPE_F8)
  wnx = WN_CreateStid ( OPC_I2STID, foffset, st, Be_Type_Tbl(MTYPE_I2),
        WN_CreateExp1 ( OPC_I4F8CVT,
        WN_CreateLdid ( OPC_F8F8LDID, WN_offset(*wn), WN_st(*wn),
            Be_Type_Tbl(MTYPE_F8) )));
      else if (vtype == MTYPE_F10)
        wnx = WN_CreateStid ( OPC_I2STID, foffset, st, Be_Type_Tbl(MTYPE_I2),
              WN_CreateExp1 ( OPC_I4F10CVT,
              WN_CreateLdid ( OPC_F10F10LDID, WN_offset(*wn), WN_st(*wn),
                              Be_Type_Tbl(MTYPE_F10) )));
      else if (vtype == MTYPE_FQ)
  wnx = WN_CreateStid ( OPC_I2STID, foffset, st, Be_Type_Tbl(MTYPE_I2),
        WN_CreateExp1 ( OPC_I4FQCVT,
        WN_CreateLdid ( OPC_FQFQLDID, WN_offset(*wn), WN_st(*wn),
            Be_Type_Tbl(MTYPE_FQ) )));
      else
  Fail_FmtAssertion("Gen_Io_PutKeyFieldWN: unexpected item type (%s)"
        " in I/O processing", MTYPE_name(vtype));
      WN_Delete ( *wn );

    } else if (OPCODE_is_expression(WN_opcode(*wn))) {

      etype = WN_rtype(*wn);
      if (etype == MTYPE_I4)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I2),
        *wn );
      else if (etype == MTYPE_I8)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I2),
        WN_CreateExp1 ( OPC_I4I8CVT, *wn ));
      else if (etype == MTYPE_F4)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I2),
        WN_CreateExp1 ( OPC_I4F4CVT, *wn ));
      else if (etype == MTYPE_F8)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I2),
        WN_CreateExp1 ( OPC_I4F8CVT, *wn ));
      else if (etype == MTYPE_F10)
        wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I2),
              WN_CreateExp1 ( OPC_I4F10CVT, *wn ));
      else if (etype == MTYPE_FQ)
  wnx = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I2),
        WN_CreateExp1 ( OPC_I4FQCVT, *wn ));
      else
  Fail_FmtAssertion("Gen_Io_PutKeyFieldWN: unexpected expression type"
        " (%s) in I/O processing", MTYPE_name(etype));
    } else
      Fail_FmtAssertion("Gen_Io_PutKeyFieldWN: unexpected node (%s)"
      " in I/O processing", OPCODE_name(WN_opcode(*wn)));

    /*  Add the generated load/store into the statement block being created  */
    /*  for the I/O statement.               */

    WN_INSERT_BlockLast ( block, wnx );
  }
}


/*  This routine is one of a set to manage the structures passed between    */
/*  user code and the I/O runtime routines.  This routine will take an      */
/*  integer constant value and put it into any field within any of the      */
/*  seven structures.  The appropriate INTCONST node is generated based on  */
/*  the field type.                 */

static void Gen_Io_PutFieldConst ( WN * block, ST * st, FIOSTRUCT field,
           INT64 value )
{
  WN * wn = NULL;
  INT32 foffset;
  INT32 ftype;

  /*  Lookup the offset and type of the requested field.  */

  if (Pointer_Size == 4) {
    foffset = fiostruct_info[field].offset32;
    ftype = fiostruct_info[field].type32;
  } else {
    foffset = fiostruct_info[field].offset64;
    ftype = fiostruct_info[field].type64;
  }

  /*  Generate an appropriate INTCONST node and store it into the structure  */
  /*  field.                     */

  if (ftype == MTYPE_I4)
    wn = WN_CreateStid ( OPC_I4STID, foffset, st, Be_Type_Tbl(MTYPE_I4),
   WN_CreateIntconst ( OPC_I4INTCONST, value ));
  else if (ftype == MTYPE_U4)
    wn = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4),
   WN_CreateIntconst ( OPC_U4INTCONST, value ));
  else if (ftype == MTYPE_I8)
    wn = WN_CreateStid ( OPC_I8STID, foffset, st, Be_Type_Tbl(MTYPE_I8),
   WN_CreateIntconst ( OPC_I8INTCONST, value ));
  else if (ftype == MTYPE_U8)
    wn = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8),
   WN_CreateIntconst ( OPC_U8INTCONST, value ));
  else
    Fail_FmtAssertion("Gen_Io_PutFieldConst: unexpected field type (%s)"
          " in I/O processing", MTYPE_name(ftype));

  /*  Add the generated load/store into the statement block being created  */
  /*  for the I/O statement.               */

  WN_INSERT_BlockLast ( block, wn );

}


/*  This routine is one of a set to manage the structures passed between    */
/*  user code and the I/O runtime routines.  This routine will take an      */
/*  address (given by an LDA node, ARRAY node or an LDID node) and put it   */
/*  into any field within any of the I/O structures.  It will also save the */
/*  ST info for use by Gen_Io_Calls to build a dummy argument list of       */
/*  referenced variables.               */

static void Gen_Io_PutAddrWN ( WN * block, ST * st, FIOSTRUCT field, WN * wn )
{
  INT32 foffset;
  INT32 ftype;
  WN * wnx;

#ifdef KEY
  // Bug 10413: IPA may have constant propagated a non-existing optional
  // argument to an IO_ITEM, skip it.
  if (WN_operator(wn) == OPR_INTCONST)
  {
    FmtAssert (WN_const_val(wn) == 0,
               ("Gen_Io_PutAddrWN: INTCONST can only be zero"));
    return;
  }
#endif

  /*  Save the ST info for building dummy parm lists.  */

  wnx = wn;
  Add_To_Dummy_List(wnx);

  /*  Lookup the offset and type of the requested field.  */

  if (Pointer_Size == 4) {
    foffset = fiostruct_info[field].offset32;
    ftype = fiostruct_info[field].type32;
  } else {
    foffset = fiostruct_info[field].offset64;
    ftype = fiostruct_info[field].type64;
  }

  /*  Generate the appropriate STID depending on the field type and  */
  /*  child node.                */

  if ((WN_opcode(wn) == OPC_U4LDA   || WN_opcode(wn) == OPC_U4U4LDID  ||
       WN_opcode(wn) == OPC_U4ARRAY || WN_opcode(wn) == OPC_U4U4ILOAD ||
       WN_opcode(wn) == OPC_U4ADD || WN_opcode(wn) == OPC_I4I4LDID)  &&
      (ftype == MTYPE_U4 || ftype == MTYPE_I4 || ftype == MTYPE_M))
    wnx = WN_CreateStid ( OPC_U4STID, foffset, st, Be_Type_Tbl(MTYPE_U4), wn );

  else if ((WN_opcode(wn) == OPC_U4LDA   || WN_opcode(wn) == OPC_U4U4LDID  ||
       WN_opcode(wn) == OPC_U4ARRAY || WN_opcode(wn) == OPC_U4U4ILOAD ||
       WN_opcode(wn) == OPC_U4ADD)  &&
      (ftype == MTYPE_U8 || ftype == MTYPE_I8 ))
    wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8), 
          WN_CreateExp1 ( OPC_U8U4CVT, wn));

  else if ((WN_opcode(wn) == OPC_U8LDA   || WN_opcode(wn) == OPC_U8U8LDID  ||
      WN_opcode(wn) == OPC_U8ARRAY || WN_opcode(wn) == OPC_U8U8ILOAD ||
      WN_opcode(wn) == OPC_U8ADD || WN_opcode(wn) == OPC_I8I8LDID)  &&
     (ftype == MTYPE_U8 || ftype == MTYPE_I8 || ftype == MTYPE_M))
    wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8), wn );

  else if ((WN_opcode(wn) == OPC_U8LDA   || WN_opcode(wn) == OPC_U8U8LDID  ||
      WN_opcode(wn) == OPC_U8ARRAY || WN_opcode(wn) == OPC_U8U8ILOAD ||
      WN_opcode(wn) == OPC_U8ADD)   &&
     (ftype == MTYPE_U4 || ftype == MTYPE_I4 ))
    wnx = WN_CreateStid ( OPC_U8STID, foffset, st, Be_Type_Tbl(MTYPE_U8), 
          WN_CreateExp1 ( OPC_U4U8CVT, wn ));

  else if (WN_opcode(wn) == OPC_MLOAD) 
    wnx = WN_CreateMstore(foffset, Create_Maligned_TY(foffset, ST_type(st)), wn,
    WN_CreateLda(opc_lda, 0, TY_pointer(ST_type(st)), st),
    WN_CreateIntconst ( OPC_U4INTCONST, fcd_size));
  else 
    Fail_FmtAssertion("Gen_Io_PutAddrWN: unexpected field type (%s)"
          " in I/O processing", MTYPE_name(ftype));

  /*  Add the generated load/store into the statement block being created  */
  /*  for the I/O statement.               */

  WN_INSERT_BlockLast ( block, wnx );

}


static void
Set_Cilist_Fields( WN * block, ST *st,
       WN *unit_wn, WN **items, WN *rec_wn, 
       WN *parsfmt_wn, WN *fmtsrc_wn, 
       WN *advance_wn, WN *size_wn, WN *varfmt )
{
  INT32 keytype;

  if (unit_wn != NULL)
    Gen_Io_PutAddrWN ( block, st, FCR_CI_UNIT, unit_wn );
  if (items[IOC_IOSTAT] != NULL)
    Gen_Io_PutAddrWN ( block, st, FCR_CI_IOSTAT, items[IOC_IOSTAT]);
  if (rec_wn != NULL)
    Gen_Io_PutAddrWN ( block, st, FCR_CI_REC, rec_wn );
  if (parsfmt_wn != NULL)
    Gen_Io_PutAddrWN ( block, st, FCR_CI_PARSFMT, parsfmt_wn );
  if (fmtsrc_wn != NULL) {
    Gen_Io_PutAddrWN ( block, st, FCR_CI_FMTSRC, fmtsrc_wn );
  }
  if (advance_wn != NULL)
    Gen_Io_PutAddrWN ( block, st, FCR_CI_ADVANCE, advance_wn );
  if (size_wn != NULL)
    Gen_Io_PutAddrWN ( block, st, FCR_CI_SIZE, size_wn );
  if (varfmt != NULL) {
    /* Calvin TODO */
      fprintf( stderr, "Variable format not yet implemented\n" );
      abort();
  }
  if (items[IOC_KEY] != NULL) {
    keytype = IOC_KEY;
  } else if (items[IOC_KEYEQ] != NULL) {
    keytype = IOC_KEYEQ;
  } else if (items[IOC_KEYGE] != NULL) {
    keytype = IOC_KEYGE;
  } else if (items[IOC_KEYGT] != NULL) {
    keytype = IOC_KEYGT;
  } else
    keytype = 0;
  if (keytype) {
    fprintf( stderr, "Keyed I/O is not done\n" );
  } else {
    /* Calvin TODO: Need to clear the fields for non-indexed I/O */
  }
  if (items[IOC_KEYID] != NULL) {
  } else {
    /* Calvin TODO: Need to set the field to -1 for non-indexed I/O */
  }
}


/*  This routine is used to build up an I/O mask used as the second argument  */
/*  to the OPEN and INQUIRE runtimes.  Every user scalar variable (logical or */
/*  integer) which can be stored into by the runtime is represented by two    */
/*  bits in the iomask.  These two bits encode the size of the user variable. */

static void Build_Io_Mask ( INT32 * iomask, INT32 ioshift, WN * wn )
{
  TY_IDX  ty;
  INT32 mtype = 0;

  /*  Determine the basic type of the user variable.  */

  if (WN_operator(wn) == OPR_LDA  ||
      WN_operator(wn) == OPR_LDID ||
      WN_operator(wn) == OPR_ILOAD) {
    ty = WN_ty(wn);
    while (TY_kind(ty) == KIND_POINTER || TY_kind(ty) == KIND_ARRAY)
      if (TY_kind(ty) == KIND_POINTER)
  ty = TY_pointed(ty);
      else
        ty = TY_etype (ty);
    mtype = TY_mtype(ty);
  }

  /*  Based on the type, get the size code, shift it into position and add  */
  /*  it to the iomask being built.             */

  *iomask |= (fio_maskcode[mtype] << ioshift);

}


/* ====================================================================
 *
 * WN *extract_calls (WN * block, WN * tree)
 *
 * Called by I/O lowerer to extract any nested calls or expressions which
 * require a store to a temporary.  Due to the semantics of F77 I/O such
 * expressions can not (in the general case) be extracted from within
 * the I/O statement when the tree is built.  On the other side, WHIRL
 * semantics does not allow a statement (or expression with side effects)
 * to be nested within an normal expression.  So the WHIRL rules were
 * slightly relaxed to allow CALL's within an I/O expression.  The case
 * of stores to temps is handled by a set of special, internal only,
 * INTRINSIC_OP's which indicate where a store to a temp is needed and
 * this routine does the extraction, temp generation, store and reload.
 *
 * ==================================================================== */

static WN *extract_calls ( WN * block, WN * tree )
{
  INT32 i;
  INT32 dtype;
  BOOL loadaddr;
  TY_IDX ttype;
  ST *temp;
  WN *kid0;
  PREG_NUM reg1, reg2;

  /* First process all kids in case there are multiple (nested) calls so
     that they will be done in the correct sequence.  */

  for (i = 0; i < WN_kid_count(tree); i++)
    WN_kid(tree,i) = extract_calls ( block, WN_kid(tree,i) );

  /*  If the current tree node is one of the special INTRINSIC_OP's, then
      extract the subtree, generate a temp and a store to that temp.  Place
      all of that at the block level and replace the subtree with an
      appropriate (re-)load operation.  Character functions are handled a
      little differently.  */

  if (WN_operator(tree) == OPR_INTRINSIC_OP) {

    kid0 = WN_kid0(tree);

    switch (WN_intrinsic(tree)) {

      case INTRN_U4I1ADRTMP:
      case INTRN_U8I1ADRTMP:  dtype    = MTYPE_I1;
        loadaddr = TRUE;
        break;

      case INTRN_U4I2ADRTMP:
      case INTRN_U8I2ADRTMP:  dtype    = MTYPE_I2;
        loadaddr = TRUE;
        break;

      case INTRN_U4I4ADRTMP:
      case INTRN_U8I4ADRTMP:  dtype    = MTYPE_I4;
        loadaddr = TRUE;
        break;

      case INTRN_U4I8ADRTMP:
      case INTRN_U8I8ADRTMP:  dtype    = MTYPE_I8;
        loadaddr = TRUE;
        break;

      case INTRN_U4F4ADRTMP:
      case INTRN_U8F4ADRTMP:  dtype    = MTYPE_F4;
        loadaddr = TRUE;
        break;

      case INTRN_U4F8ADRTMP:
      case INTRN_U8F8ADRTMP:  dtype    = MTYPE_F8;
        loadaddr = TRUE;
        break;

      case INTRN_U4FQADRTMP:
      case INTRN_U8FQADRTMP:  dtype    = MTYPE_FQ;
        loadaddr = TRUE;
        break;

      case INTRN_U4C4ADRTMP:
      case INTRN_U8C4ADRTMP:  dtype    = MTYPE_C4;
        loadaddr = TRUE;
        break;

      case INTRN_U4C8ADRTMP:
      case INTRN_U8C8ADRTMP:  dtype    = MTYPE_C8;
        loadaddr = TRUE;
        break;

      case INTRN_U4CQADRTMP:
      case INTRN_U8CQADRTMP:  dtype    = MTYPE_CQ;
        loadaddr = TRUE;
        break;

      case INTRN_U4VADRTMP:
      case INTRN_U8VADRTMP: WN_Delete ( tree );
        WN_INSERT_BlockLast ( block, kid0 );
        if (WN_operator(WN_kid0(kid0)) != OPR_PARM)
          return (WN_COPY_Tree (WN_kid0(kid0)));
        else
         return (WN_COPY_Tree (WN_kid0(WN_kid0(kid0))));

      case INTRN_I4VALTMP:  dtype    = MTYPE_I4;
        loadaddr = FALSE;
        break;

      case INTRN_I8VALTMP:  dtype    = MTYPE_I8;
        loadaddr = FALSE;
        break;

      case INTRN_U4VALTMP:  dtype    = MTYPE_U4;
        loadaddr = FALSE;
        break;

      case INTRN_U8VALTMP:  dtype    = MTYPE_U8;
        loadaddr = FALSE;
        break;

      case INTRN_F4VALTMP:  dtype    = MTYPE_F4;
        loadaddr = FALSE;
        break;

      case INTRN_F8VALTMP:  dtype    = MTYPE_F8;
        loadaddr = FALSE;
        break;

      case INTRN_FQVALTMP:  dtype    = MTYPE_FQ;
        loadaddr = FALSE;
        break;

      case INTRN_C4VALTMP:  dtype    = MTYPE_C4;
        loadaddr = FALSE;
        break;

      case INTRN_C8VALTMP:  dtype    = MTYPE_C8;
        loadaddr = FALSE;
        break;

      case INTRN_CQVALTMP:  dtype    = MTYPE_CQ;
        loadaddr = FALSE;
        break;

      default:      return (tree);

    }

    WN_Delete ( tree );
    ttype = MTYPE_To_TY ( dtype );
    temp = Gen_Temp_Symbol ( ttype, "iotemp" );
    io_set_addr_saved_flag(temp);

    if (OPCODE_is_call(WN_opcode(kid0))) {

      WN_INSERT_BlockLast ( block, kid0 );

      if (WHIRL_Return_Info_On) {

  RETURN_INFO return_info = Get_Return_Info (Be_Type_Tbl(dtype),
               Use_Simulated);

  if (RETURN_INFO_count(return_info) <= 2) {

    reg1 = RETURN_INFO_preg (return_info, 0);
    reg2 = RETURN_INFO_preg (return_info, 1);
  }

  else
    Fail_FmtAssertion ("extract_calls: more than 2 return registers");
      }
      else
  Get_Return_Pregs ( dtype, MTYPE_UNKNOWN, &reg1, &reg2 );

      WN_INSERT_BlockLast ( block, WN_Stid ( dtype, 0, temp, ttype,
           WN_LdidPreg ( dtype, reg1 )));

    } else {

      WN_INSERT_BlockLast ( block, WN_Stid ( dtype, 0, temp, ttype, kid0 ));

    }

    if (loadaddr)
      return (WN_Lda ( Pointer_type, 0, temp ));
    else
      return (WN_Ldid ( dtype, 0, temp, ttype ));

  }

  /*  Just return the passed tree node because it's nothing special.  */

  return (tree);

}

static WN *
Create_fcd (WN *block, WN *kid1, WN *kid2)
{
   ST *st;
   WN *fcd;

   st = Get_IoStruct_ST ( block, FID_CRAY_FCD, FALSE );
   Gen_Io_PutAddrWN ( block, st, FCR_FCD_ADDR, WN_COPY_Tree(kid1));
   Gen_Io_PutFieldWN ( block, st, FCR_FCD_LEN, WN_COPY_Tree(kid2));
   fcd = WN_CreateMload( 0, TY_pointer(ST_type(st)),
             WN_CreateLda(opc_lda, 0, TY_pointer(ST_type(st)), st),
             WN_CreateIntconst ( OPC_U4INTCONST, fcd_size));
   return (fcd);
}

/* ====================================================================
 *
 * void copyout_temp_to_var ( WN * addr, ST *st, TY_IDX ty)
 *
 * For F90, for certain control list items, eg. iostat, exist, size, etc.,
 * the library expects the item to be an 32bit item. A temp is generated 
 * in get_32bit_cilist_item and then in this routine we generate a block
 * to copy all such temps back to the user variable.  
 *
 * ==================================================================== 
 */

static void copyout_temp_to_var ( WN * addr, ST *st, TY_IDX ty)
{
  WN * wn;

  if (TY_mtype(ty) == MTYPE_I1)
        wn = WN_CreateIstore ( OPC_I1ISTORE, 0,
                       Make_Pointer_Type(Be_Type_Tbl(MTYPE_I1), FALSE),
                       WN_CreateLdid ( OPC_I4I4LDID, 0, st,
                                       Be_Type_Tbl(MTYPE_I4) ), addr );
  else if (TY_mtype(ty) == MTYPE_U1)
        wn = WN_CreateIstore ( OPC_U1ISTORE, 0,
                       Make_Pointer_Type(Be_Type_Tbl(MTYPE_U1), FALSE),
                       WN_CreateLdid ( OPC_U4U4LDID, 0, st,
                                       Be_Type_Tbl(MTYPE_U4) ), addr );
  else if (TY_mtype(ty) == MTYPE_I2)
        wn = WN_CreateIstore ( OPC_I2ISTORE, 0,
                       Make_Pointer_Type(Be_Type_Tbl(MTYPE_I2), FALSE),
                       WN_CreateLdid ( OPC_I4I4LDID, 0, st,
                                       Be_Type_Tbl(MTYPE_I4) ), addr );
  else if (TY_mtype(ty) == MTYPE_U2)
        wn = WN_CreateIstore ( OPC_U2ISTORE, 0,
                       Make_Pointer_Type(Be_Type_Tbl(MTYPE_U2), FALSE),
                       WN_CreateLdid ( OPC_U4U4LDID, 0, st,
                                       Be_Type_Tbl(MTYPE_U4) ), addr );
  else if (TY_mtype(ty) == MTYPE_I8)
        wn = WN_CreateIstore ( OPC_I8ISTORE, 0,
                       Make_Pointer_Type(Be_Type_Tbl(MTYPE_I8), FALSE),
                       WN_CreateLdid ( OPC_I8I4LDID, 0, st,
                                       Be_Type_Tbl(MTYPE_I4) ), addr );
  else if (TY_mtype(ty) == MTYPE_U8)
        wn = WN_CreateIstore ( OPC_U8ISTORE, 0,
                       Make_Pointer_Type(Be_Type_Tbl(MTYPE_U8), FALSE),
                       WN_CreateLdid ( OPC_U8U4LDID, 0, st,
                                       Be_Type_Tbl(MTYPE_U4) ), addr );
  else
    Fail_FmtAssertion("copyout_temp_to_var: unexpected type (%s)"
          " in I/O processing", MTYPE_name(TY_mtype(ty)));

  if (copyout_block == NULL) 
    copyout_block = WN_CreateBlock();

  WN_INSERT_BlockLast ( copyout_block, wn );

}

/* ====================================================================
 *
 * WN * get_32bit_cilist_item(WN *cilist_item, TY_IDX ty)
 *
 * For F90, for certain control list items, eg. iostat, exist, size, etc.,
 * the library expects the item to be an 32bit item. If the cilist_item
 * is not a 32-bit item, a temp will be generated in this routine and 
 * copyout_temp_to_var will be called to generate a block that copies the temp
 * back to the user variable. Otherwise, the original item is returned.
 * The block, if generated, is grafted after the runtime call in 
 * process_iostat.
 *
 * ====================================================================
 */

static WN *
get_32bit_cilist_item(WN *cilist_item, TY_IDX ty)
{
  TYPE_ID mtype = TY_mtype(ty);
  ST *st;
  WN *wn;

  if (mtype != MTYPE_I4 && mtype != MTYPE_U4) {

     if (MTYPE_is_signed(mtype)) {
       st = Gen_Temp_Symbol( MTYPE_To_TY(MTYPE_U4), "temp_cilist_item");
       copyout_temp_to_var(cilist_item, st, ty);
       wn = WN_CreateLda (opc_lda, 0,
                          Make_Pointer_Type (MTYPE_To_TY(MTYPE_U4), FALSE),
                          st);
     } else {
       st = Gen_Temp_Symbol( MTYPE_To_TY(MTYPE_I4), "temp_cilist_item");
       copyout_temp_to_var(cilist_item, st, ty);
       wn = WN_CreateLda (opc_lda, 0,
                          Make_Pointer_Type (MTYPE_To_TY(MTYPE_I4), FALSE),
                          st);
     }
     return wn;
  } else {
     return cilist_item;
  }
}

/* ====================================================================
 *
 * void process_iostat ( WN ** block1, WN ** block2, BOOL flag,
 *       WN * iostat, ST * err, ST * end, ST * eor,
 *                       BOOL zero_escape_freq )
 *
 * Called by the I/O lowerer to process all uses of the I/O status return.
 * The possible uses are IOSTAT=var, ERR=label, END=label or EOR=LABEL. This 
 * routine generates two blocks of code to deal with I/O status. The first 
 * (block1) is grafted after all but the last runtime call for the current I/O
 * statement.  The second (block2) is grafted after the final runtime
 * call.  Gen_Io_Call does the actual work of attaching these blocks of
 * code after the runtime call.  As an optimization, the flag argument is
 * TRUE if both blocks need to be generated (in the context of a particular
 * I/O statement, lower_io_statement knows if one or more runtime calls
 * will be required) or FALSE if only a degenerate version of block2 needs
 * to be generated.  zero_escape_freq is TRUE iff feedback is available
 * and feedback indicates that all branches to err, end, and eor have
 * exact zero frequency.
 *
 * ==================================================================== */

static void process_iostat ( WN **block1, WN **block2, BOOL flag, WN *iostat,
                             LABEL_IDX err, LABEL_IDX end, LABEL_IDX eor,
           BOOL zero_escape_freq )
{
  PREG_NUM rreg1, rreg2;
  PREG_NUM pregnum;
  WN * wn;
  WN * iostatx;
  WN * test_label = NULL;
  ST * pregst;
  TY_IDX  iostatty;
  BOOL only_copyout_needed = FALSE;

  /*  If no error handling is specified, then return NULL blocks. */

#ifdef KEY
  // Under -IPA, different PUs may have different src_lang, but the driver
  // always passes -LANG:=ansi_c
  if (PU_f90_lang(Get_Current_PU())) {
#else
  if (Language == LANG_F90) {
#endif // KEY
    if (iostat == NULL &&
  end == (LABEL_IDX) 0 &&
  err == (LABEL_IDX) 0 &&
  eor == (LABEL_IDX) 0) {
      if (copyout_block) {
   only_copyout_needed = TRUE;
      } else {
         *block1 = NULL;
         *block2 = NULL;
         return;
      }
    }
  } else {
    if (iostat == NULL && end == (LABEL_IDX) 0 && err == (LABEL_IDX) 0) {
      *block1 = NULL;
      *block2 = NULL;
      return;
    }
  }

  /*  Create BLOCK nodes to hold WHIRL trees.  */

  if (flag)
    *block1 = WN_CreateBlock();
  else
    *block1 = NULL;
  *block2 = WN_CreateBlock();


#ifdef KEY
  // Under -IPA, different PUs may have different src_lang, but the driver
  // always passes -LANG:=ansi_c
  if ((PU_f90_lang(Get_Current_PU())) && only_copyout_needed) {
#else
  if ((Language == LANG_F90) && only_copyout_needed) {
#endif // KEY
    if (flag)
       WN_INSERT_BlockLast ( *block1, WN_COPY_Tree(copyout_block) );
    WN_INSERT_BlockLast ( *block2, copyout_block );
    return;
  } 

  /*  Generate error test label if needed.  */

  if (flag)
    test_label = WN_CreateNewLabel();

  /*  Generate a preg to hold I/O status return.  */

  if (WHIRL_Return_Info_On) {

    RETURN_INFO return_info = Get_Return_Info (Be_Type_Tbl(MTYPE_I4),
                 Use_Simulated);

    if (RETURN_INFO_count(return_info) <= 2) {

      rreg1 = RETURN_INFO_preg (return_info, 0);
      rreg2 = RETURN_INFO_preg (return_info, 1);
    }

    else
      Fail_FmtAssertion ("process_iostat: more than 2 return registers");
  }

  else
    Get_Return_Pregs ( MTYPE_I4, MTYPE_UNKNOWN, &rreg1, &rreg2 );

  pregst = MTYPE_To_PREG ( MTYPE_I4 );
  pregnum = Create_Preg ( MTYPE_I4, "io_status");
  wn = WN_CreateStid ( OPC_I4STID, pregnum, pregst, Be_Type_Tbl(MTYPE_I4),
           WN_CreateLdid ( OPC_I4I4LDID, rreg1, Int32_Preg,
               Be_Type_Tbl(MTYPE_I4) ));
  if (flag)
    WN_INSERT_BlockLast ( *block1, WN_COPY_Tree(wn) );
  WN_INSERT_BlockLast ( *block2, wn );

#ifdef KEY
  // Under -IPA, different PUs may have different src_lang, but the driver
  // always passes -LANG:=ansi_c
  if ((PU_f90_lang(Get_Current_PU())) && copyout_block) {
#else
  if ((Language == LANG_F90) && copyout_block) {
#endif // KEY
    if (flag)
       WN_INSERT_BlockLast ( *block1, WN_COPY_Tree(copyout_block) );
    WN_INSERT_BlockLast ( *block2, copyout_block );
  }

  /*  Generate a store into a user variable if requested. */

  if (current_io_library == IOLIB_MIPS && iostat != NULL) {
    if (WN_operator(iostat) == OPR_LDA) {
      iostatty = WN_ty(iostat);
      while (TY_kind(iostatty) == KIND_POINTER)
        iostatty = TY_pointed(iostatty);
      if (TY_mtype(iostatty) == MTYPE_I1)
  wn = WN_CreateStid ( OPC_I1STID, 0, WN_st(iostat),
           Be_Type_Tbl(MTYPE_I1),
           WN_CreateLdid ( OPC_I4I4LDID, pregnum, pregst,
               Be_Type_Tbl(MTYPE_I4) ));
      else if (TY_mtype(iostatty) == MTYPE_I2)
  wn = WN_CreateStid ( OPC_I2STID, 0, WN_st(iostat),
           Be_Type_Tbl(MTYPE_I2),
           WN_CreateLdid ( OPC_I4I4LDID, pregnum, pregst,
               Be_Type_Tbl(MTYPE_I4) ));
      else if (TY_mtype(iostatty) == MTYPE_I4)
  wn = WN_CreateStid ( OPC_I4STID, 0, WN_st(iostat),
           Be_Type_Tbl(MTYPE_I4),
           WN_CreateLdid ( OPC_I4I4LDID, pregnum, pregst,
               Be_Type_Tbl(MTYPE_I4) ));
      else if (TY_mtype(iostatty) == MTYPE_I8)
  wn = WN_CreateStid ( OPC_I8STID, 0, WN_st(iostat),
           Be_Type_Tbl(MTYPE_I8),
           WN_CreateLdid ( OPC_I8I4LDID, pregnum, pregst,
               Be_Type_Tbl(MTYPE_I8) ));
      else
  Fail_FmtAssertion("unexpected iostat type (%s) in"
        " I/O processing",
        MTYPE_name(TY_mtype(iostatty)));
    } else {
      iostatx = iostat;
      while (WN_operator(iostatx) == OPR_ARRAY)
  iostatx = WN_kid0(iostatx);
      iostatty = WN_ty(iostatx);
      while (TY_kind(iostatty) == KIND_POINTER ||
       TY_kind(iostatty) == KIND_ARRAY)
        if (TY_kind(iostatty) == KIND_POINTER)
          iostatty = TY_pointed(iostatty);
        else
          iostatty = TY_AR_etype(iostatty);
      if (TY_mtype(iostatty) == MTYPE_I1)
  wn = WN_CreateIstore ( OPC_I1ISTORE, 0,
             Make_Pointer_Type(Be_Type_Tbl(MTYPE_I1), FALSE),
             WN_CreateLdid ( OPC_I4I4LDID, pregnum, pregst,
                 Be_Type_Tbl(MTYPE_I4) ),
             iostat );
      else if (TY_mtype(iostatty) == MTYPE_I2)
  wn = WN_CreateIstore ( OPC_I2ISTORE, 0,
             Make_Pointer_Type(Be_Type_Tbl(MTYPE_I2), FALSE),
             WN_CreateLdid ( OPC_I4I4LDID, pregnum, pregst,
                 Be_Type_Tbl(MTYPE_I4) ),
             iostat );
      else if (TY_mtype(iostatty) == MTYPE_I4)
  wn = WN_CreateIstore ( OPC_I4ISTORE, 0,
             Make_Pointer_Type(Be_Type_Tbl(MTYPE_I4), FALSE),
             WN_CreateLdid ( OPC_I4I4LDID, pregnum, pregst,
                 Be_Type_Tbl(MTYPE_I4) ),
             iostat );
      else if (TY_mtype(iostatty) == MTYPE_I8)
  wn = WN_CreateIstore ( OPC_I8ISTORE, 0,
             Make_Pointer_Type(Be_Type_Tbl(MTYPE_I8), FALSE),
             WN_CreateLdid ( OPC_I8I4LDID, pregnum, pregst,
                 Be_Type_Tbl(MTYPE_I8) ),
             iostat );
      else
  Fail_FmtAssertion("unexpected iostat type (%s) in I/O processing",
        MTYPE_name(TY_mtype(iostatty)));
    }
    if (flag)
      WN_INSERT_BlockLast ( *block1, WN_COPY_Tree(wn) );
    WN_INSERT_BlockLast ( *block2, wn );
  }

  /*  Generate general error branch if needed.  */

  if (flag) {
    wn = WN_CreateTruebr ( WN_label_number(test_label),
         WN_CreateExp2 ( OPC_I4I4NE,
             WN_CreateLdid ( OPC_I4I4LDID,
                 pregnum, pregst,
              Be_Type_Tbl(MTYPE_I4) ),
             WN_CreateIntconst ( OPC_I4INTCONST,
                     0 )));
    WN_INSERT_BlockLast ( *block1, wn );
    WN_INSERT_BlockLast ( *block2, test_label );
  }

  if (current_io_library == IOLIB_MIPS) {
     /*  Generate a conditional branch to an end statement if requested.  */
     
     if (end != (LABEL_IDX) 0) {
       LABEL_IDX end_label;
       end_label = end;
       wn = WN_CreateTruebr ( end_label,
           WN_CreateExp2 ( OPC_I4I4LT,
               WN_CreateLdid ( OPC_I4I4LDID,
                   pregnum, pregst,
                Be_Type_Tbl(MTYPE_I4) ),
               WN_CreateIntconst ( OPC_I4INTCONST,
                       0 )));
       WN_INSERT_BlockLast ( *block2, wn );

       // Update feedback
       if ( zero_escape_freq && Cur_PU_Feedback )
   Cur_PU_Feedback->Annot( wn, FB_EDGE_BRANCH_TAKEN, FB_FREQ_ZERO );
     }
   
     /*  Generate a conditional branch to an error statement if requested.  */
   
     if (err != (LABEL_IDX) 0) {
       LABEL_IDX err_label;
       err_label = err;
       if (!end && !iostat)
         wn = WN_CreateTruebr ( err_label,
           WN_CreateExp2 ( OPC_I4I4NE,
               WN_CreateLdid ( OPC_I4I4LDID,
                   pregnum, pregst,
                Be_Type_Tbl(MTYPE_I4) ),
               WN_CreateIntconst ( OPC_I4INTCONST,
                       0 )));
       else
         wn = WN_CreateTruebr ( err_label,
           WN_CreateExp2 ( OPC_I4I4GT,
               WN_CreateLdid ( OPC_I4I4LDID,
                   pregnum, pregst,
                Be_Type_Tbl(MTYPE_I4) ),
               WN_CreateIntconst ( OPC_I4INTCONST,
                       0 )));
       WN_INSERT_BlockLast ( *block2, wn );

       // Update feedback
       if ( zero_escape_freq && Cur_PU_Feedback )
   Cur_PU_Feedback->Annot( wn, FB_EDGE_BRANCH_TAKEN, FB_FREQ_ZERO );
     }
  } else {      /* IOLIB_CRAY */
     if (err != (LABEL_IDX) 0) {
       LABEL_IDX err_label;
       err_label = err;
       wn = WN_CreateTruebr ( err_label,
           WN_CreateExp2 ( OPC_I4I4EQ,
               WN_CreateLdid ( OPC_I4I4LDID,
                   pregnum, pregst,
                Be_Type_Tbl(MTYPE_I4) ),
               WN_CreateIntconst ( OPC_I4INTCONST,
                       1 )));
       WN_INSERT_BlockLast ( *block2, wn );

       // Update feedback
       if ( zero_escape_freq && Cur_PU_Feedback )
   Cur_PU_Feedback->Annot( wn, FB_EDGE_BRANCH_TAKEN, FB_FREQ_ZERO );
     }

     if (end != (LABEL_IDX) 0) {
       LABEL_IDX end_label;
       end_label = end;
       wn = WN_CreateTruebr ( end_label,
           WN_CreateExp2 ( OPC_I4I4EQ,
               WN_CreateLdid ( OPC_I4I4LDID,
                   pregnum, pregst,
                Be_Type_Tbl(MTYPE_I4) ),
               WN_CreateIntconst ( OPC_I4INTCONST,
                       2 )));
       WN_INSERT_BlockLast ( *block2, wn );

       // Update feedback
       if ( zero_escape_freq && Cur_PU_Feedback )
   Cur_PU_Feedback->Annot( wn, FB_EDGE_BRANCH_TAKEN, FB_FREQ_ZERO );
     }

     if (eor != (LABEL_IDX) 0) {
       LABEL_IDX eor_label;
       eor_label = eor;
       wn = WN_CreateTruebr ( eor_label,
           WN_CreateExp2 ( OPC_I4I4EQ,
               WN_CreateLdid ( OPC_I4I4LDID,
                   pregnum, pregst,
                Be_Type_Tbl(MTYPE_I4) ),
               WN_CreateIntconst ( OPC_I4INTCONST,
                       3 )));
       WN_INSERT_BlockLast ( *block2, wn );

       // Update feedback
       if ( zero_escape_freq && Cur_PU_Feedback )
   Cur_PU_Feedback->Annot( wn, FB_EDGE_BRANCH_TAKEN, FB_FREQ_ZERO );
     }
  }
}

/* ====================================================================
 *
 * void process_inqvar ( WN ** block, WN *var )
 *
 * Called by the I/O lowerer to process the return val for 
 * inquire(iolength=var). This routine generates a block of code to 
 * store the value returned by the inquire call into the user variable.
 * Gen_Io_Call does the actual work of attaching this block after the
 * runtime call.
 *
 *
 * ==================================================================== */

static void process_inqvar ( WN ** block, WN * var)
{
  PREG_NUM rreg1, rreg2;
  PREG_NUM pregnum;
  WN * wn;
  WN * varx;
  ST * pregst;
  TY_IDX  varty;

  if (var != NULL) {
    *block = WN_CreateBlock();

    /*  Generate a preg to hold I/O status return.  */

    if (WHIRL_Return_Info_On) {

      RETURN_INFO return_info = Get_Return_Info (Be_Type_Tbl(MTYPE_I4),
                                                 Use_Simulated);

      if (RETURN_INFO_count(return_info) <= 2) {

  rreg1 = RETURN_INFO_preg (return_info, 0);
  rreg2 = RETURN_INFO_preg (return_info, 1);
      }

      else
        Fail_FmtAssertion ("process_inqvar: more than 2 return registers");
    }

    else
      Get_Return_Pregs ( MTYPE_I4, MTYPE_UNKNOWN, &rreg1, &rreg2 );

    pregst = MTYPE_To_PREG ( MTYPE_I4 );
    pregnum = Create_Preg ( MTYPE_I4, "io_status");
    wn = WN_CreateStid ( OPC_I4STID, pregnum, pregst, Be_Type_Tbl(MTYPE_I4),
             WN_CreateLdid ( OPC_I4I4LDID, rreg1, Int32_Preg,
                 Be_Type_Tbl(MTYPE_I4) ));
    WN_INSERT_BlockLast ( *block, wn );

    if (WN_operator(var) == OPR_LDA) {
      varty = WN_ty(var);
      while (TY_kind(varty) == KIND_POINTER)
        varty = TY_pointed(varty);
      if (TY_mtype(varty) == MTYPE_I1)
  wn = WN_CreateStid ( OPC_I1STID, 0, WN_st(var),
           Be_Type_Tbl(MTYPE_I1),
           WN_CreateLdid ( OPC_I4I4LDID, pregnum, pregst,
               Be_Type_Tbl(MTYPE_I4) ));
      else if (TY_mtype(varty) == MTYPE_I2)
  wn = WN_CreateStid ( OPC_I2STID, 0, WN_st(var),
           Be_Type_Tbl(MTYPE_I2),
           WN_CreateLdid ( OPC_I4I4LDID, pregnum, pregst,
               Be_Type_Tbl(MTYPE_I4) ));
      else if (TY_mtype(varty) == MTYPE_I4)
  wn = WN_CreateStid ( OPC_I4STID, 0, WN_st(var),
           Be_Type_Tbl(MTYPE_I4),
           WN_CreateLdid ( OPC_I4I4LDID, pregnum, pregst,
               Be_Type_Tbl(MTYPE_I4) ));
      else if (TY_mtype(varty) == MTYPE_I8)
  wn = WN_CreateStid ( OPC_I8STID, 0, WN_st(var),
           Be_Type_Tbl(MTYPE_I8),
           WN_CreateLdid ( OPC_I8I4LDID, pregnum, pregst,
               Be_Type_Tbl(MTYPE_I8) ));
      else
  Fail_FmtAssertion("process_inqvar, LDA: unexpected var type (%s)"
        " in I/O processing", MTYPE_name(TY_mtype(varty)));
    } else {
      varx = var;
      while (WN_operator(varx) == OPR_ARRAY)
  varx = WN_kid0(varx);
      varty = WN_ty(varx);
      while (TY_kind(varty) == KIND_POINTER ||
       TY_kind(varty) == KIND_ARRAY)
        if (TY_kind(varty) == KIND_POINTER)
          varty = TY_pointed(varty);
        else
          varty = TY_AR_etype(varty);
      if (TY_mtype(varty) == MTYPE_I1)
  wn = WN_CreateIstore ( OPC_I1ISTORE, 0,
             Make_Pointer_Type(Be_Type_Tbl(MTYPE_I1), FALSE),
             WN_CreateLdid ( OPC_I4I4LDID, pregnum, pregst,
                 Be_Type_Tbl(MTYPE_I4) ),
             var );
      else if (TY_mtype(varty) == MTYPE_I2)
  wn = WN_CreateIstore ( OPC_I2ISTORE, 0,
             Make_Pointer_Type(Be_Type_Tbl(MTYPE_I2), FALSE),
             WN_CreateLdid ( OPC_I4I4LDID, pregnum, pregst,
                 Be_Type_Tbl(MTYPE_I4) ),
             var );
      else if (TY_mtype(varty) == MTYPE_I4)
  wn = WN_CreateIstore ( OPC_I4ISTORE, 0,
             Make_Pointer_Type(Be_Type_Tbl(MTYPE_I4), FALSE),
             WN_CreateLdid ( OPC_I4I4LDID, pregnum, pregst,
                 Be_Type_Tbl(MTYPE_I4) ),
             var );
      else if (TY_mtype(varty) == MTYPE_I8)
  wn = WN_CreateIstore ( OPC_I8ISTORE, 0,
             Make_Pointer_Type(Be_Type_Tbl(MTYPE_I8), FALSE),
             WN_CreateLdid ( OPC_I8I4LDID, pregnum, pregst,
                 Be_Type_Tbl(MTYPE_I8) ),
             var );
      else
  Fail_FmtAssertion("process_inqvar: unexpected var type (%s)"
        " in I/O processing", MTYPE_name(TY_mtype(varty)));
    }
    WN_INSERT_BlockLast ( *block, wn );
  }
}


static mINT32 search_implied_do_index ( WN *array_index, ST *implied_do_index )
{

    if ((WN_operator( array_index ) == OPR_CALL) ||
  (WN_operator( array_index ) == OPR_ICALL) ||
  (WN_operator( array_index ) == OPR_PICCALL) ||
  (WN_operator( array_index ) == OPR_INTRINSIC_CALL)) {
      return( 1 );
    } else if (WN_kid_count( array_index ) == 0) {
      if (WN_operator( array_index ) == OPR_LDID 
    && WN_st( array_index ) == implied_do_index)
  return( 1 );
    } else if (WN_kid_count( array_index ) == 1) {
      return( search_implied_do_index( WN_kid0( array_index ),
               implied_do_index));
    } else if (WN_kid_count( array_index ) == 2) {
      if (search_implied_do_index( WN_kid0( array_index ), implied_do_index))
    return( 1 );
      if (search_implied_do_index( WN_kid1( array_index ), implied_do_index))
    return( 1 );
    } else 
      /* return found for unrecognizable expression so no optimization
      ** will be done and to ensure correctness
      */
      return( 1 );
  return( 0 );
}


static FIOITEMTYPE get_FIT_type ( TY_IDX ty )
{
  FIOITEMTYPE type;
  INT32       mtype = TY_mtype(ty);
  BOOL        char_flag = TY_is_character(Ty_Table [ty]);
  BOOL        logical_flag = TY_is_logical(Ty_Table [ty]);

  switch (mtype) {

    case MTYPE_U1:
  type = FIT_CHARACTER;
  break;

    case MTYPE_I1:
  if (char_flag)
    type = FIT_CHARACTER;
  else if (logical_flag)
    type = FIT_LOGICAL1;
  else
    type = FIT_INTEGER1;
  break;

    case MTYPE_I2:
  if (logical_flag)
    type = FIT_LOGICAL2;
  else
    type = FIT_INTEGER2;
  break;

    case MTYPE_I4:
  if (logical_flag)
    type = FIT_LOGICAL4;
  else
    type = FIT_INTEGER4;
  break;

    case MTYPE_I8:
  if (logical_flag)
    type = FIT_LOGICAL8;
  else
    type = FIT_INTEGER8;
  break;

    case MTYPE_U4:
  type = FIT_ADDRESS4;
  break;

    case MTYPE_U8:
  type = FIT_ADDRESS8;
  break;

    case MTYPE_F4:
  type = FIT_REAL4;
  break;

    case MTYPE_F8:
  type = FIT_REAL8;
  break;

    case MTYPE_F10:
    case MTYPE_FQ:
  type = FIT_REAL16;
  break;

    case MTYPE_C4:
  type = FIT_COMPLEX4;
  break;

    case MTYPE_C8:
  type = FIT_COMPLEX8;
  break;

    case MTYPE_CQ:
  type = FIT_COMPLEX16;
  break;

    case MTYPE_M:
  type = FIT_RECORD;
  break;

    case MTYPE_UNKNOWN:
  if (char_flag) {
    type = FIT_CHARACTER;
    break;
        }
  /*  Allow to fall through to error.  */

    default:
      Fail_FmtAssertion("get_FIT_type: unexpected type (%s) in I/O processing",
      MTYPE_name(mtype));

  }

  return type;

}



/* ====================================================================
 *
 * void lower_record_items (WN * block, FIOFORMATTYPE form, WN * iostat,
 *          BOOL mode, TY_IDX  rty_idx, WN * addr, INT64 offset)
 *
 * Perform lowering of record io item list in fortran io statements.
 *
 * ==================================================================== */

static void lower_record_items ( WN * block, FIOFORMATTYPE form, WN * iostat,
         BOOL mode, TY_IDX rty_idx, WN * addr, INT64 roffset)
{
  TY_IDX ty_idx;
  TY_IDX ety_idx;
  FIOITEMTYPE type;
  FIOITEMTYPE etype;
  ST *unit_ptr;
  INT64 offset;
  WN *wn;
  WN *wn1;
  WN *wn2;
  WN *wn3;
  INT64 size;
  INT64 nelem;
  ST *ctrst;
  ST *adrst;
  PREG_NUM ctrnum;
  PREG_NUM adrnum;
  WN *raddr;
  WN *recblk;

  TY& rty = Ty_Table [rty_idx];

  Is_True (TY_kind(rty) == KIND_STRUCT,
     ("non record type passed to lower_record_items"));

  /*  Process all fields in the record.  */

  FLD_ITER fld_iter = Make_fld_iter (TY_fld(rty));

  do {
    FLD_HANDLE fld (fld_iter);

    ty_idx = FLD_type(fld);
    TY& ty = Ty_Table [ty_idx];
    offset = roffset + FLD_ofst(fld);

    switch (TY_kind(ty)) {

      case KIND_SCALAR:
      case KIND_POINTER:

  type = get_FIT_type ( ty_idx );
  if (mode) {
    (void) Make_Pointer_Type ( ty_idx, FALSE );
    if (offset <= INT32_MAX)
      wn1 = WN_CreateLda ( opc_lda, offset, TY_pointer(ty_idx, FALSE),
         WN_st(addr) );
    else
      wn1 = WN_Add ( Pointer_type,
         WN_CreateLda ( opc_lda, 0, TY_pointer(ty_idx, FALSE),
            WN_st(addr) ),
         WN_CreateIntconst ( opc_const, offset ) );
  } else
    wn1 = WN_Add ( Pointer_type, WN_COPY_Tree(addr),
       WN_CreateIntconst ( opc_const, offset ) );
  if (mp_io) {
          unit_ptr = Get_UnitPointer_ST();
    GEN_IO_CALL_3 ( block, fio_item_ops[form][type], iostat, NULL,
        wn1, WN_CreateIntconst ( OPC_I4INTCONST, 1 ),
        Make_IoAddr_WN(unit_ptr) );
  } else
    GEN_IO_CALL_2 ( block, fio_item_ops[form][type], iostat, NULL,
        wn1, WN_CreateIntconst ( OPC_I4INTCONST, 1 ));
  break;

      case KIND_ARRAY:

      {

  ety_idx = TY_AR_etype(ty);
        TY& ety = Ty_Table [ety_idx];
  etype = get_FIT_type ( ety_idx );
  switch (etype) {

    case FIT_ADDRESS4:
    case FIT_ADDRESS8:
    case FIT_INTEGER1:
    case FIT_INTEGER2:
    case FIT_INTEGER4:
    case FIT_INTEGER8:
    case FIT_LOGICAL1:
    case FIT_LOGICAL2:
    case FIT_LOGICAL4:
    case FIT_LOGICAL8:
    case FIT_REAL4:
    case FIT_REAL8:
    case FIT_REAL16:
    case FIT_COMPLEX4:
    case FIT_COMPLEX8:
    case FIT_COMPLEX16:
      if (mode) {
        (void) Make_Pointer_Type ( ety_idx, FALSE );
        if (offset <= INT32_MAX)
    wn1 = WN_CreateLda ( opc_lda, offset, TY_pointer(ety_idx, FALSE),
             WN_st(addr) );
        else
    wn1 = WN_Add ( Pointer_type,
             WN_CreateLda ( opc_lda, 0, TY_pointer(ety_idx, FALSE),
                WN_st(addr) ),
             WN_CreateIntconst ( opc_const, offset ) );
      } else
        wn1 = WN_Add ( Pointer_type, WN_COPY_Tree(addr),
           WN_CreateIntconst ( opc_const, offset ) );
      nelem = TY_size(ty) / TY_size(ety);
      if (nelem <= INT32_MAX)
        wn2 = WN_CreateIntconst ( OPC_I4INTCONST, nelem );
      else
        wn2 = WN_CreateIntconst ( OPC_I8INTCONST, nelem );
      if (mp_io) {
              unit_ptr = Get_UnitPointer_ST();
        GEN_IO_CALL_3 ( block, fio_item_ops[form][etype], iostat, NULL,
            wn1, wn2, Make_IoAddr_WN(unit_ptr) );
      } else
        GEN_IO_CALL_2 ( block, fio_item_ops[form][etype], iostat, NULL,
            wn1, wn2 );
      break;

    case FIT_CHARACTER:
      if (mode) {
        (void) Make_Pointer_Type ( ety_idx, FALSE );
        if (offset <= INT32_MAX)
    wn1 = WN_CreateLda ( opc_lda, offset, TY_pointer(ety_idx, FALSE),
             WN_st(addr) );
        else
    wn1 = WN_Add ( Pointer_type,
             WN_CreateLda ( opc_lda, 0, TY_pointer(ety_idx, FALSE),
                WN_st(addr) ),
             WN_CreateIntconst ( opc_const, offset ) );
      } else
        wn1 = WN_Add ( Pointer_type, WN_COPY_Tree(addr),
           WN_CreateIntconst ( opc_const, offset ) );
      if (TY_kind(ety) == KIND_ARRAY) {
        size = TY_size(ety);
        nelem = TY_size(ty) / size;
      } else {
        size = TY_size(ty);
        nelem = 1;
      }
      if (size <= INT32_MAX)
        wn2 = WN_CreateIntconst ( OPC_I4INTCONST, size );
      else
        wn2 = WN_CreateIntconst ( OPC_I8INTCONST, size );
      if (nelem <= INT32_MAX)
        wn3 = WN_CreateIntconst ( OPC_I4INTCONST, nelem );
      else
        wn3 = WN_CreateIntconst ( OPC_I8INTCONST, nelem );
      if (mp_io) {
              unit_ptr = Get_UnitPointer_ST();
        GEN_IO_CALL_4 ( block, fio_item_ops[form][etype], iostat, NULL,
            wn1, wn2, wn3, Make_IoAddr_WN(unit_ptr) );
      } else
        GEN_IO_CALL_3 ( block, fio_item_ops[form][etype], iostat, NULL,
            wn1, wn2, wn3 );
      break;

    case FIT_RECORD:
      if (mode) {
        (void) Make_Pointer_Type ( ety_idx, FALSE );
        if (offset <= INT32_MAX)
    wn = WN_CreateLda ( opc_lda, offset, TY_pointer(ety_idx, FALSE),
            WN_st(addr) );
        else
    wn = WN_Add ( Pointer_type,
            WN_CreateLda ( opc_lda, 0, TY_pointer(ety_idx, FALSE),
               WN_st(addr) ),
            WN_CreateIntconst ( opc_const, offset ) );
      } else
        wn = WN_Add ( Pointer_type, WN_COPY_Tree(addr),
          WN_CreateIntconst ( opc_const, offset ) );
      adrst = MTYPE_To_PREG ( Pointer_type );
      adrnum = Create_Preg ( Pointer_type, "record_address");
      WN_INSERT_BlockLast ( block,
          WN_StidIntoPreg ( Pointer_type, adrnum, adrst,
                wn ));
      recblk = WN_CreateBlock();
      ctrst = MTYPE_To_PREG ( MTYPE_I4 );
      ctrnum = Create_Preg ( MTYPE_I4, "record_counter");
      size = TY_size(ety);
      nelem = TY_size(ty) / size;
      WN_INSERT_BlockLast ( block,
          WN_CreateDO (
            WN_CreateIdname ( ctrnum, ctrst ),
            WN_StidIntoPreg ( MTYPE_I4, ctrnum, ctrst,
               WN_CreateIntconst ( OPC_I4INTCONST, 1 )),
            WN_LE ( MTYPE_I4,
              WN_LdidPreg ( MTYPE_I4, ctrnum ),
              WN_CreateIntconst ( OPC_I4INTCONST,
                nelem )),
            WN_StidIntoPreg ( MTYPE_I4, ctrnum, ctrst,
                  WN_Add ( MTYPE_I4,
                     WN_LdidPreg ( MTYPE_I4,
                       ctrnum ),
               WN_CreateIntconst ( OPC_I4INTCONST,
                 (INT64)1 ))),
            recblk, NULL ));
      raddr = WN_LdidPreg ( Pointer_type, adrnum );
      lower_record_items ( recblk, form, iostat, FALSE, ety_idx, raddr,
         (INT64)0 );
      WN_INSERT_BlockLast ( recblk,
          WN_StidIntoPreg ( Pointer_type, adrnum, adrst,
            WN_Add ( Pointer_type, raddr,
              WN_CreateIntconst ( opc_const, size ))));
      break;

    default:
      Fail_FmtAssertion("unexpected type (%s) in record I/O processing",
            MTYPE_name(TY_mtype(ety)));

  }

  break;

      }

      case KIND_STRUCT:
  lower_record_items ( block, form, iostat, mode, ty_idx, addr, offset );
  break;

      case KIND_VOID:
  break;

      default:
  Fail_FmtAssertion("unexpected type (%s) in record I/O processing",
        MTYPE_name(TY_mtype(ty)));

    }

  } while (! FLD_last_field (fld_iter++));
}


/* ====================================================================
 *
 * void lower_io_items (WN * block, WN * tree, FIOFORMATTYPE form,
 *            WN * iostat, INT32 kid_first, INT32 kid_last)
 *
 * Perform lowering of the io item list in fortran io statements.
 *
 * ==================================================================== */

static void lower_io_items ( WN * block, WN * tree, FIOFORMATTYPE form,
           WN * iostat, INT32 kid_first, INT32 kid_last )
{
  INT32 i;
  INT32 j;
  INT32 mtype;
  INT32 ntype;
  INT64 size;
  INT64 nelem;
  FIOITEMTYPE type;
  TY_IDX ty;
  TY_IDX ety;
  WN *item;
  WN *top_label;
  WN *cont_label;
  WN *start;
  WN *step;
  WN *end;
  WN *load_index;
  WN *raddr;
  WN *recblk;
  ST *pregst;
  ST *unit_ptr;
  ST *ctrst;
  ST *adrst;
  PREG_NUM pregnum;
  PREG_NUM ctrnum;
  PREG_NUM adrnum;
  IOITEM io_item;

  /*  Process all of the I/O items.  */

  for (i=kid_first; i<kid_last; i++) {

    item = WN_kid(tree,i);
    io_item = (IOITEM) WN_intrinsic(item);

    /*  If a real I/O item preprocess and determine type.  */

    if (io_item != IOL_IMPLIED_DO && io_item != IOL_IMPLIED_DO_1TRIP) {
      item = extract_calls ( block, item );
      if (io_item != IOL_ARRAY)
  type = get_FIT_type ( WN_ty(item) );
    }

    /*  Generate the appropriate I/O runtime call for the item.  */

    switch (io_item) {

      case IOL_ARRAY:
    ety = TY_AR_etype(WN_ty(item));
    type = get_FIT_type ( ety );
    if (type == FIT_RECORD) {
      adrst = MTYPE_To_PREG ( Pointer_type );
      adrnum = Create_Preg ( Pointer_type, "record_address");
      WN_INSERT_BlockLast ( block,
          WN_StidIntoPreg ( Pointer_type, adrnum, adrst,
                WN_kid0(item) ));
      recblk = WN_CreateBlock();
      ctrst = MTYPE_To_PREG ( MTYPE_I4 );
      ctrnum = Create_Preg ( MTYPE_I4, "record_counter");
      size = TY_size(ety);
      nelem = TY_size(WN_ty(item)) / size;
      WN_INSERT_BlockLast ( block,
          WN_CreateDO (
            WN_CreateIdname ( ctrnum, ctrst ),
            WN_StidIntoPreg ( MTYPE_I4, ctrnum, ctrst,
               WN_CreateIntconst ( OPC_I4INTCONST, 1 )),
            WN_LE ( MTYPE_I4,
              WN_LdidPreg ( MTYPE_I4, ctrnum ),
              WN_CreateIntconst ( OPC_I4INTCONST,
                nelem )),
            WN_StidIntoPreg ( MTYPE_I4, ctrnum, ctrst,
                  WN_Add ( MTYPE_I4,
                     WN_LdidPreg ( MTYPE_I4,
                       ctrnum ),
               WN_CreateIntconst ( OPC_I4INTCONST,
                 (INT64)1 ))),
            recblk, NULL ));
      raddr = WN_LdidPreg ( Pointer_type, adrnum );
      lower_record_items ( recblk, form, iostat, FALSE, ety, raddr,
         (INT64)0 );
      WN_INSERT_BlockLast ( recblk,
          WN_StidIntoPreg ( Pointer_type, adrnum, adrst,
            WN_Add ( Pointer_type, raddr,
              WN_CreateIntconst ( opc_const, size ))));
      WN_DELETE_Tree ( WN_kid1(item) );
    } else {
      if (mp_io) {
        unit_ptr = Get_UnitPointer_ST();
        GEN_IO_CALL_3 ( block, fio_item_ops[form][type], iostat, NULL,
            WN_kid0(item), WN_kid1(item), 
            Make_IoAddr_WN(unit_ptr) );
      }
      else
        GEN_IO_CALL_2 ( block, fio_item_ops[form][type], iostat, NULL,
            WN_kid0(item), WN_kid1(item) );
    }
    break;

      case IOL_CHAR:
    if (mp_io) {
            unit_ptr = Get_UnitPointer_ST();
      GEN_IO_CALL_4 ( block, fio_item_ops[form][type], iostat, NULL,
        WN_kid0(item), WN_kid1(item), 
        WN_CreateIntconst ( OPC_I4INTCONST, 1 ),
        Make_IoAddr_WN(unit_ptr) );
    }
    else
      GEN_IO_CALL_3 ( block, fio_item_ops[form][type], iostat, NULL,
        WN_kid0(item), WN_kid1(item),
        WN_CreateIntconst ( OPC_I4INTCONST, 1 ) );
    break;

      case IOL_CHAR_ARRAY:
    if (mp_io) {
            unit_ptr = Get_UnitPointer_ST();
      GEN_IO_CALL_4 ( block, fio_item_ops[form][type], iostat, NULL,
        WN_kid0(item), WN_kid1(item), 
        WN_kid2(item),
        Make_IoAddr_WN(unit_ptr) );
    }
    else
      GEN_IO_CALL_3 ( block, fio_item_ops[form][type], iostat, NULL,
        WN_kid0(item), WN_kid1(item), WN_kid2(item) );
    break;

      case IOL_EXPR:
    switch (type) {
      case FIT_COMPLEX4:
    pregst = MTYPE_To_PREG ( MTYPE_C4 );
    pregnum = Create_Preg ( MTYPE_C4, "complex_io_item");
    WN_INSERT_BlockLast ( block,
              WN_StidIntoPreg ( MTYPE_C4, pregnum,
              pregst,
              WN_kid0(item) ));
          if (mp_io) {
                  unit_ptr = Get_UnitPointer_ST();
            GEN_IO_CALL_3 ( block, fio_value_ops[form][type], iostat, 
        NULL, WN_CreateExp1 ( OPC_F4REALPART,
          WN_LdidPreg ( MTYPE_C4, pregnum )),
        WN_CreateExp1 ( OPC_F4IMAGPART,
          WN_LdidPreg ( MTYPE_C4, pregnum )),
        Make_IoAddr_WN(unit_ptr) );
          }
          else
      GEN_IO_CALL_2 ( block, fio_value_ops[form][type], iostat, 
        NULL, WN_CreateExp1 ( OPC_F4REALPART,
          WN_LdidPreg ( MTYPE_C4, pregnum )),
        WN_CreateExp1 ( OPC_F4IMAGPART,
          WN_LdidPreg ( MTYPE_C4, pregnum )));
    break;
      case FIT_COMPLEX8:
    pregst = MTYPE_To_PREG ( MTYPE_C8 );
    pregnum = Create_Preg ( MTYPE_C8, "complex_io_item");

    WN_INSERT_BlockLast ( block,
              WN_StidIntoPreg ( MTYPE_C8, pregnum,
              pregst,
              WN_kid0(item) ));
          if (mp_io) {
                  unit_ptr = Get_UnitPointer_ST();
            GEN_IO_CALL_3 ( block, fio_value_ops[form][type], iostat, 
        NULL, WN_CreateExp1 ( OPC_F8REALPART,
          WN_LdidPreg ( MTYPE_C8, pregnum )),
        WN_CreateExp1 ( OPC_F8IMAGPART,
          WN_LdidPreg ( MTYPE_C8, pregnum )),
        Make_IoAddr_WN(unit_ptr) );
          }
          else
      GEN_IO_CALL_2 ( block, fio_value_ops[form][type], iostat, 
        NULL, WN_CreateExp1 ( OPC_F8REALPART,
          WN_LdidPreg ( MTYPE_C8, pregnum )),
        WN_CreateExp1 ( OPC_F8IMAGPART,
          WN_LdidPreg ( MTYPE_C8, pregnum )));
    break;
      case FIT_COMPLEX16:
    pregst = MTYPE_To_PREG ( MTYPE_CQ );
    pregnum = Create_Preg ( MTYPE_CQ, "complex_io_item");
    WN_INSERT_BlockLast ( block,
              WN_StidIntoPreg ( MTYPE_CQ, pregnum,
              pregst,
              WN_kid0(item) ));
          if (mp_io) {
                  unit_ptr = Get_UnitPointer_ST();
            GEN_IO_CALL_3 ( block, fio_value_ops[form][type], iostat, 
        NULL, WN_CreateExp1 ( OPC_FQREALPART,
          WN_LdidPreg ( MTYPE_CQ, pregnum )),
        WN_CreateExp1 ( OPC_FQIMAGPART,
          WN_LdidPreg ( MTYPE_CQ, pregnum )),
        Make_IoAddr_WN(unit_ptr) );
          }
          else
      GEN_IO_CALL_2 ( block, fio_value_ops[form][type], iostat, 
        NULL, WN_CreateExp1 ( OPC_FQREALPART,
          WN_LdidPreg ( MTYPE_CQ, pregnum )),
        WN_CreateExp1 ( OPC_FQIMAGPART,
          WN_LdidPreg ( MTYPE_CQ, pregnum )));
    break;
      case FIT_RECORD:
    if (WN_operator(WN_kid0(item)) == OPR_LDA) {
      lower_record_items ( block, form, iostat, TRUE,
               WN_ty(item), WN_kid0(item),
               (INT64)WN_offset(WN_kid0(item)) );
      WN_Delete ( WN_kid0(item) );
    } else if (WN_operator(WN_kid0(item)) == OPR_LDID) {
      lower_record_items ( block, form, iostat, FALSE,
               WN_ty(item), WN_kid0(item), (INT64)0 );
      WN_Delete ( WN_kid0(item) );
    } else {
      pregst = MTYPE_To_PREG ( Pointer_type );
      pregnum = Create_Preg ( Pointer_type, "record_address");

      WN_INSERT_BlockLast ( block,
                WN_StidIntoPreg ( Pointer_type, pregnum,
                pregst,
                WN_kid0(item) ));
      raddr = WN_LdidPreg ( Pointer_type, pregnum );
      lower_record_items ( block, form, iostat, FALSE,
               WN_ty(item), raddr, (INT64)0 );
      WN_Delete ( raddr );
    }
    break;
      default:
          if (mp_io) {
                  unit_ptr = Get_UnitPointer_ST();
            GEN_IO_CALL_2 ( block, fio_value_ops[form][type], iostat, 
        NULL, WN_kid0(item), Make_IoAddr_WN(unit_ptr) );
          }
          else
      GEN_IO_CALL_1 ( block, fio_value_ops[form][type], iostat, 
        NULL, WN_kid0(item) );
    }
    break;

      case IOL_IMPLIED_DO:
      case IOL_IMPLIED_DO_1TRIP:
    top_label = WN_CreateNewLabel();
    cont_label = WN_CreateNewLabel();
    WN_start(item) = extract_calls ( block, WN_start(item) );
    WN_end(item)   = extract_calls ( block, WN_end(item) );
    WN_step(item)  = extract_calls ( block, WN