Return to paramset.c CVS log

Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / f77pass1

Annotation of cci/usr/src/usr.bin/f77/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 1.1  86/02/12  15:28:45  rcs
                     18:  * 4.3 F77. C. Keating.
                     19:  * 
                     20:  * Revision 3.2  84/10/13  03:52:03  donn
                     21:  * Setting a parameter variable to a nonconstant expression is an error;
                     22:  * previously a mere warning was emitted.  Also added a comment header.
                     23:  * 
                     24:  */
                     25: 
                     26: #include "defs.h"
                     27: #include "data.h"
                     28: 
                     29: /*     process the items in a PARAMETER statement      */
                     30: paramset( param_item_nm, param_item_vl )
                     31: Namep param_item_nm;
                     32: expptr param_item_vl;
                     33: {
                     34:   if (param_item_nm->vstg != STGUNKNOWN && param_item_nm->vstg != STGCONST )
                     35:     dclerr("conflicting declarations", param_item_nm);
                     36:   else if (param_item_nm->vclass == CLUNKNOWN)
                     37:     param_item_nm->vclass = CLPARAM;
                     38:   else if ( param_item_nm->vclass == CLPARAM )
                     39:     dclerr("redefining PARAMETER value", param_item_nm );
                     40:   else
                     41:     dclerr("conflicting declarations", param_item_nm);
                     42: 
                     43:   if (param_item_nm->vclass == CLPARAM)
                     44:     {
                     45:       if (!ISCONST(param_item_vl))
                     46:        param_item_vl = fixtype(param_item_vl);
                     47: 
                     48:       if (param_item_nm->vtype == TYUNKNOWN)
                     49:        {
                     50:          char c;
                     51: 
                     52:          c = param_item_nm->varname[0];
                     53:          if (c >= 'A' && c <= 'Z')
                     54:            c = c - 'A';
                     55:          else
                     56:            c = c - 'a';
                     57:          param_item_nm->vtype = impltype[c];
                     58:          param_item_nm->vleng = ICON(implleng[c]);
                     59:        }
                     60:       if (param_item_nm->vtype == TYUNKNOWN)
                     61:        { 
                     62:          warn1("type undefined for %s",
                     63:                varstr(VL, param_item_nm->varname));
                     64:          ((struct Paramblock *) (param_item_nm))->paramval = param_item_vl;
                     65:        }
                     66:       else
                     67:        {
                     68:          extern int badvalue;
                     69:          extern expptr constconv();
                     70:          int type;
                     71:          ftnint len;
                     72: 
                     73:          type = param_item_nm->vtype;
                     74:          if (type == TYCHAR)
                     75:            {
                     76:              if (param_item_nm->vleng != NULL)
                     77:                len = param_item_nm->vleng->constblock.const.ci;
                     78:              else if (ISCONST(param_item_vl) &&
                     79:                        param_item_vl->constblock.vtype == TYCHAR)
                     80:                len = param_item_vl->constblock.vleng->
                     81:                        constblock.const.ci;
                     82:              else
                     83:                len = 1;
                     84:            }
                     85:          badvalue = 0;
                     86:          if (ISCONST(param_item_vl))
                     87:            {
                     88:              ((struct Paramblock *) (param_item_nm))->paramval =
                     89:                convconst(param_item_nm->vtype, len, param_item_vl);
                     90:              if (type == TYLOGICAL)
                     91:                ((struct Paramblock *) (param_item_nm))->paramval->
                     92:                  headblock.vtype = TYLOGICAL;
                     93:              frexpr((tagptr) param_item_vl);
                     94:            }
                     95:          else
                     96:            {
                     97:              erri("%s set to a nonconstant",
                     98:                    varstr(VL, param_item_nm->varname));
                     99:              ((struct Paramblock *) (param_item_nm))->paramval = param_item_vl;
                    100:            }
                    101:        }
                    102:     }
                    103: }

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