static char rcsid[] = "$Id: F-equiv.c,v 1.21 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"

static int dumId = 0;
static expv equivTop = NULL;

static ID	dummyVariable _ANSI_ARGS_((char *name, int len, 
					   ID eqId, enum storage_class stClass,
					   EXT_ID commonId, int structRef));

static char idxStrBuf[4096];
static char *
idxToStr(v)
     expr v;
{
    list lp;
    char buf[4096];
    int len;
    memset(idxStrBuf, 0, 4096);

    FOR_ITEMS_IN_LIST(lp, v) {
	sprintf(buf, "%d,", EXPV_INT_VALUE(LIST_ITEM(lp)));
	strcat(idxStrBuf, buf);
    }
    len = strlen(idxStrBuf);
    idxStrBuf[len - 1] = '\0';

    return idxStrBuf;
}


static expv
findIdNodeById2(node, id)
     expv node;
     ID id;
{
    list lp;
    expv v;

    if (EQUIV_NODE_ID(node) == id) {
	return node;
    }

    FOR_ITEMS_IN_LIST(lp, node) {
	v = LIST_ITEM(lp);

	switch (EXPR_CODE(v)) {
	    case LIST: {
		if (EQUIV_NODE_ID(v) == id) {
		    return v;
		} else {
		    expv find = findIdNodeById2(v, id);
		    if (find != NULL) {
			return find;
		    }
		}
		break;
	    }
	    case ID_LIST:
	    case INT_CONSTANT: {
		break;
	    }
	    default: {
		fatal("not an equiv tree??");
		break;
	    }
	}
    }
    
    return NULL;
}


static expv
findNodeById(id, topNodePtr)
     ID id;
     expv *topNodePtr;
{
    list lp;
    expv ret = NULL;
    expv top = NULL;
    expv x;
    
    FOR_ITEMS_IN_LIST(lp, equivTop) {
	x = LIST_ITEM(lp);
	ret = findIdNodeById2(x, id);
	if (ret != NULL) {
	    top = x;
	    break;
	}
    }
    if (topNodePtr != NULL) {
	*topNodePtr = top;
    }
    return ret;
}


static expv
findParentNode(child, top)
     expv child;
     expv top;
{
    list lp;
    expv v;
    
    if (EQUIV_NODE_ID(child) == EQUIV_NODE_ID(top)) {
	return top;
    }

    FOR_ITEMS_IN_LIST(lp, top) {
	v = LIST_ITEM(lp);

	switch (EXPR_CODE(v)) {
	    case LIST: {
		if (EQUIV_NODE_ID(v) == EQUIV_NODE_ID(child)) {
		    return top;
		} else {
		    expv find = findParentNode(child, v);
		    if (find != NULL) {
			return find;
		    }
		}
		break;
	    }
	    case ID_LIST:
	    case INT_CONSTANT: {
		break;
	    }
	    default: {
		fatal("not an equiv tree??");
	    }
	}
    }

    return NULL;
}
	

static int
getNodeOffset(node, top)
     expv node;
     expv top;
{
    int ret = 0;
    expv parent = node;
    expv tmp;

    while (parent != top) {
	ret += EQUIV_NODE_OFFSET(parent);
	tmp = findParentNode(parent, top);
	if (tmp == NULL) {
	    fatal("can't get parent in equiv tree??");
	}
	parent = tmp;
    }
    return ret;
}


static void
addTopNode(v)
     expv v;
{
    equivTop = list_put_last(equivTop, v);
}


static expv
deleteTopNode(v)
     expv v;
{
    (void)list_delete_item(equivTop, v);
    return v;
}


static void
addNode(node, v)
     expv node;
     expv v;
{
    (void)list_put_last(node, v);
}


static expv
genEquivNode(id, offset, size)
     ID id;
     int offset;
     int size;
{
    return list3(LIST,
		 expv_any_term(ID_LIST, (void *)id),
		 expv_int_term(INT_CONSTANT, type_INT, offset),
		 expv_int_term(INT_CONSTANT, type_INT, size));
}


