1
2
3
4
5
6
7
8
9
10
11
12
13
14
15 lookup: proc(blk,stmnt,tree,s,context) returns(bit(1) aligned);
16
17 dcl (blk,stmnt,tree,s,d,q,b,f,name) ptr;
18 dcl fully_qualified bit(1);
19 dcl (n,k) fixed bin(15);
20 dcl pl1_stat_$LHS ptr ext static;
21
22 dcl (addr,null,substr,string) builtin;
23
24 %include semant;
25
26
27 %include symbol;
28
29 %include label;
30
31 %include reference;
32 %include semantic_bits;
33
34 %include block;
35
36 %include statement;
37
38
39 %include token;
40
41 %include list;
42
43 %include cross_reference;
44
45 %include nodes;
46
47
48
49 n = 0;
50 d = null;
51 if tree->node.type = reference_node
52 then do;
53 q = tree->reference.length;
54 name = tree->reference.symbol;
55 end;
56 else do;
57 q = null;
58 name = tree;
59 end;
60
61
62
63
64
65
66
67
68
69
70
71 b = blk;
72 do while(b^=null);
73 s = name->token.declaration;
74 do while(s^=null);
75 fully_qualified = "1"b;
76 if s->symbol.block_node^=b
77 then goto not_applicable;
78 if s->node.type = label_node
79 then if q = null
80 then go to applicable;
81 else go to not_applicable;
82 if q = null then do;
83 if s->symbol.member then fully_qualified = "0"b;
84 go to applicable;
85 end;
86 k = 1;
87 f = s;
88 do while(k <= q->list.number);
89 do f=f->symbol.father repeat f->symbol.father while(f^=null);
90 if f->symbol.token = q->list.element(k) then go to next_name;
91 fully_qualified = "0"b;
92 end;
93 go to not_applicable;
94 next_name:
95 k = k+1;
96 end;
97
98 fully_qualified = fully_qualified & f->symbol.father=null;
99
100 applicable:
101
102 if fully_qualified then go to exit;
103 n = n+1;
104 d = s;
105 not_applicable:
106 s = s->symbol.multi_use;
107 end;
108
109 if n>0 then b = null;else b = b->block.father;
110 end;
111
112 if n>1 then call semantic_translator$abort(221,name);
113 if d = null then return("0"b);
114 s = d;
115
116 exit:
117 if tree->node.type = reference_node & ^def_context.by_name_lookup
118 then do;
119 tree->reference.length = null;
120 tree->reference.symbol = s;
121 end;
122 if s->node.type = symbol_node
123 then if ^def_context.ignore_based
124 then do d=s repeat d->symbol.father while(d^=null);
125 d->symbol.allocate = "1"b;
126 end;
127
128 if stmnt ^= null
129 then if stmnt->node.type = statement_node & ^def_context.suppress_cross_ref
130 then do;
131 d = create_cross_reference();
132 q = s;
133 if s -> node.type ^= label_node
134 then if s -> symbol.condition
135 then q = s -> symbol.equivalence;
136 d->cross_reference.next = q->symbol.cross_references;
137 q->symbol.cross_references = d;
138 string(d->cross_reference.source_id) = string(stmnt->statement.source_id);
139 end;
140
141 return("1"b);
142
143 end lookup;