static char rcsid[] = "$Id: F-output.c,v 1.90 2003/03/26 18:54:20 msato Exp $";
/* 
 * $RWC_Release: Omni-1.6 $
 * $RWC_Copyright:
 *  Omni Compiler Software Version 1.5-1.6
 *  Copyright (C) 2002 PC Cluster Consortium
 *  
 *  This software is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU Lesser General Public License version
 *  2.1 published by the Free Software Foundation.
 *  
 *  Omni Compiler Software Version 1.0-1.4
 *  Copyright (C) 1999, 2000, 2001.
 *   Tsukuba Research Center, Real World Computing Partnership, Japan.
 *  
 *  Please check the Copyright and License information in the files named
 *  COPYRIGHT and LICENSE under the top  directory of the Omni Compiler
 *  Software release kit.
 *  
 *  
 *  $
 */
#include "F-front.h"

#ifdef ENABLE_QREAL
# if defined(OMNI_QREAL_NEED_GAP_MEMBER)
#  if (OMNI_QREAL_GAP_SIZE == 2)
#   define USE_SHORT_GAP
#  elif (OMNI_QREAL_GAP_SIZE == 4)
#   define USE_INT_GAP
#  else
#   define USE_CHAR_GAP
#  endif /* (OMNI_QREAL_GAP_SIZE == 2) */
# endif /* OMNI_QREAL_NEED_GAP_MEMBER */
#endif /* ENABLE_QREAL */

#ifdef Min
#undef Min
#endif
#define Min(a, b) (((a) > (b)) ? (b) : (a))

TYPE_DESC type_list,type_list_tail;

static void	collect_types _ANSI_ARGS_((void));
static void	collect_type_desc _ANSI_ARGS_((expv v));

static void	X_output _ANSI_ARGS_((expv v, FILE *fp));
static void	X_output_type _ANSI_ARGS_((TYPE_DESC tp, FILE *fp));
static void	X_output_no_indent _ANSI_ARGS_((expv v, FILE *fp));
static void	X_output_rec _ANSI_ARGS_((expv v, int l));

static void	mark_type_desc _ANSI_ARGS_((TYPE_DESC tp));
static void	mark_type_desc_in_id_list _ANSI_ARGS_((ID idp));

static void	expv_output_rec _ANSI_ARGS_((expv v, int l));
static void	expv_output_type _ANSI_ARGS_((TYPE_DESC tp, FILE *fp));

static void	print_type _ANSI_ARGS_((TYPE_DESC tp, FILE *fp));

static char *	C_sym_name _ANSI_ARGS_((SYMBOL sp));

static void	print_string_constant _ANSI_ARGS_((FILE *fp, char *str));

static int	finalizeVariableInitialize _ANSI_ARGS_((ID id));
static int	finalizeEquivInitialize _ANSI_ARGS_((ID id));
static int	finalizeCommonInitialize _ANSI_ARGS_((EXT_ID eId));

static void	convertToRaw _ANSI_ARGS_((expv v, BASIC_DATA_TYPE bTyp,
					  char *buf, int bufLen));

#define Addr2Uint32(X) ((_omUint32_t)((_omAddrInt_t)(X)))

static void
print_string_constant(fp, str)
    FILE *fp;
    char *str;
{
    if (str == NULL || str[0] == '\0') {
	fprintf(fp, " \"\")");
	return;
    }
    fprintf(fp, " \"");
    while (*str != '\0') {
	if (*str < 0x20 || *str == '\\' || *str == '"' || *str >= 0x7F) {
	    fprintf(fp, "\\%03o", *str);
	} else {
	    fprintf(fp, "%c", *str);
	}
	str++;
    }
    fprintf(fp, "\")");
    return;
}


BASIC_DATA_TYPE
getBasicType(tp)
    TYPE_DESC tp;
{
    BASIC_DATA_TYPE typ;
    if (tp == NULL) {
	return TYPE_UNKNOWN;
    }
    typ = TYPE_BASIC_TYPE(tp);
    if (typ == TYPE_UNKNOWN ||
	typ == TYPE_ARRAY) {
	if (TYPE_REF(tp) != NULL) {
	    return getBasicType(TYPE_REF(tp));
	} else {
	    return typ;
	}
    } else {
	return typ;
    }
}


static int
getIdTypeLen4Initialize(id, bTypPtr)
    ID id;
    BASIC_DATA_TYPE *bTypPtr;
{
    BASIC_DATA_TYPE bTyp = getBasicType(ID_TYPE(id));
    int typLen = -1;
    
    if (BASIC_IS_CHAR(bTyp)) {
	int nElem = 1;
	expv aSpec = VAR_ARRAY_INFO(id);
	
	typLen = type_length(ID_TYPE(id));
	if (aSpec == NULL) {
	    aSpec = id_array_spec_list(id);
	}
	if (aSpec != NULL) {
	    list lq;
	    FOR_ITEMS_IN_LIST(lq, EXPR_ARG2(aSpec)) {
		nElem *= EXPV_INT_VALUE(EXPR_ARG1(LIST_ITEM(lq)));
	    }
	}
	typLen /= nElem;
    } else {
	typLen = basic_type_size(bTyp);
	switch (bTyp) {
	case TYPE_COMPLEX: {
	    bTyp = TYPE_REAL;
	    typLen /= 2;
	    break;
	}
	case TYPE_DCOMPLEX: {
	    bTyp = TYPE_DREAL;
	    typLen /= 2;
	    break;
	}
	default: {
	    break;
	}
	}
    }
    
    if (typLen < 0) {
	fatal("typLen < 0 in variable initialize??");
    }
    if (bTypPtr != NULL) {
	*bTypPtr = bTyp;
    }

    return typLen;
}


static void
convertToRaw(v, bTyp, buf, bufLen)
    expv v;
    BASIC_DATA_TYPE bTyp;
    char *buf;
    int bufLen;
{
#define CopyIt(val)	memcpy(buf, (char *)(&(val)), bufLen)
    if (v == NULL) {
	memset(buf, 0, bufLen);
	return;
    }

    switch (EXPR_CODE(v)) {

	case STRING_CONSTANT: {
	    int strLen = strlen(EXPV_STR(v));
	    char *newStr = adjustString(EXPV_STR(v), strLen, bufLen);
	    memcpy(buf, newStr, bufLen);
	    break;
	}

#ifdef HAS_INT64
	case LONGLONG_CONSTANT: {
	    _omInt64_t i64 = EXPV_INT64_VALUE(v);
	    switch (bTyp) {
		case TYPE_DREAL: {
		    double val = (double)i64;
		    CopyIt(val);
		    break;
		}
		case TYPE_REAL: {
		    float val = (float)i64;
		    CopyIt(val);
		    break;
		}
		case TYPE_INT:
		case TYPE_LOGICAL: {
		    int val = (int)i64;
		    CopyIt(val);
		    break;
		}
		case TYPE_SHORT: {
		    short val = (short)i64;
		    CopyIt(val);
		    break;
		}
		case TYPE_LONGLONG: {
		    _omInt64_t val = (_omInt64_t)i64;
		    CopyIt(val);
		    break;
		}
		default: {
		    fatal("convertToRaw(int): not supported type '%s'",
			  basic_type_names[(int)bTyp]);
		}
	    }
	    break;
	}
#endif /* HAS_INT64 */

	case INT_CONSTANT: {
	    switch (bTyp) {
		case TYPE_DREAL: {
		    double val = (double)EXPV_INT_VALUE(v);
		    CopyIt(val);
		    break;
		}
		case TYPE_REAL: {
		    float val = (float)EXPV_INT_VALUE(v);
		    CopyIt(val);
		    break;
		}
		case TYPE_INT:
		case TYPE_LOGICAL: {
		    int val = (int)EXPV_INT_VALUE(v);
		    CopyIt(val);
		    break;
		}
		case TYPE_SHORT: {
		    short val = (short)EXPV_INT_VALUE(v);
		    CopyIt(val);
		    break;
		}
#ifdef HAS_INT64
		case TYPE_LONGLONG: {
		    _omInt64_t val = (_omInt64_t)EXPV_INT_VALUE(v);
		    CopyIt(val);
		    break;
		}
#endif /* HAS_INT64 */
		default: {
		    fatal("convertToRaw(int): not supported type '%s'",
			  basic_type_names[(int)bTyp]);
		}
	    }
	    break;
	}

	case FLOAT_CONSTANT: {
	    switch (bTyp) {
		case TYPE_DREAL: {
		    double val = (double)EXPV_FLOAT_VALUE(v);
		    CopyIt(val);
		    break;
		}
		case TYPE_REAL: {
		    float val = (float)EXPV_FLOAT_VALUE(v);
		    CopyIt(val);
		    break;
		}
		case TYPE_INT:
		case TYPE_LOGICAL: {
		    int val = (int)EXPV_FLOAT_VALUE(v);
		    CopyIt(val);
		    break;
		}
		case TYPE_SHORT: {
		    short val = (int)EXPV_FLOAT_VALUE(v);
		    CopyIt(val);
		    break;
		}
#ifdef HAS_INT64
		case TYPE_LONGLONG: {
		    _omInt64_t val = (_omInt64_t)EXPV_FLOAT_VALUE(v);
		    CopyIt(val);
		    break;
		}
#endif /* HAS_INT64 */
		default: {
		    fatal("convertToRaw(float): not supported type '%s'",
			  basic_type_names[(int)bTyp]);
		}
	    }
	    break;
	}

	default: {
	    fatal("variable initialization failed??");
	}
    }
#undef CopyIt
}


static expv
rawToInitializeList(memBuf, size)
    char *memBuf;
    int size;
{
    expv vList = list0(LIST);
    int i;

    for (i = 0; i < size; i++) {
	vList = list_put_last(vList,
			      expv_int_term(INT_CONSTANT, type_INT, 
					    (int)memBuf[i]));
    }
    return list2(LIST,
		 expv_int_term(INT_CONSTANT, type_INT, size),
		 vList);
}