static expv
adjustOffset(eSpec)
     expv eSpec;
{
    int substOffset = EXPV_INT_VALUE(EXPR_ARG2(EXPR_ARG1(eSpec)));
    list lp;
    FOR_ITEMS_IN_LIST(lp, eSpec) {
#if 0
	EXPV_INT_VALUE(EXPR_ARG2(LIST_ITEM(lp))) =
		substOffset - EXPV_INT_VALUE(EXPR_ARG2(LIST_ITEM(lp)));
#else
	EXPV_GEN(EXPR_ARG2(LIST_ITEM(lp))) = 
		(void *)((_omAddrInt_t)(substOffset - EXPV_INT_VALUE(EXPR_ARG2(LIST_ITEM(lp)))));
#endif
    }
    return eSpec;
}


static ID
getOffsetAndSize(x, offPtr, szPtr)
     expr x;
     int *offPtr;
     int *szPtr;
{
    ID id = NULL;
    expv aSpec = expr_array_spec_list(x, &id);
    int offset = 0;
    int size;
#if 0
    int basicLen;
#endif
    int numElem = 1;

    if (id == NULL) {
	return NULL;
    }
    size = type_length(ID_TYPE(id));
#if 0
    basicLen = basic_type_size(getBasicType(ID_TYPE(id)));
#endif
    if (aSpec != NULL) {
	list lq;
	FOR_ITEMS_IN_LIST(lq, EXPR_ARG2(aSpec)) {
	    numElem *= EXPV_INT_VALUE(EXPR_ARG1(LIST_ITEM(lq)));
	}
    }

    /*
     * Compute an offset.
     */
    switch (EXPR_CODE(x)) {
	case IDENT: {
	    /*
	     * Always zero even if the variable is an array.
	     */
	    offset = 0;
	    break;
	}
	case F_ARRAY_REF: {
	    expv idxV;
	    
	    if (aSpec == NULL) {
		error("'%s' is not an array.", ID_NAME(id));
		return NULL;
	    }
	    idxV = expr_array_index(x);
	    if (idxV == NULL) {
		return NULL;
	    }
	    offset = compute_element_offset(aSpec, idxV);
	    if (offset < 0) {
		return NULL;
	    }
	    if (offset >= numElem) {
		error("element index range error, %s(%s) -> %d >= %d.",
		      ID_NAME(id), idxToStr(idxV), offset, numElem);
		return NULL;
	    }
	    offset *= (size / numElem);
	    break;
	}
	case F_SUBSTR_REF: {
	    expr offX = EXPR_ARG1(EXPR_ARG2(x));
	    if (aSpec != NULL) {
		error("'%s' is an array.", ID_NAME(id));
		return NULL;
	    }
	    if (offX == NULL) {
		offset = 0;
		break;
	    } else {
		expv offV = expv_reduce(compile_expression(offX));
#ifdef HAS_INT64
		if (EXPR_CODE(offV) == INT_CONSTANT) {
		    offset = EXPV_INT_VALUE(offV) - 1;
		} else if (EXPR_CODE(offV) == LONGLONG_CONSTANT) {
		    offset = ((int)EXPV_INT64_VALUE(offV)) - 1;
		} else {
		    error("invalid substring expression.");
		    return NULL;
		}
#else
		if (EXPR_CODE(offV) != INT_CONSTANT) {
		    error("invalid substring expression.");
		    return NULL;
		}
		offset = EXPV_INT_VALUE(offV) - 1;
#endif /* HAS_INT64 */
		if (offset < 0) {
		    error("substring range error (%d).", offset);
		    return NULL;
		} else if (offset >= size) {
		    error("substring range error (%d >= %d).", offset, size);
		    return NULL;
		}
	    }
	    break;
	}
	default: {
	    fatal("what?? this must not happen!!");
	}
    }

    if (offPtr != NULL) {
	*offPtr = offset;
    }
    if (szPtr != NULL) {
	*szPtr = size;
    }

    return id;
}


