1 /* ***********************************************************
 2    *                                                         *
 3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
 4    *                                                         *
 5    * Copyright (c) 1972 by Massachusetts Institute of        *
 6    * Technology and Honeywell Information Systems, Inc.      *
 7    *                                                         *
 8    *********************************************************** */
 9 
10 
11 declare_label:      proc(cblock,cstatement,clabel,dcltype);
12 
13           /* same in VERSION 1 and VERSION 2 */
14 
15 
16 dcl       (cblock,cstatement,clabel) ptr,
17           (d,q,t) ptr,
18 
19           (n,value) fixed bin(15),
20 
21           array bit(1) aligned,
22           dcltype bit(3) aligned;
23 
24 dcl       (max,min,null) builtin;
25 
26 %include language_utility;
27 %include block;
28 %include label;
29 %include list;
30 %include nodes;
31 %include reference;
32 %include token;
33 %include label_array_element;
34 
35 begin:
36           q=clabel;
37           do while(q^=null);
38                     array="0"b;
39                     value = 0;
40                     t=q->list.element(2);
41                     if t->node.type=reference_node
42                     then do;
43                               array="1"b;
44                               value = token_to_binary((t->reference.offset->list.element(1)));
45                               t=t->reference.symbol;        /* get token pointer */
46                     end;
47                     d=t->token.declaration;
48                     do while(d^=null);
49                               if d->label.block_node = cblock & d->node.type = label_node
50                                         then do;
51                                                   if d->label.array ^= array
52                                                   then call parse_error(31,t);
53 
54                                                   else if ^ array
55                                                   then call parse_error(54,t);
56 
57                                                   else do;
58                                                        d->label.low_bound = min(value,d->label.low_bound);
59                                                        d->label.high_bound = max(value,d->label.high_bound);
60                                                        call push_array_element;
61                                                        end;
62 
63                                                   goto next_label;
64                                              end;
65                               d=d->label.multi_use;
66                     end;
67                     d=create_label(cblock,t,dcltype);
68 
69                     if array
70                     then do;
71                          d -> label.array = "1"b;
72                          d -> label.low_bound, d -> label.high_bound = value;
73                          call push_array_element;
74                          end;
75                     else d -> label.statement = cstatement;
76 
77 next_label:
78                     q=q->list.element(1);
79           end;
80 
81 
82 push_array_element: proc;
83 
84 dcl       lae ptr;
85 
86           /* associate this label array element with this statement */
87 
88           lae = create_list(3);
89           lae -> label_array_element.node_type = label_array_element_node;
90           lae -> label_array_element.statement = cstatement;
91           lae -> label_array_element.value = value;
92           lae -> label_array_element.next = d -> label.statement;
93           d -> label.statement = lae;
94 
95           end;
96 
97 
98           end declare_label;