[unix-history] / usr / src / cmd / pi / dCopy.c

    /*
     *	dCopy.c
     *
     *	functions to copy pi declarations to pTrees
     *	these should be all the functions
     *	that mark the inTree field of the namelist
     */

#include	"whoami"

#ifdef PTREE

#include	"0.h"

#include	"tree.h"

    /*
     *	copy a T_PROG, T_PDEC, or T_FDEC into a PorFNode
     *	porf	[0]	T_PROG T_PDEC or T_FDEC
     *		[1]	lineof "program" or trailing ";"
     *		[2]	program, procedure, or function name
     *		[3]	file or formal parameter list
     *		[4]	function return type or pNIL
     */
pPointer
PorFCopy( porf )
    int	*porf;
    {
	pPointer		PorF;
	union pNodeBodies	*PorFp;
	struct nl		*nlporf;
	extern struct nl	*program;

	    /*
	     *	programs are defnl'ed but not entered, but extern program works
	     */
	if ( porf[0] == T_PROG )
		nlporf = program;
	  else	nlporf = nllook( porf[2] );
	if ( nlporf -> inTree != pNIL ) {
	    pDEF( nlporf -> inTree ).PorFForward = TRUE;
	    return;
	}
	PorF = pNewNode( PorFTAG , sizeof( struct PorFNode ) );
	pSeize( PorF );
	PorFp = &( pDEF( PorF ) );
	PorFp -> PorFName = sCopy( porf[2] );
	PorFHeader[ ++ nesting ] = PorF;
	if ( porf[0] != T_PROG )
		PorFp -> PorFParams = tCopy( porf[3] );
	  else	PorFp -> PorFParams = FileCopy( porf[3] );
	nesting --;
	PorFp -> PorFLabels = pNIL;
	PorFp -> PorFConsts = pNIL;
	PorFp -> PorFTypes = pNIL;
	PorFp -> PorFVars = pNIL;
	PorFp -> PorFPFs = pNIL;
	PorFp -> PorFBody = pNIL;
	PorFp -> PorFReturns = tCopy( porf[4] );
	PorFp -> PorFForward = FALSE;
	pRelease( PorF );
	nlporf -> inTree = PorF;
	return PorF;
    }

    /*
     *	looks for defined (but not entered) symbols
     *	(either files or formal parameters)
     *	which hang down the chain field of
     *	program, procedure or function namelist entry.
     */
struct nl *
chainlookup( porf , symb )
    struct nl	*porf;
    char	*symb;
    {
	struct nl *paramp;
	
	for ( paramp = porf->chain ; paramp != NIL ; paramp = paramp->chain )
	    if ( paramp -> symbol == symb )
		break;
	return paramp;
    }

    /*
     *	copy a list of file names to a list of threads to VarDNodes
     *	(or threads to the BVarNodes for input or output)
     *	for later inclusion in the variable declaration list.
     *	as a special case, the files are found chained to the program nl entry.
     */
pPointer
FileCopy( files )
    int	*files;
    {
	int		    *filep;
	pPointer	    Thread;
	pPointer	    List;
	pPointer	    First;
	pPointer	    After;
	extern struct nl    *program;
	extern struct nl    *input;
	extern struct nl    *output;

	First = After = pNIL;
	for ( filep = files ; filep != NIL ; filep = (int *) filep[2] ) {
	    struct nl	*file = chainlookup( program , filep[1] );

		    if ( filep[1] == input -> symbol ) {
			file -> inTree = input -> inTree;
			Thread = ThreadName( input );
	    } else  if ( filep[1] == output -> symbol ) {
			file -> inTree = output -> inTree;
			Thread = ThreadName( output );
	    } else  {
			pPointer File = pNewNode( VarDTAG
						, sizeof( struct VarDNode ) );
			pPointer Name = sCopy( filep[1] );

			pDEF( File ).VarDName = Name;
			pDEF( File ).VarDType = pNIL;
			file -> inTree = File;
			Thread = ThreadName( file );
	    }
	    List = pNewNode( ListTAG , sizeof( struct ListNode ) );
	    pDEF( List ).ListItem = Thread;
	    pDEF( List ).ListUp = After;
	    pDEF( List ).ListDown = pNIL;
	    if ( After == pNIL )
		    First = List;
	      else  pDEF( After ).ListDown = List;
	    After = List;
	}
	return First;
    }

    /*
     *	copy a formal parameter declaration to a TypedNode
     *	and a list of ValPNodes or VarPNodes.
     *	param	[0]	T_PVAL or T_PVAR
     *		[1]	id_list
     *		[2]	type
     */