static int
convertInitializerToRaw(memBuf, chkBuf, bufSize, offset, bTyp, typLen, vList, nInit, isVListRaw)
    char *memBuf;
    char *chkBuf;
    int bufSize;
    int offset;
    BASIC_DATA_TYPE bTyp;
    int typLen;
    expv vList;
    int nInit;
    int isVListRaw;
{
    char *memStart = memBuf + offset;
    char *chkStart = chkBuf + offset;
    int n;
    int i;
    int j;
    list lq = EXPR_LIST(vList);

    char *valBuf = (char *)malloc(sizeof(char) * (typLen + 1));

    memset(valBuf, 0, typLen + 1);

    n = Min(bufSize, nInit);

    if (isVListRaw == TRUE) {
	for (i = 0; (i < n && lq != NULL); i++, lq = LIST_NEXT(lq)) {
	    if (chkStart[i] != 0) {
		free(valBuf);
		return FALSE;
	    }
	    memStart[i] = (int)EXPV_INT_VALUE(LIST_ITEM(lq));
	    chkStart[i] = 1;
	}
    } else {
	for (i = 0; (i < n && lq != NULL); i++, lq = LIST_NEXT(lq)) {
	    offset = i * typLen;
	    for (j = 0; j < typLen; j++) {
		if (chkStart[offset + j] != 0) {
		    free(valBuf);
		    return FALSE;
		}
	    }
	    convertToRaw(LIST_ITEM(lq), bTyp, valBuf, typLen);
	    memcpy(&(memStart[offset]), valBuf, typLen);
	    memset(&(chkStart[offset]), 1, typLen);
	}
    }
    free(valBuf);
    return TRUE;
}


static int
finalizeCommonInitialize(eId)
    EXT_ID eId;
{
    list lp, lq;
    expv comList = EXT_COM_LISTS(eId);
    ID id;
    expv tmp, tmp2;
    char *comName = getCommonNameFromExtId(eId);
    int isBlankCommon = (strcmp(comName, "(blank common)") == 0) ? TRUE : FALSE;
    expv idList = NULL;
    int isInBlockData;
    int curProcNo;
    char *memBuf = NULL;
    char *chkBuf = NULL;
    int offset = 0;
    int size = 0;
    BASIC_DATA_TYPE bTyp;
    int typLen = 0;
    int nInit = 0;
    expv vList = NULL;
    int i;
    int doInit = FALSE;

    if (EXT_COM_INIT_FINALIZED(eId)) {
	return TRUE;
    }

    if (comList == NULL) {
	EXT_COM_INIT_LIST(eId) = NULL;
	EXT_COM_INIT_FINALIZED(eId) = TRUE;
	return TRUE;
    }

    size = EXT_COM_LEN(eId);
    FOR_ITEMS_IN_LIST(lp, comList) {
	tmp = LIST_ITEM(lp);
	curProcNo = getProcNoFromStructRefId(EXPV_INT_VALUE(EXPR_ARG1(tmp)));
	if (EXT_COM_IN_BLOCKDATA(eId) == curProcNo) {
	    isInBlockData = TRUE;
	} else {
	    isInBlockData = FALSE;
	}
	FOR_ITEMS_IN_LIST(lq, EXPR_ARG2(tmp)) {
	    id = EXPV_ANY(ID, LIST_ITEM(lq));
	    if (VAR_INIT_LIST(id) != NULL) {
		if (finalizeVariableInitialize(id) == FALSE) {
		    EXT_COM_INIT_LIST(eId) = NULL;
		    EXT_COM_INIT_FINALIZED(eId) = TRUE;
		    return FALSE;
		}
		if (VAR_INIT_LIST(id) == NULL) {
		    continue;
		}
		if (isInBlockData != TRUE) {
		    char *fmt = "'%s' in common block '%s' is initialized outside of BLOCK DATA.";
		    if (doPedanticCommon == TRUE) {
			error_at_node(EXPR_ARG2(tmp), fmt, SYM_NAME(ID_SYM(id)), comName);
			EXT_COM_INIT_LIST(eId) = NULL;
			EXT_COM_INIT_FINALIZED(eId) = TRUE;
			return FALSE;
		    } else {
			warning_at_node(EXPR_ARG2(tmp), fmt, SYM_NAME(ID_SYM(id)), comName);
		    }
		}
		if (idList == NULL) {
		    idList = list0(LIST);
		}
		tmp2 = expv_any_term(ID_LIST, (void *)id);
		EXPR_LINE(tmp2) = EXPR_LINE(EXPR_ARG2(tmp));
		idList = list_put_last(idList, tmp2);
	    }
	}
    }

    if (isBlankCommon == TRUE && idList != NULL) {
	if (doPedanticCommon == TRUE) {
	    error_at_node(comList, "about to initialize blank common.");
	    EXT_COM_INIT_LIST(eId) = NULL;
	    EXT_COM_INIT_FINALIZED(eId) = TRUE;
	    return FALSE;
	} else {
	    warning_at_node(comList, "about to initialize blank common.");
	}
    }

    if (idList == NULL) {
	EXT_COM_INIT_FINALIZED(eId) = TRUE;
	EXT_COM_INIT_LIST(eId) = NULL;
	return TRUE;
    }

    memBuf = (char *)malloc(sizeof(char) * EXT_COM_LEN(eId));
    chkBuf = (char *)malloc(sizeof(char) * EXT_COM_LEN(eId));
    memset(memBuf, 0, EXT_COM_LEN(eId));
    memset(chkBuf, 0, EXT_COM_LEN(eId));

    FOR_ITEMS_IN_LIST(lp, idList) {
	id = EXPV_ANY(ID, LIST_ITEM(lp));
	vList = EXPR_ARG2(VAR_INIT_LIST(id));
	nInit = EXPV_INT_VALUE(EXPR_ARG1(VAR_INIT_LIST(id)));
	size = type_length(ID_TYPE(id));
	typLen = getIdTypeLen4Initialize(id, &bTyp);
	offset = getIdOffsetInCommon(eId, id);

	if (convertInitializerToRaw(memBuf, chkBuf,
				    size, offset,
				    bTyp, typLen,
				    vList, nInit,
				    VAR_INIT_USE_RAW(id)) == FALSE) {
	    error_at_node(LIST_ITEM(lp), "'%s' is already initialized by other variable in equivalence set or common block.",
			  SYM_NAME(ID_SYM(id)));
	    EXT_COM_INIT_LIST(eId) = NULL;
	    EXT_COM_INIT_FINALIZED(eId) = TRUE;
	    free(memBuf);
	    free(chkBuf);
	    return FALSE;
	}
    }

    for (i = 0; i < EXT_COM_LEN(eId); i++) {
	if (chkBuf[i] != 0) {
	    doInit = TRUE;
	    break;
	}
    }
    free(chkBuf);
    if (doInit == FALSE) {
	EXT_COM_INIT_LIST(eId) = NULL;
    } else {
	EXT_COM_INIT_LIST(eId) = rawToInitializeList(memBuf, EXT_COM_LEN(eId));
    }
    EXT_COM_INIT_FINALIZED(eId) = TRUE;
    free(memBuf);

    return TRUE;
}


static int
finalizeEquivInitialize(id)
    ID id;
{
    expv eqSpec = VAR_EQUIV_SPEC(id);
    expv eqList = EXPR_ARG3(eqSpec);
    int size = EXPV_INT_VALUE(EXPR_ARG2(eqSpec));
    list lp;
    expv nodeV = NULL;
    BASIC_DATA_TYPE bTyp;
    int typLen = 0;
    expv vList = NULL;
    char *memBuf = NULL;
    char *chkBuf = NULL;
    int nInit = 0;
    int doInit = 0;
    int i;

    if (VAR_INIT_FINALIZED(id) == TRUE) {
	return TRUE;
    }

    FOR_ITEMS_IN_LIST(lp, eqList) {
	nodeV = EXPR_ARG2(LIST_ITEM(lp));
	if (VAR_INIT_LIST(EQUIV_NODE_ID(nodeV)) != NULL) {
	    if (finalizeVariableInitialize(EQUIV_NODE_ID(nodeV)) != TRUE) {
		VAR_INIT_LIST(id) = NULL;
		VAR_INIT_FINALIZED(id) = TRUE;
		return FALSE;
	    }
	    if (VAR_INIT_LIST(EQUIV_NODE_ID(nodeV)) == NULL) {
		continue;
	    }
	    doInit++;
	}
    }
    
    if (doInit == 0) {
	VAR_INIT_LIST(id) = NULL;
	VAR_INIT_FINALIZED(id) = TRUE;
	return TRUE;
    }

    memBuf = (char *)malloc(sizeof(char) * size);
    chkBuf = (char *)malloc(sizeof(char) * size);
    memset(memBuf, 0, size);
    memset(chkBuf, 0, size);

    FOR_ITEMS_IN_LIST(lp, eqList) {
	nodeV = EXPR_ARG2(LIST_ITEM(lp));
	if (VAR_INIT_LIST(EQUIV_NODE_ID(nodeV)) != NULL) {

	    if (finalizeVariableInitialize(EQUIV_NODE_ID(nodeV)) != TRUE) {
		return FALSE;
	    }
	    if (VAR_INIT_LIST(EQUIV_NODE_ID(nodeV)) == NULL) {
		continue;
	    }

	    vList = EXPR_ARG2(VAR_INIT_LIST(EQUIV_NODE_ID(nodeV)));
	    nInit = EXPV_INT_VALUE(EXPR_ARG1(VAR_INIT_LIST(EQUIV_NODE_ID(nodeV))));
	    typLen = getIdTypeLen4Initialize(EQUIV_NODE_ID(nodeV), &bTyp);

	    if (convertInitializerToRaw(memBuf, chkBuf,
					EQUIV_NODE_SIZE(nodeV), EQUIV_NODE_OFFSET(nodeV),
					bTyp, typLen,
					vList, nInit,
					VAR_INIT_USE_RAW(EQUIV_NODE_ID(nodeV))) == FALSE) {
		error_at_node(nodeV, "'%s' is already initialized by other variable in equivalence set.",
			      SYM_NAME(ID_SYM(EQUIV_NODE_ID(nodeV))));
		VAR_INIT_LIST(id) = NULL;
		VAR_INIT_FINALIZED(id) = TRUE;
		VAR_INIT_USE_RAW(id) = FALSE;
		free(chkBuf);
		free(memBuf);
		return FALSE;
	    }
	}
    }

    doInit = FALSE;
    for (i = 0; i < size; i++) {
	if (chkBuf[i] != 0) {
	    doInit = TRUE;
	    break;
	}
    }
    free(chkBuf);
    if (doInit == FALSE) {
	VAR_INIT_LIST(id) = NULL;
	VAR_INIT_USE_RAW(id) = FALSE;
	VAR_IS_SAVE(id) = TRUE;
    } else {
	VAR_INIT_LIST(id) = rawToInitializeList(memBuf, size);
	VAR_INIT_USE_RAW(id) = TRUE;
    }
    VAR_INIT_FINALIZED(id) = TRUE;
    free(memBuf);

    return TRUE;
}


