#ifdef USE_OPENGR_PRAGMA
static char rcsid[] = "$Id: C-ogr-pragma.c,v 1.10 2002/02/27 11:32:41 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 "C-front.h"
#include "C-ogr-pragma.h"

static char *ogBTYPE_STRING[] = {
    "unknown basic type",	/* ogBT_UNKNOWN */
    "char",			/* ogBT_CHAR */
    "unsigned char",		/* ogBT_UCHAR */
    "short",			/* ogBT_SHORTINT */
    "unsigned short",		/* ogBT_USHORTINT */
    "int",			/* ogBT_INT */
    "unsigned int",		/* ogBT_UINT */
    "long",			/* ogBT_LONGINT */
    "unsigned long",		/* ogBT_ULONGINT */
#ifdef HAS_LONGLONG
    "long long",		/* ogBT_LONGLONGINT */
    "unsigned long long",	/* ogBT_ULONGLONGINT */
#endif /* HAS_LONGLONG */
    "float",			/* ogBT_FLOAT */
    "double",			/* ogBT_DOUBLE */
#ifdef HAS_LONGDOUBLE
    "long double",		/* ogBT_LONGDOUBLE */
#endif /* HAS_LONGDOUBLE */
    "void"			/* ogBT_VOID */
};
#define bTypeString(a)	ogBTYPE_STRING[(int)(a)]


static char *ogMODE_STRING[] = {
    "unknonw mode",	/* ogMD_UNKNOWN */
    "mode_in",		/* ogMD_IN */
    "mode_out",		/* ogMD_OUT */
    "mode_inout",	/* ogMD_INOUT */
    "mode_work"		/* ogMD_WORK */
};
#define modeString(a)	ogMODE_STRING[(int)(a)]


static int ogrInited = 0;

static ogr_token_t tokens[] = {
    {"IN",		ogTkn_IN},
    {"OUT",		ogTkn_OUT},
    {"INOUT",		ogTkn_INOUT},
    {"WORK",		ogTkn_WORK},

    {"mode_in",		ogTkn_mode_in},
    {"mode_out",	ogTkn_mode_out},
    {"mode_inout",	ogTkn_mode_inout},
    {"mode_work",	ogTkn_mode_work},

    {"char",		ogTkn_char},
    {"int",		ogTkn_int},
    {"float",		ogTkn_float},
    {"double",		ogTkn_double},

    {"signed",		ogTkn_signed},
    {"unsigned",	ogTkn_unsigned},

    {"short",		ogTkn_short},
    {"long",		ogTkn_long},

    {"void",		ogTkn_void},

    {NULL,		ogTkn_unknown}
};

static opengr_HashTable stubTab;
static opengr_HashTable tokenTab[2];
#define tokenStrTab	(tokenTab[0])
#define tokenTknTab	(tokenTab[1])

static ogr_stub_info	*alloc_stub_info _ANSI_ARGS_((char *stubname));
static ogr_stub_info	*find_stub_info _ANSI_ARGS_((char *stubname));

static ogr_param_info	*alloc_param_info _ANSI_ARGS_((char *paramname,
						       ogr_mode_type_t mode,
						       ogr_basic_type_t btype,
						       ogr_ref_type_t pOs,
						       int dim));
static ogr_param_info	*append_param_info _ANSI_ARGS_((ogr_param_info *top,
							ogr_param_info *new));

static ogr_type_token_t	find_type_token _ANSI_ARGS_((char *token));
static char *		find_type_str _ANSI_ARGS_((ogr_type_token_t tokenType));

static expv		gen_ogr_call _ANSI_ARGS_((char *stubname, expr clause,
						  enum OGR_pragma pragma));
static expr		replace_to_stubcall _ANSI_ARGS_((expr x,
							 ogr_stub_info *sPtr,
							 enum OGR_pragma pragma));
static expr		gen_extern_expr _ANSI_ARGS_((char *name,
						     BASIC_DATA_TYPE type));
static void		emit_ogr_chk_ext _ANSI_ARGS_((void));

static void		GetToken _ANSI_ARGS_((void));

static expv		gen_ogr_wait _ANSI_ARGS_((void));

static void
GetToken()
{
    pg_get_token();
}