pPointer
ParamCopy( param )
    int     *param;
    {
	int	    *idl;
	pPointer    Param;
	pPointer    Name;
	pPointer    Typed = pNewNode( TypedTAG , sizeof( struct TypedNode ) );
	pPointer    Type = tCopy( param[2] );
	pPointer    List;
	pPointer    After;
	char	    *name;
	struct nl   *porf;

	Name = pUSE( PorFHeader[ nesting ] ).PorFName;
	name = *hash( pUSE( Name ).StringValue , 0 );
	porf = nllook( name );
	if ( porf == NIL )
	    panic( "ParamCopy:nllook" );
	pDEF( Typed ).TypedType = Type;
	After = pNIL;
	for ( idl = (int *)param[1] ; idl != NIL ; idl = (int *)idl[2] ) {
	    switch ( param[0] ) {
		case T_PVAL:
		    Param = pNewNode( ValPTAG , sizeof( struct ValPNode ) );
		    break;
		case T_PVAR:
		    Param = pNewNode( VarPTAG , sizeof( struct VarPNode ) );
		    break;
		default:
		    panic("ParamCopy:param[0]");
	    };
	    Name = sCopy( idl[1] );
	    pDEF( Param ).ParamDName = Name;
	    pDEF( Param ).ParamDType = Type;
	    chainlookup( porf , idl[1] ) -> inTree = Param;
	    List = pNewNode( ListTAG , sizeof( struct ListNode ) );
	    pDEF( List ).ListItem = Param;
	    pDEF( List ).ListUp = After;
	    pDEF( List ).ListDown = pNIL;
	    if ( After == pNIL )
		    pDEF( Typed ).TypedNames = List;
	      else  pDEF( After ).ListDown = List;
	    After = List;
	}
	return Typed;
    }

    /*
     *	construct a list of LabelDNodes from a list of YINTs
     */
pPointer
LabelDCopy( labels )
    int	*labels;
    {
	int		*labelp;
	pPointer	Label;
	pPointer	Name;
	pPointer	List;
	pPointer	First;
	pPointer	After;

	After = pNIL;
	for ( labelp = labels ; labelp != NIL ; labelp = (int *) labelp[2] ) {
	    Label = pNewNode( LabelDTAG , sizeof( struct LabelDNode ) );
	    Name = sCopy( labelp[1] );
	    pDEF( Label ).LabelDName = Name;
	    nllook( labelp[1] ) -> inTree = Label;
	    List = pNewNode( ListTAG , sizeof( struct ListNode ) );
	    pDEF( List ).ListItem = Label;
	    pDEF( List ).ListUp = After;
	    pDEF( List ).ListDown = pNIL;
	    if ( After == pNIL )
		    First = List;
	      else  pDEF( After ).ListDown = List;
	    After = List;
	}
	return First;
    }

    /*
     *	copy a constant declaration to a ConstDNode
     */
pPointer
ConstDecl( id , decl )
    char	*id;
    int		*decl;
    {
	pPointer    Const = pNewNode( ConstDTAG , sizeof( struct ConstDNode ) );
	pPointer    Name = sCopy( id );
	pPointer    ConstValue = tCopy( decl );

	pDEF( Const ).ConstDName = Name;
	pDEF( Const ).ConstDValue = ConstValue;
	nllook( id ) -> inTree = Const;
	return Const;
    }

    /*
     *	copy a type declaration to a TypeDNode.
     *	note that pointers' types are filled in later.
     */