static int
finalizeVariableInitialize(id)
    ID id;
{
    list lp;
    expv vList;
    expv zero = NULL;
    BASIC_DATA_TYPE typ;
    int isComplex = FALSE;
#ifdef ENABLE_QREAL
    int isQReal = FALSE;
#endif /* ENABLE_QREAL */
    expv lSpec = NULL;
    int isZero = TRUE;

    if (VAR_INIT_FINALIZED(id) == TRUE) {
	return TRUE;
    }

    if (ID_STORAGE(id) == STG_EQBLK) {
	return finalizeEquivInitialize(id);
    }

    VAR_INIT_USE_RAW(id) = FALSE;

    if (IS_ARRAY_TYPE(ID_TYPE(id))) {
	lSpec = VAR_ARRAY_INFO(id);
	if (lSpec == NULL) {
	    lSpec = id_array_spec_list(id);
	    VAR_ARRAY_INFO(id) = lSpec;
	}
    }

    if (VAR_INIT_LIST(id) == NULL) {
	VAR_INIT_FINALIZED(id) = TRUE;
	return TRUE;
    }
    vList = EXPR_ARG2(VAR_INIT_LIST(id));

    /*
     * Last check. If VAR_INIT_LIST(id) is not NULL, but all the
     * initializers are NULL, don't emit it.
     */
    FOR_ITEMS_IN_LIST(lp, vList) {
	if (LIST_ITEM(lp) != NULL) {
	    isZero = FALSE;
	    break;
	}
    }
    if (isZero == TRUE) {
	VAR_INIT_LIST(id) = NULL;
	VAR_INIT_FINALIZED(id) = TRUE;
	VAR_IS_SAVE(id) = TRUE;
	if (ID_STORAGE(id) == STG_EQUIV) {
	    VAR_IS_SAVE(VAR_EQUIV_ID(id)) = TRUE;
	}
	return TRUE;
    }

    if (VAR_INIT_TYPE(id) == VAR_INIT_SUBSTR) {
	int maxLen = EXPV_INT_VALUE(EXPR_ARG1(VAR_INIT_LIST(id)));
	char *memImg = (char *)malloc(maxLen * sizeof(char));
	int i;
	int rMax;
	int rStart;
	char *rData;
	int curLen = 0;

	memset((char *)memImg, DEFAULT_UNINITED_CHAR, sizeof(char) * maxLen);

	FOR_ITEMS_IN_LIST(lp, vList) {
	    rMax = Min(EXPV_INT_VALUE(EXPR_ARG1(EXPR_ARG3(LIST_ITEM(lp)))),
		       EXPV_INT_VALUE(EXPR_ARG2(EXPR_ARG3(LIST_ITEM(lp)))));
	    rData = EXPV_STR(EXPR_ARG3(EXPR_ARG3(LIST_ITEM(lp))));
	    rStart = EXPV_INT_VALUE(EXPR_ARG1(LIST_ITEM(lp)));
	    for (i = 0; i < rMax; i++) {
		memImg[i + rStart] = rData[i];
		curLen++;
		if (curLen >= maxLen) {
		    goto fillEnd;
		}
	    }
	}

    fillEnd:
	VAR_INIT_LIST(id) = rawToInitializeList(memImg, maxLen);
	VAR_INIT_FINALIZED(id) = TRUE;
	VAR_INIT_USE_RAW(id) = TRUE;

	return TRUE;
    }

    typ = getBasicType(ID_TYPE(id));
    switch (typ) {
    case TYPE_SHORT:
    case TYPE_INT:
    case TYPE_LOGICAL: {
	zero = expv_int_term(INT_CONSTANT, type_INT, 0);
	break;
    }
#ifdef HAS_INT64
    case TYPE_LONGLONG: {
	zero = expv_longlong_term(LONGLONG_CONSTANT, type_LONGLONG, 0, 0);
	break;
    }
#endif /* HAS_INT64 */
    case TYPE_CHAR: {
	int len = 1;
	if(IS_ARRAY_TYPE(ID_TYPE(id))) 
	    len = TYPE_CHAR_LEN(array_element_type(ID_TYPE(id)));
	zero = expv_str_term(STRING_CONSTANT,type_char(len), "");
	break;
    }
    case TYPE_REAL:
    case TYPE_DREAL: {
	zero = expv_float_term(FLOAT_CONSTANT, type_REAL, 0.0);
	break;
    }
    case TYPE_COMPLEX:
    case TYPE_DCOMPLEX: {
	expv zRe = expv_float_term(FLOAT_CONSTANT, type_REAL, 0.0);
	zero = list2(LIST, zRe, zRe);
	isComplex = TRUE;
	break;
    }
#ifdef ENABLE_QREAL
    case TYPE_QREAL: {
	zero = expv_float_term(FLOAT_CONSTANT, type_REAL, 0.0);
	isQReal = TRUE;
	break;
    }
#endif /* ENABLE_QREAL */
    default: {
	fatal("type \"%s\" not supported yet :(",
	      basic_type_names[(int)typ]);
    }
    }

    FOR_ITEMS_IN_LIST(lp, vList) {
	if (LIST_ITEM(lp) == NULL) {
	    LIST_ITEM(lp) = zero;
	}
    }

    if (isComplex == TRUE) {
	expv tmp;
	int haveStr = FALSE;

	/*
	 * Check have string initializer.
	 */
	FOR_ITEMS_IN_LIST(lp, vList) {
	    tmp = LIST_ITEM(lp);
	    if (TYPE_BASIC_TYPE(EXPV_TYPE(tmp)) == TYPE_CHAR) {
		haveStr = TRUE;
		break;
	    }
	}

	if (haveStr == TRUE) {
	    /*
	     * use raw.
	     */
	    int orgN = EXPV_INT_VALUE(EXPR_ARG1(VAR_INIT_LIST(id)));
	    int aELen = ((typ == TYPE_COMPLEX) ? sizeof(float) : sizeof(double));
	    int tBufLen = aELen * 2;
	    int nInit = tBufLen * orgN;
	    char *memBuf = (char *)malloc(sizeof(char) * nInit);
	    char *cPtr = memBuf;

	    FOR_ITEMS_IN_LIST(lp, vList) {
		tmp = LIST_ITEM(lp);
		if (TYPE_BASIC_TYPE(EXPV_TYPE(tmp)) == TYPE_CHAR) {
		    memcpy(cPtr, EXPV_STR(tmp), tBufLen);
		    cPtr += tBufLen;
		} else {
		    memcpy(cPtr, (char *)&(EXPR_GEN(EXPR_ARG1(tmp))), aELen);
		    cPtr += aELen;
		    memcpy(cPtr, (char *)&(EXPR_GEN(EXPR_ARG2(tmp))), aELen);
		    cPtr += aELen;
		}
	    }
	    VAR_INIT_LIST(id) = rawToInitializeList(memBuf, nInit);
	    VAR_INIT_FINALIZED(id) = TRUE;
	    VAR_INIT_USE_RAW(id) = TRUE;
	    (void)free(memBuf);

	    return TRUE;
	} else {
	    int nInit = 0;
	    expv newV = list0(LIST);
	    FOR_ITEMS_IN_LIST(lp, vList) {
		tmp = LIST_ITEM(lp);
		newV = list_put_last(newV, EXPR_ARG1(tmp));
		newV = list_put_last(newV, EXPR_ARG2(tmp));
		nInit += 2;
	    }
	    EXPR_ARG1(VAR_INIT_LIST(id)) = expv_int_term(INT_CONSTANT, type_INT, nInit);
	    EXPR_ARG2(VAR_INIT_LIST(id)) = newV;
	}
    }

#ifdef ENABLE_QREAL

# define __gen64node(v, val) \
{ \
  (v) = expv_longlong_term(LONGLONG_CONSTANT, type_LONGLONG, 0, 0); \
  expr_int64_save((v), ((_omInt64_t)(val))); \
}

# define __gen32node(v, val) \
{ \
  (v) = expv_int_term(INT_CONSTANT, type_INT, (val)); \
}

# if (OMNI_SIZEOF_QLIM_T > 4)
#  define __genLimbNode(v, val) __gen64node(v, val)
# else
#  define __genLimbNode(v, val) __gen32node(v, val)
# endif /* OMNI_SIZEOF_QLIM_T ... */

# if (OMNI_SIZEOF_QEXP_T > 4)
#  define __genExpNode(v, val) __gen64node(v, val)
# else
#  define __genExpNode(v, val) __gen32node(v, val)
# endif /* OMNI_SIZEOF_QEXP_T ... */

    if (isQReal == TRUE) {
	expv tmp;
	int haveStr = FALSE;
	_omQReal_t qrVal;

	QRinit(&qrVal);

	/*
	 * Check have string initializer.
	 */
	FOR_ITEMS_IN_LIST(lp, vList) {
	    tmp = LIST_ITEM(lp);
	    if (TYPE_BASIC_TYPE(EXPV_TYPE(tmp)) == TYPE_CHAR) {
		haveStr = TRUE;
		break;
	    }
	}

	if (haveStr == TRUE ||
	    ID_STORAGE(id) == STG_COMMON ||
	    ID_STORAGE(id) == STG_COMEQ ||
	    ID_STORAGE(id) == STG_EQUIV) {
	    /*
	     * use raw.
	     */
	    int orgN = EXPV_INT_VALUE(EXPR_ARG1(VAR_INIT_LIST(id)));
	    int qrSz = basic_type_size(TYPE_QREAL);
	    int nInit = qrSz * orgN;
	    char *memBuf = (char *)malloc(sizeof(char) * nInit);
	    char *cPtr = memBuf;
	    int n = 0;
	    int cpLen;
	    int substLen;

	    FOR_ITEMS_IN_LIST(lp, vList) {
		tmp = LIST_ITEM(lp);
		if (TYPE_BASIC_TYPE(EXPV_TYPE(tmp)) == TYPE_CHAR) {
		    n++;
		}
	    }

	    if (n == orgN) {
		/*
		 * All string.
		 */
		FOR_ITEMS_IN_LIST(lp, vList) {
		    tmp = LIST_ITEM(lp);
		    cpLen = strlen(EXPV_STR(tmp));
		    cpLen = (cpLen > qrSz) ? qrSz : cpLen;
		    memcpy(cPtr, EXPV_STR(tmp), cpLen);
		    cPtr += cpLen;
		}
		memset(cPtr, 0, nInit - ((int)(cPtr - memBuf)));
		goto qRealDoFill;
	    }

	    substLen = SIZEOF_UNSIGNED_INT * 2 + /* sizeof(_mp_prec) + sizeof(_mp_size) */
	    	OMNI_SIZEOF_QEXP_T
#ifdef OMNI_QREAL_NEED_GAP_MEMBER
		+ OMNI_QREAL_GAP_SIZE
#endif /* OMNI_QREAL_NEED_GAP_MEMBER */
		;

	    FOR_ITEMS_IN_LIST(lp, vList) {
		tmp = LIST_ITEM(lp);
		if (TYPE_BASIC_TYPE(EXPV_TYPE(tmp)) == TYPE_CHAR) {
		    cpLen = strlen(EXPV_STR(tmp));
		    memcpy(cPtr, EXPV_STR(tmp), cpLen);
		    memset(cPtr + cpLen, 0, qrSz - cpLen);
		} else {
		    if (expv_const_convert_to_qreal(tmp, &qrVal) == FALSE) {
			nInit = cPtr - memBuf;
			goto qRealDoFill;
		    }
		    /* copy whole qrVal */
		    memcpy(cPtr, (char *)&qrVal, substLen);
		    memset(cPtr + substLen, 0, OMNI_SIZEOF_QLIM_T);
		    memcpy(cPtr + substLen + OMNI_SIZEOF_QLIM_T, (char *)(qrVal._omLimb),
			   OMNI_SIZEOF_QLIM_T * gmpLimbSize);
		}
		cPtr += qrSz;
	    }

	    qRealDoFill:
	    VAR_INIT_LIST(id) = rawToInitializeList(memBuf, nInit);
	    VAR_INIT_FINALIZED(id) = TRUE;
	    VAR_INIT_USE_RAW(id) = TRUE;
	    (void)free(memBuf);

	    return TRUE;
	} else {
	    int nInit = 0;
	    expv elVal;
	    int i;
	    expv newV = list0(LIST);

	    FOR_ITEMS_IN_LIST(lp, vList) {
		tmp = LIST_ITEM(lp);
		if (expv_const_convert_to_qreal(tmp, &qrVal) == FALSE) {
		    error_at_node(VAR_INIT_LIST(id),
				  "can't create quad real initializer for '%s'.\n",
				  SYM_NAME(ID_SYM(id)));
		    VAR_INIT_LIST(id) = NULL;
		    VAR_INIT_FINALIZED(id) = TRUE;
		    return FALSE;
		}
		/* put prec. */
		newV = list_put_last(newV, expv_int_term(INT_CONSTANT, type_INT,
							 qrVal._mp_prec));
		nInit++;

		/* put size. */
		newV = list_put_last(newV, expv_int_term(INT_CONSTANT, type_INT,
							 qrVal._mp_size));
		nInit++;

		/* put exp. */
		__genExpNode(elVal, qrVal._mp_exp);
		newV = list_put_last(newV, elVal);
		nInit++;

# if defined(USE_SHORT_GAP) || defined(USE_INT_GAP)
		/* put int/short gap */
		newV = list_put_last(newV, expv_constant_0);
		nInit++;
# elif defined(USE_CHAR_GAP)
		/* put bytes gap */
		for (i = 0; i < OMNI_QREAL_GAP_SIZE; i++) {
		    newV = list_put_last(newV, expv_constant_0);
		    nInit++;
		}
# endif /* USE_SHORT_GAP || USE_INI_GAP ... */

		/*
		 * put _mp_d (addr).
		 * NOTE: INITIALIZE as NULL address.
		 * 	 Runtime must re-initialize:
		 *		v._mp_d = &(v._omLimb[0]);
		 */
#ifdef ADDR_IS_64
		newV = list_put_last(newV,
				     expv_longlong_term(LONGLONG_CONSTANT,
							type_LONGLONG, 0, 0));
#else
		newV = list_put_last(newV, expv_constant_0);
#endif /* ADDR_IS_64 */
		nInit++;

		/* put limbs. */
		for (i = 0; i < gmpLimbSize; i++) {
		    __genLimbNode(elVal, qrVal._mp_d[i]);
		    newV = list_put_last(newV, elVal);
		    nInit++;
		}
	    }
	    EXPR_ARG1(VAR_INIT_LIST(id)) = expv_int_term(INT_CONSTANT, type_INT, nInit);
	    EXPR_ARG2(VAR_INIT_LIST(id)) = newV;
	}

	QRclean(&qrVal);

    }
#endif /* ENABLE_QREAL */

    if (ID_STORAGE(id) == STG_COMMON ||
	ID_STORAGE(id) == STG_COMEQ ||
	ID_STORAGE(id) == STG_EQUIV) {
	expv vList = EXPR_ARG2(VAR_INIT_LIST(id));
	int nInit = EXPV_INT_VALUE(EXPR_ARG1(VAR_INIT_LIST(id)));
	int size = type_length(ID_TYPE(id));
	char *memBuf = (char *)malloc(sizeof(char) * size);
	char *chkBuf = (char *)malloc(sizeof(char) * size);
	int typLen = getIdTypeLen4Initialize(id, &typ);

	memset(memBuf, 0, size);
	memset(chkBuf, 0, size);

	if (convertInitializerToRaw(memBuf, chkBuf,
				    size, 0,
				    typ, typLen,
				    vList, nInit,
				    FALSE) == FALSE) {
	    error_at_node(VAR_INIT_LIST(id), 
			  "'%s' is already initialized by other variable in equivalence set.",
			  SYM_NAME(ID_SYM(id)));
	    VAR_INIT_LIST(id) = NULL;
	    VAR_INIT_FINALIZED(id) = TRUE;
	    free(memBuf);
	    free(chkBuf);
	    return FALSE;
	}
	free(chkBuf);
	VAR_INIT_LIST(id) = rawToInitializeList(memBuf, size);
	free(memBuf);
	VAR_INIT_USE_RAW(id) = TRUE;
    }

    VAR_INIT_FINALIZED(id) = TRUE;
    return TRUE;
}

