1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38 prepare_operand:
39 proc (pt, evaluate, atomic) returns (ptr);
40
41 dcl pt ptr,
42 evaluate fixed bin,
43
44
45 atomic bit (1) aligned;
46
47 dcl (p, p1, p2, q, s) ptr,
48 (cfo, eval, n, bit_length)
49 fixed bin,
50 (str, useless, here_before, padded_bit)
51 bit (1) aligned,
52 op_code bit (9) aligned;
53
54 dcl (
55 cg_stat$long_string_temp,
56 cg_stat$cur_block,
57 cg_stat$cur_statement,
58 cg_stat$cur_node
59 ) ptr ext;
60
61 dcl (
62 assign_op,
63 compile_exp,
64 stack_temp$assign_aggregate,
65 state_man$update_ref
66 ) entry (ptr),
67 adjust_ref_count entry (ptr, fixed bin),
68 state_man$update_reg
69 entry (ptr, bit (19) aligned),
70 state_man$erase_reg entry (bit (19) aligned),
71 (
72 compile_exp$save,
73 compile_exp$save_exp
74 ) entry (ptr) returns (ptr),
75 eval_exp entry (ptr, bit (1) aligned) returns (ptr),
76 get_reference entry returns (ptr),
77 prepare_operand entry (ptr, fixed bin, bit (1) aligned) returns (ptr),
78 copy_temp entry (ptr) returns (ptr),
79 generate_constant$real_fix_bin_1
80 entry (fixed bin) returns (ptr),
81 check_o_and_s entry (ptr) returns (ptr),
82 load entry (ptr, fixed bin),
83 call_op entry (ptr) returns (ptr),
84 base_man$load_packed
85 entry (ptr, fixed bin),
86 pointer_builtins entry (ptr, bit (1) aligned),
87 length_op entry (ptr) returns (ptr),
88 assign_desc_op entry (ptr) returns (ptr),
89 decimal_op$change_target
90 entry (ptr) returns (bit (1) aligned),
91 decimal_op$get_float_temp
92 entry (fixed bin (24), bit (1) aligned) returns (ptr),
93 assign_op$to_dec_scaled
94 entry (ptr, ptr);
95
96 dcl (addrel, divide, fixed, max, mod, null, string, substr)
97 builtin;
98
99 dcl fix_bin (0:1) fixed bin based;
100
101 dcl io_class init ("10000"b) bit (5) int static;
102
103 %include cgsystem;
104 %include reference;
105 %include symbol;
106 %include array;
107 %include label;
108 %include operator;
109 %include nodes;
110 %include op_codes;
111 %include data_types;
112 %include boundary;
113 %include machine_state;
114
115 p, q = pt;
116 atomic = "1"b;
117
118 eval = evaluate;
119
120 if p -> node.type = label_node
121 then do;
122
123 q = get_reference ();
124 q -> reference.symbol = p;
125
126 l1:
127 q -> reference.data_type = label_constant;
128 q -> reference.allocated = p -> label.allocated;
129 q -> reference.aliasable, q -> reference.temp_ref, q -> reference.defined_ref, q -> reference.allocate = "0"b;
130 goto l3;
131 end;
132
133 if p -> node.type = operator_node
134 then do;
135
136 if p -> operator.op_code = desc_size
137 then do;
138 q = check_o_and_s (p);
139 if q ^= null
140 then goto go;
141 end;
142
143 q = p -> operand (1);
144
145
146
147 if q -> reference.evaluated
148 then if q -> reference.data_type = 0
149 then goto l8a;
150 else do;
151 if eval > 0
152 then if q -> reference.symbol -> node.type = symbol_node
153 then if q -> reference.symbol -> symbol.return_value
154 then q -> reference.length = eval_exp ((q -> reference.length), "1"b);
155 if ^q -> reference.aligned_ref
156 then atomic = "0"b;
157 goto done;
158 end;
159
160 if p -> operator.op_code = assign
161 then do;
162 s = p -> operand (2);
163 if s -> node.type ^= reference_node
164 then goto l8;
165 if s -> reference.symbol -> node.type ^= symbol_node
166 then goto l8;
167 if ^s -> reference.symbol -> symbol.arg_descriptor
168 then goto l8;
169 if ^q -> reference.symbol -> symbol.temporary
170 then goto l8;
171
172
173
174
175 if q -> reference.shared
176 then do;
177 q = s;
178 goto go;
179 end;
180 else do;
181 q = assign_desc_op (p);
182 go to exit;
183 end;
184 end;
185
186 if p -> operator.op_code = length_fun
187 then do;
188 q = length_op (p);
189 go to exit;
190 end;
191
192 if p -> operator.op_code = std_call
193 then do;
194 q = call_op (p);
195 if ^q -> reference.aligned_ref
196 then atomic = "0"b;
197 goto done;
198 end;
199
200 l8:
201 eval = 0;
202 l8a:
203 atomic = "0"b;
204 end;
205
206
207
208 go:
209 p1 = q -> reference.qualifier;
210 s = q -> reference.symbol;
211
212 here_before = q -> reference.data_type ^= 0 & ^q -> reference.shared;
213
214 if s -> node.type = label_node
215 then do;
216 p = s;
217 goto l1;
218 end;
219
220 q -> reference.aggregate =
221 q -> reference.array_ref | s -> symbol.structure | s -> symbol.arg_descriptor | s -> symbol.storage_block
222 | ((s -> symbol.dimensioned | s -> symbol.member) & s -> symbol.temporary);
223
224 q -> reference.aliasable =
225 s -> symbol.aliasable
226 | (s -> symbol.auto & (cg_stat$cur_block ^= s -> symbol.block_node) & s -> symbol.passed_as_arg);
227 q -> reference.temp_ref = q -> reference.temp_ref | s -> symbol.temporary;
228 q -> reference.allocated =
229 q -> reference.allocated | (s -> symbol.allocated & q -> reference.temp_ref = s -> symbol.temporary);
230 q -> reference.defined_ref = s -> symbol.defined & ^q -> reference.temp_ref;
231 q -> reference.allocate =
232 q -> reference.allocate | s -> symbol.allocate | q -> reference.ref_count > 0 | q -> reference.aggregate
233 | ^q -> reference.temp_ref;
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275 Note
276
277
278
279
280
281
282
283
284
285 q -> reference.padded_for_store_ref = q -> reference.padded_ref;
286
287 if ^s -> symbol.packed
288 then do;
289 padded_bit,
290 q -> reference.padded_for_store_ref =
291 ^q -> reference.substr | q -> reference.c_length = s -> symbol.c_dcl_size;
292
293 if ^(s -> symbol.parameter | (s -> symbol.defined & s -> symbol.overlayed))
294 then q -> reference.padded_ref = padded_bit;
295 end;
296
297
298 Note
299
300
301 if s -> symbol.passed_as_arg
302 then if ^s -> symbol.constant
303 then q -> reference.padded_ref = "0"b;
304
305
306
307 if p1 ^= null
308 then if p1 -> node.type ^= temporary_node
309 then if eval ^= 0
310 then if ^q -> reference.defined_ref
311 then call pointer_chain (q);
312 else call defined_chain (q);
313
314
315
316 if s -> symbol.binary
317 then do;
318 if s -> symbol.fixed
319 then if s -> symbol.c_dcl_size > max_p_fix_bin_1
320 then n = real_fix_bin_2;
321 else n = real_fix_bin_1;
322 else if s -> symbol.c_dcl_size > max_p_flt_bin_1
323 then n = real_flt_bin_2;
324 else n = real_flt_bin_1;
325
326 if s -> symbol.complex
327 then n = n + 4;
328 goto set;
329 end;
330
331 if s -> symbol.decimal
332 then do;
333 n = real_fix_dec + fixed (s -> symbol.float, 1);
334 if s -> symbol.complex
335 then n = n + 2;
336
337 set:
338 q -> reference.data_type = n;
339 goto l2;
340 end;
341
342 if s -> symbol.char | s -> symbol.picture
343 then do;
344 q -> reference.data_type = char_string;
345 goto l2;
346 end;
347
348 if s -> symbol.bit
349 then do;
350 q -> reference.data_type = bit_string;
351 goto l2;
352 end;
353
354 if s -> symbol.offset
355 then do;
356 q -> reference.data_type = real_fix_bin_1;
357 goto l2;
358 end;
359
360 if s -> symbol.ptr
361 then do;
362 if q -> reference.temp_ref
363 then if q -> reference.shared
364 then do;
365 q = copy_temp (q);
366 q -> reference.ref_count = 2;
367 if p -> node.type = operator_node
368 then p -> operator.operand (1) = q;
369 end;
370 q -> reference.data_type = unpacked_ptr + fixed (s -> symbol.packed | s -> symbol.unaligned | s -> symbol.explicit_packed, 1);
371 goto l2;
372 end;
373
374 if s -> symbol.label
375 then do;
376 q -> reference.data_type = label_variable - fixed (s -> symbol.local, 1);
377 goto l2;
378 end;
379
380 if s -> symbol.arg_descriptor
381 then do;
382 q -> reference.data_type = real_fix_bin_1;
383 goto l2;
384 end;
385
386 if s -> symbol.file
387 then do;
388 q -> reference.data_type = local_label_variable;
389 goto l2;
390 end;
391
392 if s -> symbol.format
393 then do;
394 q -> reference.data_type = local_label_variable - fixed (s -> symbol.constant, 1);
395 goto l2;
396 end;
397
398 if s -> symbol.area
399 then do;
400 q -> reference.data_type = real_fix_bin_2;
401 go to l2;
402 end;
403
404 if s -> symbol.entry
405 then if s -> symbol.variable | s -> symbol.temporary
406 then q -> reference.data_type = entry_variable;
407 else if s -> symbol.external
408 then q -> reference.data_type = ext_entry_in + fixed (s -> symbol.initial = null);
409 else q -> reference.data_type = int_entry;
410
411 l2:
412 str = s -> symbol.char | s -> symbol.bit | s -> symbol.picture;
413
414 if here_before
415 then do;
416 if (s -> symbol.packed & ^(str | s -> symbol.decimal))
417 | (str & ^(q -> reference.long_ref | q -> reference.varying_ref))
418 then if ^q -> reference.aligned_ref
419 then atomic = "0"b;
420
421 goto done;
422 end;
423
424 n = q -> reference.units;
425 if n = 0
426 then n, q -> reference.units = word_;
427
428 else if n ^= word_ & q -> reference.offset = null
429 then if mod (q -> reference.c_offset, units_per_word (n)) = 0
430 then do;
431 q -> reference.c_offset = divide (q -> reference.c_offset, units_per_word (n), 17, 0);
432 n, q -> reference.units = word_;
433 end;
434
435 q -> reference.aligned_for_store_ref, q -> reference.aligned_ref = n = word_ & ^q -> reference.fo_in_qual;
436
437 if n < word_
438 then if q -> reference.data_type > 0
439 then if q -> reference.data_type = char_string | (s -> symbol.decimal & ^s -> symbol.unaligned)
440 then if n ^= character_
441 then call bad;
442 else ;
443 else if s -> symbol.decimal & s -> symbol.unaligned
444 then if n ^= digit_
445 then call bad;
446 else ;
447 else if n ^= bit_
448 then call bad;
449
450 if str
451 then do;
452
453 bit_length = q -> reference.c_length * convert_size (q -> reference.data_type);
454 if q -> reference.c_length = 0 & q -> reference.length = null
455 then q -> reference.aligned_for_store_ref, q -> reference.aligned_ref = "1"b;
456
457 if q -> reference.length ^= null
458 then do;
459 q -> reference.long_ref = "1"b;
460 if q -> reference.shared
461 then go to l3;
462 q -> reference.big_length = is_big ((q -> reference.length));
463 go to l3;
464 end;
465
466 if q -> reference.c_length > max_short_size (q -> reference.data_type)
467 then do;
468 q -> reference.big_length = q -> reference.c_length > max_index_register_value;
469 q -> reference.long_ref = "1"b;
470 if q -> reference.temp_ref
471 then call check_assign;
472 go to l3;
473 end;
474
475 if q -> reference.varying_ref
476 then do;
477 q -> reference.big_length = "1"b;
478 if q -> reference.symbol -> symbol.dcl_size = null
479 then if q -> reference.symbol -> symbol.c_dcl_size <= max_index_register_value
480 then q -> reference.big_length = "0"b;
481 go to l3;
482 end;
483
484 q -> reference.aligned_ref =
485 q -> reference.aligned_ref & (q -> reference.padded_ref | mod (bit_length, bits_per_word) = 0);
486
487 q -> reference.aligned_for_store_ref =
488 q -> reference.aligned_for_store_ref
489 & (q -> reference.padded_for_store_ref | mod (bit_length, bits_per_word) = 0);
490 goto l5b;
491 end;
492
493 bit_length = q -> reference.c_length;
494
495 if bit_length = 0
496 then do;
497 if s -> symbol.array = null
498 then bit_length = s -> symbol.c_bit_size;
499 else bit_length = s -> symbol.array -> array.c_element_size_bits;
500
501 if s -> symbol.decimal
502 then if s -> symbol.unaligned
503 then do;
504 if s -> symbol.float
505 then q -> reference.c_length = s -> symbol.c_dcl_size + 3;
506 else q -> reference.c_length = s -> symbol.c_dcl_size + 1;
507
508 if s -> symbol.complex
509 then q -> reference.c_length = 2 * q -> reference.c_length;
510 end;
511 else q -> reference.c_length = divide (bit_length, bits_per_char, 24, 0);
512 else q -> reference.c_length = bit_length;
513 end;
514
515 if s -> symbol.decimal
516 then do;
517 call prepare_decimal;
518 if s -> symbol.packed
519 then do;
520 q -> reference.aligned_ref =
521 q -> reference.aligned_ref & (q -> reference.padded_ref | mod (bit_length, bits_per_word) = 0);
522 q -> reference.aligned_for_store_ref =
523 q -> reference.aligned_for_store_ref
524 & (q -> reference.padded_for_store_ref | mod (bit_length, bits_per_word) = 0);
525 end;
526 go to l5b;
527 end;
528
529 if s -> symbol.packed
530 then do;
531 if s -> symbol.binary
532 & ^(q -> reference.data_type = real_fix_bin_1 | q -> reference.data_type = real_flt_bin_1)
533 then do;
534 q -> reference.aligned_ref =
535 q -> reference.aligned_ref
536 & (s -> symbol.boundary > word_ & mod (bit_length, bits_per_two_words) = 0);
537 q -> reference.aligned_for_store_ref =
538 q -> reference.aligned_for_store_ref
539 & (s -> symbol.boundary > word_ & mod (bit_length, bits_per_two_words) = 0);
540 end;
541
542 else if ^s -> symbol.ptr
543 then do;
544 if s -> symbol.structure
545 then do;
546 q -> reference.aligned_ref = q -> reference.aligned_ref & q -> reference.padded_ref;
547 q -> reference.aligned_for_store_ref =
548 q -> reference.aligned_for_store_ref & q -> reference.padded_for_store_ref;
549 end;
550 q -> reference.aligned_ref = q -> reference.aligned_ref & (mod (bit_length, bits_per_word) = 0);
551 q -> reference.aligned_for_store_ref =
552 q -> reference.aligned_for_store_ref & (mod (bit_length, bits_per_word) = 0);
553 end;
554 l5b:
555 if ^q -> reference.aligned_ref
556 then atomic = "0"b;
557 end;
558
559 l3:
560 if q -> reference.aggregate & q -> reference.temp_ref
561 then do;
562
563
564
565
566 do p2 = s repeat (p2 -> symbol.father) while (p2 -> symbol.father ^= null);
567 end;
568
569 if p2 -> symbol.initial = null
570 then call stack_temp$assign_aggregate (p2);
571 end;
572
573
574
575 if ^q -> reference.aligned_ref
576 then if q -> reference.fo_in_qual
577 then q -> reference.hard_to_load = "1"b;
578 else do;
579 n = q -> reference.units;
580 if n < word_
581 then if q -> reference.offset ^= null & ^q -> reference.modword_in_offset
582 then q -> reference.hard_to_load = "1"b;
583 else if ^q -> reference.long_ref
584 then do;
585 cfo = mod (q -> reference.c_offset * convert_offset (n), bits_per_word);
586 if cfo < 0
587 then cfo = cfo + bits_per_word;
588 q -> reference.hard_to_load = cfo + bit_length > bits_per_two_words;
589 end;
590 end;
591
592 if eval = 0
593 then goto done;
594
595 if eval > 0
596 then if q -> reference.length ^= null
597 then q -> reference.length = eval_exp ((q -> reference.length), (q -> reference.big_length));
598
599 if q -> reference.offset ^= null
600 then do;
601 if n < word_ & ^q -> reference.modword_in_offset
602 then do;
603 q -> reference.big_offset = q -> reference.big_offset | is_big ((q -> reference.offset));
604 end;
605
606 q -> reference.offset = eval_exp ((q -> reference.offset), (q -> reference.big_offset));
607 end;
608
609 done:
610 q -> reference.no_address = "1"b;
611 q -> reference.perm_address = "0"b;
612
613 if q -> reference.defined_ref
614 then do;
615 if p1 = null
616 then goto exit;
617
618 if p1 -> node.type = operator_node
619 then p1 = p1 -> operand (1);
620
621 if p1 -> reference.temp_ref
622 then do;
623
624 if substr (string (p1 -> reference.value_in), 1, 2) = "00"b
625 then goto def_done;
626
627 if q -> reference.hard_to_load
628 then go to erase_no_update;
629
630
631
632 if q -> reference.data_type ^= bit_string
633 then do;
634 if q -> reference.data_type ^= p1 -> reference.data_type
635 then go to erase_no_update;
636
637 same:
638 string (q -> reference.value_in) =
639 string (q -> reference.value_in) | string (p1 -> reference.value_in);
640 call state_man$erase_reg (substr (string (p1 -> reference.value_in), 1, 2));
641 call state_man$update_reg (q, string (q -> reference.value_in));
642 if q -> reference.value_in.a
643 then if p1 -> reference.data_type = char_string
644 then if a_reg.size < p1 -> reference.c_length * bits_per_char
645 then a_reg.length = a_reg.size + a_reg.offset;
646 goto exit;
647 end;
648
649
650
651 if p1 -> reference.data_type ^= bit_string
652 then do;
653 if p1 -> reference.data_type = real_fix_bin_1
654 then goto same;
655 if p1 -> reference.data_type = packed_ptr
656 then goto same;
657 if p1 -> reference.data_type = char_string
658 then goto same;
659
660 if p1 -> reference.data_type = real_fix_bin_2 | p1 -> reference.data_type = unpacked_ptr
661 then do;
662 q -> reference.value_in.a = "1"b;
663 call state_man$update_reg (q, "1"b);
664 goto exit;
665 end;
666
667 erase_no_update:
668 call state_man$erase_reg (substr (string (p1 -> reference.value_in), 1, 2));
669 end;
670 else do;
671 call state_man$erase_reg (substr (string (p1 -> reference.value_in), 1, 2));
672 call state_man$update_ref (q);
673 if a_reg.size < p1 -> reference.c_length
674 then a_reg.length = a_reg.size + a_reg.offset;
675 end;
676
677 def_done:
678 end;
679 else do;
680 q -> reference.allocate, q -> reference.allocated = "1"b;
681 q -> reference.temp_ref = "0"b;
682 end;
683
684 end;
685
686 exit:
687 return (q);
688
689 pointer_chain:
690 proc (pt);
691
692 dcl (pt, qp, tp, sp, rp)
693 ptr,
694 dummy fixed bin,
695 useless bit (1) aligned,
696 op_code bit (9) aligned;
697
698 qp = pt -> reference.qualifier;
699 if qp -> node.type = reference_node
700 then do;
701 qp = prepare_operand (qp, 1, useless);
702 return;
703 end;
704
705 tp = qp -> operand (1);
706 if tp -> reference.evaluated
707 then return;
708
709 op_code = qp -> operator.op_code;
710 if op_code = std_call
711 then do;
712 pt -> reference.qualifier = call_op (qp);
713 return;
714 end;
715
716 if op_code = addr_fun
717 then do;
718 qp -> operand (2) = prepare_operand ((qp -> operand (2)), 1, useless);
719 return;
720 end;
721
722 sp = tp -> reference.symbol;
723
724 if op_code = assign
725 then do;
726 if qp -> operator.operand (1) -> reference.temp_ref
727 then if qp -> operator.operand (1) -> reference.shared
728 then qp -> operator.operand (1) = copy_temp ((qp -> operator.operand (1)));
729 call base_man$load_packed (qp, dummy);
730 qp -> operand (1) -> reference.evaluated = "1"b;
731 return;
732 end;
733
734 if op_code = param_ptr
735 then return;
736 if op_code = param_desc_ptr
737 then return;
738
739
740
741 if sp -> symbol.temporary
742 then if tp -> reference.shared
743 then qp -> operand (1) = copy_temp (tp);
744
745 call pointer_builtins (qp, "0"b);
746 qp -> operand (1) -> reference.evaluated = "1"b;
747
748 end;
749
750
751 defined_chain:
752 proc (pt);
753
754 dcl (pt, qp, rp) ptr;
755 dcl atomic bit (1) aligned;
756
757 qp = pt -> reference.qualifier;
758
759 if qp -> node.type = reference_node
760 then qp = prepare_operand (qp, 1, atomic);
761 else if ^qp -> operand (1) -> reference.evaluated
762 then do;
763 rp = prepare_operand (qp, 1, atomic);
764 if ^atomic
765 then rp = compile_exp$save_exp (qp);
766 end;
767
768 end;
769
770
771 is_big:
772 proc (pt) reducible returns (bit (1) aligned);
773
774
775
776
777 dcl (p, pt) ptr;
778 dcl result bit (1) aligned;
779
780 p = pt;
781
782 if p -> node.type = operator_node
783 then if p -> operator.op_code = length_fun
784 then do;
785 p = p -> operand (2);
786 if p -> node.type = operator_node
787 then p = p -> operand (1);
788 p = p -> reference.symbol;
789 result = "1"b;
790 if p -> symbol.dcl_size = null
791 then if p -> symbol.c_dcl_size <= max_index_register_value
792 then result = "0"b;
793 return (result);
794 end;
795 else p = p -> operand (1);
796
797 return (p -> reference.symbol -> symbol.c_dcl_size > max_p_xreg);
798
799 end;
800
801
802 check_assign:
803 proc;
804
805
806
807
808 dcl p2 ptr;
809
810 if q -> reference.shared
811 then if p -> node.type = operator_node
812 then if substr (p -> operator.op_code, 1, 5) = "00011"b
813
814 then do;
815 p2 = p -> operand (2);
816 if p2 -> node.type = operator_node
817 then p2 = p2 -> operand (1);
818 if (string (p2 -> reference.symbol -> symbol.data_type) & "0111111111111111111"b)
819 ^= (string (s -> symbol.data_type) & "0111111111111111111"b)
820 then q, p -> operand (1) = copy_temp (q);
821 end;
822
823 end;
824
825
826 prepare_decimal:
827 proc;
828
829
830
831
832
833
834
835 dcl r ptr;
836 dcl (
837 i,
838 scale (3)
839 ) fixed bin;
840
841 if s -> symbol.temporary
842 then if s -> symbol.fixed
843 then if s -> symbol.scale < min_dec_scale | s -> symbol.scale > max_dec_scale
844 then if p -> node.type = operator_node
845 then if p -> operator.number >= 3
846 then if p -> operator.op_code ^= complex_fun
847 then if p -> operator.op_code ^= round_fun
848 then do;
849 if decimal_op$change_target (p)
850 then do;
851 r = decimal_op$get_float_temp (s -> symbol.c_dcl_size,
852 (s -> symbol.complex));
853
854 if cg_stat$cur_node ^= null
855 then if cg_stat$cur_node -> operator.op_code = std_call
856 then go to keep_fixed;
857 else if substr (cg_stat$cur_node -> operator.op_code, 1, 5) = io_class
858 then go to keep_fixed;
859
860 if s -> symbol.c_dcl_size < max_p_fix_dec
861 then do;
862 if ^q -> reference.shared
863 then r -> reference.ref_count = q -> reference.ref_count;
864 q, p -> operand (1) = r;
865 s = r -> reference.symbol;
866 end;
867 else do;
868 keep_fixed:
869 p -> operand (1) = r;
870 r = compile_exp$save (p);
871 if q -> reference.shared
872 then q = copy_temp (q);
873 call assign_op$to_dec_scaled (q, r);
874 p -> operand (1) = q;
875 atomic = "1"b;
876 end;
877 end;
878 end;
879
880 end;
881
882
883
884
885 bad:
886 proc;
887
888 dcl error entry (fixed bin, ptr, ptr);
889
890 if q -> reference.offset = null
891 then if q -> reference.temp_ref
892 then if q -> reference.data_type = real_fix_bin_1
893 then return;
894
895 call error (332, cg_stat$cur_statement, q);
896
897 end;
898
899 end;