1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16 length_op: proc(pt) returns(ptr);
17
18 dcl pt ptr;
19
20 dcl (p,p1,p2,q,s,s2) ptr;
21 dcl (doing_length,useless) bit(1) aligned;
22
23 dcl cg_stat$cur_block ptr ext static;
24
25 dcl adjust_ref_count entry(ptr,fixed bin);
26 dcl call_op entry(ptr) returns(ptr);
27 dcl compile_exp$save entry(ptr) returns(ptr);
28 dcl create_symbol entry(ptr,ptr,bit(3) aligned) returns(ptr);
29 dcl generate_constant$real_fix_bin_1 entry(fixed bin) returns(ptr);
30 dcl prepare_operand entry(ptr,fixed bin,bit(1) aligned) returns(ptr);
31 dcl share_expression entry(ptr) returns(ptr);
32
33 dcl null builtin;
34
35 dcl fix_bin(0:1) fixed bin based;
36
37 %include cgsystem;
38 %include symbol;
39 %include reference;
40 %include operator;
41 %include boundary;
42 %include data_types;
43 %include nodes;
44 %include temporary;
45 %include op_codes;
46
47 doing_length = "1"b;
48
49 begin:
50 p = pt;
51 q = p -> operand(1);
52
53
54
55 p2 = p -> operand(2);
56
57 if p2 -> node.type = operator_node
58 then if p2 -> operand(1) -> reference.evaluated
59 then p2 = p2 -> operand(1);
60 else if p2 -> operator.op_code = std_call
61 then p2 = call_op(p2);
62 else p2 = compile_exp$save(p2);
63
64 s2 = p2 -> reference.symbol;
65 if s2 -> symbol.constant & p2 -> reference.offset = null
66 then return(generate_constant$real_fix_bin_1(s2 -> symbol.initial -> fix_bin
67 (p2 -> reference.c_offset)));
68
69 p2 = prepare_operand(p2,1,useless);
70
71
72
73
74 s = create_symbol(null,null,(s2 -> symbol.dcl_type));
75 p1 = s -> symbol.reference;
76 s -> symbol.attributes = s2 -> symbol.attributes;
77 s -> symbol.location = s2 -> symbol.location;
78 s -> symbol.block_node = s2 -> symbol.block_node;
79 s -> symbol.father = s2 -> symbol.father;
80 s -> symbol.initial = s2 -> symbol.initial;
81 s -> symbol.allocated = s2 -> symbol.allocated;
82 s -> symbol.token = s2 -> symbol.token;
83 string (s -> symbol.data_type) = string (q -> reference.symbol -> symbol.data_type);
84 s -> symbol.binary = "1"b;
85 s -> symbol.c_bit_size = bits_per_word;
86 s -> symbol.c_word_size = 1;
87 s -> symbol.c_dcl_size = q -> reference.symbol -> symbol.c_dcl_size;
88
89
90
91 p1 -> reference = p2 -> reference;
92 p1 -> reference.shared = "0"b;
93 if q -> reference.shared
94 then p1 -> reference.ref_count = 1;
95 else p1 -> reference.ref_count = q -> reference.ref_count;
96
97 q = p1;
98 q -> reference.symbol = s;
99 p -> operand(1) = q;
100
101 string(q -> reference.info) = "0"b;
102 q -> reference.value_in.storage = p2 -> reference.value_in.storage;
103
104 if doing_length
105 then q -> reference.c_offset = q -> reference.c_offset - 1;
106 q -> reference.units = word_;
107 q -> reference.data_type = real_fix_bin_1;
108 q -> reference.varying_ref = "0"b;
109 q -> reference.c_length = bits_per_word;
110 string(q -> reference.bits) = "0100000111000"b;
111
112 q -> reference.defined_ref = s -> symbol.defined;
113 q -> reference.aliasable = s -> symbol.aliasable | (s -> symbol.auto
114 & (cg_stat$cur_block ^= s -> symbol.block_node)
115 & s -> symbol.passed_as_arg);
116 q -> reference.temp_ref = s -> symbol.temporary;
117 q -> reference.aggregate = p2 -> reference.aggregate;
118 q -> reference.perm_address = "0"b;
119 q -> reference.no_address = "1"b;
120
121 if q -> reference.qualifier ^= null
122 then if q -> reference.qualifier -> node.type = temporary_node
123 then q -> reference.qualifier -> temporary.ref_count = q -> reference.qualifier -> temporary.ref_count + 1;
124 else q -> reference.qualifier = share_expression((q -> reference.qualifier));
125
126 if q -> reference.offset ^= null
127 then q -> reference.offset = share_expression((q -> reference.offset));
128
129 if ^ p2 -> reference.shared
130 then call adjust_ref_count(p2,-1);
131
132 return(q);
133
134
135 assign_desc_op: entry(pt) returns(ptr);
136
137
138
139 doing_length = "0"b;
140 go to begin;
141 end;