static void
outputCharInitializer(expv v,FILE *fd)
{
    char *cp;
    list lp;
    int i,l;

    switch(EXPV_CODE(v)){
    case STRING_CONSTANT:
	if(EXPV_STR(v)[0] == 0){	/* fill zero */
	    l = TYPE_CHAR_LEN(EXPV_TYPE(v));
	    for(i = 0; i < l; i++) 
		fprintf(fd,"(INT_CONSTANT:char 0x%x)\n",DEFAULT_UNINITED_CHAR);
	    break;
	}
	for(cp = EXPV_STR(v); *cp != 0; cp++)
	    fprintf(fd,"(INT_CONSTANT:char 0x%x)\n",*cp);
	break;
    case INT_CONSTANT:
	X_output(v,fd);
	break;
    case LIST:
	FOR_ITEMS_IN_LIST(lp, v) outputCharInitializer(LIST_ITEM(lp),fd);
	break;
    default:
	fatal("outputCharInitializer");
    }
}

static int
output_Initializer(id, fd)
    ID id;
    FILE *fd;
{
    if (finalizeVariableInitialize(id) == FALSE) {
	return FALSE;
    }

    if(is_char_type(ID_TYPE(id))){
	fprintf(fd,"(LIST\n");
	outputCharInitializer(EXPR_ARG2(VAR_INIT_LIST(id)),fd);
	fprintf(fd,")");
	return TRUE;
    }

    if (IS_ARRAY_TYPE(ID_TYPE(id)) ||
	IS_CHAR(ID_TYPE(id)) ||
	(ID_TYPE(id) == type_COMPLEX) ||
	(ID_TYPE(id) == type_DCOMPLEX) ||
#ifdef ENABLE_QREAL
	(ID_TYPE(id) == type_QREAL) ||
#endif /* ENABLE_QREAL */
	(ID_STORAGE(id) == STG_EQBLK)) {
	X_output(EXPR_ARG2(VAR_INIT_LIST(id)), fd);
    } else {
	X_output(EXPR_ARG1(EXPR_ARG2(VAR_INIT_LIST(id))), fd);
    }
    return TRUE;
}


#ifdef ENABLE_QREAL
static int __uniqAddr0;
static int __uniqAddr1;
static int __uniqAddr2;
#endif /* ENABLE_QREAL */

/*
 * OUTPUT X code
 */
