4.3BSD - /usr/src/usr.bin/f77/src/f77pass1/paramset.c

   1: /*
   2:  * Copyright (c) 1980 Regents of the University of California.
   3:  * All rights reserved.  The Berkeley software License Agreement
   4:  * specifies the terms and conditions for redistribution.
   5:  */
   6: 
   7: #ifndef lint
   8: static char sccsid[] = "@(#)paramset.c	5.1 (Berkeley) 6/7/85";
   9: #endif not lint
  10: 
  11: /*
  12:  * paramset.c
  13:  *
  14:  * Routines for handling PARAMETER statements, f77 compiler, 4.2 BSD.
  15:  *
  16:  * $Log:	paramset.c,v $
  17:  * Revision 3.2  84/10/13  03:52:03  donn
  18:  * Setting a parameter variable to a nonconstant expression is an error;
  19:  * previously a mere warning was emitted.  Also added a comment header.
  20:  *
  21:  */
  22: 
  23: #include "defs.h"
  24: #include "data.h"
  25: 
  26: /*	process the items in a PARAMETER statement	*/
  27: paramset( param_item_nm, param_item_vl )
  28: Namep param_item_nm;
  29: expptr param_item_vl;
  30: {
  31:   if (param_item_nm->vstg != STGUNKNOWN && param_item_nm->vstg != STGCONST )
  32:     dclerr("conflicting declarations", param_item_nm);
  33:   else if (param_item_nm->vclass == CLUNKNOWN)
  34:     param_item_nm->vclass = CLPARAM;
  35:   else if ( param_item_nm->vclass == CLPARAM )
  36:     dclerr("redefining PARAMETER value", param_item_nm );
  37:   else
  38:     dclerr("conflicting declarations", param_item_nm);
  39: 
  40:   if (param_item_nm->vclass == CLPARAM)
  41:     {
  42:       if (!ISCONST(param_item_vl))
  43:     param_item_vl = fixtype(param_item_vl);
  44: 
  45:       if (param_item_nm->vtype == TYUNKNOWN)
  46:     {
  47:       char c;
  48: 
  49:       c = param_item_nm->varname[0];
  50:       if (c >= 'A' && c <= 'Z')
  51:         c = c - 'A';
  52:       else
  53:         c = c - 'a';
  54:       param_item_nm->vtype = impltype[c];
  55:       param_item_nm->vleng = ICON(implleng[c]);
  56:     }
  57:       if (param_item_nm->vtype == TYUNKNOWN)
  58:     {
  59:       warn1("type undefined for %s",
  60:         varstr(VL, param_item_nm->varname));
  61:       ((struct Paramblock *) (param_item_nm))->paramval = param_item_vl;
  62:     }
  63:       else
  64:     {
  65:       extern int badvalue;
  66:       extern expptr constconv();
  67:       int type;
  68:       ftnint len;
  69: 
  70:       type = param_item_nm->vtype;
  71:       if (type == TYCHAR)
  72:         {
  73:           if (param_item_nm->vleng != NULL)
  74:         len = param_item_nm->vleng->constblock.const.ci;
  75:           else if (ISCONST(param_item_vl) &&
  76:             param_item_vl->constblock.vtype == TYCHAR)
  77:         len = param_item_vl->constblock.vleng->
  78:             constblock.const.ci;
  79:           else
  80:         len = 1;
  81:         }
  82:       badvalue = 0;
  83:       if (ISCONST(param_item_vl))
  84:         {
  85:           ((struct Paramblock *) (param_item_nm))->paramval =
  86:             convconst(param_item_nm->vtype, len, param_item_vl);
  87:           if (type == TYLOGICAL)
  88:         ((struct Paramblock *) (param_item_nm))->paramval->
  89:           headblock.vtype = TYLOGICAL;
  90:           frexpr((tagptr) param_item_vl);
  91:         }
  92:       else
  93:         {
  94:           erri("%s set to a nonconstant",
  95:             varstr(VL, param_item_nm->varname));
  96:           ((struct Paramblock *) (param_item_nm))->paramval = param_item_vl;
  97:         }
  98:     }
  99:     }
 100: }

Defined functions

Defined variables