1 /* BEGIN INCLUDE FILE ... compare_alias.incl.pl1 */
 2 
 3 /* This subroutine is an include file and is included in the optimizer and in the
 4    code generator.  It determines whether or not two potentially aliased variables are capable of
 5    occupying the same generation of storage.  Its input is a pair of pointers each pointing
 6    to a symbol node.  */
 7 
 8 compare_alias: proc(pa,pb) reducible returns(aligned bit);
 9 
10 dcl       (a,b,pa,pb) ptr;
11 %include picture_image;
12 
13           a = pa;
14           b = pb;
15           if equal_types(a,b)|(bit_overlay(a)&bit_overlay(b))|(char_overlay(a)&char_overlay(b))
16                then return("1"b);                 /* coded this way for efficiency */
17                else return("0"b);
18 
19 equal_types: proc(a,b) reducible returns(aligned bit);
20 
21 dcl       (a,b) ptr;
22 
23 
24           if string(a->symbol.data_type)=string(b->symbol.data_type)
25              then if a->symbol.aligned=b->symbol.aligned
26              then if a -> symbol.unsigned = b -> symbol.unsigned
27              then if a->symbol.varying=b->symbol.varying
28              then if a->symbol.binary=b->symbol.binary
29              then if a->symbol.real=b->symbol.real
30              then if(a->symbol.c_dcl_size=b->symbol.c_dcl_size|^(a->symbol.fixed|a->symbol.float))
31              then if a->symbol.scale=b->symbol.scale
32              then if a->symbol.picture
33                     then return(a->symbol.general->reference.symbol->symbol.initial->picture_image.chars =
34                                         b->symbol.general->reference.symbol->symbol.initial->picture_image.chars);
35                     else return("1"b);
36           return("0"b);
37           end; /* equal_types */
38 
39 bit_overlay: proc(a) reducible returns(aligned bit);
40 
41 dcl       (a,p) ptr;
42 
43           p = a;
44           do while(p->symbol.structure);
45           p = p->symbol.son;
46           end;
47           return(a->symbol.packed&p->symbol.bit);
48           end; /* bit_overlay */
49 
50 char_overlay: proc(a) reducible returns(aligned bit);
51 
52 dcl       (a,p) ptr;
53 
54           p = a;
55           do while(p->symbol.structure);
56           p = p->symbol.son;
57           end;
58           return(a->symbol.packed&(p->symbol.char|p->symbol.picture));
59           end; /* char_overlay */
60 
61           end; /* compare_alias */
62 
63 /* END INCLUDE FILE ... compare_alias.incl.pl1 */