Return to paramset.c CVS log

Up to [CSRG BSD Unix] / 43BSD / usr.bin / f77 / src / f77pass1

Annotation of 43BSD/usr.bin/f77/src/f77pass1/paramset.c, revision 1.1.1.1

1.1       root        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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.