static char rcsid[] = "$Id: C-tea-pragma.c,v 1.14 2001/03/21 07:55:56 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 "C-front.h"

/* tea extended pragma */

/*
#pragma tea parameter(name[=expr])
#pragma tea define(name = expr,name=expr)
#pragma tea logfunc(name)
#pragma tea timer(name){ }
? #pragma tea if(condition)
? #pragma tea endif
#pragma tea for unroll(i:p1,j:p2) block(i:p1,j:p2)

#pragma omni mapping(a[block])
*/

static expr	parse_TEA_for_clause _ANSI_ARGS_((void));
static expr	parse_TEA_map_clause _ANSI_ARGS_((void));
static expr	pg_parse_map_subscript _ANSI_ARGS_((void));
static void	TEA_set_value _ANSI_ARGS_((expr s, expr x));
static expv	compile_TEA_clause _ANSI_ARGS_((expr x));

expr parse_TEA_pragma(ret)
     enum pragma_syntax *ret;
{
    enum TEA_pragma pg_TEA_pragma;
    expr s,x;

    *ret = SYN_PRAGMA_NONE;	/* default */
    pg_args = NULL;

    pg_get_token();
    if(pg_tok != PG_IDENT) goto syntax_err;

    /* parallel block directive */
    if(PG_IS_IDENT("timer")){	/* #pragma tea timer[(name)] */
	pg_TEA_pragma = TEA_TIMER;
	pg_get_token();
	if(pg_tok == '('){
	    pg_get_token();
	    if((pg_args = pg_parse_expr()) == NULL) goto syntax_err;
	    if(pg_tok != ')') goto syntax_err;
	    pg_get_token();
	} else goto syntax_err;
	*ret = SYN_PRAGMA_PREFIX;
	goto chk_end;
    }

    if(PG_IS_IDENT("logfunc")){	/* #pragma tea logfunc(name) */
	pg_TEA_pragma = TEA_LOG_FUNC;
	pg_get_token();
	if(pg_tok == '('){
	    pg_get_token();
	    if((pg_args = pg_parse_expr()) == NULL) goto syntax_err;
	    if(pg_tok != ')') goto syntax_err;
	    pg_get_token();
	} else goto syntax_err;
	*ret = SYN_PRAGMA_DECL;
	goto chk_end;
    }

    if(PG_IS_IDENT("logevent")){	/* #pragma tea logevent(name) */
	pg_TEA_pragma = TEA_LOG_EVENT;
	goto log_arg;
    }
    if(PG_IS_IDENT("logbegin")){	/* #pragma tea logbegin(name) */
	pg_TEA_pragma = TEA_LOG_BEGIN;
	goto log_arg;
    }
    if(PG_IS_IDENT("logend")){		/* #pragma tea logend(name) */
	pg_TEA_pragma = TEA_LOG_END;
	goto log_arg;
    }

    if(PG_IS_IDENT("define")){ /* #pragma tea define(name=expr,...) */
	pg_get_token();
	if(pg_tok != '(') goto syntax_err;
    L1:
	pg_get_token();
	if((s = pg_parse_ident()) == NULL) goto syntax_err;
	if(pg_tok != '=') goto syntax_err;
	pg_get_token();
	if((x = pg_parse_expr()) == NULL) goto syntax_err;
	TEA_set_value(s,x);
	if(pg_tok == ',') goto L1;
	if(pg_tok != ')') goto syntax_err;
	pg_get_token();
	*ret = SYN_PRAGMA_NONE;
	if(pg_tok != 0) error("extra arguments for omni/TEA pragma directive");
	return NULL;
    }

    if(PG_IS_IDENT("parameter")){ /* #pragma tea parameter(name[=expr]) */
	pg_get_token();
#ifdef not
	if(pg_tok != '(') goto syntax_err;
	pg_get_token();
	pg_args = EMPTY_LIST;
	if((s = pg_parse_ident()) == NULL) goto syntax_err;
	pg_args = list_put_last(pg_args,s);
	if(pg_tok == '='){
	    pg_get_token();
	    if((x = pg_parse_expr()) == NULL) goto syntax_err;
	    pg_args = list_put_last(pg_args,x);
	}
	if(pg_tok != ')') goto syntax_err;
	pg_get_token();
	*ret = SYN_PRAGMA_NONE;
	goto chk_end;
#else
	error("tea parameter pragma not supported yet");
	*ret = SYN_PRAGMA_NONE;
	return NULL;
#endif
    }

    if(PG_IS_IDENT("for")){
	pg_TEA_pragma = TEA_FOR;
	pg_get_token();
	if((pg_args = parse_TEA_for_clause()) == NULL) goto err;
	*ret = SYN_PRAGMA_PREFIX;
	goto chk_end;
    }

