Commit | Line | Data |
---|---|---|
3c5d933b SJ |
1 | # include "mfile1" |
2 | ||
3 | struct instk { | |
4 | int in_sz; /* size of array element */ | |
5 | int in_x; /* current index for structure member in structure initializations */ | |
6 | int in_n; /* number of initializations seen */ | |
7 | int in_s; /* sizoff */ | |
8 | int in_d; /* dimoff */ | |
9 | TWORD in_t; /* type */ | |
10 | int in_id; /* stab index */ | |
11 | int in_fl; /* flag which says if this level is controlled by {} */ | |
12 | OFFSZ in_off; /* offset of the beginning of this level */ | |
13 | } | |
14 | instack[10], | |
15 | *pstk; | |
16 | ||
17 | /* defines used for getting things off of the initialization stack */ | |
18 | ||
19 | ||
20 | struct symtab *relook(); | |
21 | ||
22 | ||
23 | int ddebug = 0; | |
24 | ||
25 | defid( q, class ) NODE *q; { | |
26 | register struct symtab *p; | |
27 | int idp; | |
28 | TWORD type; | |
29 | TWORD stp; | |
30 | int scl; | |
31 | int dsym, ddef; | |
32 | int slev, temp; | |
33 | ||
34 | if( q == NIL ) return; /* an error was detected */ | |
35 | ||
36 | if( q < node || q >= &node[TREESZ] ) cerror( "defid call" ); | |
37 | ||
38 | idp = q->rval; | |
39 | ||
40 | if( idp < 0 ) cerror( "tyreduce" ); | |
41 | p = &stab[idp]; | |
42 | ||
43 | if( ddebug ){ | |
44 | printf( "defid( %.8s (%d), ", p->sname, idp ); | |
45 | tprint( q->type ); | |
46 | printf( ", %s, (%d,%d) ), level %d\n", scnames(class), q->cdim, q->csiz, blevel ); | |
47 | } | |
48 | ||
49 | fixtype( q, class ); | |
50 | ||
51 | type = q->type; | |
52 | class = fixclass( class, type ); | |
53 | ||
54 | stp = p->stype; | |
55 | slev = p->slevel; | |
56 | ||
57 | if( ddebug ){ | |
58 | printf( " modified to " ); | |
59 | tprint( type ); | |
60 | printf( ", %s\n", scnames(class) ); | |
61 | printf( " previous def'n: " ); | |
62 | tprint( stp ); | |
63 | printf( ", %s, (%d,%d) ), level %d\n", scnames(p->sclass), p->dimoff, p->sizoff, slev ); | |
64 | } | |
65 | ||
66 | if( stp == UNDEF|| stp == FARG ){ | |
67 | if( blevel==1 && stp!=FARG ) switch( class ){ | |
68 | ||
69 | default: | |
70 | if(!(class&FIELD)) uerror( "declared argument %.8s is missing", p->sname ); | |
71 | case MOS: | |
72 | case STNAME: | |
73 | case MOU: | |
74 | case UNAME: | |
75 | case MOE: | |
76 | case ENAME: | |
77 | case TYPEDEF: | |
78 | ; | |
79 | } | |
80 | goto enter; | |
81 | } | |
82 | if( type != stp ) goto mismatch; | |
83 | /* test (and possibly adjust) dimensions */ | |
84 | dsym = p->dimoff; | |
85 | ddef = q->cdim; | |
86 | for( temp=type; temp&TMASK; temp = DECREF(temp) ){ | |
87 | if( ISARY(temp) ){ | |
88 | if( dimtab[dsym] == 0 ) dimtab[dsym] = dimtab[ddef]; | |
89 | else if( dimtab[ddef]!=0 && dimtab[dsym] != dimtab[ddef] ){ | |
90 | goto mismatch; | |
91 | } | |
92 | ++dsym; | |
93 | ++ddef; | |
94 | } | |
95 | } | |
96 | ||
97 | /* check that redeclarations are to the same structure */ | |
98 | if( (temp==STRTY||temp==UNIONTY||temp==ENUMTY) && p->sizoff != q->csiz && (type&TMASK) ) { | |
99 | goto mismatch; | |
100 | } | |
101 | ||
102 | scl = ( p->sclass ); | |
103 | ||
104 | if( ddebug ){ | |
105 | printf( " previous class: %s\n", scnames(scl) ); | |
106 | } | |
107 | ||
108 | if( class&FIELD ){ | |
109 | /* redefinition */ | |
110 | if( !falloc( p, class&FLDSIZ, 1, NIL ) ) { | |
111 | /* successful allocation */ | |
112 | psave( idp ); | |
113 | return; | |
114 | } | |
115 | /* blew it: resume at end of switch... */ | |
116 | } | |
117 | ||
118 | else switch( class ){ | |
119 | ||
120 | case EXTERN: | |
121 | switch( scl ){ | |
122 | case STATIC: | |
123 | case USTATIC: | |
124 | if( slev==0 ) return; | |
125 | break; | |
126 | case EXTDEF: | |
127 | case EXTERN: | |
128 | case FORTRAN: | |
129 | case UFORTRAN: | |
130 | return; | |
131 | } | |
132 | break; | |
133 | ||
134 | case STATIC: | |
135 | if( scl==USTATIC || (scl==EXTERN && blevel==0) ){ | |
136 | p->sclass = STATIC; | |
137 | if( ISFTN(type) ) curftn = idp; | |
138 | return; | |
139 | } | |
140 | break; | |
141 | ||
142 | case USTATIC: | |
143 | if( scl==STATIC || scl==USTATIC ) return; | |
144 | break; | |
145 | ||
146 | case LABEL: | |
147 | if( scl == ULABEL ){ | |
148 | p->sclass = LABEL; | |
149 | deflab( p->offset ); | |
150 | return; | |
151 | } | |
152 | break; | |
153 | ||
154 | case TYPEDEF: | |
155 | if( scl == class ) return; | |
156 | break; | |
157 | ||
158 | case UFORTRAN: | |
159 | if( scl == UFORTRAN || scl == FORTRAN ) return; | |
160 | break; | |
161 | ||
162 | case FORTRAN: | |
163 | if( scl == UFORTRAN ){ | |
164 | p->sclass = FORTRAN; | |
165 | if( ISFTN(type) ) curftn = idp; | |
166 | return; | |
167 | } | |
168 | break; | |
169 | ||
170 | case MOU: | |
171 | case MOS: | |
172 | if( scl == class ) { | |
173 | if( oalloc( p, &strucoff ) ) break; | |
174 | if( class == MOU ) strucoff = 0; | |
175 | psave( idp ); | |
176 | return; | |
177 | } | |
178 | break; | |
179 | ||
180 | case MOE: | |
181 | if( scl == class ){ | |
182 | if( p->offset!= strucoff++ ) break; | |
183 | psave( idp ); | |
184 | } | |
185 | break; | |
186 | ||
187 | case EXTDEF: | |
188 | if( scl == EXTERN ) { | |
189 | p->sclass = EXTDEF; | |
190 | if( ISFTN(type) ) curftn = idp; | |
191 | return; | |
192 | } | |
193 | break; | |
194 | ||
195 | case STNAME: | |
196 | case UNAME: | |
197 | case ENAME: | |
198 | if( scl != class ) break; | |
199 | if( dimtab[p->sizoff] == 0 ) return; /* previous entry just a mention */ | |
200 | break; | |
201 | ||
202 | case ULABEL: | |
203 | if( scl == LABEL || scl == ULABEL ) return; | |
204 | case PARAM: | |
205 | case AUTO: | |
206 | case REGISTER: | |
207 | ; /* mismatch.. */ | |
208 | ||
209 | } | |
210 | ||
211 | mismatch: | |
212 | if( blevel > slev && class != EXTERN && class != FORTRAN && | |
213 | class != UFORTRAN && !( class == LABEL && slev >= 2 ) ){ | |
214 | q->rval = idp = hide( p ); | |
215 | p = &stab[idp]; | |
216 | goto enter; | |
217 | } | |
218 | uerror( "redeclaration of %.8s", p->sname ); | |
219 | if( class==EXTDEF && ISFTN(type) ) curftn = idp; | |
220 | return; | |
221 | ||
222 | enter: /* make a new entry */ | |
223 | ||
224 | if( ddebug ) printf( " new entry made\n" ); | |
225 | p->stype = type; | |
226 | p->sclass = class; | |
227 | p->slevel = blevel; | |
228 | p->offset = NOOFFSET; | |
229 | p->suse = lineno; | |
230 | if( class == STNAME || class == UNAME || class == ENAME ) { | |
231 | p->sizoff = curdim; | |
232 | dstash( 0 ); /* size */ | |
233 | dstash( -1 ); /* index to members of str or union */ | |
234 | dstash( ALSTRUCT ); /* alignment */ | |
235 | } | |
236 | else { | |
237 | switch( BTYPE(type) ){ | |
238 | case STRTY: | |
239 | case UNIONTY: | |
240 | case ENUMTY: | |
241 | p->sizoff = q->csiz; | |
242 | break; | |
243 | default: | |
244 | p->sizoff = BTYPE(type); | |
245 | } | |
246 | } | |
247 | ||
248 | /* copy dimensions */ | |
249 | ||
250 | p->dimoff = q->cdim; | |
251 | ||
252 | /* allocate offsets */ | |
253 | if( class&FIELD ){ | |
254 | falloc( p, class&FLDSIZ, 0, NIL ); /* new entry */ | |
255 | psave( idp ); | |
256 | } | |
257 | else switch( class ){ | |
258 | ||
259 | case AUTO: | |
260 | oalloc( p, &autooff ); | |
261 | break; | |
262 | case STATIC: | |
263 | case EXTDEF: | |
264 | p->offset = getlab(); | |
265 | if( ISFTN(type) ) curftn = idp; | |
266 | break; | |
267 | case ULABEL: | |
268 | case LABEL: | |
269 | p->offset = getlab(); | |
270 | p->slevel = 2; | |
271 | if( class == LABEL ){ | |
272 | locctr( PROG ); | |
273 | deflab( p->offset ); | |
274 | } | |
275 | break; | |
276 | ||
277 | case EXTERN: | |
278 | case UFORTRAN: | |
279 | case FORTRAN: | |
280 | p->offset = getlab(); | |
281 | p->slevel = 0; | |
282 | break; | |
283 | case MOU: | |
284 | case MOS: | |
285 | oalloc( p, &strucoff ); | |
286 | if( class == MOU ) strucoff = 0; | |
287 | psave( idp ); | |
288 | break; | |
289 | ||
290 | case MOE: | |
291 | p->offset = strucoff++; | |
292 | psave( idp ); | |
293 | break; | |
294 | case REGISTER: | |
295 | p->offset = regvar--; | |
296 | if( blevel == 1 ) p->sflags |= SSET; | |
297 | if( regvar < minrvar ) minrvar = regvar; | |
298 | break; | |
299 | } | |
300 | ||
301 | /* user-supplied routine to fix up new definitions */ | |
302 | ||
303 | FIXDEF(p); | |
304 | ||
305 | if( ddebug ) printf( " dimoff, sizoff, offset: %d, %d, %d\n", p->dimoff, p->sizoff, p->offset ); | |
306 | ||
307 | } | |
308 | ||
309 | psave( i ){ | |
310 | if( paramno >= PARAMSZ ){ | |
311 | cerror( "parameter stack overflow"); | |
312 | } | |
313 | paramstk[ paramno++ ] = i; | |
314 | } | |
315 | ||
316 | ftnend(){ /* end of function */ | |
317 | if( retlab != NOLAB ){ /* inside a real function */ | |
318 | efcode(); | |
319 | } | |
320 | checkst(0); | |
321 | retstat = 0; | |
322 | tcheck(); | |
323 | curclass = SNULL; | |
324 | brklab = contlab = retlab = NOLAB; | |
325 | flostat = 0; | |
326 | if( nerrors == 0 ){ | |
327 | if( psavbc != & asavbc[0] ) cerror("bcsave error"); | |
328 | if( paramno != 0 ) cerror("parameter reset error"); | |
329 | if( swx != 0 ) cerror( "switch error"); | |
330 | } | |
331 | psavbc = &asavbc[0]; | |
332 | paramno = 0; | |
333 | autooff = AUTOINIT; | |
334 | minrvar = regvar = MAXRVAR; | |
335 | reached = 1; | |
336 | swx = 0; | |
337 | swp = swtab; | |
338 | locctr(DATA); | |
339 | } | |
340 | ||
341 | dclargs(){ | |
342 | register i, j; | |
343 | register struct symtab *p; | |
344 | register NODE *q; | |
345 | argoff = ARGINIT; | |
346 | for( i=0; i<paramno; ++i ){ | |
347 | if( (j = paramstk[i]) < 0 ) continue; | |
348 | p = &stab[j]; | |
349 | if( p->stype == FARG ) { | |
350 | q = block(FREE,NIL,NIL,INT,0,INT); | |
351 | q->rval = j; | |
352 | defid( q, PARAM ); | |
353 | } | |
354 | oalloc( p, &argoff ); /* always set aside space, even for register arguments */ | |
355 | } | |
356 | cendarg(); | |
357 | locctr(PROG); | |
358 | defalign(ALINT); | |
359 | ++ftnno; | |
360 | bfcode( paramstk, paramno ); | |
361 | paramno = 0; | |
362 | } | |
363 | ||
364 | NODE * | |
365 | rstruct( idn, soru ){ /* reference to a structure or union, with no definition */ | |
366 | register struct symtab *p; | |
367 | register NODE *q; | |
368 | p = &stab[idn]; | |
369 | switch( p->stype ){ | |
370 | ||
371 | case UNDEF: | |
372 | def: | |
373 | q = block( FREE, NIL, NIL, 0, 0, 0 ); | |
374 | q->rval = idn; | |
375 | q->type = (soru&INSTRUCT) ? STRTY : ( (soru&INUNION) ? UNIONTY : ENUMTY ); | |
376 | defid( q, (soru&INSTRUCT) ? STNAME : ( (soru&INUNION) ? UNAME : ENAME ) ); | |
377 | break; | |
378 | ||
379 | case STRTY: | |
380 | if( soru & INSTRUCT ) break; | |
381 | goto def; | |
382 | ||
383 | case UNIONTY: | |
384 | if( soru & INUNION ) break; | |
385 | goto def; | |
386 | ||
387 | case ENUMTY: | |
388 | if( !(soru&(INUNION|INSTRUCT)) ) break; | |
389 | goto def; | |
390 | ||
391 | } | |
392 | stwart = instruct; | |
393 | return( mkty( p->stype, 0, p->sizoff ) ); | |
394 | } | |
395 | ||
396 | moedef( idn ){ | |
397 | register NODE *q; | |
398 | ||
399 | q = block( FREE, NIL, NIL, MOETY, 0, 0 ); | |
400 | q -> rval = idn; | |
401 | if( idn>=0 ) defid( q, MOE ); | |
402 | } | |
403 | ||
404 | bstruct( idn, soru ){ /* begining of structure or union declaration */ | |
405 | register NODE *q; | |
406 | ||
407 | psave( instruct ); | |
408 | psave( curclass ); | |
409 | psave( strucoff ); | |
410 | strucoff = 0; | |
411 | instruct = soru; | |
412 | q = block( FREE, NIL, NIL, 0, 0, 0 ); | |
413 | q->rval = idn; | |
414 | if( instruct==INSTRUCT ){ | |
415 | curclass = MOS; | |
416 | q->type = STRTY; | |
417 | if( idn >= 0 ) defid( q, STNAME ); | |
418 | } | |
419 | else if( instruct == INUNION ) { | |
420 | curclass = MOU; | |
421 | q->type = UNIONTY; | |
422 | if( idn >= 0 ) defid( q, UNAME ); | |
423 | } | |
424 | else { /* enum */ | |
425 | curclass = MOE; | |
426 | q->type = ENUMTY; | |
427 | if( idn >= 0 ) defid( q, ENAME ); | |
428 | } | |
429 | psave( q->rval ); | |
430 | return( paramno-4 ); | |
431 | } | |
432 | ||
433 | NODE * | |
434 | dclstruct( oparam ){ | |
435 | register struct symtab *p; | |
436 | register i, al, sa, j, sz, szindex; | |
437 | register TWORD temp; | |
438 | register high, low; | |
439 | ||
440 | /* paramstack contains: | |
441 | paramstack[ oparam ] = previous instruct | |
442 | paramstack[ oparam+1 ] = previous class | |
443 | paramstk[ oparam+2 ] = previous strucoff | |
444 | paramstk[ oparam+3 ] = structure name | |
445 | ||
446 | paramstk[ oparam+4, ... ] = member stab indices | |
447 | ||
448 | */ | |
449 | ||
450 | ||
451 | if( (i=paramstk[oparam+3]) < 0 ){ | |
452 | szindex = curdim; | |
453 | dstash( 0 ); /* size */ | |
454 | dstash( -1 ); /* index to member names */ | |
455 | dstash( ALSTRUCT ); /* alignment */ | |
456 | } | |
457 | else { | |
458 | szindex = stab[i].sizoff; | |
459 | } | |
460 | ||
461 | if( ddebug ){ | |
462 | printf( "dclstruct( %.8s ), szindex = %d\n", (i>=0)? stab[i].sname : "??", szindex ); | |
463 | } | |
464 | temp = (instruct&INSTRUCT)?STRTY:((instruct&INUNION)?UNIONTY:ENUMTY); | |
465 | stwart = instruct = paramstk[ oparam ]; | |
466 | curclass = paramstk[ oparam+1 ]; | |
467 | dimtab[ szindex+1 ] = curdim; | |
468 | al = ALSTRUCT; | |
469 | ||
470 | high = low = 0; | |
471 | ||
472 | for( i = oparam+4; i< paramno; ++i ){ | |
473 | dstash( j=paramstk[i] ); | |
474 | if( j<0 || j>= SYMTSZ ) cerror( "gummy structure member" ); | |
475 | p = &stab[j]; | |
476 | if( temp == ENUMTY ){ | |
477 | if( p->offset < low ) low = p->offset; | |
478 | if( p->offset > high ) high = p->offset; | |
479 | p->sizoff = szindex; | |
480 | continue; | |
481 | } | |
482 | sa = talign( p->stype, p->sizoff ); | |
483 | if( p->sclass & FIELD ){ | |
484 | sz = p->sclass&FLDSIZ; | |
485 | } | |
486 | else { | |
487 | sz = tsize( p->stype, p->dimoff, p->sizoff ); | |
488 | } | |
489 | if( sz == 0 ){ | |
490 | uerror( "illegal zero sized structure member: %.8s", p->sname ); | |
491 | } | |
492 | if( sz > strucoff ) strucoff = sz; /* for use with unions */ | |
493 | SETOFF( al, sa ); | |
494 | /* set al, the alignment, to the lcm of the alignments of the members */ | |
495 | } | |
496 | dstash( -1 ); /* endmarker */ | |
497 | SETOFF( strucoff, al ); | |
498 | ||
499 | if( temp == ENUMTY ){ | |
500 | register TWORD ty; | |
501 | ||
502 | # ifdef ENUMSIZE | |
503 | ty = ENUMSIZE(high,low); | |
504 | # else | |
505 | if( (char)high == high && (char)low == low ) ty = ctype( CHAR ); | |
506 | else if( (short)high == high && (short)low == low ) ty = ctype( SHORT ); | |
507 | else ty = ctype(INT); | |
508 | #endif | |
509 | strucoff = tsize( ty, 0, (int)ty ); | |
510 | dimtab[ szindex+2 ] = al = talign( ty, (int)ty ); | |
511 | } | |
512 | ||
513 | if( strucoff == 0 ) uerror( "zero sized structure" ); | |
514 | dimtab[ szindex ] = strucoff; | |
515 | dimtab[ szindex+2 ] = al; | |
516 | ||
517 | if( ddebug>1 ){ | |
518 | printf( "\tdimtab[%d,%d,%d] = %d,%d,%d\n", szindex,szindex+1,szindex+2, | |
519 | dimtab[szindex],dimtab[szindex+1],dimtab[szindex+2] ); | |
520 | for( i = dimtab[szindex+1]; dimtab[i] >= 0; ++i ){ | |
521 | printf( "\tmember %.8s(%d)\n", stab[dimtab[i]].sname, dimtab[i] ); | |
522 | } | |
523 | } | |
524 | ||
525 | strucoff = paramstk[ oparam+2 ]; | |
526 | paramno = oparam; | |
527 | ||
528 | return( mkty( temp, 0, szindex ) ); | |
529 | } | |
530 | ||
531 | /* VARARGS */ | |
532 | yyerror( s ) char *s; { /* error printing routine in parser */ | |
533 | ||
534 | uerror( s ); | |
535 | ||
536 | } | |
537 | ||
538 | yyaccpt(){ | |
539 | ftnend(); | |
540 | } | |
541 | ||
542 | ftnarg( idn ) { | |
543 | if( stab[idn].stype != UNDEF ){ | |
544 | idn = hide( &stab[idn]); | |
545 | } | |
546 | stab[idn].stype = FARG; | |
547 | stab[idn].sclass = PARAM; | |
548 | psave( idn ); | |
549 | } | |
550 | ||
551 | talign( ty, s) register unsigned ty; register s; { | |
552 | /* compute the alignment of an object with type ty, sizeoff index s */ | |
553 | ||
554 | register i; | |
555 | if( s<0 && ty!=INT && ty!=CHAR && ty!=SHORT && ty!=UNSIGNED && ty!=UCHAR && ty!=USHORT | |
556 | #ifdef LONGFIELDS | |
557 | && ty!=LONG && ty!=ULONG | |
558 | #endif | |
559 | ){ | |
560 | return( fldal( ty ) ); | |
561 | } | |
562 | ||
563 | for( i=0; i<=(SZINT-BTSHIFT-1); i+=TSHIFT ){ | |
564 | switch( (ty>>i)&TMASK ){ | |
565 | ||
566 | case FTN: | |
567 | cerror( "compiler takes alignment of function"); | |
568 | case PTR: | |
569 | return( ALPOINT ); | |
570 | case ARY: | |
571 | continue; | |
572 | case 0: | |
573 | break; | |
574 | } | |
575 | } | |
576 | ||
577 | switch( BTYPE(ty) ){ | |
578 | ||
579 | case UNIONTY: | |
580 | case ENUMTY: | |
581 | case STRTY: | |
582 | return( dimtab[ s+2 ] ); | |
583 | case CHAR: | |
584 | case UCHAR: | |
585 | return( ALCHAR ); | |
586 | case FLOAT: | |
587 | return( ALFLOAT ); | |
588 | case DOUBLE: | |
589 | return( ALDOUBLE ); | |
590 | case LONG: | |
591 | case ULONG: | |
592 | return( ALLONG ); | |
593 | case SHORT: | |
594 | case USHORT: | |
595 | return( ALSHORT ); | |
596 | default: | |
597 | return( ALINT ); | |
598 | } | |
599 | } | |
600 | ||
601 | OFFSZ | |
602 | tsize( ty, d, s ) TWORD ty; { | |
603 | /* compute the size associated with type ty, | |
604 | dimoff d, and sizoff s */ | |
605 | /* BETTER NOT BE CALLED WHEN t, d, and s REFER TO A BIT FIELD... */ | |
606 | ||
607 | int i; | |
608 | OFFSZ mult; | |
609 | ||
610 | mult = 1; | |
611 | ||
612 | for( i=0; i<=(SZINT-BTSHIFT-1); i+=TSHIFT ){ | |
613 | switch( (ty>>i)&TMASK ){ | |
614 | ||
615 | case FTN: | |
616 | cerror( "compiler takes size of function"); | |
617 | case PTR: | |
618 | return( SZPOINT * mult ); | |
619 | case ARY: | |
620 | mult *= dimtab[ d++ ]; | |
621 | continue; | |
622 | case 0: | |
623 | break; | |
624 | ||
625 | } | |
626 | } | |
627 | ||
628 | if( dimtab[s]==0 ) { | |
629 | uerror( "unknown size"); | |
630 | return( SZINT ); | |
631 | } | |
632 | return( dimtab[ s ] * mult ); | |
633 | } | |
634 | ||
635 | inforce( n ) OFFSZ n; { /* force inoff to have the value n */ | |
636 | /* inoff is updated to have the value n */ | |
637 | OFFSZ wb; | |
638 | register rest; | |
639 | /* rest is used to do a lot of conversion to ints... */ | |
640 | ||
641 | if( inoff == n ) return; | |
642 | if( inoff > n ) { | |
643 | cerror( "initialization alignment error"); | |
644 | } | |
645 | ||
646 | wb = inoff; | |
647 | SETOFF( wb, SZINT ); | |
648 | ||
649 | /* wb now has the next higher word boundary */ | |
650 | ||
651 | if( wb >= n ){ /* in the same word */ | |
652 | rest = n - inoff; | |
653 | vfdzero( rest ); | |
654 | return; | |
655 | } | |
656 | ||
657 | /* otherwise, extend inoff to be word aligned */ | |
658 | ||
659 | rest = wb - inoff; | |
660 | vfdzero( rest ); | |
661 | ||
662 | /* now, skip full words until near to n */ | |
663 | ||
664 | rest = (n-inoff)/SZINT; | |
665 | zecode( rest ); | |
666 | ||
667 | /* now, the remainder of the last word */ | |
668 | ||
669 | rest = n-inoff; | |
670 | vfdzero( rest ); | |
671 | if( inoff != n ) cerror( "inoff error"); | |
672 | ||
673 | } | |
674 | ||
675 | vfdalign( n ){ /* make inoff have the offset the next alignment of n */ | |
676 | OFFSZ m; | |
677 | ||
678 | m = inoff; | |
679 | SETOFF( m, n ); | |
680 | inforce( m ); | |
681 | } | |
682 | ||
683 | ||
684 | int idebug = 0; | |
685 | ||
686 | int ibseen = 0; /* the number of } constructions which have been filled */ | |
687 | ||
688 | int iclass; /* storage class of thing being initialized */ | |
689 | ||
690 | int ilocctr = 0; /* location counter for current initialization */ | |
691 | ||
692 | beginit(curid){ | |
693 | /* beginning of initilization; set location ctr and set type */ | |
694 | register struct symtab *p; | |
695 | ||
696 | if( idebug >= 3 ) printf( "beginit(), curid = %d\n", curid ); | |
697 | ||
698 | p = &stab[curid]; | |
699 | ||
700 | iclass = p->sclass; | |
701 | if( curclass == EXTERN || curclass == FORTRAN ) iclass = EXTERN; | |
702 | switch( iclass ){ | |
703 | ||
704 | case UNAME: | |
705 | case EXTERN: | |
706 | return; | |
707 | case AUTO: | |
708 | case REGISTER: | |
709 | break; | |
710 | case EXTDEF: | |
711 | case STATIC: | |
712 | ilocctr = ISARY(p->stype)?ADATA:DATA; | |
713 | locctr( ilocctr ); | |
714 | defalign( talign( p->stype, p->sizoff ) ); | |
715 | defnam( p ); | |
716 | ||
717 | } | |
718 | ||
719 | inoff = 0; | |
720 | ibseen = 0; | |
721 | ||
722 | pstk = 0; | |
723 | ||
724 | instk( curid, p->stype, p->dimoff, p->sizoff, inoff ); | |
725 | ||
726 | } | |
727 | ||
728 | instk( id, t, d, s, off ) OFFSZ off; TWORD t; { | |
729 | /* make a new entry on the parameter stack to initialize id */ | |
730 | ||
731 | register struct symtab *p; | |
732 | ||
733 | for(;;){ | |
734 | if( idebug ) printf( "instk((%d, %o,%d,%d, %d)\n", id, t, d, s, off ); | |
735 | ||
736 | /* save information on the stack */ | |
737 | ||
738 | if( !pstk ) pstk = instack; | |
739 | else ++pstk; | |
740 | ||
741 | pstk->in_fl = 0; /* { flag */ | |
742 | pstk->in_id = id ; | |
743 | pstk->in_t = t ; | |
744 | pstk->in_d = d ; | |
745 | pstk->in_s = s ; | |
746 | pstk->in_n = 0; /* number seen */ | |
747 | pstk->in_x = t==STRTY ?dimtab[s+1] : 0 ; | |
748 | pstk->in_off = off; /* offset at the beginning of this element */ | |
749 | /* if t is an array, DECREF(t) can't be a field */ | |
750 | /* INS_sz has size of array elements, and -size for fields */ | |
751 | if( ISARY(t) ){ | |
752 | pstk->in_sz = tsize( DECREF(t), d+1, s ); | |
753 | } | |
754 | else if( stab[id].sclass & FIELD ){ | |
755 | pstk->in_sz = - ( stab[id].sclass & FLDSIZ ); | |
756 | } | |
757 | else { | |
758 | pstk->in_sz = 0; | |
759 | } | |
760 | ||
761 | if( (iclass==AUTO || iclass == REGISTER ) && | |
762 | (ISARY(t) || t==STRTY) ) uerror( "no automatic aggregate initialization" ); | |
763 | ||
764 | /* now, if this is not a scalar, put on another element */ | |
765 | ||
766 | if( ISARY(t) ){ | |
767 | t = DECREF(t); | |
768 | ++d; | |
769 | continue; | |
770 | } | |
771 | else if( t == STRTY ){ | |
772 | id = dimtab[pstk->in_x]; | |
773 | p = &stab[id]; | |
774 | if( p->sclass != MOS && !(p->sclass&FIELD) ) cerror( "insane structure member list" ); | |
775 | t = p->stype; | |
776 | d = p->dimoff; | |
777 | s = p->sizoff; | |
778 | off += p->offset; | |
779 | continue; | |
780 | } | |
781 | else return; | |
782 | } | |
783 | } | |
784 | ||
785 | NODE * | |
786 | getstr(){ /* decide if the string is external or an initializer, and get the contents accordingly */ | |
787 | ||
788 | register l, temp; | |
789 | register NODE *p; | |
790 | ||
791 | if( (iclass==EXTDEF||iclass==STATIC) && (pstk->in_t == CHAR || pstk->in_t == UCHAR) && | |
792 | pstk!=instack && ISARY( pstk[-1].in_t ) ){ | |
793 | /* treat "abc" as { 'a', 'b', 'c', 0 } */ | |
794 | strflg = 1; | |
795 | ilbrace(); /* simulate { */ | |
796 | inforce( pstk->in_off ); | |
797 | /* if the array is inflexible (not top level), pass in the size and | |
798 | be prepared to throw away unwanted initializers */ | |
799 | lxstr((pstk-1)!=instack?dimtab[(pstk-1)->in_d]:0); /* get the contents */ | |
800 | irbrace(); /* simulate } */ | |
801 | return( NIL ); | |
802 | } | |
803 | else { /* make a label, and get the contents and stash them away */ | |
804 | if( iclass != SNULL ){ /* initializing */ | |
805 | /* fill out previous word, to permit pointer */ | |
806 | vfdalign( ALPOINT ); | |
807 | } | |
808 | temp = locctr( blevel==0?ISTRNG:STRNG ); /* set up location counter */ | |
809 | deflab( l = getlab() ); | |
810 | strflg = 0; | |
811 | lxstr(0); /* get the contents */ | |
812 | locctr( blevel==0?ilocctr:temp ); | |
813 | p = buildtree( STRING, NIL, NIL ); | |
814 | p->rval = -l; | |
815 | return(p); | |
816 | } | |
817 | } | |
818 | ||
819 | putbyte( v ){ /* simulate byte v appearing in a list of integer values */ | |
820 | register NODE *p; | |
821 | p = bcon(v); | |
822 | incode( p, SZCHAR ); | |
823 | tfree( p ); | |
824 | gotscal(); | |
825 | } | |
826 | ||
827 | endinit(){ | |
828 | register TWORD t; | |
829 | register d, s, n, d1; | |
830 | ||
831 | if( idebug ) printf( "endinit(), inoff = %d\n", inoff ); | |
832 | ||
833 | switch( iclass ){ | |
834 | ||
835 | case EXTERN: | |
836 | case AUTO: | |
837 | case REGISTER: | |
838 | return; | |
839 | } | |
840 | ||
841 | pstk = instack; | |
842 | ||
843 | t = pstk->in_t; | |
844 | d = pstk->in_d; | |
845 | s = pstk->in_s; | |
846 | n = pstk->in_n; | |
847 | ||
848 | if( ISARY(t) ){ | |
849 | d1 = dimtab[d]; | |
850 | ||
851 | vfdalign( pstk->in_sz ); /* fill out part of the last element, if needed */ | |
852 | n = inoff/pstk->in_sz; /* real number of initializers */ | |
853 | if( d1 >= n ){ | |
854 | /* once again, t is an array, so no fields */ | |
855 | inforce( tsize( t, d, s ) ); | |
856 | n = d1; | |
857 | } | |
858 | if( d1!=0 && d1!=n ) uerror( "too many initializers"); | |
859 | if( n==0 ) werror( "empty array declaration"); | |
860 | dimtab[d] = n; | |
861 | } | |
862 | ||
863 | else if( t == STRTY || t == UNIONTY ){ | |
864 | /* clearly not fields either */ | |
865 | inforce( tsize( t, d, s ) ); | |
866 | } | |
867 | else if( n > 1 ) uerror( "bad scalar initialization"); | |
868 | /* this will never be called with a field element... */ | |
869 | else inforce( tsize(t,d,s) ); | |
870 | ||
871 | paramno = 0; | |
872 | vfdalign( AL_INIT ); | |
873 | inoff = 0; | |
874 | iclass = SNULL; | |
875 | ||
876 | } | |
877 | ||
878 | doinit( p ) register NODE *p; { | |
879 | ||
880 | /* take care of generating a value for the initializer p */ | |
881 | /* inoff has the current offset (last bit written) | |
882 | in the current word being generated */ | |
883 | ||
884 | register sz, d, s; | |
885 | register TWORD t; | |
886 | ||
887 | /* note: size of an individual initializer is assumed to fit into an int */ | |
888 | ||
889 | if( iclass < 0 ) goto leave; | |
890 | if( iclass == EXTERN || iclass == UNAME ){ | |
891 | uerror( "cannot initialize extern or union" ); | |
892 | iclass = -1; | |
893 | goto leave; | |
894 | } | |
895 | ||
896 | if( iclass == AUTO || iclass == REGISTER ){ | |
897 | /* do the initialization and get out, without regard | |
898 | for filing out the variable with zeros, etc. */ | |
899 | bccode(); | |
900 | idname = pstk->in_id; | |
901 | p = buildtree( ASSIGN, buildtree( NAME, NIL, NIL ), p ); | |
902 | ecomp(p); | |
903 | return; | |
904 | } | |
905 | ||
906 | if( p == NIL ) return; /* for throwing away strings that have been turned into lists */ | |
907 | ||
908 | if( ibseen ){ | |
909 | uerror( "} expected"); | |
910 | goto leave; | |
911 | } | |
912 | ||
913 | if( idebug > 1 ) printf( "doinit(%o)\n", p ); | |
914 | ||
915 | t = pstk->in_t; /* type required */ | |
916 | d = pstk->in_d; | |
917 | s = pstk->in_s; | |
918 | if( pstk->in_sz < 0 ){ /* bit field */ | |
919 | sz = -pstk->in_sz; | |
920 | } | |
921 | else { | |
922 | sz = tsize( t, d, s ); | |
923 | } | |
924 | ||
925 | inforce( pstk->in_off ); | |
926 | ||
927 | p = buildtree( ASSIGN, block( NAME, NIL,NIL, t, d, s ), p ); | |
928 | p->left->op = FREE; | |
929 | p->left = p->right; | |
930 | p->right = NIL; | |
931 | p->left = optim( p->left ); | |
932 | if( p->left->op == UNARY AND ){ | |
933 | p->left->op = FREE; | |
934 | p->left = p->left->left; | |
935 | } | |
936 | p->op = INIT; | |
937 | ||
938 | if( sz < SZINT ){ /* special case: bit fields, etc. */ | |
939 | if( p->left->op != ICON ) uerror( "illegal initialization" ); | |
940 | else incode( p->left, sz ); | |
941 | } | |
942 | else if( p->left->op == FCON ){ | |
943 | fincode( p->left->dval, sz ); | |
944 | } | |
945 | else { | |
946 | cinit( optim(p), sz ); | |
947 | } | |
948 | ||
949 | gotscal(); | |
950 | ||
951 | leave: | |
952 | tfree(p); | |
953 | } | |
954 | ||
955 | gotscal(){ | |
956 | register t, ix; | |
957 | register n, id; | |
958 | struct symtab *p; | |
959 | OFFSZ temp; | |
960 | ||
961 | for( ; pstk > instack; ) { | |
962 | ||
963 | if( pstk->in_fl ) ++ibseen; | |
964 | ||
965 | --pstk; | |
966 | ||
967 | t = pstk->in_t; | |
968 | ||
969 | if( t == STRTY ){ | |
970 | ix = ++pstk->in_x; | |
971 | if( (id=dimtab[ix]) < 0 ) continue; | |
972 | ||
973 | /* otherwise, put next element on the stack */ | |
974 | ||
975 | p = &stab[id]; | |
976 | instk( id, p->stype, p->dimoff, p->sizoff, p->offset+pstk->in_off ); | |
977 | return; | |
978 | } | |
979 | else if( ISARY(t) ){ | |
980 | n = ++pstk->in_n; | |
981 | if( n >= dimtab[pstk->in_d] && pstk > instack ) continue; | |
982 | ||
983 | /* put the new element onto the stack */ | |
984 | ||
985 | temp = pstk->in_sz; | |
986 | instk( pstk->in_id, (TWORD)DECREF(pstk->in_t), pstk->in_d+1, pstk->in_s, | |
987 | pstk->in_off+n*temp ); | |
988 | return; | |
989 | } | |
990 | ||
991 | } | |
992 | ||
993 | } | |
994 | ||
995 | ilbrace(){ /* process an initializer's left brace */ | |
996 | register t; | |
997 | struct instk *temp; | |
998 | ||
999 | temp = pstk; | |
1000 | ||
1001 | for( ; pstk > instack; --pstk ){ | |
1002 | ||
1003 | t = pstk->in_t; | |
1004 | if( t != STRTY && !ISARY(t) ) continue; /* not an aggregate */ | |
1005 | if( pstk->in_fl ){ /* already associated with a { */ | |
1006 | if( pstk->in_n ) uerror( "illegal {"); | |
1007 | continue; | |
1008 | } | |
1009 | ||
1010 | /* we have one ... */ | |
1011 | pstk->in_fl = 1; | |
1012 | break; | |
1013 | } | |
1014 | ||
1015 | /* cannot find one */ | |
1016 | /* ignore such right braces */ | |
1017 | ||
1018 | pstk = temp; | |
1019 | } | |
1020 | ||
1021 | irbrace(){ | |
1022 | /* called when a '}' is seen */ | |
1023 | ||
1024 | if( idebug ) printf( "irbrace(): paramno = %d on entry\n", paramno ); | |
1025 | ||
1026 | if( ibseen ) { | |
1027 | --ibseen; | |
1028 | return; | |
1029 | } | |
1030 | ||
1031 | for( ; pstk > instack; --pstk ){ | |
1032 | if( !pstk->in_fl ) continue; | |
1033 | ||
1034 | /* we have one now */ | |
1035 | ||
1036 | pstk->in_fl = 0; /* cancel { */ | |
1037 | gotscal(); /* take it away... */ | |
1038 | return; | |
1039 | } | |
1040 | ||
1041 | /* these right braces match ignored left braces: throw out */ | |
1042 | ||
1043 | } | |
1044 | ||
1045 | upoff( size, alignment, poff ) register alignment, *poff; { | |
1046 | /* update the offset pointed to by poff; return the | |
1047 | /* offset of a value of size `size', alignment `alignment', | |
1048 | /* given that off is increasing */ | |
1049 | ||
1050 | register off; | |
1051 | ||
1052 | off = *poff; | |
1053 | SETOFF( off, alignment ); | |
1054 | *poff = off+size; | |
1055 | return( off ); | |
1056 | } | |
1057 | ||
1058 | oalloc( p, poff ) register struct symtab *p; register *poff; { | |
1059 | /* allocate p with offset *poff, and update *poff */ | |
1060 | register al, off, tsz; | |
1061 | int noff; | |
1062 | ||
1063 | al = talign( p->stype, p->sizoff ); | |
1064 | noff = off = *poff; | |
1065 | tsz = tsize( p->stype, p->dimoff, p->sizoff ); | |
1066 | #ifdef BACKAUTO | |
1067 | if( p->sclass == AUTO ){ | |
1068 | noff = off + tsz; | |
1069 | SETOFF( noff, al ); | |
1070 | off = -noff; | |
1071 | } | |
1072 | else | |
1073 | #endif | |
1074 | if( p->sclass == PARAM && (p->stype==CHAR||p->stype==UCHAR||p->stype==SHORT|| | |
1075 | p->stype==USHORT) ){ | |
1076 | off = upoff( SZINT, ALINT, &noff ); | |
1077 | # ifndef RTOLBYTES | |
1078 | off = noff - tsz; | |
1079 | #endif | |
1080 | } | |
1081 | else | |
1082 | { | |
1083 | off = upoff( tsz, al, &noff ); | |
1084 | } | |
1085 | ||
1086 | if( p->sclass != REGISTER ){ /* in case we are allocating stack space for register arguments */ | |
1087 | if( p->offset == NOOFFSET ) p->offset = off; | |
1088 | else if( off != p->offset ) return(1); | |
1089 | } | |
1090 | ||
1091 | *poff = noff; | |
1092 | return(0); | |
1093 | } | |
1094 | ||
1095 | falloc( p, w, new, pty ) register struct symtab *p; NODE *pty; { | |
1096 | /* allocate a field of width w */ | |
1097 | /* new is 0 if new entry, 1 if redefinition, -1 if alignment */ | |
1098 | ||
1099 | register al,sz,type; | |
1100 | ||
1101 | type = (new<0)? pty->type : p->stype; | |
1102 | ||
1103 | /* this must be fixed to use the current type in alignments */ | |
1104 | switch( new<0?pty->type:p->stype ){ | |
1105 | ||
1106 | case ENUMTY: | |
1107 | { | |
1108 | int s; | |
1109 | s = new<0 ? pty->csiz : p->sizoff; | |
1110 | al = dimtab[s+2]; | |
1111 | sz = dimtab[s]; | |
1112 | break; | |
1113 | } | |
1114 | ||
1115 | case CHAR: | |
1116 | case UCHAR: | |
1117 | al = ALCHAR; | |
1118 | sz = SZCHAR; | |
1119 | break; | |
1120 | ||
1121 | case SHORT: | |
1122 | case USHORT: | |
1123 | al = ALSHORT; | |
1124 | sz = SZSHORT; | |
1125 | break; | |
1126 | ||
1127 | case INT: | |
1128 | case UNSIGNED: | |
1129 | al = ALINT; | |
1130 | sz = SZINT; | |
1131 | break; | |
1132 | #ifdef LONGFIELDS | |
1133 | ||
1134 | case LONG: | |
1135 | case ULONG: | |
1136 | al = ALLONG; | |
1137 | sz = SZLONG; | |
1138 | break; | |
1139 | #endif | |
1140 | ||
1141 | default: | |
1142 | if( new < 0 ) { | |
1143 | uerror( "illegal field type" ); | |
1144 | al = ALINT; | |
1145 | } | |
1146 | else { | |
1147 | al = fldal( p->stype ); | |
1148 | sz =SZINT; | |
1149 | } | |
1150 | } | |
1151 | ||
1152 | if( w > sz ) { | |
1153 | uerror( "field too big"); | |
1154 | w = sz; | |
1155 | } | |
1156 | ||
1157 | if( w == 0 ){ /* align only */ | |
1158 | SETOFF( strucoff, al ); | |
1159 | if( new >= 0 ) uerror( "zero size field"); | |
1160 | return(0); | |
1161 | } | |
1162 | ||
1163 | if( strucoff%al + w > sz ) SETOFF( strucoff, al ); | |
1164 | if( new < 0 ) { | |
1165 | strucoff += w; /* we know it will fit */ | |
1166 | return(0); | |
1167 | } | |
1168 | ||
1169 | /* establish the field */ | |
1170 | ||
1171 | if( new == 1 ) { /* previous definition */ | |
1172 | if( p->offset != strucoff || p->sclass != (FIELD|w) ) return(1); | |
1173 | } | |
1174 | p->offset = strucoff; | |
1175 | strucoff += w; | |
1176 | p->stype = type; | |
1177 | fldty( p ); | |
1178 | return(0); | |
1179 | } | |
1180 | ||
1181 | nidcl( p ) NODE *p; { /* handle unitialized declarations */ | |
1182 | /* assumed to be not functions */ | |
1183 | register class; | |
1184 | register commflag; /* flag for labelled common declarations */ | |
1185 | ||
1186 | commflag = 0; | |
1187 | ||
1188 | /* compute class */ | |
1189 | if( (class=curclass) == SNULL ){ | |
1190 | if( blevel > 1 ) class = AUTO; | |
1191 | else if( blevel != 0 || instruct ) cerror( "nidcl error" ); | |
1192 | else { /* blevel = 0 */ | |
1193 | class = noinit(); | |
1194 | if( class == EXTERN ) commflag = 1; | |
1195 | } | |
1196 | } | |
1197 | ||
1198 | defid( p, class ); | |
1199 | ||
1200 | if( class==EXTDEF || class==STATIC ){ | |
1201 | /* simulate initialization by 0 */ | |
1202 | beginit(p->rval); | |
1203 | endinit(); | |
1204 | } | |
1205 | if( commflag ) commdec( p->rval ); | |
1206 | } | |
1207 | ||
1208 | TWORD | |
1209 | types( t1, t2, t3 ) TWORD t1, t2, t3; { | |
1210 | /* return a basic type from basic types t1, t2, and t3 */ | |
1211 | ||
1212 | TWORD t[3], noun, adj, unsg; | |
1213 | register i; | |
1214 | ||
1215 | t[0] = t1; | |
1216 | t[1] = t2; | |
1217 | t[2] = t3; | |
1218 | ||
1219 | unsg = INT; /* INT or UNSIGNED */ | |
1220 | noun = UNDEF; /* INT, CHAR, or FLOAT */ | |
1221 | adj = INT; /* INT, LONG, or SHORT */ | |
1222 | ||
1223 | for( i=0; i<3; ++i ){ | |
1224 | switch( t[i] ){ | |
1225 | ||
1226 | default: | |
1227 | bad: | |
1228 | uerror( "illegal type combination" ); | |
1229 | return( INT ); | |
1230 | ||
1231 | case UNDEF: | |
1232 | continue; | |
1233 | ||
1234 | case UNSIGNED: | |
1235 | if( unsg != INT ) goto bad; | |
1236 | unsg = UNSIGNED; | |
1237 | continue; | |
1238 | ||
1239 | case LONG: | |
1240 | case SHORT: | |
1241 | if( adj != INT ) goto bad; | |
1242 | adj = t[i]; | |
1243 | continue; | |
1244 | ||
1245 | case INT: | |
1246 | case CHAR: | |
1247 | case FLOAT: | |
1248 | if( noun != UNDEF ) goto bad; | |
1249 | noun = t[i]; | |
1250 | continue; | |
1251 | } | |
1252 | } | |
1253 | ||
1254 | /* now, construct final type */ | |
1255 | if( noun == UNDEF ) noun = INT; | |
1256 | else if( noun == FLOAT ){ | |
1257 | if( unsg != INT || adj == SHORT ) goto bad; | |
1258 | return( adj==LONG ? DOUBLE : FLOAT ); | |
1259 | } | |
1260 | else if( noun == CHAR && adj != INT ) goto bad; | |
1261 | ||
1262 | /* now, noun is INT or CHAR */ | |
1263 | if( adj != INT ) noun = adj; | |
1264 | if( unsg == UNSIGNED ) return( noun + (UNSIGNED-INT) ); | |
1265 | else return( noun ); | |
1266 | } | |
1267 | ||
1268 | NODE * | |
1269 | tymerge( typ, idp ) NODE *typ, *idp; { | |
1270 | /* merge type typ with identifier idp */ | |
1271 | ||
1272 | register unsigned t; | |
1273 | register i; | |
1274 | extern int eprint(); | |
1275 | ||
1276 | if( typ->op != TYPE ) cerror( "tymerge: arg 1" ); | |
1277 | if(idp == NIL ) return( NIL ); | |
1278 | ||
1279 | if( ddebug > 2 ) fwalk( idp, eprint, 0 ); | |
1280 | ||
1281 | idp->type = typ->type; | |
1282 | idp->cdim = curdim; | |
1283 | tyreduce( idp ); | |
1284 | idp->csiz = typ->csiz; | |
1285 | ||
1286 | for( t=typ->type, i=typ->cdim; t&TMASK; t = DECREF(t) ){ | |
1287 | if( ISARY(t) ) dstash( dimtab[i++] ); | |
1288 | } | |
1289 | ||
1290 | /* now idp is a single node: fix up type */ | |
1291 | ||
1292 | idp->type = ctype( idp->type ); | |
1293 | ||
1294 | if( (t = BTYPE(idp->type)) != STRTY && t != UNIONTY && t != ENUMTY ){ | |
1295 | idp->csiz = t; /* in case ctype has rewritten things */ | |
1296 | } | |
1297 | ||
1298 | return( idp ); | |
1299 | } | |
1300 | ||
1301 | tyreduce( p ) register NODE *p; { | |
1302 | ||
1303 | /* build a type, and stash away dimensions, from a parse tree of the declaration */ | |
1304 | /* the type is build top down, the dimensions bottom up */ | |
1305 | register o, temp; | |
1306 | register unsigned t; | |
1307 | ||
1308 | o = p->op; | |
1309 | p->op = FREE; | |
1310 | ||
1311 | if( o == NAME ) return; | |
1312 | ||
1313 | t = INCREF( p->type ); | |
1314 | if( o == UNARY CALL ) t += (FTN-PTR); | |
1315 | else if( o == LB ){ | |
1316 | t += (ARY-PTR); | |
1317 | temp = p->right->lval; | |
1318 | p->right->op = FREE; | |
1319 | } | |
1320 | ||
1321 | p->left->type = t; | |
1322 | tyreduce( p->left ); | |
1323 | ||
1324 | if( o == LB ) dstash( temp ); | |
1325 | ||
1326 | p->rval = p->left->rval; | |
1327 | p->type = p->left->type; | |
1328 | ||
1329 | } | |
1330 | ||
1331 | fixtype( p, class ) register NODE *p; { | |
1332 | register unsigned t, type; | |
1333 | register mod1, mod2; | |
1334 | /* fix up the types, and check for legality */ | |
1335 | ||
1336 | if( (type = p->type) == UNDEF ) return; | |
1337 | if( mod2 = (type&TMASK) ){ | |
1338 | t = DECREF(type); | |
1339 | while( mod1=mod2, mod2 = (t&TMASK) ){ | |
1340 | if( mod1 == ARY && mod2 == FTN ){ | |
1341 | uerror( "array of functions is illegal" ); | |
1342 | type = 0; | |
1343 | } | |
1344 | else if( mod1 == FTN && ( mod2 == ARY || mod2 == FTN ) ){ | |
1345 | uerror( "function returns illegal type" ); | |
1346 | type = 0; | |
1347 | } | |
1348 | t = DECREF(t); | |
1349 | } | |
1350 | } | |
1351 | ||
1352 | /* detect function arguments, watching out for structure declarations */ | |
1353 | ||
1354 | if( class==SNULL && blevel==1 && !(instruct&(INSTRUCT|INUNION)) ) class = PARAM; | |
1355 | if( class == PARAM || ( class==REGISTER && blevel==1 ) ){ | |
1356 | if( type == FLOAT ) type = DOUBLE; | |
1357 | else if( ISARY(type) ){ | |
1358 | ++p->cdim; | |
1359 | type += (PTR-ARY); | |
1360 | } | |
1361 | else if( ISFTN(type) ) type = INCREF(type); | |
1362 | ||
1363 | } | |
1364 | ||
1365 | if( instruct && ISFTN(type) ){ | |
1366 | uerror( "function illegal in structure or union" ); | |
1367 | type = INCREF(type); | |
1368 | } | |
1369 | p->type = type; | |
1370 | } | |
1371 | ||
1372 | uclass( class ) register class; { | |
1373 | /* give undefined version of class */ | |
1374 | if( class == SNULL ) return( EXTERN ); | |
1375 | else if( class == STATIC ) return( USTATIC ); | |
1376 | else if( class == FORTRAN ) return( UFORTRAN ); | |
1377 | else return( class ); | |
1378 | } | |
1379 | ||
1380 | fixclass( class, type ) TWORD type; { | |
1381 | ||
1382 | /* first, fix null class */ | |
1383 | ||
1384 | if( class == SNULL ){ | |
1385 | if( instruct&INSTRUCT ) class = MOS; | |
1386 | else if( instruct&INUNION ) class = MOU; | |
1387 | else if( blevel == 0 ) class = EXTDEF; | |
1388 | else if( blevel == 1 ) class = PARAM; | |
1389 | else class = AUTO; | |
1390 | ||
1391 | } | |
1392 | ||
1393 | /* now, do general checking */ | |
1394 | ||
1395 | if( ISFTN( type ) ){ | |
1396 | switch( class ) { | |
1397 | default: | |
1398 | uerror( "function has illegal storage class" ); | |
1399 | case AUTO: | |
1400 | class = EXTERN; | |
1401 | case EXTERN: | |
1402 | case EXTDEF: | |
1403 | case FORTRAN: | |
1404 | case TYPEDEF: | |
1405 | case STATIC: | |
1406 | case UFORTRAN: | |
1407 | case USTATIC: | |
1408 | ; | |
1409 | } | |
1410 | } | |
1411 | ||
1412 | if( class&FIELD ){ | |
1413 | if( !(instruct&INSTRUCT) ) uerror( "illegal use of field" ); | |
1414 | return( class ); | |
1415 | } | |
1416 | ||
1417 | switch( class ){ | |
1418 | ||
1419 | case MOU: | |
1420 | if( !(instruct&INUNION) ) uerror( "illegal class" ); | |
1421 | return( class ); | |
1422 | ||
1423 | case MOS: | |
1424 | if( !(instruct&INSTRUCT) ) uerror( "illegal class" ); | |
1425 | return( class ); | |
1426 | ||
1427 | case MOE: | |
1428 | if( instruct & (INSTRUCT|INUNION) ) uerror( "illegal class" ); | |
1429 | return( class ); | |
1430 | ||
1431 | case REGISTER: | |
1432 | if( blevel == 0 ) uerror( "illegal register declaration" ); | |
1433 | else if( regvar >= MINRVAR && cisreg( type ) ) return( class ); | |
1434 | if( blevel == 1 ) return( PARAM ); | |
1435 | else return( AUTO ); | |
1436 | ||
1437 | case AUTO: | |
1438 | case LABEL: | |
1439 | case ULABEL: | |
1440 | if( blevel < 2 ) uerror( "illegal class" ); | |
1441 | return( class ); | |
1442 | ||
1443 | case PARAM: | |
1444 | if( blevel != 1 ) uerror( "illegal class" ); | |
1445 | return( class ); | |
1446 | ||
1447 | case UFORTRAN: | |
1448 | case FORTRAN: | |
1449 | # ifdef NOFORTRAN | |
1450 | NOFORTRAN; /* a condition which can regulate the FORTRAN usage */ | |
1451 | # endif | |
1452 | if( !ISFTN(type) ) uerror( "fortran declaration must apply to function" ); | |
1453 | else { | |
1454 | type = DECREF(type); | |
1455 | if( ISFTN(type) || ISARY(type) || ISPTR(type) ) { | |
1456 | uerror( "fortran function has wrong type" ); | |
1457 | } | |
1458 | } | |
1459 | case STNAME: | |
1460 | case UNAME: | |
1461 | case ENAME: | |
1462 | case EXTERN: | |
1463 | case STATIC: | |
1464 | case EXTDEF: | |
1465 | case TYPEDEF: | |
1466 | case USTATIC: | |
1467 | return( class ); | |
1468 | ||
1469 | default: | |
1470 | cerror( "illegal class: %d", class ); | |
1471 | /* NOTREACHED */ | |
1472 | ||
1473 | } | |
1474 | } | |
1475 | ||
1476 | lookup( name, s) char *name; { | |
1477 | /* look up name: must agree with s w.r.t. SMOS and SHIDDEN */ | |
1478 | ||
1479 | register char *p, *q; | |
1480 | int i, j, ii; | |
1481 | register struct symtab *sp; | |
1482 | ||
1483 | /* compute initial hash index */ | |
1484 | if( ddebug > 2 ){ | |
1485 | printf( "lookup( %s, %d ), stwart=%d, instruct=%d\n", name, s, stwart, instruct ); | |
1486 | } | |
1487 | ||
1488 | i = 0; | |
1489 | for( p=name, j=0; *p != '\0'; ++p ){ | |
1490 | i += *p; | |
1491 | if( ++j >= NCHNAM ) break; | |
1492 | } | |
1493 | i = i%SYMTSZ; | |
1494 | sp = &stab[ii=i]; | |
1495 | ||
1496 | for(;;){ /* look for name */ | |
1497 | ||
1498 | if( sp->stype == TNULL ){ /* empty slot */ | |
1499 | p = sp->sname; | |
1500 | sp->sflags = s; /* set SMOS if needed, turn off all others */ | |
1501 | for( j=0; j<NCHNAM; ++j ) if( *p++ = *name ) ++name; | |
1502 | sp->stype = UNDEF; | |
1503 | sp->sclass = SNULL; | |
1504 | return( i ); | |
1505 | } | |
1506 | if( (sp->sflags & (SMOS|SHIDDEN)) != s ) goto next; | |
1507 | p = sp->sname; | |
1508 | q = name; | |
1509 | for( j=0; j<NCHNAM;++j ){ | |
1510 | if( *p++ != *q ) goto next; | |
1511 | if( !*q++ ) break; | |
1512 | } | |
1513 | return( i ); | |
1514 | next: | |
1515 | if( ++i >= SYMTSZ ){ | |
1516 | i = 0; | |
1517 | sp = stab; | |
1518 | } | |
1519 | else ++sp; | |
1520 | if( i == ii ) cerror( "symbol table full" ); | |
1521 | } | |
1522 | } | |
1523 | ||
1524 | #ifndef checkst | |
1525 | /* if not debugging, make checkst a macro */ | |
1526 | checkst(lev){ | |
1527 | register int s, i, j; | |
1528 | register struct symtab *p, *q; | |
1529 | ||
1530 | for( i=0, p=stab; i<SYMTSZ; ++i, ++p ){ | |
1531 | if( p->stype == TNULL ) continue; | |
1532 | j = lookup( p->sname, p->sflags&SMOS ); | |
1533 | if( j != i ){ | |
1534 | q = &stab[j]; | |
1535 | if( q->stype == UNDEF || | |
1536 | q->slevel <= p->slevel ){ | |
1537 | cerror( "check error: %.8s", q->sname ); | |
1538 | } | |
1539 | } | |
1540 | else if( p->slevel > lev ) cerror( "%.8s check at level %d", p->sname, lev ); | |
1541 | } | |
1542 | } | |
1543 | #endif | |
1544 | ||
1545 | struct symtab * | |
1546 | relook(p) register struct symtab *p; { /* look up p again, and see where it lies */ | |
1547 | ||
1548 | register struct symtab *q; | |
1549 | ||
1550 | /* I'm not sure that this handles towers of several hidden definitions in all cases */ | |
1551 | q = &stab[lookup( p->sname, p->sflags&(SMOS|SHIDDEN) )]; | |
1552 | /* make relook always point to either p or an empty cell */ | |
1553 | if( q->stype == UNDEF ){ | |
1554 | q->stype = TNULL; | |
1555 | return(q); | |
1556 | } | |
1557 | while( q != p ){ | |
1558 | if( q->stype == TNULL ) break; | |
1559 | if( ++q >= &stab[SYMTSZ] ) q=stab; | |
1560 | } | |
1561 | return(q); | |
1562 | } | |
1563 | ||
1564 | clearst( lev ){ /* clear entries of internal scope from the symbol table */ | |
1565 | register struct symtab *p, *q, *r; | |
1566 | register int temp, rehash; | |
1567 | ||
1568 | temp = lineno; | |
1569 | aobeg(); | |
1570 | ||
1571 | /* first, find an empty slot to prevent newly hashed entries from | |
1572 | being slopped into... */ | |
1573 | ||
1574 | for( q=stab; q< &stab[SYMTSZ]; ++q ){ | |
1575 | if( q->stype == TNULL )goto search; | |
1576 | } | |
1577 | ||
1578 | cerror( "symbol table full"); | |
1579 | ||
1580 | search: | |
1581 | p = q; | |
1582 | ||
1583 | for(;;){ | |
1584 | if( p->stype == TNULL ) { | |
1585 | rehash = 0; | |
1586 | goto next; | |
1587 | } | |
1588 | lineno = p->suse; | |
1589 | if( lineno < 0 ) lineno = - lineno; | |
1590 | if( p->slevel>lev ){ /* must clobber */ | |
1591 | if( p->stype == UNDEF || ( p->sclass == ULABEL && lev < 2 ) ){ | |
1592 | lineno = temp; | |
1593 | uerror( "%.8s undefined", p->sname ); | |
1594 | } | |
1595 | else aocode(p); | |
1596 | if (ddebug) printf("removing %8s from stab[ %d], flags %o level %d\n", | |
1597 | p->sname,p-stab,p->sflags,p->slevel); | |
1598 | if( p->sflags & SHIDES ) unhide(p); | |
1599 | p->stype = TNULL; | |
1600 | rehash = 1; | |
1601 | goto next; | |
1602 | } | |
1603 | if( rehash ){ | |
1604 | if( (r=relook(p)) != p ){ | |
1605 | movestab( r, p ); | |
1606 | p->stype = TNULL; | |
1607 | } | |
1608 | } | |
1609 | next: | |
1610 | if( ++p >= &stab[SYMTSZ] ) p = stab; | |
1611 | if( p == q ) break; | |
1612 | } | |
1613 | lineno = temp; | |
1614 | aoend(); | |
1615 | } | |
1616 | ||
1617 | movestab( p, q ) register struct symtab *p, *q; { | |
1618 | int k; | |
1619 | /* structure assignment: *p = *q; */ | |
1620 | p->stype = q->stype; | |
1621 | p->sclass = q->sclass; | |
1622 | p->slevel = q->slevel; | |
1623 | p->offset = q->offset; | |
1624 | p->sflags = q->sflags; | |
1625 | p->dimoff = q->dimoff; | |
1626 | p->sizoff = q->sizoff; | |
1627 | p->suse = q->suse; | |
1628 | for( k=0; k<NCHNAM; ++k ){ | |
1629 | p->sname[k] = q->sname[k]; | |
1630 | } | |
1631 | } | |
1632 | ||
1633 | hide( p ) register struct symtab *p; { | |
1634 | register struct symtab *q; | |
1635 | for( q=p+1; ; ++q ){ | |
1636 | if( q >= &stab[SYMTSZ] ) q = stab; | |
1637 | if( q == p ) cerror( "symbol table full" ); | |
1638 | if( q->stype == TNULL ) break; | |
1639 | } | |
1640 | movestab( q, p ); | |
1641 | p->sflags |= SHIDDEN; | |
1642 | q->sflags = (p->sflags&SMOS) | SHIDES; | |
1643 | if( hflag ) werror( "%.8s redefinition hides earlier one", p->sname ); | |
1644 | if( ddebug ) printf( " %d hidden in %d\n", p-stab, q-stab ); | |
1645 | return( idname = q-stab ); | |
1646 | } | |
1647 | ||
1648 | unhide( p ) register struct symtab *p; { | |
1649 | register struct symtab *q; | |
1650 | register s, j; | |
1651 | ||
1652 | s = p->sflags & SMOS; | |
1653 | q = p; | |
1654 | ||
1655 | for(;;){ | |
1656 | ||
1657 | if( q == stab ) q = &stab[SYMTSZ-1]; | |
1658 | else --q; | |
1659 | ||
1660 | if( q == p ) break; | |
1661 | ||
1662 | if( (q->sflags&SMOS) == s ){ | |
1663 | for( j =0; j<NCHNAM; ++j ) if( p->sname[j] != q->sname[j] ) break; | |
1664 | if( j == NCHNAM ){ /* found the name */ | |
1665 | q->sflags &= ~SHIDDEN; | |
1666 | if( ddebug ) printf( "unhide uncovered %d from %d\n", q-stab,p-stab); | |
1667 | return; | |
1668 | } | |
1669 | } | |
1670 | ||
1671 | } | |
1672 | cerror( "unhide fails" ); | |
1673 | } |