pPointer
TypeDecl( id , decl )
    char	*id;
    int		*decl;
    {
	pPointer    Type = pNewNode( TypeDTAG , sizeof( struct TypeDNode ) );
	pPointer    Name = sCopy( id );
	pPointer    TypeType = tCopy( decl );
	struct nl   *np = nllook( id );
		
	pDEF( Type ).TypeDName = Name;
	pDEF( Type ).TypeDType = TypeType;
	np -> inTree = Type;
	if ( ( np -> type ) -> class == PTR ) {
	    ( np -> type ) -> inTree = TypeType;
	}
	return Type;
    }

    /*
     *	copies a T_RFIELD node to a TypedNode
     *	with a type and a list of FieldDNodes
     *	rfield[0]	T_RFIELD
     *	      [1]	lineof ":"
     *	      [2]	id_list
     *	      [3]	type
     *	uses the extern inrecord to know which record its in.
     */
pPointer
FieldCopy( rfield )
    int	*rfield;
    {
	extern struct nl *inrecord;
	pPointer    Typed = pNewNode( TypedTAG , sizeof( struct TypedNode ) );
	int	    *idlp;
	pPointer    Type = tCopy( rfield[3] );
	pPointer    List;
	pPointer    After;

	pDEF( Typed ).TypedNames = pNIL;
	pDEF( Typed ).TypedType = Type;
	After = pNIL;
	for ( idlp = (int *)rfield[2] ; idlp != NIL ; idlp = (int *)idlp[2] ) {
	    pPointer FieldD
			= pNewNode( FieldDTAG , sizeof( struct FieldDNode ) );
	    pPointer Name = sCopy( idlp[1] );
	    struct nl *field;

	    if ( inrecord == NIL )
		panic( "FieldCopy:inrecord" );
	    field = reclook( inrecord , idlp[1] );
	    if ( field == NIL )
		panic( "FieldCopy:reclook" );
	    pDEF( FieldD ).FieldDName = Name;
	    pDEF( FieldD ).FieldDType = Type;
	    field -> inTree = FieldD;
	    List = pNewNode( ListTAG , sizeof( struct ListNode ) );
	    pDEF( List ).ListItem = FieldD;
	    pDEF( List ).ListUp = After;
	    pDEF( List ).ListDown = pNIL;
	    if ( After == pNIL )
		    pDEF( Typed ).TypedNames = List;
	      else  pDEF( After ).ListDown = List;
	    After = List;
	}
	return Typed;
    }

    /*
     *	copies a T_VARPT node to a VarntNode and a FieldDNode
     *	varpt	[0]	T_TYVARPT
     *		[1]	lineof "case"
     *		[2]	tag id (or nil)
     *		[3]	tag type
     *		[4]	list of variant cases
     *	uses the extern inrecord to know which record its in.
     */
pPointer
VarntCopy( tyvarpt )
    int	*tyvarpt;
    {
	extern struct nl *inrecord;
	pPointer Varnt = pNewNode( VarntTAG , sizeof( struct VarntNode ) );
	pPointer Tag = pNewNode( FieldDTAG , sizeof( struct FieldDNode ) );
	pPointer Name = sCopy( tyvarpt[2] );
	pPointer Type = tCopy( tyvarpt[3] );
	pPointer Cases = tCopy( tyvarpt[4] );

	pDEF( Tag ).FieldDName = Name;
	pDEF( Tag ).FieldDType = Type;
	if ( tyvarpt[2] != NIL )
	    reclook( inrecord , tyvarpt[2] ) -> inTree = Tag;
	pDEF( Varnt ).VarntTag = Tag;
	pDEF( Varnt ).VarntCases = Cases;
	return Varnt;
    }

    /*
     *	copies a T_TYSCAL node to an EnumTNode and a list of ScalDNodes
     *	tyscal	[0]	T_TYSCAL
     *		[1]	lineof "("
     *		[2]	id_list
     */
