1
2
3
4
5
6
7
8
9
10
11
12
13 constant_length:
14 procedure (P_tree, P_constant_value) returns (bit (1) aligned);
15
16
17
18 dcl (
19 P_tree ptr,
20 P_constant_value fixed bin (71)
21 ) parameter;
22
23
24
25 dcl tree ptr;
26
27
28
29 dcl null builtin;
30
31
32
33 tree = P_tree;
34
35 if tree -> reference.length = null
36 then do;
37 if tree -> reference.c_length ^= P_constant_value
38 then return ("0"b);
39
40 return ("1"b);
41 end;
42
43 if tree -> reference.length -> node.type = operator_node
44 then if tree -> reference.length -> operator.op_code = range_ck
45 then if tree -> reference.length -> operand (2) -> node.type = reference_node
46 then if tree -> reference.length -> operand (2) -> reference.symbol -> symbol.constant
47 then if constant_value ((tree -> reference.length -> operand (2) -> reference.symbol))
48 ^= P_constant_value
49 then return ("0"b);
50 else return ("1"b);
51
52 return ("0"b);
53
54
55
56 constant_value:
57 procedure (sym_ptr) returns (fixed bin (71));
58
59
60
61 dcl sym_ptr ptr;
62
63
64
65 dcl integer_1 based fixed bin (35);
66 dcl integer_2 based fixed bin (71);
67
68
69
70 dcl initial_value fixed bin (71);
71
72 if sym_ptr -> symbol.c_dcl_size > max_p_fix_bin_1
73 then initial_value = sym_ptr -> symbol.initial -> integer_2;
74 else initial_value = sym_ptr -> symbol.initial -> integer_1;
75
76 return (initial_value);
77
78 end ;
79 ^L
80
81
82 %include nodes;
83 %include op_codes;
84 %include operator;
85 %include reference;
86 %include symbol;
87 %include system;
88 end ;