1781Speter /* Copyright (c) 1979 Regents of the University of California */ 2781Speter 3*10664Speter static char sccsid[] = "@(#)var.c 1.14 02/01/83"; 4781Speter 5781Speter #include "whoami.h" 6781Speter #include "0.h" 7*10664Speter #include "objfmt.h" 8781Speter #include "align.h" 92075Smckusic #include "iorec.h" 10781Speter #ifdef PC 11781Speter # include "pc.h" 12781Speter # include "pcops.h" 13781Speter #endif PC 14781Speter 15781Speter /* 16781Speter * Declare variables of a var part. DPOFF1 is 17781Speter * the local variable storage for all prog/proc/func 18781Speter * modules aside from the block mark. The total size 19781Speter * of all the local variables is entered into the 20781Speter * size array. 21781Speter */ 227951Speter varbeg( lineofyvar , r ) 237951Speter int lineofyvar; 24781Speter { 257951Speter static bool var_order = FALSE; 267951Speter static bool var_seen = FALSE; 27781Speter 28837Speter /* this allows for multiple declaration 29781Speter * parts except when the "standard" 30781Speter * option has been specified. 31781Speter * If routine segment is being compiled, 32781Speter * do level one processing. 33781Speter */ 34781Speter 35781Speter #ifndef PI1 36837Speter if (!progseen) 37837Speter level1(); 387951Speter line = lineofyvar; 39837Speter if ( parts[ cbn ] & RPRT ) { 40837Speter if ( opt( 's' ) ) { 41781Speter standard(); 427951Speter error("Variable declarations should precede routine declarations"); 43837Speter } else { 447951Speter if ( !var_order ) { 457951Speter var_order = TRUE; 467951Speter warning(); 477951Speter error("Variable declarations should precede routine declarations"); 487951Speter } 49837Speter } 50781Speter } 51837Speter if ( parts[ cbn ] & VPRT ) { 52837Speter if ( opt( 's' ) ) { 53837Speter standard(); 547951Speter error("All variables should be declared in one var part"); 55837Speter } else { 567951Speter if ( !var_seen ) { 577951Speter var_seen = TRUE; 587951Speter warning(); 597951Speter error("All variables should be declared in one var part"); 607951Speter } 61837Speter } 62837Speter } 63837Speter parts[ cbn ] |= VPRT; 64781Speter #endif 65781Speter /* 66781Speter * #ifndef PI0 673229Smckusic * sizes[cbn].om_max = sizes[cbn].curtmps.om_off = -DPOFF1; 68781Speter * #endif 69781Speter */ 70781Speter forechain = NIL; 71781Speter #ifdef PI0 72781Speter send(REVVBEG); 73781Speter #endif 74781Speter } 75781Speter 76781Speter var(vline, vidl, vtype) 77781Speter #ifdef PI0 78781Speter int vline, *vidl, *vtype; 79781Speter { 80781Speter register struct nl *np; 81781Speter register int *vl; 82781Speter 83781Speter np = gtype(vtype); 84781Speter line = vline; 85781Speter for (vl = vidl; vl != NIL; vl = vl[2]) { 86781Speter } 87781Speter } 88781Speter send(REVVAR, vline, vidl, vtype); 89781Speter } 90781Speter #else 91781Speter int vline; 92781Speter register int *vidl; 93781Speter int *vtype; 94781Speter { 95781Speter register struct nl *np; 96781Speter register struct om *op; 97781Speter long w; 98781Speter int o2; 99781Speter int *ovidl = vidl; 1003836Speter struct nl *vp; 101781Speter 102781Speter np = gtype(vtype); 103781Speter line = vline; 1043949Speter w = lwidth(np); 105781Speter op = &sizes[cbn]; 106781Speter for (; vidl != NIL; vidl = vidl[2]) { 107781Speter # ifdef OBJ 1083235Smckusic op->curtmps.om_off = 1093235Smckusic roundup((int)(op->curtmps.om_off-w), (long)align(np)); 1103235Smckusic o2 = op -> curtmps.om_off; 111781Speter # endif OBJ 112781Speter # ifdef PC 113781Speter if ( cbn == 1 ) { 114781Speter /* 115781Speter * global variables are not accessed off the fp 116781Speter * but rather by their names. 117781Speter */ 118781Speter o2 = 0; 119781Speter } else { 120781Speter /* 121781Speter * locals are aligned, too. 122781Speter */ 1233229Smckusic op->curtmps.om_off = 1243229Smckusic roundup((int)(op->curtmps.om_off - w), 1253082Smckusic (long)align(np)); 1263229Smckusic o2 = op -> curtmps.om_off; 127781Speter } 128781Speter # endif PC 1293836Speter vp = enter(defnl(vidl[1], VAR, np, o2)); 130781Speter if ( np -> nl_flags & NFILES ) { 131781Speter dfiles[ cbn ] = TRUE; 132781Speter } 133781Speter # ifdef PC 134781Speter if ( cbn == 1 ) { 135781Speter putprintf( " .data" , 0 ); 136*10664Speter aligndot(align(np)); 137781Speter putprintf( " .comm " , 1 ); 138781Speter putprintf( EXTFORMAT , 1 , vidl[1] ); 139781Speter putprintf( ",%d" , 0 , w ); 140781Speter putprintf( " .text" , 0 ); 1412165Speter stabgvar( vidl[1] , p2type( np ) , o2 , w , line ); 1423836Speter vp -> extra_flags |= NGLOBAL; 1433836Speter } else { 1443836Speter vp -> extra_flags |= NLOCAL; 145781Speter } 146781Speter # endif PC 147781Speter } 148781Speter # ifdef PTREE 149781Speter { 150781Speter pPointer *Vars; 151781Speter pPointer Var = VarDecl( ovidl , vtype ); 152781Speter 153781Speter pSeize( PorFHeader[ nesting ] ); 154781Speter Vars = &( pDEF( PorFHeader[ nesting ] ).PorFVars ); 155781Speter *Vars = ListAppend( *Vars , Var ); 156781Speter pRelease( PorFHeader[ nesting ] ); 157781Speter } 158781Speter # endif 159781Speter } 160781Speter #endif 161781Speter 162781Speter varend() 163781Speter { 164781Speter 165781Speter foredecl(); 166781Speter #ifndef PI0 1673229Smckusic sizes[cbn].om_max = sizes[cbn].curtmps.om_off; 168781Speter #else 169781Speter send(REVVEND); 170781Speter #endif 171781Speter } 172781Speter 173781Speter /* 174781Speter * Evening 175781Speter */ 1763082Smckusic long 1773082Smckusic leven(w) 1783082Smckusic register long w; 1793082Smckusic { 1803082Smckusic if (w < 0) 1813082Smckusic return (w & 0xfffffffe); 1823082Smckusic return ((w+1) & 0xfffffffe); 1833082Smckusic } 1843082Smckusic 1853082Smckusic int 186781Speter even(w) 187781Speter register int w; 188781Speter { 1893082Smckusic return leven((long)w); 190781Speter } 191781Speter 192781Speter /* 193781Speter * Find the width of a type in bytes. 194781Speter */ 195781Speter width(np) 196781Speter struct nl *np; 197781Speter { 198781Speter 199781Speter return (lwidth(np)); 200781Speter } 201781Speter 202781Speter long 203781Speter lwidth(np) 204781Speter struct nl *np; 205781Speter { 206781Speter register struct nl *p; 207781Speter long w; 208781Speter 209781Speter p = np; 210781Speter if (p == NIL) 211781Speter return (0); 212781Speter loop: 213781Speter switch (p->class) { 214781Speter case TYPE: 215781Speter switch (nloff(p)) { 216781Speter case TNIL: 217781Speter return (2); 218781Speter case TSTR: 219781Speter case TSET: 220781Speter panic("width"); 221781Speter default: 222781Speter p = p->type; 223781Speter goto loop; 224781Speter } 225781Speter case ARRAY: 226781Speter return (aryconst(p, 0)); 227781Speter case PTR: 228781Speter return ( sizeof ( int * ) ); 229781Speter case FILET: 2302075Smckusic return ( sizeof(struct iorec) + lwidth( p -> type ) ); 231781Speter case RANGE: 232781Speter if (p->type == nl+TDOUBLE) 233781Speter #ifdef DEBUG 234781Speter return (hp21mx ? 4 : 8); 235781Speter #else 236781Speter return (8); 237781Speter #endif 238781Speter case SCAL: 239781Speter return (bytes(p->range[0], p->range[1])); 240781Speter case SET: 241781Speter setran(p->type); 2423082Smckusic return roundup((int)((set.uprbp >> 3) + 1), 2433082Smckusic (long)(A_SET)); 244781Speter case STR: 245781Speter case RECORD: 246781Speter return ( p->value[NL_OFFS] ); 247781Speter default: 248781Speter panic("wclass"); 249781Speter } 250781Speter } 251781Speter 252781Speter /* 253781Speter * round up x to a multiple of y 254781Speter * for computing offsets of aligned things. 255781Speter * y had better be positive. 256781Speter * rounding is in the direction of x. 257781Speter */ 258781Speter long 259781Speter roundup( x , y ) 2603082Smckusic int x; 261781Speter register long y; 262781Speter { 263781Speter 264781Speter if ( y == 0 ) { 2654030Smckusic return x; 266781Speter } 267781Speter if ( x >= 0 ) { 268781Speter return ( ( ( x + ( y - 1 ) ) / y ) * y ); 269781Speter } else { 270781Speter return ( ( ( x - ( y - 1 ) ) / y ) * y ); 271781Speter } 272781Speter } 273781Speter 274781Speter /* 275781Speter * alignment of an object using the c alignment scheme 276781Speter */ 277781Speter int 278781Speter align( np ) 279781Speter struct nl *np; 280781Speter { 281781Speter register struct nl *p; 282781Speter 283781Speter p = np; 284781Speter if ( p == NIL ) { 285781Speter return 0; 286781Speter } 287781Speter alignit: 288781Speter switch ( p -> class ) { 289781Speter case TYPE: 290781Speter switch ( nloff( p ) ) { 291781Speter case TNIL: 292781Speter return A_POINT; 293781Speter case TSTR: 294*10664Speter return A_STRUCT; 295781Speter case TSET: 296781Speter return A_SET; 297781Speter default: 298781Speter p = p -> type; 299781Speter goto alignit; 300781Speter } 301781Speter case ARRAY: 302781Speter /* 303*10664Speter * strings are structures, since they can get 304*10664Speter * assigned form/to as structure assignments. 305*10664Speter * other arrays are aligned as their component types 306781Speter */ 307*10664Speter if ( p -> type == nl+T1CHAR ) { 308*10664Speter return A_STRUCT; 309*10664Speter } 310781Speter p = p -> type; 311781Speter goto alignit; 312781Speter case PTR: 313781Speter return A_POINT; 314781Speter case FILET: 315781Speter return A_FILET; 316781Speter case RANGE: 317781Speter if ( p -> type == nl+TDOUBLE ) { 318781Speter return A_DOUBLE; 319781Speter } 320781Speter /* else, fall through */ 321781Speter case SCAL: 322781Speter switch ( bytes( p -> range[0] , p -> range[1] ) ) { 323781Speter case 4: 324781Speter return A_LONG; 325781Speter case 2: 326781Speter return A_SHORT; 327781Speter case 1: 328781Speter return A_CHAR; 329781Speter default: 330781Speter panic( "align: scal" ); 331781Speter } 332781Speter case SET: 333781Speter return A_SET; 334781Speter case STR: 335*10664Speter /* 336*10664Speter * arrays of chars are structs 337*10664Speter */ 338*10664Speter return A_STRUCT; 339781Speter case RECORD: 340781Speter /* 3418681Speter * the alignment of a record is in its align_info field 3428681Speter * why don't we use this for the rest of the namelist? 343781Speter */ 3448681Speter return p -> align_info; 345781Speter default: 346781Speter panic( "align" ); 347781Speter } 348781Speter } 349781Speter 350*10664Speter #ifdef PC 3513949Speter /* 352*10664Speter * output an alignment pseudo-op. 3533949Speter */ 354*10664Speter aligndot(alignment) 3553949Speter int alignment; 356*10664Speter #ifdef vax 3573949Speter { 358*10664Speter switch (alignment) { 359*10664Speter case 1: 360*10664Speter return; 361*10664Speter case 2: 362*10664Speter putprintf(" .align 1", 0); 363*10664Speter return; 364*10664Speter default: 365*10664Speter case 4: 366*10664Speter putprintf(" .align 2", 0); 367*10664Speter return; 3683949Speter } 3693949Speter } 370*10664Speter #endif vax 371*10664Speter #ifdef mc68000 372*10664Speter { 373*10664Speter switch (alignment) { 374*10664Speter case 1: 375*10664Speter return; 376*10664Speter default: 377*10664Speter putprintf(" .even", 0); 378*10664Speter return; 379*10664Speter } 380*10664Speter } 381*10664Speter #endif mc68000 382*10664Speter #endif PC 383*10664Speter 384781Speter /* 385781Speter * Return the width of an element 386781Speter * of a n time subscripted np. 387781Speter */ 388781Speter long aryconst(np, n) 389781Speter struct nl *np; 390781Speter int n; 391781Speter { 392781Speter register struct nl *p; 393781Speter long s, d; 394781Speter 395781Speter if ((p = np) == NIL) 396781Speter return (NIL); 397781Speter if (p->class != ARRAY) 398781Speter panic("ary"); 399781Speter s = lwidth(p->type); 400781Speter /* 401781Speter * Arrays of anything but characters are word aligned. 402781Speter */ 403781Speter if (s & 1) 404781Speter if (s != 1) 405781Speter s++; 406781Speter /* 407781Speter * Skip the first n subscripts 408781Speter */ 409781Speter while (n >= 0) { 410781Speter p = p->chain; 411781Speter n--; 412781Speter } 413781Speter /* 414781Speter * Sum across remaining subscripts. 415781Speter */ 416781Speter while (p != NIL) { 417781Speter if (p->class != RANGE && p->class != SCAL) 418781Speter panic("aryran"); 419781Speter d = p->range[1] - p->range[0] + 1; 420781Speter s *= d; 421781Speter p = p->chain; 422781Speter } 423781Speter return (s); 424781Speter } 425781Speter 426781Speter /* 427781Speter * Find the lower bound of a set, and also its size in bits. 428781Speter */ 429781Speter setran(q) 430781Speter struct nl *q; 431781Speter { 432781Speter register lb, ub; 433781Speter register struct nl *p; 434781Speter 435781Speter p = q; 436781Speter if (p == NIL) 437781Speter return (NIL); 438781Speter lb = p->range[0]; 439781Speter ub = p->range[1]; 440781Speter if (p->class != RANGE && p->class != SCAL) 441781Speter panic("setran"); 442781Speter set.lwrb = lb; 443781Speter /* set.(upperbound prime) = number of bits - 1; */ 444781Speter set.uprbp = ub-lb; 445781Speter } 446781Speter 447781Speter /* 448781Speter * Return the number of bytes required to hold an arithmetic quantity 449781Speter */ 450781Speter bytes(lb, ub) 451781Speter long lb, ub; 452781Speter { 453781Speter 454781Speter #ifndef DEBUG 455781Speter if (lb < -32768 || ub > 32767) 456781Speter return (4); 457781Speter else if (lb < -128 || ub > 127) 458781Speter return (2); 459781Speter #else 460781Speter if (!hp21mx && (lb < -32768 || ub > 32767)) 461781Speter return (4); 462781Speter if (lb < -128 || ub > 127) 463781Speter return (2); 464781Speter #endif 465781Speter else 466781Speter return (1); 467781Speter } 468