122857Smckusick /* 222857Smckusick * Copyright (c) 1980 Regents of the University of California. 322857Smckusick * All rights reserved. The Berkeley software License Agreement 422857Smckusick * specifies the terms and conditions for redistribution. 522857Smckusick */ 622857Smckusick 722857Smckusick #ifndef lint 8*33257Sbostic static char sccsid[] = "@(#)paramset.c 5.2 (Berkeley) 01/03/88"; 922857Smckusick #endif not lint 1022857Smckusick 1122857Smckusick /* 1222857Smckusick * paramset.c 1322857Smckusick * 1422857Smckusick * Routines for handling PARAMETER statements, f77 compiler, 4.2 BSD. 1522857Smckusick * 1622857Smckusick * $Log: paramset.c,v $ 1722857Smckusick * Revision 3.2 84/10/13 03:52:03 donn 1822857Smckusick * Setting a parameter variable to a nonconstant expression is an error; 1922857Smckusick * previously a mere warning was emitted. Also added a comment header. 2022857Smckusick * 2122857Smckusick */ 2222857Smckusick 2322857Smckusick #include "defs.h" 2422857Smckusick #include "data.h" 2522857Smckusick 2622857Smckusick /* process the items in a PARAMETER statement */ 2722857Smckusick paramset( param_item_nm, param_item_vl ) 2822857Smckusick Namep param_item_nm; 2922857Smckusick expptr param_item_vl; 3022857Smckusick { 3122857Smckusick if (param_item_nm->vstg != STGUNKNOWN && param_item_nm->vstg != STGCONST ) 3222857Smckusick dclerr("conflicting declarations", param_item_nm); 3322857Smckusick else if (param_item_nm->vclass == CLUNKNOWN) 3422857Smckusick param_item_nm->vclass = CLPARAM; 3522857Smckusick else if ( param_item_nm->vclass == CLPARAM ) 3622857Smckusick dclerr("redefining PARAMETER value", param_item_nm ); 3722857Smckusick else 3822857Smckusick dclerr("conflicting declarations", param_item_nm); 3922857Smckusick 4022857Smckusick if (param_item_nm->vclass == CLPARAM) 4122857Smckusick { 4222857Smckusick if (!ISCONST(param_item_vl)) 4322857Smckusick param_item_vl = fixtype(param_item_vl); 4422857Smckusick 4522857Smckusick if (param_item_nm->vtype == TYUNKNOWN) 4622857Smckusick { 4722857Smckusick char c; 4822857Smckusick 4922857Smckusick c = param_item_nm->varname[0]; 5022857Smckusick if (c >= 'A' && c <= 'Z') 5122857Smckusick c = c - 'A'; 5222857Smckusick else 5322857Smckusick c = c - 'a'; 5422857Smckusick param_item_nm->vtype = impltype[c]; 5522857Smckusick param_item_nm->vleng = ICON(implleng[c]); 5622857Smckusick } 5722857Smckusick if (param_item_nm->vtype == TYUNKNOWN) 5822857Smckusick { 5922857Smckusick warn1("type undefined for %s", 6022857Smckusick varstr(VL, param_item_nm->varname)); 6122857Smckusick ((struct Paramblock *) (param_item_nm))->paramval = param_item_vl; 6222857Smckusick } 6322857Smckusick else 6422857Smckusick { 6522857Smckusick extern int badvalue; 6622857Smckusick extern expptr constconv(); 6722857Smckusick int type; 6822857Smckusick ftnint len; 6922857Smckusick 7022857Smckusick type = param_item_nm->vtype; 7122857Smckusick if (type == TYCHAR) 7222857Smckusick { 7322857Smckusick if (param_item_nm->vleng != NULL) 74*33257Sbostic len = param_item_nm->vleng->constblock.constant.ci; 7522857Smckusick else if (ISCONST(param_item_vl) && 7622857Smckusick param_item_vl->constblock.vtype == TYCHAR) 7722857Smckusick len = param_item_vl->constblock.vleng-> 78*33257Sbostic constblock.constant.ci; 7922857Smckusick else 8022857Smckusick len = 1; 8122857Smckusick } 8222857Smckusick badvalue = 0; 8322857Smckusick if (ISCONST(param_item_vl)) 8422857Smckusick { 8522857Smckusick ((struct Paramblock *) (param_item_nm))->paramval = 8622857Smckusick convconst(param_item_nm->vtype, len, param_item_vl); 8722857Smckusick if (type == TYLOGICAL) 8822857Smckusick ((struct Paramblock *) (param_item_nm))->paramval-> 8922857Smckusick headblock.vtype = TYLOGICAL; 9022857Smckusick frexpr((tagptr) param_item_vl); 9122857Smckusick } 9222857Smckusick else 9322857Smckusick { 9422857Smckusick erri("%s set to a nonconstant", 9522857Smckusick varstr(VL, param_item_nm->varname)); 9622857Smckusick ((struct Paramblock *) (param_item_nm))->paramval = param_item_vl; 9722857Smckusick } 9822857Smckusick } 9922857Smckusick } 10022857Smckusick } 101