static ogr_stub_info *
alloc_stub_info(stubname)
     char *stubname;
{
    opengr_HashEntry *ePtr = NULL;
    int isNew = 0;
    ogr_stub_info *ret = NULL;
    if (ogrInited == 0) {
	fatal("alloc_stub_info: OpenGR parser is not initialized.");
	return NULL;
    }
    if (stubname == NULL ||
	stubname[0] == '\0') {
	fatal("alloc_stub_info: Got a nul stub identifier.");
	return NULL;
    }
    ePtr = opengr_CreateHashEntry(&stubTab, stubname, &isNew);
    if (isNew == 0) {
	opengr_DeleteHashEntry(ePtr);
	fatal("alloc_stub_info: stub info for '%s' is already allocated.");
	return NULL;
    }

    ret = (ogr_stub_info *)malloc(sizeof(ogr_stub_info));
    if (ret == NULL) {
	opengr_DeleteHashEntry(ePtr);
	fatal("alloc_stub_info: can't allocate stub info.");
	return NULL;
    }

    (void)memset((void *)ret, 0, sizeof(ogr_stub_info));
    ret->stubname = strdup(stubname);
    ret->state = OGR_STUB_NONE;

    opengr_SetHashValue(ePtr, (ClientData)ret);

    return ret;
}


static ogr_param_info *
alloc_param_info(paramname, mode, btype, pOs, dim)
     char *paramname;
     ogr_mode_type_t mode;
     ogr_basic_type_t btype;
     ogr_ref_type_t pOs;
     int dim;
{
    ogr_param_info *ret = (ogr_param_info *)malloc(sizeof(ogr_param_info));
    if (ret == NULL) {
	fatal("alloc_param_info: can't allocate parameter info struct.");
	return NULL;
    }
    (void)memset((void *)ret, 0, sizeof(ogr_param_info));
    ret->paramname = strdup(paramname);
    ret->mode = mode;
    ret->btype = btype;
    ret->pOs = pOs;
    ret->dim = dim;

    return ret;
}


static void	dumpParamInfo _ANSI_ARGS_((ogr_param_info *pPtr));

static void
dumpParamInfo(pPtr)
     ogr_param_info *pPtr;
{
    fprintf(stderr, "\tparam: %s %s ",
	    modeString(pPtr->mode),
	    bTypeString(pPtr->btype));
    if (pPtr->pOs == ogRT_POINTER) {
	int i;
	for (i = 0; i < pPtr->dim; i++) {
	    fprintf(stderr, "*");
	}
    }
    fprintf(stderr, " %s;\n", pPtr->paramname);
}


static void	dumpStubInfo _ANSI_ARGS_((ogr_stub_info *sPtr));
static void
dumpStubInfo(sPtr)
     ogr_stub_info *sPtr;
{
    ogr_param_info *tmp;
    fprintf(stderr, "stub: %s %s",
	    sPtr->stubname,
	    sPtr->stubdecl);
    if (sPtr->comment != NULL) {
	fprintf(stderr, " \"%s\"",
		sPtr->comment);
    }
    fprintf(stderr, "\n");
    for (tmp = sPtr->params; tmp != NULL; tmp = tmp->next) {
	dumpParamInfo(tmp);
    }
    if (sPtr->module != NULL) {
	fprintf(stderr, "\tmodule: '%s'\n", sPtr->module);
    }
    if (sPtr->callname != NULL) {
	fprintf(stderr, "\tcalled as: '%s'\n", sPtr->callname);
    }
}


static ogr_param_info *
append_param_info(top, new)
     ogr_param_info *top;
     ogr_param_info *new;
{
    if (top != NULL) {
	ogr_param_info *last;
	for (last = top; last->next != NULL; last = last->next);
	last->next = new;
    } else {
	top = new;
    }
    new->next = NULL;
    return top;
}


static ogr_stub_info *
find_stub_info(stubname)
     char *stubname;
{
    ogr_stub_info *ret = NULL;
    opengr_HashEntry *ePtr = NULL;

    if (ogrInited == 0) {
	fatal("find_stub_info: OpenGR parser is not initialized.");
	return NULL;
    }
    if (stubname == NULL ||
	stubname[0] == '\0') {
	fatal("find_stub_info: Got a nul stub identifier.");
	return NULL;
    }

    ePtr = opengr_FindHashEntry(&stubTab, stubname);
    if (ePtr == NULL) {
	return NULL;
    } else {
	ret = (ogr_stub_info *)opengr_GetHashValue(ePtr);
	return ret;
    }
}


