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 /* No journal comments present previous to 1983 !*/
 12 /* Modified 830106 BIM to note beginning of loop in statement so */
 13 /*                     compile_statement can align it to Y-pair. */
 14 do_semantics:       proc(blk,stmnt,tree);
 15 
 16 dcl       (blk,stmnt,tree) ptr,
 17           (cv,cvref,o,o1,o2,o3,o4,p,q,ref,s,spec,v) ptr,
 18           (first,last,next,label1,label2) ptr,
 19           (first_statement,last_statement,next_statement,label1_statement,prof) ptr,
 20           label_variable ptr,
 21 
 22           e(3) ptr,
 23 
 24           i fixed bin(15),
 25           sign_of_by fixed bin(15),
 26 
 27           (first_spec,first_time,multiple_spec) bit(1) aligned,
 28           opcode bit(9) aligned;
 29 
 30 dcl       pl1_stat_$profile bit(1) aligned ext static;
 31 
 32 /* builtins */
 33 
 34 dcl       (null, string, substr) builtin;
 35 
 36 %include semant;
 37 
 38 %include block;
 39 %include declare_type;
 40 %include label;
 41 %include list;
 42 %include nodes;
 43 %include operator;
 44 %include op_codes;
 45 %include reference;
 46 %include semantic_bits;
 47 %include statement;
 48 %include statement_types;
 49 %include symbol;
 50 %include system;
 51 %include token;
 52 %include token_types;
 53 
 54                               /*   ^L   */
 55 
 56           first_time = "1"b;
 57           last = tree->operand(1);
 58           spec = tree->operand(3);
 59           s = stmnt;
 60           last_statement = last->label.statement;
 61           if spec = null                          /* "do;" statement */
 62           then do;
 63                     last_statement->statement.reference_count = last_statement->statement.reference_count - 1;
 64                     go to ret;
 65                end;
 66 
 67           first_spec = "1"b;
 68           multiple_spec = spec->operand(6)^=null;
 69 
 70           if multiple_spec
 71           then do;
 72 /* first: ; */
 73                     first_statement = make_statement(s,null_statement,first);
 74                     first->label.statement->statement.reference_count = 1;
 75 
 76                     label_variable = declare_pointer(blk);
 77                     label_variable->reference.symbol->symbol.set = "1"b;
 78 
 79                     o = make_operator(jump,1,label_variable,null,null);
 80 /* goto label_variable; */
 81                     label1_statement = make_statement(last_statement,goto_statement,o);
 82                     label1_statement->statement.reference_count = 2;
 83                     label1_statement->statement.processed ="1"b;
 84           end;
 85 
 86           cv = tree->operand(2);
 87 
 88           if cv^=null
 89           then do;
 90                     v = cv;
 91 
 92                     if cv->node.type ^= reference_node
 93                     then do;
 94                               call semantic_translator$abort(145,cv);
 95                               go to ret;
 96                     end;
 97 
 98                     if cv->reference.symbol->node.type ^= symbol_node
 99                     then do;
