1748Speter /* Copyright (c) 1979 Regents of the University of California */ 2748Speter 3*18345Smckusick #ifndef lint 4*18345Smckusick static char sccsid[] = "@(#)const.c 2.2 03/15/85"; 5*18345Smckusick #endif 6748Speter 7748Speter #include "whoami.h" 8748Speter #include "0.h" 9748Speter #include "tree.h" 10*18345Smckusick #include "tree_ty.h" 11748Speter 12748Speter /* 13748Speter * Const enters the definitions 14748Speter * of the constant declaration 15748Speter * part into the namelist. 16748Speter */ 17748Speter #ifndef PI1 18*18345Smckusick constbeg( lineofyconst ) 197951Speter int lineofyconst; 20748Speter { 217951Speter static bool const_order = FALSE; 227951Speter static bool const_seen = FALSE; 23748Speter 24748Speter /* 25834Speter * this allows for multiple declaration 26748Speter * parts, unless the "standard" option 27748Speter * has been specified. 28748Speter * If a routine segment is being compiled, 29748Speter * do level one processing. 30748Speter */ 31748Speter 32748Speter if (!progseen) 33748Speter level1(); 347951Speter line = lineofyconst; 35834Speter if (parts[ cbn ] & (TPRT|VPRT|RPRT)) { 36834Speter if ( opt( 's' ) ) { 37834Speter standard(); 387951Speter error("Constant declarations should precede type, var and routine declarations"); 39834Speter } else { 407951Speter if ( !const_order ) { 417951Speter const_order = TRUE; 427951Speter warning(); 437951Speter error("Constant declarations should precede type, var and routine declarations"); 447951Speter } 45834Speter } 46834Speter } 47834Speter if (parts[ cbn ] & CPRT) { 48834Speter if ( opt( 's' ) ) { 49834Speter standard(); 507951Speter error("All constants should be declared in one const part"); 51834Speter } else { 527951Speter if ( !const_seen ) { 537951Speter const_seen = TRUE; 547951Speter warning(); 557951Speter error("All constants should be declared in one const part"); 567951Speter } 57834Speter } 58834Speter } 59834Speter parts[ cbn ] |= CPRT; 60748Speter } 61748Speter #endif PI1 62748Speter 63748Speter const(cline, cid, cdecl) 64748Speter int cline; 65748Speter register char *cid; 66*18345Smckusick register struct tnode *cdecl; 67748Speter { 68748Speter register struct nl *np; 69748Speter 70748Speter #ifdef PI0 71748Speter send(REVCNST, cline, cid, cdecl); 72748Speter #endif 73748Speter line = cline; 74748Speter gconst(cdecl); 75748Speter np = enter(defnl(cid, CONST, con.ctype, con.cival)); 76748Speter #ifndef PI0 77748Speter np->nl_flags |= NMOD; 78748Speter #endif 79748Speter 80748Speter #ifdef PC 81825Speter if (cbn == 1) { 82840Speter stabgconst( cid , line ); 83825Speter } 84748Speter #endif PC 85748Speter 86748Speter # ifdef PTREE 87748Speter { 88748Speter pPointer Const = ConstDecl( cid , cdecl ); 89748Speter pPointer *Consts; 90748Speter 91748Speter pSeize( PorFHeader[ nesting ] ); 92748Speter Consts = &( pDEF( PorFHeader[ nesting ] ).PorFConsts ); 93748Speter *Consts = ListAppend( *Consts , Const ); 94748Speter pRelease( PorFHeader[ nesting ] ); 95748Speter } 96748Speter # endif 97748Speter if (con.ctype == NIL) 98748Speter return; 99748Speter if ( con.ctype == nl + TSTR ) 100*18345Smckusick np->ptr[0] = (struct nl *) con.cpval; 101748Speter if (isa(con.ctype, "i")) 102748Speter np->range[0] = con.crval; 103748Speter else if (isa(con.ctype, "d")) 104748Speter np->real = con.crval; 10518344Smckusick # ifdef PC 10618344Smckusick if (cbn == 1 && con.ctype != NIL) { 10718344Smckusick stabconst(np); 10818344Smckusick } 10918344Smckusick # endif 110748Speter } 111748Speter 112748Speter #ifndef PI0 113748Speter #ifndef PI1 114748Speter constend() 115748Speter { 116748Speter 117748Speter } 118748Speter #endif 119748Speter #endif 120748Speter 121748Speter /* 122748Speter * Gconst extracts 123748Speter * a constant declaration 124748Speter * from the tree for it. 125748Speter * only types of constants 126748Speter * are integer, reals, strings 127748Speter * and scalars, the first two 128748Speter * being possibly signed. 129748Speter */ 130*18345Smckusick gconst(c_node) 131*18345Smckusick struct tnode *c_node; 132748Speter { 133748Speter register struct nl *np; 134*18345Smckusick register struct tnode *cn; 135748Speter char *cp; 136748Speter int negd, sgnd; 137748Speter long ci; 138748Speter 139748Speter con.ctype = NIL; 140*18345Smckusick cn = c_node; 141748Speter negd = sgnd = 0; 142748Speter loop: 143*18345Smckusick if (cn == TR_NIL || cn->sign_const.number == TR_NIL) 144*18345Smckusick return; 145*18345Smckusick switch (cn->tag) { 146748Speter default: 147748Speter panic("gconst"); 148748Speter case T_MINUSC: 149748Speter negd = 1 - negd; 150748Speter case T_PLUSC: 151748Speter sgnd++; 152*18345Smckusick cn = cn->sign_const.number; 153748Speter goto loop; 154748Speter case T_ID: 155*18345Smckusick np = lookup(cn->char_const.cptr); 156*18345Smckusick if (np == NLNIL) 157748Speter return; 158748Speter if (np->class != CONST) { 159*18345Smckusick derror("%s is a %s, not a constant as required", cn->char_const.cptr, classes[np->class]); 160748Speter return; 161748Speter } 162748Speter con.ctype = np->type; 163748Speter switch (classify(np->type)) { 164748Speter case TINT: 165748Speter con.crval = np->range[0]; 166748Speter break; 167748Speter case TDOUBLE: 168748Speter con.crval = np->real; 169748Speter break; 170748Speter case TBOOL: 171748Speter case TCHAR: 172748Speter case TSCAL: 173748Speter con.cival = np->value[0]; 174748Speter con.crval = con.cival; 175748Speter break; 176748Speter case TSTR: 177*18345Smckusick con.cpval = (char *) np->ptr[0]; 178748Speter break; 179748Speter case NIL: 180748Speter con.ctype = NIL; 181748Speter return; 182748Speter default: 183748Speter panic("gconst2"); 184748Speter } 185748Speter break; 186748Speter case T_CBINT: 187*18345Smckusick con.crval = a8tol(cn->char_const.cptr); 188748Speter goto restcon; 189748Speter case T_CINT: 190*18345Smckusick con.crval = atof(cn->char_const.cptr); 191748Speter if (con.crval > MAXINT || con.crval < MININT) { 192748Speter derror("Constant too large for this implementation"); 193748Speter con.crval = 0; 194748Speter } 195748Speter restcon: 196748Speter ci = con.crval; 197748Speter #ifndef PI0 198748Speter if (bytes(ci, ci) <= 2) 199748Speter con.ctype = nl+T2INT; 200748Speter else 201748Speter #endif 202748Speter con.ctype = nl+T4INT; 203748Speter break; 204748Speter case T_CFINT: 205748Speter con.ctype = nl+TDOUBLE; 206*18345Smckusick con.crval = atof(cn->char_const.cptr); 207748Speter break; 208748Speter case T_CSTRNG: 209*18345Smckusick cp = cn->char_const.cptr; 210748Speter if (cp[1] == 0) { 211748Speter con.ctype = nl+T1CHAR; 212748Speter con.cival = cp[0]; 213748Speter con.crval = con.cival; 214748Speter break; 215748Speter } 216748Speter con.ctype = nl+TSTR; 217748Speter con.cpval = savestr(cp); 218748Speter break; 219748Speter } 220748Speter if (sgnd) { 221*18345Smckusick if (isnta((struct nl *) con.ctype, "id")) 222*18345Smckusick derror("%s constants cannot be signed", 223*18345Smckusick nameof((struct nl *) con.ctype)); 224748Speter else { 225748Speter if (negd) 226748Speter con.crval = -con.crval; 227748Speter ci = con.crval; 228748Speter } 229748Speter } 230748Speter } 231748Speter 232748Speter #ifndef PI0 233*18345Smckusick isconst(cn) 234*18345Smckusick register struct tnode *cn; 235748Speter { 236748Speter 237*18345Smckusick if (cn == TR_NIL) 238748Speter return (1); 239*18345Smckusick switch (cn->tag) { 240748Speter case T_MINUS: 241*18345Smckusick cn->tag = T_MINUSC; 242*18345Smckusick cn->sign_const.number = 243*18345Smckusick cn->un_expr.expr; 244*18345Smckusick return (isconst(cn->sign_const.number)); 245748Speter case T_PLUS: 246*18345Smckusick cn->tag = T_PLUSC; 247*18345Smckusick cn->sign_const.number = 248*18345Smckusick cn->un_expr.expr; 249*18345Smckusick return (isconst(cn->sign_const.number)); 250748Speter case T_VAR: 251*18345Smckusick if (cn->var_node.qual != TR_NIL) 252748Speter return (0); 253*18345Smckusick cn->tag = T_ID; 254*18345Smckusick cn->char_const.cptr = 255*18345Smckusick cn->var_node.cptr; 256748Speter return (1); 257748Speter case T_BINT: 258*18345Smckusick cn->tag = T_CBINT; 259*18345Smckusick cn->char_const.cptr = 260*18345Smckusick cn->const_node.cptr; 261748Speter return (1); 262748Speter case T_INT: 263*18345Smckusick cn->tag = T_CINT; 264*18345Smckusick cn->char_const.cptr = 265*18345Smckusick cn->const_node.cptr; 266748Speter return (1); 267748Speter case T_FINT: 268*18345Smckusick cn->tag = T_CFINT; 269*18345Smckusick cn->char_const.cptr = 270*18345Smckusick cn->const_node.cptr; 271748Speter return (1); 272748Speter case T_STRNG: 273*18345Smckusick cn->tag = T_CSTRNG; 274*18345Smckusick cn->char_const.cptr = 275*18345Smckusick cn->const_node.cptr; 276748Speter return (1); 277748Speter } 278748Speter return (0); 279748Speter } 280748Speter #endif 281