static char rcsid[] = "$Id: F-iosub.c,v 1.11 2000/12/09 04:14:26 m-hirano 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 struct ioSpecifierRec {
    int id;
    char *str;
} ioSpecifiers[] = {
    { 0, "UNIT" },
    { 1, "FMT" },
    { 2, "REC" },
    { 3, "IOSTAT" },
    { 4, "ERR" },
    { 5, "END" },
    { 6, "FILE" },
    { 7, "STATUS" },
    { 8, "ACCESS" },
    { 9, "FORM" },
    { 10, "RECL" },
    { 11, "BLANK" },
    { 12, "EXIST" },
    { 13, "OPENED" },
    { 14, "NUMBER" },
    { 15, "NAMED" },
    { 16, "NAME" },
    { 17, "SEQUENTIAL" },
    { 18, "DIRECT" },
    { 19, "FORMATTED" },
    { 20, "UNFORMATTED" },
    { 21, "NEXTREC" },
    { 22, "NML" },
    { 23, NULL }
};


static int
specStrToSpecId(str)
     char *str;
{
    int i;

    for (i = 0; i < IO_SPEC_UNKNOWN; i++) {
	if (strcasecmp(str, ioSpecifiers[i].str) == 0) {
	    return ioSpecifiers[i].id;
	}
    }
    
    return IO_SPEC_UNKNOWN;
}


static char *
specIdToSpecStr(id)
     int id;
{
    int i;

    for (i = 0; i < IO_SPEC_UNKNOWN; i++) {
	if (ioSpecifiers[i].id == id) {
	    return ioSpecifiers[i].str;
	}
    }

    return NULL;
}


expv
NormalizeIoSpecifier(x)
     expr x;
{
    expv ret = list0(LIST);
    expr ioSpec = EXPR_ARG1(x);
    list lp;
    expr tmp;
    int gotAmbigUNIT = FALSE;
    int id;
    expr specVal;
    int n = 0;
    int max = 0;
    int *idList;
    int i;

    FOR_ITEMS_IN_LIST(lp, ioSpec) {
	max++;
    }
    idList = (int *)malloc(sizeof(int) * max);

    FOR_ITEMS_IN_LIST(lp, ioSpec) {
	id = IO_SPEC_UNKNOWN;
	specVal = NULL;

	tmp = LIST_ITEM(lp);

	if (tmp == NULL) {
	    goto AmbigExpr;
	}
	if (EXPR_CODE(tmp) == F_SET_EXPR) {
	    if (EXPR_CODE(EXPR_ARG1(tmp)) != IDENT) {
		fatal("parser error???\n");
	    }
	    id = specStrToSpecId(SYM_NAME(EXPR_SYM(EXPR_ARG1(tmp))));
	    if (id == IO_SPEC_UNKNOWN) {
		error("unknown I/O specifier \"%s\".",
		      SYM_NAME(EXPR_SYM(EXPR_ARG1(tmp))));
		return NULL;
	    }

	    for (i = 0; i < n; i++) {
		if (idList[i] == id) {
		    error("\"%s\" is already specified.",
			  specIdToSpecStr(id));
		    return NULL;
		}
	    }
	    specVal = EXPR_ARG2(tmp);
	} else {
	    AmbigExpr:
	    if (n == 0) {
		gotAmbigUNIT = TRUE;
		id = IO_SPEC_UNIT;
	    } else if (n == 1) {
		if (gotAmbigUNIT == TRUE) {
		    if (tmp == NULL ||
			EXPR_CODE(tmp) != IDENT) {
			id = IO_SPEC_FMT;
		    } else {
			ID tId = declare_ident(EXPR_SYM(tmp), CL_UNKNOWN);
			if (ID_CLASS(tId) == CL_NAMELIST) {
			    id = IO_SPEC_NML;
			} else {
			    id = IO_SPEC_FMT;
			}
		    }   
		} else {
		    error("the first specifier is not unit specifier without \"UNIT=\".");
		    return NULL;
		}
	    } else {
		error("only the first (unit) and the second (format/namelist) specifiers are allowed to ommit \"UNIT=\" and \"FMT=/NML=\".");
		return NULL;
	    }
	    specVal = tmp;
	}

	ret = list_put_last(ret, list2(LIST,
				       expv_int_term(INT_CONSTANT, type_INT, id),
				       specVal));
	idList[n] = id;
	n++;
    }

    free(idList);
    return ret;
}