pPointer
EnumTCopy( tyscal )
    int *tyscal;
    {
	pPointer    EnumT = pNewNode( EnumTTAG , sizeof( struct EnumTNode ) );
	pPointer    ScalD;
	pPointer    Name;
	int	    *idp;
	pPointer    List;
	pPointer    After;

	After = pNIL;
	for ( idp = (int *) tyscal[2] ; idp != NIL ; idp = (int *) idp[2] ) {
	    ScalD = pNewNode( ScalDTAG , sizeof( struct ScalDNode ) );
	    Name = sCopy( idp[1] );
	    pDEF( ScalD ).ScalDName = Name;
	    nllook( idp[1] ) -> inTree = ScalD;
	    List = pNewNode( ListTAG , sizeof( struct ListNode ) );
	    pDEF( List ).ListItem = ScalD;
	    pDEF( List ).ListUp = After;
	    pDEF( List ).ListDown = pNIL;
	    if ( After == pNIL )
		    pDEF( EnumT ).EnumTScalars = List;
	      else  pDEF( After ).ListDown = List;
	    After = List;
	}
	return EnumT;
    }

    /*
     *	copies a variable declaration to a TypedNode
     *	with a type and a list of VarDNodes
     *	also, deals with previously declared (e.g. program files) variables.
     */
pPointer
VarDecl( idl , type )
    int	*idl;
    int	*type;
    {
	pPointer    Typed = pNewNode( TypedTAG , sizeof( struct TypedNode ) );
	int	    *idlp;
	struct nl   *var;
	pPointer    VarD;
	pPointer    Name;
	pPointer    Type = tCopy( type );
	pPointer    List;
	pPointer    After;

	pDEF( Typed ).TypedNames = pNIL;
	pDEF( Typed ).TypedType = Type;
	After = pNIL;
	for ( idlp = (int *) idl ; idlp != NIL ; idlp = (int *) idlp[2] ) {
	    if ( ( var = nllook( idlp[1] ) ) -> inTree == pNIL ) {
		    /*
		     *	usual case, a new variable
		     */
		    VarD = pNewNode( VarDTAG , sizeof( struct VarDNode ) );
		    Name = sCopy( idlp[1] );
		    pDEF( VarD ).VarDName = Name;
		    var -> inTree = VarD;
	    } else {
		    /*
		     *	previously declared (file) variable, already in tree
		     *	gets hung on list of variables, in addition
		     */
		    VarD = var -> inTree;
	    }
	    pDEF( VarD ).VarDType = Type;
	    if ( ( var -> type ) -> class == PTR ) {
		( var -> type ) -> inTree = Type;
	    }
	    List = pNewNode( ListTAG , sizeof( struct ListNode ) );
	    pDEF( List ).ListItem = VarD;
	    pDEF( List ).ListUp = After;
	    pDEF( List ).ListDown = pNIL;
	    if ( After == pNIL )
		    pDEF( Typed ).TypedNames = List;
	      else  pDEF( After ).ListDown = List;
	    After = List;
	}
	return Typed;
    }

\f
    /*
     *	initialize the pTree
     *	including cheapo versions of all the builtins (eech!)
     */