static void
compileEquiv(specList, byDATAstate)
     expr specList;
     int byDATAstate;
{
    expv eSpec = list0(LIST);
    expv x;
    ID id;
    list lp;
    int size;
    int offset;
    ID substId = NULL;
    expv substTopNode;
    expv substNode;
    ID aliasId;
    expv aliasTopNode;
    expv aliasNode;
    BASIC_DATA_TYPE substType;
    BASIC_DATA_TYPE aliasType;

    /*
     * Phase 1: check the list are made of variable, and duplication.
     */
    FOR_ITEMS_IN_LIST(lp, specList) {
	x = LIST_ITEM(lp);
	if (expr_is_variable(x, TRUE, &id) == FALSE) {
	    if (id != NULL) {
		if (ID_CLASS(id) == CL_PROC) {
		    if (PROC_CLASS(id) == P_THISPROC) {
			error("can't allocate euivalence storage to '%s'.", ID_NAME(id));
			return;
		    }
		}
		error("'%s' is not a variable.", ID_NAME(id));
	    } else {
		error("not a variable.");
	    }
	    return;
	}
	id = getOffsetAndSize(x, &offset, &size);
	eSpec = list_put_last(eSpec, genEquivNode(id, offset, size));
	VAR_EQUIV_BY_DATA(id) = byDATAstate;
    }
    
    /*
     * Phase 2: adjust offset as relative to substantial variable. The
     * substantial variable is the first argument of equivalence
     * statement.
     */
    eSpec = adjustOffset(eSpec);

    /*
     * Phase 3: Check the substance is already registerd. If not, add
     * new.
     */
    substId = EXPV_ANY(ID, EXPR_ARG1(EXPR_ARG1(eSpec)));
    substNode = findNodeById(substId, &substTopNode);
    if (substNode == NULL) {
	substTopNode = EXPR_ARG1(eSpec);
	addTopNode(substTopNode);
	substNode = findNodeById(substId, &substTopNode);
    }
    substType = getBasicType(ID_TYPE(substId));

    /*
     * Phase 4: Add each variables into equiv-tree. Top nodes might be
     * merged into sigle tree.
     */
    FOR_ITEMS_IN_LIST(lp, eSpec) {
	x = LIST_ITEM(lp);
	aliasId = EXPV_ANY(ID, EXPR_ARG1(x));
	aliasTopNode = NULL;
	aliasNode = findNodeById(aliasId, &aliasTopNode);
	aliasType = getBasicType(ID_TYPE(aliasId));
	if (doPedanticEquiv == TRUE) {
	    if (BASIC_IS_CHAR(substType) || BASIC_IS_CHAR(aliasType)) {
		if (substType != aliasType) {
		    error ("to be equivalent '%s'(%s) to '%s'(%s) is not allowed.",
			   ID_NAME(substId), basic_type_name(substType),
			   ID_NAME(aliasId), basic_type_name(aliasType));
		    return;
		}
	    }
	}
	if (aliasNode == NULL) {
	    /*
	     * Welcome newcommer. Just add into tree.
	     */
	    addNode(substNode, x);
	} else {
	    int oldOff = getNodeOffset(aliasNode, aliasTopNode);
	    int newOff = getNodeOffset(substNode, substTopNode) +
	    	EXPV_INT_VALUE(EXPR_ARG2(x));
	    if (aliasTopNode == substTopNode) {
		/*
		 * Both already are in same branch. Just only checking
		 * offset validness, No need to append.
		 */
		if (oldOff != newOff) {
		    if (aliasId == substId) {
			error("inconsistent equivalence for '%s'.", ID_NAME(substId));
		    } else {
			error("inconsistent equivalence between '%s' and '%s'.",
			      ID_NAME(substId), ID_NAME(aliasId));
		    }
		    return;
		}
	    } else {
		/*
		 * Not in same branch. Merge the branches.
		 */
		(void)deleteTopNode(aliasTopNode);
#if 0
		EXPV_INT_VALUE(EXPR_ARG2(aliasTopNode)) -= (oldOff - newOff);
#else
		EXPV_GEN(EXPR_ARG2(aliasTopNode)) = 
			(void *)((_omAddrInt_t)(EXPV_INT_VALUE(EXPR_ARG2(aliasTopNode)) -
						(oldOff - newOff)));
#endif
		addNode(substTopNode, aliasTopNode);
	    }
	}
    }
}


static void
serializeNode3(ret, v, top)
     expv ret;
     expv v;
     expv top;
{
    list lp;
    expv vv;

    if (ret == NULL) {
	ret = list0(LIST);
    }

    FOR_ITEMS_IN_LIST(lp, v) {
	vv = LIST_ITEM(lp);

	switch (EXPR_CODE(vv)) {
	    case LIST: {
		ret = list_put_last(ret,
				    genEquivNode(EQUIV_NODE_ID(vv),
						 getNodeOffset(vv, top),
						 EQUIV_NODE_SIZE(vv)));
		serializeNode3(ret, vv, top);
	    }
	    case ID_LIST:
	    case INT_CONSTANT: {
		break;
	    }
	    default: {
		fatal("not equiv tree node??");
	    }
	}
    }
}