int
CheckIoSpecifierSanity(ioList, ids, n)
     expv ioList;
     int *ids;
     int n;
{
    int i;
    list lp;
    expv tmp;
    int found;
    
    FOR_ITEMS_IN_LIST(lp, ioList) {
	tmp = EXPR_ARG1(LIST_ITEM(lp));
	found = 0;
	for (i = 0; i < n; i++) {
	    if (EXPV_INT_VALUE(tmp) == ids[i]) {
		found = 1;
	    }
	}
	if (found == 0) {
	    error("I/O specifier \"%s\" is not allowed.",
		  specIdToSpecStr(EXPV_INT_VALUE(tmp)));
	    return FALSE;
	}
    }

    return TRUE;
}


expr
GetIoSpecifierValue(v, id, specifiedPtr)
     expv v;
     int id;
     int *specifiedPtr;
{
    list lp;

    if (specifiedPtr != NULL) {
	*specifiedPtr = FALSE;
    }
    FOR_ITEMS_IN_LIST(lp, v) {
	if (EXPR_INT(EXPR_ARG1(LIST_ITEM(lp))) == id) {
	    if (specifiedPtr != NULL) {
		*specifiedPtr = TRUE;
	    }
	    return EXPR_ARG2(LIST_ITEM(lp));
	}
    }

    return NULL;
}


ID
Get_ERRorEND_Label(ioSpec, type)
     expv ioSpec;
     int type;
{
    ID label = NULL;
    expv iSp = GetIoSpecifierValue(ioSpec, type, NULL);
    if (iSp != NULL) {
	expv cV = expr_constant_value(iSp, TRUE);
	if (cV == NULL) {
	    error("%s specifier must be integer constant.",
		  (type == IO_SPEC_ERR) ? "error" : "end-of-file");
	    return NULL;
	}
	if ((label = declare_label(EXPV_INT_VALUE(cV), LAB_EXEC, FALSE)) == NULL) {
	    fatal("can't generate label.");
	}
    }
    return label;
}


expv
GetIoSpecifierValueAsIntegerVariable(ioSpec, id, doAddr, haveItPtr, vIdPtr)
     expv ioSpec;
     int id;
     int doAddr;
     int *haveItPtr;
     ID *vIdPtr;
{
    expv intVar = NULL;
    expv iSp = GetIoSpecifierValue(ioSpec, id, haveItPtr);
    ID vId = NULL;

    if (iSp != NULL) {
	switch (EXPR_CODE(iSp)) {
	    case F_ARRAY_REF:
	    case IDENT: {
		BASIC_DATA_TYPE typ;
		if (EXPR_CODE(iSp) == F_ARRAY_REF) {
		    vId = declare_ident(EXPR_SYM(EXPR_ARG1(iSp)), CL_UNKNOWN);
		} else {
		    vId = declare_ident(EXPR_SYM(iSp), CL_UNKNOWN);
		}
		if (ID_CLASS(vId) == CL_UNKNOWN ||
		    ID_CLASS(vId) == CL_VAR) {
		    vId = declare_variable(vId);
		}
		if (ID_CLASS(vId) != CL_VAR) {
		    error("\"%s\" is not a variable.",
			  SYM_NAME(ID_SYM(vId)));
		    return NULL;
		}
		typ = getBasicType(ID_TYPE(vId));
		if (typ != TYPE_INT && typ != TYPE_LOGICAL) {
		    error("\"%s\" is not a integer*%d variable.",
			  SYM_NAME(ID_SYM(vId)),
			  basic_type_size(TYPE_INT));
		    return NULL;
		}
		break;
	    }
	    default: {
		error("not a variable expression.");
		return NULL;
	    }
	}
	if (vIdPtr != NULL) {
	    *vIdPtr = vId;
	}
	intVar = expv_reduce(compile_expression(iSp));
	if (doAddr == TRUE) {
	    intVar = expv_get_address(intVar);
	}
    }
    return intVar;
}