pTreeInit()
    {
	extern char	*in_consts[];
	extern char	*in_types[];
	extern char	*in_ctypes[];
	extern char	*in_vars[];
	extern char	*in_funcs[];
	extern char	*in_procs[];
	union pNodeBodies	*Glob;
	pPointer	List;
	char 		**cp;

	nesting = 0;
	PorFHeader[ nesting ] = pNewNode( GlobTAG , sizeof( struct GlobNode ) );
	pWorld = PorFHeader[ nesting ];
	pSeize( PorFHeader[ nesting ] );
	Glob = &( pDEF( PorFHeader[ nesting ] ) );
	    /*
	     *	built in constants
	     */
	dumpnl( NIL , "pTreeInit" );
	List = pNIL;
	for ( cp = in_consts ; *cp ; cp ++ ) {
	    pPointer BCon = pNewNode( BConstTAG , sizeof( struct BConstNode ) );
	    pPointer Name = sCopy( *cp );

	    pDEF( BCon ).BConstName = Name;
	    List = ListAppend( List , BCon );
	    nllook( *cp ) -> inTree = BCon;
	}
	Glob -> GlobConsts = List;
	    /*
	     *	built in simple and constructed types
	     */
	List = pNIL;
	    /*
	     *	simple types
	     */
	for ( cp = in_types ; *cp ; cp ++ ) {
	    pPointer BType = pNewNode( BTypeTAG , sizeof( struct BTypeNode ) );
	    pPointer Name = sCopy( *cp );

	    pDEF( BType ).BTypeName = Name;
	    List = ListAppend( List , BType );
	    nllook( *cp ) -> inTree = BType;
	}
	    /*
	     *	constructed types (aren't any more difficult)
	     */
	for ( cp = in_ctypes ; *cp ; cp ++ ) {
	    pPointer BType = pNewNode( BTypeTAG , sizeof( struct BTypeNode ) );
	    pPointer Name = sCopy( *cp );

	    pDEF( BType ).BTypeName = Name;
	    List = ListAppend( List , BType );
	    nllook( *cp ) -> inTree = BType;
	}
	Glob -> GlobType = List;
	    /*
	     *	built in variables
	     */
	List = pNIL;
	for ( cp = in_vars ; *cp ; cp ++ ) {
	    pPointer BVar = pNewNode( BVarTAG , sizeof( struct BVarNode ) );
	    pPointer Name = sCopy( *cp );

	    pDEF( BVar ).BVarName = Name;
	    List = ListAppend( List , BVar );
	    nllook( *cp ) -> inTree = BVar;
	}
	Glob -> GlobVars = List;
	    /*
	     *	built in functions and procedures
	     */
	List = pNIL;
	    /*
	     *	built in functions
	     */
	for ( cp = in_funcs ; *cp ; cp ++ ) {
	    pPointer BFunc = pNewNode( BFuncTAG , sizeof( struct BFuncNode ) );
	    pPointer Name = sCopy( *cp );

	    pDEF( BFunc ).BFuncName = Name;
	    List = ListAppend( List , BFunc );
	    nllook( *cp ) -> inTree = BFunc;
	}
	    /*
	     *	built in procedures
	     */
	for ( cp = in_procs ; *cp ; cp ++ ) {
	    pPointer BProc = pNewNode( BProcTAG , sizeof( struct BProcNode ) );
	    pPointer Name = sCopy( *cp );

	    pDEF( BProc ).BProcName = Name;
	    List = ListAppend( List , BProc );
	    nllook( *cp ) -> inTree = BProc;
	}
	Glob -> GlobPFs = List;
	pRelease( PorFHeader[ nesting ] );
    }

    /*
     *	find a symbol in the
     *	block structure symbol
     *	table and returns a pointer to
     *	its namelist entry.
     *	[this is a copy of lookup, except it calls nllook1
     *	whose only variation from lookup1 is that it doesn't set NUSED]
     */
struct nl *
nllook(s)
	register char *s;
{
	register struct nl *p;
	register struct udinfo *udp;

	if (s == NIL) {
		nocascade();
		return (NIL);
	}
	p = nllook1(s);
	if (p == NIL) {
		derror("%s is undefined", s);
		return (NIL);
	}
	if (p->class == FVAR) {
		p = p->chain;
		bn--;
	}
	return (p);
}

/*
 * an internal nllook.
 * It is not an error to call nllook1 if the symbol is not defined.
 * Also nllook1 will return FVARs while nllook never will.
 * [this is a copy of lookup1, except that it doesn't set NUSED]
 */

struct nl *
nllook1(s)
	register char *s;
{
	register struct nl *p;
#	ifndef PI0
	    register struct nl *q;
#	endif
	register int i;

	if (s == NIL)
		return (NIL);
	bn = cbn;
#ifndef PI0
	/*
	 * We first check the field names
	 * of the currently active with
	 * statements (expensive since they
	 * are not hashed).
	 */
	for (p = withlist; p != NIL; p = p->nl_next) {
		q = p->type;
		if (q == NIL)
			continue;
		if (reclook(q, s) != NIL)
			/*
			 * Return the WITHPTR, lvalue understands.
			 */
			return (p);
	}
#endif
	/*
	 * Symbol table is a 64 way hash
	 * on the low bits of the character
	 * pointer value. (Simple, but effective)
	 */
	i = (int) s & 077;
	for (p = disptab[i]; p != NIL; p = p->nl_next)
		if (p->symbol == s && p->class != FIELD && p->class != BADUSE) {
			bn = (p->nl_block & 037);
			return (p);
		}
	return (NIL);
}

#endif PTREE
Commit	Line	Data
f9df2b86 CH	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	\f
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