int
output_X_file()
{
    EXT_ID ep;
    TYPE_DESC tp;
    list lp,lq;
    ID id;
    expr x;
    expr v1,v2;

    collect_types();

    /* output file name */
    fprintf(output_file,"### source:%s\n",
	    (source_file_name != NULL) ? source_file_name : "<stdin>");
    current_line = NULL;

    /* dump types */
#ifdef ENABLE_QREAL

    if (type_QREAL->is_referenced) {
	/*
	 * No need to create an actual type for mp_limb_t[n].
	 * just need a uniq addr.
	 */
	char *uq = (char *)(&__uniqAddr0);
#ifdef USE_CHAR_GAP
	/*
	 * like above, create uniq addr for gap member "char _gap_[OMNI_QREAL_GAP_SIZE]"
	 */
	char *gU = (char *)(&__uniqAddr1);
#endif /* USE_CHAR_GAP */

	/*
	 * mp_limb_t pointer type.
	 */
	char *uqLPtr = (char *)(&__uniqAddr2);

# if (OMNI_SIZEOF_QLIM_T > 4)
#  define _LTNm TYPE_LONGLONG
#  define _XobjNm "long_long"
# elif (OMNI_SIZEOF_QLIM_T == 4)
#  define _LTNm TYPE_INT
#  define _XobjNm "int"
# else
#  define _LTNm TYPE_SHORT
#  define _XobjNm "short"
# endif /* OMNI_SIZEOF_QLIM_T ... */

	/*
	 * Emit mp_limb_t * type.
	 */
	fprintf(output_file,
		"{P%x 0x%x 0x%x 0 0 %s}\n",
		Addr2Uint32(uqLPtr),
		basic_type_size(_LTNm),
		basic_type_align(_LTNm),
		_XobjNm);

# ifdef USE_CHAR_GAP
	fprintf(output_file,
		"{A%x 0x%x 0x%x 0 0 %s 0x%x}\n",
		Addr2Uint32(gU),
		(int)(sizeof(char) * OMNI_QREAL_GAP_SIZE),
		(int)(sizeof(char)),
		"char",
		(int)OMNI_QREAL_GAP_SIZE);
# endif /* USE_CHAR_GAP */

	fprintf(output_file,
		"{A%x 0x%x 0x%x 0 0 %s 0x%x}\n",
		Addr2Uint32(uq),
		basic_type_size(_LTNm) * gmpLimbSize,
		basic_type_align(_LTNm),
		_XobjNm,
		(int)gmpLimbSize);

# if defined(USE_SHORT_GAP)
	fprintf(output_file,
		"{S%x 0x%x 0x%x 0 0 [_mp_prec * int ()] [_mp_size * int ()] [_mp_exp * %s ()] [_gap_ * short () ] [_mp_d * P%x ()] [_omLimb * A%x ()]}\n",
		Addr2Uint32(type_QREAL),
		basic_type_size(TYPE_QREAL),
		basic_type_align(TYPE_QREAL),
		_XobjNm,
		Addr2Uint32(uqLPtr),
		Addr2Uint32(uq));
# elif defined(USE_INT_GAP)
	fprintf(output_file,
		"{S%x 0x%x 0x%x 0 0 [_mp_prec * int ()] [_mp_size * int ()] [_mp_exp * %s ()] [_gap_ * int () ] [_mp_d * P%x ()] [_omLimb * A%x ()]}\n",
		Addr2Uint32(type_QREAL),
		basic_type_size(TYPE_QREAL),
		basic_type_align(TYPE_QREAL),
		_XobjNm,
		Addr2Uint32(uqLPtr),
		Addr2Uint32(uq));
# elif defined(USE_CHAR_GAP)
	fprintf(output_file,
		"{S%x 0x%x 0x%x 0 0 [_mp_prec * int ()] [_mp_size * int ()] [_mp_exp * %s ()] [_gap_ * A%x () ] [_mp_d * P%x ()] [_omLimb * A%x ()]}\n",
		Addr2Uint32(type_QREAL),
		basic_type_size(TYPE_QREAL),
		basic_type_align(TYPE_QREAL),
		_XobjNm,
		Addr2Uint32(gU),
		Addr2Uint32(uqLPtr),
		Addr2Uint32(uq));
# else
	fprintf(output_file,
		"{S%x 0x%x 0x%x 0 0 [_mp_prec * int ()] [_mp_size * int ()] [_mp_exp * %s ()] [_mp_d * P%x ()] [_omLimb * A%x ()]}\n",
		Addr2Uint32(type_QREAL),
		basic_type_size(TYPE_QREAL),
		basic_type_align(TYPE_QREAL),
		_XobjNm,
		Addr2Uint32(uqLPtr),
		Addr2Uint32(uq));
# endif /* USE_SHORT_GAP ... */
# undef _LTNm
# undef _XobjNm
    }
#endif /* ENABLE_QREAL */

    if(type_COMPLEX->is_referenced)
	fprintf(output_file,
		"{S%x 0x8 0x4 0 0  [re * float ()]  [im * float ()] }\n",
		Addr2Uint32(type_COMPLEX));

    if(type_DCOMPLEX->is_referenced)
	fprintf(output_file,
		"{S%x 0x10 0x8 0 0  [re * double ()]  [im * double ()] }\n",
		Addr2Uint32(type_DCOMPLEX));
    
    for(tp = type_list; tp != NULL; tp = TYPE_LINK(tp)){
	if(is_char_type(tp)){
	    /* char type is always one-dimensional array of char */
	    if(IS_ARRAY_TYPE(tp)){
		if(TYPE_ARRAY_SIZE(tp) > 0){
		    int l = type_length(tp);
		    fprintf(output_file,"{");
		    X_output_type(tp,output_file);
		    fprintf(output_file," 0x%x 0x1 0 0 char 0x%x}\n",l,l);
		} else {  /* adjustable char array */
		    fprintf(output_file,"{");
		    X_output_type(tp,output_file);
		    fprintf(output_file," 0x0 0x1 0 0 char ");
		    x = array_total_size(tp);
		    if(x != NULL) X_output_no_indent(x,output_file);
		    else fprintf(output_file,"0");
		    fprintf(output_file,"}\n");
		}
	    } else {
		if(TYPE_CHAR_LEN(tp) != 0){
		    fprintf(output_file,"{A%x 0x%x 0x1 0 0 char 0x%x}\n",
			    Addr2Uint32(tp), TYPE_CHAR_LEN(tp),
			    TYPE_CHAR_LEN(tp));
		}
	    }
	} else if(TYPE_REF(tp) == NULL){ 
	    /* basic type */
	} else if(IS_ARRAY_TYPE(tp)){
	    if(TYPE_ARRAY_SIZE(tp) > 0){
		fprintf(output_file,"{");
		X_output_type(tp,output_file);
		fprintf(output_file," 0x%x 0x%x 0 0 ",
			type_length(tp),type_align(tp));
		X_output_type(TYPE_REF(tp),output_file);
		fprintf(output_file," 0x%x}\n",TYPE_ARRAY_SIZE(tp));
	    } else {
		/* adjustable array */
		fprintf(output_file,"{");
		X_output_type(tp,output_file);
		fprintf(output_file," 0x0 0x%x 0 0 ",type_align(tp));
		X_output_type(array_element_type(tp),output_file);
		fprintf(output_file," ");
		x = array_total_size(tp);
		if(x != NULL) X_output_no_indent(x,output_file);
		else fprintf(output_file,"0");
		fprintf(output_file,"}\n");
	    }
	} else if(IS_FUNCTION_TYPE(tp)){
		fprintf(output_file,"{");
		X_output_type(tp,output_file);
		fprintf(output_file," 0x0 0x0 0 0 ");
		X_output_type(TYPE_REF(tp),output_file);
		fprintf(output_file," 0 ()}\n");
	} else { /* pointer */
	    if (TYPE_BASIC_TYPE(TYPE_REF(tp)) == TYPE_EQBLK) {
		ID equivId = (ID)TYPE_EQUIV_ID(TYPE_REF(tp));
		if (VAR_EQUIV_TYPE(equivId) != EQUIV_TYPE_PURE) {
		    continue;
		}
	    }
	    fprintf(output_file,"{");
	    X_output_type(tp,output_file);
	    fprintf(output_file," 0x%x 0x%x 0 0 ",
		    type_POINTER_SIZE,type_POINTER_ALIGN);
	    X_output_type(TYPE_REF(tp),output_file);
	    fprintf(output_file,"}\n");
	}
    }

    /* output type for common and function */
    for(ep = external_symbols; ep != NULL; ep = EXT_NEXT(ep)){
	switch(EXT_TAG(ep)){
	case STG_EXT:	/* external functions */
	    fprintf(output_file,"{F%x 0x0 0x0 0 0 ", Addr2Uint32(ep));
	    X_output_type(EXT_PROC_C_TYPE(ep), output_file);
	    if(EXT_PROC_ARGS(ep) == NULL|| !EXT_PROC_IS_RUNTIME(ep)){
		fprintf(output_file," 0 ()}\n");
	    } else {
		fprintf(output_file," 1 ");		/* set prototype */
		X_output_no_indent(EXT_PROC_ARGS(ep),output_file);
		fprintf(output_file,"}\n");
	    }
	    /* name's address is used as pointer's ID */
	    fprintf(output_file,"{P%x 0x%lx 0x%lx 0 0 F%x}\n",
		    Addr2Uint32(EXT_SYM(ep)),
		    (unsigned long int)type_POINTER_SIZE,
		    (unsigned long int)type_POINTER_ALIGN,
		    Addr2Uint32(ep));
	    break;
	case STG_COMMON: /* common block */
	    if (EXT_COM_LISTS(ep) != NULL) {
		/* define struct for common */
		list mustAtFirst = NULL;

		FOR_ITEMS_IN_LIST(lp, EXT_COM_LISTS(ep)) {
		    /* struct member '_0' is whole variable for initialize */
		    if (EXPV_INT_VALUE(EXPR_ARG1(LIST_ITEM(lp))) == 0) {
			mustAtFirst = lp;
		    }
		    fprintf(output_file,"{S%x 0x%lx 0x1 0 0",
			    Addr2Uint32(lp),
			    (unsigned long int)EXT_COM_LEN(ep));
		    FOR_ITEMS_IN_LIST(lq, EXPR_ARG2(LIST_ITEM(lp))){
			id = EXPV_ANY(ID,LIST_ITEM(lq));
			fprintf(output_file," [%s * ",C_sym_name(ID_SYM(id)));
			X_output_type(ID_TYPE(id),output_file);
			fprintf(output_file," ()]");
		    }
		    fprintf(output_file,"}\n");
		}
		fprintf(output_file,"{U%x 0x%lx 0x1 0 0",
			Addr2Uint32(ep),
			(unsigned long int)EXT_COM_LEN(ep));
		
		/* Put first */
		if (mustAtFirst != NULL) {
		    fprintf(output_file, " [_%d * S%x ()]",
			    EXPV_INT_VALUE(EXPR_ARG1(LIST_ITEM(mustAtFirst))),
			    Addr2Uint32(mustAtFirst));
		}
		/* Put rest */
		FOR_ITEMS_IN_LIST(lp, EXT_COM_LISTS(ep)) {
		    if (lp != mustAtFirst) {
			fprintf(output_file," [_%d * S%x ()]",
				EXPV_INT_VALUE(EXPR_ARG1(LIST_ITEM(lp))),
				Addr2Uint32(lp));
		    }
		}
		fprintf(output_file,"}\n");
		fprintf(output_file,"{P%x 0x%lx 0x%lx 0 0 U%x}\n",
			Addr2Uint32(EXT_SYM(ep)),
			(unsigned long int)type_POINTER_SIZE,
			(unsigned long int)type_POINTER_ALIGN,
			Addr2Uint32(ep));

		finalizeCommonInitialize(ep);
	    }
	    break;
	default:
	    fatal("X_output_file: unknown ext_id tag");
	}
    }

    /* output equivalence struct/union */
    for (ep = external_symbols; ep != NULL; ep = EXT_NEXT(ep)) {
	if (EXT_TAG(ep) != STG_EXT) continue;
	for (id = EXT_PROC_ID_LIST(ep); id != NULL; id = ID_NEXT(id)) {
	    if (ID_STORAGE(id) == STG_EQBLK &&
		VAR_EQUIV_TYPE(id) == EQUIV_TYPE_PURE) {
		list lp, lq;
		expv eqSpec = VAR_EQUIV_SPEC(id);
		expv eqList = EXPR_ARG3(eqSpec);
		expv tmp;
		int size = EXPV_INT_VALUE(EXPR_ARG2(eqSpec));
		
		/*
		 * output each structs
		 */
		FOR_ITEMS_IN_LIST(lp, eqList) {
		    fprintf(output_file, "{S%x 0x%lx 0x1 0 0",
			    Addr2Uint32(lp),
			    (unsigned long int)size);
		    FOR_ITEMS_IN_LIST(lq, LIST_ITEM(lp)) {
			tmp = LIST_ITEM(lq);
			if (tmp != NULL) {
			    fprintf(output_file, " [%s * ",
				    C_sym_name(ID_SYM(EQUIV_NODE_ID(tmp))));
			    X_output_type(ID_TYPE(EQUIV_NODE_ID(tmp)), output_file);
			    fprintf(output_file, " ()]");
			}
		    }
		    fprintf(output_file, "}\n");
		}

		/*
		 * output union struct, substance of equivalence
		 */
		fprintf(output_file, "{");
		X_output_type(ID_TYPE(id), output_file);
		fprintf(output_file, " 0x%lx 0x1 0 0",
			(unsigned long int)size);
		FOR_ITEMS_IN_LIST(lp, eqList) {
		    tmp = LIST_ITEM(lp);
		    fprintf(output_file, " [_%d * S%x ()]",
			    VAR_EQUIV_STRUCT_NO(EQUIV_NODE_ID(EXPR_ARG2(tmp))),
			    Addr2Uint32(lp));
		}
		fprintf(output_file, "}\n");

		/*
		 * Finalize initialization.
		 */
		finalizeEquivInitialize(id);
	    }
	}
    }

    /* output global env */
    fprintf(output_file,"%%\n");
    
    if(type_COMPLEX->is_referenced)
	fprintf(output_file,"[* tagname S%x ()]\n", Addr2Uint32(type_COMPLEX));
    if(type_DCOMPLEX->is_referenced)
	fprintf(output_file,"[* tagname S%x ()]\n", Addr2Uint32(type_DCOMPLEX));
#ifdef ENABLE_QREAL
    if(type_QREAL->is_referenced)
	fprintf(output_file,"[* tagname S%x ()]\n", Addr2Uint32(type_QREAL));
#endif /* ENABLE_QREAL */

    for(ep = external_symbols; ep != NULL; ep = EXT_NEXT(ep)){
	switch(EXT_TAG(ep)) {
	case STG_EXT: {
	    /* external functions */
	    int doGen = FALSE;
	    if (EXT_PROC_IS_RUNTIME(ep) != TRUE &&
		strcmp(C_sym_name(EXT_SYM(ep)), OMNI_FORTRAN_ENTRY_POINT) != 0) {
		doGen = TRUE;
	    }
	    fprintf(output_file,"[%s ",C_sym_name(EXT_SYM(ep)));
	    if (EXT_IS_DEFINED(ep)) {
		if (EXT_PROC_BODY(ep) == NULL && EXT_PROC_ID_LIST(ep) == NULL) {
		    fprintf(output_file, "extern ");
		} else {
		    fprintf(output_file,"extern_def ");
		}
	    } else {
		fprintf(output_file,"extern ");
	    }
	    fprintf(output_file,"F%x ", Addr2Uint32(ep));
	    fprintf(output_file," (FUNC_ADDR:P%x %s) %s]\n",
		    Addr2Uint32(EXT_SYM(ep)),
		    C_sym_name(EXT_SYM(ep)),
		    (doGen == TRUE) ? "*" : "*");
	    break;
	}
	case STG_COMMON: {
	    /* common block */
	    if (EXT_COM_LISTS(ep) != NULL) {
		fprintf(output_file,"[%s extern_def U%x",
			C_sym_name(EXT_SYM(ep)),
			Addr2Uint32(ep));
		fprintf(output_file," (VAR_ADDR:P%x %s) %s]\n",
			Addr2Uint32(EXT_SYM(ep)),
			C_sym_name(EXT_SYM(ep)),
			(EXT_COM_INIT_LIST(ep) != NULL) ? "" : "*");
		/* output union tagname for common */
		FOR_ITEMS_IN_LIST(lp,EXT_COM_LISTS(ep)){
		    fprintf(output_file,"[* tagname S%x ()]\n", Addr2Uint32(lp));
		}
		fprintf(output_file,"[* tagname U%x ()]\n", Addr2Uint32(ep));
	    }
	    break;
	}
	default: {
	    fatal("X_output_file: unknown ext_id tag");
	}
	}
    }

    /* output tagname for equivalence */
    for (ep = external_symbols; ep != NULL; ep = EXT_NEXT(ep)) {
	if (EXT_TAG(ep) != STG_EXT) continue;
	for (id = EXT_PROC_ID_LIST(ep); id != NULL; id = ID_NEXT(id)) {
	    if (ID_STORAGE(id) == STG_EQBLK &&
		VAR_EQUIV_TYPE(id) == EQUIV_TYPE_PURE) {
		list lp;
		expv eqSpec = VAR_EQUIV_SPEC(id);
		expv eqList = EXPR_ARG3(eqSpec);
		
		FOR_ITEMS_IN_LIST(lp, eqList) {
		    fprintf(output_file, " [* tagname S%x ()]",
			    Addr2Uint32(lp));
		}
		fprintf(output_file, " [* tagname ");
		X_output_type(ID_TYPE(id), output_file);
		fprintf(output_file, " ()]");
	    }
	}
    }

    /* output declaration and function */
    fprintf(output_file,"\n%%\n");

    /* First, named common blocks with initializer */
    for (ep = external_symbols; ep != NULL; ep = EXT_NEXT(ep)) {
	if (EXT_TAG(ep) == STG_COMMON && EXT_COM_INIT_LIST(ep) != NULL) {
	    fprintf(output_file, "(VAR_DECL (IDENT %s)\n",
		    C_sym_name(EXT_SYM(ep)));
	    X_output(EXPR_ARG2(EXT_COM_INIT_LIST(ep)), output_file);
	    fprintf(output_file, ")\n");
	}
    }

    /* scan functions */
    for(ep = external_symbols; ep != NULL; ep = EXT_NEXT(ep)){
	if(EXT_TAG(ep) != STG_EXT) continue;
	if (EXT_PROC_BODY(ep) == NULL && EXT_PROC_ID_LIST(ep) == NULL) {
	    /* just extern. */
	    continue;
	}

	if(!EXT_IS_DEFINED(ep)){
#ifndef BUGFIX
	    fprintf(output_file,"(LIST (EXT_DECL (IDENT %s) ()))\n",
		    C_sym_name(EXT_SYM(ep)));
#endif
	    continue;
	}

	/* function definition */
	fprintf(output_file,"(FUNCTION_DEFINITION (IDENT %s)\n",
		C_sym_name(EXT_SYM(ep)));

	/* for paramter */
	fprintf(output_file,"(ID_LIST\n");
	FOR_ITEMS_IN_LIST(lp,EXT_PROC_ARGS(ep)){
	    x = LIST_ITEM(lp);
	    v1 = EXPR_ARG1(x);
	    v2 = EXPR_ARG2(x);
	    if(EXPR_CODE(v2) == PARAM_ADDR)
		fprintf(output_file,"[%s param ",C_sym_name(EXPV_NAME(v1)));
	    else
		fprintf(output_file,"[%s fparam ",C_sym_name(EXPV_NAME(v1)));
	    X_output_type(EXPV_TYPE(v1),output_file);
	    fprintf(output_file," ");
	    X_output_no_indent(v2,output_file);
	    fprintf(output_file,"]\n");
	}
	fprintf(output_file,")\n");

	fprintf(output_file,"(LIST\n");
	for(id = EXT_PROC_ID_LIST(ep); id != NULL; id = ID_NEXT(id)){
	    if(ID_STORAGE(id) == STG_ARG)
		fprintf(output_file,"(VAR_DECL (IDENT %s) ())",
			C_sym_name(ID_SYM(id)));
	}
	fprintf(output_file,")\n");

	/* body */
	fprintf(output_file,"(COMPOUND_STATEMENT\n(ID_LIST\n");
	/* dump variable id_list */
	for(id = EXT_PROC_ID_LIST(ep); id != NULL; id = ID_NEXT(id)){
	    if (ID_STORAGE(id) == STG_EQBLK &&
		VAR_EQUIV_TYPE(id) != EQUIV_TYPE_PURE) {
		continue;
	    }
	    if (ID_CLASS(id) == CL_VAR &&
		VAR_IS_IMPLIED_DO_DUMMY(id) == TRUE) {
		continue;
	    }

	    switch(ID_STORAGE(id)){
	    case STG_UNKNOWN:
	    case STG_ARG:	/* already precessed */
		/* printf("STG_UNKOWN '%s'\n",ID_NAME(id)); */
		continue;
	    case STG_NONE: 	/* statement function, intrinsic function */
		continue;
	    case STG_BSS:
		fprintf(output_file,"[%s static ",C_sym_name(ID_SYM(id)));
		break;
	    case STG_EQBLK:
	    case STG_AUTO:
		if (VAR_IS_SAVE(id) == TRUE) {
		    fprintf(output_file,"[%s static ",C_sym_name(ID_SYM(id)));
		} else {
		    fprintf(output_file,"[%s auto ",C_sym_name(ID_SYM(id)));
		}
		break;
	    case STG_PTRBASE:
		continue;
	    case STG_TEMP:
		fprintf(output_file,"[%s temp ",C_sym_name(ID_SYM(id)));
		break;
	    case STG_CTEMP:
		fprintf(output_file,"[%s ctemp ",C_sym_name(ID_SYM(id)));
		break;

	    case STG_EQUIV:
	    case STG_COMEQ:
	    case STG_COMMON:	/* allocated in common */
		if (VAR_EQUIV_IS_DUMMY(id) != TRUE) {
		    fprintf(output_file,"[%s fcomm ",C_sym_name(ID_SYM(id)));
		} else {
		    /*
		     * This kind of symbol must be the one that is
		     * created as dummy, Should not be emitted.
		     */
		    goto NoNeedToEmit;
		}
		break;

	    case STG_EXT:	/* external function */
		/* this must be declared in external list...
		   fprintf(output_file, "[%s extern ", C_sym_name(ID_SYM(id)));
		   break;
		   */
		continue;

	    default:
		fatal("unknown ID_STORAGE = %d of '%s'\n",
		      ID_STORAGE(id),ID_NAME(id));
	    }
	    X_output_type(ID_TYPE(id),output_file);
	    fprintf(output_file," ");
	    X_output_no_indent(ID_ADDR(id),output_file);
	    fprintf(output_file,"]\n");
	NoNeedToEmit:
	    continue;
	}
	for(id = EXT_PROC_LABEL_LIST(ep); id != NULL; id = ID_NEXT(id))
	    fprintf(output_file,"[%s label * ()]\n",C_sym_name(ID_SYM(id)));
	fprintf(output_file,")\n");
	fprintf(output_file,"(LIST\n");
	for(id = EXT_PROC_ID_LIST(ep); id != NULL; id = ID_NEXT(id)){
	    if (ID_STORAGE(id) == STG_BSS ||
		ID_STORAGE(id) == STG_AUTO ||
		ID_STORAGE(id) == STG_EQBLK) {
		if (VAR_EQUIV_TYPE(id) != EQUIV_TYPE_PURE) {
		    continue;
		}
		if (ID_CLASS(id) == CL_VAR &&
		    VAR_IS_IMPLIED_DO_DUMMY(id) == TRUE) {
		    continue;
		}
		fprintf(output_file, "(VAR_DECL (IDENT %s)\n",
			C_sym_name(ID_SYM(id)));
		if (VAR_INIT_LIST(id) != NULL) {
		    if (finalizeVariableInitialize(id) == FALSE) {
			return FALSE;
		    }
		    if (VAR_INIT_LIST(id) == NULL) {
			goto noInit;
		    } else {
			if (output_Initializer(id, output_file) == FALSE) {
			    return FALSE;
			}
		    }
		} else {
		noInit:
		    fprintf(output_file, " ()");
		}
		fprintf(output_file, ")\n");
	    }
	}
	if(EXT_PROC_DIRECTIVES(ep) != NULL){
	    FOR_ITEMS_IN_LIST(lp,EXT_PROC_DIRECTIVES(ep)){
		X_output(LIST_ITEM(lp),output_file);
	    }
	}
	fprintf(output_file,")\n");

	/* real body */
	X_output(EXT_PROC_BODY(ep),output_file);
	fprintf(output_file,"))\n");
    }

    return TRUE;
}