expv
Get_IOSTAT_Variable(ioSpec, vIdPtr)
     expv ioSpec;
     ID *vIdPtr;
{
    return GetIoSpecifierValueAsIntegerVariable(ioSpec,
						IO_SPEC_IOSTAT,
						FALSE,
						NULL,
						vIdPtr);
}


expv
GetIoSpecifierValueAsInteger(ioSpec, id, doAddr, haveItPtr)
     expv ioSpec;
     int id;
     int doAddr;
     int *haveItPtr;
{
    expv intV = NULL;
    expv iSp = GetIoSpecifierValue(ioSpec, id, haveItPtr);
    if (iSp != NULL) {
	if (EXPR_CODE(iSp) == INT_CONSTANT
#ifdef HAS_INT64
	    || EXPR_CODE(iSp) == LONGLONG_CONSTANT
#endif /* HAS_INT64 */
	    ) {
	    expv tI = compile_expression(iSp);
	    expv tmp = allocate_temp(type_INT);
	    output_expr_statement(expv_assignment(tmp,
						  (EXPR_CODE(tI) == INT_CONSTANT) ?
						  tI : expv_cons(CAST_EXPR, type_INT, tI, NULL)));
	    if (doAddr == TRUE) {
		intV = expv_get_address(tmp);
	    } else {
		intV = tmp;
	    }
	} else {
	    BASIC_DATA_TYPE typ;
	    expv vTmp = compile_args(list1(LIST, iSp), doAddr);
	    if (vTmp == NULL ||
		EXPR_ARG1(vTmp) == NULL) {
		fatal("internal compiler error.");
	    }
	    vTmp = EXPR_ARG1(vTmp);
	    if (EXPV_TYPE(vTmp) == NULL) {
		fatal("can't determine type of specifier.");
	    }
	    typ = getBasicType(EXPV_TYPE(vTmp));
	    if (typ == TYPE_UNKNOWN) {
		fatal("can't determine type of specifier.");
	    }
	    
	    if (!BASIC_IS_INT(typ)) {
		error("%s specifier must be integer type.",
		      specIdToSpecStr(id));
		return NULL;
	    } else {
		if (typ != TYPE_INT) {
		    if (doAddr == TRUE) {
			expv tt = allocate_temp(type_INT);
			output_expr_statement(
				expv_assignment(tt,
					expv_cons(CAST_EXPR, type_INT,
						  expv_cons(POINTER_REF, EXPV_TYPE(vTmp), vTmp, NULL),
						  NULL)));
			vTmp = expv_get_address(tt);
		    } else {
			vTmp = expv_cons(CAST_EXPR, type_INT, vTmp, NULL);
		    }
		}
	    }
	    intV = vTmp;
	}
    }
    return intV;
}


expv
GetIoSpecifierValueAsLogicalVariable(ioSpec, id, doAddr, haveItPtr, vIdPtr)
     expv ioSpec;
     int id;
     int doAddr;
     int *haveItPtr;
     ID *vIdPtr;
{
    expv logVar = NULL;
    expv iSp = GetIoSpecifierValue(ioSpec, id, haveItPtr);
    ID vId = NULL;

    if (iSp != NULL) {
	switch (EXPR_CODE(iSp)) {
	    case F_ARRAY_REF:
	    case IDENT: {
		BASIC_DATA_TYPE typ;
		if (EXPR_CODE(iSp) == F_ARRAY_REF) {
		    vId = declare_ident(EXPR_SYM(EXPR_ARG1(iSp)), CL_UNKNOWN);
		} else {
		    vId = declare_ident(EXPR_SYM(iSp), CL_UNKNOWN);
		}
		if (ID_CLASS(vId) == CL_UNKNOWN ||
		    ID_CLASS(vId) == CL_VAR) {
		    vId = declare_variable(vId);
		}
		if (ID_CLASS(vId) != CL_VAR) {
		    error("\"%s\" is not a variable.",
			  SYM_NAME(ID_SYM(vId)));
		    return NULL;
		}
		typ = getBasicType(ID_TYPE(vId));
		if (typ != TYPE_LOGICAL) {
		    error("\"%s\" is not a logical variable.",
			  SYM_NAME(ID_SYM(vId)));
		    return NULL;
		}
		break;
	    }
	    default: {
		error("not a variable expression.");
		return NULL;
	    }
	}
	if (vIdPtr != NULL) {
	    *vIdPtr = vId;
	}
	logVar = expv_reduce(compile_expression(iSp));
	if (doAddr == TRUE) {
	    logVar = expv_get_address(logVar);
	}
    }
    return logVar;
}