    if(PG_IS_IDENT("mapping") || PG_IS_IDENT("map")){
	pg_TEA_pragma = TEA_DATAMAP;
	pg_get_token();
	if((pg_args = parse_TEA_map_clause()) == NULL) goto err;
	*ret = SYN_PRAGMA_DECL;
	goto chk_end;
    }
    error("unknown omni/TEA pragma");
    return NULL;

log_arg:
    pg_get_token();
    if(pg_tok == '('){
	pg_get_token();
	if((pg_args = pg_parse_expr()) == NULL) goto syntax_err;
	if(pg_tok != ')') goto syntax_err;
	pg_get_token();
    } else goto syntax_err;
    *ret = SYN_PRAGMA_EXEC;
    goto chk_end;

syntax_err:
    error("syntax error in omni/TEA pragma");
err:
    return NULL;

chk_end:
    if(pg_tok != 0) error("extra arguments for omni/TEA pragma directive");
    return elist2(current_line,PRAGMA_LINE,
		  make_enode(INT_CONSTANT, (void *)pg_TEA_pragma), pg_args);
}

static void TEA_set_value(expr s,expr x)
{
    expv v;
    v = expv_reduce(compile_expression(x));
    if(v != NULL){
	if(EXPR_CODE(v) == INT_CONSTANT ||
	   EXPR_CODE(v) == FLOAT_CONSTANT ||
	   EXPR_CODE(v) == STRING_CONSTANT)
	    define_pragma_name(EXPR_SYM(s),v);
	else error("pragma name value must be constant");
    }
}

/* unroll(i:size), block(i:size) */
static expr parse_TEA_for_clause()
{
    expr args,e,s,c;

    args = EMPTY_LIST;
    while(pg_tok == PG_IDENT){
	if(PG_IS_IDENT("unroll")){
	    pg_get_token();
	    if(pg_tok != '(') goto syntax_err;
	    pg_get_token();
	    c = EMPTY_LIST;
	L1:
	    if((s = pg_parse_ident()) == NULL) goto syntax_err;
	    if(pg_tok != ':') goto syntax_err;
	    pg_get_token();
	    if((e = pg_parse_expr()) == NULL) goto syntax_err;
	    c = list_put_last(c,list2(LIST,s,e));
	    if(pg_tok == ','){
		pg_get_token();
		goto L1;
	    }
	    if(pg_tok != ')') goto syntax_err;
	    c = PG_LIST1(TEA_FOR_UNROLL,c);
	    pg_get_token();
	} else if(PG_IS_IDENT("block")){
	    pg_get_token();
	    if(pg_tok != '(') goto syntax_err;
	    pg_get_token();
	L2:
	    if((s = pg_parse_ident()) == NULL) goto syntax_err;
	    if(pg_tok != ':') goto syntax_err;
	    pg_get_token();
	    c = EMPTY_LIST;
	    if((e = pg_parse_expr()) == NULL) goto syntax_err;
	    c = list_put_last(c,list2(LIST,s,e));
	    if(pg_tok == ','){
		pg_get_token();
		goto L2;
	    }
	    if(pg_tok != ')') goto syntax_err;
	    c = PG_LIST1(TEA_FOR_BLOCK,c);
	    pg_get_token();
	} else {
	    error("unknown TEA 'for' directive clause '%s'",pg_tok_buf);
	    goto err;
	}
	args = list_put_last(args,c);
    }
    return args;
 syntax_err:
    error("syntax error in TEA 'for' directive");
 err:
    return NULL;
}

expr pg_parse_map_expr(void);

/* mapping(T[cyclic][block],...[:T[][]]) */
/* (TEA_DATAMAP (LIST (LIST (array dim1 dim2) ...) [align]))  */
static expr parse_TEA_map_clause()
{
    expr args,c;

    args = EMPTY_LIST;

    if(pg_tok != '(') goto syntax_err;
    pg_get_token();

next:
    if((c = pg_parse_map_expr()) == NULL) goto syntax_err;
    args = list_put_last(args,c);
    if(pg_tok == ',') {
	pg_get_token();
	goto next;
    }
    c = NULL;
    if(pg_tok == ':'){ 	/* align option */
	pg_get_token();
	if((c = pg_parse_map_expr()) == NULL) goto syntax_err;
    } 
    if(pg_tok == ')'){
	pg_get_token();
	return list2(LIST,args,c);
    } 
 syntax_err:
    error("syntax error in Omni 'mapping' directive");
    return NULL;
}

expr pg_parse_map_expr()
{
    expr e,s,c;
    if((s = pg_parse_ident()) == NULL) return NULL;
    if(pg_tok == '['){
	if((e = pg_parse_map_subscript()) == NULL) return NULL;
	c = list2(LIST,s,e);
    } else 
	c = list2(LIST,s,NULL);
    return c;
}

