1 2 /* 3 The procedure cobol_perform_gen generates the code necessary to im- 4 plement the COBOL PERFORM statement. The general format of the 5 PERFORM statement is as follows: 6 7 Format 1 - 8 9 P^H_E^H_R^H_F^H_O^H_R^H_M^H_ procedure-name-1 [{T^H_H^H_R^H_U^H_|T^H_H^H_R^H_O^H_U^H_G^H_H^H_} procedure-name-2] 10 11 Format 2 - 12 13 P^H_E^H_R^H_F^H_O^H_R^H_M^H_ procedure-name-1 [{T^H_H^H_R^H_U^H_|T^H_H^H_R^H_O^H_U^H_G^H_H^H_} procedure-name-2] 14 15 {identifier-10|integer-1} T^H_I^H_M^H_E^H_S^H_ 16 17 Format 3 - 18 19 P^H_E^H_R^H_F^H_O^H_R^H_M^H_ procedure-name-1 [{T^H_H^H_R^H_U^H_|T^H_H^H_R^H_O^H_U^H_G^H_H^H_} procedure-name-2] 20 21 U^H_N^H_T^H_I^H_L^H_ condition-1 22 23 Format 4 - 24 25 P^H_E^H_R^H_F^H_O^H_R^H_M^H_ procedure-name-1 [{T^H_H^H_R^H_U^H_|T^H_H^H_R^H_O^H_U^H_G^H_H^H_} procedure-name-2] 26 27 V^H_A^H_R^H_Y^H_I^H_N^H_G^H_ {identifier-1|index-name-1} 28 29 F^H_R^H_O^H_M^H_ {identifier-2|index-name-2|literal-1} 30 31 B^H_Y^H_ {identifier-3|literal-2} U^H_N^H_T^H_I^H_L^H_ condition-1 32 33 [A^H_F^H_T^H_E^H_^H_R^H_ {identifier-4|index-name-3} 34 35 F^H_R^H_O^H_M^H_ {identifier-5|index-name-4|literal-3} 36 37 B^H_Y^H_ {identifier-6|literal-4} U^H_N^H_T^H_I^H_L^H_ condition-2 38 39 [A^H_F^H_T^H_E^H_R^H_ {identifier-7|index-name-5} 40 41 F^H_R^H_O^H_M^H_ {identifier-8|index-name-6|literal-5} 42 43 B^H_Y^H_ {identifier-9|literal-6} U^H_N^H_T^H_I^H_L^H_ condition-3]] 44 45 46 In all formats, the beginning of the PERFORM range is defined as 47 the first statement of the procedure named procedure-name-1 or, 48 in terms of executable code, the first instruction generated to 49 implement the first statement of procedure-name-1. Similarly, in 50 all formats, the end of the PERFORM range is defined as the last 51 statement of the procedure named procedure-name-2, if the THROUGH 52 phrase is present, or the last statement of the procedure named 53 procedure-name-1, if it is not. In terms of executable code, 54 this corresponds to the last instruction generated to implement 55 the last statement of the appropriate procedure. If procedure- 56 name-1 (or -2) is a paragraph-name, then the last statement in 57 the PERFORM range is the last statement of the paragraph. If 58 procedure-name-1 (or -2) is a section-name, then the last state- 59 ment in the PERFORM range is the last statement of the last para- 60 graph of the section. 61 If, as a consequence of executing a PERFORM statement, a transfer 62 of control is indicated, the transfer is made to the first in- 63 struction in the PERFORM range. This transfer of control occurs 64 only once for each execution of a PERFORM statement. A subse- 65 quent transfer of control following the execution of the last in- 66 struction in the PERFORM range to the next executable statement 67 following the PERFORM statement is implied and must be explicitly 68 implemented. If, however, control passes to a procedure which 69 has been named as containing the last statement in a PERFORM 70 range by means other than a PERFORM statement, then control must 71 pass through the last statement of the procedure to the next ex- 72 ecutable statement as if no PERFORM statement mentioned the pro- 73 cedure. In this connection, it should be noted that there is no 74 next executable statement following: 75 76 1. The last statement in a Declarative Section when the para- 77 graph in which it appears is not being executed under the 78 control of some other COBOL statement. 79 80 2. The last statement in a program when the paragraph in which 81 it appears is not being executed under the control of some 82 other COBOL statement. 83 84 3. The last statement in a size procedure when the procedure 85 is not being executed under the control of some other COBOL 86 statement. (Size procedures and control statements which 87 execute then are compiler sefined.) 88 89 This modifiable program flow is implemented by inserting an al- 90 terable GO after the last instruction of each PERFORM range de- 91 fined in the program. These end-of-perform range alterable GO's 92 are initialized, upon first entry into the program as part of the 93 current run-unit, to pass control to the next executable state- 94 ment except for those cases defined above for which there is no 95 next executable statement. For these exceptional cases, the al- 96 terable GO's are initialized to transfer control to a sequence of 97 instructions which calls a procedure (signal_) to signal an ap- 98 propriate error to the user. The setting of the end-of-perform 99 range alterable GO's is otherwise controlled by code generated to 100 implement the PERFORM statements. In programs conforming to the 101 rules of COBOL, the end-of-perform range alterable GO's are al- 102 ways reset at the completion of the PERFORM statement to pass 103 control to the next executable statement or to an error signal- 104 ling routine, as appropriate, regardless of any modifications 105 that may have been made to implement the PERFORM statement. If 106 the rules regarding PERFORM statements are not followed, the al- 107 terable GO's at the end of involved PERFORM ranges may not be 108 properly reset and unspecified alteration of control flow will 109 occur. 110 The instructions necessary for implementing end-of-perform range 111 alterable GO's are generated in-line immediately after the gener- 112 ation of the last instruction of each procedure which is at the 113 end of a PERFORM range (see cobol_paragraph_gen, cobol_section_gen, and 114 cobol_end_gen). The instructions necessary for initializing the 115 end-of-perform range alterable GO's are generated (by cobol_seginit_ 116 gen) after the processing of Minpral5 and the initial value min- 117 pral file. 118 119 This procedure also generates the code necessary to "perform" 120 size routines used in "addressing" identifiers defined with the 121 occurs depending clause. The call is made as it would be for a 122 Format 1 PERFORM statement except that the format number in the 123 end_stmt token is set to seven. 124 125 U^H__^Hs_^Ha_^Hg_^He:^H_ 126 127 declare cobol_perform_gen entry (ptr); 128 129 call cobol_perform_gen (in_token_ptr); 130 131 */ 132 133 134 /* 135 G^H__^He_^Hn_^He_^Hr_^Ha_^Ht_^He_^Hd_C^H__^Ho_^Hd_^He:^H_ 136 137 The code generated to implement the PERFORM statement is a func- 138 tion of format and segment initialization requirements. Segment 139 initializtion is required when procedure-name-1 is in a segment 140 different from that containing the PERFORM statement and this 141 segment is an independent segment containing explicit alterable 142 GO's (GO statements referenced by ALTER statements). 143 144 Format 1 - 145 146 No Intializaation Required 147 148 eaxn loc_a_relp,ic Set alterable GO at end of PNn to 149 sxln target_a_PNn return control to inst at loc_a 150 151 tra PN1_relp,ic Transfer to PN1 152 153 loc_a eaxn t_relp,ic Reset alterable GO at end 154 sxln target_a_PNn of PNn 155 156 Initialization Required 157 158 eaxn loc_a_relp Set alterable GO at end of PNn to 159 sxln target_a_PNn return control inst at loc_a 160 161 eaa PN1_relp,ic Load addr PN1 in a-reg bits 0-17 162 tra i_segm_relp,ic Transfer to init code for seg 163 containing PN1 164 165 loc_a eaxn t_relp,ic Reset alterable GO at end 166 sxln target_a_PNn of PNn 167 168 Format 2 - 169 170 No Initialization Required 171 172 Convert identifier-10 to fixed binary. 173 This code is generated by the move generator if the 174 identifier is long or short binary. The code generated 175 by the MOVE generator is not shown here. 176 177 If the identifier is packed or unpacked decimal, then the 178 following code sequence is generated: 179 180 dtb (ar),(ar) 181 ndsc9 id_10,l 182 ndsc9 id_10_fb,4 183 184 If the identifier is overpunch sign data, then it is first 185 converted to an unpacked decimal trailing sign temporary. 186 This temporary is then converted to a binary by generating 187 the same instructions shown above for packed or unpacked 188 decimal. 189 190 191 tmoz loc_b_relp,ic Tra to inst at loc_b if 0 or neg 192 193 [The preceding instructions are not generated if integer-1 194 is used instead of identifier-10 ] 195 196 stz count Store 0 in temp used to count times 197 performed 198 199 eaxn loc_a_relp Set alterable GO at end of PNn to 200 sxln target_a_PNn return control inst at loc_a 201 202 tra PN1_relp1,ic Transfer to PN1 203 204 loc_a ldq count Add one to count of times performed 205 adq 1,dl and compare to number of times 206 stq count specified in PERFORM 207 cmpq id_10_fb statement 208 209 [If integer-1 is used instead of identifier-10, then 210 cmpq id_10_fb becomes cmpq integer-1,dl ] 211 212 tnz PN1_relp2,ic Tra to PN1 if not performed times 213 required 214 215 eaxn t_relp,ic Reset alterable GO at end 216 sxln target_a_PNn of PNn 217 loc_b 218 219 Initialization Required 220 221 222 Convert identifier-10 to fixed binary. 223 This code is generated by the move generator if the 224 identifier is long or short binary. The code generated 225 by the MOVE generator is not shown here. 226 227 If the identifier is packed or unpacked decimal, then the 228 following code sequence is generated: 229 230 dtb (ar),(ar) 231 ndsc9 id_10,l 232 ndsc9 id_10_fb,4 233 234 If the identifier is overpunch sign data, then it is first 235 converted to an unpacked decimal trailing sign temporary. 236 This temporary is then converted to a binary by generating 237 the same instructions shown above for packed or unpacked 238 decimal. 239 tmoz loc_b_relp,ic Tra to inst at loc_b if 0 or neg 240 241 [The preceding instructions are not generated if integer-1 242 is used instead of identifier-10 ] 243 244 stz count Store 0 in temp used to count times 245 performed 246 247 eaxn loc_a_relp Set alterable GO at end of PNn to 248 sxln target_a_PNn return control inst at loc_a 249 250 eaa PN1_relp1,ic Load addr of PN1 in a-reg bits 0-17 251 252 tra i_segm_relp,ic Transfer to init code for seg 253 containing PN1 254 255 loc_a ldq count Add one to count of times performed 256 adq 1,dl and compare to number of times 257 stq count specified in PERFORM 258 cmpq id_10_fb statement 259 260 [If integer-1 is used instead of identifier-10, then 261 cmpq id_10_fb becomes cmpq integer-1,dl ] 262 263 tnz PN1_relp2,ic Tra to PN1 if not performed times 264 required 265 266 eaxn t_relp,ic Reset alterable GO at end 267 sxln target_a_PNn of PNn 268 loc_b 269 270 Format 3 - 271 272 No Initialization Required 273 274 eaxn loc_a_relp,ic Set alterable GO at end of PNn to 275 sxln target_a_PNn return control to inst at loc_a 276 277 loc_a[Instructions generated by cobol_arithop_gen and/or cobol_compare] 278 [_gen to implement condition-1. Tags created by PD Syntax ] 279 [for "condition true" are equated to loc_b and for "condi- ] 280 [tion false" are equated to PN1. ] 281 282 loc_b eaxn t_relp,ic Reset alterable GO at end 283 sxln target_a_PNn of PNn 284 285 Initialization Required 286 287 stz count Store 0 in count to indicate init 288 required 289 eaxn loc_a_relp,ic Set alterable GO at end of PNn to 290 sxln target_a_PNn return control to inst at loc_a 291 292 loc_a[Instructions generated by cobol_arithop_gen and/or cobol_compare] 293 [_gen to implement condition-1. Tags created by PD Syntax ] 294 [for "condition true" are equated to loc_b and for "condi- ] 295 [tion false" are equated to loc_i. ] 296 297 loc_b eaxn t_relp,ic Reset alterable GO at end 298 sxln target_a_PNn of PNn 299 tra loc_d_relp,ic Transfer to loc_d 300 loc_i ldq count Examine count and transfer 301 tnz PN1_relp1,ic to PN1 if it is not 0 302 aos count Otherwise add 1 to count 303 eaa PN1_relp2,ic Load addr of PN1 in a-reg bits 0-17 304 305 tra i_segm_relp,ic Transfer to init code for segment 306 containing PN1 307 loc_d 308 309 Format 4 - 310 311 The sequence of instructions given below is for the most complex 312 form of Format 4. Code generated for the less complex forms can 313 be deduced from it, however. 314 315 epbp2 0,ic Store ptr to base of Text 316 spri2 pr6|M Segment in pr6|M 317 tra loc_s_relp,ic Transfer to inst at loc_s 318 319 loc_e[Call to cobol_error_ generated by cobol_process_error to ] 320 [report "BY" identifier equal to zero. ] 321 322 rtcd pr6|M Transfer to addr stored in pr6|M 323 324 loc_s[Instructions generated by cobol_move_gen or cobol_set_gen to ] 325 [initialize identifier-1 or index-name-1 to identifier-2, ] 326 [index-name-2, or literal-1; identifier-4 or index-name-3 ] 327 [to identifier-5, index-name-4, or literal-3; and identi- ] 328 [fier-7 or index-name-5 to identifier-8, index-name-6, or ] 329 [literal-5. ] 330 331 {stz count Store 0 in count to indicate init 332 required. } 333 eaxn loc_a_relp,ic Set alterable GO at end of PNn to 334 sxln target_a_PNn return control to inst at loc_a 335 tra con_1_relp,ic and transfer to inst at con_1 336 337 loc_a[Instructions generated by cobol_compare_gen to implement ] 338 [equivalent COBOL statement "if identifier-9 is not zero ] 339 [go to inc_3.". Omitted if literal-6 is specified. ] 340 341 stc2 pr6|M Store addr inc_3 in pr6|M and 342 tra loc_e_relp,ic transfer to loc_e. These inst are 343 omitted if literal-6 is specified. 344 345 inc_3[Instructions generated by cobol_add_gen or cobol_set_gen to in- ] 346 [crement identifier-7 or index-name-5 by identifier-9 or ] 347 [literal-6. ] 348 349 con_3[Instructions generated by cobol_arithop_gen and/or cobol_compare] 350 [_gen to implement condition-3. Tags created by PD Syntax ] 351 [for "condition true" are equated to tru_3 and for "condi- ] 352 [tion false" are equated to loc_i if initialization is re- ] 353 [quired and to PN1 if initialization is not required. ] 354 355 tru_3[Instructions generated by cobol_move_gen or cobol_set_gen to ] 356 [initialize identifier-7 or index-name-5 to identifier-8, ] 357 [index-name-6, or literal-5. ] 358 359 [Instructions generated by cobol_compare_gen to implement ] 360 [equivalent COBOL statement "if identifier-6 is not zero ] 361 [go to inc_2.". Omitted if literal-4 is specified. ] 362 363 stc2 pr6|M Store addr inc_2 in pr6|M and 364 tra loc_e_relp,ic transfer to loc_e. These inst are 365 omitted if literal-4 is specified. 366 367 inc_2[Instructions generated by cobol_add_gen or cobol_set_gen to in- ] 368 [crement identifier-4 or index-name-3 by identifier-6 or ] 369 [literal-4. ] 370 371 con_2[Instructions generated by cobol_arithop_gen and/or cobol_compare] 372 [_gen to implement condition-2. Tags created by PD Syntax ] 373 [for "condition true" are equated to tru_2 and for "condi- ] 374 [tion false" are equated to con_3. ] 375 376 tru_2[Instructions generated by cobol_move_gen or cobol_set_gen to ] 377 [initialize identifier-4 or index-name-3 to identifier-5, ] 378 [index-name-4, or literal-3. ] 379 380 [Instructions generated by cobol_compare_gen to implement ] 381 [equivalent COBOL statement "if identifier-3 is not zero ] 382 [go to inc_1.". Omitted if literal-2 is specified. ] 383 384 stc1 pr6|M Store addr inc_1 in pr6|M and 385 tra loc_e_relp,ic transfer to loc_e. These inst are 386 omitted if literal-2 is specified. 387 388 inc_1[Instructions generated by cobol_add_gen or cobol_set_gen to in- ] 389 [crement identifier-1 or index-name-1 by identifier-3 or ] 390 [literal-2. ] 391 392 con_1[Instructions generated by cobol_arithop_gen and/or cobol_compare] 393 [_gen to implement condition-1. Tags created by PD Syntax ] 394 [for "condition true" are equated to tru_1 and for "condi- ] 395 [tion false" are equated to con_2. ] 396 397 tru_1 eaxn t_relp,ic Reset alterable GO at end 398 sxln target_a_PNn of PNn 399 {tra loc_n_relp,ic Transfer to loc_n 400 loc_i ldq count Examine count and transfer 401 tnz PN1_relp1,ic to PN1 if it is not 0 402 aos count Otherwise add 1 to count 403 eaa PN1_relp2,ic Load addr of PN1 in a-reg bits 0-17 404 405 tra i_segm_relp,ic Transfer to init code for segment 406 containing PN1 } 407 loc_n 408 409 Instructions in {} are included only if segment initialization is 410 required. 411 412 In initializing the "varying" or "after" identifiers to their 413 current "from" values, cobol_move_gen is employed only if the ident- 414 ifier is a numeric data item and the "from" operand is not an 415 index-name. In all other cases, cobol_set_gen is employed. To in- 416 crement the "varying" or "after" identifiers, cobol_add_gen is em- 417 ployed if the identifier is a numeric data item and cobol_set_gen 418 is employed if it is an index-name. 419 420 421 where: 422 PNn is procedure-name-n for n = 1 or 2. 423 424 target-a-PNn is a 36-bit variable allocated in the program's 425 COBOL data segment. It is uniquely associated with 426 procedure-name-n (n = 1 or 2). 427 428 PN1_relp is the offset, relative to the instruction in which 429 PN1_relp1 the symbol is used, of the first instruction gener- 430 PN1_relp2 ated to implement procedure-name-1. 431 432 t_relp is the offset, relative to the instruction in which 433 it appears, of an instruction defined by a tag uni- 434 quely associated with target_a_PNn. (Usually, this 435 is the instruction immediately following the end-of- 436 perform range alterable GO at the end of procedure- 437 name-1.) 438 439 id_10 is identifier-10. 440 441 id_10_fb designates a location in the COBOL data segment 442 where id_10 is stored as a fixed bin quantity. 443 444 count designates a location in the COBOL data segment 445 where a count is kept of the number of times that 446 the procedures in the PERFORM range have been per- 447 formed for Format 2 statements. For Formats 3 and 448 4 when segment initialization is required, count = 0 449 indicates that the initial transfer of control has 450 not yet been made and count = 1, that it has. 451 452 loc_x_relp is the offset, relative to the instruction in which 453 it appears, of the instruction whose address is 454 loc_x for x = a, b, c, ..... 455 456 con_n_relp is the offset, relative to the instruction in which 457 it appears, of the instruction whose address is 458 con_n for n = 1, 2, or 3. 459 460 i_segm_relp is the offset, relative to the instruction in which 461 it appears, of the first instruction of the code 462 generated to initialize segm (the segment contain- 463 ing procedure PN1). 464 465 M is the word offset of a word in the stack in which 466 the return address is stored prior to calling 467 cobol_error_ in Format 4 statements. 468 469 470 D^H__^Hi_^Hs_^Hc_^Hu_^Hs_^Hs_^Hi_^Ho_^Hn:^H_ 471 472 The number and nature of the tokens pointed to by the array 473 in_token.token_ptr depends upon the format of the PERFORM state- 474 ment which they describe. The following list indicates what may 475 be expected for each format: 476 477 Format 1 - tokens for 478 PERFORM PN1 PN2 EOS 479 480 Format 2 - tokens for 481 PERFORM PN1 PN2 ID EOS 482 483 Format 3 - tokens for 484 PERFORM PN1 PN2 condition EOS 485 486 Format 4 - tokens for 487 PERFORM PN1 PN2 ID1 ID2 ID3 condition [AFTER ID4 ID5 ID6 488 condition AFTER ID7 ID8 ID9 condition] EOS 489 490 Where the tokens for --- 491 PERFORM and AFTER are type-1 Reserved Word. 492 PN1 and PN2 are type-18 Procedure Reference. PN2 equals PN1 if 493 no THROUGH phrase is present in the original statement. 494 condition comprises a sequence of tokens representing the condi- 495 tional expression or expressions that are present in Formats 3 496 and 4. These tokens may be of the following types: 497 9 Data Definition 498 1 Reserved word (for FIGURATIVE CONSTANT ZERO) 499 2 Numeric Literal 500 3 Alphanumeric Literal 501 10 Index-Name 502 31 Tag Equivalence 503 30 Internal Tag Definition 504 19 EOS with 13 (branch) or 28 (arithmetic operator) in the 505 verb field 506 ID is a type-9 Data Definition or a type-2 Numeric Literal. 507 ID1, ID4, and ID7 may individually be either a type-9 Data Defini- 508 tion or a type-10 Index-Name. 509 ID2, ID5, and ID8 may individually be a type-9 Data Defintion, a 510 type-10 Index-Name, or a type-2 Numeric Literal, 511 or a type-1 token for the reserved word ZERO. 512 ID3, ID6, and ID9 may individually be either a type-9 Data Defini- 513 tion or a type-2 Numeric Literal. 514 EOS represents a type-19 token. 515 D^H__^Ha_^Ht_^Ha:^H_ 516 517 518 Items in cobol_$incl.pl1 used (u) and/or set (s) by 519 cobol_perform_gen: 520 521 cobol_ptr (u) 522 next_tag (u/s) 523 perform_list_ptr (u) 524 priority_no (u) 525 seg_init_list_ptr (u) 526 temp_token_ptr (u/s) 527 text_wd_off (u) 528 529 */ 530