static ogr_type_token_t
find_type_token(token)
     char *token;
{
    opengr_HashEntry *ePtr;

    if (ogrInited == 0) {
	fatal("find_type_token: OpenGR parser is not initialized.");
	return ogTkn_unknown;
    }
    if (token == NULL ||
	token[0] == '\0') {
	fatal("find_type_token: Got nul token.");
	return ogTkn_unknown;
    }

    ePtr = opengr_FindHashEntry(&tokenStrTab, token);
    if (ePtr == NULL) {
	return ogTkn_unknown;
    } else {
	ogr_token_t *tPtr = (ogr_token_t *)opengr_GetHashValue(ePtr);
	return tPtr->tokenType;
    }
}


static char *
find_type_str(tokenType)
     ogr_type_token_t tokenType;
{
    opengr_HashEntry *ePtr;

    if (ogrInited == 0) {
	fatal("find_type_token: OpenGR parser is not initialized.");
	return ogTkn_unknown;
    }    
    if ((int)tokenType <= (int)ogTkn_unknown ||
	(int)tokenType > (int)ogTkn_void) {
	return NULL;
    }

    ePtr = opengr_FindHashEntry(&tokenTknTab, (void *)tokenType);
    if (ePtr == NULL) {
	return NULL;
    } else {
	ogr_token_t *tPtr = (ogr_token_t *)opengr_GetHashValue(ePtr);
	return tPtr->token;
    }
}


void
init_OGR_pragma()
{
    if (ogrInited == 0) {
	ogr_token_t *tPtr = &(tokens[0]);
	opengr_HashEntry *ePtr = NULL;
	int isNew;

	/* Initialize stub name hash table. */
	opengr_InitHashTable(&stubTab, OPENGR_STRING_KEYS);
	
	/* Initialize token hash table, str->token and token->str. */
	opengr_InitHashTable(&tokenStrTab, OPENGR_STRING_KEYS);
	opengr_InitHashTable(&tokenTknTab, OPENGR_ONE_WORD_KEYS);

	for (;
	     tPtr->token != NULL;
	     tPtr++) {
	    ePtr = opengr_CreateHashEntry(&tokenStrTab,
					  tPtr->token, &isNew);
	    opengr_SetHashValue(ePtr, (ClientData)tPtr);
	    ePtr = opengr_CreateHashEntry(&tokenTknTab,
					  (void *)tPtr->tokenType, &isNew);
	    opengr_SetHashValue(ePtr, (ClientData)tPtr);	    
	}
	ogrInited = 1;
    }
    return;
}


expr
parse_OGR_pragma(ret)
     enum pragma_syntax *ret;
{
    enum OGR_pragma ogrPrgm = OGR_END;
    ogr_stub_info *stInfo = NULL;
    char *stubname = NULL;

    *ret = SYN_PRAGMA_NONE;
    pg_args = NULL;

    GetToken();
    if (pg_tok != PG_IDENT) {
	goto syntax_err;
    }