static expr pg_parse_map_subscript()
{
    expr subs;
    expr e = NULL;

    if(pg_tok != '[') return NULL;
    subs = EMPTY_LIST;
    while(pg_tok == '['){
	pg_get_token();
	if(PG_IS_IDENT("block")){
	    pg_get_token();
	    if(pg_tok == '('){
		pg_get_token();
		if((e = pg_parse_expr()) == NULL) goto syntax_err;
		if(pg_tok != ')') goto syntax_err;
		pg_get_token();
		e = PG_LIST1(TEA_MAP_BLOCK,e);
	    } else e = PG_LIST1(TEA_MAP_BLOCK,NULL);
	    subs = list_put_last(subs,e);
	} else if(PG_IS_IDENT("cyclic")){
	    pg_get_token();
	    if(pg_tok == '('){
		pg_get_token();
		if((e = pg_parse_expr()) == NULL) goto syntax_err;
		if(pg_tok != ')') goto syntax_err;
		pg_get_token();
		e = PG_LIST1(TEA_MAP_CYCLIC,e);
	    } else {
		e = PG_LIST1(TEA_MAP_CYCLIC,NULL);
	    }
	    subs = list_put_last(subs,e);
	} else if(pg_tok == '*'){
	    pg_get_token();
	    subs = list_put_last(subs,NULL);
	} else {
	    if((e = pg_parse_expr()) == NULL){
		error("bad subscript expression in TEA mapping");
		goto err;
	    }
	    e = PG_LIST1(TEA_MAP_EXPR,e);
	    subs = list_put_last(subs,e);
	}
	if(pg_tok != ']') goto syntax_err;
	pg_get_token();
    } 
    return subs;
 syntax_err:
    error("syntax error in subscript of Omni 'mapping' directive");
 err:
    return NULL;
}

/* 
 * compile TEA pramga
 */
expv compile_TEA_pragma(enum TEA_pragma pragma,expr x)
{
    expv v;

    switch(pragma){
    case TEA_FOR:
	v = compile_statement(EXPR_ARG3(x));
	return elist3(EXPR_LINE(x),TEA_PRAGMA,EXPR_ARG1(x),
		      compile_TEA_clause(EXPR_ARG2(x)),v);

    case TEA_TIMER:
	v = compile_statement(EXPR_ARG3(x));
	if(EXPR_CODE(EXPR_ARG2(x)) != STRING_CONSTANT){
	    error_at_node(x,"string is required in #pramga tea timer");
	    return NULL;
	}
	return elist3(EXPR_LINE(x),TEA_PRAGMA,EXPR_ARG1(x),EXPR_ARG2(x),v);

    case TEA_LOG_FUNC:
	v = EXPR_ARG2(x);
	if(EXPR_CODE(v) != IDENT){
	    error_at_node(x,"identifier is required in #pramga tea logfunc");
	    return NULL;
	}
	return elist3(EXPR_LINE(x),TEA_PRAGMA,EXPR_ARG1(x),EXPR_ARG2(x),NULL);
	    
    case TEA_LOG_EVENT:
    case TEA_LOG_BEGIN:
    case TEA_LOG_END:
	v = expv_reduce(compile_expression(EXPR_ARG2(x)));
	if(v == NULL) return NULL;
	if(EXPR_CODE(v) != INT_CONSTANT){
	    error_at_node(x,"integer value is required in #pramga tea logfunc/logbegin/logend");
	    return NULL;
	}
	return elist3(EXPR_LINE(x),TEA_PRAGMA,EXPR_ARG1(x),v,NULL);
	
    case TEA_DATAMAP:
	return elist3(EXPR_LINE(x),TEA_PRAGMA,EXPR_ARG1(x),EXPR_ARG2(x),NULL);
    default:
	break;
    }
    fatal("compile_TEA_pragma:");
    return NULL;
}

static expv compile_TEA_clause(expr x)
{
    list lp,lq;
    ID id;
    expr c,cc,xx;
    expv clause,v,vv;

    clause = EMPTY_LIST;
    FOR_ITEMS_IN_LIST(lp,x){
	c = LIST_ITEM(lp);
	switch(EXPR_INT(EXPR_ARG1(c))){
	case TEA_FOR_UNROLL:
	case TEA_FOR_BLOCK:
	    vv = EMPTY_LIST;
	    FOR_ITEMS_IN_LIST(lq,EXPR_ARG2(c)){
		cc = LIST_ITEM(lq);
		xx = EXPR_ARG1(cc);
		id = lookup_ident(xx);
		if(id == NULL){
		    error_at_node(x, "undefined variable, %s in pragma", 
				  SYM_NAME(EXPR_SYM(xx)));
		    continue;
		}
		v = expv_reduce(compile_expression(EXPR_ARG2(cc)));
		if(v == NULL) continue;
		if(EXPR_CODE(v) != INT_CONSTANT){
		    error_at_node(x,"TEA unroll/block number must be integer constant");
		    continue;
		}
		list_put_last(vv,list2(LIST,xx,v));
	    }
	    list_put_last(clause,list2(LIST,EXPR_ARG1(c),vv));
	    break;
	default:
	    fatal("unknown omni/TEA pragma clause");
	}
    }
    return clause;
}