1 /* BEGIN fort_utilities.incl.pl1 */
 2 
 3 /* Created:         October 1977, Richard Barnes
 4 
 5    Modified:
 6           22 May 1978, DSL - add create_constant.
 7           09 Oct 1978, PES - make create_(constant node) return fixed bin(18) unsigned.
 8           13 Dec 1978, PES - Get create_node from include file, rather than copy.
 9 */
10 
11 %include fort_create_node;
12 
13 create_constant:    proc(data_type,value) returns(fixed bin (18));
14 
15 dcl       (data_type,a_data_type)       fixed bin(4);       /* data type of constant */
16 dcl       (value,a_value)               bit(72) aligned;    /* value of constant */
17 
18 dcl       addr                          builtin;
19 dcl       binary                        builtin;
20 dcl       bool                          builtin;
21 dcl       char                          builtin;
22 dcl       data_size                     fixed bin(17);
23 dcl       decimal                       builtin;
24 dcl       hash_index                    fixed bin;
25 dcl       hash_table(0:hash_table_size-1) fixed bin(35) aligned based(operand_base);
26 dcl       hash_table_size               fixed bin int static options(constant) init(211);
27 dcl       hbound                        builtin;
28 dcl       ltrim                         builtin;
29 dcl       mod                           builtin;
30 dcl       mod_2_sum                     bit(36) aligned;
31 dcl       node_offset                   fixed bin;
32 dcl       node_ptr                      pointer;
33 dcl       size                          builtin;
34 dcl       v_array(2)                    bit(36) aligned based(addr(a_value));
35 dcl       x(0:operand_max_len-1)        fixed bin(35) aligned based(operand_base);
36 
37 %include relocation_bits;
38 
39 
40           a_data_type = data_type;
41           a_value = value;
42 
43           if a_data_type = char_mode | a_data_type <= 0 | a_data_type > hbound(data_type_size,1)
44           then do;
45                call print_message(452, ltrim(char(decimal(a_data_type,12)))); /* cannot create the node */
46                end;
47           else data_size = data_type_size(a_data_type);
48 
49           if data_size = 1
50           then do;
51                mod_2_sum = v_array(1);
52                v_array(2) = "0"b;
53                end;
54           else mod_2_sum = bool(v_array(1),v_array(2),"0110"b);
55 
56 
57           hash_index = mod(binary(mod_2_sum,35),hash_table_size);
58 
59           /* Search the hash table for the constant. */
60 
61           node_offset = hash_table(hash_index);
62           do while(node_offset > 0);                        /* search the entire bucket */
63                node_ptr = addr(x(node_offset));
64 
65                if node_ptr -> constant.value = a_value      /* must be same value */
66                then if node_ptr -> node.data_type = a_data_type /* and same data type */
67                     then return(node_offset);
68 
69                node_offset = node_ptr -> node.hash_chain;   /* NB - pointer remains pointing at last item in bucket */
70                end;
71 
72           /* a new constant node must be created */
73 
74           node_offset = create_node(constant_node, size(constant));
75 
76           if hash_table(hash_index) = 0                     /* Is this the first item in the bucket? */
77           then hash_table(hash_index) = node_offset;        /* yes */
78           else node_ptr -> node.hash_chain = node_offset;   /* no, add it to the end */
79 
80           node_ptr = addr(x(node_offset));
81           node_ptr -> constant.data_type = a_data_type;
82           node_ptr -> constant.operand_type = constant_type;
83           node_ptr -> constant.is_addressable = "1"b;
84           node_ptr -> constant.reloc = rc_t;
85           node_ptr -> constant.value = a_value;
86 
87           constant_info(data_size).constant_count = constant_info(data_size).constant_count + 1;
88 
89           if constant_info(data_size).first_constant = 0    /* Is this the first item of this size? */
90           then constant_info(data_size).first_constant = node_offset; /* yes */
91           else addr(x(constant_info(data_size).last_constant)) -> constant.next_constant = node_offset; /* no, add it */
92 
93           constant_info(data_size).last_constant = node_offset;
94 
95           return(node_offset);
96 
97           end create_constant;
98 
99 /* END fort_utilities.incl.pl1 */