static int equivStructTagId = 1;
static ID
genEquivalenceId()
{
    ID id;
    char eqNameBuf[4096];

    sprintf(eqNameBuf, "__Equiv_%d_%d", current_proc_no, equivStructTagId);
    id = declare_ident(c_find_symbol(eqNameBuf), CL_VAR);
    ID_STORAGE(id) = STG_EQBLK;
    declare_variable(id);
    VAR_EQUIV_TYPE(id) = EQUIV_TYPE_PURE;
    VAR_EQUIV_IS_STRING(id) = FALSE;
    VAR_EQUIV_IS_DUMMY(id) = TRUE;
    ID_TYPE(id) = type_equiv();
    TYPE_EQUIV_ID(ID_TYPE(id)) = (void *)id;
    return id;
}


#define curProcBit	12
#define structIdBit	10

#define curProcShift	curProcBit
#define curProcMask	((1 << curProcShift) - 1)

#define structIdShift	(curProcBit + structIdBit)
#define structIdMask	(((1 << (structIdShift)) - 1) & ~(curProcMask))

#define localIdMask	((~0) & ~((1 << (structIdShift)) - 1))

static int
genStructRefId(localId)
     int localId;
{
    int ret = 
    ((localId << structIdShift) & localIdMask) |
    ((equivStructTagId << curProcShift) & structIdMask) | 
    (current_proc_no & curProcMask);
#if 0
    fprintf(stderr, "debug: struct ref ID 0x%08lx (localId 0x%08lx, tag 0x%08lx, proc 0x%08lx)\n",
	    ret,
	    localId,
	    equivStructTagId,
	    current_proc_no);
#endif
    return ret;
}


int
getProcNoFromStructRefId(refId)
     int refId;
{
    return refId & curProcMask;
}


static ID
dummyVariable(name, len, eqId, stClass, commonId, structRef)
     char *name;
     int len;	/* size in byte */
     ID eqId;
     enum storage_class stClass;
     EXT_ID commonId;
     int structRef;
{
    ID id = declare_ident(c_find_symbol(name), CL_VAR);
    
    ID_IS_DECLARED(id) = FALSE;
    ID_STORAGE(id) = stClass;
    VAR_EQUIV_ID(id) = eqId;
    VAR_EQUIV_IS_DUMMY(id) = TRUE;
    VAR_COM_NAME(id) = commonId;
    VAR_EQUIV_STRUCT_NO(id) = structRef;
    ID_TYPE(id) = type_char(len);
    declare_variable(id);
    return id;
}


static expv
genStruct(v, max, needNULL)
     expv v;
     int max;
     int needNULL;
{
    int offset = EQUIV_NODE_OFFSET(v);
    int size = EQUIV_NODE_SIZE(v);
    int fill = 0;
    ID eqId = VAR_EQUIV_ID(EQUIV_NODE_ID(v));
    expv offsetIdV = NULL;
    expv fillIdV = NULL;
    expv ret = list0(LIST);
    int structNo = VAR_EQUIV_STRUCT_NO(EQUIV_NODE_ID(v));
    EXT_ID commonId = VAR_COM_NAME(EQUIV_NODE_ID(v));
    enum storage_class stClass = ID_STORAGE(EQUIV_NODE_ID(v));
    char buf[4096];
    
    if (offset > 0) {
	sprintf(buf, "__offset%d", dumId++);
	offsetIdV = genEquivNode(dummyVariable(buf, offset, eqId,
					       stClass, commonId, structNo),
				 0,
				 offset);
    }
    if (needNULL == TRUE || offsetIdV != NULL) {
	ret = list_put_last(ret, offsetIdV);
    }

    ret = list_put_last(ret, v);

    fill = max - size - offset;
    if (fill > 0) {
	sprintf(buf, "__fill%d", dumId++);
	fillIdV = genEquivNode(dummyVariable(buf, fill, eqId,
					     stClass, commonId, structNo),
			       offset + size,
			       fill);
    }
    if (needNULL == TRUE || fillIdV != NULL) {
	ret = list_put_last(ret, fillIdV);
    }

    return ret;
}