    if (PG_IS_IDENT("define_func")) {
	ogr_param_info *newP = NULL;
	ogr_type_token_t mode;	/* IN|OUT|INOUT|WORK|mode_in|
				   mode_out|mode_inout|mode_work */
	int modeDecld = 0;
	ogr_type_token_t bType; /* char|int|float|double|void */
	int bTypeDecld = 0;
	ogr_type_token_t sOu;	/* signed|unsigned */
	int sOuDecld = 0;
	ogr_type_token_t size;	/* short|long */
	int has2Long = 0;	/* long long */
	int sizeDecld = 0;
	int pIdentDecld = 0;
	int nDim = 0;
	int nextMustBeParamIdent = 0;
	char *paramName = NULL;

	ogr_basic_type_t finalBType = ogBT_UNKNOWN;
	ogr_mode_type_t finalMode = ogMD_UNKNOWN;
	ogr_ref_type_t pOs = ogRT_UNKNOWN;

	/*
	 * #pragma ogr define_func ident '(' params ')'
	 */
	ogrPrgm = OGR_DEFINE_FUNC;
	*ret = SYN_PRAGMA_DECL;

	/*
	 * check ident.
	 */
	GetToken();
	if (pg_tok != PG_IDENT) {
	    goto syntax_err;
	}
	stubname = strdup(pg_tok_buf);

	stInfo = find_stub_info(stubname);
	if (stInfo == NULL) {
	    stInfo = alloc_stub_info(stubname);
	    if (stInfo == NULL) {
		fatal("parse_OGR_pragma: can't create stub info entry for '%s'.",
		      stubname);
		goto err;
	    }
	} else {
	    error("OpenGR stub '%s' is already declared.", stubname);
	    goto err;
	}
	{
	    char *cp = pg_cp;
	    char *l = NULL;
	    int len;

	    while (isspace((int)*cp)) {
		cp++;
	    }

	    stInfo->stubdecl = strdup(cp);
	    len = strlen(stInfo->stubdecl);
	    if (stInfo->stubdecl[len - 1] == '\n') {
		stInfo->stubdecl[len - 1] = '\0';
	    }
	    l = strrchr(stInfo->stubdecl, ')');
	    if (l != NULL &&
		*(l + 1) != '\0') {
		l++;
		*l = '\0';
	    }
	}

	/*
	 * check params.
	 *
	 *	paramlist := '(' params ')'
	 *	params := params ',' param
	 *	param := ioMode typeSpec name dimSpec
	 *	ioMode := 'IN'|'OUT'|'INOUT'|'WORK'
	 *		  |'mode_in'|'mode_out'|'mode_inout'|'mode_work'
	 *	typeSpec := <C type decl>
	 *	name := ident
	 *	dimSpec := <C dimension decl>
	 */

	GetToken();
	if (pg_tok != '(') {
	    goto syntax_err;
	}

	while (1) {
	    NextParam:

	    newP = NULL;
	    mode = ogTkn_unknown;
	    modeDecld = 0;
	    bType = ogTkn_unknown;
	    bTypeDecld = 0;
	    sOu = ogTkn_unknown;
	    sOuDecld = 0;
	    size = ogTkn_unknown;
	    sizeDecld = 0;
	    has2Long = 0;
	    pIdentDecld = 0;
	    nDim = 0;
	    if (paramName != NULL) {
		free(paramName);
		paramName = NULL;
	    }
	    finalBType = ogBT_UNKNOWN;
	    finalMode = ogMD_UNKNOWN;
	    pOs = ogRT_UNKNOWN;
	    nextMustBeParamIdent = 0;

	    NextToken:
	    GetToken();
	    if (pg_tok == PG_IDENT) {
		ogr_type_token_t t;
		
		t = find_type_token(pg_tok_buf);
		if (t != ogTkn_unknown) {
		    if (nextMustBeParamIdent == 1) {
			error("OpenGR only identifier allowed after '*'.");
			goto err;
		    }
		    switch (t) {
			case ogTkn_char: case ogTkn_int: case ogTkn_float:
			case ogTkn_double: case ogTkn_void: {
			    if (bTypeDecld == 1) {
				error("OpenGR invalid type combination.");
				goto err;
			    } else {
				bType = t;
				bTypeDecld = 1;
			    }
			    break;
			}

			case ogTkn_signed: case ogTkn_unsigned: {
			    if (sOuDecld == 1) {
				error("OpenGR invalid type combination.");
				goto err;
			    } else {
				sOu = t;
				sOuDecld = 1;
			    }
			    break;
			}

			case ogTkn_short: case ogTkn_long: {
			    if (sizeDecld == 1) {
				if (size == ogTkn_long &&
				    t == ogTkn_long) {
				    size = t;
				    has2Long = 1;
				} else {
				    error("OpenGR invalid type combination.");
				    goto err;
				}
			    } else {
				size = t;
				sizeDecld = 1;
			    }
			    break;
			}

			case ogTkn_IN: case ogTkn_OUT: case ogTkn_INOUT:
			case ogTkn_WORK: case ogTkn_mode_in:
			case ogTkn_mode_out: case ogTkn_mode_inout:
			case ogTkn_mode_work: {
			    if (modeDecld == 1) {
				error("OpenGR invalid type combination.");
				goto err;
			    } else {
				mode = t;
				modeDecld = 1;
			    }
			    break;
			}

			default: {
			    fatal("parse_OGR_pragma: Shouldn't be here :(");
			    goto err;
			}
		    }

		    goto NextToken;

		} else {
		    /* The first non-type-token in this parameter, means ident. */
		    if (pIdentDecld == 1) {
			error("undefined or not a type '%s'.", pg_tok_buf);
			goto err;
		    }

		    /* Canonic the type */
		    if (modeDecld == 0) {
			error("OpenGR mode type is not specified.");
			goto err;
		    }
		    if (bTypeDecld == 0) {
			bType = ogTkn_int;
		    }
		    if (sOuDecld == 0) {
			sOu = ogTkn_signed;
		    }
		    
		    if (bType == ogTkn_float ||
			bType == ogTkn_double) {
			if (sOuDecld == 1) {
			    error("OpenGR invalid type combination.");
			    goto err;
			}
			if (bType == ogTkn_float &&
			    sizeDecld == 1) {
			    error("OpenGR invalid type combination.");
			    goto err;
			}
#ifdef HAS_LONGDOUBLE
			if (bType == ogTkn_double) {
			    if (size == ogTkn_long) {
				finalBType = ogBT_LONGDOUBLE;
			    } else if (size == ogTkn_unknown) {
				finalBType = ogBT_DOUBLE;
			    } else {
				error("OpenGR invalid type combination.");
				goto err;
			    }
			} else {
			    finalBType = ogBT_FLOAT;
			}
#else
			if (sizeDecld == 1) {
			    error("OpenGR invalid type combination.");
			    goto err;
			}
			finalBType = (bType == ogTkn_float) ? 
			ogBT_FLOAT : ogBT_DOUBLE;
#endif /* HAS_LONGDOUBLE */
		    } else {
			switch (size) {
			    case ogTkn_unknown: {
				switch (bType) {
				    case ogTkn_char: {
					finalBType = (sOu == ogTkn_signed) ?
					ogBT_CHAR : ogBT_UCHAR;
					break;
				    }
				    case ogTkn_int: {
					finalBType = (sOu == ogTkn_signed) ?
					ogBT_INT : ogBT_UINT;
					break;
				    }
				    default: {
					error("OpenGR invalid type combination.");
					goto err;
				    }
				}
				break;
			    }
			    case ogTkn_short: {
				switch (bType) {
				    case ogTkn_int: {
					finalBType = (sOu == ogTkn_signed) ?
					ogBT_SHORTINT : ogBT_USHORTINT;
					break;
				    }
				    default: {
					error("OpenGR invalid type combination.");
					goto err;
				    }
				}
				break;
			    }
			    case ogTkn_long: {
				switch (bType) {
				    case ogTkn_int: {
					finalBType = (sOu == ogTkn_signed) ?
					((has2Long == 1) ? ogBT_LONGLONGINT : ogBT_LONGINT) :
					((has2Long == 1) ? ogBT_ULONGLONGINT : ogBT_ULONGINT);
					break;
				    }
				    default: {
					error("OpenGR invalid type combination.");
					goto err;
				    }
				}
				break;
			    }
			    default: {
				error("OpenGR invalid type combination.");
				goto err;
			    }
			}
		    }
		    
		    if (finalBType == ogBT_UNKNOWN) {
			fatal("parse_OGR_pragma: can't determine a type.");
			goto err;
		    }
		    pIdentDecld = 1;
		    paramName = strdup(pg_tok_buf);

		    goto NextToken;

		}
	    } else if (pg_tok == '*') {
		/* pointer */
		if (modeDecld == 0) {
		    error("OpenGR mode type is not specified.");
		    goto err;
		}
		if (bTypeDecld == 0) {
		    bType = ogTkn_int;
		    bTypeDecld = 1;
		}
		if (bTypeDecld == 1 &&
		    (bType != ogTkn_float &&
		     bType != ogTkn_double)) {
		    if (sOuDecld == 0) {
			sOu = ogTkn_signed;
			sOuDecld = 1;
		    }
		}
		nextMustBeParamIdent = 1;
		nDim++;
		goto NextToken;
	    } else if (pg_tok == '[') {
		/* array */
		expr dimx = NULL;
		if (pIdentDecld == 0) {
		    error("OpenGR parameter identifier is not specified.");
		    goto err;
		}
		GetToken();
		if (pg_tok == ']') {
		    /* ident '[' ']' */
		    nDim++;
		} else {
#if 0
		    dimx = pg_parse_expr();
		    if (dimx == NULL) {
			error("OpenGR invalid array expression.");
			goto err;
		    } else {
			GetToken();
			if (pg_tok != ']') {
			    goto syntax_err;
			} else {
			    nDim++;
			}
		    }
#else
		    /* 
		     * XXXXX FIXME:
		     * Just ignore expressions until ']' occur.
		     */
		    while (1) {
			GetToken();
			if (pg_tok == ']') {
			    break;
			} else if (pg_tok == 0) {
			    goto syntax_err;
			}
		    }
#endif
		}
		goto NextToken;

	    } else if (pg_tok == ',' ||
		       pg_tok == ')') {

		/* a param decl end */

		/* check ident */
		if (pIdentDecld == 0) {
		    error("OpenGR parameter identifier is not specified.");
		    goto err;
		}

		/* finalize mode */
		switch (mode) {
		    case ogTkn_IN: case ogTkn_mode_in: {
			finalMode = ogMD_IN; break;
		    }
		    case ogTkn_OUT: case ogTkn_mode_out: {
			finalMode = ogMD_OUT; break;
		    }
		    case ogTkn_INOUT: case ogTkn_mode_inout: {
			finalMode = ogMD_INOUT; break;
		    }
		    case ogTkn_WORK: case ogTkn_mode_work: {
			finalMode = ogMD_WORK;
		    }
		    default: {
			fatal("parse_OGR_pragma: invalid mode detection.");
			goto err;
		    }
		}

		/* pointer/scalar */
		if (nDim == 0) {
		    pOs = ogRT_SCALAR;
		} else if (nDim > 0) {
		    pOs = ogRT_POINTER;
		} else {
		    fatal("parse_OGR_pragma: negative dimension??");
		    goto err;
		}

		newP = alloc_param_info(paramName, finalMode, finalBType, pOs, nDim);
		if (newP == NULL) {
		    fatal("parse_ORG_pragma: can't create a param info struct.");
		    goto err;
		}

		stInfo->params = append_param_info(stInfo->params, newP);

		if (pg_tok == ')') {
		    /* param list end */
		    break;
		} else {
		    goto NextParam;
		}
	    }
	}

	/* comment */
	GetToken();
	if (pg_tok == 0) {
	    goto defDone;
	}
	if (pg_tok == PG_CONST &&
	    EXPR_CODE(pg_tok_val) == STRING_CONSTANT) {
	    stInfo->comment = strdup(EXPR_STR(pg_tok_val));
	} else {
	    goto syntax_err;
	}

	GetToken();

	defDone:
	stInfo->state = OGR_STUB_DECLARED;

	goto chk_end;
    } else if (PG_IS_IDENT("gen_stub")) {
	char *module = NULL;
	char *require = NULL;
	int external = 0;
	int gotAtLeastOneOpt = 0;
	/*
	 * #pragma ogr gen_stub ident '(' specs ')'
	 */
	ogrPrgm = OGR_GEN_STUB;
	*ret = SYN_PRAGMA_DECL;
	
	/*
	 * check ident.
	 */
	GetToken();
	if (pg_tok != PG_IDENT) {
	    goto syntax_err;
	}
	stubname = strdup(pg_tok_buf);

	stInfo = find_stub_info(stubname);
	if (stInfo == NULL ||
	    stInfo->state != OGR_STUB_DECLARED) {
	    error("OpenGR stub '%s' is not defined.", stubname);
	    goto err;
	}
	if (stInfo->state & OGR_STUB_GENERATED ||
	    stInfo->state & OGR_STUB_DEFINED) {
	    error("OpenGR stub '%s' is already defined.", stubname);
	    goto err;
	}

	/*
	 * check specs.
	 *
	 *	speclist := '(' specs ')'
	 *	specs := specs ',' spec
	 *	spec := 'module' ident
	 *		| 'require' <string>
	 */

	GetToken();
	if (pg_tok != '(') {
	    goto syntax_err;
	}

	while (1) {
	    NextSpec:

	    GetToken();
	    if (pg_tok == PG_IDENT) {
		if (strncasecmp(pg_tok_buf, "module", 6) == 0) {
		    GetToken();
		    if (pg_tok == PG_IDENT) {
			module = strdup(pg_tok_buf);
		    } else if (pg_tok == PG_CONST &&
			       EXPR_CODE(pg_tok_val) == STRING_CONSTANT) {
			module = strdup(EXPR_STR(pg_tok_val));
		    } else {
			error("OpenGR stub '%s' module name missing.",
			      stubname);
			goto err;
		    }
		} else if (strncasecmp(pg_tok_buf, "require", 7) == 0) {
		    GetToken();
		    if (pg_tok == PG_CONST &&
			EXPR_CODE(pg_tok_val) == STRING_CONSTANT) {
			require = strdup(EXPR_STR(pg_tok_val));
		    } else {
			error("OpenGR stub '%s' require optioins parsing error.",
			      stubname);
			goto err;
		    }
		} else if (strncasecmp(pg_tok_buf, "external", 8) == 0) {
		    external = 1;
		} else {
		    error("OpenGR unknown stub generation option.");
		    goto err;
		}
		gotAtLeastOneOpt = 1;
	    } else if (pg_tok == ',') {
		if (gotAtLeastOneOpt == 0) {
		    goto syntax_err;
		}
		goto NextSpec;
	    } else if (pg_tok == ')') {
		if (gotAtLeastOneOpt == 0) {
		    goto syntax_err;
		}
		break;
	    }
	}
	GetToken();

	if (module == NULL) {
	    error("OpenGR stub '%s' module name not specified.",
		  stubname);
	    goto err;
	} else {
	    int lenM = strlen(module);
	    int lenS = strlen(stubname);
	    int len = lenM + lenS + 2;
	    	/* one for '/', another for NUL. */
	    stInfo->module = module;
	    stInfo->callname = (char *)malloc(sizeof(char) * len);
	    (void)memcpy((void *)(stInfo->callname), module, lenM);
	    stInfo->callname[lenM] = '/';
	    (void)memcpy((void *)((char *)(stInfo->callname + lenM + 1)),
			 stubname, lenS);
	    stInfo->callname[len] = '\0';
	}

	if (require != NULL) {
	    stInfo->require = require;
	    if (external == 1) {
		warning("OpenGR stub '%s' is specified as generated externally,"
			" ignore require option.",
			stubname);
	    }
	}

	stInfo->state |= OGR_STUB_GENERATED;
	if (external == 1) {
	    stInfo->external = 1;
	    stInfo->state |= OGR_STUB_DEFINED;
	}

	goto chk_end;
    } else if (PG_IS_IDENT("call") ||
	       PG_IS_IDENT("call_async")) {
	ogrPrgm = (PG_IS_IDENT("call")) ? OGR_CALL : OGR_CALL_ASYNC;
	*ret = SYN_PRAGMA_PREFIX;
	
	/*
	 * check ident.
	 */
	GetToken();
	if (pg_tok != PG_IDENT) {
	    goto syntax_err;
	}
	stubname = strdup(pg_tok_buf);

	stInfo = find_stub_info(stubname);
	if (stInfo == NULL) {
	    error("OpenGR stub '%s' is not defined.", stubname);
	    goto err;
	}
	if (!(stInfo->state & OGR_STUB_DECLARED &&
	      stInfo->state & OGR_STUB_GENERATED &&
	      stInfo->state & OGR_STUB_DEFINED)) {
	    error("OpenGR stub '%s' is not defined.", stubname);
	    goto err;
	}
#if 0
	dumpStubInfo(stInfo);
#endif
	GetToken();

	goto chk_end;
    } else if (PG_IS_IDENT("wait_async")) {
	ogrPrgm = OGR_WAIT_ASYNC;
	*ret = SYN_PRAGMA_EXEC;
	pg_args = list0(LIST);
	GetToken();
	goto chk_end;
    }