expv
GetIoSpecifierValueAsStringVariable(ioSpec, id, haveItPtr, lenVPtr, vIdPtr)
     expv ioSpec;
     int id;
     int *haveItPtr;
     expv *lenVPtr;
     ID *vIdPtr;
{
    expv strV = NULL;
    expv iSp = GetIoSpecifierValue(ioSpec, id, haveItPtr);
    if (iSp != NULL) {
	ID vId = NULL;
	switch (EXPR_CODE(iSp)) {
	    case F_SUBSTR_REF: {
		strV = convertSubstrRefToPointerRef(iSp, lenVPtr);
		if (vIdPtr != NULL) {
		    if (EXPR_CODE(EXPR_ARG1(iSp)) == IDENT) {
			vId = declare_ident(EXPR_SYM(EXPR_ARG1(iSp)), CL_UNKNOWN);
			*vIdPtr = vId;
		    } else {
			*vIdPtr = NULL;
		    }
		}
		break;
	    }
	    case F_ARRAY_REF:
	    case IDENT: {
		BASIC_DATA_TYPE typ;
		if (EXPR_CODE(iSp) == F_ARRAY_REF) {
		    vId = declare_ident(EXPR_SYM(EXPR_ARG1(iSp)), CL_UNKNOWN);
		} else {
		    vId = declare_ident(EXPR_SYM(iSp), CL_UNKNOWN);
		}
		if (ID_CLASS(vId) == CL_UNKNOWN ||
		    ID_CLASS(vId) == CL_VAR) {
		    vId = declare_variable(vId);
		}
		if (ID_CLASS(vId) != CL_VAR) {
		    error("\"%s\" is not a variable.",
			  SYM_NAME(ID_SYM(vId)));
		    return NULL;
		}
		typ = getBasicType(ID_TYPE(vId));
		if (!BASIC_IS_CHAR(typ)) {
		    error("\"%s\" is not a string variable.",
			  SYM_NAME(ID_SYM(vId)));
		    return NULL;
		}
		strV = expv_reduce(compile_expression(iSp));
		if (lenVPtr != NULL) {
		    *lenVPtr = expv_reduce(expv_char_len(strV));
		}
		if (vIdPtr != NULL) {
		    *vIdPtr = vId;
		}
		break;
	    }
	    default: {
		error("not a variable expression.");
		return NULL;
	    }
	}
    }
    return strV;
}


expv
GetIoSpecifierValueAsString(ioSpec, id, haveItPtr, lenVPtr)
     expv ioSpec;
     int id;
     int *haveItPtr;
     expv *lenVPtr;
{
    expv strV = NULL;
    expv iSp = GetIoSpecifierValue(ioSpec, id, haveItPtr);
    if (iSp != NULL) {
	if (EXPR_CODE(iSp) == F_SUBSTR_REF) {
	    strV = convertSubstrRefToPointerRef(iSp, lenVPtr);
	} else {
	    BASIC_DATA_TYPE typ;
	    expv vTmp = compile_args(list1(LIST, iSp), TRUE);
	    if (vTmp == NULL ||
		EXPR_ARG1(vTmp) == NULL) {
		fatal("internal compiler error.");
	    }
	    vTmp = EXPR_ARG1(vTmp);
	    if (EXPV_TYPE(vTmp) == NULL) {
		fatal("can't determine type of specifier.");
	    }
	    typ = getBasicType(EXPV_TYPE(vTmp));
	    if (typ == TYPE_UNKNOWN) {
		fatal("can't determine type of specifier.");
	    }

	    if (!BASIC_IS_CHAR(typ)) {
		error("%s specifier must be integer type.",
		      specIdToSpecStr(id));
		return NULL;
	    }

	    if (lenVPtr != NULL) {
		expv vOrg = expv_reduce(compile_expression(iSp));
		expv lenV = expv_reduce(expv_char_len(vOrg));
		if (lenV == NULL) {
		    fatal("internal compiler error.");
		}
		*lenVPtr = lenV;
	    }
	    strV = vTmp;
	}
    }
    return strV;
}