static void
X_output_type(tp,fp)
    TYPE_DESC tp;
    FILE *fp;
{
    if(tp == NULL){
	fprintf(output_file,"void");
	return;
    }

    switch(TYPE_BASIC_TYPE(tp)){
    case TYPE_SHORT:
	fprintf(output_file,"short");
	break;
    case TYPE_INT:
	fprintf(output_file,"int");
	break;
    case TYPE_LONGLONG:
#ifdef HAS_INT64
	fprintf(output_file,"long_long");
#else
	fatal("'long long' is not supported on this system. must not be here.");
#endif /* HAS_INT64 */
	break;
    case TYPE_REAL:
	fprintf(output_file,"float");
	break;
    case TYPE_DREAL:
	fprintf(output_file,"double");
	break;
    case TYPE_CHAR:
	if(TYPE_CHAR_LEN(tp) == 0)
	    fprintf(output_file,"char");
	else 
	    fprintf(output_file,"A%x", Addr2Uint32(tp));
	break;
    case TYPE_COMPLEX:
	fprintf(output_file,"S%x", Addr2Uint32(type_COMPLEX));
	break;
    case TYPE_DCOMPLEX:
	fprintf(output_file,"S%x", Addr2Uint32(type_DCOMPLEX));
	break;
#ifdef ENABLE_QREAL
    case TYPE_QREAL:
	fprintf(output_file,"S%x", Addr2Uint32(type_QREAL));
	break;
#endif /* ENABLE_QREAL */
	
    case TYPE_SUBR:
	fprintf(output_file, "void");
	break;

    case TYPE_LOGICAL:
	fprintf(output_file,"%s",type_LOGICAL_NAME);
	break;

    case TYPE_EQBLK:
	fprintf(fp, "U%x", Addr2Uint32(tp));
	break;

    case TYPE_FUNCTION:
	fprintf(fp,"F%x", Addr2Uint32(tp));
	break;

    case TYPE_ARRAY:
	fprintf(fp,"A%x", Addr2Uint32(tp));
	return;
	/* fall through */

    case TYPE_UNKNOWN:
	if(TYPE_REF(tp) != NULL){
	    fprintf(fp,"P%x", Addr2Uint32(tp));
	    return;
	}
	fatal("X_output_type: unknown_type");
	break;
    default:
	fatal("X_output_type: unknown_type");
	break;
    }
}