#define ROUND(a, b)	(b * ((a + b - 1) / b))
int
getIdOffsetInCommon(commonId, id)
     EXT_ID commonId;
     ID id;
{
    int structTag = VAR_EQUIV_STRUCT_NO(id);
    list lp;
    expv comList = EXT_COM_LISTS(commonId);
    expv v = NULL;
    int offset = 0;
    ID comVarId = NULL;
    int tmpOff, align;

    FOR_ITEMS_IN_LIST(lp, comList) {
	if (EXPV_INT_VALUE(EXPR_ARG1(LIST_ITEM(lp))) == structTag) {
	    v = EXPR_ARG2(LIST_ITEM(lp));
	    break;
	}
    }
    if (v == NULL) {
	fatal("'%s' is not in common block '%s'??",
	      SYM_NAME(ID_SYM(id)),
	      getCommonNameFromExtId(commonId));
    }

    FOR_ITEMS_IN_LIST(lp, v) {
	comVarId = (ID)EXPV_ANY(ID, LIST_ITEM(lp));
	if (comVarId == id) {
	    break;
	}
	tmpOff = type_length(ID_TYPE(comVarId));
	if (tmpOff < 0) {
	    error("adjustable array in common, %s",
		  SYM_NAME(ID_SYM(comVarId)));
	    return -1;
	}
	align = type_align(ID_TYPE(comVarId));
	if (offset % align != 0) {
	    offset = ROUND(offset, align);
	}
	offset += tmpOff;
    }
    return ROUND(offset, type_align(ID_TYPE(id)));
}

static int
mergeEquivToCommon(equivId, comVarId, eqOffset, eqLen, eqVarV, commonId)
     ID equivId;
     ID comVarId;
     int eqOffset;
     int eqLen;
     expv eqVarV;
     EXT_ID commonId;
{
    int comOffset = getIdOffsetInCommon(commonId, comVarId);
    int offDiff = 0;
    expv v;
    int newMax = 0;
    list lp, lq;
    expv newCom;
    expv strV;
    expv tmp;

    if (comOffset < 0) {
	return FALSE;
    }

    offDiff = comOffset - eqOffset;
    if (offDiff < 0) {
	error("backward extension (%d bytes from top) occurs in common block '%s'",
	      offDiff,
	      getCommonNameFromExtId(commonId));
	return FALSE;
    }

    /*
     * Adjust equivalence variables offset to common block offset.
     */
    FOR_ITEMS_IN_LIST(lp, eqVarV) {
	v = LIST_ITEM(lp);
#if 0
	EQUIV_NODE_OFFSET(v) += offDiff;
#else
	EXPV_GEN(__Eq_Node_OffV(v)) =
		(void *)((_omAddrInt_t)(EQUIV_NODE_OFFSET(v) + offDiff));
#endif
    }

    /*
     * Compute new common size.
     */
    newMax = eqLen - eqOffset + offDiff;
    if (newMax > EXT_COM_LEN(commonId)) {
	warning("common block '%s' is extended (forward extension) from %d bytes to %d bytes by common/equivalence sharing.",
		getCommonNameFromExtId(commonId),
		EXT_COM_LEN(commonId),
		newMax);
	EXT_COM_LEN(commonId) = newMax;
    } else {
	newMax = EXT_COM_LEN(commonId);
    }

    /*
     * OK, merge'em.
     */
    FOR_ITEMS_IN_LIST(lp, eqVarV) {
	v = LIST_ITEM(lp);
	if (EQUIV_NODE_ID(v) != comVarId) {
	    newCom = list1(LIST,
			   expv_int_term(INT_CONSTANT, type_INT,
					 VAR_EQUIV_STRUCT_NO(EQUIV_NODE_ID(v))));
	    strV = genStruct(v, newMax, FALSE);
	    tmp = list0(LIST);
	    FOR_ITEMS_IN_LIST(lq, strV) {
		tmp = list_put_last(tmp,
				    expv_any_term(ID_LIST,
						  (void *)EQUIV_NODE_ID(LIST_ITEM(lq))));
	    }
	    newCom = list_put_last(newCom, tmp);
	    EXT_COM_LISTS(commonId) = 
	    list_put_last(EXT_COM_LISTS(commonId), newCom);
	}
    }

    return TRUE;
}


