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 /*        This procedure allocates and initializes a statement node.
 12           Modified on:        April 1977 by RHS for new allocation methods
 13           Modified on:        14 March 1980 by M. N. Davidoff to add some comments
 14 */
 15 /* format: style3 */
 16 create_statement:
 17      proc (statement_type, father_block, label_ptr, conditions) returns (pointer);
 18 
 19 dcl       (i, nodetype)       fixed bin (15),
 20           statement_type      bit (9) aligned,
 21           (lab, p, q, qq, ref, t, father_block, label_ptr)
 22                               ptr;
 23 dcl       conditions          bit (12) aligned;
 24 
 25 dcl       pl1_stat_$node_uses (32) fixed bin ext;
 26 dcl       (
 27           pl1_stat_$source_seg,
 28           pl1_stat_$st_length
 29           )                   fixed bin (11) ext static,
 30           pl1_stat_$st_start  fixed bin (23) ext static,
 31           pl1_stat_$cur_block ptr ext,
 32           pl1_stat_$cur_statement
 33                               ptr ext,
 34           pl1_stat_$free_ptr  (18) ptr ext static;
 35 
 36 dcl       (fixed, null, string)
 37                               builtin;
 38 
 39 %include pl1_tree_areas;
 40 %include token_list;
 41 %include label;
 42 %include reference;
 43 %include list;
 44 %include statement;
 45 %include block;
 46 %include nodes;
 47 %include statement_types;
 48 ^L
 49           if father_block = null
 50           then i = 3;
 51 
 52           else if father_block -> node.type = statement_node/* for inserting a statement */
 53           then i = 3;
 54 
 55           else i = 1;
 56 
 57           go to common;
 58 
 59 create_statement$prologue:
 60      entry (statement_type, father_block, label_ptr, conditions) returns (ptr);
 61 
 62           i = 2;
 63 
 64 common:
 65           nodetype = fixed (statement_node, 15, 0);
 66           p = pl1_stat_$free_ptr (nodetype);
 67 
 68           if p ^= null
 69           then pl1_stat_$free_ptr (nodetype) = p -> statement.next;
 70           else do;
 71                     pl1_stat_$node_uses (2) = pl1_stat_$node_uses (2) + 1;
 72                     allocate statement in (xeq_tree_area) set (p);
 73                end;
 74 
 75           p -> statement.node_type = statement_node;
 76           p -> statement.statement_type = statement_type;
 77           p -> statement.optimized, p -> statement.free_temps, p -> statement.LHS_in_RHS, string (p -> statement.bits) = "0"b;
 78 
 79           p -> statement.reference_count, p -> statement.ref_count_copy, p -> statement.object.start,
 80                p -> statement.object.finish = 0;
 81 
 82           if i = 3
 83           then do;
 84 
 85 /* Use statement numbering information from statement being processed by top level of expression_semantics,
 86    unless we are doing a do statement. */
 87 
 88                     q = pl1_stat_$cur_statement;
 89 
 90                     if q ^= null
 91                     then if q -> statement.statement_type = do_statement
 92                                                             /* for do_semantics */
 93                          then q = father_block;
 94 
 95                     if q = null
 96                     then q = father_block;
 97 
 98                     p -> statement.source.segment = q -> statement.source.segment;
 99                     p -> statement.source.start = q -> statement.source.start;
100                     p -> statement.source.length = q -> statement.source.length;
101                     string (p -> statement.source_id) = string (q -> statement.source_id);
102                end;
103           else do;
104                     p -> statement.source.segment = pl1_stat_$source_seg;
105                     p -> statement.source.start = pl1_stat_$st_start;
106                     p -> statement.source.length = pl1_stat_$st_length;
107                     string (p -> statement.source_id) = string (pl1_stat_$statement_id);
108                end;
109 
110           p -> statement.labels = label_ptr;
111           p -> statement.prefix = conditions;
112 
113           p -> statement.next, p -> statement.root, p -> statement.state_list, p -> statement.reference_list = null;
114 
115           go to action (i);
116 
117 action (1):                                                 /* end of the main sequence */
118           if father_block -> block.end_main = null
119           then father_block -> block.main = p;
120           else father_block -> block.end_main -> statement.next = p;
121           p -> statement.back = father_block -> block.end_main;
122           father_block -> block.end_main = p;
123           return (p);
124 
125 action (2):                                                 /* end of the prologue sequence */
126           if father_block -> block.end_prologue = null
127           then father_block -> block.prologue = p;
128           else father_block -> block.end_prologue -> statement.next = p;
129           p -> statement.back = father_block -> block.end_prologue;
130           father_block -> block.end_prologue = p;
131           return (p);
132 
133 action (3):
134           if father_block = null
135           then do;
136 
137 /* No statements preceding cur_statement in prologue. */
138 
139                     t = pl1_stat_$cur_block -> block.prologue;
140                     goto con;
141                end;
142 
143           if string (p -> statement.source_id) ^= string (father_block -> statement.source_id)
144           then do;
145 
146 /* p has become the first statement node of the corresponding source statement. */
147 
148                     p -> statement.put_in_profile, p -> statement.free_temps = "1"b;
149 
150                     t = father_block -> statement.next;
151                     if t ^= null
152                     then do;
153 con:
154                               t -> statement.put_in_profile, t -> statement.free_temps = "0"b;
155 
156                               if t -> statement.statement_type ^= entry_statement
157                                    & q -> statement.statement_type ^= do_statement
158                               then do;
159                                         do qq = t -> statement.labels repeat qq -> list.element (1) while (qq ^= null);
160                                              if qq -> list.element (2) -> node.type = label_node
161                                              then qq -> list.element (2) -> label.statement = p;
162                                              else if qq -> list.element (2) -> node.type ^= token_node
163                                              then do;
164                                                        ref = qq -> element (2);
165                                                        lab = ref -> reference.symbol;
166                                                        lab -> label.statement -> element (ref -> reference.c_offset + 1) = p;
167                                                   end;
168                                         end;
169 
170                                         p -> statement.reference_count = t -> statement.reference_count;
171                                         t -> statement.reference_count = 0;
172                                         p -> statement.labels = t -> statement.labels;
173                                         t -> statement.labels = null;
174                                    end;
175                          end;
176                end;
177 
178           if father_block ^= null
179           then do;                                          /* insert into the main sequence */
180                     p -> statement.back, q = father_block;
181                     p -> statement.next = q -> statement.next;
182                     q -> statement.next = p;
183 
184                     q = p -> statement.next;
185                     if q ^= null
186                     then q -> statement.back = p;
187                end;
188           else do;
189                     p -> statement.back = null;
190                     p -> statement.next = pl1_stat_$cur_block -> block.prologue;
191                     pl1_stat_$cur_block -> block.prologue = p;
192                     p -> statement.next -> statement.back = p;
193                end;
194 
195           return (p);
196 
197      end;