    syntax_err:
    error("syntax error in OpenGR pragma");
    err:
    *ret = SYN_PRAGMA_NONE;
    if (stubname != NULL) {
	free(stubname);
    }
    return NULL;

    chk_end:
    if (pg_tok != 0) {
	error("extra arguments for OpenGR pragma");
	*ret = SYN_PRAGMA_NONE;
	return NULL;
    }

    if (stubname != NULL) {
	pg_args = make_enode(STRING_CONSTANT, (void *)strdup(stubname));
	free(stubname);
    }
    return elist2(current_line, PRAGMA_LINE,
		  make_enode(INT_CONSTANT, (void *)((int)ogrPrgm)), pg_args);
}


expv
compile_OGR_pragma(pragma, x)
     enum OGR_pragma pragma;
     expr x;
{
    expv retV = NULL;

    switch (pragma) {
	case OGR_DEFINE_FUNC:
	case OGR_GEN_STUB: {
	    break;
	}
	case OGR_START_BODY:
	case OGR_END_BODY: {
	    break;
	}
	case OGR_CALL:
	case OGR_CALL_ASYNC: {
	    retV = gen_ogr_call(EXPR_STR(EXPR_ARG2(x)), EXPR_ARG3(x), pragma);
	    break;
	}
	case OGR_WAIT_ASYNC: {
	    retV = gen_ogr_wait();
	    break;
	}
	default: {
	    fatal("compile_OGR_pragma: unknown OpenGR pragma.");
	    break;
	}
    }

    if (retV == NULL) {
	retV = list0(LIST);
    }
    return retV;
}