static FILE *print_fp;

static void
X_output(v,fp)
    expv v;
    FILE *fp;
{
    print_fp = fp;
    X_output_rec(v,0);
    fprintf(print_fp,"\n");
}


static void
X_output_no_indent(v,fp)
    expv v;
    FILE *fp;
{
    print_fp = fp;
    X_output_rec(v,-1);
}


static void
beginIndent(n)
    int n;
{
    int i;
    for (i = 0; i < n; i++) {
	fprintf(print_fp, "  ");
    }
}

static void
endIndent(n)
    int n;
{
    fprintf(print_fp, "%s", (n < 0) ? " " : "\n");
}

static void
X_output_rec_as_compound(v, l)
    expv v;
    int l;
{
    fprintf(print_fp, "(COMPOUND_STATEMENT (ID_LIST) (LIST) (LIST\n");
    X_output_rec(v, l + 1);
    fprintf(print_fp, "))");
}

static void
X_output_rec(v,l)
    expv v;
    int l;	/* indent level */
{
    char *expv_type_name();
    struct list_node *lp;
    TYPE_DESC tp;

    if(v == NULL){
	/* special case */
	beginIndent(l);
	fprintf(print_fp,"()");
	return;
    } else if (EXPV_CODE(v) == EXPR_STATEMENT) {
	if (EXPV_CODE(EXPR_ARG1(v)) == ASSIGN_EXPR_WITH_CHECK) {
	    int lineNo = -1;
	    if (EXPR_LINE(v) != NULL) {
		lineNo = EXPR_LINE_NO(v);
	    }
	    for (lp = EXPV_LIST(EXPR_ARG1(v)); lp != NULL; lp = lp->l_next) {
		beginIndent(l);
		fprintf(print_fp, "(EXPR_STATEMENT");
		if (lineNo > 0) {
		    fprintf(print_fp, "@%d\n", lineNo);
		} else {
		    fprintf(print_fp, "\n");
		}
		X_output_rec(lp->l_item, l + 1);
		fprintf(print_fp, ")");
		if (lp->l_next != NULL) {
		    fprintf(print_fp, "\n");
		}
	    }
	    return;
	}
    } else if (EXPV_CODE(v) == CRAY_POINTER_REF) {
	tp = EXPV_TYPE(v);
	beginIndent(l);
	fprintf(print_fp, "(CAST_EXPR:");
	X_output_type(tp, print_fp);
	fprintf(print_fp, "\n");
	X_output_rec(EXPR_ARG1(v), l + 1);
	fprintf(print_fp, ")");
	return;
    } else if (EXPV_CODE(v) == UNRESOLVED_FORMAT) {
	ID fId = EXPV_ANY(ID, EXPR_ARG1(v));
	beginIndent(l);
	if (FORMAT_STR(fId) != NULL) {
	    X_output_rec(FORMAT_STR(fId), l + 1);
	} else {
	    fatal("unresolved format still remain.");
	}
	return;
    } else if (EXPV_CODE(v) == FIRST_EXECUTION_POINT) {
	return;
    }
    
    beginIndent(l);

    /* XCODE NAME */
    fprintf(print_fp,"(%s",EXPR_CODE_NAME(EXPV_CODE(v)));
    
    tp = EXPV_TYPE(v);
    if(tp != NULL) {
	fprintf(print_fp,":");
	X_output_type(tp,print_fp);
    }


    if(EXPR_CODE_IS_TERMINAL(EXPV_CODE(v))){
	switch(EXPV_CODE(v)){
	case IDENT:		/* NAME */
	case LVAR:
	case VAR:
	case PARAM_VAR:
	case PARAM_ADDR:
	case VAR_ADDR:		/* ICON */
	case LVAR_ADDR:
	case FPARAM_VAR_ADDR:
	case ARRAY_ADDR:
	case LARRAY_ADDR:
	case FPARAM_ARRAY_ADDR:
	case FUNC_ADDR:
	    fprintf(print_fp," %s)",C_sym_name(EXPV_NAME(v)));
	    return;

	case INT_CONSTANT:
	    fprintf(print_fp," 0x%x)",EXPV_INT_VALUE(v));
	    return;
	case ID_LIST:
	    if (EXPV_ANY(void *, v) != NULL) {
		fprintf(print_fp," 0x%p)", EXPV_ANY(void *, v));
	    } else {
		fprintf(print_fp,")");
	    }
	    return;
	case STRING_CONSTANT:
	    print_string_constant(print_fp, EXPV_STR(v));
	    return;
	case LONGLONG_CONSTANT:
#ifndef HAS_INT64
	    fatal("'long long' is not supported on this system. should not be here.");
	    return;
#endif /* !HAS_INT64 */
	case FLOAT_CONSTANT:
	    fprintf(print_fp," %x %x)",
		    EXPV_LLINT_HIGH(v),EXPV_LLINT_LOW(v));
	    return;
	case ERROR_NODE:
	    fprintf(print_fp,")");
	default: {}
	}
	fatal("X_output: unknown terminal");
    }


    /* print lineno */
    if(l >= 0 && EXPR_LINE(v) != NULL){
        if(current_line == NULL ||
           EXPR_LINE_FILE_ID(v) != current_line->file_id){
            fprintf(print_fp,"@%d.%s",EXPR_LINE_NO(v),
                    FILE_NAME(EXPR_LINE_FILE_ID(v)));
        } else {
            fprintf(print_fp,"@%d",EXPR_LINE_NO(v));
        }
        current_line = EXPR_LINE(v);
    }

    /* non-terminal */
    if (EXPV_LIST(v) != NULL){
	endIndent(l);
	if (l >= 0) {
	    l++;
	}

	switch (EXPV_CODE(v)) {
	case IF_STATEMENT: {
	    int nI = 0;
	    for (lp = EXPV_LIST(v); lp != NULL; lp = lp->l_next) {
		nI++;
		if (lp->l_item == NULL) {
		    beginIndent(l);
		    fprintf(print_fp, "()");
		    continue;
		}
		switch (nI) {
		case 1: {
		    X_output_rec(lp->l_item, l);
		    endIndent(l);
		    break;
		}
		default: {
		    beginIndent(l);
		    X_output_rec_as_compound(lp->l_item, l);
		    if (lp->l_next != NULL) {
			endIndent(l);
		    }
		}
		}
	    }
	    break;
	}
	default: {
	    for(lp = EXPV_LIST(v); lp != NULL; lp=lp->l_next){
		X_output_rec(lp->l_item,l);
		if(lp->l_next != NULL){
		    endIndent(l);
		}
	    }
	    break;
	}
	}
    }
    fprintf(print_fp,")");
}