static expv
serializeTopNode(top)
     expv top;
{
    list lp;
    expv v;
    int min = INT_MAX;
    int max = INT_MIN;
    int tmpMax;
    ID equivId;
    ID id;
    int equivStructNo = 1;
    expv sTop = list1(LIST,
		      genEquivNode(EQUIV_NODE_ID(top),
				   EQUIV_NODE_OFFSET(top),
				   EQUIV_NODE_SIZE(top)));
    expv ret = NULL;
    expv retList = NULL;
    int isCommon = FALSE;
    int nNode = 0;
    int nStrNode = 0;
    int isString = FALSE;
    enum storage_class stClass = STG_EQUIV;
    TYPE_DESC tp;
    EXT_ID commonId = NULL;
    ID inCommonTagId = NULL;
    expv inCommonTagV = NULL;
    int isSaved = FALSE;

    serializeNode3(sTop, top, top);

    /*
     * Fix the offsets as zero origin, and check some statuses.
     */
    FOR_ITEMS_IN_LIST(lp, sTop) {
	v = LIST_ITEM(lp);
	if (EQUIV_NODE_OFFSET(v) < min) {
	    min = EQUIV_NODE_OFFSET(v);
	}
	if (BASIC_IS_CHAR(getBasicType(ID_TYPE(EQUIV_NODE_ID(v))))) {
	    nStrNode++;
	}
	if (ID_STORAGE(EQUIV_NODE_ID(v)) == STG_COMMON ||
	    ID_STORAGE(EQUIV_NODE_ID(v)) == STG_COMEQ) {
	    isCommon = TRUE;
	}
	id = EQUIV_NODE_ID(v);
	if (VAR_IS_SAVE(EQUIV_NODE_ID(v)) == TRUE ||
	    ID_STORAGE(id) == STG_BSS) {
	    isSaved = TRUE;
	}
	nNode++;
    }
    if (doPedanticEquiv == TRUE) {
	if (nStrNode > 0 && nStrNode != nNode) {
	    fatal("This must not happen. character/non-character equivalence");
	} else {
	    isString = TRUE;
	}
    }
    FOR_ITEMS_IN_LIST(lp, sTop) {
	v = LIST_ITEM(lp);
#if 0
	EQUIV_NODE_OFFSET(v) -= min;
#else
	EXPV_GEN(__Eq_Node_OffV(v)) =
		(void *)((_omAddrInt_t)(EQUIV_NODE_OFFSET(v) - min));
#endif
    }

    equivId = genEquivalenceId();
    VAR_IS_SAVE(equivId) = isSaved;
    if (isCommon == TRUE) {
	int i;
	EXT_ID tmpComId;

	stClass = STG_COMEQ;
	VAR_EQUIV_TYPE(equivId) = EQUIV_TYPE_COM;

	/*
	 * Make sure only ONE common variable is in the equivalence.
	 */
	lp = EXPR_LIST(sTop);
	for (i = 0; (i < nNode && lp != NULL); i++, lp = LIST_NEXT(lp)) {
	    v = LIST_ITEM(lp);
	    if (ID_STORAGE(EQUIV_NODE_ID(v)) == STG_COMMON ||
		ID_STORAGE(EQUIV_NODE_ID(v)) == STG_COMEQ) {
		tmpComId = VAR_COM_NAME(EQUIV_NODE_ID(v));
		if (tmpComId != NULL) {
		    if (commonId == NULL) {
			commonId = tmpComId;
			inCommonTagV = v;
			inCommonTagId = EQUIV_NODE_ID(v);
			continue;
		    } else {
			if (commonId != tmpComId) {
			    error("'%s' and '%s' are in different common block.",
				  SYM_NAME(ID_SYM(EQUIV_NODE_ID(v))),
				  SYM_NAME(ID_SYM(inCommonTagId)));
			    return NULL;
			} 
#ifdef not
			else {
			    if (ID_STORAGE(EQUIV_NODE_ID(v)) == STG_COMMON) {
				error("'%s' and '%s' are in same common block.",
				      SYM_NAME(ID_SYM(EQUIV_NODE_ID(v))),
				      SYM_NAME(ID_SYM(inCommonTagId)));
				return NULL;
			    }
			}
#endif
		    }
		}
	    }
	}
    } else {
	stClass = STG_EQUIV;
	VAR_EQUIV_TYPE(equivId) = EQUIV_TYPE_PURE;
    }
    VAR_EQUIV_IS_STRING(equivId) = isString;
    ID_IS_DECLARED(equivId) = FALSE;
    if (declare_variable(equivId) == NULL) {
	fatal("can't create shared storage for equivalence??");
    }

    /*
     * Compute size of the equivalence block, and set some statuses.
     */
    FOR_ITEMS_IN_LIST(lp, sTop) {
	v = LIST_ITEM(lp);
	tmpMax = EQUIV_NODE_OFFSET(v) + EQUIV_NODE_SIZE(v);
	if (max < tmpMax) {
	    max = tmpMax;
	}
	ID_IS_DECLARED(EQUIV_NODE_ID(v)) = FALSE;
	ID_STORAGE(EQUIV_NODE_ID(v)) = stClass;
	VAR_EQUIV_ID(EQUIV_NODE_ID(v)) = equivId;
	if (isCommon == FALSE) {
	    VAR_EQUIV_STRUCT_NO(EQUIV_NODE_ID(v)) = equivStructNo++;
	} else {
	    VAR_COM_NAME(EQUIV_NODE_ID(v)) = commonId;
	    if (inCommonTagId != EQUIV_NODE_ID(v)) {
		/* Make special OR'd ID for struct/union refference */
		VAR_EQUIV_STRUCT_NO(EQUIV_NODE_ID(v)) = genStructRefId(equivStructNo++);
	    }
	}
	tp = ID_TYPE(EQUIV_NODE_ID(v));
	declare_id_type(EQUIV_NODE_ID(v), tp);
	if (declare_variable(EQUIV_NODE_ID(v)) == NULL) {
	    fatal("equivalence failed?? no variable id");
	}
    }

    /*
     * OK, party time.
     */
    ret = list0(LIST);
    ret = list_put_last(ret, expv_any_term(ID_LIST, (void *)equivId));
    ret = list_put_last(ret, expv_int_term(INT_CONSTANT, type_INT, max));
    retList = list0(LIST);

    /*
     * Add whole size node for DATA statement.
     */
    if (isCommon == FALSE) {
	expv wV;
	char buf[4096];

	sprintf(buf, "__whole%d", dumId++);
	wV = genEquivNode(dummyVariable(buf, max, equivId,
					stClass, commonId, 0),
			  0, max);
	retList = list_put_last(retList, list3(LIST, NULL, wV, NULL));
    }

    /*
     * Add all node.
     */
    FOR_ITEMS_IN_LIST(lp, sTop) {
	retList = list_put_last(retList,
				genStruct(LIST_ITEM(lp), max, TRUE));
    }

    ret = list_put_last(ret, retList);

    VAR_EQUIV_SPEC(equivId) = ret;

    equivStructTagId++;

    if (isCommon == TRUE) {
	if (mergeEquivToCommon(equivId, inCommonTagId,
			       EQUIV_NODE_OFFSET(inCommonTagV),
			       max, sTop, commonId) == TRUE) {
	    return ret;
	} else {
	    return NULL;
	}
    }

    return ret;
}


void
compile_EQUIVALENCE_decl(x, byDATAstate)
     expr x;
     int byDATAstate;
{
    list lp;
    expr y;

    if (EXPR_CODE(x) != LIST) {
	fatal("paser error in equivalence??");
    }

    FOR_ITEMS_IN_LIST(lp, x) {
	y = LIST_ITEM(lp);
	if (EXPR_CODE(y) != LIST) {
	    fatal("paser error in equivalence??");
	}
	compileEquiv(y, byDATAstate);
    }
}


void
InitializeEquivalence()
{
    equivTop = list0(LIST);
    dumId = 0;
    equivStructTagId = 1;
}


void
FinalizeEquivalence()
{
    list lp;
    expv v;

    FOR_ITEMS_IN_LIST(lp, equivTop) {
	v = serializeTopNode(LIST_ITEM(lp));
	if (v == NULL) {
	    continue;
	}
    }
}