xref: /csrg-svn/usr.bin/pascal/src/lookup.c (revision 757)
1*757Speter /* Copyright (c) 1979 Regents of the University of California */
2*757Speter 
3*757Speter static	char sccsid[] = "@(#)lookup.c 1.1 08/27/80";
4*757Speter 
5*757Speter #include "whoami.h"
6*757Speter #include "0.h"
7*757Speter 
8*757Speter /*
9*757Speter  * Lookup is called to
10*757Speter  * find a symbol in the
11*757Speter  * block structure symbol
12*757Speter  * table and returns a pointer to
13*757Speter  * its namelist entry.
14*757Speter  */
15*757Speter struct nl *
16*757Speter lookup(s)
17*757Speter 	register char *s;
18*757Speter {
19*757Speter 	register struct nl *p;
20*757Speter 	register struct udinfo *udp;
21*757Speter 
22*757Speter 	if (s == NIL) {
23*757Speter 		nocascade();
24*757Speter 		return (NIL);
25*757Speter 	}
26*757Speter 	p = lookup1(s);
27*757Speter 	if (p == NIL) {
28*757Speter 		derror("%s is undefined", s);
29*757Speter 		return (NIL);
30*757Speter 	}
31*757Speter 	if (p->class == FVAR) {
32*757Speter 		p = p->chain;
33*757Speter 		bn--;
34*757Speter 	}
35*757Speter 	return (p);
36*757Speter }
37*757Speter 
38*757Speter #ifndef PI0
39*757Speter int	flagwas;
40*757Speter #endif
41*757Speter /*
42*757Speter  * Lookup1 is an internal lookup.
43*757Speter  * It is not an error to call lookup1
44*757Speter  * if the symbol is not defined.  Also
45*757Speter  * lookup1 will return FVARs while
46*757Speter  * lookup never will, thus asgnop
47*757Speter  * calls it when it thinks you are
48*757Speter  * assigning to the function variable.
49*757Speter  */
50*757Speter 
51*757Speter struct nl *
52*757Speter lookup1(s)
53*757Speter 	register char *s;
54*757Speter {
55*757Speter 	register struct nl *p;
56*757Speter #ifndef PI0
57*757Speter 	register struct nl *q;
58*757Speter #endif
59*757Speter 	register int i;
60*757Speter 
61*757Speter 	if (s == NIL)
62*757Speter 		return (NIL);
63*757Speter 	bn = cbn;
64*757Speter #ifndef PI0
65*757Speter 	/*
66*757Speter 	 * We first check the field names
67*757Speter 	 * of the currently active with
68*757Speter 	 * statements (expensive since they
69*757Speter 	 * are not hashed).
70*757Speter 	 */
71*757Speter 	for (p = withlist; p != NIL; p = p->nl_next) {
72*757Speter 		q = p->type;
73*757Speter 		if (q == NIL)
74*757Speter 			continue;
75*757Speter 		if (reclook(q, s) != NIL)
76*757Speter 			/*
77*757Speter 			 * Return the WITHPTR, lvalue understands.
78*757Speter 			 */
79*757Speter 			return (p);
80*757Speter 	}
81*757Speter #endif
82*757Speter 	/*
83*757Speter 	 * Symbol table is a 64 way hash
84*757Speter 	 * on the low bits of the character
85*757Speter 	 * pointer value. (Simple, but effective)
86*757Speter 	 */
87*757Speter 	i = (int) s & 077;
88*757Speter 	for (p = disptab[i]; p != NIL; p = p->nl_next)
89*757Speter 		if (p->symbol == s && p->class != FIELD && p->class != BADUSE) {
90*757Speter 			bn = (p->nl_block & 037);
91*757Speter #ifndef PI0
92*757Speter 			flagwas = p->nl_flags;
93*757Speter 			p->nl_flags |= NUSED;
94*757Speter #endif
95*757Speter 			return (p);
96*757Speter 		}
97*757Speter 	return (NIL);
98*757Speter }
99*757Speter 
100*757Speter #ifndef PI01
101*757Speter nlfund(sp)
102*757Speter 	char *sp;
103*757Speter {
104*757Speter 	register struct nl *p;
105*757Speter 	register int i;
106*757Speter 
107*757Speter 	i = (int) sp & 077;
108*757Speter 	for (p = disptab[i]; p != NIL; p = p->nl_next)
109*757Speter 	if (p->symbol == sp && (p->nl_block & 037) == 0)
110*757Speter 		return (nloff(p));
111*757Speter 	return (0);
112*757Speter }
113*757Speter #endif
114