paramset.c

来自「<B>Digital的Unix操作系统VAX 4.2源码</B>」· C语言 代码 · 共 123 行

#ifndef lint
static	char	*sccsid = "@(#)paramset.c	4.1	(ULTRIX)	7/17/90";
#endif lint

/************************************************************************
 *									*
 *			Copyright (c) 1984 by				*
 *		Digital Equipment Corporation, Maynard, MA		*
 *			All rights reserved.				*
 *									*
 *   This software is furnished under a license and may be used and	*
 *   copied  only  in accordance with the terms of such license and	*
 *   with the  inclusion  of  the  above  copyright  notice.   This	*
 *   software  or  any  other copies thereof may not be provided or	*
 *   otherwise made available to any other person.  No title to and	*
 *   ownership of the software is hereby transferred.			*
 *									*
 *   This software is  derived  from  software  received  from  the	*
 *   University    of   California,   Berkeley,   and   from   Bell	*
 *   Laboratories.  Use, duplication, or disclosure is  subject  to	*
 *   restrictions  under  license  agreements  with  University  of	*
 *   California and with AT&T.						*
 *									*
 *   The information in this software is subject to change  without	*
 *   notice  and should not be construed as a commitment by Digital	*
 *   Equipment Corporation.						*
 *									*
 *   Digital assumes no responsibility for the use  or  reliability	*
 *   of its software on equipment which is not supplied by Digital.	*
 *									*
 ************************************************************************/

/*
 * paramset.c
 *
 * Routines for handling PARAMETER statements, f77 compiler, 4.2 BSD.
 *
 * $Log:	paramset.c,v $
 * Revision 3.2  84/10/13  03:52:03  donn
 * Setting a parameter variable to a nonconstant expression is an error;
 * previously a mere warning was emitted.  Also added a comment header.
 * 
 */

#include "defs.h"
#include "data.h"

/*	process the items in a PARAMETER statement	*/
paramset( param_item_nm, param_item_vl )
Namep param_item_nm;
expptr param_item_vl;
{
  if (param_item_nm->vstg != STGUNKNOWN && param_item_nm->vstg != STGCONST )
    dclerr("conflicting declarations", param_item_nm);
  else if (param_item_nm->vclass == CLUNKNOWN)
    param_item_nm->vclass = CLPARAM;
  else if ( param_item_nm->vclass == CLPARAM )
    dclerr("redefining PARAMETER value", param_item_nm );
  else
    dclerr("conflicting declarations", param_item_nm);

  if (param_item_nm->vclass == CLPARAM)
    {
      if (!ISCONST(param_item_vl))
	param_item_vl = fixtype(param_item_vl);

      if (param_item_nm->vtype == TYUNKNOWN)
	{
	  char c;

	  c = param_item_nm->varname[0];
	  if (c >= 'A' && c <= 'Z')
	    c = c - 'A';
	  else
	    c = c - 'a';
	  param_item_nm->vtype = impltype[c];
	  param_item_nm->vleng = ICON(implleng[c]);
	}
      if (param_item_nm->vtype == TYUNKNOWN)
	{ 
	  warn1("type undefined for %s",
		varstr(VL, param_item_nm->varname));
	  ((struct Paramblock *) (param_item_nm))->paramval = param_item_vl;
	}
      else
	{
	  extern int badvalue;
	  extern expptr constconv();
	  int type;
	  ftnint len;

	  type = param_item_nm->vtype;
	  if (type == TYCHAR)
	    {
	      if (param_item_nm->vleng != NULL)
		len = param_item_nm->vleng->constblock.const.ci;
	      else if (ISCONST(param_item_vl) &&
			param_item_vl->constblock.vtype == TYCHAR)
		len = param_item_vl->constblock.vleng->
			constblock.const.ci;
	      else
		len = 1;
	    }
	  badvalue = 0;
	  if (ISCONST(param_item_vl))
	    {
	      ((struct Paramblock *) (param_item_nm))->paramval =
	        convconst(param_item_nm->vtype, len, param_item_vl);
	      if (type == TYLOGICAL)
		((struct Paramblock *) (param_item_nm))->paramval->
		  headblock.vtype = TYLOGICAL;
	      frexpr((tagptr) param_item_vl);
	    }
	  else
	    {
	      erri("%s set to a nonconstant",
		    varstr(VL, param_item_nm->varname));
	      ((struct Paramblock *) (param_item_nm))->paramval = param_item_vl;
	    }
	}
    }
}