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