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.constant.ci; 75 else if (ISCONST(param_item_vl) && 76 param_item_vl->constblock.vtype == TYCHAR) 77 len = param_item_vl->constblock.vleng-> 78 constblock.constant.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 } 101