static expr
replace_to_stubcall(x, sPtr, pragma)
     expr x;
     ogr_stub_info *sPtr;
     enum OGR_pragma pragma;
{
    if (x == NULL) {
	return x;
    } else if (EXPR_CODE_IS_TERMINAL(EXPR_CODE(x))) {
	return x;
    } else if (EXPR_CODE(x) == FUNCTION_CALL &&
	       strcmp(SYM_NAME(EXPR_SYM(EXPR_ARG1(x))),
		      sPtr->stubname) == 0) {
	list lp;
	expr newArgX = list0(LIST);
	expr newX = list0(FUNCTION_CALL);
	SYMBOL sp = find_symbol((pragma == OGR_CALL_ASYNC) ?
				"__rpcAsync" : "__rpcSync");
	newX = list_put_last(newX, make_enode(IDENT, (void *)sp));

	newArgX = list_put_last(newArgX, make_enode(STRING_CONSTANT, sPtr->callname));
	
	FOR_ITEMS_IN_LIST(lp, EXPR_ARG2(x)) {
	    /*
	     * XXXXX FIXME:
	     *	should check argument type, comparing to types defined in stub info.
	     */
	    newArgX = list_put_last(newArgX, LIST_ITEM(lp));
	}
	newX = list_put_last(newX, newArgX);

	return newX;
    } else {
	list lp;
	expr tmp;

	FOR_ITEMS_IN_LIST(lp, x) {
	    tmp = replace_to_stubcall(LIST_ITEM(lp), sPtr, pragma);
	    if (tmp != LIST_ITEM(lp)) {
		LIST_ITEM(lp) = tmp;
	    }
	}
	return x;
    }
}


