COMPILATION LISTING OF SEGMENT cobol_compare_gen Compiled by: Multics PL/I Compiler, Release 31b, of April 24, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 05/24/89 0936.9 mst Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060), 17* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 18* MCR8060 cobol_compare_gen.pl1 Added Trace statements. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 10/19/84 by FCH, [5.3-1], BUG563(phx18381), new cobol_addr_tokens.incl.pl1 */ 23 /* Modified on 08/13/83 by fch, [5.2 ... ], trace added */ 24 /* Modified on 04/17/80 by FCH, [4.2-2], fix routine which compares type 2 tokens */ 25 /* Modified on 03/27/80 by FCH, [4.2-1], BUG427(TR3251), FW const used for neg comp-6 numbers */ 26 /* Modified on 02/23/77 by Bob Chang to fix the bug for initialization of auto data. */ 27 /* Modified on 1/19/77 by Bob Chang to improve the codes generated for index and binary comparsion. */ 28 /* Modified on 1/11/77 by Bob Chang to improve the codes generated for comp-6 and comp-7 comparison. */ 29 /* Modified on 12/30/76 by Bob Chang to handle numeric test for opch data with unsigned value in storage. */ 30 /* Modified since Version 2.0. */ 31 32 33 /* format: style3 */ 34 cobol_compare_gen: 35 proc (in_token_ptr, sort_prog_coll_seq_ptr); 36 37 38 39 40 sort_pcs_ptr = null (); /* not call from sort with collating seq. */ 41 42 goto start; 43 44 sort: 45 entry (in_token_ptr, sort_prog_coll_seq_ptr); 46 47 sort_pcs_ptr = sort_prog_coll_seq_ptr; 48 49 /* The above entry is the compare routine called from sort_gen. */ 50 51 52 /* 53*The Compare Generator: cobol_compare_gen 54* 55*FUNCTION 56*The compare generator is called to generate code for: 57* 58* 1. relational conditions 59* 2. class conditions 60* 3. sign conditions 61* 4. unconditional branches 62* 63*INPUT 64* 65*The input to this procedure is a pointer that points to a struc- 66*ture with a format defined by the following declaration: 67* 68*dcl 1 in_token aligned based (in_token_ptr), 69* 2 n fixed bin aligned, 70* 2 code fixed bin aligned, 71* 2 token_ptr (0 refer(in_token.n)) ptr aligned; 72* 73*The pointers in the array in_token.token_ptr point to tokens that 74*provide information about the type of code to be generated. This 75*array will contain from one to three pointers of interest to cobol_compare_gen, 76*depending on the code to be generated. 77* 78* code to be generated | number of pointers of 79* | interest 80* ______________________________________________________ 81* | 82* unconditional branch | 1 83* _______________________________________________________ 84* | 85* class condition | 2 86* sign condition | 87* abbreviated relational | 88* condition | 89* _______________________________________________________ 90* relational condition | 3 91* _______________________________________________________ 92* 93*In all cases for which cobol_compare_gen is called, in_token.token_ptr(n) 94*points to an EOS token. The pointers of interest in the token_ptr 95*array are described in the following table. 96* 97* 98*if cobol_compare gen is | pointers of interest in token_ptr 99* called for |__________________________________ 100* | number | description 101*_________________________________________________________________ 102* | | 103*unconditional branch | 1 | token_ptr(n)->EOS token 104* | 105*_________________________________________________________________ 106* | | 107*class condition | 2 | token_ptr(n)->EOS token 108* | | token_ptr(n-1)-> dataname 109* | | token whose class is to be 110* | | determined 111* 112* | | 113*_________________________________________________________________ 114* | | 115*sign condition | 2 | token_ptr(n)->EOS token 116* | | token_ptr(n-1)->dataname 117* | | token whose sign is to be 118* | | determined 119* | | 120*_________________________________________________________________ 121* | | 122*abbreviated relational | 2 | token_ptr(n)->EOS token 123* condition | | token_ptr(n-1)->right 124* | | operand of the abbreviated 125* | | relation 126* | | 127*_________________________________________________________________ 128* 129* | | 130*relational condition | 3 | token_ptr(n)->EOS token 131* | | token_ptr(n-1)->right operand 132* | | operand of relation 133* | | token_ptr(n-2)->left 134* | | operand of relation 135*_________________________________________________________________ 136* 137* 138*THE EOS TOKEN 139* 140*The EOS token contains information that defines the type of code 141*to be generated. The format of this token is defined by 142*a declaration of the form: 143* 144* dcl 1 end_stmt based (eos_ptr), 145* 2 size fixed bin (15), 146* 2 line fixed bin (15), 147* 2 column fixed bin (15), 148* 2 type fixed bin (15), 149* 2 e fixed bin (15), 150* 2 h fixed bin (15), 151* 2 i fixed bin (15), 152* 2 j fixed bin (15), 153* 2 a bit (3), 154* 2 b bit (1), 155* 2 c bit (1), 156* 2 d bit (2), 157* 2 f bit (2), 158* 2 g bit (2), 159* 2 k bit (5); 160* 161*Only certain fields of the EOS token are relevant to cobol_compare_gen. 162*The relevant fields are: 163* 164*1. end_stmt.e 165* This fixed binary field contains either 166* a. a code that identifies the type of compare 167* for which code is to be generated. 168* b. a code that indicates that code for an 169* unconditional branch is to be generated. 170* 171* The values which this field will contain, and the meaning 172* associated with each are given in the following table: 173* 174* value in end_stmt.e | code is to be generated for 175* _______________________________________________________ 176* 63 | unconditional branch 177* 102 | equal compare 178* 113 | greater compare 179* 123 | less compare 180* 171 | unequal compare 181* 131 | numeric class condition 182* 74 | alphabetic class condition 183* 141 | positive sign condition 184* 127 | negative sign condition 185* 180 | zero sign condition 186* ________________________________________________________ 187* 188*2. end_stmt.h 189* This fixed binary field contains a compiler generated 190* tag (label) number to which a transfer is to be done 191* depending on the results of the compare. 192* 193*3. end_stmt.i 194* This fixed binary field is used as a bit (36) field. 195* Only two bits have any significance: 196* 197* a. bit 2 If "1"b, then a transfer to te label in 198* end_stmt.h is to be executed if the result 199* of the compare specified in end_stmt.e 200* is NOT true. 201* b. bit 3 If "1"b, then this is an EOS for an abbreviated 202* compare. Only token_ptr(n-1) is meaningful 203* the token_ptr array, and it points to the right 204* operand of the relational condition. 205* 206*OUTPUT 207* 208*One output value is passed back to the generator driver under 209*certain conditions. When cobol_compare_gen is called to generate 210*code for an unabbreviated relation condition, the field "in_token.code" 211*is set to 1 before returning to the generator driver. This reuurned 212*value tells the driver to save the current in_token structure. 213*This saved in_token structure will be the source of the left operand 214* 215*if the next call to cobol_compare_gen is an abbreviated compare. Note 216* 217*that it is the responsibility of cobol_compare_gen to save a pointer 218*to the input_structure saved by the generator driver. 219**/ 220 /*}*/ 221 222 223 224 225 /* DECLARATIONS OF EXTERNAL ENTRIES */ 226 227 dcl cobol_make_tagref ext entry (fixed bin, fixed bin, ptr); 228 dcl cobol_make_type9$type2_3 229 ext entry (ptr, ptr); 230 dcl cobol_addr ext entry (ptr, ptr, ptr); 231 dcl cobol_emit ext entry (ptr, ptr, fixed bin); 232 dcl cobol_trans_alphabet 233 entry (ptr, ptr, fixed bin, fixed bin, ptr, char (1)); 234 dcl cobol_register$load entry (ptr); 235 dcl cobol_register$release 236 entry (ptr); 237 dcl cobol_make_type9$long_bin 238 entry (ptr, fixed bin, fixed bin); 239 dcl cobol_alloc$stack ext entry (fixed bin, fixed bin, fixed bin); 240 dcl cobol_move_gen ext entry (ptr); 241 dcl cobol_make_type9$copy 242 ext entry (ptr, ptr); 243 dcl cobol_pool$search_op 244 entry (char (*), fixed bin, fixed bin, fixed bin); 245 dcl cobol_define_tag ext entry (fixed bin); 246 dcl cobol_get_index_value 247 ext entry (fixed bin, ptr, ptr); 248 dcl cobol_num_to_udts ext entry (ptr, ptr); 249 250 /* DEFINITIONS OF CONSTANTS THAT COULD APPEAR IN THE EOS TOKENS */ 251 252 dcl rwkey_numeric fixed bin int static init (131); 253 dcl rwkey_alphabetic fixed bin int static init (74); 254 dcl rwkey_positive fixed bin int static init (141); 255 dcl rwkey_negative fixed bin int static init (127); 256 dcl rwkey_zero fixed bin int static init (180); 257 dcl rwkey_equal fixed bin int static init (102); 258 dcl rwkey_greater fixed bin int static init (113); 259 dcl rwkey_less fixed bin int static init (123); 260 dcl rwkey_unequal fixed bin int static init (171); 261 dcl rwkey_space fixed bin int static init (192); 262 dcl rwkey_quote fixed bin int static init (235); 263 dcl rwkey_highval fixed bin int static init (221); 264 dcl rwkey_lowval fixed bin int static init (229); 265 dcl uncond_branch fixed bin int static init (63); 266 267 /* DEFINITIONS OF CONSTANTS THAT REPRESENT OPCODES USED IN THIS GENERATOR */ 268 269 dcl tmi_op bit (10) int static init ("1100001000"b /* 604(0) */); 270 dcl tpl_op bit (10) int static init ("1100001010"b /* 605(0) */); 271 dcl trc_op bit (10) int static init ("1100000110"b /* 603(0) */); 272 dcl tnc_op bit (10) int static init ("1100000100"b /* 602(0) */); 273 dcl tmoz_op bit (10) int static init ("1100001001"b /* 604(1) */); 274 dcl tpnz_op bit (10) int static init ("1100001011"b /* 605(1) */); 275 dcl tnz_op bit (10) int static init ("1100000010"b /* 601(0) */); 276 dcl tze_op bit (10) int static init ("1100000000"b /* 600(0) */); 277 dcl ttf_op bit (10) int static init ("1100001110"b /* 607(0) */); 278 dcl ttn_op bit (10) int static init ("1100001101"b /* 606(1) */); 279 dcl tra_op bit (10) int static init ("1110010000"b /* 710(0) */); 280 dcl nop_op bit (10) int static init ("0000010010"b /* 011(0) */); 281 dcl cmpn_op bit (10) int static init ("0110000111"b /* 303(1) */); 282 dcl cmpc_op bit (10) int static init ("0010001101"b /* 106(1) */); 283 dcl tct_op bit (10) int static init ("0011101001"b /* 164(1) */); 284 dcl mvt_op bit (10) int static init ("0011100001"b /* 160(1) */); 285 286 287 /* DECLARATION OF AN IMAGE OF A NUMERIC LITERAL ZERO */ 288 289 dcl 1 numeric_zero internal static, 290 2 size fixed bin (15) init (37), 291 2 line fixed bin (15) init (0), 292 2 column fixed bin (15) init (0), 293 2 type fixed bin (15) init (2), 294 2 integral bit (1) init ("1"b), 295 2 floating bit (1) init ("0"b), 296 2 filler1 bit (5) init ("00000"b), 297 2 sign char (1) init (" "), 298 2 exp_sign char (1) init (" "), 299 2 exp_places fixed bin (15) init (0), 300 2 places_left fixed bin (15) init (1), 301 2 places_right fixed bin (15) init (0), 302 2 places fixed bin (15) init (1), 303 2 literal char (1) init ("0"); 304 305 306 /* INTERNAL STATIC BUFFERS USED TO HOLD OPERANDS THAT ARE BUILT ONLY 307* ONCE PER COMPILATION */ 308 309 dcl type9_zero (1:35) fixed bin internal static; 310 311 dcl type9_zero_ptr ptr internal static; 312 313 dcl type9_numeric_tct (1:40) fixed bin int static; 314 dcl type9_numeric_tct_ptr 315 ptr internal static; 316 317 dcl type9_alpha_tct (1:40) fixed bin int static; 318 319 dcl type9_alpha_tct_ptr ptr internal static; 320 321 dcl type9_opch_tct (1:40) fixed bin int static; 322 dcl type9_opch_tct_ptr ptr int static; 323 324 /* DECLARATION OF STATIC WORK BUFFERS */ 325 326 dcl minus_type9 (1:40) fixed bin int static; /* Used to contain type 9 for minus sign */ 327 328 dcl plus_type9 (1:40) fixed bin int static; /* Used to contain type 9 for plus sign */ 329 330 331 /* DECLARATION OF INTERNAL STATIC VARIABLES USED AS "FIRST TIME" SWITCHES FOR THINGS TO BE DONE 332* ONCE PER COMPILATION */ 333 334 dcl zero_allocated fixed bin int static init (0); 335 dcl ascii_to_ebcdic_table_allocated 336 fixed bin int static init (0); 337 dcl numeric_tct_table_allocated 338 fixed bin int static init (0); 339 dcl alpha_tct_table_allocated 340 fixed bin int static init (0); 341 dcl opch_tct_table_allocated 342 fixed bin int static init (0); 343 344 345 /* DEFINITION OF A TRANSLATION TABLE THAT CONTAINS ZERO FOR LOWER CASE ALPHABETICS, 346* UPPER CASE ALPHABETICS, AND SPACE. */ 347 348 dcl alpha_tct_table (0:511) bit (9) int static 349 init ( 350 /* | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 |*/ 351 /*----------------------------------------------------------------------------------------*/ 352 /* 00 */ "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 353 /* 01 */ 354 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 355 /* 02 */ 356 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 357 /* 03 */ 358 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 359 /* 04 */ 360 "0"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 361 /* 05 */ 362 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 363 /* 06 */ 364 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 365 /* 07 */ 366 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 367 /* 10 */ 368 "1"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, 369 /* 11 */ 370 "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, 371 /* 12 */ 372 "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, 373 /* 13 */ 374 "0"b, "0"b, "0"b, "1"b, "1"b, "1"b, "1"b, "1"b, 375 /* 14 */ 376 "1"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, 377 /* 15 */ 378 "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, 379 /* 16 */ 380 "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, 381 /* 17 */ 382 "0"b, "0"b, "0"b, "1"b, "1"b, "1"b, "1"b, "1"b, 383 /* 20 */ 384 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 385 /* 21 */ 386 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 387 /* 22 */ 388 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 389 /* 23 */ 390 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 391 /* 24 */ 392 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 393 /* 25 */ 394 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 395 /* 26 */ 396 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 397 /* 27 */ 398 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 399 /* 30 */ 400 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 401 /* 31 */ 402 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 403 /* 32 */ 404 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 405 /* 33 */ 406 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 407 /* 34 */ 408 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 409 /* 35 */ 410 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 411 /* 36 */ 412 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 413 /* 37 */ 414 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 415 /* 40 */ 416 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 417 /* 41 */ 418 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 419 /* 42 */ 420 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 421 /* 43 */ 422 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 423 /* 44 */ 424 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 425 /* 45 */ 426 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 427 /* 46 */ 428 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 429 /* 47 */ 430 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 431 /* 50 */ 432 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 433 /* 51 */ 434 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 435 /* 52 */ 436 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 437 /* 53 */ 438 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 439 /* 54 */ 440 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 441 /* 55 */ 442 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 443 /* 56 */ 444 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 445 /* 57 */ 446 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 447 /* 60 */ 448 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 449 /* 61 */ 450 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 451 /* 62 */ 452 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 453 /* 63 */ 454 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 455 /* 64 */ 456 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 457 /* 65 */ 458 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 459 /* 66 */ 460 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 461 /* 67 */ 462 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 463 /* 70 */ 464 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 465 /* 71 */ 466 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 467 /* 72 */ 468 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 469 /* 73 */ 470 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 471 /* 74 */ 472 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 473 /* 75 */ 474 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 475 /* 76 */ 476 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 477 /* 77 */ 478 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b); 479 /* DEFINITION OF A TRANSLATION TABLE THAT CONTAINS ZERO FOR NUMERICS ONLY */ 480 481 dcl numeric_tct_table (0:511) bit (9) int static 482 init ( 483 /* | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 |*/ 484 /*----------------------------------------------------------------------------------------*/ 485 /* 00 */ "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 486 /* 01 */ 487 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 488 /* 02 */ 489 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 490 /* 03 */ 491 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 492 /* 04 */ 493 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 494 /* 05 */ 495 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 496 /* 06 */ 497 "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, 498 /* 07 */ 499 "0"b, "0"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 500 /* 10 */ 501 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 502 /* 11 */ 503 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 504 /* 12 */ 505 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 506 /* 13 */ 507 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 508 /* 14 */ 509 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 510 /* 15 */ 511 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 512 /* 16 */ 513 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 514 /* 17 */ 515 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 516 /* 20 */ 517 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 518 /* 21 */ 519 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 520 /* 22 */ 521 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 522 /* 23 */ 523 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 524 /* 24 */ 525 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 526 /* 25 */ 527 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 528 /* 26 */ 529 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 530 /* 27 */ 531 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 532 /* 30 */ 533 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 534 /* 31 */ 535 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 536 /* 32 */ 537 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 538 /* 33 */ 539 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 540 /* 34 */ 541 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 542 /* 35 */ 543 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 544 /* 36 */ 545 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 546 /* 37 */ 547 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 548 /* 40 */ 549 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 550 /* 41 */ 551 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 552 /* 42 */ 553 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 554 /* 43 */ 555 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 556 /* 44 */ 557 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 558 /* 45 */ 559 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 560 /* 46 */ 561 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 562 /* 47 */ 563 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 564 /* 50 */ 565 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 566 /* 51 */ 567 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 568 /* 52 */ 569 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 570 /* 53 */ 571 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 572 /* 54 */ 573 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 574 /* 55 */ 575 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 576 /* 56 */ 577 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 578 /* 57 */ 579 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 580 /* 60 */ 581 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 582 /* 61 */ 583 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 584 /* 62 */ 585 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 586 /* 63 */ 587 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 588 /* 64 */ 589 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 590 /* 65 */ 591 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 592 /* 66 */ 593 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 594 /* 67 */ 595 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 596 /* 70 */ 597 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 598 /* 71 */ 599 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 600 /* 72 */ 601 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 602 /* 73 */ 603 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 604 /* 74 */ 605 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 606 /* 75 */ 607 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 608 /* 76 */ 609 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 610 /* 77 */ 611 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b); 612 613 /* DEFINITION OF A TRANSLATION TABLE THAT CONTAINS ZERO FOR OVERPUNCH SIGN CHARACTERS ONLY */ 614 615 dcl opch_tct_table (0:511) bit (9) int static 616 init ( 617 /* | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 |*/ 618 /*----------------------------------------------------------------------------------------*/ 619 /* 00 */ "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 620 /* 01 */ 621 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 622 /* 02 */ 623 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 624 /* 03 */ 625 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 626 /* 04 */ 627 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 628 /* 05 */ 629 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 630 /* 06 */ 631 "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, 632 /* 07 */ 633 "0"b, "0"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 634 /* 10 */ 635 "1"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, 636 /* 11 */ 637 "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, 638 /* 12 */ 639 "0"b, "0"b, "0"b, "1"b, "1"b, "1"b, "1"b, "1"b, 640 /* 13 */ 641 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 642 /* 14 */ 643 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 644 /* 15 */ 645 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 646 /* 16 */ 647 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 648 /* 17 */ 649 "1"b, "1"b, "1"b, "0"b, "1"b, "0"b, "1"b, "1"b, 650 /* 20 */ 651 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 652 /* 21 */ 653 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 654 /* 22 */ 655 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 656 /* 23 */ 657 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 658 /* 24 */ 659 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 660 /* 25 */ 661 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 662 /* 26 */ 663 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 664 /* 27 */ 665 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 666 /* 30 */ 667 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 668 /* 31 */ 669 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 670 /* 32 */ 671 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 672 /* 33 */ 673 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 674 /* 34 */ 675 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 676 /* 35 */ 677 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 678 /* 36 */ 679 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 680 /* 37 */ 681 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 682 /* 40 */ 683 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 684 /* 41 */ 685 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 686 /* 42 */ 687 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 688 /* 43 */ 689 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 690 /* 44 */ 691 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 692 /* 45 */ 693 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 694 /* 46 */ 695 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 696 /* 47 */ 697 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 698 /* 50 */ 699 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 700 /* 51 */ 701 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 702 /* 52 */ 703 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 704 /* 53 */ 705 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 706 /* 54 */ 707 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 708 /* 55 */ 709 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 710 /* 56 */ 711 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 712 /* 57 */ 713 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 714 /* 60 */ 715 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 716 /* 61 */ 717 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 718 /* 62 */ 719 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 720 /* 63 */ 721 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 722 /* 64 */ 723 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 724 /* 65 */ 725 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 726 /* 66 */ 727 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 728 /* 67 */ 729 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 730 /* 70 */ 731 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 732 /* 71 */ 733 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 734 /* 72 */ 735 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 736 /* 73 */ 737 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 738 /* 74 */ 739 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 740 /* 75 */ 741 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 742 /* 76 */ 743 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 744 /* 77 */ 745 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b); 746 747 748 /* Static variables used for processing of separate sign for class condition */ 749 750 dcl separate_signs_pooled 751 fixed bin int static init (0); 752 753 /* Declaration of an alphanumeric literal used to develop allocated constants for plus (+) 754* and minus (-) in processing for class condition. */ 755 756 dcl 1 separate_sign_literal 757 int static, 758 2 size fixed bin (15) init (25), 759 2 line fixed bin (15) init (0), 760 2 column fixed bin (15) init (0), 761 2 type fixed bin (15) init (3), 762 2 lit_type bit (1) init ("0"b), 763 2 all_lit bit (1) init ("0"b), 764 2 filler1 bit (1), 765 2 lit_size fixed bin (15) init (1), 766 2 literal_string char (1); 767 768 769 770 /* Definition of eis fill character */ 771 772 dcl 1 eis_fill_def int static, 773 2 space char (1) init (" "), 774 2 zero char (1) init ("0"), 775 2 quote char (1) init (""""), 776 2 high_value char (1) init (""), /* INIT TO OCTAL 177. */ 777 2 low_value char (1) init (""); /* INIT TO OCTAL 000. */ 778 779 780 781 /* DECLARATIONS OF VARIABLES USED IN BUILDING NON-EIS INSTRUCTIONS */ 782 783 dcl non_eis_ptr ptr; 784 785 dcl 1 non_eis_inst aligned based (non_eis_ptr), 786 2 y bit (18) unaligned, 787 2 op_code bit (9) unaligned, 788 2 zeroes bit (3) unaligned, 789 2 tm bit (2) unaligned, 790 2 td bit (4) unaligned; 791 792 dcl non_eis_word bit (36); 793 794 /* DECLARATIONS OF VARIABLES USED IN BUILDING EIS INSTRUCTIONS */ 795 796 dcl eis_ptr ptr; 797 798 dcl 1 eis_inst aligned based (eis_ptr), 799 2 unused bit (18) unaligned, 800 2 opcode bit (10) unaligned; 801 802 803 /* DECLARATIONS OF WORK BUFFERS */ 804 805 /* WORK BUFFER IN WHICH INPUT TO THE ADDRESSABILITY UTILITY IS BUILT */ 806 807 dcl wkbuff1 (1:20) fixed bin; 808 809 /* WORK BUFFER IN WHICH THE OUTPUT FROM THE ADDRESSABILITY UTILITY IS RETURNED */ 810 811 dcl wkbuff2 (1:5) fixed bin; 812 813 /* WORK BUFFER IN WHICH RELOCATION INFORMATION IS PLACED BY THE ADDRESSABILITY UTILITY */ 814 815 dcl wkbuff3 (1:10) fixed bin; 816 817 818 /* VARIABLES USED TO ACESS "end_stmt.i" as a bit string */ 819 820 dcl i_ptr ptr; 821 822 dcl 1 ibit based (i_ptr), 823 2 unused1 bit (1), 824 2 not bit (1), 825 2 abbreviated bit (1); 826 827 /* OTHER WORK VARIABLES */ 828 829 dcl save_locno fixed bin; 830 dcl topcode bit (10); 831 dcl descrip_ptr ptr; 832 dcl in_op fixed bin; 833 dcl descrip bit (72) based (descrip_ptr); 834 dcl alpha_flag bit (1); 835 836 dcl work_in_token_ptr ptr; 837 838 dcl 1 work_in_token, 839 2 n fixed bin, 840 2 code fixed bin, 841 2 token_ptr (1:3) ptr; 842 843 dcl work_in_token1_ptr ptr; 844 845 dcl 1 work_in_token1, 846 2 n fixed bin, 847 2 code fixed bin, 848 2 token_ptr (1:3) ptr; 849 850 dcl sort_prog_coll_seq_ptr 851 ptr; 852 dcl dn_ptr ptr; 853 dcl sort_pcs_ptr ptr; 854 855 856 /**************************************************/ 857 /* START OF EXECUTION */ 858 /* cobol_compare_gen */ 859 /**************************************************/ 860 861 862 start: /***..... if Trace_Bit then call cobol_gen_driver_$Tr_Beg(ccg);/**/ 863 /* Initialization of pointers used in addressability utility */ 864 input_ptr = addr (wkbuff1 (1)); 865 inst_ptr = addr (wkbuff2 (1)); 866 reloc_ptr = addr (wkbuff3 (1)); 867 868 869 eos_ptr = in_token.token_ptr (in_token.n); /* Point at EOS in input structure */ 870 871 872 873 if sort_pcs_ptr ^= null () 874 then do; 875 alpha_name_ptr = sort_pcs_ptr; 876 alpha_flag = "1"b; 877 end; 878 879 880 881 else if cobol_$main_pcs_ptr ^= null () 882 then do; 883 alpha_name_ptr = cobol_$main_pcs_ptr; 884 alpha_flag = "1"b; 885 end; 886 887 else alpha_flag = "0"b; 888 889 if end_stmt.e = uncond_branch 890 then call ubranch; 891 892 else if (end_stmt.e = rwkey_numeric | end_stmt.e = rwkey_alphabetic) 893 then call class_condition; 894 895 else if (end_stmt.e = rwkey_positive | end_stmt.e = rwkey_negative | end_stmt.e = rwkey_zero) 896 then call sign_condition; 897 898 899 900 else call relational_compare; /* assume relational compare */ 901 902 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_End(ccg);/**/ 903 return; 904 905 /*{*/ 906 ubranch: 907 proc; 908 909 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_Beg(ub);/**/ 910 911 /* This internal procedure generates code for an unconditional branch. */ 912 913 /*}*/ 914 start_ubranch: /* Zero the instruction to be emitted */ 915 non_eis_word = "0"b; 916 non_eis_ptr = addr (non_eis_word); 917 918 /* Set op code to unconditional transfer */ 919 non_eis_inst.op_code = tra_op; 920 921 /* Save the offset in the text section at which the instruction is to be emitted */ 922 save_locno = cobol_$text_wd_off; 923 924 /* Build the relocation bytes */ 925 reloc_struc (1) = "0"b; 926 reloc_struc (2) = "0"b; 927 928 /* Emit the instruction */ 929 930 call cobol_emit (non_eis_ptr, reloc_ptr, 1); 931 932 933 /* Issue a reference to the tag in "end_stmt.h" */ 934 935 call cobol_make_tagref (fixed (end_stmt.h, 17), save_locno, null ()); 936 937 938 939 exit_ubranch: 940 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_End(ub);/**/ 941 return; 942 end ubranch; 943 944 /*{*/ 945 sign_condition: 946 proc; 947 948 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_Beg(sc);/**/ 949 950 /* This internal procedure generates code for a Cobol sign condition. */ 951 952 /*}*/ 953 954 dcl out1_ptr ptr; 955 start_sign_condition: /* Allocate a numeric constant of zero and make a type 9 for the constant, 956* if it hasn't already been allocated during this compilation. */ 957 if zero_allocated ^= cobol_$compile_count 958 then do; /* Allocate numeric zero */ 959 /* Point at buffer in which type 9 for zero is to be built */ 960 961 type9_zero_ptr = addr (type9_zero (1)); 962 963 call cobol_make_type9$type2_3 (type9_zero_ptr, addr (numeric_zero)); 964 965 zero_allocated = cobol_$compile_count; 966 end; /* Allocate the numeric zero; */ 967 968 969 /* Establish addressability to the operand to be compared to zero, and the operand 970* for numeric zero */ 971 972 /* Build the input structure to the addressability utility. */ 973 /* Base dataname token template on the operand */ 974 dn_ptr = in_token.token_ptr (in_token.n - 1); 975 976 977 if (data_name.type = rtc_dataname & (data_name.bin_18 | data_name.bin_36)) /* fixed binary data type */ 978 | (data_name.type = rtc_dataname & data_name.item_signed & ^data_name.sign_separate) 979 /* overpunch sign */ 980 then do; /* Operand must be converted to decimal */ 981 out1_ptr = null (); 982 983 call convert_to_dec (dn_ptr, out1_ptr); 984 985 dn_ptr = out1_ptr; 986 end; /* Operand must be converted to decimal */ 987 988 989 input_struc.type = 5; /* eis, 2 operands */ 990 input_struc.operand_no = 2; 991 input_struc.lock = 0; /* no locks requested */ 992 input_struc.token_ptr (1) = dn_ptr; 993 input_struc.size_sw (1) = 0; 994 input_struc.send_receive (1) = 0; 995 input_struc.token_ptr (2) = type9_zero_ptr; 996 input_struc.send_receive (2) = 0; 997 input_struc.size_sw (2) = 0; 998 999 /* Call the addressability utility */ 1000 1001 1002 call cobol_addr (input_ptr, inst_ptr, reloc_ptr); 1003 1004 1005 /* Insert the CMPN opcode into the instruction just built */ 1006 eis_ptr = inst_ptr; 1007 eis_inst.opcode = cmpn_op; 1008 1009 /* Emit the CMPN instruction */ 1010 1011 call cobol_emit (eis_ptr, reloc_ptr, 3); 1012 1013 1014 /* Determine the type of transfer instruction to be generated */ 1015 1016 i_ptr = addr (end_stmt.i); 1017 1018 if end_stmt.e = rwkey_positive 1019 then do; /* POSITIVE OR NOT POSITIVE */ 1020 if ibit.not 1021 then topcode = tpl_op; /* NOT POSITIVE */ 1022 else topcode = tmi_op; /* POSITIVE */ 1023 end; /* POSITIVE OR NOT POSITIVE */ 1024 1025 1026 else if end_stmt.e = rwkey_negative 1027 then do; /* NEGATIVE OR NOT NEGATIVE */ 1028 if ibit.not 1029 then topcode = tmoz_op; /* NOT NEGATIVE */ 1030 else topcode = tpnz_op; /* NEGATIVE */ 1031 end; /* NEGATIVE OR NOT NEGATIVE */ 1032 1033 1034 1035 else do; /* ASSUME ZERO OR NOT ZERO */ 1036 if ibit.not 1037 then topcode = tnz_op; /* NOT ZERO */ 1038 else topcode = tze_op; /* ZERO */ 1039 end; /* ASSUME ZERO OR NOT ZERO */ 1040 1041 1042 /* Build the transfer instruction */ 1043 1044 non_eis_word = "0"b; 1045 non_eis_ptr = addr (non_eis_word); 1046 1047 /* Set the op_code */ 1048 non_eis_ptr -> eis_inst.opcode = topcode; 1049 1050 /* Save the offset in the text section at which the transfer is to be emitted */ 1051 save_locno = cobol_$text_wd_off; 1052 1053 /* build the relocation bytes */ 1054 reloc_struc (1) = "0"b; 1055 reloc_struc (2) = "0"b; 1056 1057 /* Emit the transfer instruction */ 1058 1059 1060 call cobol_emit (addr (non_eis_inst), reloc_ptr, 1); 1061 1062 1063 /* Issue a reference to the tag in "end_stmt.h" */ 1064 1065 1066 call cobol_make_tagref (fixed (end_stmt.h, 17), save_locno, null ()); 1067 1068 1069 exit_sign_condition: 1070 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_End(sc);/**/ 1071 return; 1072 end sign_condition; 1073 1074 /*{*/ 1075 relational_compare: 1076 proc; 1077 1078 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_Beg(rc);/**/ 1079 1080 /* This internal procedure generates code for a relational comparison. */ 1081 1082 /*}*/ 1083 1084 dcl continue bit (1); 1085 dcl both_numeric bit (1); 1086 1087 dcl lop_ptr ptr; 1088 dcl rop_ptr ptr; 1089 dcl saved_lop_ptr int static ptr; 1090 1091 /*************************************************/ 1092 /* START OF EXECUTION */ 1093 /* relational_comparison */ 1094 /**************************************************/ 1095 1096 start_relational_compare: 1097 eos_ptr = in_token.token_ptr (in_token.n); 1098 1099 /* Determine whether the current compare is abbreviated or not */ 1100 1101 i_ptr = addr (end_stmt.i); 1102 1103 if ^ibit.abbreviated 1104 then do; /* Not an abbreviated compare */ 1105 lop_ptr = in_token.token_ptr (in_token.n - 2); 1106 /* Get left operand pointer */ 1107 saved_lop_ptr = lop_ptr; /* Save left operand pointer for use if next 1108* compare is abbreviated */ 1109 end; /* Not an abbreviated compare */ 1110 1111 1112 else lop_ptr = saved_lop_ptr; /* An abbreviated compare. Use the saved lop pointer. */ 1113 1114 rop_ptr = in_token.token_ptr (in_token.n - 1); 1115 1116 /* Determine whether the compare is numeric or alphanumeric */ 1117 1118 both_numeric = "0"b; 1119 continue = "1"b; 1120 rw_ptr = lop_ptr; /* Check left operand first */ 1121 1122 1123 do while (continue); /* Check to see if both operands are numeric */ 1124 1125 if (reserved_word.type = rtc_indexname | reserved_word.type = rtc_numlit /* numeric literal */ 1126 | (reserved_word.type = rtc_resword & reserved_word.key = rwkey_zero) /* ZERO */ 1127 | (reserved_word.type = rtc_dataname 1128 & (rw_ptr -> data_name.numeric | rw_ptr -> data_name.usage_index)) 1129 /* numeric type 9 or usage index */) 1130 then do; /* The current operand is numeric */ 1131 1132 if rw_ptr = rop_ptr 1133 then do; /* Current operand is right operand, so both are numeric */ 1134 continue = "0"b; /* To exit from the loop */ 1135 both_numeric = "1"b; /* Both operands are numeric */ 1136 end; /* Current operand is right operand, so both are numeric */ 1137 1138 1139 else rw_ptr = rop_ptr; /* Must now check right operand */ 1140 end; /* The current operand is numeric */ 1141 1142 1143 else continue = "0"b; /* The current operand is not numeric */ 1144 1145 end; /* Check to see if both operands are numeric */ 1146 1147 1148 1149 if both_numeric 1150 then call numeric_compare (lop_ptr, rop_ptr); 1151 1152 1153 else call alpha_compare (lop_ptr, rop_ptr); 1154 1155 1156 exit_relational_compare: 1157 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_End(rc);/**/ 1158 return; 1159 end relational_compare; 1160 1161 /*{*/ 1162 numeric_compare: 1163 proc (lop_ptr, rop_ptr); /* 1164*This procedure generates code for a numeric relational comparison. */ 1165 /* DECLARATIONS OF THE PARAMETERS */ 1166 1167 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_Beg(nc);/**/ 1168 1169 dcl lop_ptr ptr; 1170 dcl rop_ptr ptr; 1171 1172 /* 1173*lop_ptr Points to the left operand of a numeric 1174* compare. (input) 1175*rop_ptr Points to the right operand of a numeric 1176* comparison. (input) 1177**/ 1178 1179 /*}*/ 1180 1181 dcl buff1 (1:40) fixed bin; 1182 dcl buff2 (1:40) fixed bin; 1183 dcl temp_lop_ptr ptr; 1184 dcl temp_buff char (150); 1185 dcl temp_rop_ptr ptr; 1186 dcl out1_ptr ptr; 1187 dcl out2_ptr ptr; 1188 1189 dcl equal_flag fixed bin, 1190 less_flag fixed bin, 1191 greater_flag fixed bin; 1192 dcl 1 move_bin_18 static, 1193 2 n fixed bin init (4), 1194 2 code fixed bin init (0), 1195 2 pt1 ptr init (null), 1196 2 pt2 ptr, 1197 2 pt3 ptr, 1198 2 pt4 ptr; 1199 1200 dcl 1 bin_36_rop static, 1201 2 header (4) fixed bin init (112, 0, 0, 9), 1202 2 repl_ptr (2) ptr init ((2) null ()), 1203 2 fill1 bit (108) init (""b), 1204 2 file_key_info, 1205 3 fb1 (3) fixed bin init (0, 0, 0), 1206 3 size fixed bin init (0), 1207 3 fb2 (2) fixed bin init (0, 0), 1208 3 flags1 bit (36) init ("000000100100001001000000000000000000"b), 1209 3 flags2 bit (36) init (""b), 1210 3 seg fixed bin init (1000), 1211 3 offset fixed bin, 1212 2 fill2 (7) fixed bin init (0, 0, 0, 0, 0, 0, 0); 1213 1214 dcl 1 bin_36_lop static, 1215 2 header (4) fixed bin init (112, 0, 0, 9), 1216 2 repl_ptr (2) ptr init ((2) null ()), 1217 2 fill1 bit (108) init (""b), 1218 2 file_key_info, 1219 3 fb1 (3) fixed bin init (0, 0, 0), 1220 3 size fixed bin init (0), 1221 3 fb2 (2) fixed bin init (0, 0), 1222 3 flags1 bit (36) init ("000000100100001001000000000000000000"b), 1223 3 flags2 bit (36) init (""b), 1224 3 seg fixed bin init (1000), 1225 3 offset fixed bin, 1226 2 fill2 (7) fixed bin init (0, 0, 0, 0, 0, 0, 0); 1227 1228 dcl 1 bin_18_type9 static, 1229 2 header (4) fixed bin init (112, 0, 0, 9), 1230 2 repl_ptr (2) ptr init ((2) null ()), 1231 2 fill1 bit (108) init (""b), 1232 2 file_key_info, 1233 3 fb1 (3) fixed bin init (0, 0, 0), 1234 3 size fixed bin init (0), 1235 3 fb2 (2) fixed bin init (0, 0), 1236 3 flags1 bit (36) init ("000000100100010001000000000000000000"b), 1237 3 flags2 bit (36) init (""b), 1238 3 seg fixed bin init (1000), 1239 3 off fixed bin, 1240 2 fill2 (7) fixed bin init (0, 0, 0, 0, 0, 0, 0); 1241 1242 dcl 1 bin_18_type19 static, 1243 2 header (4) fixed bin init (38, 0, 0, 19), 1244 2 verb fixed bin init (0), 1245 2 e fixed bin init (1), 1246 2 h fixed bin init (0), 1247 2 ij (2) fixed bin init (0, 0), 1248 2 abcdfgk bit (16) init ("0000000000000000"b); 1249 1250 1251 1252 1253 /**************************************************/ 1254 /* START OF EXECUTION */ 1255 /* numeric_compare */ 1256 /**************************************************/ 1257 1258 start_numeric_compare: /* Set pointers to the work buffers into which operands may be built by convert_to_dec procedure. */ 1259 out1_ptr = addr (buff1 (1)); 1260 out2_ptr = addr (buff2 (1)); 1261 1262 less_flag = 0; 1263 greater_flag = 0; 1264 equal_flag = 2; 1265 if rop_ptr -> data_name.type = 10 | rop_ptr -> data_name.type = 2 1266 | (rop_ptr -> data_name.type = 9 1267 & (rop_ptr -> data_name.bin_36 | (rop_ptr -> data_name.bin_18 & ^rop_ptr -> data_name.subscripted))) 1268 then do; 1269 if lop_ptr -> data_name.type = 10 | lop_ptr -> data_name.type = 2 1270 | (lop_ptr -> data_name.type = 9 1271 & (lop_ptr -> data_name.bin_36 1272 | (lop_ptr -> data_name.bin_18 & ^lop_ptr -> data_name.subscripted))) 1273 then do; 1274 1275 1276 if lop_ptr -> data_name.type = 10 1277 then do; 1278 temp_lop_ptr = addr (bin_36_lop); 1279 bin_36_lop.seg = lop_ptr -> index_name.seg_num; 1280 bin_36_lop.offset = lop_ptr -> index_name.offset + 4; 1281 lop_ptr = temp_lop_ptr; 1282 end; 1283 1284 1285 1286 if rop_ptr -> data_name.type = 10 1287 then do; 1288 temp_rop_ptr = addr (bin_36_rop); 1289 bin_36_rop.seg = rop_ptr -> index_name.seg_num; 1290 bin_36_rop.offset = rop_ptr -> index_name.offset + 4; 1291 rop_ptr = temp_rop_ptr; 1292 end; 1293 1294 if end_stmt.e = rwkey_greater 1295 then end_stmt.e = rwkey_less; 1296 else if end_stmt.e = rwkey_less 1297 then end_stmt.e = rwkey_greater; 1298 1299 1300 if lop_ptr -> data_name.type = 2 | rop_ptr -> data_name.type = 2 1301 then do; 1302 1303 call num_lit_comp (lop_ptr, rop_ptr, equal_flag, less_flag, greater_flag); 1304 1305 goto tra_label; 1306 end; 1307 1308 1309 1310 if rop_ptr -> data_name.bin_18 1311 then do; 1312 if (substr (unspec (rop_ptr -> data_name.offset), 35, 2) = "10"b) 1313 & (lop_ptr -> data_name.bin_18 1314 & substr (unspec (lop_ptr -> data_name.offset), 35, 2) = "10"b) 1315 then do; 1316 1317 call cobol_alloc$stack (4, 0, bin_18_type9.off); 1318 1319 move_bin_18.pt2 = rop_ptr; 1320 move_bin_18.pt3 = addr (bin_18_type9); 1321 move_bin_18.pt4 = addr (bin_18_type19); 1322 1323 call cobol_move_gen (addr (move_bin_18)); 1324 1325 1326 call comp6_proc (lop_ptr, addr (bin_18_type9)); 1327 1328 goto tra_label; 1329 end; 1330 1331 else if substr (unspec (rop_ptr -> data_name.offset), 35, 2) = "10"b 1332 | (substr (unspec (rop_ptr -> data_name.offset), 35, 2) = "00"b 1333 & lop_ptr -> data_name.bin_36) 1334 then do; 1335 temp_lop_ptr = lop_ptr; 1336 lop_ptr = rop_ptr; 1337 rop_ptr = temp_lop_ptr; 1338 if end_stmt.e = rwkey_greater 1339 then end_stmt.e = rwkey_less; 1340 else if end_stmt.e = rwkey_less 1341 then end_stmt.e = rwkey_greater; 1342 end; 1343 1344 end; 1345 1346 1347 call comp6_proc (lop_ptr, rop_ptr); 1348 1349 goto tra_label; 1350 end; 1351 1352 end; 1353 1354 1355 /* Base dataname token template on the left operand */ 1356 dn_ptr = lop_ptr; 1357 1358 if data_name.type ^= rtc_dataname /* Must be a literal or fig. const. ZERO or index anme */ 1359 | (data_name.type = rtc_dataname & data_name.usage_index) /* usage index item */ 1360 | (data_name.type = rtc_dataname & (data_name.bin_18 | data_name.bin_36)) /* fixed binary data type */ 1361 | (data_name.type = rtc_dataname & data_name.item_signed & ^data_name.sign_separate) 1362 /* overpunch sign */ 1363 then do; /* Left operand must be converted to decimal */ 1364 1365 call convert_to_dec (lop_ptr, out1_ptr); 1366 1367 lop_ptr = out1_ptr; 1368 end; /* Left operand must be converted to decimal */ 1369 1370 1371 /* Base dataname template on the right operand */ 1372 1373 dn_ptr = rop_ptr; 1374 1375 1376 if data_name.type ^= rtc_dataname /* Must be a literal or fig. const. ZERO or index anme */ 1377 | (data_name.type = rtc_dataname & data_name.usage_index) /* usage index item */ 1378 | (data_name.type = rtc_dataname & (data_name.bin_18 | data_name.bin_36)) /* fixed binary data type */ 1379 | (data_name.type = rtc_dataname & data_name.item_signed & ^data_name.sign_separate) 1380 /* overpunch sign */ 1381 then do; /* Right operand must be converted to decimal */ 1382 1383 call convert_to_dec (rop_ptr, out2_ptr); 1384 1385 rop_ptr = out2_ptr; 1386 end; /* Right operand must be converted to decimal */ 1387 1388 1389 /* Build the input structure to the addressability utility */ 1390 1391 input_struc.type = 5; /* eis, 2 operands */ 1392 input_struc.operand_no = 2; 1393 input_struc.lock = 0; 1394 input_struc.token_ptr (1) = lop_ptr; 1395 input_struc.send_receive (1) = 0; 1396 input_struc.size_sw (1) = 0; 1397 input_struc.token_ptr (2) = rop_ptr; 1398 input_struc.send_receive (2) = 0; 1399 input_struc.size_sw (2) = 0; 1400 1401 /* Call the addressability utility */ 1402 1403 call cobol_addr (input_ptr, inst_ptr, reloc_ptr); 1404 1405 1406 /* Insert the cmpn opcode into the instruction just built */ 1407 1408 eis_ptr = inst_ptr; 1409 eis_inst.opcode = cmpn_op; 1410 1411 /* Emit the cmpn instruction */ 1412 1413 call cobol_emit (eis_ptr, reloc_ptr, 3); 1414 1415 1416 tra_label: /* Determine the type of transfer instruction to be generated */ 1417 i_ptr = addr (end_stmt.i); 1418 1419 if equal_flag = 0 | (less_flag = 1 & end_stmt.e = rwkey_greater) | (greater_flag = 1 & end_stmt.e = rwkey_less) 1420 then topcode = tra_op; 1421 1422 else if equal_flag = 1 | (less_flag = 1 & end_stmt.e = rwkey_less) 1423 | (greater_flag = 1 & end_stmt.e = rwkey_greater) 1424 then topcode = nop_op; 1425 1426 else if end_stmt.e = rwkey_greater 1427 then do; /* GREATER OR NOT GREATER */ 1428 if ibit.not 1429 then topcode = tpl_op; /* not greater */ 1430 else topcode = tmi_op; /* GREATER */ 1431 end; /* GREATER OR NOT GREATER */ 1432 1433 1434 else if end_stmt.e = rwkey_less 1435 then do; /* LESS OR NOT LESS */ 1436 if ibit.not 1437 then topcode = tmoz_op; /* NOT LESS */ 1438 else topcode = tpnz_op; /* LESS */ 1439 end; /* LESS OR NOT LESS */ 1440 1441 1442 else if end_stmt.e = rwkey_equal 1443 then do; /* EQUAL OR NOT EQUAL */ 1444 if ibit.not 1445 then topcode = tnz_op; /* NOT EQUAL */ 1446 else topcode = tze_op; /* EQUAL */ 1447 end; /* EQUAL OR NOT EQUAL */ 1448 1449 1450 1451 else do; /* ASSUME UNEQUAL */ 1452 if ibit.not 1453 then topcode = tze_op; /* NOT UNEQUAL (EQUAL) */ 1454 else topcode = tnz_op; /* UNEQUAL */ 1455 end; /* ASSUME UNEQUAL */ 1456 1457 1458 1459 /* Build the transfer instruction */ 1460 1461 non_eis_word = "0"b; /* Zero the instruction word */ 1462 non_eis_ptr = addr (non_eis_word); 1463 non_eis_ptr -> eis_inst.opcode = topcode; 1464 1465 /* Save the offset in the text section at which the transfer is to be inserted */ 1466 save_locno = cobol_$text_wd_off; 1467 1468 /* Build the relocation bytes */ 1469 reloc_struc (1) = "0"b; 1470 reloc_struc (2) = "0"b; 1471 1472 /* Emit the transfer instruction */ 1473 1474 1475 call cobol_emit (non_eis_ptr, reloc_ptr, 1); 1476 1477 1478 /* Issue a reference to the tag in "end_stmt.h" */ 1479 1480 1481 call cobol_make_tagref (fixed (end_stmt.h, 17), save_locno, null ()); 1482 1483 1484 exit_numeric_compare: 1485 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_End(nc);/**/ 1486 return; 1487 end numeric_compare; 1488 1489 /*{*/ 1490 1491 convert_to_dec: 1492 proc (input_op_ptr, output_op_ptr); 1493 1494 /* This procedure converts a non_numeric operand to a numeric 1495*operand. For the Release 1.5 of Multics Cobol, only the following 1496*operands are converted: 1497* 1498* 1. Numeric literal (type 2 token) 1499* 2. Figurative constant ZERO (type 1 token, reserved 1500* word key = 180 ) 1501* 3. Index name (type 10 token) 1502* 4. Index data item (type 9 token, usage index bit on) 1503* 1504* 5. Fixed binary data items (type 9 tokens, bin_18 or bin_36 bits on) 1505* 1506* 6. Overpunch sign data (type 9 token, sign_separate off item_signed on) 1507* 1508* 1509**/ 1510 1511 /* DECLARATION OF THE PARAMETERS */ 1512 1513 dcl input_op_ptr ptr; 1514 dcl output_op_ptr ptr; 1515 1516 /* 1517* input_op_ptr Points to the operand for which a numeric operand 1518* (type 9) is to be constructed. (input) 1519* 1520*output_op_ptr Points to a buffer in which the numeric 1521* operand (type 9) is constructed. (input) 1522* 1523* If input_op_ptr points to the figurative constant 1524* ZERO, then output_op_ptr will point to a numeric 1525* operand (type 9) created for zero on output. 1526* The type 9 will not be moved to the buffer 1527* supplied by the user. 1528* 1529**/ 1530 1531 /*}*/ 1532 1533 dcl descrip_ptr ptr; 1534 dcl descrip bit (72) based (descrip_ptr); 1535 1536 /**************************************************/ 1537 /* START OF EXECUTION */ 1538 /* convert_to_dec */ 1539 /**************************************************/ 1540 1541 start_convert_to_dec: 1542 dn_ptr = input_op_ptr; /* Base dataname template on the input operand image */ 1543 1544 if data_name.type = rtc_numlit /* Numeric literal */ 1545 then call cobol_make_type9$type2_3 (output_op_ptr, input_op_ptr); 1546 1547 1548 else if data_name.type = rtc_resword 1549 then do; /* ASSUME ZERO */ 1550 1551 if zero_allocated ^= cobol_$compile_count 1552 then do; /* Allocate numeric zero */ 1553 type9_zero_ptr = addr (type9_zero (1)); 1554 1555 call cobol_make_type9$type2_3 (type9_zero_ptr, addr (numeric_zero)); 1556 1557 zero_allocated = cobol_$compile_count; 1558 end; /* Allocate numeric zero */ 1559 1560 1561 output_op_ptr = type9_zero_ptr; 1562 end; /* ASSUME ZERO */ 1563 1564 else if (data_name.type = rtc_indexname | data_name.usage_index) 1565 then call cobol_get_index_value (2, input_op_ptr, output_op_ptr); 1566 /* Assume an index name */ 1567 1568 1569 else /* Assume fixed binary data item or overpunch sign data item. */ 1570 call cobol_num_to_udts (input_op_ptr, output_op_ptr); 1571 1572 1573 exit_convert_to_dec: 1574 return; 1575 end convert_to_dec; 1576 1577 /* ******************** */ 1578 comp6_proc: 1579 proc (lop_ptr, rop_ptr); 1580 1581 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_Beg(c6);/**/ 1582 1583 /* This procedure is used to generate non-eis instructions for the comparison 1584* of comp-6 and/or comp-7 data. */ 1585 /* load long or short bin */ 1586 dcl lop_ptr ptr, 1587 rop_ptr ptr; /* eaa 0,xn 1588* ars 18 */ 1589 dcl eaa_buff (2) bit (36) static 1590 init ("000000000000000000110011101000000000"b, "000000000000010010111011001000000000"b); 1591 dcl inst_code fixed bin static init (1); 1592 dcl inst_op (5) bit (10) static init ("0100111010"b, 1593 /* lda */ 1594 "0100100000"b, /* ldxn*/ 1595 "1110100000"b, /* lxln*/ 1596 "0010011010"b, /* cmpa */ 1597 "0010000000"b); /* cmpx */ 1598 /* The followings are for the register structure */ 1599 /* reg_struc_ptr is a pointer to the following structure (input) */ 1600 1601 dcl 1 reg_struc static, 1602 2 what_reg fixed bin, 1603 2 reg_num bit (4), 1604 2 lock fixed bin init (1), 1605 2 already_there fixed bin, 1606 2 contains fixed bin, 1607 2 pointer ptr, 1608 2 literal bit (36); 1609 1610 start_comp6_proc: 1611 input_struc.type = 2; 1612 input_struc.operand_no = 1; 1613 input_struc.lock = 0; 1614 input_struc.token_ptr (1) = lop_ptr; 1615 input_struc.size_sw (1) = 0; 1616 1617 1618 if lop_ptr -> data_name.bin_36 1619 then do; 1620 reg_struc.what_reg = 1; 1621 inst_code = 1; 1622 end; 1623 1624 1625 else do; 1626 reg_struc.what_reg = 14; 1627 if substr (unspec (lop_ptr -> data_name.offset), 35, 2) = "10"b 1628 then inst_code = 3; 1629 else inst_code = 2; 1630 end; 1631 1632 1633 call cobol_addr (input_ptr, inst_ptr, reloc_ptr); 1634 1635 1636 call cobol_register$load (addr (reg_struc)); 1637 1638 inst_struc.fill1_op = inst_op (inst_code); 1639 if inst_code ^= 1 1640 then substr (inst_struc.fill1_op, 7, 3) = substr (reg_struc.reg_num, 2, 3); 1641 1642 call cobol_emit (inst_ptr, reloc_ptr, 1); 1643 1644 input_struc.type = 2; 1645 input_struc.operand_no = 1; 1646 input_struc.lock = 0; 1647 input_struc.token_ptr (1) = rop_ptr; 1648 input_struc.size_sw (1) = 0; 1649 1650 1651 if rop_ptr -> data_name.bin_36 1652 then do; 1653 1654 1655 if inst_code ^= 1 1656 then do; 1657 substr (eaa_buff (1), 33, 4) = reg_struc.reg_num; 1658 1659 call cobol_emit (addr (eaa_buff (1)), null, 2); 1660 1661 end; 1662 1663 inst_code = 4; 1664 end; 1665 1666 else inst_code = 5; 1667 inst_struc.fill1_op = inst_op (inst_code); 1668 if inst_code ^= 4 1669 then substr (inst_struc.fill1_op, 7, 3) = substr (reg_struc.reg_num, 2, 3); 1670 1671 call cobol_addr (input_ptr, inst_ptr, reloc_ptr); 1672 1673 1674 call cobol_emit (inst_ptr, reloc_ptr, 1); 1675 1676 1677 call cobol_register$release (addr (reg_struc)); 1678 1679 exit_comp6_proc: 1680 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_End(c6);/**/ 1681 return; 1682 end comp6_proc; 1683 1684 num_lit_comp: 1685 proc (lop_ptr, rop_ptr, equal_flag, less_flag, greater_flag); 1686 1687 /* This procedure is used to set the comparison for 1688* numerical literal in one or both operands. */ 1689 1690 dcl lop_ptr ptr, 1691 rop_ptr ptr, 1692 temp_lop_ptr ptr, 1693 temp_token_ptr ptr, 1694 temp fixed bin, 1695 in_op fixed bin, 1696 l_win fixed bin, 1697 ic_flag fixed bin, 1698 nonzero_pr fixed bin, 1699 (i, j, k) fixed bin; 1700 dcl (equal_flag, less_flag, greater_flag) 1701 fixed bin; 1702 dcl bin_36_buff char (120); 1703 dcl inst_code fixed bin static init (1); 1704 dcl inst_op (4) bit (10) static init ("0100111010"b, 1705 /* lda */ 1706 "0100100000"b, /* ldxn*/ 1707 "1110100000"b, /* lxln*/ 1708 "0010011010"b); /* cmpa */ 1709 dcl compare_inst (2) bit (36) static init ("000000000000000000001001101000000111"b, 1710 /* cmpa n,dl */ 1711 "000000000000000000001000000000000011"b); 1712 /* cmpxn n,du */ 1713 /* The followings are for the register structure */ 1714 /* reg_struc_ptr is a pointer to the following structure (input) */ 1715 1716 dcl 1 reg_struc static, 1717 2 what_reg fixed bin, 1718 2 reg_num bit (4), 1719 2 lock fixed bin init (1), 1720 2 already_there fixed bin, 1721 2 contains fixed bin, 1722 2 pointer ptr, 1723 2 literal bit (36); 1724 1725 1726 /* DECLARATION OF INTERNAL STATIC DATA */ 1727 1728 dcl smallest_long_binary 1729 fixed dec (11, 0) init (-32359738368); 1730 dcl largest_long_binary fixed dec (11, 0) init (32359738357); 1731 dcl smallest_short_binary 1732 fixed dec (6, 0) int static init (-131072); 1733 dcl largest_short_binary 1734 fixed dec (6, 0) int static init (131071); 1735 dcl ZERO char (32) static init ((32)"0"); 1736 1737 1738 /* DECLARATION OF INTERNAL VARIABLES */ 1739 1740 dcl work_fdec fixed dec (19, 0); 1741 dcl work_fdec_string char (20) based (work_fdec_ptr); 1742 dcl work_fdec_ptr ptr; 1743 dcl (LP, RP) ptr; 1744 1745 dcl (LS, RS, LPL, RPL, SI, SO, SF) 1746 fixed bin; 1747 dcl ret_offset fixed bin; 1748 dcl long_bin_const fixed bin (35); 1749 dcl long_bin_ptr ptr; 1750 dcl long_bin_string char (4) based (long_bin_ptr); 1751 1752 start_num_lit_comp: 1753 ic_flag = 0; 1754 greater_flag = 0; 1755 less_flag = 0; 1756 equal_flag = 2; 1757 1758 1759 if lop_ptr -> data_name.type = 2 1760 then do; 1761 temp_lop_ptr = lop_ptr; 1762 lop_ptr = rop_ptr; 1763 rop_ptr = temp_lop_ptr; 1764 if end_stmt.e = rwkey_greater 1765 then end_stmt.e = rwkey_less; 1766 else if end_stmt.e = rwkey_less 1767 then end_stmt.e = rwkey_greater; 1768 1769 1770 if lop_ptr -> data_name.type = 2 1771 then do; /*[4.2-2]*/ 1772 equal_flag = 0; 1773 if lop_ptr -> numeric_lit.sign = "-" | rop_ptr -> numeric_lit.sign = "-" 1774 then if lop_ptr -> numeric_lit.sign ^= rop_ptr -> numeric_lit.sign 1775 then do; /*[4.2-2]*/ 1776 equal_flag = 1; 1777 return; 1778 end; 1779 1780 1781 1782 /*[4.2-2]*/ 1783 if lop_ptr -> numeric_lit.places_left >= rop_ptr -> numeric_lit.places_left 1784 /*[4.2-2]*/ 1785 then do; 1786 LP = lop_ptr; /* L precedes R */ 1787 /*[4.2-2]*/ 1788 RP = rop_ptr; /*[4.2-2]*/ 1789 end; /*[4.2-2]*/ 1790 else do; 1791 LP = rop_ptr; /*[4.2-2]*/ 1792 RP = lop_ptr; /*[4.2-2]*/ 1793 end; 1794 1795 /*[4.2-2]*/ 1796 LS = LP -> numeric_lit.places;/* L size */ 1797 /*[4.2-2]*/ 1798 RS = RP -> numeric_lit.places;/* R size */ 1799 1800 /*[4.2-2]*/ 1801 LPL = LP -> numeric_lit.places_left; 1802 /* L places left */ 1803 /*[4.2-2]*/ 1804 RPL = RP -> numeric_lit.places_left; 1805 /* R places left */ 1806 1807 /*[4.2-2]*/ 1808 SI = LPL - RPL; /* initial size */ 1809 1810 /*[4.2-2]*/ 1811 if SI ^= 0 /*[4.2-2]*/ 1812 then if substr (LP -> numeric_lit.literal, 1, SI) ^= ZERO 1813 /*[4.2-2]*/ 1814 then do; 1815 equal_flag = 1;/* initial string ^= 0 */ 1816 /*[4.2-2]*/ 1817 return; /*[4.2-2]*/ 1818 end; 1819 1820 /*[4.2-2]*/ 1821 SO = min (LS - SI, RS); /* overlap size */ 1822 1823 /*[4.2-2]*/ 1824 if SO = 0 /*[4.2-2]*/ 1825 then if substr (RP -> numeric_lit.literal, 1, RS) ^= ZERO 1826 /*[4.2-2]*/ 1827 then do; 1828 equal_flag = 1;/* final string ^= 0 */ 1829 /*[4.2-2]*/ 1830 return; /*[4.2-2]*/ 1831 end; /*[4.2-2]*/ 1832 else return; /* no overlap, both 0 */ 1833 1834 /*[4.2-2]*/ 1835 if substr (LP -> numeric_lit.literal, SI + 1, SO) 1836 ^= substr (RP -> numeric_lit.literal, 1, SO) 1837 /*[4.2-2]*/ 1838 then do; 1839 equal_flag = 1; /* overlapping strings not equal */ 1840 /*[4.2-2]*/ 1841 return; /*[4.2-2]*/ 1842 end; 1843 1844 /*[4.2-2]*/ 1845 if SO = RS /*[4.2-2]*/ 1846 then if SI + SO = LS /* L extends beyond R */ 1847 /*[4.2-2]*/ 1848 then return; /*[4.2-2]*/ 1849 else if substr (LP -> numeric_lit.literal, SI + SO + 1, LS - SI - SO) ^= ZERO 1850 /*[4.2-2]*/ 1851 then do; 1852 equal_flag = 1;/* final string ^= 0 */ 1853 /*[4.2-2]*/ 1854 return; /*[4.2-2]*/ 1855 end; /*[4.2-2]*/ 1856 else return; /*[4.2-2]*/ 1857 else if substr (RP -> numeric_lit.literal, SO + 1, RS - SO) ^= ZERO 1858 /*[4.2-2]*/ 1859 then do; 1860 equal_flag = 1; /* final string ^= 0 */ 1861 /*[4.2-2]*/ 1862 return; /*[4.2-2]*/ 1863 end; /*[4.2-2]*/ 1864 else return; 1865 end; 1866 1867 end; 1868 1869 nonzero_pr = 0; 1870 if rop_ptr -> numeric_lit.places_right ^= 0 1871 then do k = 1 to rop_ptr -> numeric_lit.places_right while (nonzero_pr = 0); 1872 /*[4.2-2]*/ 1873 if substr (rop_ptr -> numeric_lit.literal, k + rop_ptr -> numeric_lit.places_left, 1) ^= "0" 1874 then nonzero_pr = 1; 1875 end; 1876 1877 work_fdec = 0; 1878 work_fdec_ptr = addr (work_fdec); 1879 if rop_ptr -> numeric_lit.sign = "-" 1880 then substr (work_fdec_string, 1, 1) = "-"; 1881 else substr (work_fdec_string, 1, 1) = "+"; 1882 substr (work_fdec_string, 21 - rop_ptr -> numeric_lit.places_left, rop_ptr -> numeric_lit.places_left) = 1883 substr (rop_ptr -> numeric_lit.literal, 1, rop_ptr -> numeric_lit.places_left); 1884 1885 1886 if nonzero_pr = 1 1887 then do; 1888 1889 1890 if end_stmt.e = rwkey_equal 1891 then do; 1892 if ibit.not 1893 then equal_flag = 1; 1894 else equal_flag = 0; 1895 return; 1896 end; 1897 1898 1899 1900 if ibit.not 1901 then do; 1902 ibit.not = "0"b; 1903 if end_stmt.e = rwkey_greater 1904 then end_stmt.e = rwkey_less; 1905 else end_stmt.e = rwkey_greater; 1906 end; 1907 1908 if end_stmt.e = rwkey_greater 1909 then if rop_ptr -> numeric_lit.sign = "-" 1910 then work_fdec = work_fdec - 1; 1911 else work_fdec = work_fdec + 1; 1912 end; 1913 1914 1915 1916 if lop_ptr -> data_name.bin_36 1917 then do; 1918 if work_fdec > largest_long_binary 1919 then less_flag = 1; 1920 else if work_fdec < smallest_long_binary 1921 then greater_flag = 1; /*[4.2-1]*/ 1922 else if work_fdec > largest_short_binary | substr (work_fdec_string, 1, 1) = "-" 1923 then ic_flag = 1; 1924 end; 1925 1926 1927 else do; 1928 if work_fdec > largest_short_binary 1929 then less_flag = 1; 1930 else if work_fdec < smallest_short_binary 1931 then greater_flag = 1; 1932 end; 1933 1934 if less_flag = 1 | greater_flag = 1 1935 then return; 1936 long_bin_const = binary (work_fdec); 1937 input_struc.type = 2; 1938 input_struc.operand_no = 1; 1939 input_struc.lock = 0; 1940 input_struc.token_ptr (1) = lop_ptr; 1941 input_struc.size_sw (1) = 0; 1942 1943 1944 if lop_ptr -> data_name.bin_36 1945 then do; 1946 reg_struc.what_reg = 1; 1947 inst_code = 1; 1948 end; 1949 1950 1951 else do; 1952 reg_struc.what_reg = 14; 1953 if substr (unspec (lop_ptr -> data_name.offset), 35, 2) = "10"b 1954 then inst_code = 3; 1955 else inst_code = 2; 1956 end; 1957 1958 1959 call cobol_addr (input_ptr, inst_ptr, reloc_ptr); 1960 1961 1962 call cobol_register$load (addr (reg_struc)); 1963 1964 inst_struc.fill1_op = inst_op (inst_code); 1965 if inst_code ^= 1 1966 then substr (inst_struc.fill1_op, 7, 3) = substr (reg_struc.reg_num, 2, 3); 1967 1968 call cobol_emit (inst_ptr, reloc_ptr, 1); 1969 1970 1971 1972 if ic_flag = 1 1973 then do; 1974 long_bin_ptr = addr (long_bin_const); 1975 1976 call cobol_pool$search_op (long_bin_string, 0, ret_offset, in_op); 1977 1978 if in_op = 1 1979 then temp = 3; 1980 else temp = 3000; 1981 temp_token_ptr = addr (bin_36_buff); 1982 1983 call cobol_make_type9$long_bin (temp_token_ptr, temp, ret_offset); 1984 1985 input_struc.type = 2; 1986 input_struc.operand_no = 1; 1987 input_struc.lock = 0; 1988 input_struc.token_ptr (1) = temp_token_ptr; 1989 input_struc.size_sw (1) = 0; 1990 1991 call cobol_addr (input_ptr, inst_ptr, reloc_ptr); 1992 1993 inst_struc.fill1_op = inst_op (4); 1994 1995 call cobol_emit (inst_ptr, reloc_ptr, 1); 1996 1997 end; 1998 1999 2000 else do; 2001 2002 2003 if inst_code ^= 1 2004 then do; 2005 inst_code = 2; 2006 substr (compare_inst (inst_code), 25, 3) = substr (reg_struc.reg_num, 2, 3); 2007 end; 2008 2009 substr (compare_inst (inst_code), 1, 18) = substr (unspec (long_bin_const), 19, 18); 2010 2011 call cobol_emit (addr (compare_inst (inst_code)), null, 1); 2012 2013 end; 2014 2015 2016 call cobol_register$release (addr (reg_struc)); 2017 2018 return; 2019 2020 exit_num_lit_comp: 2021 return; 2022 end num_lit_comp; 2023 2024 /*{*/ 2025 alpha_compare: 2026 proc (lop_ptr, rop_ptr); 2027 2028 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_Beg(ac);/**/ 2029 2030 /* 2031*This procedure generates code for an alphanumeric comparison. 2032**/ 2033 2034 /* DECLARATION OF THE PARAMETERS */ 2035 2036 dcl lop_ptr ptr; 2037 dcl rop_ptr ptr; 2038 2039 /* 2040*lop_ptr Points to the left operand of the alphanumeric 2041* comparison. (input) 2042*rop_ptr Points to the right operand of the alphanumeric 2043* comparison. (input) 2044**/ 2045 2046 /*}*/ 2047 2048 /* Work buffers in which the convert_to_alpha procedure can build 2049*dataname (type 9) operands */ 2050 2051 dcl wkbuff1 (1:40) fixed bin; 2052 dcl wkbuff2 (1:40) fixed bin; 2053 dcl wkbuff1_ptr ptr; 2054 dcl wkbuff2_ptr ptr; 2055 2056 /* Work buffers in which dataname (type 9) operands are built if code is 2057* 2058*to be generated to convert from ASCII to EBCDIC */ 2059 2060 dcl wkbuff3 (1:40) fixed bin; 2061 2062 dcl wkbuff4 (1:40) fixed bin; 2063 dcl wkbuff3_ptr ptr; 2064 dcl wkbuff4_ptr ptr; 2065 2066 /* Variables in which the CMPC filler character and filler 2067*hierarchy are saved. */ 2068 2069 dcl cmpc_filler char (1); 2070 dcl filler_hier fixed bin; 2071 2072 /* Work variables */ 2073 2074 dcl temp_cmpc_filler char (1); 2075 dcl temp_filler_hier fixed bin; 2076 dcl temp_op_ptr ptr; 2077 2078 2079 /**************************************************/ 2080 /* START OF EXECUTION */ 2081 /* alpha_compare */ 2082 /**************************************************/ 2083 2084 start_alpha_compare: 2085 cmpc_filler = " "; 2086 filler_hier = 0; 2087 2088 /* Check to see if the left operand needs conversion */ 2089 2090 dn_ptr = lop_ptr; 2091 if (data_name.type ^= rtc_dataname 2092 | (^data_name.alphanum & ^data_name.alphanum_edited 2093 & ^data_name.numeric_edited /* NUMERIC EDITED IS ALPHANUMERIC!! */ & ^data_name.alphabetic 2094 & ^data_name.alphabetic_edited)) 2095 then do; /* Left operand needs conversion to alphanumeric data name */ 2096 wkbuff1_ptr = addr (wkbuff1 (1)); 2097 2098 call convert_to_alpha (lop_ptr, rop_ptr, wkbuff1_ptr, temp_cmpc_filler, temp_filler_hier); 2099 2100 lop_ptr = wkbuff1_ptr; 2101 if temp_filler_hier > filler_hier 2102 then do; /* Filler character returned must be used in the cmpc instruction */ 2103 2104 cmpc_filler = temp_cmpc_filler; 2105 filler_hier = temp_filler_hier; 2106 end; /* Filler character returned must be used in the cmpc instruction */ 2107 2108 2109 end; /* Left operand needs conversson to alphanumeric data name */ 2110 2111 2112 /* Check to see if the right operand needs conversion */ 2113 2114 dn_ptr = rop_ptr; 2115 2116 if (data_name.type ^= rtc_dataname 2117 | (^data_name.alphanum & ^data_name.alphanum_edited 2118 & ^data_name.numeric_edited /* NUMERIC EDITED IS ALPHANUMERIC!! */ & ^data_name.alphabetic 2119 & ^data_name.alphabetic_edited)) 2120 then do; /* Right operand needs conversion to alphanumeric data name */ 2121 wkbuff2_ptr = addr (wkbuff2 (1)); 2122 2123 call convert_to_alpha (rop_ptr, lop_ptr, wkbuff2_ptr, temp_cmpc_filler, temp_filler_hier); 2124 2125 rop_ptr = wkbuff2_ptr; 2126 if temp_filler_hier > filler_hier 2127 then do; /* Filler character returned must be used in the cmpc instruction */ 2128 2129 cmpc_filler = temp_cmpc_filler; 2130 filler_hier = temp_filler_hier; 2131 end; /* Filler character returned must be used in the cmpc instruction */ 2132 2133 2134 end; /* Right operand needs conversion to alphanumeric data name */ 2135 2136 /* Determine the type of transfer instruction to be generated following the compare 2137* ( and reverse operands if necessary) */ 2138 2139 /* Base EOS template on the EOS tokee */ 2140 2141 eos_ptr = in_token.token_ptr (in_token.n); 2142 i_ptr = addr (end_stmt.i); 2143 if end_stmt.e = rwkey_greater 2144 then do; /* GREATER OR NOT GREATER */ 2145 2146 /* REVERSE OPERANDS FOR THESE TWO RELATIONAL OPERATORS */ 2147 temp_op_ptr = lop_ptr; 2148 lop_ptr = rop_ptr; 2149 rop_ptr = temp_op_ptr; 2150 2151 if ibit.not 2152 then topcode = trc_op; /* NOT GREATER */ 2153 else topcode = tnc_op; /* GREATER */ 2154 end; /* GREATER OR NOT GREATER */ 2155 2156 2157 else if end_stmt.e = rwkey_less 2158 then do; /* LESS OR NOT LESS */ 2159 2160 if ibit.not 2161 then topcode = trc_op; /* NOT LESS */ 2162 else topcode = tnc_op; /* LESS */ 2163 end; /* LESS OR NOT LESS */ 2164 2165 2166 else if end_stmt.e = rwkey_equal 2167 then do; /* EQUAL OR NOT EQUAL */ 2168 2169 if ibit.not 2170 then topcode = tnz_op; /* NOT EQUAL */ 2171 else topcode = tze_op; /* EQUAL */ 2172 end; /* EQUAL OR NOT EQUAL */ 2173 2174 2175 2176 else do; /* ASSUME UNEQUAL */ 2177 if ibit.not 2178 then topcode = tze_op; /* NOT UNEQUAL (EQUAL) */ 2179 else topcode = tnz_op; /* UNEQUAL */ 2180 2181 end; /* ASSUUME UNEQUAL */ 2182 2183 2184 2185 /* HERE, TEST COLLATING SEQUENCE BY LOOKING AT FIXED COMMON, AND IF NECESSARY, 2186* GENERATE CODE TO CONVERT ASCII OPERANDS TO EBCDIE, PRIOR TO ESTABLISHINg 2187* addressability. also, THE FILLER CHAR MUST BE CONVERTED FROM ASCII TO EBCDIC. */ 2188 2189 if cobol_$main_pcs_ptr ^= null () | sort_pcs_ptr ^= null () 2190 /* alphabet name */ 2191 then call cobol_trans_alphabet (lop_ptr, rop_ptr, 0, 0, sort_pcs_ptr, cmpc_filler); 2192 2193 2194 /* ESTABLISH ADDRESSABILITY TO THE TWO OPERANDS */ 2195 2196 /* Build the input structure to the addressability utility */ 2197 2198 input_struc.type = 5; /* eis, 2 operands */ 2199 input_struc.operand_no = 2; 2200 input_struc.lock = 0; /* no locks */ 2201 2202 input_struc.token_ptr (1) = lop_ptr; 2203 input_struc.send_receive (1) = 0; 2204 input_struc.size_sw (1) = 0; 2205 input_struc.token_ptr (2) = rop_ptr; 2206 input_struc.send_receive (2) = 0; 2207 input_struc.size_sw (2) = 0; 2208 2209 /* Call the addressabiliyt utility */ 2210 2211 2212 call cobol_addr (input_ptr, inst_ptr, reloc_ptr); 2213 2214 2215 /* Insert the cmpc opcode into the instruction */ 2216 2217 eis_ptr = inst_ptr; 2218 eis_inst.opcode = cmpc_op; 2219 2220 /* Insert the filler character into the instruction */ 2221 2222 substr (eis_inst.unused, 1, 9) = unspec (cmpc_filler); 2223 2224 /* Emit the cmpc instruction */ 2225 2226 call cobol_emit (eis_ptr, reloc_ptr, 3); 2227 2228 2229 /* Build the transfer instruction */ 2230 non_eis_word = "0"b; 2231 non_eis_ptr = addr (non_eis_word); 2232 non_eis_ptr -> eis_inst.opcode = topcode; 2233 2234 /* Save the offset in the text section at which the transfer is to be emitted */ 2235 2236 save_locno = cobol_$text_wd_off; 2237 2238 /* Build the relocation bytes */ 2239 reloc_struc (1) = "0"b; 2240 reloc_struc (2) = "0"b; 2241 2242 /* Emit the transfer instruction */ 2243 2244 call cobol_emit (non_eis_ptr, reloc_ptr, 1); 2245 2246 2247 /* Issue a reference to the tag in "end_stmt.h" */ 2248 2249 call cobol_make_tagref (fixed (end_stmt.h, 17), save_locno, null ()); 2250 2251 exit_alpha_compare: 2252 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_End(ac);/**/ 2253 return; 2254 2255 end alpha_compare; 2256 2257 /*{*/ 2258 convert_to_alpha: 2259 proc (operand_ptr, other_operand_ptr, output_operand_ptr, eis_filler, filler_hier); 2260 2261 /* 2262*This procedure converts an operand that is not an alphanumeric data 2263* 2264*name to an alphanumeric data name operand. For the first release of 2265*Multics Cobol, the following types of operands are converted: 2266* 1. alphanumeric literal (type 3 token) 2267* 2. figurative constants (type 1 token) 2268* 3. numeric literal (type 2 token) 2269* 4. numeric data name (type 9 token) 2270* 5. figurative constants of the form ALL "string" (type 3 token) 2271* 2272**/ 2273 2274 /* DECLARATION OF THE PARAMETERS */ 2275 dcl operand_ptr ptr; 2276 dcl other_operand_ptr ptr; 2277 dcl output_operand_ptr ptr; 2278 dcl eis_filler char (1); 2279 dcl filler_hier fixed bin; 2280 2281 /* 2282*operand_ptr Pointer to the operand to be converted. (input) 2283*other_operadn_ptr Pointer to the other operand (other than that 2284* pointed to by operand_ptr) in the alphanumeric 2285* compare. (input) 2286*output_operand_ptr Pointer to the user supplied buffer in which this 2287* procedure builds a token (type 9) for the output 2288* operand. (input) 2289*eis_filler One character that is to be inserted into the 2290* "fill" filed of the CMPC instruction. (output) 2291*filler_hier A code that indicates the "hierarchy" of the fill 2292* character returned by this procedurue. The 2293* hierarchy value is equal to 1 for the following 2294* input operands: 2295* a. Figurative constants ZERO, SPACE, 2296* QUOTE,HIGH-VALUE, and LOW-VALUE. 2297* 2298* b. Figurative constants of the form 2299* ALL "X". (i.e. only one character 2300* is specified in the literal string) 2301* 2302* The hierarchy value returned is 0 for all 2303* other input operands. 2304* 2305**/ 2306 2307 /*}*/ 2308 2309 2310 2311 /* Definition of input structure to the move generator */ 2312 2313 dcl 1 move_token, 2314 2 n fixed bin, 2315 2 code fixed bin, 2316 2 token_ptr (1:5) ptr; 2317 2318 /* Temporary work buffers */ 2319 2320 dcl eos_buff (1:10) fixed bin; 2321 2322 dcl wkbuff1 (1:40) fixed bin; 2323 dcl alit_buffer (1:40) fixed bin; 2324 dcl temp_type9_token (1:40) fixed bin; 2325 2326 /* Variables required to access the description bits of a data name token */ 2327 2328 dcl descrip_ptr ptr; 2329 dcl descrip bit (72) based (descrip_ptr); 2330 2331 /* Other work variables */ 2332 2333 dcl s_length fixed bin; 2334 dcl s_offset fixed bin; 2335 dcl t_key fixed bin; 2336 dcl temp9_ptr ptr; 2337 2338 dcl dn_buff (1:40) fixed bin based (output_operand_ptr); 2339 dcl ix fixed bin; 2340 2341 dcl changed_descrip_bits 2342 bit (1); 2343 dcl save_dn_ptr ptr; 2344 2345 /*************************************************/ 2346 /* START OF EXECUTION */ 2347 /* convert_to_alpha */ 2348 /**************************************************/ 2349 2350 2351 start_convert_to_alpha: 2352 dn_ptr = operand_ptr; 2353 eis_filler = eis_fill_def.space; 2354 filler_hier = 0; 2355 changed_descrip_bits = "0"b; 2356 2357 if data_name.type = rtc_alphalit 2358 then do; /* Input operand is an alphanumeric literal */ 2359 2360 alit_ptr = operand_ptr; 2361 if ^alphanum_lit.all_lit 2362 then call cobol_make_type9$type2_3 (output_operand_ptr, operand_ptr); 2363 /* Not al "ALL" literal */ 2364 2365 2366 2367 else do; /* An "ALL" literal */ 2368 2369 if alphanum_lit.lit_size = 1 2370 then do; /* form is ALL "X" */ 2371 2372 /* Build a data name token (type 9) */ 2373 2374 2375 call cobol_make_type9$type2_3 (output_operand_ptr, operand_ptr); 2376 2377 2378 2379 /* Set the eis fill character */ 2380 2381 eis_filler = alphanum_lit.string; 2382 filler_hier = 1; 2383 2384 end; /* form is ALL "X" */ 2385 2386 2387 2388 else do; /* form is ALL "XYZ..." */ 2389 2390 /* Determine the length of the other operand in the comparison */ 2391 2392 /* Here we assume that the other operand is a dataname (type 9), 2393* 2394* either numeric or alphanumeric. Must also handle index name (type 10) later */ 2395 2396 s_length = other_operand_ptr -> data_name.item_length; 2397 if other_operand_ptr -> data_name.sign_separate 2398 then s_length = s_length - 1; 2399 2400 /* Allocate space on the run-time stack equal to the length of the 2401* other operand */ 2402 2403 2404 call cobol_alloc$stack (s_length, 0, s_offset); 2405 2406 2407 /* Build a data name token that describes the stack entry just allocated */ 2408 2409 dn_ptr = output_operand_ptr; 2410 /* Initialize the buffer to zeroes. */ 2411 2412 do ix = 1 to 40; 2413 dn_buff (ix) = 0; 2414 end; 2415 2416 2417 data_name.seg_num = 1000; 2418 /* run-time stack */ 2419 data_name.offset = s_offset; 2420 2421 2422 2423 2424 data_name.type = rtc_dataname; 2425 descrip_ptr = addr (data_name.file_section); 2426 descrip = "0"b; 2427 2428 data_name.elementary = "1"b; 2429 data_name.alphanum = "1"b; 2430 data_name.display = "1"b; 2431 2432 data_name.item_length = s_length; 2433 data_name.places_left = s_length; 2434 data_name.places_right = 0; 2435 2436 /* Generate code to move the figurative constant to the stack */ 2437 2438 move_token.n = 4; 2439 move_token.token_ptr (1) = null (); 2440 move_token.token_ptr (2) = operand_ptr; 2441 /* Sending */ 2442 move_token.token_ptr (3) = output_operand_ptr; 2443 /* Receiving */ 2444 move_token.token_ptr (4) = addr (eos_buff (1)); 2445 2446 move_token.token_ptr (4) -> end_stmt.verb = 18; 2447 /* MOVE */ 2448 move_token.token_ptr (4) -> end_stmt.e = 1; 2449 /* One operand to move. */ 2450 2451 call cobol_move_gen (addr (move_token)); 2452 2453 2454 end; /* Form is ALL "XYZ..." */ 2455 2456 end; /* AN "ALL" LITERAL */ 2457 2458 2459 end; /* Input operand is an alphanumeric literal */ 2460 2461 2462 else if (data_name.type = rtc_dataname | data_name.type = rtc_numlit | data_name.type = rtc_indexname) 2463 then do; /* Input operand is a dataname (type 9) or numeric literal (type 2) */ 2464 /* or index name (type 10) */ 2465 2466 if data_name.type = rtc_numlit 2467 then do; /* A numeric literal */ 2468 /* Pool the literal and build a type 9 */ 2469 temp9_ptr = addr (wkbuff1 (1)); 2470 2471 call cobol_make_type9$type2_3 (temp9_ptr, operand_ptr); 2472 2473 operand_ptr = temp9_ptr; 2474 dn_ptr = temp9_ptr; 2475 end; /* a numeric literal */ 2476 2477 if (data_name.type = rtc_dataname & data_name.usage_index) | data_name.type = rtc_indexname 2478 then do; /* index data item (type 9) token or index name (type 10) token */ 2479 2480 /* Generate code to convert the index value from a 2 byte fixed bin 2481* to a decimal */ 2482 2483 2484 call cobol_get_index_value (2, operand_ptr, addr (temp_type9_token (1))); 2485 2486 operand_ptr = addr (temp_type9_token (1)); 2487 s_length = 6; /* Maximum number of decimal digits. */ 2488 2489 end; /* Index data item (type 9) token or index name (type 10) token */ 2490 2491 2492 2493 if (data_name.type ^= rtc_indexname & data_name.sign_separate) 2494 then s_length = data_name.item_length - 1; 2495 else s_length = data_name.item_length; 2496 if data_name.bin_18 = "1"b 2497 then s_length = 6; 2498 else if data_name.bin_36 = "1"b 2499 then s_length = 11; 2500 else if data_name.ascii_packed_dec = "1"b 2501 then s_length = data_name.places_right + data_name.places_left; 2502 2503 /* Allocate space in the run time stack to hold the alphanumeric 2504* representation of the numeric */ 2505 2506 call cobol_alloc$stack (s_length, 0, s_offset); 2507 2508 save_dn_ptr = dn_ptr; /* Build a dataname token for the space just allocated in the stack */ 2509 dn_ptr = output_operand_ptr; 2510 2511 /* Zero the buffer in which data name token is built */ 2512 2513 do ix = 1 to 40; 2514 dn_buff (ix) = 0; 2515 end; 2516 2517 2518 data_name.type = rtc_dataname; 2519 data_name.seg_num = 1000; /* Run time stack segment */ 2520 data_name.offset = s_offset; /* Offset returned by the allocate procedure */ 2521 2522 2523 descrip_ptr = addr (data_name.file_section); 2524 descrip = "0"b; 2525 data_name.alphanum = "1"b; 2526 data_name.display = "1"b; 2527 data_name.item_length = s_length; 2528 2529 /* Build an EOS token for a MOVE */ 2530 2531 eos_ptr = addr (eos_buff (1)); 2532 end_stmt.verb = 18; /* MOVE */ 2533 end_stmt.e = 1; /* One operand to move */ 2534 2535 /* Build an input structure before calling the move generator */ 2536 2537 move_token.n = 4; 2538 move_token.code = 0; 2539 move_token.token_ptr (1) = null (); 2540 move_token.token_ptr (2) = operand_ptr; /* Numeric data item */ 2541 move_token.token_ptr (3) = output_operand_ptr; 2542 /* Alphanumeric in the stack */ 2543 move_token.token_ptr (4) = eos_ptr; /* EOS token */ 2544 2545 /* Call the move generator */ 2546 2547 call cobol_move_gen (addr (move_token)); 2548 2549 dn_ptr = save_dn_ptr; 2550 2551 if changed_descrip_bits 2552 then do; /* Reset the description bits in the token of the operand being converted. */ 2553 data_name.numeric = "1"b; 2554 data_name.alphanum = "0"b; 2555 end; /* Reset the description bits in the token of the operand being comverted. */ 2556 2557 2558 end; /* INput operand is a dataname (type 9) or numeric literal (type2) */ 2559 2560 2561 else if data_name.type = rtc_resword 2562 then do; /* A reserved word, assume a figurative constant */ 2563 2564 rw_ptr = dn_ptr; 2565 2566 filler_hier = 1; 2567 t_key = reserved_word.key; 2568 2569 if t_key = rwkey_zero 2570 then eis_filler = eis_fill_def.zero; /* ZERO */ 2571 else if t_key = rwkey_space 2572 then eis_filler = eis_fill_def.space; 2573 else if t_key = rwkey_quote 2574 then eis_filler = eis_fill_def.quote; 2575 2576 2577 else if alpha_flag 2578 then do; 2579 if t_key = rwkey_highval 2580 then eis_filler = alphabet_name.hival_char; 2581 else if t_key = rwkey_lowval 2582 then eis_filler = alphabet_name.loval_char; 2583 end; 2584 2585 2586 else do; 2587 if t_key = rwkey_highval 2588 then eis_filler = eis_fill_def.high_value; 2589 else if t_key = rwkey_lowval 2590 then eis_filler = eis_fill_def.low_value; 2591 end; 2592 2593 2594 /* Build an alphanumeric literal token for the figurative constant */ 2595 2596 alit_ptr = addr (alit_buffer (1)); 2597 2598 alphanum_lit.size = 25; 2599 alphanum_lit.line = 0; 2600 alphanum_lit.column = 0; 2601 alphanum_lit.type = rtc_alphalit; 2602 alphanum_lit.lit_type = "0"b; /* Character string */ 2603 alphanum_lit.all_lit = "0"b; 2604 alphanum_lit.lit_size = 1; 2605 alphanum_lit.string = eis_filler; 2606 2607 /* Pool the alphanumeric literal, and build a data name token */ 2608 2609 2610 call cobol_make_type9$type2_3 (output_operand_ptr, alit_ptr); 2611 2612 2613 2614 end; /* A reserved word assume a figurative constant */ 2615 2616 exit_convert_to_alpha: 2617 return; 2618 end convert_to_alpha; 2619 2620 /*{*/ 2621 class_condition: 2622 proc; 2623 2624 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_Beg(cc);/**/ 2625 2626 /* 2627*This procedure generates code for the Cobol class condition. 2628**/ 2629 2630 /*}*/ 2631 /* Buffer in which a data name token for separate sign operand is built */ 2632 2633 dcl sep_sign_type9 (1:40) fixed bin; 2634 dcl sep_sign_ptr ptr; 2635 dcl separate_sign_processing_flag 2636 bit (1); 2637 2638 /* Buffer in which a data name token for the TCT summary word (descriptor 3) 2639* is built. */ 2640 2641 dcl summary_buff (1:40) fixed bin; 2642 dcl summary_op_ptr ptr; 2643 2644 2645 /* Other work variables */ 2646 2647 dcl in_op_ptr ptr; 2648 dcl tct_table_ptr ptr; 2649 dcl original_in_op_ptr ptr; 2650 dcl st_offset fixed bin; 2651 dcl tct_ptr ptr; 2652 dcl summary_ptr ptr; 2653 2654 dcl descrip_ptr ptr; 2655 dcl descrip bit (72) based (descrip_ptr); 2656 dcl work_binary fixed bin (35); 2657 dcl 1 work_inst based (inst_ptr), 2658 2 left_half bit (18), 2659 2 right_half bit (18); 2660 2661 2662 dcl ret_offset fixed bin; 2663 dcl eos_buff (1:10) fixed bin; 2664 dcl temp_eos_ptr ptr; 2665 2666 dcl 1 move_token aligned, 2667 2 count fixed bin, 2668 2 code fixed bin, 2669 2 token_ptr (1:5) ptr; 2670 2671 2672 /*************************************************/ 2673 /* START OF EXECUTION */ 2674 /* class_condition */ 2675 /**************************************************/ 2676 start_class_condition: 2677 separate_sign_processing_flag = "0"b; /* Used to indicate whether numeric is separate sign or overpunch */ 2678 2679 2680 /* Get a pointer to the operand to be tested for class condition */ 2681 in_op_ptr = in_token.token_ptr (in_token.n - 1); 2682 2683 if end_stmt.e = rwkey_alphabetic 2684 then do; /* Alphabetic class condition */ 2685 2686 if alpha_tct_table_allocated ^= cobol_$compile_count 2687 then do; /* Must build the alphabetic tct table in the constant section */ 2688 2689 type9_alpha_tct_ptr = addr (type9_alpha_tct (1)); 2690 dn_ptr = type9_alpha_tct_ptr; 2691 tct_table_ptr = addr (alpha_tct_table); 2692 2693 2694 call tct_table_build; 2695 2696 2697 alpha_tct_table_allocated = cobol_$compile_count; 2698 end; /* Must build the alphabetic tct table in the constant section */ 2699 2700 2701 tct_ptr = type9_alpha_tct_ptr; 2702 2703 end; /* Alphabetic class condition */ 2704 2705 2706 2707 else do; /* Numeric class conditon */ 2708 2709 if numeric_tct_table_allocated ^= cobol_$compile_count 2710 then do; /* Must build the numeric tct table in the constant section */ 2711 2712 type9_numeric_tct_ptr = addr (type9_numeric_tct (1)); 2713 dn_ptr = type9_numeric_tct_ptr; 2714 tct_table_ptr = addr (numeric_tct_table); 2715 2716 2717 call tct_table_build; 2718 2719 2720 numeric_tct_table_allocated = cobol_$compile_count; 2721 end; /* Must build the numeric tct tble in the constant section */ 2722 2723 2724 tct_ptr = type9_numeric_tct_ptr; 2725 2726 2727 2728 if in_op_ptr -> data_name.numeric 2729 then do; /* Operand being tested for NUMERIC class condition is a numeric 2730* ( as opposed to alphanumeric) */ 2731 2732 /* Make a copy of the input operand token. */ 2733 sep_sign_ptr = null (); 2734 2735 call copy_whole_token (sep_sign_ptr, in_op_ptr); 2736 2737 2738 original_in_op_ptr = in_op_ptr; 2739 2740 in_op_ptr = sep_sign_ptr; 2741 if in_op_ptr -> data_name.sign_separate 2742 | (in_op_ptr -> data_name.item_signed & in_op_ptr -> data_name.sign_separate = "0"b) 2743 then do; /* The numeric operand has a separate sign or overpunch sign. */ 2744 2745 2746 2747 if in_op_ptr -> data_name.subscripted 2748 then do; /* A subscripted separate sign or overpunch sign token. */ 2749 2750 /* Make a copy of the copy of the token just made. */ 2751 sep_sign_ptr = null (); 2752 2753 2754 call copy_whole_token (sep_sign_ptr, in_op_ptr); 2755 2756 2757 /* Modify the copy so that it is not subscripted. */ 2758 sep_sign_ptr -> data_name.subscripted = "0"b; 2759 sep_sign_ptr -> data_name.variable_length = "0"b; 2760 sep_sign_ptr -> data_name.occurs_ptr = 0; 2761 2762 /* Allocate space on the stack to receive the value contained 2763* in the subscripted variable. */ 2764 2765 call cobol_alloc$stack ( 2766 fixed (sep_sign_ptr -> data_name.item_length, 17), 0, ret_offset); 2767 2768 /* Modify the token so that it describes the stack space 2769* just allocated. */ 2770 sep_sign_ptr -> data_name.seg_num = 1000; 2771 /* stack */ 2772 sep_sign_ptr -> data_name.offset = ret_offset; 2773 2774 /* Generate code to move the numeric value to the stack. */ 2775 2776 temp_eos_ptr = addr (eos_buff (1)); 2777 temp_eos_ptr -> end_stmt.verb = 18; 2778 /* MOVE */ 2779 temp_eos_ptr -> end_stmt.e = 1; 2780 /* One receiving field */ 2781 2782 /* Build an input structure for calling the MOVE generator. */ 2783 move_token.count = 4; 2784 move_token.code = 0; 2785 move_token.token_ptr (1) = null (); 2786 move_token.token_ptr (2) = in_op_ptr; 2787 /* SOURCE */ 2788 move_token.token_ptr (3) = sep_sign_ptr; 2789 /* DESTINATION */ 2790 move_token.token_ptr (4) = temp_eos_ptr; 2791 2792 2793 call cobol_move_gen (addr (move_token)); 2794 2795 2796 /* Point the original input operand pointer at the token that 2797* describes the numeric value in the stack. */ 2798 2799 original_in_op_ptr = sep_sign_ptr; 2800 2801 in_op_ptr = null (); 2802 2803 /* Make a copy of the token that describes the stack value. */ 2804 2805 call copy_whole_token (in_op_ptr, sep_sign_ptr); 2806 2807 2808 end; /* A suubscripted, separate sign reference. */ 2809 2810 2811 /* Modify the token so that the separate sign or overpunch sign is excluded. */ 2812 2813 if in_op_ptr -> data_name.sign_type = "100"b 2814 | (in_op_ptr -> data_name.sign_type = "010"b) 2815 /* Leading overpunch */ 2816 then /* Leading separate sign or leading overpunch sign. */ 2817 /* Set offset to the byte following the sign byte. */ 2818 in_op_ptr -> data_name.offset = in_op_ptr -> data_name.offset + 1; 2819 2820 in_op_ptr -> data_name.sign_type = "000"b; 2821 /* Unsigned */ 2822 2823 /* Decrease the length of the numeric by one (because sign byte 2824* is being ignored ) */ 2825 in_op_ptr -> data_name.item_length = in_op_ptr -> data_name.item_length - 1; 2826 2827 separate_sign_processing_flag = "1"b; 2828 2829 end; /* The numeric operand has a separate sign. */ 2830 2831 2832 /* Modify the input operand token so that is no longer references a numeric */ 2833 in_op_ptr -> data_name.numeric = "0"b; 2834 in_op_ptr -> data_name.alphanum = "1"b; 2835 2836 end; /* Operand being tested for NUMERIC class condition is a numeric 2837* 2838* ( as opposed to alphanumeric) */ 2839 2840 end; /* Numeric class condition */ 2841 2842 2843 2844 /* Allocate one 6180 word in the run-time stack to receive summary information */ 2845 2846 2847 call cobol_alloc$stack (4 /* bytes */, 0, st_offset); 2848 2849 2850 /* Build a data name token (type 9) for the stack entry */ 2851 dn_ptr = addr (summary_buff (1)); 2852 2853 data_name.type = rtc_dataname; 2854 data_name.seg_num = 1000; /* stack segment */ 2855 data_name.offset = st_offset; /* Offset returned by the alloc procedure */ 2856 2857 /* Zero the description bits */ 2858 descrip_ptr = addr (data_name.file_section); 2859 descrip = "0"b; 2860 2861 data_name.numeric = "1"b; 2862 data_name.elementary = "1"b; 2863 data_name.display = "1"b; 2864 data_name.item_length = 4; 2865 2866 /* Point at the operand for the summary operand just built */ 2867 summary_ptr = dn_ptr; 2868 2869 2870 /* At this point in execution we have three relevant pointers: 2871* 2872* 1. in_op_ptr points to the input operand 2873* 2. tct_ptr points to the operand for the tct table 2874* 3. summary_ptr points to the operand for the summary word allocated 2875* in the stack. 2876**/ 2877 2878 2879 call test_for_numeric; 2880 2881 2882 2883 /* Emit the instruction(s) following the tct */ 2884 2885 if ^separate_sign_processing_flag 2886 then do; /* Not separate sign operand, so emit a single transfer instruction */ 2887 2888 i_ptr = addr (end_stmt.i); 2889 if ibit.not 2890 then topcode = ttf_op; /* NOT CLASS CONDITION */ 2891 else topcode = ttn_op; /* CLASS CONDITION */ 2892 2893 /* Zero bits to instruction being built */ 2894 non_eis_word = "0"b; 2895 non_eis_ptr = addr (non_eis_word); 2896 2897 /* Insert opcode into the instruction */ 2898 non_eis_ptr -> eis_inst.opcode = topcode; 2899 2900 /* Build relocation information */ 2901 2902 reloc_struc (1) = "0"b; 2903 reloc_struc (2) = "0"b; 2904 2905 /* Save the text section offset at which the transfer is to be emitted */ 2906 save_locno = cobol_$text_wd_off; 2907 2908 /* Emit the transfer instruction */ 2909 2910 call cobol_emit (non_eis_ptr, reloc_ptr, 1); 2911 2912 2913 /* Issue a reference to the tag in end_stmt.h */ 2914 2915 call cobol_make_tagref (fixed (end_stmt.h, 17), save_locno, null ()); 2916 2917 2918 end; /* Not separate sign operand, so emit a single transfer instruction */ 2919 2920 2921 2922 else do; /* Separate sign operand, must generate code to isolate and test the sign */ 2923 2924 2925 call separate_sign_processing; 2926 2927 2928 end; /* Separate sign operand, must generate code to isolate and test the sign */ 2929 2930 exit_class_condition: 2931 /***..... if Trace_Bit then call cobol_gen_driver_$Tr_End(cc);/**/ 2932 return; 2933 2934 /*{*/ 2935 tct_table_build: 2936 proc; 2937 2938 /* 2939*This internal procedure pools a tct table image in the 2940*constant section of the Cobol text segment, and then builds 2941*a data name token (type 9) that describes the table. 2942**/ 2943 2944 /* Assertions at entry. 2945* 1. tct_table_ptr points to an iternal static initialized 2946* character string that is the tct table to be pooled. 2947* 2948* 2. dn_ptr points to a buffer in which the data name 2949* token (type 9) is to be built. 2950**/ 2951 2952 /*}*/ 2953 2954 dcl tct_table char (512) based (tct_table_ptr); 2955 dcl t_offset fixed bin; 2956 2957 /**************************************************/ 2958 /* START OF EXECUTION */ 2959 /* tct_table_build */ 2960 /**************************************************/ 2961 2962 start_tct_table_build: /* Pool the tct table in the constant section */ 2963 call cobol_pool$search_op (tct_table, 0, t_offset, in_op); 2964 2965 2966 /* Build a data name (type 9) token for the pooled constant */ 2967 data_name.type = rtc_dataname; 2968 if in_op = 1 2969 then data_name.seg_num = 3; 2970 else data_name.seg_num = 3000; /* Constant section of the text segment */ 2971 data_name.offset = t_offset; /* Offset returned by the pool procedure */ 2972 2973 /* Zero the description bits of the data name token being built */ 2974 descrip_ptr = addr (data_name.file_section); 2975 descrip = "0"b; 2976 2977 data_name.alphanum = "1"b; 2978 data_name.display = "1"b; 2979 data_name.elementary = "1"b; 2980 data_name.item_length = 512; 2981 2982 2983 2984 exit_tct_table_build: 2985 return; 2986 end tct_table_build; 2987 2988 2989 test_for_numeric: 2990 proc; 2991 2992 /* 2993*This procedure generates a tct instruction that thest whether 2994*a data item is numeric. 2995**/ 2996 2997 /* At this point in execution we have three relevant pointers: 2998* 2999* 1. in_op_ptr points to the input operand 3000* 2. tct_ptr points to the operand for the tct table 3001* 3. summary_ptr points to the operand for the summary word allocated 3002* in the stack. 3003* 3004* 3005* */ 3006 3007 start_test_for_numeric: /* Now we must build the TCT instruction and descriptors */ 3008 /* Build the input structure for the instruction and first descriptor */ 3009 input_struc.type = 4; /* eis, 1 descriptor */ 3010 input_struc.operand_no = 1; 3011 input_struc.lock = 0; /* no locks */ 3012 input_struc.operand.token_ptr (1) = in_op_ptr; 3013 input_struc.operand.send_receive (1) = 0; 3014 input_struc.operand.size_sw (1) = 0; 3015 3016 3017 call cobol_addr (input_ptr, inst_ptr, reloc_ptr); 3018 3019 3020 /* Insert the tct opcode into the instruction */ 3021 eis_ptr = inst_ptr; 3022 eis_inst.opcode = tct_op; 3023 3024 /* Emit the tct instruction and first descriptor */ 3025 3026 call cobol_emit (inst_ptr, reloc_ptr, 2); 3027 3028 3029 /* Build the second descriptor */ 3030 3031 input_struc.type = 3; /* eis, 1 operand, no descriptors */ 3032 input_struc.operand_no = 1; 3033 input_struc.lock = 0; /* no locks */ 3034 input_struc.operand.token_ptr (1) = tct_ptr; 3035 input_struc.operand.send_receive (1) = 0; 3036 input_struc.operand.size_sw (1) = 0; 3037 3038 3039 call cobol_addr (input_ptr, inst_ptr, reloc_ptr); 3040 3041 3042 /* Set the opcode in the returned eis instruction to zero bits */ 3043 3044 inst_struc_basic.fill1_op = "0"b; 3045 3046 /* Increment the address returned by cobol_addr, because cobol_addr generates the address 3047* relative to the IC of this instruction, when what we need is an IC address relative to 3048* the TCT instruction. */ 3049 3050 work_binary = binary (work_inst.left_half, 18) + 2; 3051 work_inst.left_half = substr (unspec (work_binary), 19, 18); 3052 3053 /* Emit the second descriptor */ 3054 3055 call cobol_emit (inst_ptr, reloc_ptr, 1); 3056 3057 3058 /* Build the third descriptor */ 3059 3060 input_struc.type = 3; /* eis, 1 operand, no descriptors */ 3061 input_struc.operand_no = 1; 3062 input_struc.lock = 0; 3063 input_struc.operand.token_ptr (1) = summary_ptr; 3064 input_struc.operand.send_receive (1) = 0; 3065 input_struc.operand.size_sw (1) = 0; 3066 3067 3068 call cobol_addr (input_ptr, inst_ptr, reloc_ptr); 3069 3070 3071 /* Set the opcode in the returned eis instruction to zero bits */ 3072 3073 inst_struc_basic.fill1_op = "0"b; 3074 3075 /* Emit the third descriptor */ 3076 3077 call cobol_emit (inst_ptr, reloc_ptr, 1); 3078 3079 3080 3081 exit_test_for_numeric: 3082 return; 3083 end test_for_numeric; 3084 3085 /*{*/ 3086 separate_sign_processing: 3087 proc; 3088 3089 /* This internal procedure generates code that tests to determine 3090*whether the separate sign byte of a numeric operand is plus 3091*or minus. */ 3092 3093 /*}*/ 3094 3095 3096 /* Declaration of automatic work buffers */ 3097 3098 dcl separate_sign_type9 (1:40) fixed bin; /* Used to contain type 9 for the sign byte */ 3099 3100 dcl separate_sign_eos (1:10) fixed bin; /* Used to build EOS for recursive calls to cobol_compare_gen */ 3101 3102 dcl separate_sign_input_token 3103 (1:15) fixed bin; /* Used to contain input token for recursive calls to mc 3104* cobol_compare_gen */ 3105 3106 /* Other work variables */ 3107 3108 dcl save_h fixed bin; 3109 dcl save_not bit (1); 3110 dcl fail_tag fixed bin; 3111 dcl temp_tag fixed bin; 3112 dcl temp_ptr ptr; 3113 3114 3115 3116 /**************************************************/ 3117 /* START OF EXECUTION */ 3118 /* separate_sign */ 3119 /**************************************************/ 3120 3121 3122 start_separate_sign_processing: /* Build a data name token for the sign byte of the numeric data name token */ 3123 /* Make a copy of the original numeric data name token */ 3124 dn_ptr = addr (separate_sign_type9 (1)); 3125 3126 call cobol_make_type9$copy (dn_ptr, original_in_op_ptr); 3127 3128 3129 /* Modify the copy of the numeric data name */ 3130 3131 data_name.numeric = "0"b; 3132 data_name.alphanum = "1"b; 3133 data_name.places_left = 0; 3134 data_name.places_right = 0; 3135 3136 if data_name.sign_type = "011"b /* Trailing separate */ 3137 | data_name.sign_type = "001"b /* trailing, but not separate */ | data_name.sign_type = "000"b 3138 /* Clause not specified, defaults to trailing overpunch. */ 3139 then /* Set offset to last character in the numeric data item */ 3140 data_name.offset = data_name.offset + data_name.item_length - 1; 3141 3142 data_name.item_length = 1; 3143 3144 /* Reserve a tag */ 3145 fail_tag = cobol_$next_tag; 3146 cobol_$next_tag = cobol_$next_tag + 1; 3147 3148 /* Save the location at which the ttf instruction is to be emitted */ 3149 save_locno = cobol_$text_wd_off; 3150 3151 /* Build the ttf instruction */ 3152 non_eis_word = "0"b; 3153 non_eis_ptr = addr (non_eis_word); 3154 non_eis_ptr -> eis_inst.opcode = ttf_op; 3155 3156 /* Build relocation bytes */ 3157 reloc_struc (1) = "0"b; 3158 reloc_struc (2) = "0"b; 3159 3160 /* Emit the instruction */ 3161 3162 3163 call cobol_emit (non_eis_ptr, reloc_ptr, 1); 3164 3165 3166 3167 i_ptr = addr (end_stmt.i); 3168 3169 /* Save the tag from the input EOS */ 3170 save_h = end_stmt.h; 3171 3172 /* Save the "not" bit from the input EOS */ 3173 save_not = ibit.not; 3174 3175 /* Issue a reference to a tag at the instruction just emitted */ 3176 3177 3178 if ibit.not 3179 then temp_tag = end_stmt.h; 3180 else temp_tag = fail_tag; 3181 3182 3183 call cobol_make_tagref (temp_tag, save_locno, null ()); 3184 3185 3186 3187 if (data_name.item_signed & data_name.sign_separate = "0"b) 3188 then do; /* Testing for leading or trailing overpunch sign. */ 3189 3190 if opch_tct_table_allocated ^= cobol_$compile_count 3191 then do; /* Must build the overpunch sign tct table in the constant section. */ 3192 3193 temp_ptr = dn_ptr; 3194 type9_opch_tct_ptr = addr (type9_opch_tct (1)); 3195 dn_ptr = type9_opch_tct_ptr; 3196 tct_table_ptr = addr (opch_tct_table); 3197 3198 3199 call tct_table_build; 3200 3201 opch_tct_table_allocated = cobol_$compile_count; 3202 dn_ptr = temp_ptr; 3203 end; /* Must build the overpunch sign tct table in the constant section. */ 3204 3205 3206 tct_ptr = type9_opch_tct_ptr; 3207 in_op_ptr = dn_ptr; 3208 3209 3210 call test_for_numeric; 3211 3212 3213 if save_not = "0"b 3214 then do; /* test is "if X numeric". */ 3215 /* If sign is a valid overpunch sign, then we want to transfer to 3216* the tag specified in the EOS token. */ 3217 temp_tag = end_stmt.h; 3218 non_eis_ptr -> eis_inst.opcode = ttn_op; 3219 end; /* Test if "if X numeric". */ 3220 3221 3222 3223 3224 call cobol_emit (non_eis_ptr, reloc_ptr, 1); 3225 3226 3227 call cobol_make_tagref (temp_tag, cobol_$text_wd_off - 1, null ()); 3228 3229 3230 end; /* Testing for leading or trailing overpunch sign. */ 3231 3232 3233 3234 else do; /* Testing for leading or trailing separate sign. */ 3235 3236 /* Build an EOS to be used in recursive calls to cobol_compare_gen */ 3237 3238 if separate_signs_pooled ^= cobol_$compile_count 3239 then do; /* Pool the signs, and build data name (type 9) tokens for each */ 3240 3241 /* Pool plus and make a data name */ 3242 separate_sign_literal.literal_string = "+"; 3243 3244 temp_ptr = addr (plus_type9 (1)); 3245 3246 call cobol_make_type9$type2_3 (temp_ptr, addr (separate_sign_literal)); 3247 3248 3249 /* Pool minus and make data name */ 3250 separate_sign_literal.literal_string = "-"; 3251 temp_ptr = addr (minus_type9 (1)); 3252 3253 call cobol_make_type9$type2_3 (temp_ptr, addr (separate_sign_literal)); 3254 3255 3256 separate_signs_pooled = cobol_$compile_count; 3257 3258 end; /* Pool the signs, and build a data name token for each */ 3259 3260 eos_ptr = addr (separate_sign_eos (1)); 3261 end_stmt.e = rwkey_equal; 3262 if save_not 3263 then end_stmt.h = fail_tag; 3264 else end_stmt.h = save_h; 3265 3266 end_stmt.i = 0; 3267 3268 /* Build the input structure to be used in recursive calls to cobol_compare_gen */ 3269 3270 work_in_token_ptr = addr (work_in_token.n); 3271 work_in_token.n = 3; 3272 work_in_token.token_ptr (work_in_token.n) = eos_ptr; 3273 /* EOS token for EQUAL compare */ 3274 work_in_token.token_ptr (work_in_token.n - 1) = addr (plus_type9 (1)); 3275 /* Data name token for the plus sign */ 3276 work_in_token.token_ptr (work_in_token.n - 2) = dn_ptr; 3277 /* Data name token for the sign byte */ 3278 3279 3280 3281 /* Build the input structure for the second recursive call (NECESSARY BECAUSE THE PRROGRAM BLOWS 3282* 3283* UP OTHERWISE!!!! ) */ 3284 3285 work_in_token1_ptr = addr (work_in_token1.n); 3286 3287 work_in_token1.n = 3; 3288 work_in_token1.token_ptr (work_in_token1.n) = eos_ptr; 3289 work_in_token1.token_ptr (work_in_token1.n - 1) = addr (minus_type9 (1)); 3290 work_in_token1.token_ptr (work_in_token1.n - 2) = dn_ptr; 3291 3292 /* Call cobol_compare_gen recursively to generate code to test whether the sign is plus */ 3293 3294 call cobol_compare_gen (work_in_token_ptr, null ()); 3295 3296 3297 3298 /* Modify the input token for next recursive call to cobol_compare_gen */ 3299 3300 /*!!!*/ 3301 3302 if save_not 3303 then do; /* Branch on condition false, must change EOS */ 3304 end_stmt.e = rwkey_unequal; 3305 end_stmt.h = save_h; 3306 end; /* Branch on condition false, must change EOS */ 3307 3308 3309 /* Call cobol_compare_gen recursively to generate code to test whether the sign is minus */ 3310 3311 call cobol_compare_gen (work_in_token1_ptr, null ()); 3312 3313 end; /* Testing for leading or trailing separate sign. */ 3314 3315 3316 3317 /* Define the label "fail_tag" at the next word in the text section */ 3318 3319 call cobol_define_tag (fail_tag); 3320 3321 3322 3323 exit_separate_sign_processing: 3324 return; 3325 end separate_sign_processing; 3326 3327 3328 copy_whole_token: 3329 proc (copied_token_ptr, source_token_ptr); 3330 3331 /* This procedure makes a copy of the entire contents 3332*of a token. This procedure is necessary because 3333*cobol_make_type9$copy copies only the header of a token. */ 3334 3335 /* DECLARATION OF THE PARAMETERS */ 3336 3337 dcl copied_token_ptr ptr; 3338 dcl source_token_ptr ptr; 3339 3340 /* DESCRIPTION OF THE PARAMETERS */ 3341 3342 /* 3343*PARAMETER DESCRIPTION 3344* 3345*copied_token_ptr Pointer to the copy made by this procedure. 3346* (input/output) On input, if this pointer 3347* is null(), then this procedure allocates 3348* space for the copy of the token in the 3349* temporary token area, and returns a pointer 3350* to the temporary token in this 3351* parameter. If 3352* this pointer is not null() on input, 3353* then the copied token is made in the space 3354* pointed at the the input value of the pointer. 3355*source_token_ptr Pointer to the token to be copied. (input) 3356* 3357**/ 3358 3359 dcl copy_string char (1000) based (copied_token_ptr); 3360 dcl source_string char (1000) based (source_token_ptr); 3361 3362 3363 3364 start_copy_whole_token: 3365 if copied_token_ptr = null () 3366 then do; /* Allocate space for the token in the temporary token area. */ 3367 3368 copied_token_ptr = cobol_$temp_token_ptr; 3369 cobol_$temp_token_ptr = 3370 addrel (cobol_$temp_token_ptr, fixed ((source_token_ptr -> data_name.size + 3) / 4, 18)); 3371 3372 end; /* Allocate space for the token in the temmporary token aarea. */ 3373 3374 3375 /* Copy the token. */ 3376 substr (copy_string, 1, source_token_ptr -> data_name.size) = substr (source_string, 1); 3377 3378 exit_copy_whole_token: 3379 return; 3380 end copy_whole_token; 3381 end class_condition; 3382 3383 /***..... dcl cobol_gen_driver_$Tr_Beg entry(char(*));/**/ 3384 /***..... dcl cobol_gen_driver_$Tr_End entry(char(*));/**/ 3385 3386 /***..... dcl Trace_Bit bit(1) static external;/**/ 3387 /***..... dcl Trace_Lev fixed bin static external;/**/ 3388 /***..... dcl Trace_Line char(36) static external;/**/ 3389 /***..... dcl ioa_ entry options(variable); /**/ 3390 3391 /***..... dcl cc char(15) init("CLASS_CONDITION");/**/ 3392 /***..... dcl ac char(13) init("ALPHA_COMPARE");/**/ 3393 /***..... dcl c6 char(10) init("COMP6_PROC");/**/ 3394 /***..... dcl nc char(15) init("NUMERIC_COMPARE");/**/ 3395 /***..... dcl rc char(18) init("RELATIONAL_COMPARE");/**/ 3396 /***..... dcl sc char(14) init("SIGN_CONDITION");/**/ 3397 /***..... dcl ub char(7) init("UBRANCH");/**/ 3398 /***..... dcl ccg char(17) init("COBOL_COMPARE_GEN");/**/ 3399 3400 3401 /* INCLUDE FILES USED BY THIS PROCEDURE */ 3402 3403 3404 /***** Declaration for builtin function *****/ 3405 3406 dcl (substr, mod, binary, fixed, addr, addrel, rel, length, string, unspec, null, index) 3407 builtin; 3408 3409 dcl (max, min) builtin; 3410 3411 /***** End of declaration for builtin function *****/ 3412 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_.incl.pl1 */ 1 3 /* last modified Feb 4, 1977 by ORN */ 1 4 1 5 /* This file defines all external data used in the generator phase of Multics Cobol */ 1 6 1 7 /* POINTERS */ 1 8 dcl cobol_$text_base_ptr ptr ext; 1 9 dcl text_base_ptr ptr defined (cobol_$text_base_ptr); 1 10 dcl cobol_$con_end_ptr ptr ext; 1 11 dcl con_end_ptr ptr defined (cobol_$con_end_ptr); 1 12 dcl cobol_$def_base_ptr ptr ext; 1 13 dcl def_base_ptr ptr defined (cobol_$def_base_ptr); 1 14 dcl cobol_$link_base_ptr ptr ext; 1 15 dcl link_base_ptr ptr defined (cobol_$link_base_ptr); 1 16 dcl cobol_$sym_base_ptr ptr ext; 1 17 dcl sym_base_ptr ptr defined (cobol_$sym_base_ptr); 1 18 dcl cobol_$reloc_text_base_ptr ptr ext; 1 19 dcl reloc_text_base_ptr ptr defined (cobol_$reloc_text_base_ptr); 1 20 dcl cobol_$reloc_def_base_ptr ptr ext; 1 21 dcl reloc_def_base_ptr ptr defined (cobol_$reloc_def_base_ptr); 1 22 dcl cobol_$reloc_link_base_ptr ptr ext; 1 23 dcl reloc_link_base_ptr ptr defined (cobol_$reloc_link_base_ptr); 1 24 dcl cobol_$reloc_sym_base_ptr ptr ext; 1 25 dcl reloc_sym_base_ptr ptr defined (cobol_$reloc_sym_base_ptr); 1 26 dcl cobol_$reloc_work_base_ptr ptr ext; 1 27 dcl reloc_work_base_ptr ptr defined (cobol_$reloc_work_base_ptr); 1 28 dcl cobol_$pd_map_ptr ptr ext; 1 29 dcl pd_map_ptr ptr defined (cobol_$pd_map_ptr); 1 30 dcl cobol_$fixup_ptr ptr ext; 1 31 dcl fixup_ptr ptr defined (cobol_$fixup_ptr); 1 32 dcl cobol_$initval_base_ptr ptr ext; 1 33 dcl initval_base_ptr ptr defined (cobol_$initval_base_ptr); 1 34 dcl cobol_$initval_file_ptr ptr ext; 1 35 dcl initval_file_ptr ptr defined (cobol_$initval_file_ptr); 1 36 dcl cobol_$perform_list_ptr ptr ext; 1 37 dcl perform_list_ptr ptr defined (cobol_$perform_list_ptr); 1 38 dcl cobol_$alter_list_ptr ptr ext; 1 39 dcl alter_list_ptr ptr defined (cobol_$alter_list_ptr); 1 40 dcl cobol_$seg_init_list_ptr ptr ext; 1 41 dcl seg_init_list_ptr ptr defined (cobol_$seg_init_list_ptr); 1 42 dcl cobol_$temp_token_area_ptr ptr ext; 1 43 dcl temp_token_area_ptr ptr defined (cobol_$temp_token_area_ptr); 1 44 dcl cobol_$temp_token_ptr ptr ext; 1 45 dcl temp_token_ptr ptr defined (cobol_$temp_token_ptr); 1 46 dcl cobol_$token_block1_ptr ptr ext; 1 47 dcl token_block1_ptr ptr defined (cobol_$token_block1_ptr); 1 48 dcl cobol_$token_block2_ptr ptr ext; 1 49 dcl token_block2_ptr ptr defined (cobol_$token_block2_ptr); 1 50 dcl cobol_$minpral5_ptr ptr ext; 1 51 dcl minpral5_ptr ptr defined (cobol_$minpral5_ptr); 1 52 dcl cobol_$tag_table_ptr ptr ext; 1 53 dcl tag_table_ptr ptr defined (cobol_$tag_table_ptr); 1 54 dcl cobol_$map_data_ptr ptr ext; 1 55 dcl map_data_ptr ptr defined (cobol_$map_data_ptr); 1 56 dcl cobol_$ptr_status_ptr ptr ext; 1 57 dcl ptr_status_ptr ptr defined (cobol_$ptr_status_ptr); 1 58 dcl cobol_$reg_status_ptr ptr ext; 1 59 dcl reg_status_ptr ptr defined (cobol_$reg_status_ptr); 1 60 dcl cobol_$misc_base_ptr ptr ext; 1 61 dcl misc_base_ptr ptr defined (cobol_$misc_base_ptr); 1 62 dcl cobol_$misc_end_ptr ptr ext; 1 63 dcl misc_end_ptr ptr defined (cobol_$misc_end_ptr); 1 64 dcl cobol_$list_ptr ptr ext; 1 65 dcl list_ptr ptr defined (cobol_$list_ptr); 1 66 dcl cobol_$allo1_ptr ptr ext; 1 67 dcl allo1_ptr ptr defined (cobol_$allo1_ptr); 1 68 dcl cobol_$eln_ptr ptr ext; 1 69 dcl eln_ptr ptr defined (cobol_$eln_ptr); 1 70 dcl cobol_$diag_ptr ptr ext; 1 71 dcl diag_ptr ptr defined (cobol_$diag_ptr); 1 72 dcl cobol_$xref_token_ptr ptr ext; 1 73 dcl xref_token_ptr ptr defined (cobol_$xref_token_ptr); 1 74 dcl cobol_$xref_chain_ptr ptr ext; 1 75 dcl xref_chain_ptr ptr defined (cobol_$xref_chain_ptr); 1 76 dcl cobol_$statement_info_ptr ptr ext; 1 77 dcl statement_info_ptr ptr defined (cobol_$statement_info_ptr); 1 78 dcl cobol_$reswd_ptr ptr ext; 1 79 dcl reswd_ptr ptr defined (cobol_$reswd_ptr); 1 80 dcl cobol_$op_con_ptr ptr ext; 1 81 dcl op_con_ptr ptr defined (cobol_$op_con_ptr); 1 82 dcl cobol_$ntbuf_ptr ptr ext; 1 83 dcl ntbuf_ptr ptr defined (cobol_$ntbuf_ptr); 1 84 dcl cobol_$main_pcs_ptr ptr ext; 1 85 dcl main_pcs_ptr ptr defined (cobol_$main_pcs_ptr); 1 86 dcl cobol_$include_info_ptr ptr ext; 1 87 dcl include_info_ptr ptr defined (cobol_$include_info_ptr); 1 88 1 89 /* FIXED BIN */ 1 90 dcl cobol_$text_wd_off fixed bin ext; 1 91 dcl text_wd_off fixed bin defined (cobol_$text_wd_off); 1 92 dcl cobol_$con_wd_off fixed bin ext; 1 93 dcl con_wd_off fixed bin defined (cobol_$con_wd_off); 1 94 dcl cobol_$def_wd_off fixed bin ext; 1 95 dcl def_wd_off fixed bin defined (cobol_$def_wd_off); 1 96 dcl cobol_$def_max fixed bin ext; 1 97 dcl def_max fixed bin defined (cobol_$def_max); 1 98 dcl cobol_$link_wd_off fixed bin ext; 1 99 dcl link_wd_off fixed bin defined (cobol_$link_wd_off); 1 100 dcl cobol_$link_max fixed bin ext; 1 101 dcl link_max fixed bin defined (cobol_$link_max); 1 102 dcl cobol_$sym_wd_off fixed bin ext; 1 103 dcl sym_wd_off fixed bin defined (cobol_$sym_wd_off); 1 104 dcl cobol_$sym_max fixed bin ext; 1 105 dcl sym_max fixed bin defined (cobol_$sym_max); 1 106 dcl cobol_$reloc_text_max fixed bin(24) ext; 1 107 dcl reloc_text_max fixed bin(24) defined (cobol_$reloc_text_max); 1 108 dcl cobol_$reloc_def_max fixed bin(24) ext; 1 109 dcl reloc_def_max fixed bin(24) defined (cobol_$reloc_def_max); 1 110 dcl cobol_$reloc_link_max fixed bin(24) ext; 1 111 dcl reloc_link_max fixed bin(24) defined (cobol_$reloc_link_max); 1 112 dcl cobol_$reloc_sym_max fixed bin(24) ext; 1 113 dcl reloc_sym_max fixed bin(24) defined (cobol_$reloc_sym_max); 1 114 dcl cobol_$reloc_work_max fixed bin(24) ext; 1 115 dcl reloc_work_max fixed bin(24) defined (cobol_$reloc_work_max); 1 116 dcl cobol_$pd_map_index fixed bin ext; 1 117 dcl pd_map_index fixed bin defined (cobol_$pd_map_index); 1 118 dcl cobol_$cobol_data_wd_off fixed bin ext; 1 119 dcl cobol_data_wd_off fixed bin defined (cobol_$cobol_data_wd_off); 1 120 dcl cobol_$stack_off fixed bin ext; 1 121 dcl stack_off fixed bin defined (cobol_$stack_off); 1 122 dcl cobol_$max_stack_off fixed bin ext; 1 123 dcl max_stack_off fixed bin defined (cobol_$max_stack_off); 1 124 dcl cobol_$init_stack_off fixed bin ext; 1 125 dcl init_stack_off fixed bin defined (cobol_$init_stack_off); 1 126 dcl cobol_$pd_map_sw fixed bin ext; 1 127 dcl pd_map_sw fixed bin defined (cobol_$pd_map_sw); 1 128 dcl cobol_$next_tag fixed bin ext; 1 129 dcl next_tag fixed bin defined (cobol_$next_tag); 1 130 dcl cobol_$data_init_flag fixed bin ext; 1 131 dcl data_init_flag fixed bin defined (cobol_$data_init_flag); 1 132 dcl cobol_$seg_init_flag fixed bin ext; 1 133 dcl seg_init_flag fixed bin defined (cobol_$seg_init_flag); 1 134 dcl cobol_$alter_flag fixed bin ext; 1 135 dcl alter_flag fixed bin defined (cobol_$alter_flag); 1 136 dcl cobol_$sect_eop_flag fixed bin ext; 1 137 dcl sect_eop_flag fixed bin defined (cobol_$sect_eop_flag); 1 138 dcl cobol_$para_eop_flag fixed bin ext; 1 139 dcl para_eop_flag fixed bin defined (cobol_$para_eop_flag); 1 140 dcl cobol_$priority_no fixed bin ext; 1 141 dcl priority_no fixed bin defined (cobol_$priority_no); 1 142 dcl cobol_$compile_count fixed bin ext; 1 143 dcl compile_count fixed bin defined (cobol_$compile_count); 1 144 dcl cobol_$ptr_assumption_ind fixed bin ext; 1 145 dcl ptr_assumption_ind fixed bin defined (cobol_$ptr_assumption_ind); 1 146 dcl cobol_$reg_assumption_ind fixed bin ext; 1 147 dcl reg_assumption_ind fixed bin defined (cobol_$reg_assumption_ind); 1 148 dcl cobol_$perform_para_index fixed bin ext; 1 149 dcl perform_para_index fixed bin defined (cobol_$perform_para_index); 1 150 dcl cobol_$perform_sect_index fixed bin ext; 1 151 dcl perform_sect_index fixed bin defined (cobol_$perform_sect_index); 1 152 dcl cobol_$alter_index fixed bin ext; 1 153 dcl alter_index fixed bin defined (cobol_$alter_index); 1 154 dcl cobol_$list_off fixed bin ext; 1 155 dcl list_off fixed bin defined (cobol_$list_off); 1 156 dcl cobol_$constant_offset fixed bin ext; 1 157 dcl constant_offset fixed bin defined (cobol_$constant_offset); 1 158 dcl cobol_$misc_max fixed bin ext; 1 159 dcl misc_max fixed bin defined (cobol_$misc_max); 1 160 dcl cobol_$pd_map_max fixed bin ext; 1 161 dcl pd_map_max fixed bin defined (cobol_$pd_map_max); 1 162 dcl cobol_$map_data_max fixed bin ext; 1 163 dcl map_data_max fixed bin defined (cobol_$map_data_max); 1 164 dcl cobol_$fixup_max fixed bin ext; 1 165 dcl fixup_max fixed bin defined (cobol_$fixup_max); 1 166 dcl cobol_$tag_table_max fixed bin ext; 1 167 dcl tag_table_max fixed bin defined (cobol_$tag_table_max); 1 168 dcl cobol_$temp_token_max fixed bin ext; 1 169 dcl temp_token_max fixed bin defined (cobol_$temp_token_max); 1 170 dcl cobol_$allo1_max fixed bin ext; 1 171 dcl allo1_max fixed bin defined (cobol_$allo1_max); 1 172 dcl cobol_$eln_max fixed bin ext; 1 173 dcl eln_max fixed bin defined (cobol_$eln_max); 1 174 dcl cobol_$debug_enable fixed bin ext; 1 175 dcl debug_enable fixed bin defined (cobol_$debug_enable); 1 176 dcl cobol_$non_source_offset fixed bin ext; 1 177 dcl non_source_offset fixed bin defined (cobol_$non_source_offset); 1 178 dcl cobol_$initval_flag fixed bin ext; 1 179 dcl initval_flag fixed bin defined (cobol_$initval_flag); 1 180 dcl cobol_$date_compiled_sw fixed bin ext; 1 181 dcl date_compiled_sw fixed bin defined (cobol_$date_compiled_sw); 1 182 dcl cobol_$include_cnt fixed bin ext; 1 183 dcl include_cnt fixed bin defined (cobol_$include_cnt); 1 184 dcl cobol_$fs_charcnt fixed bin ext; 1 185 dcl fs_charcnt fixed bin defined (cobol_$fs_charcnt); 1 186 dcl cobol_$ws_charcnt fixed bin ext; 1 187 dcl ws_charcnt fixed bin defined (cobol_$ws_charcnt); 1 188 dcl cobol_$coms_charcnt fixed bin ext; 1 189 dcl coms_charcnt fixed bin defined (cobol_$coms_charcnt); 1 190 dcl cobol_$ls_charcnt fixed bin ext; 1 191 dcl ls_charcnt fixed bin defined (cobol_$ls_charcnt); 1 192 dcl cobol_$cons_charcnt fixed bin ext; 1 193 dcl cons_charcnt fixed bin defined (cobol_$cons_charcnt); 1 194 dcl cobol_$value_cnt fixed bin ext; 1 195 dcl value_cnt fixed bin defined (cobol_$value_cnt); 1 196 dcl cobol_$cd_cnt fixed bin ext; 1 197 dcl cd_cnt fixed bin defined (cobol_$cd_cnt); 1 198 dcl cobol_$fs_wdoff fixed bin ext; 1 199 dcl fs_wdoff fixed bin defined (cobol_$fs_wdoff); 1 200 dcl cobol_$ws_wdoff fixed bin ext; 1 201 dcl ws_wdoff fixed bin defined (cobol_$ws_wdoff); 1 202 dcl cobol_$coms_wdoff fixed bin ext; 1 203 dcl coms_wdoff fixed bin defined (cobol_$coms_wdoff); 1 204 1 205 /* CHARACTER */ 1 206 dcl cobol_$scratch_dir char (168) aligned ext; 1 207 dcl scratch_dir char (168) aligned defined (cobol_$scratch_dir); /* -42- */ 1 208 dcl cobol_$obj_seg_name char (32) aligned ext; 1 209 dcl obj_seg_name char (32) aligned defined (cobol_$obj_seg_name); /* -8- */ 1 210 1 211 /* BIT */ 1 212 dcl cobol_$xref_bypass bit(1) aligned ext; 1 213 dcl xref_bypass bit(1) aligned defined (cobol_$xref_bypass); /* -1- */ 1 214 dcl cobol_$same_sort_merge_proc bit(1) aligned ext; 1 215 dcl same_sort_merge_proc bit(1) aligned defined (cobol_$same_sort_merge_proc); /* -1- */ 1 216 1 217 1 218 /* END INCLUDE FILE ... cobol_incl.pl1*/ 1 219 1 220 3413 2 1 2 2 /* BEGIN INCLUDE FILE ... cobol_type40.incl.pl1 */ 2 3 /* Last modified on 11/19/76 by ORN */ 2 4 2 5 /* 2 6*A type 40 token is entered into the name table by the IDED syntax. 2 7*This token contains the information for the alphabet name. 2 8**/ 2 9 2 10 dcl alpha_name_ptr ptr; 2 11 2 12 /* BEGIN DECLARATION OF TYPE40 (ALPHABET NAME) TOKEN */ 2 13 dcl 1 alphabet_name based (alpha_name_ptr), 3 1 3 2 /* begin include file ... cobol_TYPE40.incl.pl1 */ 3 3 /* Last modified on 11/17/76 by ORN */ 3 4 3 5 /* header */ 3 6 2 size fixed bin, 3 7 2 line fixed bin, 3 8 2 column fixed bin, 3 9 2 type fixed bin, 3 10 /* body */ 3 11 2 string_ptr ptr, 3 12 2 prev_rec ptr, 3 13 2 info, 3 14 3 repl bit(8), 3 15 3 one_one bit(1), 3 16 3 onto bit(1), 3 17 2 hival_char char(1), 3 18 2 loval_char char(1), 3 19 2 iw_key fixed bin, 3 20 2 def_line fixed bin, 3 21 2 char_size fixed bin, 3 22 2 hi_value char(1), 3 23 2 segno fixed bin, 3 24 2 offset fixed bin, 3 25 2 dn_offset fixed bin, 3 26 2 table char(512), 3 27 2 name_size fixed bin, 3 28 2 name char(0 refer(alphabet_name.name_size)); 3 29 3 30 /* end include file ... cobol_TYPE40.incl.pl1 */ 3 31 2 14 2 15 /* END DECLARATION OF TYPE40 (ALPHABET NAME) TOKEN */ 2 16 2 17 /* END INCLUDE FILE ... cobol_type40.incl.pl1 */ 2 18 3414 4 1 4 2 /* BEGIN INCLUDE FILE ... cobol_type1.incl.pl1 */ 4 3 /* Last modified on 11/19/76 by ORN */ 4 4 4 5 /* 4 6*A reserved word token is created in the minpral files for each occurrence 4 7*of a reserved word in the source program. The value of the key field 4 8*indicates the specific reserved word which a type 1 token represents. 4 9**/ 4 10 4 11 dcl rw_ptr ptr; 4 12 4 13 /* BEGIN DECLARATION OF TYPE1 (RESERVED WORD) TOKEN */ 4 14 dcl 1 reserved_word based (rw_ptr), 5 1 5 2 /* begin include file ... cobol_TYPE1.incl.pl1 */ 5 3 /* Last modified on 11/17/76 by ORN */ 5 4 /* Last modified on 12/28/76 by FCH */ 5 5 /* Last modified on 12/16/80 by FCH */ 5 6 5 7 /* header */ 5 8 2 size fixed bin, 5 9 2 line fixed bin, 5 10 2 column fixed bin, 5 11 2 type fixed bin, 5 12 /* body */ 5 13 2 key fixed bin, 5 14 /* procedure division class bits */ 5 15 2 verb bit (1), 5 16 2 arith_op bit (1), 5 17 2 figcon bit (1), 5 18 2 terminator bit (1), 5 19 2 end_dec bit (1), 5 20 2 rel_op bit (1), 5 21 2 imper_verb bit (1), 5 22 2 end_cobol bit (1), 5 23 /* data division class bits */ 5 24 2 section_header bit (1), 5 25 2 fs_ind bit (1), 5 26 2 fd_clause bit (1), 5 27 2 dd_clause bit (1), 5 28 2 cd_input bit (1), 5 29 2 cd_output bit (1), 5 30 2 cset_name bit (1), 5 31 2 ss_division bit (1), 5 32 2 repl_jump_ind bit (4), 5 33 2 ided_recovery bit (1), 5 34 2 report_writer bit (5), 5 35 2 ss_desc_entry bit (1), 5 36 2 jump_index fixed bin, 5 37 2 length fixed bin, 5 38 2 name char(0 refer(reserved_word.length)); 5 39 5 40 5 41 5 42 /* end include file ... cobol_TYPE1.incl.pl1 */ 5 43 4 15 4 16 /* END DECLARATION OF TYPE1 (RESERVED WORD) TOKEN */ 4 17 4 18 /* END INCLUDE FILE ... cobol_type1.incl.pl1 */ 4 19 3415 6 1 6 2 /* BEGIN INCLUDE FILE ... cobol_type2.incl.pl1 */ 6 3 /* Last modified on 11/19/76 by ORN */ 6 4 6 5 /* 6 6*A type 2 numeric literal token is entered into the minpral file by the 6 7*lexical analysis phase for each numeric literal encountered in the source 6 8*program. 6 9**/ 6 10 6 11 dcl nlit_ptr ptr; 6 12 6 13 /* BEGIN DECLARATION OF TYPE2 (NUMERIC LITERAL) TOKEN */ 6 14 dcl 1 numeric_lit based (nlit_ptr), 7 1 7 2 /* begin include file ... cobol_TYPE2.incl.pl1 */ 7 3 /* Last modified on 12/28/76 by FCH */ 7 4 7 5 /* header */ 7 6 2 size fixed bin, 7 7 2 line fixed bin, 7 8 2 column fixed bin, 7 9 2 type fixed bin, 7 10 /* body */ 7 11 2 integral bit(1), 7 12 2 floating bit(1), 7 13 2 seg_range bit(1), 7 14 2 filler1 bit(4), 7 15 2 subscript bit(1), 7 16 2 sign char(1), 7 17 2 exp_sign char(1), 7 18 2 exp_places fixed bin, 7 19 2 places_left fixed bin, 7 20 2 places_right fixed bin, 7 21 2 places fixed bin, 7 22 2 literal char(0 refer(numeric_lit.places)); 7 23 7 24 7 25 7 26 /* end include file ... cobol_TYPE2.incl.pl1 */ 7 27 6 15 6 16 /* END DECLARATION OF TYPE2 (NUMERIC LITERAL) TOKEN */ 6 17 6 18 /* END INCLUDE FILE ... cobol_type2.incl.pl1 */ 6 19 3416 8 1 8 2 /* BEGIN INCLUDE FILE ... cobol_type3.incl.pl1 */ 8 3 /* Last modified on 11/19/76 by ORN */ 8 4 8 5 /* 8 6*A type 3 alphanumeric literal token is entered into the minpral file by the 8 7*lexical analysis phase for each alphanumeric literal encountered in the 8 8*source program. 8 9**/ 8 10 8 11 dcl alit_ptr ptr; 8 12 8 13 /* BEGIN DECLARATION OR TYPE3 (ALPHANUMERIC LITERAL) TOKEN */ 8 14 dcl 1 alphanum_lit based (alit_ptr), 9 1 9 2 /* begin include file ... cobol_TYPE3.incl.pl1 */ 9 3 /* Last modified on 11/17/76 by ORN */ 9 4 /* Last modified on 12/28/76 by FCH */ 9 5 9 6 /* header */ 9 7 2 size fixed bin, 9 8 2 line fixed bin, 9 9 2 column fixed bin, 9 10 2 type fixed bin, 9 11 /* body */ 9 12 2 lit_type bit (1), 9 13 2 all_lit bit (1), 9 14 2 filler1 bit (6), 9 15 2 lit_size fixed bin, 9 16 2 string char(0 refer(alphanum_lit.lit_size)); 9 17 9 18 9 19 9 20 /* end include file ... cobol_TYPE3.incl.pl1 */ 9 21 8 15 8 16 /* END DECLARATION OF TYPE3 (ALPHANUMERIC LITERAL) TOKEN */ 8 17 8 18 /* END INCLUDE FILE ... cobol_type3.incl.pl1 */ 8 19 3417 10 1 10 2 /* BEGIN INCLUDE FILE ... cobol_type9.incl.pl1 */ 10 3 /* Last modified on 11/19/76 by ORN */ 10 4 10 5 /* 10 6*A type 9 data name token is entered into the name table by the data 10 7*division syntax phase for each data name described in the data division. 10 8*The replacement phase subsequently replaces type 8 user word references 10 9*to data names in the procedure division minpral file with the corresponding 10 10*type 9 tokens from the name table. 10 11**/ 10 12 10 13 /* dcl dn_ptr ptr; */ 10 14 10 15 /* BEGIN DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 10 16 dcl 1 data_name based (dn_ptr), 11 1 11 2 /* begin include file ... cobol_TYPE9.incl.pl1 */ 11 3 /* Last modified on 06/19/77 by ORN */ 11 4 /* Last modified on 12/28/76 by FCH */ 11 5 11 6 /* header */ 11 7 2 size fixed bin, 11 8 2 line fixed bin, 11 9 2 column fixed bin, 11 10 2 type fixed bin, 11 11 /* body */ 11 12 2 string_ptr ptr, 11 13 2 prev_rec ptr, 11 14 2 searched bit (1), 11 15 2 duplicate bit (1), 11 16 2 saved bit (1), 11 17 2 debug_ind bit (1), 11 18 2 filler2 bit (3), 11 19 2 used_as_sub bit (1), 11 20 2 def_line fixed bin, 11 21 2 level fixed bin, 11 22 2 linkage fixed bin, 11 23 2 file_num fixed bin, 11 24 2 size_rtn fixed bin, 11 25 2 item_length fixed bin(24), 11 26 2 places_left fixed bin, 11 27 2 places_right fixed bin, 11 28 /* description */ 11 29 2 file_section bit (1), 11 30 2 working_storage bit (1), 11 31 2 constant_section bit (1), 11 32 2 linkage_section bit (1), 11 33 2 communication_section bit (1), 11 34 2 report_section bit (1), 11 35 2 level_77 bit (1), 11 36 2 level_01 bit (1), 11 37 2 non_elementary bit (1), 11 38 2 elementary bit (1), 11 39 2 filler_item bit (1), 11 40 2 s_of_rdf bit (1), 11 41 2 o_of_rdf bit (1), 11 42 2 bin_18 bit (1), 11 43 2 bin_36 bit (1), 11 44 2 pic_has_l bit (1), 11 45 2 pic_is_do bit (1), 11 46 2 numeric bit (1), 11 47 2 numeric_edited bit (1), 11 48 2 alphanum bit (1), 11 49 2 alphanum_edited bit (1), 11 50 2 alphabetic bit (1), 11 51 2 alphabetic_edited bit (1), 11 52 2 pic_has_p bit (1), 11 53 2 pic_has_ast bit (1), 11 54 2 item_signed bit(1), 11 55 2 sign_separate bit (1), 11 56 2 display bit (1), 11 57 2 comp bit (1), 11 58 2 ascii_packed_dec_h bit (1), /* as of 8/16/76 this field used for comp8. */ 11 59 2 ascii_packed_dec bit (1), 11 60 2 ebcdic_packed_dec bit (1), 11 61 2 bin_16 bit (1), 11 62 2 bin_32 bit (1), 11 63 2 usage_index bit (1), 11 64 2 just_right bit (1), 11 65 2 compare_argument bit (1), 11 66 2 sync bit (1), 11 67 2 temporary bit (1), 11 68 2 bwz bit (1), 11 69 2 variable_length bit (1), 11 70 2 subscripted bit (1), 11 71 2 occurs_do bit (1), 11 72 2 key_a bit (1), 11 73 2 key_d bit (1), 11 74 2 indexed_by bit (1), 11 75 2 value_numeric bit (1), 11 76 2 value_non_numeric bit (1), 11 77 2 value_signed bit (1), 11 78 2 sign_type bit (3), 11 79 2 pic_integer bit (1), 11 80 2 ast_when_zero bit (1), 11 81 2 label_record bit (1), 11 82 2 sign_clause_occurred bit (1), 11 83 2 okey_dn bit (1), 11 84 2 subject_of_keyis bit (1), 11 85 2 exp_redefining bit (1), 11 86 2 sync_in_rec bit (1), 11 87 2 rounded bit (1), 11 88 2 ad_bit bit (1), 11 89 2 debug_all bit (1), 11 90 2 overlap bit (1), 11 91 2 sum_counter bit (1), 11 92 2 exp_occurs bit (1), 11 93 2 linage_counter bit (1), 11 94 2 rnm_01 bit (1), 11 95 2 aligned bit (1), 11 96 2 not_user_writable bit (1), 11 97 2 database_key bit (1), 11 98 2 database_data_item bit (1), 11 99 2 seg_num fixed bin, 11 100 2 offset fixed bin(24), 11 101 2 initial_ptr fixed bin, 11 102 2 edit_ptr fixed bin, 11 103 2 occurs_ptr fixed bin, 11 104 2 do_rec char(5), 11 105 2 bitt bit (1), 11 106 2 byte bit (1), 11 107 2 half_word bit (1), 11 108 2 word bit (1), 11 109 2 double_word bit (1), 11 110 2 half_byte bit (1), 11 111 2 filler5 bit (1), 11 112 2 bit_offset bit (4), 11 113 2 son_cnt bit (16), 11 114 2 max_red_size fixed bin(24), 11 115 2 name_size fixed bin, 11 116 2 name char(0 refer(data_name.name_size)); 11 117 11 118 11 119 11 120 /* end include file ... cobol_TYPE9.incl.pl1 */ 11 121 10 17 10 18 /* END DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 10 19 10 20 /* END INCLUDE FILE ... cobol_type9.incl.pl1 */ 10 21 3418 12 1 12 2 /* BEGIN INCLUDE FILE ... cobol_type10.incl.pl1 */ 12 3 /* Last modified on 11/19/76 by ORN */ 12 4 /* 12 5*A type 10 index name token is entered into the name table by the data 12 6*division syntax phase for each index name appearing in the data division. 12 7*An index name is declared in the indexed by phrase of an occurs clause. 12 8*maintain the binary byte offset, within the array, corresponding to the 12 9*current setting of the index name. The right-most two bytes contain the 12 10*binary occurrence number to which the index name is set. 12 11*When the replacement phase processes the procedure division minpral file, 12 12*each reference to an index name is replaced with the type 10 token created 12 13*for that index name. 12 14**/ 12 15 12 16 dcl ind_ptr ptr; 12 17 12 18 /* BEGIN DECLARATION OF TYPE10 (INDEX NAME) TOKEN */ 12 19 dcl 1 index_name based (ind_ptr), 13 1 13 2 /* begin include file ... cobol_TYPE10.incl.pl1 13 3*/* Last modified on 01/25/77 by ORN */ 13 4 13 5 /* header */ 13 6 2 size fixed bin, 13 7 2 line fixed bin, 13 8 2 column fixed bin, 13 9 2 type fixed bin, 13 10 /* body */ 13 11 2 string_ptr ptr, 13 12 2 prev_rec ptr, 13 13 2 searched bit(1), 13 14 2 duplicate bit(1), 13 15 2 saved bit(1), 13 16 2 debug_ind bit(1), 13 17 2 filler1 bit(3), 13 18 2 subscript bit(1), 13 19 2 def_line fixed bin, 13 20 2 level fixed bin, 13 21 2 seg_num fixed bin, 13 22 2 offset fixed bin(24), 13 23 2 index_no fixed bin, 13 24 2 min fixed bin, 13 25 2 max fixed bin, 13 26 2 struc_length fixed bin, 13 27 2 cswd_seg fixed bin, 13 28 2 cswd_offset fixed bin(24), 13 29 2 name_size fixed bin, 13 30 2 name char(0 refer(index_name.name_size)); 13 31 13 32 13 33 13 34 /* end include file ... cobol_TYPE10.incl.pl1 */ 13 35 12 20 12 21 /* END DECLARATION OF TYPE10 (INDEX NAME) TOKEN */ 12 22 12 23 /* END INCLUDE FILE ... cobol_type10.incl.pl1 */ 12 24 3419 14 1 14 2 /* BEGIN INCLUDE FILE ... cobol_type19.incl.pl1 */ 14 3 /* last modified on 11/19/76 by ORN */ 14 4 14 5 /* 14 6*A type 19 end of statement token is created in the procedure division 14 7*minpral file at the end of each minpral statement generated by the 14 8*procedure division syntax phase. A minpral statement may be a complete or 14 9*partial source language statement. A type 19 token contains information 14 10*describing the statement which it delimits. 14 11**/ 14 12 14 13 dcl eos_ptr ptr; 14 14 14 15 /* BEGIN DECLARATION OF TYPE19 (END STATEMENT) TOKEN */ 14 16 dcl 1 end_stmt based (eos_ptr), 15 1 15 2 /* begin include file ... cobol_TYPE19.incl.pl1 */ 15 3 /* Last modified on 11/17/76 by ORN */ 15 4 15 5 /* header */ 15 6 2 size fixed bin, 15 7 2 line fixed bin, 15 8 2 column fixed bin, 15 9 2 type fixed bin, 15 10 /* body */ 15 11 2 verb fixed bin, 15 12 2 e fixed bin, 15 13 2 h fixed bin, 15 14 2 i fixed bin, 15 15 2 j fixed bin, 15 16 2 a bit (3), 15 17 2 b bit (1), 15 18 2 c bit (1), 15 19 2 d bit (2), 15 20 2 f bit (2), 15 21 2 g bit (2), 15 22 2 k bit (5), 15 23 2 always_an bit (1); 15 24 15 25 /* end include file ... cobol_TYPE19.incl.pl1 */ 15 26 14 17 14 18 /* END DECLARATION OF TYPE19 (END STATEMENT) TOKEN */ 14 19 14 20 /* 14 21*FIELD CONTENTS 14 22* 14 23*size The total size in bytes of this end of statement token. 14 24*line 0 14 25*column 0 14 26*type 19 14 27*verb A value indicating the verb in this statement 14 28* 1 = accept 14 29* 2 = add 14 30* 3 = on size error 14 31* 4 = alter 14 32* 5 = call 14 33* 7 = cancel 14 34* 8 = close 14 35* 9 = divide 14 36* 10 = multiply 14 37* 11 = subtract 14 38* 12 = exit 14 39* 14 = go 14 40* 15 = merge 14 41* 16 = initiate 14 42* 17 = inspect 14 43* 18 = move 14 44* 19 = open 14 45* 20 = perform 14 46* 21 = read 14 47* 23 = receive 14 48* 24 = release 14 49* 25 = return 14 50* 26 = search 14 51* 27 = rewrite 14 52* 29 = seek 14 53* 30 = send 14 54* 31 = set 14 55* 33 = stop 14 56* 34 = string 14 57* 35 = suspend 14 58* 36 = terminate 14 59* 37 = unstring 14 60* 38 = write 14 61* 39 = use 14 62* 40 = compute 14 63* 41 = disable 14 64* 42 = display 14 65* 43 = enable 14 66* 45 = generate 14 67* 46 = hold 14 68* 48 = process 14 69* 49 = sort 14 70* 52 = procedure 14 71* 53 = declaratives 14 72* 54 = section name 14 73* 55 = paragraph name 14 74* 98 = end 14 75*e,h,i,j The significance of these fields differs with each 14 76* statement. These fields are normally used as counters. 14 77*a,b,c,d,f,g,k The significance of these fields differs with each 14 78* statement. These fields are normally used as indicators. 14 79**/ 14 80 14 81 /* END INCLUDE FILE ... cobol_type19.incl.pl1 */ 14 82 3420 16 1 16 2 /* BEGIN INCLUDE FILE ... cobol_mcdb.incl.pl1 */ 16 3 /* Last modified on 10/31/74 by tlf */ 16 4 16 5 /* DECLARATION OF MCOBOL DEBUGGING SWITCHES */ 16 6 16 7 dcl cobol_mcdb_enable bit (1) ext static; 16 8 dcl cobol_mcdb_flag (1:100) bit (1) ext static; 16 9 16 10 /* ASSIGNMENT OF DEBUGGING SWITCHES */ 16 11 16 12 16 13 dcl mcdb_compare_gen fixed bin int static init (1); 16 14 dcl mcdb_compute_gen fixed bin int static init (2); 16 15 dcl mcdb_bldresop fixed bin int static init (3); 16 16 16 17 16 18 /* END INCLUDE FILE... cobol_mcdb.incl.pl1 */ 16 19 3421 17 1 17 2 /* BEGIN INCLUDE FILE ... cobol_record_types.incl.pl1 */ 17 3 /* <<< LAST MODIFIED ON 09-09-75 by tlf >>> */ 17 4 17 5 dcl rtc_resword fixed bin (15) int static init(1); 17 6 dcl rtc_numlit fixed bin (15) int static init(2); 17 7 dcl rtc_alphalit fixed bin (15) int static init(3); 17 8 dcl rtc_picstring fixed bin (15) int static init(4); 17 9 dcl rtc_diag fixed bin (15) int static init(5); 17 10 dcl rtc_source fixed bin (15) int static init(6); 17 11 dcl rtc_procdef fixed bin (15) int static init(7); 17 12 dcl rtc_userwd fixed bin (15) int static init(8); 17 13 dcl rtc_dataname fixed bin (15) int static init(9); 17 14 dcl rtc_indexname fixed bin (15) int static init(10); 17 15 dcl rtc_condname fixed bin (15) int static init(11); 17 16 dcl rtc_filedef fixed bin (15) int static init(12); 17 17 dcl rtc_commdesc fixed bin (15) int static init(13); 17 18 dcl rtc_debugitems fixed bin (15) int static init(14); 17 19 dcl rtc_savedarea fixed bin (15) int static init(15); 17 20 dcl rtc_sortmerge fixed bin (15) int static init(16); 17 21 dcl rtc_mnemonic fixed bin (15) int static init(17); 17 22 dcl rtc_pararef fixed bin (15) int static init(18); 17 23 dcl rtc_eos fixed bin (15) int static init(19); 17 24 dcl rtc_reportname fixed bin (15) int static init(20); 17 25 dcl rtc_groupname fixed bin (15) int static init(21); 17 26 dcl rtc_reportentry fixed bin (15) int static init(22); 17 27 dcl rtc_unknown1 fixed bin (15) int static init(23); 17 28 dcl rtc_debugenable fixed bin (15) int static init(24); 17 29 dcl rtc_unknown2 fixed bin (15) int static init(25); 17 30 dcl rtc_unknown3 fixed bin (15) int static init(26); 17 31 dcl rtc_unknown4 fixed bin (15) int static init(27); 17 32 dcl rtc_unknown5 fixed bin (15) int static init(28); 17 33 dcl rtc_unknown6 fixed bin (15) int static init(29); 17 34 dcl rtc_internal_tag fixed bin (15) int static init(30); 17 35 dcl rtc_equate_tag fixed bin (15) int static init(31); 17 36 dcl rtc_register fixed bin (15) int static init(100); 17 37 dcl rtc_fdec_temp fixed bin (15) int static init(101); 17 38 dcl rtc_immed_const fixed bin (15) int static init(102); 17 39 17 40 /* END INCLUDE FILE ... cobol_record_types.incl.pl1 */ 17 41 3422 18 1 18 2 /* BEGIN INCLUDE FILE ... cobol_in_token.incl.pl1 */ 18 3 18 4 /* Last modified August 22, 1974 by AEG */ 18 5 18 6 18 7 declare in_token_ptr ptr; 18 8 18 9 declare 1 in_token aligned based(in_token_ptr), 18 10 2 n fixed bin aligned, 18 11 2 code fixed bin aligned, 18 12 2 token_ptr(0 refer(in_token.n)) ptr aligned; 18 13 18 14 18 15 /* END INCLUDE FILE ... cobol_in_token.incl.pl1 */ 18 16 3423 19 1 19 2 /* BEGIN INCLUDE FILE ... cobol_addr_tokens.incl.pl1 */ 19 3 19 4 19 5 /****^ HISTORY COMMENTS: 19 6* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8058), 19 7* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 19 8* MCR8058 cobol_addr_tokens.incl.pl1 Change array extents to refer to 19 9* constants rather than variables. 19 10* END HISTORY COMMENTS */ 19 11 19 12 19 13 /* Last modified on 10/1/74 by tg */ 19 14 19 15 19 16 /* parameter list */ 19 17 19 18 dcl (input_ptr, inst_ptr, reloc_ptr) ptr; 19 19 19 20 19 21 /* input_struc_basic is used for type 1 addressing */ 19 22 19 23 dcl 1 input_struc_basic based (input_ptr), 19 24 2 type fixed bin, 19 25 2 operand_no fixed bin, 19 26 2 lock fixed bin, 19 27 2 segno fixed bin, 19 28 2 char_offset fixed bin (24), 19 29 2 send_receive fixed bin; 19 30 19 31 19 32 dcl 1 input_struc based (input_ptr), 19 33 2 type fixed bin, 19 34 2 operand_no fixed bin, 19 35 2 lock fixed bin, 19 36 2 operand (0 refer (input_struc.operand_no)), 19 37 3 token_ptr ptr, 19 38 3 send_receive fixed bin, 19 39 3 ic_mod fixed bin, 19 40 3 size_sw fixed bin; 19 41 19 42 /* reloc_struc is used for all types of addressing * all types */ 19 43 19 44 dcl 1 reloc_struc (input_struc.operand_no + 1) based (reloc_ptr), 19 45 2 left_wd bit (5) aligned, 19 46 2 right_wd bit (5) aligned; 19 47 19 48 /* Instruction format for 1 word instruction */ 19 49 19 50 19 51 dcl 1 inst_struc_basic based (inst_ptr) aligned, 19 52 2 y unaligned, 19 53 3 pr bit (3) unaligned, 19 54 3 wd_offset bit (15) unaligned, 19 55 2 fill1_op bit (10) unaligned, 19 56 2 zero1 bit (1) unaligned, 19 57 2 pr_spec bit (1) unaligned, 19 58 2 tm bit (2) unaligned, 19 59 2 td bit (4) unaligned; 19 60 19 61 19 62 /* The detailed definitions of the fields in this structure 19 63* can be found in the GMAP manual section 8 */ 19 64 /* EIS instruction format for 2_4 word instructions */ 19 65 19 66 dcl 1 inst_struc based (inst_ptr) aligned, 19 67 2 inst unaligned, 19 68 3 zero1 bit (2) unaligned, 19 69 3 mf3 unaligned, 19 70 4 pr_spec bit (1) unaligned, 19 71 4 reg_or_length bit (1) unaligned, 19 72 4 zero2 bit (1) unaligned, 19 73 4 reg_mod bit (4) unaligned, 19 74 3 zero3 bit (2) unaligned, 19 75 3 mf2 unaligned, 19 76 4 pr_spec bit (1) unaligned, 19 77 4 reg_or_length bit (1) unaligned, 19 78 4 zero4 bit (1) unaligned, 19 79 4 reg_mod bit (4) unaligned, 19 80 3 fill1_op bit (10) unaligned, 19 81 3 zero5 bit (1) unaligned, 19 82 3 mf1 unaligned, 19 83 4 pr_spec bit (1) unaligned, 19 84 4 reg_or_length bit (1) unaligned, 19 85 4 zero6 bit (1) unaligned, 19 86 4 reg_mod bit (4) unaligned, 19 87 2 desc_ext unaligned, 19 88 3 desc (512) unaligned, 19 89 4 desc_od bit (36) unaligned; 19 90 19 91 /* The detailed definitions of the fields in this structure 19 92* can be found in the GMAP manual section 8. 19 93* The desc_ext is the descriptor extension of this eis 19 94* instruction. The number of descriptors associated with 19 95* this instruction is equavalent to the operand number. 19 96* Depending on operand data type, the descriptor 19 97* can be alphanumeric or numeric. The structures of the 19 98* alphanumeric and the numeric descriptors are defined 19 99* below. */ 19 100 19 101 /* alphanumeric descriptor format */ 19 102 19 103 dcl 1 desc_an based (desc_an_ptr) unaligned, 19 104 2 desc_f (512) unaligned, 19 105 3 y unaligned, 19 106 4 pr bit (3) unaligned, 19 107 4 wd_offset bit (15) unaligned, 19 108 3 char_n bit (3) unaligned, 19 109 3 zero1 bit (1) unaligned, 19 110 3 ta bit (2), 19 111 3 n bit (12) unaligned; 19 112 19 113 19 114 /* The detailed definitions of the fields in this structure can 19 115* be found in the GMAP manual section 8. */ 19 116 /* numeric descriptor format */ 19 117 19 118 dcl desc_nn_ptr ptr; 19 119 dcl desc_an_ptr ptr; 19 120 19 121 19 122 dcl 1 desc_nn based (desc_nn_ptr) unaligned, 19 123 2 desc_f (512) unaligned, 19 124 3 y unaligned, 19 125 4 pr bit (3) unaligned, 19 126 4 wd_offset bit (15) unaligned, 19 127 3 digit_n bit (3) unaligned, 19 128 3 tn bit (1) unaligned, 19 129 3 sign_type bit (2) unaligned, 19 130 3 scal bit (6) unaligned, 19 131 3 n bit (6) unaligned; 19 132 19 133 19 134 /* The detailed definitions of fields in this structure can 19 135* be found in the GMAP manual section 8. */ 19 136 /* END INCLUDE FILE ... cobol_addr_tokens.incl.pl1 */ 19 137 3424 20 1 20 2 /* BEGIN INCLUDE FILE ... cobol_fixed_common.incl.pl1 */ 20 3 /* Modified on 10/27/82 by FCH, [5.1-1], cobol_cln added to save last line num, BUG543(phx13643) */ 20 4 /* Modified on 07/31/80 by FCH, [4.3-1], use_reporting field added for Report Writer */ 20 5 /* Modified on 03/30/79 by FCH, [4.1-1], -card option added */ 20 6 /* Modified on 03/30/79 by FCH, [4.0-2], -svNM option added */ 20 7 /* Modified on 03/02/79 by FCH, [4.0-1], -levNM option added */ 20 8 /* Modified by RAL on 10/13/78, [4.0-0], Added option exp from fil2. */ 20 9 /* Modified by BC on 06/20/77, descriptor added. */ 20 10 /* Modified by BC on 06/02/77, init_cd_seg, init_cd_offset added. */ 20 11 /* Modified by BC on 1/21/77, options.profile added. */ 20 12 /* Modified by FCH on 7/6/76, sysin_fno & sysout_fno deleted, accept_device & display_device added */ 20 13 /* Modified by FCH on 5/20/77, comp_level added */ 20 14 20 15 20 16 /* THE SIZE OF THIS STRUCTURE IN BYTES, (EXCLUDING VARIABLE 20 17* LENGTH ENTITIES), FOR EACH HARDWARE IMPLEMENTATION IS: 20 18* 20 19* HARDWARE | SIZE (BYTES) 20 20* --------------------------------- 20 21* 645/6180 | 464 20 22* P7 | 396 20 23* --------------------------------- 20 24* */ 20 25 20 26 dcl 1 fixed_common based ( cobol_com_ptr), 20 27 2 prog_name char (30), 20 28 2 compiler_rev_no char (25), 20 29 2 phase_name char (6), 20 30 2 currency char (1), 20 31 2 fatal_no fixed bin, 20 32 2 warn_no fixed bin, 20 33 2 proc_counter fixed bin, 20 34 2 spec_tag_counter fixed bin, 20 35 2 file_count fixed bin, 20 36 2 filedescr_offsets (20) char (5), 20 37 2 perf_alter_info char (5), 20 38 2 another_perform_info char (5), 20 39 2 sort_in_info char (5), 20 40 2 odo_info char (5), 20 41 2 size_seg fixed bin, 20 42 2 size_offset fixed bin(24), 20 43 2 size_perform_info char (5), 20 44 2 rename_info char (5), 20 45 2 report_names char (5), 20 46 2 rw_buf_seg fixed bin, 20 47 2 rw_buf_offset fixed bin(24), 20 48 2 rw_buf_length fixed bin(24), 20 49 2 file_keys char (5), 20 50 2 search_keys char (5), 20 51 2 dd_seg_size fixed bin(24), 20 52 2 pd_seg_size fixed bin(24), 20 53 2 seg_limit fixed bin , 20 54 2 number_of_dd_segs fixed bin, 20 55 2 seg_info char (5), 20 56 2 number_of_ls_pointers fixed bin, 20 57 2 link_sec_seg fixed bin, 20 58 2 link_sec_offset fixed bin(24), 20 59 2 sra_clauses fixed bin, 20 60 2 fix_up_info char (5), 20 61 2 linage_info char (5), 20 62 2 first_dd_item char (5), 20 63 2 sort_out_info char (5), 20 64 2 db_info char (5), 20 65 2 realm_info char (5), 20 66 2 rc_realm_info char (5), 20 67 2 last_file_key char (5), 20 68 2 prog_coll_seq fixed bin, 20 69 2 init_cd_seg fixed bin, 20 70 2 init_cd_offset fixed bin(24), 20 71 2 input_error_exit fixed bin, 20 72 2 output_error_exit fixed bin, 20 73 2 i_o_error_exit fixed bin, 20 74 2 extend_error_exit fixed bin, 20 75 2 dummy15 fixed bin, 20 76 2 options, 20 77 3 cu bit (1), 20 78 3 st bit (1), 20 79 3 wn bit (1), 20 80 3 obs bit (1), 20 81 3 dm bit (1), 20 82 3 xrl bit (1), 20 83 3 xrn bit (1), 20 84 3 src bit (1), 20 85 3 obj bit (1), 20 86 3 exs bit (1), 20 87 3 sck bit (1), 20 88 3 rno bit (1), 20 89 3 u_l bit (1), 20 90 3 cnv bit (1), 20 91 3 cos bit (1), 20 92 3 fmt bit (1), 20 93 3 profile bit(1), 20 94 3 nw bit (1), 20 95 3 exp bit (1), /* [4.0-0] */ 20 96 3 card bit (1), /*[4.1-1]*/ 20 97 3 fil2 bit (5), 20 98 3 m_map bit (1), 20 99 3 m_bf bit (1), 20 100 3 m_fat bit (1), 20 101 3 m_wn bit (1), 20 102 3 m_obs bit(1), 20 103 3 pd bit(1), 20 104 3 oc bit(1), 20 105 2 supervisor bit (1), 20 106 2 dec_comma bit (1), 20 107 2 init_cd bit (1), 20 108 2 corr bit (1), 20 109 2 initl bit (1), 20 110 2 debug bit (1), 20 111 2 report bit (1), 20 112 2 sync_in_prog bit (1), 20 113 2 pd_section bit (1), 20 114 2 list_switch bit (1), 20 115 2 alpha_cond bit (1), 20 116 2 num_cond bit (1), 20 117 2 spec_sysin bit (1), 20 118 2 spec_sysout bit (1), 20 119 2 cpl_files bit (1), 20 120 2 obj_dec_comma bit (1), 20 121 2 default_sign_type bit (3), 20 122 2 use_debug bit(1), 20 123 2 syntax_trace bit(1), 20 124 2 comp_defaults, 20 125 3 comp bit(1), 20 126 3 comp_1 bit(1), 20 127 3 comp_2 bit(1), 20 128 3 comp_3 bit(1), 20 129 3 comp_4 bit(1), 20 130 3 comp_5 bit(1), 20 131 3 comp_6 bit(1), 20 132 3 comp_7 bit(1), 20 133 3 comp_8 bit(1), 20 134 2 disp_defaults, 20 135 3 disp bit(1), 20 136 3 disp_1 bit(1), 20 137 3 disp_2 bit(1), 20 138 3 disp_3 bit(1), 20 139 3 disp_4 bit(1), 20 140 3 disp_5 bit(1), 20 141 3 disp_6 bit(1), 20 142 3 disp_7 bit(1), 20 143 2 descriptor bit(2), 20 144 2 levsv bit(3), /*[4.0-1]*/ 20 145 2 use_reporting bit(1), /*[4.3-1]*/ 20 146 2 cd bit(1), /*[4.4-1]*/ 20 147 2 dummy17 bit(3), 20 148 2 lvl_rstr bit(32), 20 149 2 inst_rstr bit(32), 20 150 2 comp_level char(1), 20 151 2 dummy18 char(30), 20 152 2 object_sign char (1), 20 153 2 last_print_rec char (5), 20 154 2 coll_seq_info char (5), 20 155 2 sys_status_seg fixed bin, 20 156 2 sys_status_offset fixed bin(24), 20 157 2 compiler_id fixed bin, 20 158 2 date_comp_ln fixed bin, 20 159 2 compile_mode bit(36), 20 160 2 default_temp fixed bin, 20 161 2 accept_device fixed bin, 20 162 2 display_device fixed bin, 20 163 2 cobol_cln fixed bin, /*[5.1-1]*/ 20 164 2 alphabet_offset fixed bin; 20 165 20 166 20 167 20 168 /* END INCLUDE FILE ... cobol_fixed_common.incl.pl1 */ 20 169 3425 21 1 21 2 /* BEGIN INCLUDE FILE ... cobol_ext_.incl.pl1 */ 21 3 /* Last modified on 06/17/76 by ORN */ 21 4 /* Last modified on 12/28/76 by FCH */ 21 5 /* Last modified on 12/01/80 by FCH */ 21 6 21 7 /* <<< SHARED EXTERNALS INCLUDE FILE >>> */ 21 8 21 9 21 10 dcl cobol_ext_$cobol_afp ptr ext; 21 11 dcl cobol_afp ptr defined ( cobol_ext_$cobol_afp); 21 12 dcl cobol_ext_$cobol_analin_fileno ptr ext; 21 13 dcl cobol_analin_fileno ptr defined ( cobol_ext_$cobol_analin_fileno); 21 14 dcl cobol_ext_$report_first_token ptr ext; 21 15 dcl report_first_token ptr defined( cobol_ext_$report_first_token); 21 16 dcl cobol_ext_$report_last_token ptr ext; 21 17 dcl report_last_token ptr defined ( cobol_ext_$report_last_token); 21 18 dcl cobol_ext_$cobol_eltp ptr ext; 21 19 dcl cobol_eltp ptr defined ( cobol_ext_$cobol_eltp); 21 20 dcl cobol_ext_$cobol_cmfp ptr ext; 21 21 dcl cobol_cmfp ptr defined ( cobol_ext_$cobol_cmfp); 21 22 dcl cobol_ext_$cobol_com_fileno ptr ext; 21 23 dcl cobol_com_fileno ptr defined ( cobol_ext_$cobol_com_fileno); 21 24 dcl cobol_ext_$cobol_com_ptr ptr ext; 21 25 dcl cobol_com_ptr ptr defined ( cobol_ext_$cobol_com_ptr); 21 26 dcl cobol_ext_$cobol_dfp ptr ext; 21 27 dcl cobol_dfp ptr defined ( cobol_ext_$cobol_dfp); 21 28 dcl cobol_ext_$cobol_hfp ptr ext; 21 29 dcl cobol_hfp ptr defined ( cobol_ext_$cobol_hfp); 21 30 dcl cobol_ext_$cobol_m1fp ptr ext; 21 31 dcl cobol_m1fp ptr defined ( cobol_ext_$cobol_m1fp); 21 32 dcl cobol_ext_$cobol_m2fp ptr ext; 21 33 dcl cobol_m2fp ptr defined ( cobol_ext_$cobol_m2fp); 21 34 dcl cobol_ext_$cobol_min1_fileno ptr ext; 21 35 dcl cobol_min1_fileno ptr defined ( cobol_ext_$cobol_min1_fileno); 21 36 dcl cobol_ext_$cobol_min2_fileno_ptr ptr ext; 21 37 dcl cobol_min2_fileno_ptr ptr defined ( cobol_ext_$cobol_min2_fileno_ptr); 21 38 dcl cobol_ext_$cobol_name_fileno ptr ext; 21 39 dcl cobol_name_fileno ptr defined ( cobol_ext_$cobol_name_fileno); 21 40 dcl cobol_ext_$cobol_name_fileno_ptr ptr ext; 21 41 dcl cobol_name_fileno_ptr ptr defined ( cobol_ext_$cobol_name_fileno_ptr); 21 42 dcl cobol_ext_$cobol_ntfp ptr ext; 21 43 dcl cobol_ntfp ptr defined ( cobol_ext_$cobol_ntfp); 21 44 dcl cobol_ext_$cobol_pdofp ptr ext; 21 45 dcl cobol_pdofp ptr defined ( cobol_ext_$cobol_pdofp); 21 46 dcl cobol_ext_$cobol_pfp ptr ext; 21 47 dcl cobol_pfp ptr defined ( cobol_ext_$cobol_pfp); 21 48 dcl cobol_ext_$cobol_rm2fp ptr ext; 21 49 dcl cobol_rm2fp ptr defined ( cobol_ext_$cobol_rm2fp); 21 50 dcl cobol_ext_$cobol_rmin2fp ptr ext; 21 51 dcl cobol_rmin2fp ptr defined ( cobol_ext_$cobol_rmin2fp); 21 52 dcl cobol_ext_$cobol_curr_in ptr ext; 21 53 dcl cobol_curr_in ptr defined ( cobol_ext_$cobol_curr_in); 21 54 dcl cobol_ext_$cobol_curr_out ptr ext; 21 55 dcl cobol_curr_out ptr defined ( cobol_ext_$cobol_curr_out); 21 56 dcl cobol_ext_$cobol_sfp ptr ext; 21 57 dcl cobol_sfp ptr defined ( cobol_ext_$cobol_sfp); 21 58 dcl cobol_ext_$cobol_w1p ptr ext; 21 59 dcl cobol_w1p ptr defined ( cobol_ext_$cobol_w1p); 21 60 dcl cobol_ext_$cobol_w2p ptr ext; 21 61 dcl cobol_w2p ptr defined ( cobol_ext_$cobol_w2p); 21 62 dcl cobol_ext_$cobol_w3p ptr ext; 21 63 dcl cobol_w3p ptr defined ( cobol_ext_$cobol_w3p); 21 64 dcl cobol_ext_$cobol_w5p ptr ext; 21 65 dcl cobol_w5p ptr defined ( cobol_ext_$cobol_w5p); 21 66 dcl cobol_ext_$cobol_w6p ptr ext; 21 67 dcl cobol_w6p ptr defined ( cobol_ext_$cobol_w6p); 21 68 dcl cobol_ext_$cobol_w7p ptr ext; 21 69 dcl cobol_w7p ptr defined ( cobol_ext_$cobol_w7p); 21 70 dcl cobol_ext_$cobol_x3fp ptr ext; 21 71 dcl cobol_x3fp ptr defined ( cobol_ext_$cobol_x3fp); 21 72 dcl cobol_ext_$cobol_rwdd ptr ext; 21 73 dcl cobol_rwdd ptr defined(cobol_ext_$cobol_rwdd); 21 74 dcl cobol_ext_$cobol_rwpd ptr ext; 21 75 dcl cobol_rwpd ptr defined(cobol_ext_$cobol_rwpd); 21 76 21 77 21 78 dcl cobol_ext_$cobol_fileno1 fixed bin(24)ext; 21 79 dcl cobol_fileno1 fixed bin(24)defined ( cobol_ext_$cobol_fileno1); 21 80 dcl cobol_ext_$cobol_options_len fixed bin(24)ext; 21 81 dcl cobol_options_len fixed bin(24)defined ( cobol_ext_$cobol_options_len); 21 82 dcl cobol_ext_$cobol_pdout_fileno fixed bin(24)ext; 21 83 dcl cobol_pdout_fileno fixed bin(24)defined ( cobol_ext_$cobol_pdout_fileno); 21 84 dcl cobol_ext_$cobol_print_fileno fixed bin(24)ext; 21 85 dcl cobol_print_fileno fixed bin(24)defined ( cobol_ext_$cobol_print_fileno); 21 86 dcl cobol_ext_$cobol_rmin2_fileno fixed bin(24)ext; 21 87 dcl cobol_rmin2_fileno fixed bin(24)defined ( cobol_ext_$cobol_rmin2_fileno); 21 88 dcl cobol_ext_$cobol_x1_fileno fixed bin(24)ext; 21 89 dcl cobol_x1_fileno fixed bin(24)defined ( cobol_ext_$cobol_x1_fileno); 21 90 dcl cobol_ext_$cobol_x2_fileno fixed bin(24)ext; 21 91 dcl cobol_x2_fileno fixed bin(24)defined ( cobol_ext_$cobol_x2_fileno); 21 92 dcl cobol_ext_$cobol_x3_fileno fixed bin(24)ext; 21 93 dcl cobol_x3_fileno fixed bin(24)defined ( cobol_ext_$cobol_x3_fileno); 21 94 21 95 dcl cobol_ext_$cobol_lpr char (5) ext; 21 96 dcl cobol_lpr char (5) defined ( cobol_ext_$cobol_lpr); /* -2- */ 21 97 dcl cobol_ext_$cobol_options char (120) ext; 21 98 dcl cobol_options char (120) defined ( cobol_ext_$cobol_options); /* -30- */ 21 99 21 100 dcl cobol_ext_$cobol_xlast8 bit (1) ext; 21 101 dcl cobol_xlast8 bit (1) defined ( cobol_ext_$cobol_xlast8); /* -1- */ 21 102 dcl cobol_ext_$report_exists bit (1) ext; 21 103 dcl report_exists bit (1) defined ( cobol_ext_$report_exists); 21 104 21 105 21 106 /* <<< END OF SHARED EXTERNALS INCLUDE FILE >>> */ 21 107 /* END INCLUDE FILE ... cobol_ext_.incl.pl1 */ 21 108 3426 3427 3428 end cobol_compare_gen; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0830.3 cobol_compare_gen.pl1 >spec>install>MR12.3-1048>cobol_compare_gen.pl1 3413 1 11/11/82 1712.7 cobol_.incl.pl1 >ldd>include>cobol_.incl.pl1 3414 2 03/27/82 0439.8 cobol_type40.incl.pl1 >ldd>include>cobol_type40.incl.pl1 2-14 3 11/11/82 1712.8 cobol_TYPE40.incl.pl1 >ldd>include>cobol_TYPE40.incl.pl1 3415 4 03/27/82 0439.8 cobol_type1.incl.pl1 >ldd>include>cobol_type1.incl.pl1 4-15 5 11/11/82 1712.8 cobol_TYPE1.incl.pl1 >ldd>include>cobol_TYPE1.incl.pl1 3416 6 03/27/82 0439.8 cobol_type2.incl.pl1 >ldd>include>cobol_type2.incl.pl1 6-15 7 11/11/82 1712.8 cobol_TYPE2.incl.pl1 >ldd>include>cobol_TYPE2.incl.pl1 3417 8 03/27/82 0439.8 cobol_type3.incl.pl1 >ldd>include>cobol_type3.incl.pl1 8-15 9 11/11/82 1712.8 cobol_TYPE3.incl.pl1 >ldd>include>cobol_TYPE3.incl.pl1 3418 10 03/27/82 0439.9 cobol_type9.incl.pl1 >ldd>include>cobol_type9.incl.pl1 10-17 11 11/11/82 1712.7 cobol_TYPE9.incl.pl1 >ldd>include>cobol_TYPE9.incl.pl1 3419 12 03/27/82 0439.8 cobol_type10.incl.pl1 >ldd>include>cobol_type10.incl.pl1 12-20 13 11/11/82 1712.7 cobol_TYPE10.incl.pl1 >ldd>include>cobol_TYPE10.incl.pl1 3420 14 03/27/82 0439.8 cobol_type19.incl.pl1 >ldd>include>cobol_type19.incl.pl1 14-17 15 03/27/82 0439.6 cobol_TYPE19.incl.pl1 >ldd>include>cobol_TYPE19.incl.pl1 3421 16 03/27/82 0439.7 cobol_mcdb.incl.pl1 >ldd>include>cobol_mcdb.incl.pl1 3422 17 03/27/82 0439.8 cobol_record_types.incl.pl1 >ldd>include>cobol_record_types.incl.pl1 3423 18 11/11/82 1712.7 cobol_in_token.incl.pl1 >ldd>include>cobol_in_token.incl.pl1 3424 19 05/24/89 0811.7 cobol_addr_tokens.incl.pl1 >spec>install>MR12.3-1048>cobol_addr_tokens.incl.pl1 3425 20 11/11/82 1712.8 cobol_fixed_common.incl.pl1 >ldd>include>cobol_fixed_common.incl.pl1 3426 21 03/27/82 0431.3 cobol_ext_.incl.pl1 >ldd>include>cobol_ext_.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. LP 000530 automatic pointer dcl 1743 set ref 1786* 1791* 1796 1801 1811 1835 1849 LPL 000536 automatic fixed bin(17,0) dcl 1745 set ref 1801* 1808 LS 000534 automatic fixed bin(17,0) dcl 1745 set ref 1796* 1821 1845 1849 RP 000532 automatic pointer dcl 1743 set ref 1788* 1792* 1798 1804 1824 1835 1857 RPL 000537 automatic fixed bin(17,0) dcl 1745 set ref 1804* 1808 RS 000535 automatic fixed bin(17,0) dcl 1745 set ref 1798* 1821 1824 1845 1857 SI 000540 automatic fixed bin(17,0) dcl 1745 set ref 1808* 1811 1811 1821 1835 1845 1849 1849 SO 000541 automatic fixed bin(17,0) dcl 1745 set ref 1821* 1824 1835 1835 1845 1845 1849 1849 1857 1857 ZERO 005726 constant char(32) initial packed unaligned dcl 1735 ref 1811 1824 1849 1857 abbreviated 0(02) based bit(1) level 2 packed packed unaligned dcl 822 ref 1103 addr builtin function dcl 3406 ref 862 865 866 916 961 963 963 1016 1045 1060 1060 1101 1258 1260 1278 1288 1320 1321 1323 1323 1326 1326 1416 1462 1553 1555 1555 1636 1636 1659 1659 1677 1677 1878 1962 1962 1974 1981 2011 2011 2016 2016 2096 2121 2142 2231 2425 2444 2451 2451 2469 2484 2484 2486 2523 2531 2547 2547 2596 2689 2691 2712 2714 2776 2793 2793 2851 2858 2888 2895 2974 3122 3153 3167 3194 3196 3244 3246 3246 3251 3253 3253 3260 3270 3274 3285 3289 addrel builtin function dcl 3406 ref 3369 alit_buffer 001014 automatic fixed bin(17,0) array dcl 2323 set ref 2596 alit_ptr 000214 automatic pointer dcl 8-11 set ref 2360* 2361 2369 2381 2596* 2598 2599 2600 2601 2602 2603 2604 2605 2610* all_lit 4(01) based bit(1) level 2 packed packed unaligned dcl 8-14 set ref 2361 2603* alpha_flag 000157 automatic bit(1) packed unaligned dcl 834 set ref 876* 884* 887* 2577 alpha_name_ptr 000210 automatic pointer dcl 2-10 set ref 875* 883* 2579 2581 alpha_tct_table 000412 internal static bit(9) initial array packed unaligned dcl 348 set ref 2691 alpha_tct_table_allocated 000410 internal static fixed bin(17,0) initial dcl 339 set ref 2686 2697* alphabet_name based structure level 1 unaligned dcl 2-13 alphabetic 21(21) based bit(1) level 2 packed packed unaligned dcl 10-16 ref 2091 2116 alphabetic_edited 21(22) based bit(1) level 2 packed packed unaligned dcl 10-16 ref 2091 2116 alphanum 21(19) based bit(1) level 2 packed packed unaligned dcl 10-16 set ref 2091 2116 2429* 2525* 2554* 2834* 2977* 3132* alphanum_edited 21(20) based bit(1) level 2 packed packed unaligned dcl 10-16 ref 2091 2116 alphanum_lit based structure level 1 unaligned dcl 8-14 ascii_packed_dec 21(30) based bit(1) level 2 packed packed unaligned dcl 10-16 ref 2500 bin_18 21(13) based bit(1) level 2 packed packed unaligned dcl 10-16 ref 977 1265 1269 1310 1312 1358 1376 2496 bin_18_type19 001362 internal static structure level 1 unaligned dcl 1242 set ref 1321 bin_18_type9 001326 internal static structure level 1 unaligned dcl 1228 set ref 1320 1326 1326 bin_36 21(14) based bit(1) level 2 packed packed unaligned dcl 10-16 ref 977 1265 1269 1331 1358 1376 1618 1651 1916 1944 2498 bin_36_buff 000455 automatic char(120) packed unaligned dcl 1702 set ref 1981 bin_36_lop 001272 internal static structure level 1 unaligned dcl 1214 set ref 1278 bin_36_rop 001236 internal static structure level 1 unaligned dcl 1200 set ref 1288 binary builtin function dcl 3406 ref 1936 3050 both_numeric 000253 automatic bit(1) packed unaligned dcl 1085 set ref 1118* 1135* 1149 buff1 000266 automatic fixed bin(17,0) array dcl 1181 set ref 1258 buff2 000336 automatic fixed bin(17,0) array dcl 1182 set ref 1260 changed_descrip_bits 001145 automatic bit(1) packed unaligned dcl 2341 set ref 2355* 2551 cmpc_filler 000702 automatic char(1) packed unaligned dcl 2069 set ref 2084* 2104* 2129* 2189* 2222 cmpc_op constant bit(10) initial packed unaligned dcl 282 ref 2218 cmpn_op constant bit(10) initial packed unaligned dcl 281 ref 1007 1409 cobol_$compile_count 001474 external static fixed bin(17,0) dcl 1-142 ref 955 965 1551 1557 2686 2697 2709 2720 3190 3201 3238 3256 cobol_$main_pcs_ptr 001466 external static pointer dcl 1-84 ref 881 883 2189 cobol_$next_tag 001472 external static fixed bin(17,0) dcl 1-128 set ref 3145 3146* 3146 cobol_$temp_token_ptr 001464 external static pointer dcl 1-44 set ref 3368 3369* 3369 cobol_$text_wd_off 001470 external static fixed bin(17,0) dcl 1-90 ref 922 1051 1466 2236 2906 3149 3227 cobol_addr 001432 constant entry external dcl 230 ref 1002 1403 1633 1671 1959 1991 2212 3017 3039 3068 cobol_alloc$stack 001446 constant entry external dcl 239 ref 1317 2404 2506 2765 2847 cobol_define_tag 001456 constant entry external dcl 245 ref 3319 cobol_emit 001434 constant entry external dcl 231 ref 930 1011 1060 1413 1475 1642 1659 1674 1968 1995 2011 2226 2244 2910 3026 3055 3077 3163 3224 cobol_get_index_value 001460 constant entry external dcl 246 ref 1564 2484 cobol_make_tagref 001426 constant entry external dcl 227 ref 935 1066 1481 2249 2915 3183 3227 cobol_make_type9$copy 001452 constant entry external dcl 241 ref 3126 cobol_make_type9$long_bin 001444 constant entry external dcl 237 ref 1983 cobol_make_type9$type2_3 001430 constant entry external dcl 228 ref 963 1544 1555 2361 2375 2471 2610 3246 3253 cobol_move_gen 001450 constant entry external dcl 240 ref 1323 2451 2547 2793 cobol_num_to_udts 001462 constant entry external dcl 248 ref 1569 cobol_pool$search_op 001454 constant entry external dcl 243 ref 1976 2962 cobol_register$load 001440 constant entry external dcl 234 ref 1636 1962 cobol_register$release 001442 constant entry external dcl 235 ref 1677 2016 cobol_trans_alphabet 001436 constant entry external dcl 232 ref 2189 code 1 001266 automatic fixed bin(17,0) level 2 in structure "move_token" dcl 2666 in procedure "class_condition" set ref 2784* code 1 000716 automatic fixed bin(17,0) level 2 in structure "move_token" dcl 2313 in procedure "convert_to_alpha" set ref 2538* column 2 based fixed bin(17,0) level 2 dcl 8-14 set ref 2600* compare_inst 001412 internal static bit(36) initial array packed unaligned dcl 1709 set ref 2006* 2009* 2011 2011 continue 000252 automatic bit(1) packed unaligned dcl 1084 set ref 1119* 1123 1134* 1143* copied_token_ptr parameter pointer dcl 3337 set ref 3328 3364 3368* 3376 copy_string based char(1000) packed unaligned dcl 3359 set ref 3376* count 001266 automatic fixed bin(17,0) level 2 dcl 2666 set ref 2783* data_name based structure level 1 unaligned dcl 10-16 descrip based bit(72) packed unaligned dcl 2655 in procedure "class_condition" set ref 2859* 2975* descrip based bit(72) packed unaligned dcl 2329 in procedure "convert_to_alpha" set ref 2426* 2524* descrip_ptr 001134 automatic pointer dcl 2328 in procedure "convert_to_alpha" set ref 2425* 2426 2523* 2524 descrip_ptr 001246 automatic pointer dcl 2654 in procedure "class_condition" set ref 2858* 2859 2974* 2975 display 21(27) based bit(1) level 2 packed packed unaligned dcl 10-16 set ref 2430* 2526* 2863* 2978* dn_buff based fixed bin(17,0) array dcl 2338 set ref 2413* 2514* dn_ptr 000204 automatic pointer dcl 852 set ref 974* 977 977 977 977 977 977 983* 985* 992 1356* 1358 1358 1358 1358 1358 1358 1358 1358 1358 1373* 1376 1376 1376 1376 1376 1376 1376 1376 1376 1541* 1544 1548 1564 1564 2090* 2091 2091 2091 2091 2091 2091 2114* 2116 2116 2116 2116 2116 2116 2351* 2357 2409* 2417 2419 2424 2425 2428 2429 2430 2432 2433 2434 2462 2462 2462 2466 2474* 2477 2477 2477 2493 2493 2493 2495 2496 2498 2500 2500 2500 2508 2509* 2518 2519 2520 2523 2525 2526 2527 2549* 2553 2554 2561 2564 2690* 2713* 2851* 2853 2854 2855 2858 2861 2862 2863 2864 2867 2967 2968 2970 2971 2974 2977 2978 2979 2980 3122* 3126* 3131 3132 3133 3134 3136 3136 3136 3136 3136 3136 3142 3187 3187 3193 3195* 3202* 3207 3276 3290 e 5 based fixed bin(17,0) level 2 dcl 14-16 set ref 889 892 892 895 895 895 1018 1026 1294 1294* 1296 1296* 1338 1338* 1340 1340* 1419 1419 1422 1422 1426 1434 1442 1764 1764* 1766 1766* 1890 1903 1903* 1905* 1908 2143 2157 2166 2448* 2533* 2683 2779* 3261* 3304* eaa_buff 001374 internal static bit(36) initial array packed unaligned dcl 1589 set ref 1657* 1659 1659 eis_fill_def 000000 constant structure level 1 packed packed unaligned dcl 772 eis_filler parameter char(1) packed unaligned dcl 2278 set ref 2258 2353* 2381* 2569* 2571* 2573* 2579* 2581* 2587* 2589* 2605 eis_inst based structure level 1 dcl 798 eis_ptr 000104 automatic pointer dcl 796 set ref 1006* 1007 1011* 1408* 1409 1413* 2217* 2218 2222 2226* 3021* 3022 elementary 21(09) based bit(1) level 2 packed packed unaligned dcl 10-16 set ref 2428* 2862* 2979* end_stmt based structure level 1 unaligned dcl 14-16 eos_buff 000732 automatic fixed bin(17,0) array dcl 2320 in procedure "convert_to_alpha" set ref 2444 2531 eos_buff 001252 automatic fixed bin(17,0) array dcl 2663 in procedure "class_condition" set ref 2776 eos_ptr 000216 automatic pointer dcl 14-13 set ref 869* 889 892 892 895 895 895 935 935 1016 1018 1026 1066 1066 1096* 1101 1294 1294 1296 1296 1338 1338 1340 1340 1416 1419 1419 1422 1422 1426 1434 1442 1481 1481 1764 1764 1766 1766 1890 1903 1903 1905 1908 2141* 2142 2143 2157 2166 2249 2249 2531* 2532 2533 2543 2683 2888 2915 2915 3167 3170 3178 3217 3260* 3261 3262 3264 3266 3272 3288 3304 3305 equal_flag parameter fixed bin(17,0) dcl 1700 in procedure "num_lit_comp" set ref 1684 1756* 1772* 1776* 1815* 1828* 1839* 1852* 1860* 1892* 1894* equal_flag 000416 automatic fixed bin(17,0) dcl 1189 in procedure "numeric_compare" set ref 1264* 1303* 1419 1422 fail_tag 001412 automatic fixed bin(17,0) dcl 3110 set ref 3145* 3180 3262 3319* file_key_info 13 001236 internal static structure level 2 in structure "bin_36_rop" unaligned dcl 1200 in procedure "numeric_compare" file_key_info 13 001326 internal static structure level 2 in structure "bin_18_type9" unaligned dcl 1228 in procedure "numeric_compare" file_key_info 13 001272 internal static structure level 2 in structure "bin_36_lop" unaligned dcl 1214 in procedure "numeric_compare" file_section 21 based bit(1) level 2 packed packed unaligned dcl 10-16 set ref 2425 2523 2858 2974 fill1_op 0(18) based bit(10) level 2 in structure "inst_struc_basic" packed packed unaligned dcl 19-51 in procedure "cobol_compare_gen" set ref 3044* 3073* fill1_op 0(18) based bit(10) level 3 in structure "inst_struc" packed packed unaligned dcl 19-66 in procedure "cobol_compare_gen" set ref 1638* 1639* 1667* 1668* 1964* 1965* 1993* filler_hier parameter fixed bin(17,0) dcl 2279 in procedure "convert_to_alpha" set ref 2258 2354* 2382* 2566* filler_hier 000703 automatic fixed bin(17,0) dcl 2070 in procedure "alpha_compare" set ref 2086* 2101 2105* 2126 2130* fixed builtin function dcl 3406 ref 935 935 1066 1066 1481 1481 2249 2249 2765 2765 2915 2915 3369 greater_flag 000420 automatic fixed bin(17,0) dcl 1189 in procedure "numeric_compare" set ref 1263* 1303* 1419 1422 greater_flag parameter fixed bin(17,0) dcl 1700 in procedure "num_lit_comp" set ref 1684 1754* 1920* 1930* 1934 h 6 based fixed bin(17,0) level 2 dcl 14-16 set ref 935 935 1066 1066 1481 1481 2249 2249 2915 2915 3170 3178 3217 3262* 3264* 3305* high_value 0(27) 000000 constant char(1) initial level 2 packed packed unaligned dcl 772 ref 2587 hival_char 10(18) based char(1) level 2 packed packed unaligned dcl 2-13 ref 2579 i 7 based fixed bin(17,0) level 2 dcl 14-16 set ref 1016 1101 1416 2142 2888 3167 3266* i_ptr 000152 automatic pointer dcl 820 set ref 1016* 1020 1028 1036 1101* 1103 1416* 1428 1436 1444 1452 1892 1900 1902 2142* 2151 2160 2169 2177 2888* 2889 3167* 3173 3178 ibit based structure level 1 packed packed unaligned dcl 822 ic_flag 000452 automatic fixed bin(17,0) dcl 1690 set ref 1752* 1922* 1972 in_op 000156 automatic fixed bin(17,0) dcl 832 in procedure "cobol_compare_gen" set ref 2962* 2968 in_op 000451 automatic fixed bin(17,0) dcl 1690 in procedure "num_lit_comp" set ref 1976* 1978 in_op_ptr 001232 automatic pointer dcl 2647 set ref 2681* 2728 2735* 2738 2740* 2741 2741 2741 2747 2754* 2786 2801* 2805* 2813 2813 2813 2813 2820 2825 2825 2833 2834 3012 3207* in_token based structure level 1 dcl 18-9 in_token_ptr parameter pointer dcl 18-7 ref 34 44 869 869 974 974 1096 1096 1105 1105 1114 1114 2141 2141 2681 2681 index_name based structure level 1 unaligned dcl 12-19 input_op_ptr parameter pointer dcl 1513 set ref 1491 1541 1544* 1564* 1569* input_ptr 000220 automatic pointer dcl 19-18 set ref 862* 989 990 991 992 993 994 995 996 997 1002* 1391 1392 1393 1394 1395 1396 1397 1398 1399 1403* 1610 1612 1613 1614 1615 1633* 1644 1645 1646 1647 1648 1671* 1937 1938 1939 1940 1941 1959* 1985 1986 1987 1988 1989 1991* 2198 2199 2200 2202 2203 2204 2205 2206 2207 2212* 3007 3010 3011 3012 3013 3014 3017* 3031 3032 3033 3034 3035 3036 3039* 3060 3061 3062 3063 3064 3065 3068* input_struc based structure level 1 unaligned dcl 19-32 inst based structure level 2 packed packed unaligned dcl 19-66 inst_code 001411 internal static fixed bin(17,0) initial dcl 1703 in procedure "num_lit_comp" set ref 1947* 1953* 1955* 1964 1965 2003 2005* 2006 2009 2011 2011 inst_code 001376 internal static fixed bin(17,0) initial dcl 1591 in procedure "comp6_proc" set ref 1621* 1627* 1629* 1638 1639 1655 1663* 1666* 1667 1668 inst_op 000010 constant bit(10) initial array packed unaligned dcl 1592 in procedure "comp6_proc" ref 1638 1667 inst_op 000006 constant bit(10) initial array packed unaligned dcl 1704 in procedure "num_lit_comp" ref 1964 1993 inst_ptr 000222 automatic pointer dcl 19-18 set ref 865* 1002* 1006 1403* 1408 1633* 1638 1639 1642* 1667 1668 1671* 1674* 1959* 1964 1965 1968* 1991* 1993 1995* 2212* 2217 3017* 3021 3026* 3039* 3044 3050 3051 3055* 3068* 3073 3077* inst_struc based structure level 1 dcl 19-66 inst_struc_basic based structure level 1 dcl 19-51 item_length 16 based fixed bin(24,0) level 2 dcl 10-16 set ref 2396 2432* 2493 2495 2527* 2765 2765 2825* 2825 2864* 2980* 3136 3142* item_signed 21(25) based bit(1) level 2 packed packed unaligned dcl 10-16 ref 977 1358 1376 2741 3187 ix 001144 automatic fixed bin(17,0) dcl 2339 set ref 2412* 2413* 2513* 2514* k 000454 automatic fixed bin(17,0) dcl 1690 set ref 1870* 1873* key 4 based fixed bin(17,0) level 2 dcl 4-14 ref 1125 2567 largest_long_binary 000516 automatic fixed dec(11,0) initial dcl 1730 set ref 1730* 1918 largest_short_binary 000002 constant fixed dec(6,0) initial dcl 1733 ref 1922 1928 left_half based bit(18) level 2 packed packed unaligned dcl 2657 set ref 3050 3051* less_flag parameter fixed bin(17,0) dcl 1700 in procedure "num_lit_comp" set ref 1684 1755* 1918* 1928* 1934 less_flag 000417 automatic fixed bin(17,0) dcl 1189 in procedure "numeric_compare" set ref 1262* 1303* 1419 1422 line 1 based fixed bin(17,0) level 2 dcl 8-14 set ref 2599* lit_size 5 based fixed bin(17,0) level 2 dcl 8-14 set ref 2369 2381 2604* 2605 lit_type 4 based bit(1) level 2 packed packed unaligned dcl 8-14 set ref 2602* literal 11 based char level 2 packed packed unaligned dcl 6-14 ref 1811 1824 1835 1835 1849 1857 1873 1882 literal_string 6 001213 internal static char(1) level 2 packed packed unaligned dcl 756 set ref 3242* 3250* lock 2 based fixed bin(17,0) level 2 dcl 19-32 set ref 991* 1393* 1613* 1646* 1939* 1987* 2200* 3011* 3033* 3062* long_bin_const 000543 automatic fixed bin(35,0) dcl 1748 set ref 1936* 1974 2009 long_bin_ptr 000544 automatic pointer dcl 1749 set ref 1974* 1976 long_bin_string based char(4) packed unaligned dcl 1750 set ref 1976* lop_ptr parameter pointer dcl 1169 in procedure "numeric_compare" set ref 1162 1269 1269 1269 1269 1269 1269 1276 1279 1280 1281* 1300 1303* 1312 1312 1326* 1331 1335 1336* 1347* 1356 1365* 1367* 1394 lop_ptr parameter pointer dcl 2036 in procedure "alpha_compare" set ref 2025 2090 2098* 2100* 2123* 2147 2148* 2189* 2202 lop_ptr parameter pointer dcl 1690 in procedure "num_lit_comp" set ref 1684 1759 1761 1762* 1770 1773 1773 1783 1786 1792 1916 1940 1944 1953 lop_ptr parameter pointer dcl 1586 in procedure "comp6_proc" ref 1578 1614 1618 1627 lop_ptr 000254 automatic pointer dcl 1087 in procedure "relational_compare" set ref 1105* 1107 1112* 1120 1149* 1153* loval_char 10(27) based char(1) level 2 packed packed unaligned dcl 2-13 ref 2581 low_value 1 000000 constant char(1) initial level 2 packed packed unaligned dcl 772 ref 2589 min builtin function dcl 3409 ref 1821 minus_type9 000266 internal static fixed bin(17,0) array dcl 326 set ref 3251 3289 move_bin_18 001224 internal static structure level 1 unaligned dcl 1192 set ref 1323 1323 move_token 001266 automatic structure level 1 dcl 2666 in procedure "class_condition" set ref 2793 2793 move_token 000716 automatic structure level 1 unaligned dcl 2313 in procedure "convert_to_alpha" set ref 2451 2451 2547 2547 n based fixed bin(17,0) level 2 in structure "in_token" dcl 18-9 in procedure "cobol_compare_gen" ref 869 974 1096 1105 1114 2141 2681 n 000174 automatic fixed bin(17,0) level 2 in structure "work_in_token1" dcl 845 in procedure "cobol_compare_gen" set ref 3285 3287* 3288 3289 3290 n 000716 automatic fixed bin(17,0) level 2 in structure "move_token" dcl 2313 in procedure "convert_to_alpha" set ref 2438* 2537* n 000162 automatic fixed bin(17,0) level 2 in structure "work_in_token" dcl 838 in procedure "cobol_compare_gen" set ref 3270 3271* 3272 3274 3276 non_eis_inst based structure level 1 dcl 785 set ref 1060 1060 non_eis_ptr 000100 automatic pointer dcl 783 set ref 916* 919 930* 1045* 1048 1060 1060 1462* 1463 1475* 2231* 2232 2244* 2895* 2898 2910* 3153* 3154 3163* 3218 3224* non_eis_word 000102 automatic bit(36) packed unaligned dcl 792 set ref 914* 916 1044* 1045 1461* 1462 2230* 2231 2894* 2895 3152* 3153 nonzero_pr 000453 automatic fixed bin(17,0) dcl 1690 set ref 1869* 1870 1873* 1886 nop_op constant bit(10) initial packed unaligned dcl 280 ref 1422 not 0(01) based bit(1) level 2 packed packed unaligned dcl 822 set ref 1020 1028 1036 1428 1436 1444 1452 1892 1900 1902* 2151 2160 2169 2177 2889 3173 3178 null builtin function dcl 3406 ref 40 873 881 935 935 981 1066 1066 1481 1481 1659 1659 2011 2011 2189 2189 2249 2249 2439 2539 2733 2751 2785 2801 2915 2915 3183 3183 3227 3227 3294 3294 3311 3311 3364 numeric 21(17) based bit(1) level 2 packed packed unaligned dcl 10-16 set ref 1125 2553* 2728 2833* 2861* 3131* numeric_edited 21(18) based bit(1) level 2 packed packed unaligned dcl 10-16 ref 2091 2116 numeric_lit based structure level 1 unaligned dcl 6-14 numeric_tct_table 000612 internal static bit(9) initial array packed unaligned dcl 481 set ref 2714 numeric_tct_table_allocated 000407 internal static fixed bin(17,0) initial dcl 337 set ref 2709 2720* numeric_zero 000010 internal static structure level 1 unaligned dcl 289 set ref 963 963 1555 1555 occurs_ptr 27 based fixed bin(17,0) level 2 dcl 10-16 set ref 2760* off 24 001326 internal static fixed bin(17,0) level 3 dcl 1228 set ref 1317* offset 24 001272 internal static fixed bin(17,0) level 3 in structure "bin_36_lop" dcl 1214 in procedure "numeric_compare" set ref 1280* offset 14 based fixed bin(24,0) level 2 in structure "index_name" dcl 12-19 in procedure "cobol_compare_gen" ref 1280 1290 offset 24 based fixed bin(24,0) level 2 in structure "data_name" dcl 10-16 in procedure "cobol_compare_gen" set ref 1312 1312 1331 1331 1627 1953 2419* 2520* 2772* 2813* 2813 2855* 2971* 3136* 3136 offset 24 001236 internal static fixed bin(17,0) level 3 in structure "bin_36_rop" dcl 1200 in procedure "numeric_compare" set ref 1290* op_code 0(18) based bit(9) level 2 packed packed unaligned dcl 785 set ref 919* opch_tct_table 001012 internal static bit(9) initial array packed unaligned dcl 615 set ref 3196 opch_tct_table_allocated 000411 internal static fixed bin(17,0) initial dcl 341 set ref 3190 3201* opcode 0(18) based bit(10) level 2 packed packed unaligned dcl 798 set ref 1007* 1048* 1409* 1463* 2218* 2232* 2898* 3022* 3154* 3218* operand 4 based structure array level 2 unaligned dcl 19-32 operand_no 1 based fixed bin(17,0) level 2 dcl 19-32 set ref 990* 1392* 1612* 1645* 1938* 1986* 2199* 3010* 3032* 3061* operand_ptr parameter pointer dcl 2275 set ref 2258 2351 2360 2361* 2375* 2440 2471* 2473* 2484* 2486* 2540 original_in_op_ptr 001236 automatic pointer dcl 2649 set ref 2738* 2799* 3126* other_operand_ptr parameter pointer dcl 2276 ref 2258 2396 2397 out1_ptr 000412 automatic pointer dcl 1186 in procedure "numeric_compare" set ref 1258* 1365* 1367 out1_ptr 000242 automatic pointer dcl 954 in procedure "sign_condition" set ref 981* 983* 985 out2_ptr 000414 automatic pointer dcl 1187 set ref 1260* 1383* 1385 output_op_ptr parameter pointer dcl 1514 set ref 1491 1544* 1561* 1564* 1569* output_operand_ptr parameter pointer dcl 2277 set ref 2258 2361* 2375* 2409 2413 2442 2509 2514 2541 2610* places 10 based fixed bin(17,0) level 2 dcl 6-14 ref 1796 1798 1811 1824 1835 1835 1849 1857 1873 1882 places_left 6 based fixed bin(17,0) level 2 in structure "numeric_lit" dcl 6-14 in procedure "cobol_compare_gen" ref 1783 1783 1801 1804 1873 1882 1882 1882 places_left 17 based fixed bin(17,0) level 2 in structure "data_name" dcl 10-16 in procedure "cobol_compare_gen" set ref 2433* 2500 3133* places_right 20 based fixed bin(17,0) level 2 in structure "data_name" dcl 10-16 in procedure "cobol_compare_gen" set ref 2434* 2500 3134* places_right 7 based fixed bin(17,0) level 2 in structure "numeric_lit" dcl 6-14 in procedure "cobol_compare_gen" ref 1870 1870 plus_type9 000336 internal static fixed bin(17,0) array dcl 328 set ref 3244 3274 pt2 4 001224 internal static pointer level 2 dcl 1192 set ref 1319* pt3 6 001224 internal static pointer level 2 dcl 1192 set ref 1320* pt4 10 001224 internal static pointer level 2 dcl 1192 set ref 1321* quote 0(18) 000000 constant char(1) initial level 2 packed packed unaligned dcl 772 ref 2573 reg_num 1 001414 internal static bit(4) level 2 in structure "reg_struc" packed packed unaligned dcl 1716 in procedure "num_lit_comp" set ref 1965 2006 reg_num 1 001400 internal static bit(4) level 2 in structure "reg_struc" packed packed unaligned dcl 1601 in procedure "comp6_proc" set ref 1639 1657 1668 reg_struc 001414 internal static structure level 1 unaligned dcl 1716 in procedure "num_lit_comp" set ref 1962 1962 2016 2016 reg_struc 001400 internal static structure level 1 unaligned dcl 1601 in procedure "comp6_proc" set ref 1636 1636 1677 1677 reloc_ptr 000224 automatic pointer dcl 19-18 set ref 866* 925 926 930* 1002* 1011* 1054 1055 1060* 1403* 1413* 1469 1470 1475* 1633* 1642* 1671* 1674* 1959* 1968* 1991* 1995* 2212* 2226* 2239 2240 2244* 2902 2903 2910* 3017* 3026* 3039* 3055* 3068* 3077* 3157 3158 3163* 3224* reloc_struc based structure array level 1 unaligned dcl 19-44 set ref 925* 926* 1054* 1055* 1469* 1470* 2239* 2240* 2902* 2903* 3157* 3158* reserved_word based structure level 1 unaligned dcl 4-14 ret_offset 001251 automatic fixed bin(17,0) dcl 2662 in procedure "class_condition" set ref 2765* 2772 ret_offset 000542 automatic fixed bin(17,0) dcl 1747 in procedure "num_lit_comp" set ref 1976* 1983* rop_ptr parameter pointer dcl 2037 in procedure "alpha_compare" set ref 2025 2098* 2114 2123* 2125* 2148 2149* 2189* 2205 rop_ptr parameter pointer dcl 1690 in procedure "num_lit_comp" set ref 1684 1762 1763* 1773 1773 1783 1788 1791 1870 1870 1873 1873 1879 1882 1882 1882 1882 1908 rop_ptr parameter pointer dcl 1586 in procedure "comp6_proc" ref 1578 1647 1651 rop_ptr 000256 automatic pointer dcl 1088 in procedure "relational_compare" set ref 1114* 1132 1139 1149* 1153* rop_ptr parameter pointer dcl 1170 in procedure "numeric_compare" set ref 1162 1265 1265 1265 1265 1265 1265 1286 1289 1290 1291* 1300 1303* 1310 1312 1319 1331 1331 1336 1337* 1347* 1373 1383* 1385* 1397 rtc_alphalit constant fixed bin(15,0) initial dcl 17-7 ref 2357 2601 rtc_dataname constant fixed bin(15,0) initial dcl 17-13 ref 977 977 1125 1358 1358 1358 1358 1376 1376 1376 1376 2091 2116 2424 2462 2477 2518 2853 2967 rtc_indexname constant fixed bin(15,0) initial dcl 17-14 ref 1125 1564 2462 2477 2493 rtc_numlit constant fixed bin(15,0) initial dcl 17-6 ref 1125 1544 2462 2466 rtc_resword constant fixed bin(15,0) initial dcl 17-5 ref 1125 1548 2561 rw_ptr 000212 automatic pointer dcl 4-11 set ref 1120* 1125 1125 1125 1125 1125 1125 1125 1132 1139* 2564* 2567 rwkey_alphabetic constant fixed bin(17,0) initial dcl 253 ref 892 2683 rwkey_equal constant fixed bin(17,0) initial dcl 257 ref 1442 1890 2166 3261 rwkey_greater constant fixed bin(17,0) initial dcl 258 ref 1294 1296 1338 1340 1419 1422 1426 1764 1766 1903 1905 1908 2143 rwkey_highval constant fixed bin(17,0) initial dcl 263 ref 2579 2587 rwkey_less constant fixed bin(17,0) initial dcl 259 ref 1294 1296 1338 1340 1419 1422 1434 1764 1766 1903 2157 rwkey_lowval constant fixed bin(17,0) initial dcl 264 ref 2581 2589 rwkey_negative constant fixed bin(17,0) initial dcl 255 ref 895 1026 rwkey_numeric constant fixed bin(17,0) initial dcl 252 ref 892 rwkey_positive constant fixed bin(17,0) initial dcl 254 ref 895 1018 rwkey_quote constant fixed bin(17,0) initial dcl 262 ref 2573 rwkey_space constant fixed bin(17,0) initial dcl 261 ref 2571 rwkey_unequal constant fixed bin(17,0) initial dcl 260 ref 3304 rwkey_zero constant fixed bin(17,0) initial dcl 256 ref 895 1125 2569 s_length 001136 automatic fixed bin(17,0) dcl 2333 set ref 2396* 2397* 2397 2404* 2432 2433 2487* 2493* 2495* 2496* 2498* 2500* 2506* 2527 s_offset 001137 automatic fixed bin(17,0) dcl 2334 set ref 2404* 2419 2506* 2520 save_dn_ptr 001146 automatic pointer dcl 2343 set ref 2508* 2549 save_h 001410 automatic fixed bin(17,0) dcl 3108 set ref 3170* 3264 3305 save_locno 000154 automatic fixed bin(17,0) dcl 829 set ref 922* 935* 1051* 1066* 1466* 1481* 2236* 2249* 2906* 2915* 3149* 3183* save_not 001411 automatic bit(1) packed unaligned dcl 3109 set ref 3173* 3213 3262 3302 saved_lop_ptr 001222 internal static pointer dcl 1089 set ref 1107* 1112 seg 23 001272 internal static fixed bin(17,0) initial level 3 in structure "bin_36_lop" dcl 1214 in procedure "numeric_compare" set ref 1279* seg 23 001236 internal static fixed bin(17,0) initial level 3 in structure "bin_36_rop" dcl 1200 in procedure "numeric_compare" set ref 1289* seg_num 23 based fixed bin(17,0) level 2 in structure "data_name" dcl 10-16 in procedure "cobol_compare_gen" set ref 2417* 2519* 2770* 2854* 2968* 2970* seg_num 13 based fixed bin(17,0) level 2 in structure "index_name" dcl 12-19 in procedure "cobol_compare_gen" ref 1279 1289 send_receive 6 based fixed bin(17,0) array level 3 dcl 19-32 set ref 994* 996* 1395* 1398* 2203* 2206* 3013* 3035* 3064* sep_sign_ptr 001156 automatic pointer dcl 2634 set ref 2733* 2735* 2740 2751* 2754* 2758 2759 2760 2765 2765 2770 2772 2788 2799 2805* separate_sign_eos 001376 automatic fixed bin(17,0) array dcl 3100 set ref 3260 separate_sign_literal 001213 internal static structure level 1 unaligned dcl 756 set ref 3246 3246 3253 3253 separate_sign_processing_flag 001160 automatic bit(1) packed unaligned dcl 2635 set ref 2676* 2827* 2885 separate_sign_type9 001326 automatic fixed bin(17,0) array dcl 3098 set ref 3122 separate_signs_pooled 001212 internal static fixed bin(17,0) initial dcl 750 set ref 3238 3256* sign 4(09) based char(1) level 2 packed packed unaligned dcl 6-14 ref 1773 1773 1773 1773 1879 1908 sign_separate 21(26) based bit(1) level 2 packed packed unaligned dcl 10-16 ref 977 1358 1376 2397 2493 2741 2741 3187 sign_type 22(13) based bit(3) level 2 packed packed unaligned dcl 10-16 set ref 2813 2813 2820* 3136 3136 3136 size based fixed bin(17,0) level 2 in structure "data_name" dcl 10-16 in procedure "cobol_compare_gen" ref 3369 3376 size based fixed bin(17,0) level 2 in structure "alphanum_lit" dcl 8-14 in procedure "cobol_compare_gen" set ref 2598* size_sw 10 based fixed bin(17,0) array level 3 dcl 19-32 set ref 993* 997* 1396* 1399* 1615* 1648* 1941* 1989* 2204* 2207* 3014* 3036* 3065* smallest_long_binary 000513 automatic fixed dec(11,0) initial dcl 1728 set ref 1728* 1920 smallest_short_binary 000004 constant fixed dec(6,0) initial dcl 1731 ref 1930 sort_pcs_ptr 000206 automatic pointer dcl 853 set ref 40* 47* 873 875 2189 2189* sort_prog_coll_seq_ptr parameter pointer dcl 850 ref 34 44 47 source_string based char(1000) packed unaligned dcl 3360 ref 3376 source_token_ptr parameter pointer dcl 3338 ref 3328 3369 3376 3376 space 000000 constant char(1) initial level 2 packed packed unaligned dcl 772 ref 2353 2571 st_offset 001240 automatic fixed bin(17,0) dcl 2650 set ref 2847* 2855 string 6 based char level 2 packed packed unaligned dcl 8-14 set ref 2381 2605* subscripted 22(05) based bit(1) level 2 packed packed unaligned dcl 10-16 set ref 1265 1269 2747 2758* substr builtin function dcl 3406 set ref 1312 1312 1331 1331 1627 1639* 1639 1657* 1668* 1668 1811 1824 1835 1835 1849 1857 1873 1879* 1881* 1882* 1882 1922 1953 1965* 1965 2006* 2006 2009* 2009 2222* 3051 3376* 3376 summary_buff 001161 automatic fixed bin(17,0) array dcl 2641 set ref 2851 summary_ptr 001244 automatic pointer dcl 2652 set ref 2867* 3063 t_key 001140 automatic fixed bin(17,0) dcl 2335 set ref 2567* 2569 2571 2573 2579 2581 2587 2589 t_offset 001310 automatic fixed bin(17,0) dcl 2955 set ref 2962* 2971 tct_op constant bit(10) initial packed unaligned dcl 283 ref 3022 tct_ptr 001242 automatic pointer dcl 2651 set ref 2701* 2724* 3034 3206* tct_table based char(512) packed unaligned dcl 2954 set ref 2962* tct_table_ptr 001234 automatic pointer dcl 2648 set ref 2691* 2714* 2962 3196* temp 000450 automatic fixed bin(17,0) dcl 1690 set ref 1978* 1980* 1983* temp9_ptr 001142 automatic pointer dcl 2336 set ref 2469* 2471* 2473 2474 temp_cmpc_filler 000704 automatic char(1) packed unaligned dcl 2074 set ref 2098* 2104 2123* 2129 temp_eos_ptr 001264 automatic pointer dcl 2664 set ref 2776* 2777 2779 2790 temp_filler_hier 000705 automatic fixed bin(17,0) dcl 2075 set ref 2098* 2101 2105 2123* 2126 2130 temp_lop_ptr 000406 automatic pointer dcl 1183 in procedure "numeric_compare" set ref 1278* 1281 1335* 1337 temp_lop_ptr 000444 automatic pointer dcl 1690 in procedure "num_lit_comp" set ref 1761* 1763 temp_op_ptr 000706 automatic pointer dcl 2076 set ref 2147* 2149 temp_ptr 001414 automatic pointer dcl 3112 set ref 3193* 3202 3244* 3246* 3251* 3253* temp_rop_ptr 000410 automatic pointer dcl 1185 set ref 1288* 1291 temp_tag 001413 automatic fixed bin(17,0) dcl 3111 set ref 3178* 3180* 3183* 3217* 3227* temp_token_ptr 000446 automatic pointer dcl 1690 set ref 1981* 1983* 1988 temp_type9_token 001064 automatic fixed bin(17,0) array dcl 2324 set ref 2484 2484 2486 tmi_op constant bit(10) initial packed unaligned dcl 269 ref 1022 1430 tmoz_op constant bit(10) initial packed unaligned dcl 273 ref 1028 1436 tnc_op constant bit(10) initial packed unaligned dcl 272 ref 2153 2162 tnz_op constant bit(10) initial packed unaligned dcl 275 ref 1036 1444 1454 2169 2179 token_ptr 2 based pointer array level 2 in structure "in_token" dcl 18-9 in procedure "cobol_compare_gen" ref 869 974 1096 1105 1114 2141 2681 token_ptr 2 000716 automatic pointer array level 2 in structure "move_token" dcl 2313 in procedure "convert_to_alpha" set ref 2439* 2440* 2442* 2444* 2446 2448 2539* 2540* 2541* 2543* token_ptr 4 based pointer array level 3 in structure "input_struc" dcl 19-32 in procedure "cobol_compare_gen" set ref 992* 995* 1394* 1397* 1614* 1647* 1940* 1988* 2202* 2205* 3012* 3034* 3063* token_ptr 2 001266 automatic pointer array level 2 in structure "move_token" dcl 2666 in procedure "class_condition" set ref 2785* 2786* 2788* 2790* token_ptr 2 000174 automatic pointer array level 2 in structure "work_in_token1" dcl 845 in procedure "cobol_compare_gen" set ref 3288* 3289* 3290* token_ptr 2 000162 automatic pointer array level 2 in structure "work_in_token" dcl 838 in procedure "cobol_compare_gen" set ref 3272* 3274* 3276* topcode 000155 automatic bit(10) packed unaligned dcl 830 set ref 1020* 1022* 1028* 1030* 1036* 1038* 1048 1419* 1422* 1428* 1430* 1436* 1438* 1444* 1446* 1452* 1454* 1463 2151* 2153* 2160* 2162* 2169* 2171* 2177* 2179* 2232 2889* 2891* 2898 tpl_op constant bit(10) initial packed unaligned dcl 270 ref 1020 1428 tpnz_op constant bit(10) initial packed unaligned dcl 274 ref 1030 1438 tra_op constant bit(10) initial packed unaligned dcl 279 ref 919 1419 trc_op constant bit(10) initial packed unaligned dcl 271 ref 2151 2160 ttf_op constant bit(10) initial packed unaligned dcl 277 ref 2889 3154 ttn_op constant bit(10) initial packed unaligned dcl 278 ref 2891 3218 type based fixed bin(17,0) level 2 in structure "input_struc" dcl 19-32 in procedure "cobol_compare_gen" set ref 989* 1391* 1610* 1644* 1937* 1985* 2198* 3007* 3031* 3060* type 3 based fixed bin(17,0) level 2 in structure "reserved_word" dcl 4-14 in procedure "cobol_compare_gen" ref 1125 1125 1125 1125 type 3 based fixed bin(17,0) level 2 in structure "data_name" dcl 10-16 in procedure "cobol_compare_gen" set ref 977 977 1265 1265 1265 1269 1269 1269 1276 1286 1300 1300 1358 1358 1358 1358 1376 1376 1376 1376 1544 1548 1564 1759 1770 2091 2116 2357 2424* 2462 2462 2462 2466 2477 2477 2493 2518* 2561 2853* 2967* type 3 based fixed bin(17,0) level 2 in structure "alphanum_lit" dcl 8-14 in procedure "cobol_compare_gen" set ref 2601* type9_alpha_tct 000142 internal static fixed bin(17,0) array dcl 317 set ref 2689 type9_alpha_tct_ptr 000212 internal static pointer dcl 319 set ref 2689* 2690 2701 type9_numeric_tct 000070 internal static fixed bin(17,0) array dcl 313 set ref 2712 type9_numeric_tct_ptr 000140 internal static pointer dcl 314 set ref 2712* 2713 2724 type9_opch_tct 000214 internal static fixed bin(17,0) array dcl 321 set ref 3194 type9_opch_tct_ptr 000264 internal static pointer dcl 322 set ref 3194* 3195 3206 type9_zero 000022 internal static fixed bin(17,0) array dcl 309 set ref 961 1553 type9_zero_ptr 000066 internal static pointer dcl 311 set ref 961* 963* 995 1553* 1555* 1561 tze_op constant bit(10) initial packed unaligned dcl 276 ref 1038 1446 1452 2171 2177 uncond_branch constant fixed bin(17,0) initial dcl 265 ref 889 unspec builtin function dcl 3406 ref 1312 1312 1331 1331 1627 1953 2009 2222 3051 unused based bit(18) level 2 packed packed unaligned dcl 798 set ref 2222* usage_index 21(34) based bit(1) level 2 packed packed unaligned dcl 10-16 ref 1125 1358 1376 1564 2477 variable_length 22(04) based bit(1) level 2 packed packed unaligned dcl 10-16 set ref 2759* verb 4 based fixed bin(17,0) level 2 dcl 14-16 set ref 2446* 2532* 2777* what_reg 001400 internal static fixed bin(17,0) level 2 in structure "reg_struc" dcl 1601 in procedure "comp6_proc" set ref 1620* 1626* what_reg 001414 internal static fixed bin(17,0) level 2 in structure "reg_struc" dcl 1716 in procedure "num_lit_comp" set ref 1946* 1952* wkbuff1 000106 automatic fixed bin(17,0) array dcl 807 in procedure "cobol_compare_gen" set ref 862 wkbuff1 000744 automatic fixed bin(17,0) array dcl 2322 in procedure "convert_to_alpha" set ref 2469 wkbuff1 000556 automatic fixed bin(17,0) array dcl 2051 in procedure "alpha_compare" set ref 2096 wkbuff1_ptr 000676 automatic pointer dcl 2053 set ref 2096* 2098* 2100 wkbuff2 000132 automatic fixed bin(17,0) array dcl 811 in procedure "cobol_compare_gen" set ref 865 wkbuff2 000626 automatic fixed bin(17,0) array dcl 2052 in procedure "alpha_compare" set ref 2121 wkbuff2_ptr 000700 automatic pointer dcl 2054 set ref 2121* 2123* 2125 wkbuff3 000137 automatic fixed bin(17,0) array dcl 815 set ref 866 work_binary 001250 automatic fixed bin(35,0) dcl 2656 set ref 3050* 3051 work_fdec 000521 automatic fixed dec(19,0) dcl 1740 set ref 1877* 1878 1908* 1908 1911* 1911 1918 1920 1922 1928 1930 1936 work_fdec_ptr 000526 automatic pointer dcl 1742 set ref 1878* 1879 1881 1882 1922 work_fdec_string based char(20) packed unaligned dcl 1741 set ref 1879* 1881* 1882* 1922 work_in_token 000162 automatic structure level 1 unaligned dcl 838 work_in_token1 000174 automatic structure level 1 unaligned dcl 845 work_in_token1_ptr 000172 automatic pointer dcl 843 set ref 3285* 3311* work_in_token_ptr 000160 automatic pointer dcl 836 set ref 3270* 3294* work_inst based structure level 1 packed packed unaligned dcl 2657 zero 0(09) 000000 constant char(1) initial level 2 packed packed unaligned dcl 772 ref 2569 zero_allocated 000406 internal static fixed bin(17,0) initial dcl 334 set ref 955 965* 1551 1557* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. SF automatic fixed bin(17,0) dcl 1745 allo1_max defined fixed bin(17,0) dcl 1-171 allo1_ptr defined pointer dcl 1-67 alter_flag defined fixed bin(17,0) dcl 1-135 alter_index defined fixed bin(17,0) dcl 1-153 alter_list_ptr defined pointer dcl 1-39 ascii_to_ebcdic_table_allocated internal static fixed bin(17,0) initial dcl 335 cd_cnt defined fixed bin(17,0) dcl 1-197 cobol_$allo1_max external static fixed bin(17,0) dcl 1-170 cobol_$allo1_ptr external static pointer dcl 1-66 cobol_$alter_flag external static fixed bin(17,0) dcl 1-134 cobol_$alter_index external static fixed bin(17,0) dcl 1-152 cobol_$alter_list_ptr external static pointer dcl 1-38 cobol_$cd_cnt external static fixed bin(17,0) dcl 1-196 cobol_$cobol_data_wd_off external static fixed bin(17,0) dcl 1-118 cobol_$coms_charcnt external static fixed bin(17,0) dcl 1-188 cobol_$coms_wdoff external static fixed bin(17,0) dcl 1-202 cobol_$con_end_ptr external static pointer dcl 1-10 cobol_$con_wd_off external static fixed bin(17,0) dcl 1-92 cobol_$cons_charcnt external static fixed bin(17,0) dcl 1-192 cobol_$constant_offset external static fixed bin(17,0) dcl 1-156 cobol_$data_init_flag external static fixed bin(17,0) dcl 1-130 cobol_$date_compiled_sw external static fixed bin(17,0) dcl 1-180 cobol_$debug_enable external static fixed bin(17,0) dcl 1-174 cobol_$def_base_ptr external static pointer dcl 1-12 cobol_$def_max external static fixed bin(17,0) dcl 1-96 cobol_$def_wd_off external static fixed bin(17,0) dcl 1-94 cobol_$diag_ptr external static pointer dcl 1-70 cobol_$eln_max external static fixed bin(17,0) dcl 1-172 cobol_$eln_ptr external static pointer dcl 1-68 cobol_$fixup_max external static fixed bin(17,0) dcl 1-164 cobol_$fixup_ptr external static pointer dcl 1-30 cobol_$fs_charcnt external static fixed bin(17,0) dcl 1-184 cobol_$fs_wdoff external static fixed bin(17,0) dcl 1-198 cobol_$include_cnt external static fixed bin(17,0) dcl 1-182 cobol_$include_info_ptr external static pointer dcl 1-86 cobol_$init_stack_off external static fixed bin(17,0) dcl 1-124 cobol_$initval_base_ptr external static pointer dcl 1-32 cobol_$initval_file_ptr external static pointer dcl 1-34 cobol_$initval_flag external static fixed bin(17,0) dcl 1-178 cobol_$link_base_ptr external static pointer dcl 1-14 cobol_$link_max external static fixed bin(17,0) dcl 1-100 cobol_$link_wd_off external static fixed bin(17,0) dcl 1-98 cobol_$list_off external static fixed bin(17,0) dcl 1-154 cobol_$list_ptr external static pointer dcl 1-64 cobol_$ls_charcnt external static fixed bin(17,0) dcl 1-190 cobol_$map_data_max external static fixed bin(17,0) dcl 1-162 cobol_$map_data_ptr external static pointer dcl 1-54 cobol_$max_stack_off external static fixed bin(17,0) dcl 1-122 cobol_$minpral5_ptr external static pointer dcl 1-50 cobol_$misc_base_ptr external static pointer dcl 1-60 cobol_$misc_end_ptr external static pointer dcl 1-62 cobol_$misc_max external static fixed bin(17,0) dcl 1-158 cobol_$non_source_offset external static fixed bin(17,0) dcl 1-176 cobol_$ntbuf_ptr external static pointer dcl 1-82 cobol_$obj_seg_name external static char(32) dcl 1-208 cobol_$op_con_ptr external static pointer dcl 1-80 cobol_$para_eop_flag external static fixed bin(17,0) dcl 1-138 cobol_$pd_map_index external static fixed bin(17,0) dcl 1-116 cobol_$pd_map_max external static fixed bin(17,0) dcl 1-160 cobol_$pd_map_ptr external static pointer dcl 1-28 cobol_$pd_map_sw external static fixed bin(17,0) dcl 1-126 cobol_$perform_list_ptr external static pointer dcl 1-36 cobol_$perform_para_index external static fixed bin(17,0) dcl 1-148 cobol_$perform_sect_index external static fixed bin(17,0) dcl 1-150 cobol_$priority_no external static fixed bin(17,0) dcl 1-140 cobol_$ptr_assumption_ind external static fixed bin(17,0) dcl 1-144 cobol_$ptr_status_ptr external static pointer dcl 1-56 cobol_$reg_assumption_ind external static fixed bin(17,0) dcl 1-146 cobol_$reg_status_ptr external static pointer dcl 1-58 cobol_$reloc_def_base_ptr external static pointer dcl 1-20 cobol_$reloc_def_max external static fixed bin(24,0) dcl 1-108 cobol_$reloc_link_base_ptr external static pointer dcl 1-22 cobol_$reloc_link_max external static fixed bin(24,0) dcl 1-110 cobol_$reloc_sym_base_ptr external static pointer dcl 1-24 cobol_$reloc_sym_max external static fixed bin(24,0) dcl 1-112 cobol_$reloc_text_base_ptr external static pointer dcl 1-18 cobol_$reloc_text_max external static fixed bin(24,0) dcl 1-106 cobol_$reloc_work_base_ptr external static pointer dcl 1-26 cobol_$reloc_work_max external static fixed bin(24,0) dcl 1-114 cobol_$reswd_ptr external static pointer dcl 1-78 cobol_$same_sort_merge_proc external static bit(1) dcl 1-214 cobol_$scratch_dir external static char(168) dcl 1-206 cobol_$sect_eop_flag external static fixed bin(17,0) dcl 1-136 cobol_$seg_init_flag external static fixed bin(17,0) dcl 1-132 cobol_$seg_init_list_ptr external static pointer dcl 1-40 cobol_$stack_off external static fixed bin(17,0) dcl 1-120 cobol_$statement_info_ptr external static pointer dcl 1-76 cobol_$sym_base_ptr external static pointer dcl 1-16 cobol_$sym_max external static fixed bin(17,0) dcl 1-104 cobol_$sym_wd_off external static fixed bin(17,0) dcl 1-102 cobol_$tag_table_max external static fixed bin(17,0) dcl 1-166 cobol_$tag_table_ptr external static pointer dcl 1-52 cobol_$temp_token_area_ptr external static pointer dcl 1-42 cobol_$temp_token_max external static fixed bin(17,0) dcl 1-168 cobol_$text_base_ptr external static pointer dcl 1-8 cobol_$token_block1_ptr external static pointer dcl 1-46 cobol_$token_block2_ptr external static pointer dcl 1-48 cobol_$value_cnt external static fixed bin(17,0) dcl 1-194 cobol_$ws_charcnt external static fixed bin(17,0) dcl 1-186 cobol_$ws_wdoff external static fixed bin(17,0) dcl 1-200 cobol_$xref_bypass external static bit(1) dcl 1-212 cobol_$xref_chain_ptr external static pointer dcl 1-74 cobol_$xref_token_ptr external static pointer dcl 1-72 cobol_afp defined pointer dcl 21-11 cobol_analin_fileno defined pointer dcl 21-13 cobol_cmfp defined pointer dcl 21-21 cobol_com_fileno defined pointer dcl 21-23 cobol_com_ptr defined pointer dcl 21-25 cobol_curr_in defined pointer dcl 21-53 cobol_curr_out defined pointer dcl 21-55 cobol_data_wd_off defined fixed bin(17,0) dcl 1-119 cobol_dfp defined pointer dcl 21-27 cobol_eltp defined pointer dcl 21-19 cobol_ext_$cobol_afp external static pointer dcl 21-10 cobol_ext_$cobol_analin_fileno external static pointer dcl 21-12 cobol_ext_$cobol_cmfp external static pointer dcl 21-20 cobol_ext_$cobol_com_fileno external static pointer dcl 21-22 cobol_ext_$cobol_com_ptr external static pointer dcl 21-24 cobol_ext_$cobol_curr_in external static pointer dcl 21-52 cobol_ext_$cobol_curr_out external static pointer dcl 21-54 cobol_ext_$cobol_dfp external static pointer dcl 21-26 cobol_ext_$cobol_eltp external static pointer dcl 21-18 cobol_ext_$cobol_fileno1 external static fixed bin(24,0) dcl 21-78 cobol_ext_$cobol_hfp external static pointer dcl 21-28 cobol_ext_$cobol_lpr external static char(5) packed unaligned dcl 21-95 cobol_ext_$cobol_m1fp external static pointer dcl 21-30 cobol_ext_$cobol_m2fp external static pointer dcl 21-32 cobol_ext_$cobol_min1_fileno external static pointer dcl 21-34 cobol_ext_$cobol_min2_fileno_ptr external static pointer dcl 21-36 cobol_ext_$cobol_name_fileno external static pointer dcl 21-38 cobol_ext_$cobol_name_fileno_ptr external static pointer dcl 21-40 cobol_ext_$cobol_ntfp external static pointer dcl 21-42 cobol_ext_$cobol_options external static char(120) packed unaligned dcl 21-97 cobol_ext_$cobol_options_len external static fixed bin(24,0) dcl 21-80 cobol_ext_$cobol_pdofp external static pointer dcl 21-44 cobol_ext_$cobol_pdout_fileno external static fixed bin(24,0) dcl 21-82 cobol_ext_$cobol_pfp external static pointer dcl 21-46 cobol_ext_$cobol_print_fileno external static fixed bin(24,0) dcl 21-84 cobol_ext_$cobol_rm2fp external static pointer dcl 21-48 cobol_ext_$cobol_rmin2_fileno external static fixed bin(24,0) dcl 21-86 cobol_ext_$cobol_rmin2fp external static pointer dcl 21-50 cobol_ext_$cobol_rwdd external static pointer dcl 21-72 cobol_ext_$cobol_rwpd external static pointer dcl 21-74 cobol_ext_$cobol_sfp external static pointer dcl 21-56 cobol_ext_$cobol_w1p external static pointer dcl 21-58 cobol_ext_$cobol_w2p external static pointer dcl 21-60 cobol_ext_$cobol_w3p external static pointer dcl 21-62 cobol_ext_$cobol_w5p external static pointer dcl 21-64 cobol_ext_$cobol_w6p external static pointer dcl 21-66 cobol_ext_$cobol_w7p external static pointer dcl 21-68 cobol_ext_$cobol_x1_fileno external static fixed bin(24,0) dcl 21-88 cobol_ext_$cobol_x2_fileno external static fixed bin(24,0) dcl 21-90 cobol_ext_$cobol_x3_fileno external static fixed bin(24,0) dcl 21-92 cobol_ext_$cobol_x3fp external static pointer dcl 21-70 cobol_ext_$cobol_xlast8 external static bit(1) packed unaligned dcl 21-100 cobol_ext_$report_exists external static bit(1) packed unaligned dcl 21-102 cobol_ext_$report_first_token external static pointer dcl 21-14 cobol_ext_$report_last_token external static pointer dcl 21-16 cobol_fileno1 defined fixed bin(24,0) dcl 21-79 cobol_hfp defined pointer dcl 21-29 cobol_lpr defined char(5) packed unaligned dcl 21-96 cobol_m1fp defined pointer dcl 21-31 cobol_m2fp defined pointer dcl 21-33 cobol_mcdb_enable external static bit(1) packed unaligned dcl 16-7 cobol_mcdb_flag external static bit(1) array packed unaligned dcl 16-8 cobol_min1_fileno defined pointer dcl 21-35 cobol_min2_fileno_ptr defined pointer dcl 21-37 cobol_name_fileno defined pointer dcl 21-39 cobol_name_fileno_ptr defined pointer dcl 21-41 cobol_ntfp defined pointer dcl 21-43 cobol_options defined char(120) packed unaligned dcl 21-98 cobol_options_len defined fixed bin(24,0) dcl 21-81 cobol_pdofp defined pointer dcl 21-45 cobol_pdout_fileno defined fixed bin(24,0) dcl 21-83 cobol_pfp defined pointer dcl 21-47 cobol_print_fileno defined fixed bin(24,0) dcl 21-85 cobol_rm2fp defined pointer dcl 21-49 cobol_rmin2_fileno defined fixed bin(24,0) dcl 21-87 cobol_rmin2fp defined pointer dcl 21-51 cobol_rwdd defined pointer dcl 21-73 cobol_rwpd defined pointer dcl 21-75 cobol_sfp defined pointer dcl 21-57 cobol_w1p defined pointer dcl 21-59 cobol_w2p defined pointer dcl 21-61 cobol_w3p defined pointer dcl 21-63 cobol_w5p defined pointer dcl 21-65 cobol_w6p defined pointer dcl 21-67 cobol_w7p defined pointer dcl 21-69 cobol_x1_fileno defined fixed bin(24,0) dcl 21-89 cobol_x2_fileno defined fixed bin(24,0) dcl 21-91 cobol_x3_fileno defined fixed bin(24,0) dcl 21-93 cobol_x3fp defined pointer dcl 21-71 cobol_xlast8 defined bit(1) packed unaligned dcl 21-101 compile_count defined fixed bin(17,0) dcl 1-143 coms_charcnt defined fixed bin(17,0) dcl 1-189 coms_wdoff defined fixed bin(17,0) dcl 1-203 con_end_ptr defined pointer dcl 1-11 con_wd_off defined fixed bin(17,0) dcl 1-93 cons_charcnt defined fixed bin(17,0) dcl 1-193 constant_offset defined fixed bin(17,0) dcl 1-157 data_init_flag defined fixed bin(17,0) dcl 1-131 date_compiled_sw defined fixed bin(17,0) dcl 1-181 debug_enable defined fixed bin(17,0) dcl 1-175 def_base_ptr defined pointer dcl 1-13 def_max defined fixed bin(17,0) dcl 1-97 def_wd_off defined fixed bin(17,0) dcl 1-95 desc_an based structure level 1 packed packed unaligned dcl 19-103 desc_an_ptr automatic pointer dcl 19-119 desc_nn based structure level 1 packed packed unaligned dcl 19-122 desc_nn_ptr automatic pointer dcl 19-118 descrip based bit(72) packed unaligned dcl 833 in procedure "cobol_compare_gen" descrip based bit(72) packed unaligned dcl 1534 in procedure "convert_to_dec" descrip_ptr automatic pointer dcl 831 in procedure "cobol_compare_gen" descrip_ptr automatic pointer dcl 1533 in procedure "convert_to_dec" diag_ptr defined pointer dcl 1-71 eln_max defined fixed bin(17,0) dcl 1-173 eln_ptr defined pointer dcl 1-69 fixed_common based structure level 1 unaligned dcl 20-26 fixup_max defined fixed bin(17,0) dcl 1-165 fixup_ptr defined pointer dcl 1-31 fs_charcnt defined fixed bin(17,0) dcl 1-185 fs_wdoff defined fixed bin(17,0) dcl 1-199 i automatic fixed bin(17,0) dcl 1690 include_cnt defined fixed bin(17,0) dcl 1-183 include_info_ptr defined pointer dcl 1-87 ind_ptr automatic pointer dcl 12-16 index builtin function dcl 3406 init_stack_off defined fixed bin(17,0) dcl 1-125 initval_base_ptr defined pointer dcl 1-33 initval_file_ptr defined pointer dcl 1-35 initval_flag defined fixed bin(17,0) dcl 1-179 input_struc_basic based structure level 1 unaligned dcl 19-23 j automatic fixed bin(17,0) dcl 1690 l_win automatic fixed bin(17,0) dcl 1690 length builtin function dcl 3406 link_base_ptr defined pointer dcl 1-15 link_max defined fixed bin(17,0) dcl 1-101 link_wd_off defined fixed bin(17,0) dcl 1-99 list_off defined fixed bin(17,0) dcl 1-155 list_ptr defined pointer dcl 1-65 ls_charcnt defined fixed bin(17,0) dcl 1-191 main_pcs_ptr defined pointer dcl 1-85 map_data_max defined fixed bin(17,0) dcl 1-163 map_data_ptr defined pointer dcl 1-55 max builtin function dcl 3409 max_stack_off defined fixed bin(17,0) dcl 1-123 mcdb_bldresop internal static fixed bin(17,0) initial dcl 16-15 mcdb_compare_gen internal static fixed bin(17,0) initial dcl 16-13 mcdb_compute_gen internal static fixed bin(17,0) initial dcl 16-14 minpral5_ptr defined pointer dcl 1-51 misc_base_ptr defined pointer dcl 1-61 misc_end_ptr defined pointer dcl 1-63 misc_max defined fixed bin(17,0) dcl 1-159 mod builtin function dcl 3406 mvt_op internal static bit(10) initial packed unaligned dcl 284 next_tag defined fixed bin(17,0) dcl 1-129 nlit_ptr automatic pointer dcl 6-11 non_source_offset defined fixed bin(17,0) dcl 1-177 ntbuf_ptr defined pointer dcl 1-83 obj_seg_name defined char(32) dcl 1-209 op_con_ptr defined pointer dcl 1-81 para_eop_flag defined fixed bin(17,0) dcl 1-139 pd_map_index defined fixed bin(17,0) dcl 1-117 pd_map_max defined fixed bin(17,0) dcl 1-161 pd_map_ptr defined pointer dcl 1-29 pd_map_sw defined fixed bin(17,0) dcl 1-127 perform_list_ptr defined pointer dcl 1-37 perform_para_index defined fixed bin(17,0) dcl 1-149 perform_sect_index defined fixed bin(17,0) dcl 1-151 priority_no defined fixed bin(17,0) dcl 1-141 ptr_assumption_ind defined fixed bin(17,0) dcl 1-145 ptr_status_ptr defined pointer dcl 1-57 reg_assumption_ind defined fixed bin(17,0) dcl 1-147 reg_status_ptr defined pointer dcl 1-59 rel builtin function dcl 3406 reloc_def_base_ptr defined pointer dcl 1-21 reloc_def_max defined fixed bin(24,0) dcl 1-109 reloc_link_base_ptr defined pointer dcl 1-23 reloc_link_max defined fixed bin(24,0) dcl 1-111 reloc_sym_base_ptr defined pointer dcl 1-25 reloc_sym_max defined fixed bin(24,0) dcl 1-113 reloc_text_base_ptr defined pointer dcl 1-19 reloc_text_max defined fixed bin(24,0) dcl 1-107 reloc_work_base_ptr defined pointer dcl 1-27 reloc_work_max defined fixed bin(24,0) dcl 1-115 report_exists defined bit(1) packed unaligned dcl 21-103 report_first_token defined pointer dcl 21-15 report_last_token defined pointer dcl 21-17 reswd_ptr defined pointer dcl 1-79 rtc_commdesc internal static fixed bin(15,0) initial dcl 17-17 rtc_condname internal static fixed bin(15,0) initial dcl 17-15 rtc_debugenable internal static fixed bin(15,0) initial dcl 17-28 rtc_debugitems internal static fixed bin(15,0) initial dcl 17-18 rtc_diag internal static fixed bin(15,0) initial dcl 17-9 rtc_eos internal static fixed bin(15,0) initial dcl 17-23 rtc_equate_tag internal static fixed bin(15,0) initial dcl 17-35 rtc_fdec_temp internal static fixed bin(15,0) initial dcl 17-37 rtc_filedef internal static fixed bin(15,0) initial dcl 17-16 rtc_groupname internal static fixed bin(15,0) initial dcl 17-25 rtc_immed_const internal static fixed bin(15,0) initial dcl 17-38 rtc_internal_tag internal static fixed bin(15,0) initial dcl 17-34 rtc_mnemonic internal static fixed bin(15,0) initial dcl 17-21 rtc_pararef internal static fixed bin(15,0) initial dcl 17-22 rtc_picstring internal static fixed bin(15,0) initial dcl 17-8 rtc_procdef internal static fixed bin(15,0) initial dcl 17-11 rtc_register internal static fixed bin(15,0) initial dcl 17-36 rtc_reportentry internal static fixed bin(15,0) initial dcl 17-26 rtc_reportname internal static fixed bin(15,0) initial dcl 17-24 rtc_savedarea internal static fixed bin(15,0) initial dcl 17-19 rtc_sortmerge internal static fixed bin(15,0) initial dcl 17-20 rtc_source internal static fixed bin(15,0) initial dcl 17-10 rtc_unknown1 internal static fixed bin(15,0) initial dcl 17-27 rtc_unknown2 internal static fixed bin(15,0) initial dcl 17-29 rtc_unknown3 internal static fixed bin(15,0) initial dcl 17-30 rtc_unknown4 internal static fixed bin(15,0) initial dcl 17-31 rtc_unknown5 internal static fixed bin(15,0) initial dcl 17-32 rtc_unknown6 internal static fixed bin(15,0) initial dcl 17-33 rtc_userwd internal static fixed bin(15,0) initial dcl 17-12 same_sort_merge_proc defined bit(1) dcl 1-215 scratch_dir defined char(168) dcl 1-207 sect_eop_flag defined fixed bin(17,0) dcl 1-137 seg_init_flag defined fixed bin(17,0) dcl 1-133 seg_init_list_ptr defined pointer dcl 1-41 sep_sign_type9 automatic fixed bin(17,0) array dcl 2633 separate_sign_input_token automatic fixed bin(17,0) array dcl 3102 stack_off defined fixed bin(17,0) dcl 1-121 statement_info_ptr defined pointer dcl 1-77 string builtin function dcl 3406 summary_op_ptr automatic pointer dcl 2642 sym_base_ptr defined pointer dcl 1-17 sym_max defined fixed bin(17,0) dcl 1-105 sym_wd_off defined fixed bin(17,0) dcl 1-103 tag_table_max defined fixed bin(17,0) dcl 1-167 tag_table_ptr defined pointer dcl 1-53 temp_buff automatic char(150) packed unaligned dcl 1184 temp_token_area_ptr defined pointer dcl 1-43 temp_token_max defined fixed bin(17,0) dcl 1-169 temp_token_ptr defined pointer dcl 1-45 text_base_ptr defined pointer dcl 1-9 text_wd_off defined fixed bin(17,0) dcl 1-91 token_block1_ptr defined pointer dcl 1-47 token_block2_ptr defined pointer dcl 1-49 value_cnt defined fixed bin(17,0) dcl 1-195 wkbuff3 automatic fixed bin(17,0) array dcl 2060 wkbuff3_ptr automatic pointer dcl 2063 wkbuff4 automatic fixed bin(17,0) array dcl 2062 wkbuff4_ptr automatic pointer dcl 2064 ws_charcnt defined fixed bin(17,0) dcl 1-187 ws_wdoff defined fixed bin(17,0) dcl 1-201 xref_bypass defined bit(1) dcl 1-213 xref_chain_ptr defined pointer dcl 1-75 xref_token_ptr defined pointer dcl 1-73 NAMES DECLARED BY EXPLICIT CONTEXT. alpha_compare 003121 constant entry internal dcl 2025 ref 1153 class_condition 004342 constant entry internal dcl 2621 ref 892 cobol_compare_gen 000036 constant entry external dcl 34 ref 3294 3311 comp6_proc 001645 constant entry internal dcl 1578 ref 1326 1347 convert_to_alpha 003531 constant entry internal dcl 2258 ref 2098 2123 convert_to_dec 001532 constant entry internal dcl 1491 ref 983 1365 1383 copy_whole_token 005622 constant entry internal dcl 3328 ref 2735 2754 2805 exit_alpha_compare 003530 constant label dcl 2251 exit_class_condition 004727 constant label dcl 2930 exit_comp6_proc 002123 constant label dcl 1679 exit_convert_to_alpha 004341 constant label dcl 2616 exit_convert_to_dec 001644 constant label dcl 1573 exit_copy_whole_token 005661 constant label dcl 3378 exit_num_lit_comp 003120 constant label dcl 2020 exit_numeric_compare 001531 constant label dcl 1484 exit_relational_compare 000615 constant label dcl 1156 exit_separate_sign_processing 005621 constant label dcl 3323 exit_sign_condition 000505 constant label dcl 1069 exit_tct_table_build 005007 constant label dcl 2984 exit_test_for_numeric 005207 constant label dcl 3081 exit_ubranch 000222 constant label dcl 939 num_lit_comp 002124 constant entry internal dcl 1684 ref 1303 numeric_compare 000616 constant entry internal dcl 1162 ref 1149 relational_compare 000506 constant entry internal dcl 1075 ref 900 separate_sign_processing 005210 constant entry internal dcl 3086 ref 2925 sign_condition 000223 constant entry internal dcl 945 ref 895 sort 000050 constant entry external dcl 44 start 000061 constant label dcl 862 ref 42 start_alpha_compare 003123 constant label dcl 2084 start_class_condition 004343 constant label dcl 2676 start_comp6_proc 001647 constant label dcl 1610 start_convert_to_alpha 003533 constant label dcl 2351 start_convert_to_dec 001534 constant label dcl 1541 start_copy_whole_token 005624 constant label dcl 3364 start_num_lit_comp 002140 constant label dcl 1752 start_numeric_compare 000620 constant label dcl 1258 start_relational_compare 000507 constant label dcl 1096 start_separate_sign_processing 005211 constant label dcl 3122 start_sign_condition 000224 constant label dcl 955 start_tct_table_build 004731 constant label dcl 2962 start_test_for_numeric 005011 constant label dcl 3007 start_ubranch 000151 constant label dcl 914 tct_table_build 004730 constant entry internal dcl 2935 ref 2694 2717 3199 test_for_numeric 005010 constant entry internal dcl 2989 ref 2879 3210 tra_label 001322 constant label dcl 1416 ref 1305 1328 1349 ubranch 000150 constant entry internal dcl 906 ref 889 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 6222 7720 5743 6232 Length 10650 5743 1476 714 257 1416 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_compare_gen 1000 external procedure is an external procedure. ubranch internal procedure shares stack frame of external procedure cobol_compare_gen. sign_condition internal procedure shares stack frame of external procedure cobol_compare_gen. relational_compare internal procedure shares stack frame of external procedure cobol_compare_gen. numeric_compare internal procedure shares stack frame of external procedure cobol_compare_gen. convert_to_dec internal procedure shares stack frame of external procedure cobol_compare_gen. comp6_proc internal procedure shares stack frame of external procedure cobol_compare_gen. num_lit_comp internal procedure shares stack frame of external procedure cobol_compare_gen. alpha_compare internal procedure shares stack frame of external procedure cobol_compare_gen. convert_to_alpha internal procedure shares stack frame of external procedure cobol_compare_gen. class_condition internal procedure shares stack frame of external procedure cobol_compare_gen. tct_table_build internal procedure shares stack frame of external procedure cobol_compare_gen. test_for_numeric internal procedure shares stack frame of external procedure cobol_compare_gen. separate_sign_processing internal procedure shares stack frame of external procedure cobol_compare_gen. copy_whole_token internal procedure shares stack frame of external procedure cobol_compare_gen. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 numeric_zero cobol_compare_gen 000022 type9_zero cobol_compare_gen 000066 type9_zero_ptr cobol_compare_gen 000070 type9_numeric_tct cobol_compare_gen 000140 type9_numeric_tct_ptr cobol_compare_gen 000142 type9_alpha_tct cobol_compare_gen 000212 type9_alpha_tct_ptr cobol_compare_gen 000214 type9_opch_tct cobol_compare_gen 000264 type9_opch_tct_ptr cobol_compare_gen 000266 minus_type9 cobol_compare_gen 000336 plus_type9 cobol_compare_gen 000406 zero_allocated cobol_compare_gen 000407 numeric_tct_table_allocated cobol_compare_gen 000410 alpha_tct_table_allocated cobol_compare_gen 000411 opch_tct_table_allocated cobol_compare_gen 000412 alpha_tct_table cobol_compare_gen 000612 numeric_tct_table cobol_compare_gen 001012 opch_tct_table cobol_compare_gen 001212 separate_signs_pooled cobol_compare_gen 001213 separate_sign_literal cobol_compare_gen 001222 saved_lop_ptr relational_compare 001224 move_bin_18 numeric_compare 001236 bin_36_rop numeric_compare 001272 bin_36_lop numeric_compare 001326 bin_18_type9 numeric_compare 001362 bin_18_type19 numeric_compare 001374 eaa_buff comp6_proc 001376 inst_code comp6_proc 001400 reg_struc comp6_proc 001411 inst_code num_lit_comp 001412 compare_inst num_lit_comp 001414 reg_struc num_lit_comp STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_compare_gen 000100 non_eis_ptr cobol_compare_gen 000102 non_eis_word cobol_compare_gen 000104 eis_ptr cobol_compare_gen 000106 wkbuff1 cobol_compare_gen 000132 wkbuff2 cobol_compare_gen 000137 wkbuff3 cobol_compare_gen 000152 i_ptr cobol_compare_gen 000154 save_locno cobol_compare_gen 000155 topcode cobol_compare_gen 000156 in_op cobol_compare_gen 000157 alpha_flag cobol_compare_gen 000160 work_in_token_ptr cobol_compare_gen 000162 work_in_token cobol_compare_gen 000172 work_in_token1_ptr cobol_compare_gen 000174 work_in_token1 cobol_compare_gen 000204 dn_ptr cobol_compare_gen 000206 sort_pcs_ptr cobol_compare_gen 000210 alpha_name_ptr cobol_compare_gen 000212 rw_ptr cobol_compare_gen 000214 alit_ptr cobol_compare_gen 000216 eos_ptr cobol_compare_gen 000220 input_ptr cobol_compare_gen 000222 inst_ptr cobol_compare_gen 000224 reloc_ptr cobol_compare_gen 000242 out1_ptr sign_condition 000252 continue relational_compare 000253 both_numeric relational_compare 000254 lop_ptr relational_compare 000256 rop_ptr relational_compare 000266 buff1 numeric_compare 000336 buff2 numeric_compare 000406 temp_lop_ptr numeric_compare 000410 temp_rop_ptr numeric_compare 000412 out1_ptr numeric_compare 000414 out2_ptr numeric_compare 000416 equal_flag numeric_compare 000417 less_flag numeric_compare 000420 greater_flag numeric_compare 000444 temp_lop_ptr num_lit_comp 000446 temp_token_ptr num_lit_comp 000450 temp num_lit_comp 000451 in_op num_lit_comp 000452 ic_flag num_lit_comp 000453 nonzero_pr num_lit_comp 000454 k num_lit_comp 000455 bin_36_buff num_lit_comp 000513 smallest_long_binary num_lit_comp 000516 largest_long_binary num_lit_comp 000521 work_fdec num_lit_comp 000526 work_fdec_ptr num_lit_comp 000530 LP num_lit_comp 000532 RP num_lit_comp 000534 LS num_lit_comp 000535 RS num_lit_comp 000536 LPL num_lit_comp 000537 RPL num_lit_comp 000540 SI num_lit_comp 000541 SO num_lit_comp 000542 ret_offset num_lit_comp 000543 long_bin_const num_lit_comp 000544 long_bin_ptr num_lit_comp 000556 wkbuff1 alpha_compare 000626 wkbuff2 alpha_compare 000676 wkbuff1_ptr alpha_compare 000700 wkbuff2_ptr alpha_compare 000702 cmpc_filler alpha_compare 000703 filler_hier alpha_compare 000704 temp_cmpc_filler alpha_compare 000705 temp_filler_hier alpha_compare 000706 temp_op_ptr alpha_compare 000716 move_token convert_to_alpha 000732 eos_buff convert_to_alpha 000744 wkbuff1 convert_to_alpha 001014 alit_buffer convert_to_alpha 001064 temp_type9_token convert_to_alpha 001134 descrip_ptr convert_to_alpha 001136 s_length convert_to_alpha 001137 s_offset convert_to_alpha 001140 t_key convert_to_alpha 001142 temp9_ptr convert_to_alpha 001144 ix convert_to_alpha 001145 changed_descrip_bits convert_to_alpha 001146 save_dn_ptr convert_to_alpha 001156 sep_sign_ptr class_condition 001160 separate_sign_processing_flag class_condition 001161 summary_buff class_condition 001232 in_op_ptr class_condition 001234 tct_table_ptr class_condition 001236 original_in_op_ptr class_condition 001240 st_offset class_condition 001242 tct_ptr class_condition 001244 summary_ptr class_condition 001246 descrip_ptr class_condition 001250 work_binary class_condition 001251 ret_offset class_condition 001252 eos_buff class_condition 001264 temp_eos_ptr class_condition 001266 move_token class_condition 001310 t_offset tct_table_build 001326 separate_sign_type9 separate_sign_processing 001376 separate_sign_eos separate_sign_processing 001410 save_h separate_sign_processing 001411 save_not separate_sign_processing 001412 fail_tag separate_sign_processing 001413 temp_tag separate_sign_processing 001414 temp_ptr separate_sign_processing THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as call_ext_in call_ext_out_desc call_ext_out return_mac ext_entry trunc_fx2 divide_fx1 THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_addr cobol_alloc$stack cobol_define_tag cobol_emit cobol_get_index_value cobol_make_tagref cobol_make_type9$copy cobol_make_type9$long_bin cobol_make_type9$type2_3 cobol_move_gen cobol_num_to_udts cobol_pool$search_op cobol_register$load cobol_register$release cobol_trans_alphabet THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cobol_$compile_count cobol_$main_pcs_ptr cobol_$next_tag cobol_$temp_token_ptr cobol_$text_wd_off LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 34 000032 40 000043 42 000045 44 000046 47 000055 862 000061 865 000063 866 000065 869 000067 873 000076 875 000102 876 000104 877 000106 881 000107 883 000114 884 000117 885 000121 887 000122 889 000123 892 000130 895 000136 900 000146 903 000147 906 000150 914 000151 916 000152 919 000154 922 000156 925 000161 926 000164 930 000166 935 000202 939 000222 945 000223 955 000224 961 000230 963 000232 965 000244 974 000247 977 000256 981 000276 983 000300 985 000302 989 000304 990 000306 991 000311 992 000312 993 000314 994 000316 995 000317 996 000322 997 000324 1002 000325 1006 000337 1007 000341 1011 000345 1016 000362 1018 000365 1020 000371 1022 000400 1023 000402 1026 000403 1028 000405 1030 000414 1031 000416 1036 000417 1038 000426 1044 000430 1045 000431 1048 000433 1051 000437 1054 000442 1055 000445 1060 000447 1066 000465 1069 000505 1075 000506 1096 000507 1101 000516 1103 000520 1105 000525 1107 000530 1109 000532 1112 000533 1114 000536 1118 000541 1119 000542 1120 000544 1123 000546 1125 000550 1132 000571 1134 000575 1135 000576 1136 000600 1139 000601 1140 000603 1143 000604 1145 000605 1149 000606 1153 000613 1156 000615 1162 000616 1258 000620 1260 000622 1262 000624 1263 000625 1264 000626 1265 000630 1269 000652 1276 000674 1278 000676 1279 000701 1280 000703 1281 000706 1286 000707 1288 000714 1289 000717 1290 000721 1291 000724 1294 000725 1296 000734 1300 000740 1303 000752 1305 000771 1310 000772 1312 000775 1317 001013 1319 001031 1320 001036 1321 001040 1323 001042 1326 001052 1328 001066 1331 001067 1335 001076 1336 001077 1337 001100 1338 001101 1340 001107 1347 001113 1349 001124 1356 001125 1358 001130 1365 001160 1367 001170 1373 001173 1376 001177 1383 001227 1385 001237 1391 001242 1392 001244 1393 001247 1394 001250 1395 001253 1396 001255 1397 001256 1398 001261 1399 001263 1403 001264 1408 001277 1409 001301 1413 001305 1416 001322 1419 001325 1422 001363 1426 001400 1428 001403 1430 001412 1431 001414 1434 001415 1436 001417 1438 001426 1439 001430 1442 001431 1444 001433 1446 001442 1447 001444 1452 001445 1454 001454 1461 001456 1462 001457 1463 001461 1466 001465 1469 001470 1470 001473 1475 001475 1481 001511 1484 001531 1491 001532 1541 001534 1544 001537 1548 001555 1551 001557 1553 001563 1555 001565 1557 001577 1561 001602 1562 001605 1564 001606 1569 001632 1573 001644 1578 001645 1610 001647 1612 001651 1613 001654 1614 001655 1615 001660 1618 001662 1620 001667 1621 001671 1622 001672 1626 001673 1627 001676 1629 001705 1633 001707 1636 001721 1638 001732 1639 001741 1642 001751 1644 001765 1645 001767 1646 001772 1647 001773 1648 001777 1651 002001 1655 002006 1657 002012 1659 002017 1663 002037 1664 002042 1666 002043 1667 002046 1668 002053 1671 002063 1674 002075 1677 002112 1679 002123 1684 002124 1728 002126 1730 002134 1752 002140 1754 002141 1755 002142 1756 002143 1759 002145 1761 002152 1762 002153 1763 002156 1764 002157 1766 002166 1770 002172 1772 002177 1773 002200 1776 002223 1777 002225 1783 002226 1786 002231 1788 002232 1789 002233 1791 002234 1792 002235 1796 002236 1798 002241 1801 002244 1804 002246 1808 002250 1811 002253 1815 002260 1817 002262 1821 002263 1824 002272 1828 002301 1830 002303 1832 002304 1835 002305 1839 002312 1841 002314 1845 002315 1849 002324 1852 002333 1854 002335 1856 002336 1857 002337 1860 002346 1862 002350 1864 002351 1869 002352 1870 002353 1873 002367 1875 002402 1877 002404 1878 002407 1879 002411 1881 002425 1882 002430 1886 002436 1890 002441 1892 002445 1894 002455 1895 002456 1900 002457 1902 002464 1903 002467 1905 002474 1908 002476 1911 002512 1916 002515 1918 002522 1920 002531 1922 002540 1924 002553 1928 002554 1930 002563 1934 002571 1936 002600 1937 002605 1938 002607 1939 002612 1940 002613 1941 002614 1944 002616 1946 002623 1947 002625 1948 002626 1952 002627 1953 002632 1955 002641 1959 002643 1962 002655 1964 002666 1965 002675 1968 002705 1972 002721 1974 002724 1976 002726 1978 002752 1980 002760 1981 002762 1983 002764 1985 002777 1986 003001 1987 003004 1988 003005 1989 003007 1991 003011 1993 003024 1995 003031 1997 003046 2003 003047 2005 003053 2006 003055 2009 003062 2011 003066 2016 003106 2018 003117 2020 003120 2025 003121 2084 003123 2086 003125 2090 003126 2091 003131 2096 003137 2098 003141 2100 003160 2101 003163 2104 003166 2105 003170 2114 003171 2116 003175 2121 003203 2123 003205 2125 003223 2126 003226 2129 003231 2130 003233 2141 003234 2142 003243 2143 003245 2147 003250 2148 003254 2149 003257 2151 003260 2153 003270 2154 003272 2157 003273 2160 003275 2162 003304 2163 003306 2166 003307 2169 003311 2171 003320 2172 003322 2177 003323 2179 003332 2189 003334 2198 003370 2199 003372 2200 003375 2202 003376 2203 003402 2204 003404 2205 003405 2206 003410 2207 003412 2212 003413 2217 003426 2218 003430 2222 003434 2226 003437 2230 003454 2231 003455 2232 003457 2236 003464 2239 003467 2240 003472 2244 003474 2249 003510 2251 003530 2258 003531 2351 003533 2353 003536 2354 003542 2355 003543 2357 003544 2360 003547 2361 003552 2369 003570 2375 003573 2381 003605 2382 003614 2384 003616 2396 003617 2397 003623 2404 003630 2409 003644 2412 003650 2413 003655 2414 003661 2417 003663 2419 003666 2424 003670 2425 003672 2426 003674 2428 003677 2429 003701 2430 003703 2432 003705 2433 003707 2434 003710 2438 003711 2439 003713 2440 003715 2442 003721 2444 003724 2446 003726 2448 003730 2451 003732 2459 003743 2462 003744 2466 003752 2469 003754 2471 003756 2473 003770 2474 003773 2477 003774 2484 004005 2486 004025 2487 004030 2493 004032 2495 004045 2496 004047 2498 004057 2500 004067 2506 004077 2508 004113 2509 004115 2513 004121 2514 004127 2515 004133 2518 004135 2519 004140 2520 004142 2523 004144 2524 004146 2525 004151 2526 004153 2527 004155 2531 004157 2532 004161 2533 004163 2537 004165 2538 004167 2539 004170 2540 004172 2541 004176 2543 004201 2547 004202 2549 004213 2551 004215 2553 004217 2554 004222 2558 004224 2561 004225 2564 004227 2566 004230 2567 004232 2569 004235 2571 004243 2573 004246 2577 004254 2579 004256 2581 004265 2583 004273 2587 004274 2589 004302 2596 004307 2598 004311 2599 004313 2600 004314 2601 004315 2602 004317 2603 004321 2604 004323 2605 004325 2610 004330 2616 004341 2621 004342 2676 004343 2681 004344 2683 004353 2686 004357 2689 004363 2690 004365 2691 004366 2694 004370 2697 004371 2701 004374 2703 004376 2709 004377 2712 004403 2713 004405 2714 004406 2717 004410 2720 004411 2724 004414 2728 004416 2733 004422 2735 004424 2738 004426 2740 004430 2741 004432 2747 004445 2751 004450 2754 004452 2758 004454 2759 004457 2760 004461 2765 004462 2770 004500 2772 004503 2776 004505 2777 004507 2779 004511 2783 004513 2784 004515 2785 004516 2786 004520 2788 004522 2790 004523 2793 004524 2799 004535 2801 004537 2805 004541 2813 004543 2820 004555 2825 004557 2827 004561 2833 004563 2834 004565 2847 004567 2851 004605 2853 004607 2854 004611 2855 004613 2858 004615 2859 004617 2861 004622 2862 004624 2863 004626 2864 004630 2867 004632 2879 004633 2885 004634 2888 004636 2889 004641 2891 004650 2894 004652 2895 004653 2898 004655 2902 004661 2903 004664 2906 004666 2910 004671 2915 004705 2918 004725 2925 004726 2930 004727 2935 004730 2962 004731 2967 004755 2968 004760 2970 004766 2971 004770 2974 004772 2975 004774 2977 004777 2978 005001 2979 005003 2980 005005 2984 005007 2989 005010 3007 005011 3010 005013 3011 005016 3012 005017 3013 005021 3014 005023 3017 005024 3021 005037 3022 005041 3026 005045 3031 005062 3032 005064 3033 005067 3034 005070 3035 005072 3036 005074 3039 005075 3044 005110 3050 005112 3051 005122 3055 005125 3060 005142 3061 005144 3062 005147 3063 005150 3064 005152 3065 005154 3068 005155 3073 005170 3077 005172 3081 005207 3086 005210 3122 005211 3126 005213 3131 005224 3132 005227 3133 005231 3134 005232 3136 005233 3142 005251 3145 005253 3146 005256 3149 005257 3152 005261 3153 005262 3154 005264 3157 005270 3158 005273 3163 005275 3167 005311 3170 005314 3173 005317 3178 005323 3180 005331 3183 005333 3187 005350 3190 005357 3193 005363 3194 005364 3195 005366 3196 005367 3199 005371 3201 005372 3202 005375 3206 005377 3207 005401 3210 005403 3213 005404 3217 005406 3218 005411 3224 005415 3227 005432 3230 005452 3238 005453 3242 005457 3244 005461 3246 005463 3250 005475 3251 005500 3253 005502 3256 005514 3260 005517 3261 005521 3262 005523 3264 005530 3266 005532 3270 005533 3271 005535 3272 005537 3274 005541 3276 005543 3285 005545 3287 005547 3288 005551 3289 005553 3290 005555 3294 005557 3302 005571 3304 005573 3305 005576 3311 005600 3319 005612 3323 005621 3328 005622 3364 005624 3368 005630 3369 005634 3376 005650 3378 005661 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved