1 
  2 /*  Input structure for cobol_register$load                    */
  3 
  4 declare 1 register_request aligned static,
  5           2 requested_reg fixed bin aligned init(12),
  6           2 assigned_reg bit(4) aligned,
  7           2 lock fixed bin aligned init(1),
  8           2 reg_set_now fixed bin aligned,
  9           2 use_code fixed bin aligned init(0),
 10           2 adjust_ptr_addr fixed bin aligned init(0),
 11           2 content_ptr ptr aligned init(null),
 12           2 literal_content bit(36) aligned init((36)"0"b);
 13 
 14 /*
 15 requested_reg   is a code designating the register requested;
 16                     0  - a- or q- or any index-register
 17                     1  - a-register
 18                     2  - q-register
 19                     3  - a- and q-register
 20                     4  - a- or q-register
 21                     5  - any index-register
 22                     1n - index-register n
 23 
 24 assigned_reg    is a code designating the register assigned.  It
 25                 has no significance if a specific register is
 26                 requested.
 27 
 28 lock            indicates locking requirements; 1 requests that
 29                 the register be locked.
 30 
 31 reg_set_now     not applicable for use_code = 0.
 32 
 33 use_code        specifies how the register is to be used by the
 34                 requester; 0 signifies that such information is
 35                 not meaningful for register optimization.
 36 
 37 adjust_ptr_addr inserted to make evident that since all pointers
 38                 must be allocated on even word boundaries, the
 39                 pl1 compiler will allocate structures containing
 40                 pointers and all pointers therein on even word
 41                 boundaries leaving "gaps" where necessary.
 42 
 43 content_ptr     not applicable for use_code = 0.
 44 
 45 literal_content not applicable for use_code = 0.
 46                                                                */
 47 
 48 /*  Input structures for cobol_addr                            */
 49 
 50 declare 1 target aligned static,
 51           2 type fixed bin aligned init(1),
 52           2 operand_no fixed bin aligned init(0),
 53           2 lock fixed bin aligned init(0),
 54           2 segno fixed bin aligned,
 55           2 char_offset fixed bin(24) aligned,
 56           2 send_receive fixed bin aligned init(0);
 57 
 58 declare 1 count aligned static,
 59           2 type fixed bin aligned init(1),
 60           2 operand_no fixed bin aligned init(0),
 61           2 lock fixed bin aligned init(1),
 62           2 segno fixed bin aligned init(2),
 63           2 char_offset fixed bin(24) aligned,
 64           2 send_receive fixed bin aligned init(0);
 65 
 66 /*
 67 type         indicates type of addressing requested.  Type 1
 68              indicates basic; i.e., data to be addressed is
 69              specified by segno and char_offset.
 70 
 71 operand_no   not applicable to type 1.
 72 
 73 lock         indicates lock requirements for registers used in
 74              addressing;
 75                0 - do not lock registers used.
 76                1 - lock registers used.
 77 
 78 segno        is the compiler designation of the segment in which
 79              the data to be addressed is located.
 80 
 81 char_offset  is the character offset within segno of the data to
 82              be addressed.
 83 
 84 send_receive indicates whether the data being addressed is a
 85              sending or receiving field for the instruction whose
 86              address field is being set; 0 indicates sending.
 87                                                                */
 88 
 89 declare 1 input_struc aligned static,
 90           2 type fixed bin aligned init(4),
 91           2 operand_no fixed bin aligned init(1),
 92           2 lock fixed bin aligned init(0),
 93           2 operand,
 94             3 token_ptr ptr aligned init(null),
 95             3 send_receive fixed bin aligned init(0),
 96             3 ic_mod fixed  bin aligned,
 97             3 size_sw fixed  bin aligned init(0);
 98 
 99 /*
100 type         indicates type of addressing requested.
101                     1  -  no operand, 1 wd, basic
102                     2  -  1 operand, 1 wd, non-EIS
103                     3  -  1 operand, 1 wd, EIS
104                     4  -  1 operand, 1 desc, 2wd, EIS
105                     5  -  2 operands, 2 desc, 3 wd, EIS
106                     6  -  3 operands, 3 desc, 4 wd, EIS
107 
108 operand_no   number of operands associated with requested type.
109 
110 lock         indicates lock requirements for registers used in
111              addressing.
112                     0  -  do not lock registers used
113                     1  -  lock registers used
114                     2  -  unlock all registers
115 
116 token_ptr    is a pointer to the operand token.
117 
118 send_receive indicates whether the operand being addressed is a
119              sending or receiving field for the instruction.
120                     0  -  sending operand
121                     1  -  receiving operand
122 
123 ic_mod       indicates whether ic modification is specified in
124              the mf field of this operand (set by cobol_addr).
125                     0  -  no ic modification
126                     1  -  ic modification
127 
128 size_sw      indicates size (length) handlhlng requirements to
129              cobol_addr.
130                     0  -  cobol_addr may store the operand size in a
131                           register or in the instruction
132                     1  -  cobol_addr need not be concerned with size
133                                                                */
134 
135 /*  Input structure for cobol_pointer_register$get                       */
136 
137 declare 1 ptr_register_request aligned static,
138           2 what_pointer fixed bin aligned init(2),
139           2 assigned_ptr fixed bin aligned,
140           2 lock fixed bin aligned init(1),
141           2 switch fixed bin aligned init(0),
142           2 segno fixed bin aligned init(0),
143           2 offset fixed bin aligned init(0),
144           2 reset fixed bin aligned;
145 
146 /*
147 where:
148 
149 what_pointer is the number of the desired pointer register.
150              (Input)
151 
152 assigned_ptr is the number of the register assigned.  (Output)
153 
154 lock         specifies locking requirements.  (0 - do not lock
155              requested register).  (Input)
156 
157 switch       specifies the significance of segno and offset.
158              (0 - segno and word offset are not supplied).
159              (Input)
160 
161 segno        is the segment number that the pointer register is
162              to contain.  (Input)
163 
164 offset       is the word or character offset that the pointer
165              reginter is to contain.  (Input)
166 
167                                                                */
168 
169 /*  Static Data                                                */
170 
171 declare 1 equate_tag aligned static,
172           2 size fixed bin aligned init(0),
173           2 line fixed bin aligned init(0),
174           2 column fixed bin aligned init(0),
175           2 type fixed bin aligned init(31),
176           2 filler1 fixed bin aligned init(0),
177           2 equated_tag fixed bin aligned init(0),
178           2 true_tag fixed bin aligned init(0),
179           2 filler2 fixed bin aligned init(0),
180           2 filler3 fixed bin aligned init(0),
181           2 filler4 bit(16) aligned init((16)"0"b);
182 
183 declare 1 eos_token aligned static,
184           2 size fixed bin init(0),
185           2 line fixed bin init(0),
186           2 column fixed bin init(0),
187           2 type fixed bin init(19),
188           2 verb fixed bin init(0),
189           2 e fixed bin init(0),
190           2 h fixed bin init(0),
191           2 i fixed bin init(0),
192           2 j fixed bin init(0),
193           2 a bit(3) init("000"b),
194           2 b bit(1) init("0"b),
195           2 c bit(1) init("0"b),
196           2 d bit(2) init("00"b),
197           2 f bit(2) init("00"b),
198           2 g bit(2) init("00"b),
199           2 k bit(5) init("00000"b);
200 
201 declare 1 seg_ovfl_error aligned static,
202           2 my_name char(32) init("cobol_perform_gen"),
203           2 message_len fixed bin init(32),
204           2 message char(32) init
205             ("Temp_token_area length exceeded!");
206 
207 /*  Declarations for instruction sequences                     */
208 dcl seq1(8) bit(18) unaligned static init
209     ("000000000001000000"b, "011000101101000000"b,   /*  dtb   (ar),(ar)        */
210      "000000000000000000"b, "000000000000000000"b,   /*  ndsc9 id_10,l          */
211      "000000000000000000"b, "000000000000000100"b,   /*  ndsc9 id10_fb,4        */
212      "000000000000000000"b, "110000100100000100"b);  /*  tmoz  loc_b_relp,ic    */
213 
214 dcl seq2(8) bit(18) unaligned static init
215     ("000000000000000000"b, "100101000001000000"b,   /*  stz   count            */
216      "000000000000000011"b, "110010010000000100"b,   /*  eax2  3,ic             */
217      "000000000000000000"b, "100100010001000000"b,   /*  sxl2  target_a_PN2     */
218      "000000000000000000"b, "111001000000000100"b);  /*  tra   PN1_relp1,ic     */
219 
220 dcl seq2i(10) bit(18) unaligned static init
221     ("000000000000000000"b, "100101000001000000"b,   /*  stz   count            */
222      "000000000000000100"b, "110010010000000100"b,   /*  eax2  4,ic             */
223      "000000000000000000"b, "100100010001000000"b,   /*  sxl2  target_a_PN2     */
224      "000000000000000000"b, "110011101000000100"b,   /*  eaa   PN1_relp1,ic     */
225      "000000000000000000"b, "111001000000000100"b);  /*  tra   i_segm_relp,ic   */
226 
227 dcl seq3(14) bit(18) unaligned static init
228     ("000000000000000000"b, "010011110001000000"b,   /*  ldq   count            */
229      "000000000000000001"b, "000111110000000111"b,   /*  adq   1,dl             */
230      "000000000000000000"b, "111101110001000000"b,   /*  stq   count            */
231      "000000000000000000"b, "000000000000000000"b,   /*  cmpq  id_10_fb or      */
232                                                      /*        int_1,dl         */
233      "000000000000000000"b, "110000001000000100"b,   /*  tnz   PN1_relp2,ic     */
234      "000000000000000000"b, "110010010000000100"b,   /*  eax2  t_relp,ic        */
235      "000000000000000000"b, "100100010001000000"b);  /*  sxl2  target_a_PN2     */
236 
237 dcl cmpq_id_10 bit(18) static init ("001001110001000000"b);
238 
239 dcl cmpq_int_1 bit(18) static init ("001001110000000111"b);
240 
241 dcl seq4(8) bit(18) unaligned static init
242     ("000000000000000000"b, "100101000001000000"b,   /*  stz    count           */
243      "000000000000000000"b, "110010010000000100"b,   /*  eax2   loc_a_relp,ic   */
244      "000000000000000000"b, "100100010001000000"b,   /*  sxl2   target_a_PN2    */
245      "000000000000000000"b, "111001000000000100"b);  /*  tra    con_1_relp,ic   */
246 
247 dcl seq5(16) bit(18) unaligned static init
248     ("000000000000000000"b, "110010010000000100"b,   /*  eax2   t_relp,ic       */
249      "000000000000000000"b, "100100010001000000"b,   /*  sxl2   target_a_PN2    */
250      "000000000000000110"b, "111001000000000100"b,   /*  tra    6,ic            */
251      "000000000000000000"b, "010011110001000000"b,   /*  ldq    count           */
252      "000000000000000000"b, "110000001000000100"b,   /*  tnz    PN1_relp1,ic    */
253      "000000000000000000"b, "000101100001000000"b,   /*  aos    count           */
254      "000000000000000000"b, "110011101000000100"b,   /*  eaa    PN1_relp2,ic    */
255      "000000000000000000"b, "111001000000000100"b);  /*  tra    i_segm_relp,ic  */
256 
257 dcl tra_inst(6) bit(18) unaligned static init
258     ("000000000000000000"b, "011101010100000100"b,   /*  epbp2  0,ic            */
259      "110000000000000000"b, "010101010001000000"b,   /*  spri2  pr6|M           */
260      "000000000000000000"b, "111001000000000100"b);  /*  tra    loc_s_relp,ic   */
261 
262 dcl ret_inst(2) bit(18) unaligned static init
263     ("110000000000000000"b, "110001000001000000"b);  /*  rtcd   pr6|M           */
264 
265 dcl seq6(4) bit(18) unaligned static init
266     ("110000000000000000"b, "111101000001000000"b,   /*  stc2   pr6|M+1         */
267      "000000000000000000"b, "111001000000000100"b);  /*  tra    loc_e_relp,ic   */
268 
269 dcl seq8(6) bit(18) unaligned static init
270     ("000000000000000011"b, "110010111000000100"b,   /*  eax7   3,ic            */
271      "000000000000000000"b, "100100111001000000"b,   /*  sxl7   target_a_PN2    */
272      "000000000000000000"b, "111001000000000100"b);  /*  tra    PN1_relp1,ic    */
273 
274 dcl move_in_token (1:10) ptr int static;
275 dcl move_data_init fixed bin int static init (0);
276 
277 dcl       1 move_eos int static,
278                     2 size fixed bin (15),
279                     2 line fixed bin (15),
280                     2 column fixed bin (15),
281                     2  type fixed bin (15) init (19),
282                     2 verb fixed bin (15) init (18),
283                     2 e fixed bin (15) init (1);
284 
285 dcl szn_seq (2) bit (18) int static init
286           ( "000000000000000000"b,  "010011100001000000"b);  /*  szn 0  */
287 
288 
289 /*
290 P^H__^Hr_^Ho_^Hc_^He_^Hd_^Hu_^Hr_^He_^Hs_C^H__^Ha_^Hl_^Hl_^He_^Hd:^H_
291                                                                */
292 
293 dcl cobol_add_gen entry (ptr, fixed bin),
294     cobol_addr entry (ptr, ptr, ptr),
295     cobol_alloc$cobol_data entry (fixed bin(24), fixed bin, fixed bin(24)),
296     cobol_alloc$stack entry (fixed bin, fixed bin, fixed bin),
297     cobol_arithop_gen entry (ptr),
298     cobol_compare_gen entry (ptr),
299     cobol_define_tag entry (fixed bin),
300     cobol_define_tag_nc entry (fixed bin, fixed bin),
301     cobol_emit entry (ptr, ptr, fixed bin),
302     cobol_equate_tag entry (ptr),
303     cobol_make_tagref entry (fixed bin, fixed bin, ptr),
304     cobol_move_gen entry (ptr),
305     cobol_pointer_register$get entry (ptr),
306     cobol_pointer_register$priority entry (fixed bin, fixed bin, bit(3)),
307     cobol_process_error entry (fixed bin, fixed bin, fixed bin),
308     cobol_register$load entry (ptr),
309     cobol_reset_r$in_line entry,
310     cobol_set_gen entry (ptr),
311     signal_ entry (char(*), ptr, ptr);
312 dcl cobol_make_type9$long_bin ext entry (ptr,fixed bin,fixed bin);
313 dcl cobol_num_to_udts ext entry (ptr,ptr);
314 
315 
316 /*
317 B^H__^Hu_^Hi_^Hl_^Ht-^H__^Hi_^Hn_F^H__^Hu_^Hn_^Hc_^Ht_^Hi_^Ho_^Hn_^Hs_U^H__^Hs_^He_^Hd:^H_
318                                                                */
319 
320 dcl abs builtin,
321     addr builtin,
322     addrel builtin,
323     binary builtin,
324     null builtin,
325     rel builtin,
326     substr builtin,
327     unspec builtin;
328 
329 %include cobol_seg_init_list;
330 %include cobol_type10;
331 %include cobol_type19;
332 
333 %include cobol_type1;
334 
335 %include cobol_type9;
336 
337 %include cobol_in_token;
338 
339 %include cobol_perform_list;
340 
341 %include cobol_type2;
342 
343 %include cobol_type18;
344 
345 %include cobol_type30;
346 
347 %include cobol_;
348