100                               call semantic_translator$abort(145,cv);
101                               go to ret;
102                     end;
103 
104                     if cv->reference.symbol->symbol.based
105                     then do;
106                               p = declare_pointer(blk);
107                               q = v->reference.qualifier;
108                               o = make_operator(assign,2,p,q,null);
109 /* v->R.qualifier=cv->R.qualifier */
110                               s = make_statement(s,assignment_statement,o);
111                               v->reference.qualifier = p;
112                     end;
113 
114                     if v->reference.offset^=null
115                     then do;
116                               p = declare_integer(blk);
117                               q = v->reference.offset;
118                               o = make_operator(assign,2,p,q,null);
119 /* v->R.offset=cv->R.offset */
120                               s = make_statement(s,assignment_statement,o);
121                               v->reference.offset = p;
122                     end;
123 
124                     if v->reference.length^=null
125                     then do;
126                               p = declare_integer(blk);
127                               q = v->reference.length;
128                               o = make_operator(assign,2,p,q,null);
129 /* v->R.length=cv->R.length */
130                               s = make_statement(s,assignment_statement,o);
131                               v->reference.length = p;
132                     end;
133           end;
134 
135                               /*   ^L   */
136 
137           do while(spec^=null);
138                     if multiple_spec
139                     then do;
140 /* label1: ; */
141                               label1_statement = make_statement(label1_statement,null_statement,label1);
142                               label1_statement->statement.reference_count = 2;
143 
144                               o = make_operator(assign,2,label_variable,label1,null);
145 /* label_variable=label1; */
146                               s = make_statement(s,assignment_statement,o);
147                               s->statement.processed ="1"b;
148                     end;
149                     else do;
150                               label1_statement = last_statement;
151                               last_statement -> statement.reference_count = last_statement -> statement.reference_count - 1;
152                     end;
153 
154                     e(1), e(2), e(3) = null;
155 
156                     sign_of_by = 0;
157 
158                     do i=1 to 3;
159                               if spec->operand(i)^=null
160                               then      if spec->operand(i)->node.type=token_node
161                                         then do;
162                                                   e(i) = spec->operand(i);
163 
164                                                   if i=3
165                                                   then      if spec->operand(3)->token.type & is_constant
166                                                             then      if substr(spec->operand(3)->token.string,1,1)="-"
167                                                                       then      sign_of_by = -1;
168                                                                       else      sign_of_by =  1;
169                                         end;
170                                         else do;
171                                                   if spec->operand(i)->node.type=operator_node
172                                                   then      if spec->operand(i)->operator.op_code=loop
173                                                             |  spec->operand(i)->operator.op_code=join
174                                                             then      call semantic_translator$abort(140,null);
175                                                             else      p = spec->operand(i)->operand(1);
176                                                   else      p = spec->operand(i);
177 
178                                                   ref = p;
179 
180                                                   if p->node.type = reference_node
181                                                   then do;
182                                                             if p->reference.array_ref
183                                                             then      call semantic_translator$abort(140,null);
184 
185                                                             p = p->reference.symbol;
186 
187                                                             if p->node.type = symbol_node
188                                                             then do;
189                                                                       if p->symbol.area & spec->operand(4)=null
190                                                                       then      call semantic_translator$abort(143,p);
191 
192                                                                       if p->symbol.dcl_size^=null & spec->operand(4)=null
193                                                                       then      call semantic_translator$abort(144,p);
194                                                             end;
195                                                   end;
196 
197                                                   if i=1
198                                                   then      e(1) = spec->operand(1);
199 
200                                                   else      if p->symbol.constant & ref->reference.shared & i=2
201                                                             /* by is too complicated for this optimization */
202                                                   then      e(i) = spec->operand(i);
203 
204                                                   else do;
205 /* e(i)=expr(i) */
206                                                             q = create_symbol(blk,null,by_compiler);
207 
208                                                             if spec->operand(i)->node.type=operator_node
209                                                             then do;
210                                                                       if spec->operand(i)->op_code^=std_call
211                                                                       then do;
212                                                                                 q->symbol = p->symbol;
213                                                                                 q->symbol.next = null;
214                                                                                 q->symbol.block_node = blk;
215                                                                                 e(i)  ,
216                                                                                 spec->operand(i)->operand(1)  ,
217                                                                                 q->symbol.reference = copy_expression(p->symbol.reference);
218                                                                                 e(i)->reference.symbol = q;
219                                                                       end;
220                                                                       else do;
221                                                                                 e(i) = spec->operand(i)->operand(1);
222                                                                                 e(i)->reference.ref_count = e(i)->reference.ref_count+1;
223                                                                       end;
224 
225                                                                       s = make_statement(s,assignment_statement,(spec->operand(i)));
226                                                             end;
227                                                             else do;
228                                                                       e(i) = q->symbol.reference;
229                                                                       q->symbol.temporary = "1"b;
230                                                                       o = make_operator(assign,2,e(i),(spec->operand(i)),null);
231 
232                                                                       s = make_statement(s,assignment_statement,o);
233 
234                                                                       context = "0"b;
235 
236                                                                       s->statement.root = operator_semantics(blk,s,o,context);
237                                                             end;
238 
239                                                             q->symbol.temporary = "0"b;
240                                                             q->symbol.auto  ,
241                                                             q->symbol.allocate  ,
242                                                             s->statement.processed = "1"b;
243                                                   end;
244                                         end;
245                     end;
246 
247                     if e(1)^=null
248                     then do;
249                               o = make_operator(assign,2,copy_ref(v),e(1),null);
250 /* v=e1; */
251                               s = make_statement(s,assignment_statement,o);
252                     end;
253 
254                     if e(2)=null & e(3)=null & spec->operand(4)=null & spec->operand(5)=null
255                     then do;
256                               next_statement = label1_statement;
257                               goto next_spec;
258                     end;
259 /* next: ; */
260                     next_statement = make_statement(label1_statement,null_statement,next);
261                     next_statement->statement.reference_count = 1;
262                     string(next_statement->statement.source_id) = string(last_statement->statement.source_id);
263 
264                     if spec->operand(2)^=null
265                     |  spec->operand(3)^=null
266                     |  spec->operand(4)^=null
267                     |  spec->operand(5)^=null & cv=null
268                     then do;
269 /* label2: ; */
270                               s = make_statement(s,null_statement,label2);
271                               s->statement.begins_loop = "1"b;
272                               s->statement.reference_count = 2;
273 
274                     end;
275 
276                     if cv^=null
277                     then do;
278                               if e(2)^=null & e(3)=null
279                               then do;
280                                         sign_of_by = 1;
281                                         e(3) = create_token("1",dec_integer);
282                               end;
283 
284                               if e(3)^=null
285                               then do;
286                                         o = make_operator(add,3,null,copy_ref(v),share_expression(e(3)));
287                                         o = make_operator(assign,2,copy_ref(v),o,null);
288 /* v=v+e3; */
289                                         label1_statement = make_statement(label1_statement,assignment_statement,o);
290                                         string(label1_statement->statement.source_id) = string(last_statement->statement.source_id);
291                               end;
292 
293                               if spec->operand(4)^=null
294                               then do;
295                                         o = make_operator(assign,2,copy_ref(v),(spec->operand(4)),null);
296                                         label1_statement = make_statement(label1_statement,assignment_statement,o);
297                                         string(label1_statement->statement.source_id) = string(last_statement->statement.source_id);
298                                         o->operand(2) = expression_semantics(blk,label1_statement,(o->operand(2)),"0"b);
299                               end;
300 
301                               if e(2)^=null
302                               then      if sign_of_by=0
303                                         then do;
304                                                   cvref = copy_ref(v);
305                                                   if ^ cvref -> reference.shared
306                                                        then cvref -> reference.ref_count = 2;
307 
308                                                   o3 = make_operator(greater_or_equal,3,null,share_expression(e(3)),create_token("0",dec_integer));
309                                                   o4 = make_operator(greater_than,3,null,cvref,share_expression(e(2)));
310                                                   o1 = make_operator(and_bits,3,null,o3,o4);
311 
312                                                   o3 = make_operator(less_than,3,null,share_expression(e(3)),create_token("0",dec_integer));
313                                                   o4 = make_operator(less_than,3,null,cvref,share_expression(e(2)));
314                                                   o2 = make_operator(and_bits,3,null,o3,o4);
315 
316                                                   o = make_operator(or_bits,3,null,o1,o2);
317                                                   o = make_operator(jump_true,2,next,o,null);
318 
319 
320 /* if (e3>=0) & (v>e2) | (e3<0) & (v<e2) then goto next; */
321                                                   s = make_statement(s,if_statement,o);
322                                         end;
323                                         else do;
324                                                   if sign_of_by>0
325                                                   then      opcode = jump_if_gt;
326                                                   else      opcode = jump_if_lt;
327                                                   o = make_operator(opcode,3,next,copy_ref(v),share_expression(e(2)));
328 
329 /* if v>e2 [v<e2] then goto next; */
330                                                   s = make_statement(s,if_statement,o);
331                                         end;
332                     end;
333 
334                     if spec->operand(5)^=null
335                     then do;
336                               if spec->operand(5)->node.type^=operator_node
337                               then      goto create_jump_operator;
338 
339                               opcode = spec->operand(5)->operator.op_code;
340 
341                               if opcode<less_than | opcode>greater_or_equal
342                               then      goto create_jump_operator;
343 
344                               if opcode=equal
345                               then      opcode = jump_if_ne;          else
346                               if opcode=not_equal
347                               then      opcode = jump_if_eq;          else
348                               if opcode=less_than
349                               then      opcode = jump_if_ge;          else
350                               if opcode=greater_than
351                               then      opcode = jump_if_le;          else
352                               if opcode=less_or_equal
353                               then      opcode = jump_if_gt;
354                               else      opcode = jump_if_lt;
355 
356                               o = spec->operand(5);
357                               o->operator.op_code = opcode;
358                               o->operand(1) = next;
359 
360                               goto create_while_statement;
361 
362 create_jump_operator:
363                               o = make_operator(jump_false,2,next,(spec->operand(5)),null);
364 /* if ^e5 then goto next; */
365 create_while_statement:
366                               s = make_statement(s,if_statement,o);
367                               o = expression_semantics(blk,s,o,"0"b);
368                     end;
369 
370                     if e(3)^=null
371                     |  spec->operand(4)^=null
372                     |  spec->operand(5)^=null & cv=null
373                     then do;
374                               o = make_operator(jump,1,label2,null,null);
375 /* goto label2; */
376                               label1_statement = make_statement(label1_statement,goto_statement,o);
377                               string(label1_statement->statement.source_id) = string(last_statement->statement.source_id);
378                               label1_statement->statement.processed ="1"b;
379 
380                               if pl1_stat_$profile
381                               then do;
382 
383                                         /* we want 2 profile entries for do statement, so put
384                                            out a statement with 0 id */
385 
386                                         prof = label2->label.statement;
387                                         prof = create_statement(null_statement,prof,null,(prof->statement.prefix));
388                                         string(prof->statement.source_id) = "0"b;
389                               end;
390                     end;
391 
392 next_spec:
393                     if ^first_spec
394                     then do;
395                               o = make_operator(jump,1,first,null,null);
396 /* goto first */
397                               s = make_statement(s,goto_statement,o);
398                               first->label.statement->statement.reference_count = first->label.statement->statement.reference_count+1;
399                               s->statement.processed ="1"b;
400                     end;
401 
402                     else do;
403                          first_spec = "0"b;
404                     end;
405                     label1_statement  ,
406                     s = next_statement;
407                     spec = spec->operand(6);
408           end;
409 
410           goto ret;
411 
412 
413                               /*   ^L   */
414 
415 make_operator:      proc(opcode,number,opnd1,opnd2,opnd3) returns(ptr);
416 
417 dcl       opcode bit(9) aligned,
418 
419           number fixed bin(15),
420 
421           (op,opnd1,opnd2,opnd3) ptr;
422 
423           op = create_operator(opcode,number);
424 
425           if number >= 1
426           then do;
427                     op -> operator.operand (1) = opnd1;
428 
429                     if number >= 2
430                     then do;
431                               op -> operator.operand (2) = opnd2;
432 
433                               if number >= 3
434                               then op -> operator.operand (3) = opnd3;
435                          end;
436                end;
437 
438           return(op);
439 
440           end make_operator;
441 
442 make_statement:     proc(st,type,opnd) returns(ptr);
443 
444 dcl       type bit(9) aligned,
445 
446           (opnd,st,stp) ptr;
447 
448           stp = create_statement(type,st,null,(st->statement.prefix));
449           stp->statement.generated = "1"b;
450 
451           if type=null_statement
452           then do;
453                     opnd = create_label(blk,null,by_compiler);
454                     opnd->label.statement = stp;
455                     stp->statement.labels = create_list(2);
456                     stp->statement.labels->list.element(2) = opnd;
457 
458                     stp->statement.processed ="1"b;
459           end;
460           else      stp->statement.root = opnd;
461 
462           return(stp);
463 
464           end make_statement;
465 
466 copy_ref: proc(pt) returns(ptr);
467 
468 dcl       (p,pt) ptr;
469 
470           if first_time
471           then do;
472                first_time = "0"b;
473                return(pt);
474                end;
475 
476           if pt -> reference.shared
477                then return(pt);
478 
479           p = create_reference(null);
480           p -> reference = pt -> reference;
481 
482           /* offset and length are known to be null or shared auto
483              variables, so only check qualifier */
484 
485           if p -> reference.qualifier ^= null
486                then p -> reference.qualifier = share_expression((p -> reference.qualifier));
487 
488           return(p);
489 
490           end copy_ref;
491 
492                               /*   ^L   */
493 
494 ret:
495           call free_node(tree);
496 
497           end do_semantics;