static expr
gen_extern_expr(name, type)
     char *name;
     BASIC_DATA_TYPE type;
{
    SYMBOL sp = find_symbol(name);
    expr ix = make_enode(IDENT, (void *)sp);
    ID id = define_ident(ix, EXTERN, BASIC_TYPE_DESC(type));
    ID tid;

    for (tid = GLOBAL_ID_LIST; ID_NEXT(tid) != NULL; tid = ID_NEXT(tid)) {;}
    ID_NEXT(tid) = id;

    return list2(LIST,
		 list2(LIST,
		       make_enode(STORAGE_CLASS_NODE, (void *)((int)EXTERN)),
		       make_enode(BASIC_TYPE_NODE, (void *)((int)type))),
		 list1(LIST, ix));
}


static void
emit_ogr_chk_ext()
{
    static int ogrChkEmitted = 0;
    if (ogrChkEmitted == 0) {
	compile_external_declaration(gen_extern_expr(OGR_CHK_SYMNAME, INT));
	ogrChkEmitted = 1;
    }
}


static expv
gen_ogr_call(stubname, clause, pragma)
     char *stubname;
     expr clause;
     enum OGR_pragma pragma;
{
    expv orgV = compile_statement(clause);
    ogr_stub_info *stInfo = find_stub_info(stubname);
    expr scX = NULL;
    expv scV = NULL;
    SYMBOL sp = NULL;

    expr condX = NULL;
    expv condV = NULL;

    if (orgV == NULL) {
	return NULL;
    }

    if (stInfo == NULL) {
	error("OpenGR stub '%s' is not defined.", stubname);
	return NULL;
    }

    scX = replace_to_stubcall(clause, stInfo, pragma);

    scV = compile_statement(scX);
    if (scV == NULL) {
	return NULL;
    }

    emit_ogr_chk_ext();
    
    sp = find_symbol(OGR_CHK_SYMNAME);

    condX = list2(LOG_EQ_EXPR,
		  make_enode(IDENT, (void *)sp),
		  make_enode(INT_CONSTANT, (void *)1));
    condV = compile_expression(condX);
    if (condV == NULL) {
	return NULL;
    }

    return list3(IF_STATEMENT, condV, scV, orgV);
}


static expv
gen_ogr_wait()
{
    expr newX = list0(FUNCTION_CALL);
    SYMBOL sp = find_symbol("__rpcWait");

    newX = list_put_last(newX, make_enode(IDENT, (void *)sp));
    newX = list_put_last(newX, list0(LIST));

    return compile_statement(newX);
}


#else
static int __OpenGR_omited__ = 1;
#endif /* USE_OPENGR_PRAGMA */