|
|
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.