|
|
1.1 root 1: /*
2: * dCopy.c
3: *
4: * functions to copy pi declarations to pTrees
5: * these should be all the functions
6: * that mark the inTree field of the namelist
7: */
8:
9: #include "whoami"
10:
11: #ifdef PTREE
12:
13: #include "0.h"
14:
15: #include "tree.h"
16:
17: /*
18: * copy a T_PROG, T_PDEC, or T_FDEC into a PorFNode
19: * porf [0] T_PROG T_PDEC or T_FDEC
20: * [1] lineof "program" or trailing ";"
21: * [2] program, procedure, or function name
22: * [3] file or formal parameter list
23: * [4] function return type or pNIL
24: */
25: pPointer
26: PorFCopy( porf )
27: int *porf;
28: {
29: pPointer PorF;
30: union pNodeBodies *PorFp;
31: struct nl *nlporf;
32: extern struct nl *program;
33:
34: /*
35: * programs are defnl'ed but not entered, but extern program works
36: */
37: if ( porf[0] == T_PROG )
38: nlporf = program;
39: else nlporf = nllook( porf[2] );
40: if ( nlporf -> inTree != pNIL ) {
41: pDEF( nlporf -> inTree ).PorFForward = TRUE;
42: return;
43: }
44: PorF = pNewNode( PorFTAG , sizeof( struct PorFNode ) );
45: pSeize( PorF );
46: PorFp = &( pDEF( PorF ) );
47: PorFp -> PorFName = sCopy( porf[2] );
48: PorFHeader[ ++ nesting ] = PorF;
49: if ( porf[0] != T_PROG )
50: PorFp -> PorFParams = tCopy( porf[3] );
51: else PorFp -> PorFParams = FileCopy( porf[3] );
52: nesting --;
53: PorFp -> PorFLabels = pNIL;
54: PorFp -> PorFConsts = pNIL;
55: PorFp -> PorFTypes = pNIL;
56: PorFp -> PorFVars = pNIL;
57: PorFp -> PorFPFs = pNIL;
58: PorFp -> PorFBody = pNIL;
59: PorFp -> PorFReturns = tCopy( porf[4] );
60: PorFp -> PorFForward = FALSE;
61: pRelease( PorF );
62: nlporf -> inTree = PorF;
63: return PorF;
64: }
65:
66: /*
67: * looks for defined (but not entered) symbols
68: * (either files or formal parameters)
69: * which hang down the chain field of
70: * program, procedure or function namelist entry.
71: */
72: struct nl *
73: chainlookup( porf , symb )
74: struct nl *porf;
75: char *symb;
76: {
77: struct nl *paramp;
78:
79: for ( paramp = porf->chain ; paramp != NIL ; paramp = paramp->chain )
80: if ( paramp -> symbol == symb )
81: break;
82: return paramp;
83: }
84:
85: /*
86: * copy a list of file names to a list of threads to VarDNodes
87: * (or threads to the BVarNodes for input or output)
88: * for later inclusion in the variable declaration list.
89: * as a special case, the files are found chained to the program nl entry.
90: */
91: pPointer
92: FileCopy( files )
93: int *files;
94: {
95: int *filep;
96: pPointer Thread;
97: pPointer List;
98: pPointer First;
99: pPointer After;
100: extern struct nl *program;
101: extern struct nl *input;
102: extern struct nl *output;
103:
104: First = After = pNIL;
105: for ( filep = files ; filep != NIL ; filep = (int *) filep[2] ) {
106: struct nl *file = chainlookup( program , filep[1] );
107:
108: if ( filep[1] == input -> symbol ) {
109: file -> inTree = input -> inTree;
110: Thread = ThreadName( input );
111: } else if ( filep[1] == output -> symbol ) {
112: file -> inTree = output -> inTree;
113: Thread = ThreadName( output );
114: } else {
115: pPointer File = pNewNode( VarDTAG
116: , sizeof( struct VarDNode ) );
117: pPointer Name = sCopy( filep[1] );
118:
119: pDEF( File ).VarDName = Name;
120: pDEF( File ).VarDType = pNIL;
121: file -> inTree = File;
122: Thread = ThreadName( file );
123: }
124: List = pNewNode( ListTAG , sizeof( struct ListNode ) );
125: pDEF( List ).ListItem = Thread;
126: pDEF( List ).ListUp = After;
127: pDEF( List ).ListDown = pNIL;
128: if ( After == pNIL )
129: First = List;
130: else pDEF( After ).ListDown = List;
131: After = List;
132: }
133: return First;
134: }
135:
136: /*
137: * copy a formal parameter declaration to a TypedNode
138: * and a list of ValPNodes or VarPNodes.
139: * param [0] T_PVAL or T_PVAR
140: * [1] id_list
141: * [2] type
142: */
143: pPointer
144: ParamCopy( param )
145: int *param;
146: {
147: int *idl;
148: pPointer Param;
149: pPointer Name;
150: pPointer Typed = pNewNode( TypedTAG , sizeof( struct TypedNode ) );
151: pPointer Type = tCopy( param[2] );
152: pPointer List;
153: pPointer After;
154: char *name;
155: struct nl *porf;
156:
157: Name = pUSE( PorFHeader[ nesting ] ).PorFName;
158: name = *hash( pUSE( Name ).StringValue , 0 );
159: porf = nllook( name );
160: if ( porf == NIL )
161: panic( "ParamCopy:nllook" );
162: pDEF( Typed ).TypedType = Type;
163: After = pNIL;
164: for ( idl = (int *)param[1] ; idl != NIL ; idl = (int *)idl[2] ) {
165: switch ( param[0] ) {
166: case T_PVAL:
167: Param = pNewNode( ValPTAG , sizeof( struct ValPNode ) );
168: break;
169: case T_PVAR:
170: Param = pNewNode( VarPTAG , sizeof( struct VarPNode ) );
171: break;
172: default:
173: panic("ParamCopy:param[0]");
174: };
175: Name = sCopy( idl[1] );
176: pDEF( Param ).ParamDName = Name;
177: pDEF( Param ).ParamDType = Type;
178: chainlookup( porf , idl[1] ) -> inTree = Param;
179: List = pNewNode( ListTAG , sizeof( struct ListNode ) );
180: pDEF( List ).ListItem = Param;
181: pDEF( List ).ListUp = After;
182: pDEF( List ).ListDown = pNIL;
183: if ( After == pNIL )
184: pDEF( Typed ).TypedNames = List;
185: else pDEF( After ).ListDown = List;
186: After = List;
187: }
188: return Typed;
189: }
190:
191: /*
192: * construct a list of LabelDNodes from a list of YINTs
193: */
194: pPointer
195: LabelDCopy( labels )
196: int *labels;
197: {
198: int *labelp;
199: pPointer Label;
200: pPointer Name;
201: pPointer List;
202: pPointer First;
203: pPointer After;
204:
205: After = pNIL;
206: for ( labelp = labels ; labelp != NIL ; labelp = (int *) labelp[2] ) {
207: Label = pNewNode( LabelDTAG , sizeof( struct LabelDNode ) );
208: Name = sCopy( labelp[1] );
209: pDEF( Label ).LabelDName = Name;
210: nllook( labelp[1] ) -> inTree = Label;
211: List = pNewNode( ListTAG , sizeof( struct ListNode ) );
212: pDEF( List ).ListItem = Label;
213: pDEF( List ).ListUp = After;
214: pDEF( List ).ListDown = pNIL;
215: if ( After == pNIL )
216: First = List;
217: else pDEF( After ).ListDown = List;
218: After = List;
219: }
220: return First;
221: }
222:
223: /*
224: * copy a constant declaration to a ConstDNode
225: */
226: pPointer
227: ConstDecl( id , decl )
228: char *id;
229: int *decl;
230: {
231: pPointer Const = pNewNode( ConstDTAG , sizeof( struct ConstDNode ) );
232: pPointer Name = sCopy( id );
233: pPointer ConstValue = tCopy( decl );
234:
235: pDEF( Const ).ConstDName = Name;
236: pDEF( Const ).ConstDValue = ConstValue;
237: nllook( id ) -> inTree = Const;
238: return Const;
239: }
240:
241: /*
242: * copy a type declaration to a TypeDNode.
243: * note that pointers' types are filled in later.
244: */
245: pPointer
246: TypeDecl( id , decl )
247: char *id;
248: int *decl;
249: {
250: pPointer Type = pNewNode( TypeDTAG , sizeof( struct TypeDNode ) );
251: pPointer Name = sCopy( id );
252: pPointer TypeType = tCopy( decl );
253: struct nl *np = nllook( id );
254:
255: pDEF( Type ).TypeDName = Name;
256: pDEF( Type ).TypeDType = TypeType;
257: np -> inTree = Type;
258: if ( ( np -> type ) -> class == PTR ) {
259: ( np -> type ) -> inTree = TypeType;
260: }
261: return Type;
262: }
263:
264: /*
265: * copies a T_RFIELD node to a TypedNode
266: * with a type and a list of FieldDNodes
267: * rfield[0] T_RFIELD
268: * [1] lineof ":"
269: * [2] id_list
270: * [3] type
271: * uses the extern inrecord to know which record its in.
272: */
273: pPointer
274: FieldCopy( rfield )
275: int *rfield;
276: {
277: extern struct nl *inrecord;
278: pPointer Typed = pNewNode( TypedTAG , sizeof( struct TypedNode ) );
279: int *idlp;
280: pPointer Type = tCopy( rfield[3] );
281: pPointer List;
282: pPointer After;
283:
284: pDEF( Typed ).TypedNames = pNIL;
285: pDEF( Typed ).TypedType = Type;
286: After = pNIL;
287: for ( idlp = (int *)rfield[2] ; idlp != NIL ; idlp = (int *)idlp[2] ) {
288: pPointer FieldD
289: = pNewNode( FieldDTAG , sizeof( struct FieldDNode ) );
290: pPointer Name = sCopy( idlp[1] );
291: struct nl *field;
292:
293: if ( inrecord == NIL )
294: panic( "FieldCopy:inrecord" );
295: field = reclook( inrecord , idlp[1] );
296: if ( field == NIL )
297: panic( "FieldCopy:reclook" );
298: pDEF( FieldD ).FieldDName = Name;
299: pDEF( FieldD ).FieldDType = Type;
300: field -> inTree = FieldD;
301: List = pNewNode( ListTAG , sizeof( struct ListNode ) );
302: pDEF( List ).ListItem = FieldD;
303: pDEF( List ).ListUp = After;
304: pDEF( List ).ListDown = pNIL;
305: if ( After == pNIL )
306: pDEF( Typed ).TypedNames = List;
307: else pDEF( After ).ListDown = List;
308: After = List;
309: }
310: return Typed;
311: }
312:
313: /*
314: * copies a T_VARPT node to a VarntNode and a FieldDNode
315: * varpt [0] T_TYVARPT
316: * [1] lineof "case"
317: * [2] tag id (or nil)
318: * [3] tag type
319: * [4] list of variant cases
320: * uses the extern inrecord to know which record its in.
321: */
322: pPointer
323: VarntCopy( tyvarpt )
324: int *tyvarpt;
325: {
326: extern struct nl *inrecord;
327: pPointer Varnt = pNewNode( VarntTAG , sizeof( struct VarntNode ) );
328: pPointer Tag = pNewNode( FieldDTAG , sizeof( struct FieldDNode ) );
329: pPointer Name = sCopy( tyvarpt[2] );
330: pPointer Type = tCopy( tyvarpt[3] );
331: pPointer Cases = tCopy( tyvarpt[4] );
332:
333: pDEF( Tag ).FieldDName = Name;
334: pDEF( Tag ).FieldDType = Type;
335: if ( tyvarpt[2] != NIL )
336: reclook( inrecord , tyvarpt[2] ) -> inTree = Tag;
337: pDEF( Varnt ).VarntTag = Tag;
338: pDEF( Varnt ).VarntCases = Cases;
339: return Varnt;
340: }
341:
342: /*
343: * copies a T_TYSCAL node to an EnumTNode and a list of ScalDNodes
344: * tyscal [0] T_TYSCAL
345: * [1] lineof "("
346: * [2] id_list
347: */
348: pPointer
349: EnumTCopy( tyscal )
350: int *tyscal;
351: {
352: pPointer EnumT = pNewNode( EnumTTAG , sizeof( struct EnumTNode ) );
353: pPointer ScalD;
354: pPointer Name;
355: int *idp;
356: pPointer List;
357: pPointer After;
358:
359: After = pNIL;
360: for ( idp = (int *) tyscal[2] ; idp != NIL ; idp = (int *) idp[2] ) {
361: ScalD = pNewNode( ScalDTAG , sizeof( struct ScalDNode ) );
362: Name = sCopy( idp[1] );
363: pDEF( ScalD ).ScalDName = Name;
364: nllook( idp[1] ) -> inTree = ScalD;
365: List = pNewNode( ListTAG , sizeof( struct ListNode ) );
366: pDEF( List ).ListItem = ScalD;
367: pDEF( List ).ListUp = After;
368: pDEF( List ).ListDown = pNIL;
369: if ( After == pNIL )
370: pDEF( EnumT ).EnumTScalars = List;
371: else pDEF( After ).ListDown = List;
372: After = List;
373: }
374: return EnumT;
375: }
376:
377: /*
378: * copies a variable declaration to a TypedNode
379: * with a type and a list of VarDNodes
380: * also, deals with previously declared (e.g. program files) variables.
381: */
382: pPointer
383: VarDecl( idl , type )
384: int *idl;
385: int *type;
386: {
387: pPointer Typed = pNewNode( TypedTAG , sizeof( struct TypedNode ) );
388: int *idlp;
389: struct nl *var;
390: pPointer VarD;
391: pPointer Name;
392: pPointer Type = tCopy( type );
393: pPointer List;
394: pPointer After;
395:
396: pDEF( Typed ).TypedNames = pNIL;
397: pDEF( Typed ).TypedType = Type;
398: After = pNIL;
399: for ( idlp = (int *) idl ; idlp != NIL ; idlp = (int *) idlp[2] ) {
400: if ( ( var = nllook( idlp[1] ) ) -> inTree == pNIL ) {
401: /*
402: * usual case, a new variable
403: */
404: VarD = pNewNode( VarDTAG , sizeof( struct VarDNode ) );
405: Name = sCopy( idlp[1] );
406: pDEF( VarD ).VarDName = Name;
407: var -> inTree = VarD;
408: } else {
409: /*
410: * previously declared (file) variable, already in tree
411: * gets hung on list of variables, in addition
412: */
413: VarD = var -> inTree;
414: }
415: pDEF( VarD ).VarDType = Type;
416: if ( ( var -> type ) -> class == PTR ) {
417: ( var -> type ) -> inTree = Type;
418: }
419: List = pNewNode( ListTAG , sizeof( struct ListNode ) );
420: pDEF( List ).ListItem = VarD;
421: pDEF( List ).ListUp = After;
422: pDEF( List ).ListDown = pNIL;
423: if ( After == pNIL )
424: pDEF( Typed ).TypedNames = List;
425: else pDEF( After ).ListDown = List;
426: After = List;
427: }
428: return Typed;
429: }
430:
431:
432: /*
433: * initialize the pTree
434: * including cheapo versions of all the builtins (eech!)
435: */
436: pTreeInit()
437: {
438: extern char *in_consts[];
439: extern char *in_types[];
440: extern char *in_ctypes[];
441: extern char *in_vars[];
442: extern char *in_funcs[];
443: extern char *in_procs[];
444: union pNodeBodies *Glob;
445: pPointer List;
446: char **cp;
447:
448: nesting = 0;
449: PorFHeader[ nesting ] = pNewNode( GlobTAG , sizeof( struct GlobNode ) );
450: pWorld = PorFHeader[ nesting ];
451: pSeize( PorFHeader[ nesting ] );
452: Glob = &( pDEF( PorFHeader[ nesting ] ) );
453: /*
454: * built in constants
455: */
456: dumpnl( NIL , "pTreeInit" );
457: List = pNIL;
458: for ( cp = in_consts ; *cp ; cp ++ ) {
459: pPointer BCon = pNewNode( BConstTAG , sizeof( struct BConstNode ) );
460: pPointer Name = sCopy( *cp );
461:
462: pDEF( BCon ).BConstName = Name;
463: List = ListAppend( List , BCon );
464: nllook( *cp ) -> inTree = BCon;
465: }
466: Glob -> GlobConsts = List;
467: /*
468: * built in simple and constructed types
469: */
470: List = pNIL;
471: /*
472: * simple types
473: */
474: for ( cp = in_types ; *cp ; cp ++ ) {
475: pPointer BType = pNewNode( BTypeTAG , sizeof( struct BTypeNode ) );
476: pPointer Name = sCopy( *cp );
477:
478: pDEF( BType ).BTypeName = Name;
479: List = ListAppend( List , BType );
480: nllook( *cp ) -> inTree = BType;
481: }
482: /*
483: * constructed types (aren't any more difficult)
484: */
485: for ( cp = in_ctypes ; *cp ; cp ++ ) {
486: pPointer BType = pNewNode( BTypeTAG , sizeof( struct BTypeNode ) );
487: pPointer Name = sCopy( *cp );
488:
489: pDEF( BType ).BTypeName = Name;
490: List = ListAppend( List , BType );
491: nllook( *cp ) -> inTree = BType;
492: }
493: Glob -> GlobType = List;
494: /*
495: * built in variables
496: */
497: List = pNIL;
498: for ( cp = in_vars ; *cp ; cp ++ ) {
499: pPointer BVar = pNewNode( BVarTAG , sizeof( struct BVarNode ) );
500: pPointer Name = sCopy( *cp );
501:
502: pDEF( BVar ).BVarName = Name;
503: List = ListAppend( List , BVar );
504: nllook( *cp ) -> inTree = BVar;
505: }
506: Glob -> GlobVars = List;
507: /*
508: * built in functions and procedures
509: */
510: List = pNIL;
511: /*
512: * built in functions
513: */
514: for ( cp = in_funcs ; *cp ; cp ++ ) {
515: pPointer BFunc = pNewNode( BFuncTAG , sizeof( struct BFuncNode ) );
516: pPointer Name = sCopy( *cp );
517:
518: pDEF( BFunc ).BFuncName = Name;
519: List = ListAppend( List , BFunc );
520: nllook( *cp ) -> inTree = BFunc;
521: }
522: /*
523: * built in procedures
524: */
525: for ( cp = in_procs ; *cp ; cp ++ ) {
526: pPointer BProc = pNewNode( BProcTAG , sizeof( struct BProcNode ) );
527: pPointer Name = sCopy( *cp );
528:
529: pDEF( BProc ).BProcName = Name;
530: List = ListAppend( List , BProc );
531: nllook( *cp ) -> inTree = BProc;
532: }
533: Glob -> GlobPFs = List;
534: pRelease( PorFHeader[ nesting ] );
535: }
536:
537: /*
538: * find a symbol in the
539: * block structure symbol
540: * table and returns a pointer to
541: * its namelist entry.
542: * [this is a copy of lookup, except it calls nllook1
543: * whose only variation from lookup1 is that it doesn't set NUSED]
544: */
545: struct nl *
546: nllook(s)
547: register char *s;
548: {
549: register struct nl *p;
550: register struct udinfo *udp;
551:
552: if (s == NIL) {
553: nocascade();
554: return (NIL);
555: }
556: p = nllook1(s);
557: if (p == NIL) {
558: derror("%s is undefined", s);
559: return (NIL);
560: }
561: if (p->class == FVAR) {
562: p = p->chain;
563: bn--;
564: }
565: return (p);
566: }
567:
568: /*
569: * an internal nllook.
570: * It is not an error to call nllook1 if the symbol is not defined.
571: * Also nllook1 will return FVARs while nllook never will.
572: * [this is a copy of lookup1, except that it doesn't set NUSED]
573: */
574:
575: struct nl *
576: nllook1(s)
577: register char *s;
578: {
579: register struct nl *p;
580: # ifndef PI0
581: register struct nl *q;
582: # endif
583: register int i;
584:
585: if (s == NIL)
586: return (NIL);
587: bn = cbn;
588: #ifndef PI0
589: /*
590: * We first check the field names
591: * of the currently active with
592: * statements (expensive since they
593: * are not hashed).
594: */
595: for (p = withlist; p != NIL; p = p->nl_next) {
596: q = p->type;
597: if (q == NIL)
598: continue;
599: if (reclook(q, s) != NIL)
600: /*
601: * Return the WITHPTR, lvalue understands.
602: */
603: return (p);
604: }
605: #endif
606: /*
607: * Symbol table is a 64 way hash
608: * on the low bits of the character
609: * pointer value. (Simple, but effective)
610: */
611: i = (int) s & 077;
612: for (p = disptab[i]; p != NIL; p = p->nl_next)
613: if (p->symbol == s && p->class != FIELD && p->class != BADUSE) {
614: bn = (p->nl_block & 037);
615: return (p);
616: }
617: return (NIL);
618: }
619:
620: #endif PTREE
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.