static char *C_sym_name(SYMBOL sp)
{
    static char C_name[MAX_NAME_LEN+10];
    if(sp->s_under){
	strcpy(C_name,SYM_NAME(sp));
	strcat(C_name,"_");
	return C_name;
    } 
    return SYM_NAME(sp);
}


static void
collect_types()
{
    EXT_ID ep;

    type_list = NULL;

    /* collect used types */
    for (ep = external_symbols; ep != NULL; ep = EXT_NEXT(ep)){
	if (EXT_TAG(ep) == STG_COMMON) {
	    list lp, lq;
	    ID id;
	    if (EXT_COM_LISTS(ep) != NULL) {
		FOR_ITEMS_IN_LIST(lp, EXT_COM_LISTS(ep)) {
		    FOR_ITEMS_IN_LIST(lq, EXPR_ARG2(LIST_ITEM(lp))) {
			id = EXPV_ANY(ID, LIST_ITEM(lq));
			mark_type_desc(ID_TYPE(id));
		    }
		}
	    }
	    continue;
	}
	if (EXT_TAG(ep) != STG_EXT || 
	    (!EXT_IS_DEFINED(ep) && !EXT_PROC_IS_RUNTIME(ep))) {
	    continue;
	}
	/* for defined function, mark body and id list  */
	mark_type_desc(EXT_PROC_C_TYPE(ep));
	collect_type_desc(EXT_PROC_ARGS(ep));
	mark_type_desc_in_id_list(EXT_PROC_ID_LIST(ep));
	collect_type_desc(EXT_PROC_BODY(ep));
    }
}

static void
collect_type_desc(v)
    expv v;
{
    list lp;

    if(v == NULL) return;
    mark_type_desc(EXPV_TYPE(v));
    if(EXPV_CODE(v) == UNRESOLVED_FORMAT){
	ID fId = EXPV_ANY(ID, EXPR_ARG1(v));
	if (FORMAT_STR(fId) != NULL) collect_type_desc(FORMAT_STR(fId));
    }
    if (EXPR_CODE_IS_TERMINAL(EXPV_CODE(v))) return;
    for(lp = EXPV_LIST(v); lp != NULL; lp=lp->l_next){
	collect_type_desc(lp->l_item);
    }
}

static void
mark_type_desc(tp)
    TYPE_DESC tp;
{
    if(tp == NULL) return;

    if(tp->is_referenced) return;
    tp->is_referenced = 1;	/* mark it */
    if(TYPE_REF(tp)) mark_type_desc(TYPE_REF(tp));

    if(type_list == NULL) type_list = tp;
    else TYPE_LINK(type_list_tail) = tp;
    type_list_tail = tp;
}


static void
mark_type_desc_in_id_list(idp)
    ID idp;
{
    ID idq;
    for(idq = idp; idq != NULL; idq = ID_NEXT(idq)){
	mark_type_desc(ID_TYPE(idq));
	collect_type_desc(ID_ADDR(idq));
	collect_type_desc(VAR_INIT_LIST(idq));
    }
}

/* 
 * for debug 
 */
static FILE *print_fp;

void
expv_output(x,fp)
    expv x;
    FILE *fp;
{
    print_fp = fp;
    expv_output_rec(x,0);
    fprintf(print_fp,"\n");
}

/* tree print routine */
static void
expv_output_rec(v,l)
    expv v;
    int l;
{
    int i;
    struct list_node *lp;
    TYPE_DESC tp;
    
    /* indent */
    for(i = 0; i < l; i++) fprintf(print_fp,"  ");

    if(v == NULL){
	/* special case */
	fprintf(print_fp,"()");
	return;
    }

    /* XCODE NAME */
    fprintf(print_fp,"(%s",EXPR_CODE_NAME(EXPV_CODE(v)));

    tp = EXPV_TYPE(v);
    if(tp != NULL) {
	fprintf(print_fp,":");
	expv_output_type(tp,print_fp);
    }

    if(EXPR_CODE_IS_TERMINAL(EXPV_CODE(v))){
	switch(EXPV_CODE(v)){
	case IDENT:		/* NAME */
	case VAR_ADDR:		/* ICON */
	case LVAR_ADDR:
	case PARAM_ADDR:
	case PARAM_VAR:
	case LVAR:
	case VAR:
	case ARRAY_ADDR:
	case LARRAY_ADDR:
	case FUNC_ADDR:
	case FPARAM_ARRAY_ADDR:
	case FPARAM_VAR_ADDR:
	    fprintf(print_fp," %s)",SYM_NAME(EXPV_NAME(v)));
	    return;

	case INT_CONSTANT:
	    fprintf(print_fp," %x)",EXPV_INT_VALUE(v));
	    return;

	case ID_LIST:
	    if (EXPV_ANY(void *, v) != NULL) {
		fprintf(print_fp, " 0x%p)", EXPV_ANY(void *, v));
	    } else {
		fprintf(print_fp, ")");
	    }
	    return;

	case STRING_CONSTANT:
#if 0
	    fprintf(print_fp," \"%s\")",EXPV_STR(v));
#else
	    print_string_constant(print_fp, EXPV_STR(v));
#endif
	    return;
	case LONGLONG_CONSTANT:
#ifndef HAS_INT64
	    fatal("'long long' is not supported on this system. should not be here.");
	    return;
#endif /* !HAS_INT64 */
	case FLOAT_CONSTANT:
	    fprintf(print_fp," %x %x)",
		    EXPV_LLINT_HIGH(v),EXPV_LLINT_LOW(v));
	    return;
	case ERROR_NODE:
	    fprintf(print_fp,")");
	default: {}
	}
	fatal("expv_output: unknown terminal");
    }

    if(EXPV_LIST(v) != NULL){
	if(l < 0) fprintf(print_fp," ");
	else {
	    fprintf(print_fp,"\n");
	    l++;
	} 
	for(lp = EXPV_LIST(v); lp != NULL; lp=lp->l_next){
	    expv_output_rec(lp->l_item,l);
	    if(lp->l_next != NULL){
		if(l < 0) fprintf(print_fp," ");
		else fprintf(print_fp,"\n");
	    }
	}
    }
    fprintf(print_fp,")");
}


static void
expv_output_type(tp,fp)
    TYPE_DESC tp;
    FILE *fp;
{
    print_type(tp,fp); /* temporary */
}

/* for debug */
static void
print_ID(id,fp)
    ID id;
    FILE *fp;
{
    fprintf(fp,"'%s',class=%s,",ID_NAME(id),name_class_name(ID_CLASS(id)));
    fprintf(fp,"type=");
    print_type(ID_TYPE(id),fp);
    fprintf(fp,"\n");
    switch(ID_CLASS(id)){
    case CL_VAR:
    case CL_PROC:
    default: {}
    }
}

void
print_IDs(ip,fp)
    ID ip;
    FILE *fp;
{
    for( ; ip != NULL; ip = ID_NEXT(ip)) print_ID(ip,fp);
    fflush(fp);
}


static void
print_type(tp,fp)
    TYPE_DESC tp;
    FILE *fp;
{
    if(tp == NULL){
	fprintf(fp,"{<NULL>}");
	return;
    }
    if(TYPE_N_DIM(tp) != 0){
	fprintf(fp,"{array(dim=%d):",TYPE_N_DIM(tp));
	print_type(TYPE_REF(tp),fp);
	fprintf(fp,"}");
    } else if(TYPE_REF(tp)){
	/* this is pointer type */
	fprintf(fp,"{pointer:");
	print_type(TYPE_REF(tp),fp);
	fprintf(fp,"}");
    } else if(TYPE_BASIC_TYPE(tp) == TYPE_CHAR){
	fprintf(fp,"{character(%d)}",TYPE_CHAR_LEN(tp));
    } else {
	fprintf(fp,"{%s}",basic_type_name(TYPE_BASIC_TYPE(tp)));
    }
}

char *basic_type_names[] = BASIC_TYPE_NAMES;
char *
basic_type_name(t)
    BASIC_DATA_TYPE t;
{
    return basic_type_names[(int)t];
}

char *name_class_names[] = NAME_CLASS_NAMES;
char *
name_class_name(c)
    enum name_class c;
{
    return name_class_names[(int)c];
}

char *proc_class_names[] = PROC_CLASS_NAMES;
char *
proc_class_name(c)
    enum proc_class c;
{
    return proc_class_names[(int)c];
}

char *storage_class_names[] = STORAGE_CLASS_NAMES;
char *
storage_class_name(c)
    enum storage_class c;
{
    return storage_class_names[(int)c];
}