COMPILATION LISTING OF SEGMENT cobol_write_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 0951.8 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_write_gen.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 12/07/80 by FCH, [4.4-1], report writer added */ 23 /* modified on 08/15/79 by MHD, [4.0-2], fixed problem in write with LINAGE clause */ 24 /* modified on 06/27/79 by FCH, [4.0-1], not option added for debug */ 25 /* Modified on 11/13/78 by FCH, [3.0-1], alt rec keys added */ 26 /* Modified since Version 3.0 */ 27 28 /* format: style3 */ 29 cobol_write_gen: 30 proc (mp_ptr, passed_tag); 31 32 dcl stoff fixed bin; 33 dcl (good_tag, stream_tag, seek_tag, write_tag, skip_tag, alt_tag, alt_seek_tag) 34 fixed bin; 35 dcl passed_tag fixed bin; /* for in-line error handling */ 36 dcl ptag fixed bin; 37 dcl linage_ptr ptr; 38 dcl mp_ptr ptr; 39 dcl 1 mp based (mp_ptr), 40 2 n fixed bin, /* from 3 - 5 */ 41 2 pt (0 refer (mp.n)) ptr; /* pt(1) pts to type1 token for WRITE */ 42 /* pt(2) pts to type9 token (record name) or type12 token(file name) */ 43 /* pt(3) pts to type9 token for FROM data IF eos.c = "1"b */ 44 /* pt(n-1) pts to type9 token for ADVANCING data IF eos.d ^= "00"b */ 45 /* pt(n) pts to type19 token (eos) */ 46 47 dcl 1 args, 48 2 entryno fixed bin, 49 2 arglist_off fixed bin, 50 2 stacktemp_off fixed bin, 51 2 n fixed bin, 52 2 arg (4), 53 3 pt ptr, 54 3 type fixed bin, 55 3 off1 fixed bin, 56 3 off2 fixed bin, 57 3 value bit (18) unal, 58 3 indirect bit (1) unal, 59 3 overlay bit (1) unal, 60 3 repeat_nogen bit (1) unal; 61 62 dcl file_key_desc char (40) based; 63 dcl extend_sw bit (1) aligned; 64 dcl (alt_sw, code_set_sw, var) 65 bit (1); 66 dcl text (0:100000) bit (36) based (cobol_$text_base_ptr); 67 dcl argb (4) bit (216) based (addr (args.arg (1))); 68 dcl save_mp2_ptr ptr; 69 dcl ft_ptr ptr; 70 dcl fkey_ptr ptr; 71 dcl dn_ptr ptr; 72 dcl name_ptr ptr; 73 dcl arg_ptr ptr; 74 dcl ioerror_ptr ptr; 75 76 dcl (temp, fn) fixed bin; 77 dcl aloff fixed bin init (0); 78 dcl size fixed bin; 79 dcl offset fixed bin; 80 dcl reclen_off fixed bin; 81 dcl buflen_off fixed bin; 82 dcl buf_off fixed bin; 83 dcl ntag fixed bin; 84 85 /*************************************/ 86 /*************************************/ 87 /* INITIALIZATION */ 88 start: 89 pr5_struct_ptr = addr (pr5_struct); 90 rw_ptr = mp.pt (1); 91 92 eos_ptr = mp.pt (mp.n); 93 ioerror.retry_tag = cobol_$next_tag; 94 good_tag = cobol_$next_tag + 1; 95 stream_tag = cobol_$next_tag + 2; 96 seek_tag = cobol_$next_tag + 3; 97 write_tag = cobol_$next_tag + 4; /* [3.0-1] */ 98 alt_tag = cobol_$next_tag + 5; /* [3.0-1] */ 99 alt_seek_tag = cobol_$next_tag + 6; 100 cobol_$next_tag = cobol_$next_tag + 7; /*[4.4-1]*/ 101 call set_up; 102 arg_ptr = addr (args); 103 ioerror.cobol_code = 0; 104 ioerror.type1_ptr = mp.pt (1); 105 ioerror.mode = 0; 106 ioerror_ptr = addr (ioerror); 107 iocb_arg.pt = addr (iocb_struct); 108 109 if end_stmt.b = "1"b 110 then do; 111 passed_tag, ioerror.ns_tag = cobol_$next_tag; 112 ioerror.is_tag = cobol_$next_tag + 1; 113 cobol_$next_tag = cobol_$next_tag + 2; 114 end; 115 else do; 116 ioerror.is_tag = 0; 117 ioerror.ns_tag = cobol_$next_tag; 118 cobol_$next_tag = cobol_$next_tag + 1; 119 end; 120 121 /*[4.4-1]*/ 122 call cobol_read_ft (fn, ft_ptr); 123 124 if file_table.organization = 5 125 then file_table.organization = 4; /* temporary */ 126 127 iocb_struct.seg = file_table.fsb.seg; 128 iocb_struct.offset = file_table.fsb.off; 129 130 call cobol_alloc$stack (56, 2, aloff); /* enough for 14 words - aloff is a wd offset */ 131 132 args.arglist_off = aloff; 133 args.n = 4; 134 argb (1) = unspec (iocb_arg); 135 argb (4) = unspec (status_arg); 136 buflen_off = 80; 137 138 139 /*************************************/ 140 /* START CODE GENERATION */ 141 start_codegen: /* MOVE FROM DATANAME TO BUFFER IF NECESSARY */ 142 if end_stmt.c = "1"b /* FROM specified */ 143 then do; 144 mpout.pt1 = mp.pt (1); 145 mpout.pt2 = mp.pt (3); 146 mpout.pt3 = mp.pt (2); 147 mpout.pt4 = addr (type19); 148 149 call cobol_move_gen (addr (mpout)); 150 151 end; 152 153 /* MAKE SURE FILE IS OPEN */ 154 155 call cobol_define_tag (ioerror.retry_tag); 156 157 call cobol_set_fsbptr (ft_ptr); /* generates epp1 pr4|102,* */ 158 159 /* OPERATOR39(init_write) */ 160 call cobol_call_op (39, good_tag); /* INT_WRITE_OP */ 161 162 call cobol_gen_ioerror (ft_ptr, ioerror_ptr); 163 164 call cobol_define_tag (good_tag); 165 166 if file_table.linage /* LINAGE TOP initialization */ 167 then do; 168 call cobol_read_rand (1, file_table.linage_info, linage_ptr); 169 170 if linage_rec.top > 0 171 then do; 172 if linage_rec.top ^= 5 173 then call linage_init (linage_rec.top, 94 * 4); 174 else call cobol_ioop_util$set_fsb (linage_rec.top_int, 94); 175 176 end; 177 178 end; /*[4.4-1]*/ 179 if var /*[4.4-1]*/ 180 then do; 181 var = data_name.variable_length; 182 temp = data_name.item_length; 183 end; /*[4.4-1]*/ 184 else do; 185 var = file_table.variable; 186 temp = file_table.max_cra_size; 187 end; /* ESTABLISH RECORD LENGTH */ 188 /*[4.4-1]*/ 189 if ^var 190 then do; 191 192 call cobol_io_util$move_direct ("110"b, buflen_off * 4, 4, 1, substr (unspec (temp), 19, 18)); 193 end; 194 195 else do; 196 197 if ^file_table.rec_do 198 then call cobol_get_size (dn_ptr, buflen_off, reserved_word.line); 199 200 else do; 201 202 call cobol_read_rand (1, file_table.rec_do_info, fkey_ptr); 203 204 addr (fkey_type9.file_key_info) -> file_key_desc = file_key.desc; 205 206 call cobol_io_util$t9dec_to_bin ("110"b, buflen_off * 4, addr (fkey_type9)); 207 208 end; 209 end; 210 211 /* CONVERT IF CODE SET INDICATES SO */ 212 code_set_sw = file_table.code_set_clause & file_table.code_set = 12; 213 214 if code_set_sw 215 then do; 216 call cobol_alloc$stack (data_name.size + 1, 2, stoff); 217 /*-10/07/76-*/ 218 219 trans_type9.seg = 1000; /* in stack */ 220 trans_type9.off = stoff * 4; /*-10/07/76-*/ 221 trans_type9.size = data_name.size; 222 223 call cobol_trans_alphabet$io (dn_ptr, addr (trans_type9), fixed (file_table.code_set), 0); 224 225 dn_ptr = addr (trans_type9); /* set to converted record for remainder of this generator */ 226 227 end; 228 229 /* STREAM OUTPUT */ 230 231 /* [3.0-1] */ 232 alt_sw = file_table.organization = 3 /* ind */ /* [3.0-1] */ & /* [3.0-1] */ file_table.alternate_keys ^= 0; 233 234 if file_table.organization = 4 | file_table.device = 1 | file_table.device = 3 235 then do; 236 if end_stmt.b = "1"b 237 then /* in-line error coding follows */ 238 call cobol_ioop_util$set_icode; 239 240 if code_set_sw 241 then do; 242 save_mp2_ptr = mp.pt (2); 243 mp.pt (2) = addr (trans_type9); 244 245 246 end; 247 248 call cobol_linage (ft_ptr, mp_ptr, buflen_off, buf_off, ioerror_ptr); 249 250 /* OPPERATOR52(LINAGE) */ 251 call init_linage; /*[4.0-2]*/ 252 if code_set_sw 253 then mp.pt (2) = save_mp2_ptr; 254 255 call cobol_set_fsbptr (ft_ptr); 256 257 call cobol_ioop_util$disp (buf_off); 258 259 /* OPERATOR68(write_stream_linage) */ 260 261 if file_table.linage 262 then call cobol_call_op (68, stream_tag); 263 /* write_stream_linage_op */ 264 265 /* OPERATOR40(write_stream) */ 266 267 else call cobol_call_op (40, stream_tag); 268 /* write_stream_op */ 269 270 call cobol_gen_ioerror (ft_ptr, ioerror_ptr); 271 272 end; 273 274 else do; 275 276 if file_table.access < 2 277 then if file_table.external | file_table.open_io 278 then do; 279 ntag = cobol_$next_tag; 280 cobol_$next_tag = cobol_$next_tag + 1; 281 282 call cobol_io_util$bypass_mode_error (ntag, "10"b); 283 284 call cobol_define_tag (ntag); 285 286 end; 287 288 /* SEEK KEY FOR RELATIVE OR INDEXED FILES */ 289 290 if file_table.organization ^= 1 /* not sequential */ 291 then do; 292 if file_table.relative_key | file_table.record_key 293 then do; 294 295 call cobol_read_rand (1, file_table.r_key_info, fkey_ptr); 296 297 addr (fkey_type9.file_key_info) -> file_key_desc = file_key.desc; 298 end; 299 300 if file_table.organization = 2 & file_table.access < 2 301 /* relative sequential */ 302 then do; 303 call cobol_io_util$fixed_add ("001"b, fsb_relkey, 1, ""b, 0); 304 /* must maintain own relkey */ 305 306 call cobol_io_util$bin_to_dec ("001"b, fsb_key, 16, "001"b, fsb_relkey, 4); 307 308 call cobol_io_util$move_direct ("001"b, fsb_keylen_sw, 4, 1, 309 "000000000000010000"b); 310 311 end; 312 else do; 313 314 mpout.pt1 = mp.pt (1); 315 mpout.pt2 = addr (fkey_type9); 316 if file_table.organization = 2 317 then do; 318 mpout.pt3 = addr (num_type9); 319 size, num_type9.size, num_type9.places_left = 16; 320 num_type9.seg = 5001; 321 /* from PR1 */ 322 num_type9.off = file_table.fsb.off + fsb_key; 323 end; 324 else do; /* indexed */ 325 mpout.pt3 = addr (alpha_type9); 326 size, alpha_type9.size = fkey_type9.size; 327 alpha_type9.seg = 5001; 328 /* from PR1 */ 329 alpha_type9.off = file_table.fsb.off + fsb_key; 330 end; 331 332 mpout.pt4 = addr (type19); 333 334 call cobol_move_gen (addr (mpout)); 335 /* must always move reckey to varying string */ 336 337 call cobol_io_util$move_direct ("001"b, fsb_keylen_sw, 4, 1, 338 substr (unspec (size), 19, 18)); 339 340 end; 341 342 if alt_sw 343 then call EMIT_OP_91; 344 345 call cobol_call_op (41, seek_tag); 346 /* OPERATOR41(seek_tag) */ 347 348 call cobol_gen_ioerror (ft_ptr, ioerror_ptr); 349 350 call cobol_define_tag (seek_tag); 351 352 353 /* RESET "LAST-KEY-READ" IF NECESSARY */ 354 if file_table.access < 2 & (file_table.external | file_table.open_io) 355 then do; 356 call cobol_set_fsbptr (ft_ptr); 357 /* set pr1 to fsb */ 358 359 call cobol_io_util$move_direct ("001"b, fsb_keylen_sw, 4, 1, ""b); 360 /* zero fsb.keylen_sw */ 361 362 end; 363 364 end; 365 366 else if alt_sw 367 then call EMIT_OP_91; 368 369 /* WRITE THE RECORD */ 370 371 call cobol_set_pr (pr5_struct_ptr, dn_ptr); 372 373 if end_stmt.b = "1"b 374 then call cobol_ioop_util$set_icode; 375 376 call cobol_call_op (42, write_tag); /* OPERATOR42(write_record) */ 377 378 call cobol_gen_ioerror (ft_ptr, ioerror_ptr); 379 380 call cobol_define_tag (write_tag); 381 382 /* [3.0-1] */ 383 if alt_sw /* [3.0-1] */ 384 then do; 385 call cobol_io_util$file_desc (file_table.file_desc_1_offset); 386 /* [3.0-1] */ 387 call cobol_call_op (90, stream_tag); 388 /* OPERATOR90(alt_add_write_keys) */ 389 /* [3.0-1] */ 390 call cobol_gen_ioerror (ft_ptr, ioerror_ptr); 391 /* [3.0-1] */ 392 end; 393 394 /* SET RELATIVE KEY IF NECESSARY */ 395 if file_table.organization = 2 & file_table.access < 2 & file_table.relative_key 396 then do; 397 call cobol_set_fsbptr (ft_ptr); 398 399 mpout.pt1 = mp.pt (1); 400 mpout.pt2 = addr (num_type9); 401 num_type9.size, num_type9.places_left = 16; 402 num_type9.seg = 5001; /* from PR1 */ 403 num_type9.off = file_table.fsb.off + fsb_key; 404 mpout.pt3 = addr (fkey_type9); 405 mpout.pt4 = addr (type19); 406 407 call cobol_move_gen (addr (mpout)); 408 409 end; 410 411 end; 412 413 414 call cobol_define_tag (stream_tag); 415 416 /* [3.0-1] */ 417 if alt_sw 418 then call cobol_set_fsbptr (ft_ptr); 419 420 421 422 call cobol_reg_manager$after_op (4095 + ioerror.cobol_code); 423 424 /*[4.0-1]*/ 425 if end_stmt.f = "01"b /*[4.0-1]*/ 426 then passed_tag = ioerror.is_tag; /*[4.0-1]*/ 427 else call cobol_gen_ioerror$finish_up (ft_ptr, ioerror_ptr); 428 429 430 return; 431 432 EMIT_OP_91: 433 proc; 434 435 /* [3.0-1] */ 436 call cobol_io_util$file_desc (file_table.file_desc_1_offset); 437 /* [3.0-1] */ 438 call cobol_set_pr (pr5_struct_ptr, dn_ptr); /* [3.0-1] */ 439 call cobol_call_op (91, alt_seek_tag); /* OPERATOR91(alt_seek_key) */ 440 /* [3.0-1] */ 441 call cobol_gen_ioerror (ft_ptr, ioerror_ptr); /* [3.0-1] */ 442 call cobol_define_tag (alt_seek_tag); /* [3.0-1] */ 443 call cobol_set_fsbptr (ft_ptr); 444 445 end; 446 447 /**/ 448 /****************************************/ 449 450 linage_init: 451 proc (index_value, fsb_offset); 452 453 dcl index_value fixed bin (15); 454 dcl fsb_offset fixed bin; 455 456 addr (fkey_type9.file_key_info) -> file_key_desc = linage_rec.name_desc (index_value); 457 458 mpout.n = 4; 459 mpout.pt1 = mp.pt (1); 460 mpout.pt2 = addr (fkey_type9); 461 mpout.pt3 = addr (comp6_type9); 462 463 comp6_type9.size, comp6_type9.places_left = 4; 464 comp6_type9.seg = 5001; /* TO PR1 */ 465 comp6_type9.off = file_table.fsb.off + fsb_offset; 466 467 mpout.pt4 = addr (type19); 468 469 call cobol_move_gen (addr (mpout)); 470 471 return; 472 473 end linage_init; 474 init_linage: 475 proc; /*[4.0-2]*/ 476 /* This block of code was made into a subroutine in order to fix a bug in the 477* write using a LINAGE clause. This is the code genetated that assigns the new 478* Page-Size, Footing-Size, and Bottom-Size */ 479 480 if file_table.linage /* LINAGE initialization */ 481 then do; 482 call cobol_set_fsbptr (ft_ptr); 483 484 skip_tag = cobol_$next_tag; 485 cobol_$next_tag = cobol_$next_tag + 1; 486 487 call cobol_ioop_util$bypass_reset (skip_tag); 488 489 call cobol_read_rand (1, file_table.linage_info, linage_ptr); 490 491 if linage_rec.body > 0 492 then do; 493 if linage_rec.body ^= 5 494 then call linage_init (linage_rec.body, 92 * 4); 495 else call cobol_ioop_util$set_fsb (linage_rec.body_int, 92); 496 497 end; 498 else do; 499 500 linage_rec.body_int = 66; /* default should no reach this point. */ 501 linage_rec.body = 5; 502 503 call cobol_ioop_util$set_fsb (linage_rec.body_int, 92); 504 505 end; 506 507 if linage_rec.footing > 0 508 then do; 509 if linage_rec.footing ^= 5 510 then call linage_init (linage_rec.footing, 93 * 4); 511 512 else do; 513 514 if linage_rec.footing_int = 0 515 then call cobol_ioop_util$set_fsb (linage_rec.body_int, 135); 516 517 else call cobol_ioop_util$set_fsb (linage_rec.footing_int, 93); 518 519 end; 520 521 end; 522 else do; 523 524 if linage_rec.body ^= 5 525 then call linage_init (linage_rec.body, 93 * 4); 526 else call cobol_ioop_util$set_fsb (linage_rec.body_int, 93); 527 528 end; 529 530 if linage_rec.bottom > 0 531 then do; 532 if linage_rec.bottom ^= 5 533 then call linage_init (linage_rec.bottom, 95 * 4); 534 else call cobol_ioop_util$set_fsb (linage_rec.bottom_int, 95); 535 536 end; 537 538 call cobol_define_tag (skip_tag); 539 540 541 end; 542 543 end init_linage; 544 545 set_up: 546 proc; 547 548 /*[4.4-1]*/ 549 if end_stmt.a = "010"b /*[4.4-1]*/ 550 then do; 551 end_stmt.c = "0"b; /* write fn from dn (report) */ 552 /*[4.4-1]*/ 553 end_stmt.a = "001"b; /*[4.4-1]*/ 554 dn_ptr = mp.pt (3); /*[4.4-1]*/ 555 fn = mp.pt (2) -> fd_token.file_no; /*[4.4-1]*/ 556 mp.pt (2) = mp.pt (3); /*[4.4-1]*/ 557 var = "1"b; /*[4.4-1]*/ 558 end; /*[4.4-1]*/ 559 else do; 560 dn_ptr = mp.pt (2); /*[4.4-1]*/ 561 fn = data_name.file_num; /*[4.4-1]*/ 562 var = "0"b; /*[4.4-1]*/ 563 end; 564 565 end; 566 567 1 1 1 2 1 3 /* 1 4* 1 5* The procedure cobol_write_gen.pl1 generates the code which realizes the 1 6*COBOL write statement. 1 7* 1 8* Format 1 WRITE rn [id] [id] eos 1 9* 1 10* FORMAT 2 WRITE rn [id] eos 1 11* 1 12* FORMAT 3 WRITE fn id eos 1 13* 1 14* eos a=000 format 1 write advancing 1 15* 001 format 2 1 16* 010 format 3 write report file 1 17* 1 18* b=0 no EOP 1 19* 1 EOP 1 20* 1 21* c=0 no FROM 1 22* 1 FROM 1 23* 1 24* d=00 neither 1 25* 01 BEFORE 1 26* 10 AFTER 1 27* 1 28* f=00 no NOT 1 29* 01 NOT 1 30* 1 31* mp.n 3 - 5 1 32* mp.ptr(1) type-1("WRITE") 1 33* mp.ptr(2) type-9(record-name) or type-12(file-name) 1 34* mp.ptr(3) type-9(from id) 1 35* mp.ptr(4) type-9(data-name,advancing id) 1 36* type-1("PAGE") 1 37* type-2(advancing literal) 1 38* type-17(mnemonic-name) 1 39* mp.ptr(n) eos 1 40* 1 41*Flow Chart 1 42* 1 43*TAG(ioerror.retry_tag): 1 44* 1 45* OP39(init_write,good_tag);GEN_IOERROR 1 46* 1 47*TAG(good_tag): 1 48* 1 49* alt_sw = file_table.organization = 3 ind 1 50* & 1 51* file_table.alternate_keys ^= 0 1 52* 1 53* if file_table.organization = 4 stream 1 54* | 1 55* file_table.device = 1 printer 1 56* | 1 57* file_table.device = 3 punch 1 58* 1 59* then do; if file_table.linage 1 60* then OP68(write_stream_linage,stream_tag) 1 61* else OP40(write_stream,stream_tag) 1 62* 1 63* GEN_IOERROR 1 64* end; 1 65* else do; if file_table.access < 2 seq 1 66* | 1 67* file_table.open_io 1 68* 1 69* then do; INCR_NTAG 1 70* IO_UTIL$BYPASS_MODE_ERROR 1 71*TAG(ntag): 1 72* end; 1 73* 1 74* if alt_sw 1 75* then do; IO_UTIL$FILE_DESC 1 76* OP91(alt_write_seek_key,alt_seek_tag) 1 77* GEN_IOERROR 1 78*TAG(alt_seek_tag): 1 79* SET_FSBPTR 1 80* end; 1 81* 1 82* if file_table.organization ^= 1 not seq 1 83* then do; move key to FSB 1 84* if alt_sw then call EMIT_OP_91; 1 85* OP41(seek_key,seek_tag) 1 86* GEN_IOERROR 1 87*TAG(seek_tag): 1 88* end; 1 89* else if alt_sw then call EMIT_OP_91; 1 90* 1 91* OP42(write_record,write_tag);GEN_IOERROR 1 92* 1 93*TAG(write_tag): 1 94* 1 95* if alt_sw then IO_UTIL$FILE_DESC;OP90(alt_add_write_keys,stream_tag);GEN_IOERROR 1 96* 1 97* end; 1 98* 1 99*TAG(stream_tag): 1 100* 1 101* if alt_sw then SET_FSBPTR 1 102* 1 103* if file_table.linage then do; INCR_NTAG(skip_tag) 1 104* 1 105*TAG(skip_tag): 1 106* end; 1 107* 1 108*EMIT_OP_91: proc; 1 109* 1 110* IO_UTIL$FILE_DESC 1 111* COBOL_SET_PR 1 112* OP91(alt_write_seek_key,alt_seek_tag) 1 113* GEN_IOERROR 1 114*TAG(alt_seek_tag): 1 115* SET_FSBPTR 1 116*end; 1 117* 1 118**/ 1 119 2 1 /* 2 2*cobol_operators_: write statement 2 3* 2 4* OP39(init_write) 2 5* 2 6* OP40(write_stream) 2 7* 2 8* SUBR_PUT_CHARS 2 9* 2 10* OP41(seek_key) 2 11* 2 12* SUBR_SEEK_OP(16) 2 13* 2 14* OP42(write_record) 2 15* 2 16* iox_$write_record) 2 17* 2 18* OP68(write_stream_linage) 2 19* 2 20* SUBR_PUT_CHARS 2 21* 2 22* OP90(alt_add_write_keys) 2 23* 2 24* if cobol_mode = 61 then save prime key in crp.prime_key 2 25* add alternate key values to record 2 26* update fields in FSB 2 27* RTS(56) 2 28* 2 29* OP91(alt_write_seek_key) 2 30* 2 31* if cobol_mode = 61 then test key order (error_table_$key_order) 2 32* if necessary then SAVE_CRP 2 33* test alternate key values for legality (error_table_$invalid_key) 2 34* if invalid key and SAVE_CRP was executed then RESTORE_CRP 2 35* shift key one position to right and prefix 2 36* RTS(51) 2 37* 2 38* SUBR_PUT_CHARS 40,68 2 39* 2 40* iox_$put_chars 2 41* 2 42* SUBR_SEEK_OP(i) 41,[67] 2 43* 2 44* iox_$seek_key 2 45* RTS(i) 2 46* 2 47**/ 1 120 1 121 568 3 1 3 2 /* STATIC DECLARATIONS */ 3 3 3 4 dcl pr5_struct_ptr ptr static; 3 5 3 6 dcl 1 pr5_struct static, 3 7 2 pr5 fixed bin init(5), 3 8 2 pointer_no bit(3), 3 9 2 lock fixed bin init(0), 3 10 2 switch fixed bin init(0), 3 11 2 segno fixed bin init(0), 3 12 2 offset fixed bin init(0), 3 13 2 reset fixed bin; 3 14 dcl 1 iocb_arg static, 3 15 2 pt ptr init(null()), /* initialized to address of basic structure */ 3 16 2 zeros bit(144) init(""b); 3 17 dcl 1 temp_arg static, 3 18 2 pt ptr init(null()), /* always null */ 3 19 2 type fixed bin init(3), 3 20 2 zeros bit(108) init(""b); 3 21 dcl 1 status_arg static, 3 22 2 pt ptr init(null()), /* always null */ 3 23 2 type fixed bin init(3), 3 24 2 off1 fixed bin init(40), 3 25 2 zeros bit(72) init(""b); 3 26 dcl 1 buff_arg static, 3 27 2 pt ptr init(null()), /* setto pt to type 9 token for buffer */ 3 28 2 type fixed bin init(5), 3 29 2 off1 fixed bin init(0), /* not meaningful */ 3 30 2 off2 fixed bin init(42), /* allocate ptr at sp|42 */ 3 31 2 bits bit(36) init("0000000000000000001000"b); /* indirect */ 3 32 dcl 1 fsb_arg static, 3 33 2 pt ptr init(null()), /* always null */ 3 34 2 type fixed bin init(3), 3 35 2 off1 fixed bin, /* set each time to wd offset in fsb */ 3 36 2 off2 fixed bin init(0), /* not used */ 3 37 2 bits bit(36) init("0000000000000000000001001"b); /* pr1 */ 3 38 3 39 dcl 1 pr1_struct static, 3 40 2 pr1 fixed bin init(1), 3 41 2 pointer_no bit(3), 3 42 2 lock fixed bin init(1), 3 43 2 switch fixed bin init(0), 3 44 2 segno fixed bin, 3 45 2 offset fixed bin, 3 46 2 reset fixed bin; 3 47 dcl 1 x1_struct static, 3 48 2 x1 fixed bin init(11), 3 49 2 reg_no bit(4), 3 50 2 lock fixed bin init(0), 3 51 2 already_there fixed bin, 3 52 2 contains fixed bin init(0), 3 53 2 null_ptr ptr init(null()), 3 54 2 fill bit(18) unaligned init((18)"0"b), 3 55 2 literal bit(18) unaligned; 3 56 dcl 1 aq_struct static, 3 57 2 aq fixed bin init(3), 3 58 2 reg_no bit(4), 3 59 2 lock fixed bin init(0), 3 60 2 already_there fixed bin, 3 61 2 contains fixed bin init(0), 3 62 2 null_ptr ptr init(null()), 3 63 2 fill bit(18) unaligned init((18)"0"b), 3 64 2 literal bit(18) unaligned; 3 65 3 66 dcl 1 iocb_struct static, 3 67 2 type fixed bin init(1), 3 68 2 operand_no fixed bin init(0), 3 69 2 lock fixed bin init(0), 3 70 2 seg fixed bin, 3 71 2 offset fixed bin, 3 72 2 send_receive fixed bin init(0); 3 73 3 74 dcl 1 mpout static, 3 75 2 n fixed bin init(4), 3 76 2 pt1 ptr, 3 77 2 pt2 ptr, 3 78 2 pt3 ptr, 3 79 2 pt4 ptr; 3 80 3 81 dcl 1 alpha_type9 static, 3 82 2 header (4) fixed bin init(112,0,0,9), 3 83 2 repl_ptr (2) ptr init((2)null()), 3 84 2 fill1 bit(108) init(""b), 3 85 2 file_key_info, 3 86 3 fb1 (3) fixed bin init(0,0,0), 3 87 3 size fixed bin init(0), 3 88 3 fb2 (2) fixed bin init(0,0), 3 89 3 flags1 bit(36) init("010000100100000000010000000100000000"b), 3 90 3 flags2 bit(36) init(""b), 3 91 3 seg fixed bin init(0), 3 92 3 off fixed bin, 3 93 2 fill2 (7) fixed bin init(0,0,0,0,0,0,0); 3 94 dcl 1 trans_type9 static, 3 95 2 header (4) fixed bin init(112,0,0,9), 3 96 2 repl_ptr (2) ptr init((2)null()), 3 97 2 fill1 bit(108) init(""b), 3 98 2 file_key_info, 3 99 3 fb1 (3) fixed bin init(0,0,0), 3 100 3 size fixed bin init(0), 3 101 3 fb2 (2) fixed bin init(0,0), 3 102 3 flags1 bit(36) init("010000100100000000010000000100000000"b), 3 103 3 flags2 bit(36) init(""b), 3 104 3 seg fixed bin init(0), 3 105 3 off fixed bin, 3 106 2 fill2 (7) fixed bin init(0,0,0,0,0,0,0); 3 107 dcl 1 num_type9 static, 3 108 2 header (4) fixed bin init(112,0,0,9), 3 109 2 repl_ptr (2) ptr init((2)null()), 3 110 2 fill1 bit(108) init(""b), 3 111 2 file_key_info, 3 112 3 fb1 (3) fixed bin init(0,0,0), 3 113 3 size fixed bin init(0), 3 114 3 places_left fixed bin, 3 115 3 places_right fixed bin init(0), 3 116 3 flags1 bit(36) init("010000100100000001000000000100000000"b), 3 117 3 flags2 bit(36) init(""b), 3 118 3 seg fixed bin init(0), 3 119 3 off fixed bin, 3 120 2 fill2 (7) fixed bin init(0,0,0,0,0,0,0); 3 121 dcl 1 comp6_type9 static, 3 122 2 header (4) fixed bin init(112,0,0,9), 3 123 2 repl_ptr (2) ptr init((2)null()), 3 124 2 fill1 bit(108) init(""b), 3 125 2 file_key_info, 3 126 3 fb1 (3) fixed bin init(0,0,0), 3 127 3 size fixed bin init(0), 3 128 3 places_left fixed bin, 3 129 3 places_right fixed bin init(0), 3 130 3 flags1 bit(36) init("010000100100001001000000000000000000"b), 3 131 3 flags2 bit(36) init(""b), 3 132 3 seg fixed bin init(0), 3 133 3 off fixed bin, 3 134 2 fill2 (7) fixed bin init(0,0,0,0,0,0,0); 3 135 dcl 1 fkey_type9 static, 3 136 2 header (4) fixed bin init(112,0,0,9), 3 137 2 repl_ptr (2) ptr init((2)null()), 3 138 2 fill1 bit(108) init(""b), 3 139 2 file_key_info, 3 140 3 fb1 (3) fixed bin init(0,0,0), 3 141 3 size fixed bin init(0), 3 142 3 fb2 (2) fixed bin init(0,0), 3 143 3 flags1 bit(36) init(""b), 3 144 3 flags2 bit(36) init(""b), 3 145 3 seg fixed bin, 3 146 3 off fixed bin, 3 147 2 fill2 (7) fixed bin init(0,0,0,0,0,0,0); 3 148 dcl 1 type19 static, 3 149 2 size fixed bin init(38), 3 150 2 line fixed bin init(0), 3 151 2 column fixed bin init(0), 3 152 2 type fixed bin init(19), 3 153 2 verb fixed bin init(18), /* verb number */ 3 154 2 e fixed bin init(1), 3 155 2 h fixed bin init(0), 3 156 2 i fixed bin init(0), 3 157 2 j fixed bin init(0), 3 158 2 a bit(3) init(""b), 3 159 2 b bit(1) init(""b), 3 160 2 c bit(1) init(""b), 3 161 2 d bit(2) init(""b), 3 162 2 f bit(2) init(""b), 3 163 2 g bit(2) init(""b), 3 164 2 k bit(5) init(""b); 3 165 3 166 dcl 1 ioerror static, 3 167 2 cobol_code fixed bin, 3 168 2 retry_tag fixed bin, 3 169 2 is_tag fixed bin, 3 170 2 ns_tag fixed bin, 3 171 2 type1_ptr ptr, 3 172 2 mode fixed bin; 3 173 3 174 dcl mcode_off fixed bin static init(40); 3 175 dcl fsb_relkey fixed bin static init(20); /* offset 5 */ 3 176 dcl fsb_keylen_sw fixed bin static init(24); /* offset 6 */ 3 177 dcl fsb_key fixed bin static init(28); /* offset 7 */ 3 178 dcl fsb_key_wd fixed bin static init(7); 3 179 dcl write_errno fixed bin static init(21); /* Unable to write record */ 3 180 dcl seek_errno fixed bin init(22); /* Unable to seek key for output - possible duplication */ 3 181 dcl iomode_errno fixed bin static init(41); /* Attempt to perform write on sequential accessed file opened as i-o */ 3 182 3 183 3 184 /* EXTERNAL ENTRY NAMES */ 3 185 3 186 dcl cobol_trans_alphabet$io entry(ptr, ptr, fixed bin, fixed bin); 3 187 dcl cobol_make_tagref entry(fixed bin, fixed bin, ptr); 3 188 dcl cobol_ioop_util$set_icode entry; 3 189 dcl cobol_ioop_util$bypass_reset entry(fixed bin); 3 190 dcl cobol_ioop_util$disp entry(fixed bin); 3 191 dcl cobol_ioop_util$lda entry(fixed bin); 3 192 dcl cobol_ioop_util$set_fsb entry(fixed bin(31), fixed bin); 3 193 dcl cobol_reg_manager$after_op entry(fixed bin); 3 194 dcl cobol_gen_ioerror$finish_up entry(ptr, ptr); 3 195 dcl cobol_gen_ioerror entry(ptr, ptr); 3 196 dcl cobol_call_op entry(fixed bin, fixed bin); 3 197 dcl cobol_alloc$stack entry(fixed bin,fixed bin,fixed bin); 3 198 dcl cobol_read_ft entry(fixed bin,ptr); 3 199 dcl cobol_read_rand entry(fixed bin,char(5),ptr); 3 200 dcl cobol_define_tag entry(fixed bin); 3 201 3 202 /* sub-generators */ 3 203 dcl cobol_move_gen entry(ptr); 3 204 dcl cobol_set_fsbptr entry(ptr); 3 205 dcl cobol_get_size entry(ptr,fixed bin,fixed bin); 3 206 dcl cobol_linage entry(ptr,ptr,fixed bin,fixed bin,ptr); 3 207 dcl cobol_io_util$file_desc entry(fixed bin(24)); 3 208 dcl cobol_io_util$t9dec_to_bin entry(bit(3) aligned,fixed bin,ptr); 3 209 dcl cobol_io_util$fixed_add entry(bit(3) aligned,fixed bin,fixed bin,bit(3) aligned,fixed bin); 3 210 dcl cobol_io_util$bin_to_dec entry(bit(3) aligned,fixed bin,fixed bin,bit(3) aligned,fixed bin,fixed bin); 3 211 dcl cobol_io_util$move_direct entry(bit(3) aligned,fixed bin,fixed bin,fixed bin,bit(18) aligned); 3 212 dcl cobol_io_util$bypass_mode_error entry(fixed bin,bit(2) aligned); 3 213 dcl cobol_set_pr entry(ptr, ptr); 3 214 3 215 /* BUILTIN FUNCTIONS */ 3 216 3 217 dcl (substr,mod,binary,fixed,addr,addrel,rel,length, 3 218 string,unspec,null,index) builtin; 3 219 3 220 3 221 3 222 4 1 4 2 /* BEGIN INCLUDE FILE ... cobol_file_table.incl.pl1 */ 4 3 /* <<< INCLUDE FILE FOR FILE TABLE IN COMMON >>> */ 4 4 4 5 /* Modified on 09/30/80 by FCH, [4.4-1], density is 6250 is supported */ 4 6 /* Modified on 12/05/78 by RAL, [3.0-3], added dupl_alt from dummy102 */ 4 7 /* Modified on 11/21/78 by RAL, [3.0-2], added space for abs_record_offset from filler */ 4 8 /* Modified on 10/26/78 by RAL, [3.0-1], added space for file_desc_1 table offset from filler */ 4 9 /* <<< LAST MODIFIED ON 06-02-77 by GM >>> */ 4 10 /* <<< LAST MODIFIED ON 05-31-77 by GM >>> */ 4 11 /* <<< LAST MODIFIED ON 06-30-76 by GM >>> */ 4 12 /* <<< LAST MODIFIED ON 06-07-76 by GM >>> */ 4 13 /* <<< LAST MODIFIED ON 11-29-74 by orn >>> */ 4 14 4 15 /* 4 16*A file table is created in variable common for each file selected in the 4 17*environment division. The fields of a given file table provide information 4 18*about the specific file for which the file table is generated. The 4 19*addresses which may be contained in the various "info" fields of the file 4 20*table are addresses in variable common. 4 21**/ 4 22 4 23 /* THE FILE TABLE STRUCTURE */ 4 24 4 25 dcl 1 file_table based (ft_ptr), 4 26 2 next char (5), 4 27 2 ifn char (16), 4 28 2 attach_options_info char(5), /*06/02/77*/ 4 29 2 replacement_info char(5), /*06/02/77*/ 4 30 2 file_id_info char(5), /*05/31/77*/ 4 31 2 retention_info char(5), /*05/31/77*/ 4 32 2 filler0 char (3) , /* [3.0-1] */ 4 33 2 file_desc_1_offset fixed bin (24), /* [3.0-1] */ 4 34 2 abs_record_offset fixed bin (24), /* [3.-02] */ 4 35 2 filler char(5), /* this area is available.*/ 4 36 2 padding_char char (1), 4 37 2 banner_char char (1), 4 38 2 file_status_info char (5), 4 39 2 extra_status_info char (5), 4 40 2 cat_id_info char (5), 4 41 2 r_key_info char (5), 4 42 2 alt_key_info char (5), 4 43 2 rec_do_info char (5), 4 44 2 label_info char (5), 4 45 2 data_info char (5), 4 46 2 report_info char (5), 4 47 2 linage_info char (5), 4 48 2 optional bit (1), /*06/07/76*/ 4 49 2 external bit (1), 4 50 2 file_status bit (1), 4 51 2 extra_status bit (1), 4 52 2 sysin bit (1), 4 53 2 sysout bit (1), 4 54 2 move_mode bit (1), 4 55 2 locate_mode bit (1), 4 56 2 fixed_recs bit (1), 4 57 2 variable_recs bit (1), 4 58 2 spanned_recs bit (1), /*06/07/76*/ 4 59 2 interchange bit (1), /*06/07/76*/ 4 60 2 relative_key bit (1), 4 61 2 record_key bit (1), 4 62 2 even_parity bit (1), 4 63 2 odd_parity bit (1), 4 64 2 padding bit (1), 4 65 2 banner bit (1), 4 66 2 random bit (1), 4 67 2 no_file_lockout bit (1), 4 68 2 no_write_check bit (1), 4 69 2 no_resident_index bit (1), 4 70 2 same_file bit (1), 4 71 2 sort_file bit (1), 4 72 2 rec_do bit (1), 4 73 2 linage bit (1), 4 74 2 code_set_clause bit (1), 4 75 /* history */ 4 76 2 close bit (1), 4 77 2 delete bit (1), 4 78 2 open_in bit (1), 4 79 2 open_out bit (1), 4 80 2 open_io bit (1), 4 81 2 open_ext bit (1), 4 82 2 read bit (1), 4 83 2 release bit (1), 4 84 2 return_bit bit (1), 4 85 2 rewrite bit (1), 4 86 2 sort bit (1), 4 87 2 start bit (1), 4 88 2 use_error bit (1), 4 89 2 write bit (1), 4 90 2 read_next bit (1), 4 91 2 read_key bit (1), 4 92 2 accept bit (1), 4 93 2 display bit (1), 4 94 2 unequal_recs bit (1), 4 95 2 dummy_sysin bit (1), 4 96 2 dummy_sysout bit (1), 4 97 2 file_no fixed bin, 4 98 2 uca_offset fixed bin(24), 4 99 2 cra_seg fixed bin, 4 100 2 cra_offset fixed bin(24), 4 101 2 max_cra_size fixed bin(24), 4 102 2 catalogued fixed bin, 4 103 2 organization fixed bin, 4 104 2 org_qual fixed bin, 4 105 2 access fixed bin, 4 106 2 buffers fixed bin, 4 107 2 device fixed bin, 4 108 2 record_prefix fixed bin, /*06/07/76*/ 4 109 2 alternate_keys fixed bin, 4 110 2 record_format fixed bin, 4 111 2 label_format fixed bin, 4 112 2 key_location fixed bin, 4 113 2 key_size fixed bin, 4 114 2 temporary fixed bin, 4 115 2 address_format fixed bin, 4 116 2 same_area_clause fixed bin, 4 117 2 same_rec_clause fixed bin, 4 118 2 same_sort_clause fixed bin, 4 119 2 mult_clause_no fixed bin, 4 120 2 mult_position_no fixed bin, 4 121 2 block_desc fixed bin, 4 122 2 block_min fixed bin(24), 4 123 2 block_max fixed bin(24), 4 124 2 rec_min fixed bin(24), 4 125 2 rec_max fixed bin(24), 4 126 2 label_count fixed bin, 4 127 2 ifn_size fixed bin, 4 128 2 data_count fixed bin, 4 129 2 report_count fixed bin, 4 130 2 code_set fixed bin, 4 131 2 error_exit fixed bin, 4 132 2 prefix_size fixed bin, 4 133 2 blocked bit (1), 4 134 2 variable bit (1), 4 135 2 unbannered bit (1), 4 136 2 prefix_clause bit (1), 4 137 2 symbolic bit (1), 4 138 2 address_format_bit bit (1), 4 139 2 bsn bit(1), /*06/07/76*/ 4 140 2 process_area bit(1), /*06/07/76*/ 4 141 2 dupl_alt bit (1), /* [3.0-3] */ 4 142 2 dummy102 bit (23), 4 143 2 name_size fixed bin, 4 144 2 name char(32), 4 145 2 id char(32), 4 146 2 temp bit(1) , 4 147 2 perm bit(1) , 4 148 2 attach bit(1) , 4 149 2 detach bit(1) , 4 150 2 fsb , /* file state block */ 4 151 3 seg fixed bin(24), /* internal addr */ 4 152 3 off fixed bin(24), 4 153 2 tape, 4 154 3 density bit(1) , /* 0-hi 1-lo */ 4 155 3 retain bit(1), /* 0 not retained across attachment, 1 retained */ 4 156 3 force bit(1), /* 0 check retention date, 1 no check */ 4 157 3 protect bit(1) , /* 0-no 1-yes */ 4 158 3 den_6250 bit(1), /* 0-no 1-yes */ /*[4.4-1]*/ 4 159 2 cat_nm char(200), 4 160 2 ao_len fixed bin(24), /* attach options */ 4 161 2 ao_string char(256), 4 162 2 output_mode fixed bin, /* 0 not specified 4 163* 1 generation 4 164* 2 modification 4 165* 3 replacement literal 4 166* 4 replacement dataname */ 4 167 2 om_len fixed bin, /* length of output mode */ 4 168 2 om_string char(17), 4 169 2 tape_device fixed bin, /* 0 not specified 4 170* 1 integer 4 171* 2 dataname */ 4 172 2 tape_device_num fixed bin, 4 173 2 tape_device_key char(5), 4 174 2 add_cat_key char(5); 4 175 4 176 4 177 /* END INCLUDE FILE ... cobol_file_table.incl.pl1 */ 4 178 3 223 5 1 5 2 /* BEGIN INCLUDE FILE ... cobol_file_key.incl.pl1 */ 5 3 /* Last modified on 03/30/78 by FCH */ 5 4 5 5 /* 5 6*A file key record is created in variable common for any one of several 5 7*data items which may be associated with a file name. The key_type field in 5 8*the file key record identifies the type of item for which the record is 5 9*created. The name in a file key record is resolved by the replacement 5 10*phase, and a section of the type 9 entry in the name table for the 5 11*specified data item is stored in the file key record. The stored 5 12*description is subsequently used by the generator phase. 5 13**/ 5 14 5 15 /* THE FILE KEY RECORD STRUCTURE */ 5 16 5 17 dcl 1 file_key based (fkey_ptr), 5 18 2 next char(5), 5 19 2 next_alt char(5), 5 20 2 qual char(5), 5 21 2 info, 5 22 3 duplicates bit(1), 5 23 3 filler bit(7), 5 24 2 file_no fixed bin, 5 25 2 key_type fixed bin, 5 26 2 line fixed bin, 5 27 2 column fixed bin, 5 28 2 temp_seg fixed bin, 5 29 2 temp_offset fixed bin(24), 5 30 2 desc char(40), 5 31 2 name_size fixed bin, 5 32 2 name char(0 refer(file_key.name_size)); 5 33 5 34 /* END INCLUDE FILE ... cobol_file_key.incl.pl1 */ 5 35 3 224 6 1 6 2 /* BEGIN INCLUDE FILE ... cobol_linage_rec.incl.pl1 */ 6 3 /* <<< LAST MODIFIED ON 7-29-74 by FCH >>> */ 6 4 6 5 /* ***STRUCTURE SIZE INFORMATION*** */ 6 6 /* THE SIZE OF THIS STRUCTURE IN BYTES, (EXCLUDING VARIABLE 6 7* LENGTH ENTITIES), FOR EACH HARDWARE IMPLEMENTATION IS: 6 8* 6 9* HARDWARE | SIZE (BYTES) 6 10* --------------------------------- 6 11* 645/6180 | 64 6 12* --------------------------------- 6 13**/ 6 14 6 15 /* 6 16*A linage record is entered into variable common for each linage clause 6 17*specified in the data division. 6 18**/ 6 19 6 20 /* THE LINAGE RECORD STRUCTURE */ 6 21 6 22 dcl 1 linage_rec based (linage_ptr), 6 23 2 body fixed bin (15), 6 24 2 footing fixed bin (15), 6 25 2 top fixed bin (15), 6 26 2 bottom fixed bin (15), 6 27 2 body_int fixed bin (31), 6 28 2 footing_int fixed bin (31), 6 29 2 top_int fixed bin (31), 6 30 2 bottom_int fixed bin (31), 6 31 2 body_name char (5), 6 32 2 footing_name char (5), 6 33 2 top_name char (5), 6 34 2 bottom_name char (5), 6 35 2 name_count fixed bin (15), 6 36 2 gen_seg fixed bin (15), 6 37 2 gen_offset fixed bin (31), 6 38 2 name_desc(0 refer(linage_rec.name_count)) char(40); 6 39 6 40 6 41 6 42 /* END INCLUDE FILE ... cobol_linage_rec.incl.pl1 */ 6 43 3 225 7 1 7 2 /* BEGIN INCLUDE FILE ... cobol_type1.incl.pl1 */ 7 3 /* Last modified on 11/19/76 by ORN */ 7 4 7 5 /* 7 6*A reserved word token is created in the minpral files for each occurrence 7 7*of a reserved word in the source program. The value of the key field 7 8*indicates the specific reserved word which a type 1 token represents. 7 9**/ 7 10 7 11 dcl rw_ptr ptr; 7 12 7 13 /* BEGIN DECLARATION OF TYPE1 (RESERVED WORD) TOKEN */ 7 14 dcl 1 reserved_word based (rw_ptr), 8 1 8 2 /* begin include file ... cobol_TYPE1.incl.pl1 */ 8 3 /* Last modified on 11/17/76 by ORN */ 8 4 /* Last modified on 12/28/76 by FCH */ 8 5 /* Last modified on 12/16/80 by FCH */ 8 6 8 7 /* header */ 8 8 2 size fixed bin, 8 9 2 line fixed bin, 8 10 2 column fixed bin, 8 11 2 type fixed bin, 8 12 /* body */ 8 13 2 key fixed bin, 8 14 /* procedure division class bits */ 8 15 2 verb bit (1), 8 16 2 arith_op bit (1), 8 17 2 figcon bit (1), 8 18 2 terminator bit (1), 8 19 2 end_dec bit (1), 8 20 2 rel_op bit (1), 8 21 2 imper_verb bit (1), 8 22 2 end_cobol bit (1), 8 23 /* data division class bits */ 8 24 2 section_header bit (1), 8 25 2 fs_ind bit (1), 8 26 2 fd_clause bit (1), 8 27 2 dd_clause bit (1), 8 28 2 cd_input bit (1), 8 29 2 cd_output bit (1), 8 30 2 cset_name bit (1), 8 31 2 ss_division bit (1), 8 32 2 repl_jump_ind bit (4), 8 33 2 ided_recovery bit (1), 8 34 2 report_writer bit (5), 8 35 2 ss_desc_entry bit (1), 8 36 2 jump_index fixed bin, 8 37 2 length fixed bin, 8 38 2 name char(0 refer(reserved_word.length)); 8 39 8 40 8 41 8 42 /* end include file ... cobol_TYPE1.incl.pl1 */ 8 43 7 15 7 16 /* END DECLARATION OF TYPE1 (RESERVED WORD) TOKEN */ 7 17 7 18 /* END INCLUDE FILE ... cobol_type1.incl.pl1 */ 7 19 3 226 9 1 9 2 /* BEGIN INCLUDE FILE ... cobol_type9.incl.pl1 */ 9 3 /* Last modified on 11/19/76 by ORN */ 9 4 9 5 /* 9 6*A type 9 data name token is entered into the name table by the data 9 7*division syntax phase for each data name described in the data division. 9 8*The replacement phase subsequently replaces type 8 user word references 9 9*to data names in the procedure division minpral file with the corresponding 9 10*type 9 tokens from the name table. 9 11**/ 9 12 9 13 /* dcl dn_ptr ptr; */ 9 14 9 15 /* BEGIN DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 9 16 dcl 1 data_name based (dn_ptr), 10 1 10 2 /* begin include file ... cobol_TYPE9.incl.pl1 */ 10 3 /* Last modified on 06/19/77 by ORN */ 10 4 /* Last modified on 12/28/76 by FCH */ 10 5 10 6 /* header */ 10 7 2 size fixed bin, 10 8 2 line fixed bin, 10 9 2 column fixed bin, 10 10 2 type fixed bin, 10 11 /* body */ 10 12 2 string_ptr ptr, 10 13 2 prev_rec ptr, 10 14 2 searched bit (1), 10 15 2 duplicate bit (1), 10 16 2 saved bit (1), 10 17 2 debug_ind bit (1), 10 18 2 filler2 bit (3), 10 19 2 used_as_sub bit (1), 10 20 2 def_line fixed bin, 10 21 2 level fixed bin, 10 22 2 linkage fixed bin, 10 23 2 file_num fixed bin, 10 24 2 size_rtn fixed bin, 10 25 2 item_length fixed bin(24), 10 26 2 places_left fixed bin, 10 27 2 places_right fixed bin, 10 28 /* description */ 10 29 2 file_section bit (1), 10 30 2 working_storage bit (1), 10 31 2 constant_section bit (1), 10 32 2 linkage_section bit (1), 10 33 2 communication_section bit (1), 10 34 2 report_section bit (1), 10 35 2 level_77 bit (1), 10 36 2 level_01 bit (1), 10 37 2 non_elementary bit (1), 10 38 2 elementary bit (1), 10 39 2 filler_item bit (1), 10 40 2 s_of_rdf bit (1), 10 41 2 o_of_rdf bit (1), 10 42 2 bin_18 bit (1), 10 43 2 bin_36 bit (1), 10 44 2 pic_has_l bit (1), 10 45 2 pic_is_do bit (1), 10 46 2 numeric bit (1), 10 47 2 numeric_edited bit (1), 10 48 2 alphanum bit (1), 10 49 2 alphanum_edited bit (1), 10 50 2 alphabetic bit (1), 10 51 2 alphabetic_edited bit (1), 10 52 2 pic_has_p bit (1), 10 53 2 pic_has_ast bit (1), 10 54 2 item_signed bit(1), 10 55 2 sign_separate bit (1), 10 56 2 display bit (1), 10 57 2 comp bit (1), 10 58 2 ascii_packed_dec_h bit (1), /* as of 8/16/76 this field used for comp8. */ 10 59 2 ascii_packed_dec bit (1), 10 60 2 ebcdic_packed_dec bit (1), 10 61 2 bin_16 bit (1), 10 62 2 bin_32 bit (1), 10 63 2 usage_index bit (1), 10 64 2 just_right bit (1), 10 65 2 compare_argument bit (1), 10 66 2 sync bit (1), 10 67 2 temporary bit (1), 10 68 2 bwz bit (1), 10 69 2 variable_length bit (1), 10 70 2 subscripted bit (1), 10 71 2 occurs_do bit (1), 10 72 2 key_a bit (1), 10 73 2 key_d bit (1), 10 74 2 indexed_by bit (1), 10 75 2 value_numeric bit (1), 10 76 2 value_non_numeric bit (1), 10 77 2 value_signed bit (1), 10 78 2 sign_type bit (3), 10 79 2 pic_integer bit (1), 10 80 2 ast_when_zero bit (1), 10 81 2 label_record bit (1), 10 82 2 sign_clause_occurred bit (1), 10 83 2 okey_dn bit (1), 10 84 2 subject_of_keyis bit (1), 10 85 2 exp_redefining bit (1), 10 86 2 sync_in_rec bit (1), 10 87 2 rounded bit (1), 10 88 2 ad_bit bit (1), 10 89 2 debug_all bit (1), 10 90 2 overlap bit (1), 10 91 2 sum_counter bit (1), 10 92 2 exp_occurs bit (1), 10 93 2 linage_counter bit (1), 10 94 2 rnm_01 bit (1), 10 95 2 aligned bit (1), 10 96 2 not_user_writable bit (1), 10 97 2 database_key bit (1), 10 98 2 database_data_item bit (1), 10 99 2 seg_num fixed bin, 10 100 2 offset fixed bin(24), 10 101 2 initial_ptr fixed bin, 10 102 2 edit_ptr fixed bin, 10 103 2 occurs_ptr fixed bin, 10 104 2 do_rec char(5), 10 105 2 bitt bit (1), 10 106 2 byte bit (1), 10 107 2 half_word bit (1), 10 108 2 word bit (1), 10 109 2 double_word bit (1), 10 110 2 half_byte bit (1), 10 111 2 filler5 bit (1), 10 112 2 bit_offset bit (4), 10 113 2 son_cnt bit (16), 10 114 2 max_red_size fixed bin(24), 10 115 2 name_size fixed bin, 10 116 2 name char(0 refer(data_name.name_size)); 10 117 10 118 10 119 10 120 /* end include file ... cobol_TYPE9.incl.pl1 */ 10 121 9 17 9 18 /* END DECLARATION OF TYPE9 (DATA NAME) TOKEN */ 9 19 9 20 /* END INCLUDE FILE ... cobol_type9.incl.pl1 */ 9 21 3 227 11 1 11 2 /* BEGIN INCLUDE FILE ... cobol_type19.incl.pl1 */ 11 3 /* last modified on 11/19/76 by ORN */ 11 4 11 5 /* 11 6*A type 19 end of statement token is created in the procedure division 11 7*minpral file at the end of each minpral statement generated by the 11 8*procedure division syntax phase. A minpral statement may be a complete or 11 9*partial source language statement. A type 19 token contains information 11 10*describing the statement which it delimits. 11 11**/ 11 12 11 13 dcl eos_ptr ptr; 11 14 11 15 /* BEGIN DECLARATION OF TYPE19 (END STATEMENT) TOKEN */ 11 16 dcl 1 end_stmt based (eos_ptr), 12 1 12 2 /* begin include file ... cobol_TYPE19.incl.pl1 */ 12 3 /* Last modified on 11/17/76 by ORN */ 12 4 12 5 /* header */ 12 6 2 size fixed bin, 12 7 2 line fixed bin, 12 8 2 column fixed bin, 12 9 2 type fixed bin, 12 10 /* body */ 12 11 2 verb fixed bin, 12 12 2 e fixed bin, 12 13 2 h fixed bin, 12 14 2 i fixed bin, 12 15 2 j fixed bin, 12 16 2 a bit (3), 12 17 2 b bit (1), 12 18 2 c bit (1), 12 19 2 d bit (2), 12 20 2 f bit (2), 12 21 2 g bit (2), 12 22 2 k bit (5), 12 23 2 always_an bit (1); 12 24 12 25 /* end include file ... cobol_TYPE19.incl.pl1 */ 12 26 11 17 11 18 /* END DECLARATION OF TYPE19 (END STATEMENT) TOKEN */ 11 19 11 20 /* 11 21*FIELD CONTENTS 11 22* 11 23*size The total size in bytes of this end of statement token. 11 24*line 0 11 25*column 0 11 26*type 19 11 27*verb A value indicating the verb in this statement 11 28* 1 = accept 11 29* 2 = add 11 30* 3 = on size error 11 31* 4 = alter 11 32* 5 = call 11 33* 7 = cancel 11 34* 8 = close 11 35* 9 = divide 11 36* 10 = multiply 11 37* 11 = subtract 11 38* 12 = exit 11 39* 14 = go 11 40* 15 = merge 11 41* 16 = initiate 11 42* 17 = inspect 11 43* 18 = move 11 44* 19 = open 11 45* 20 = perform 11 46* 21 = read 11 47* 23 = receive 11 48* 24 = release 11 49* 25 = return 11 50* 26 = search 11 51* 27 = rewrite 11 52* 29 = seek 11 53* 30 = send 11 54* 31 = set 11 55* 33 = stop 11 56* 34 = string 11 57* 35 = suspend 11 58* 36 = terminate 11 59* 37 = unstring 11 60* 38 = write 11 61* 39 = use 11 62* 40 = compute 11 63* 41 = disable 11 64* 42 = display 11 65* 43 = enable 11 66* 45 = generate 11 67* 46 = hold 11 68* 48 = process 11 69* 49 = sort 11 70* 52 = procedure 11 71* 53 = declaratives 11 72* 54 = section name 11 73* 55 = paragraph name 11 74* 98 = end 11 75*e,h,i,j The significance of these fields differs with each 11 76* statement. These fields are normally used as counters. 11 77*a,b,c,d,f,g,k The significance of these fields differs with each 11 78* statement. These fields are normally used as indicators. 11 79**/ 11 80 11 81 /* END INCLUDE FILE ... cobol_type19.incl.pl1 */ 11 82 3 228 13 1 13 2 /* BEGIN INCLUDE FILE ... cobol_.incl.pl1 */ 13 3 /* last modified Feb 4, 1977 by ORN */ 13 4 13 5 /* This file defines all external data used in the generator phase of Multics Cobol */ 13 6 13 7 /* POINTERS */ 13 8 dcl cobol_$text_base_ptr ptr ext; 13 9 dcl text_base_ptr ptr defined (cobol_$text_base_ptr); 13 10 dcl cobol_$con_end_ptr ptr ext; 13 11 dcl con_end_ptr ptr defined (cobol_$con_end_ptr); 13 12 dcl cobol_$def_base_ptr ptr ext; 13 13 dcl def_base_ptr ptr defined (cobol_$def_base_ptr); 13 14 dcl cobol_$link_base_ptr ptr ext; 13 15 dcl link_base_ptr ptr defined (cobol_$link_base_ptr); 13 16 dcl cobol_$sym_base_ptr ptr ext; 13 17 dcl sym_base_ptr ptr defined (cobol_$sym_base_ptr); 13 18 dcl cobol_$reloc_text_base_ptr ptr ext; 13 19 dcl reloc_text_base_ptr ptr defined (cobol_$reloc_text_base_ptr); 13 20 dcl cobol_$reloc_def_base_ptr ptr ext; 13 21 dcl reloc_def_base_ptr ptr defined (cobol_$reloc_def_base_ptr); 13 22 dcl cobol_$reloc_link_base_ptr ptr ext; 13 23 dcl reloc_link_base_ptr ptr defined (cobol_$reloc_link_base_ptr); 13 24 dcl cobol_$reloc_sym_base_ptr ptr ext; 13 25 dcl reloc_sym_base_ptr ptr defined (cobol_$reloc_sym_base_ptr); 13 26 dcl cobol_$reloc_work_base_ptr ptr ext; 13 27 dcl reloc_work_base_ptr ptr defined (cobol_$reloc_work_base_ptr); 13 28 dcl cobol_$pd_map_ptr ptr ext; 13 29 dcl pd_map_ptr ptr defined (cobol_$pd_map_ptr); 13 30 dcl cobol_$fixup_ptr ptr ext; 13 31 dcl fixup_ptr ptr defined (cobol_$fixup_ptr); 13 32 dcl cobol_$initval_base_ptr ptr ext; 13 33 dcl initval_base_ptr ptr defined (cobol_$initval_base_ptr); 13 34 dcl cobol_$initval_file_ptr ptr ext; 13 35 dcl initval_file_ptr ptr defined (cobol_$initval_file_ptr); 13 36 dcl cobol_$perform_list_ptr ptr ext; 13 37 dcl perform_list_ptr ptr defined (cobol_$perform_list_ptr); 13 38 dcl cobol_$alter_list_ptr ptr ext; 13 39 dcl alter_list_ptr ptr defined (cobol_$alter_list_ptr); 13 40 dcl cobol_$seg_init_list_ptr ptr ext; 13 41 dcl seg_init_list_ptr ptr defined (cobol_$seg_init_list_ptr); 13 42 dcl cobol_$temp_token_area_ptr ptr ext; 13 43 dcl temp_token_area_ptr ptr defined (cobol_$temp_token_area_ptr); 13 44 dcl cobol_$temp_token_ptr ptr ext; 13 45 dcl temp_token_ptr ptr defined (cobol_$temp_token_ptr); 13 46 dcl cobol_$token_block1_ptr ptr ext; 13 47 dcl token_block1_ptr ptr defined (cobol_$token_block1_ptr); 13 48 dcl cobol_$token_block2_ptr ptr ext; 13 49 dcl token_block2_ptr ptr defined (cobol_$token_block2_ptr); 13 50 dcl cobol_$minpral5_ptr ptr ext; 13 51 dcl minpral5_ptr ptr defined (cobol_$minpral5_ptr); 13 52 dcl cobol_$tag_table_ptr ptr ext; 13 53 dcl tag_table_ptr ptr defined (cobol_$tag_table_ptr); 13 54 dcl cobol_$map_data_ptr ptr ext; 13 55 dcl map_data_ptr ptr defined (cobol_$map_data_ptr); 13 56 dcl cobol_$ptr_status_ptr ptr ext; 13 57 dcl ptr_status_ptr ptr defined (cobol_$ptr_status_ptr); 13 58 dcl cobol_$reg_status_ptr ptr ext; 13 59 dcl reg_status_ptr ptr defined (cobol_$reg_status_ptr); 13 60 dcl cobol_$misc_base_ptr ptr ext; 13 61 dcl misc_base_ptr ptr defined (cobol_$misc_base_ptr); 13 62 dcl cobol_$misc_end_ptr ptr ext; 13 63 dcl misc_end_ptr ptr defined (cobol_$misc_end_ptr); 13 64 dcl cobol_$list_ptr ptr ext; 13 65 dcl list_ptr ptr defined (cobol_$list_ptr); 13 66 dcl cobol_$allo1_ptr ptr ext; 13 67 dcl allo1_ptr ptr defined (cobol_$allo1_ptr); 13 68 dcl cobol_$eln_ptr ptr ext; 13 69 dcl eln_ptr ptr defined (cobol_$eln_ptr); 13 70 dcl cobol_$diag_ptr ptr ext; 13 71 dcl diag_ptr ptr defined (cobol_$diag_ptr); 13 72 dcl cobol_$xref_token_ptr ptr ext; 13 73 dcl xref_token_ptr ptr defined (cobol_$xref_token_ptr); 13 74 dcl cobol_$xref_chain_ptr ptr ext; 13 75 dcl xref_chain_ptr ptr defined (cobol_$xref_chain_ptr); 13 76 dcl cobol_$statement_info_ptr ptr ext; 13 77 dcl statement_info_ptr ptr defined (cobol_$statement_info_ptr); 13 78 dcl cobol_$reswd_ptr ptr ext; 13 79 dcl reswd_ptr ptr defined (cobol_$reswd_ptr); 13 80 dcl cobol_$op_con_ptr ptr ext; 13 81 dcl op_con_ptr ptr defined (cobol_$op_con_ptr); 13 82 dcl cobol_$ntbuf_ptr ptr ext; 13 83 dcl ntbuf_ptr ptr defined (cobol_$ntbuf_ptr); 13 84 dcl cobol_$main_pcs_ptr ptr ext; 13 85 dcl main_pcs_ptr ptr defined (cobol_$main_pcs_ptr); 13 86 dcl cobol_$include_info_ptr ptr ext; 13 87 dcl include_info_ptr ptr defined (cobol_$include_info_ptr); 13 88 13 89 /* FIXED BIN */ 13 90 dcl cobol_$text_wd_off fixed bin ext; 13 91 dcl text_wd_off fixed bin defined (cobol_$text_wd_off); 13 92 dcl cobol_$con_wd_off fixed bin ext; 13 93 dcl con_wd_off fixed bin defined (cobol_$con_wd_off); 13 94 dcl cobol_$def_wd_off fixed bin ext; 13 95 dcl def_wd_off fixed bin defined (cobol_$def_wd_off); 13 96 dcl cobol_$def_max fixed bin ext; 13 97 dcl def_max fixed bin defined (cobol_$def_max); 13 98 dcl cobol_$link_wd_off fixed bin ext; 13 99 dcl link_wd_off fixed bin defined (cobol_$link_wd_off); 13 100 dcl cobol_$link_max fixed bin ext; 13 101 dcl link_max fixed bin defined (cobol_$link_max); 13 102 dcl cobol_$sym_wd_off fixed bin ext; 13 103 dcl sym_wd_off fixed bin defined (cobol_$sym_wd_off); 13 104 dcl cobol_$sym_max fixed bin ext; 13 105 dcl sym_max fixed bin defined (cobol_$sym_max); 13 106 dcl cobol_$reloc_text_max fixed bin(24) ext; 13 107 dcl reloc_text_max fixed bin(24) defined (cobol_$reloc_text_max); 13 108 dcl cobol_$reloc_def_max fixed bin(24) ext; 13 109 dcl reloc_def_max fixed bin(24) defined (cobol_$reloc_def_max); 13 110 dcl cobol_$reloc_link_max fixed bin(24) ext; 13 111 dcl reloc_link_max fixed bin(24) defined (cobol_$reloc_link_max); 13 112 dcl cobol_$reloc_sym_max fixed bin(24) ext; 13 113 dcl reloc_sym_max fixed bin(24) defined (cobol_$reloc_sym_max); 13 114 dcl cobol_$reloc_work_max fixed bin(24) ext; 13 115 dcl reloc_work_max fixed bin(24) defined (cobol_$reloc_work_max); 13 116 dcl cobol_$pd_map_index fixed bin ext; 13 117 dcl pd_map_index fixed bin defined (cobol_$pd_map_index); 13 118 dcl cobol_$cobol_data_wd_off fixed bin ext; 13 119 dcl cobol_data_wd_off fixed bin defined (cobol_$cobol_data_wd_off); 13 120 dcl cobol_$stack_off fixed bin ext; 13 121 dcl stack_off fixed bin defined (cobol_$stack_off); 13 122 dcl cobol_$max_stack_off fixed bin ext; 13 123 dcl max_stack_off fixed bin defined (cobol_$max_stack_off); 13 124 dcl cobol_$init_stack_off fixed bin ext; 13 125 dcl init_stack_off fixed bin defined (cobol_$init_stack_off); 13 126 dcl cobol_$pd_map_sw fixed bin ext; 13 127 dcl pd_map_sw fixed bin defined (cobol_$pd_map_sw); 13 128 dcl cobol_$next_tag fixed bin ext; 13 129 dcl next_tag fixed bin defined (cobol_$next_tag); 13 130 dcl cobol_$data_init_flag fixed bin ext; 13 131 dcl data_init_flag fixed bin defined (cobol_$data_init_flag); 13 132 dcl cobol_$seg_init_flag fixed bin ext; 13 133 dcl seg_init_flag fixed bin defined (cobol_$seg_init_flag); 13 134 dcl cobol_$alter_flag fixed bin ext; 13 135 dcl alter_flag fixed bin defined (cobol_$alter_flag); 13 136 dcl cobol_$sect_eop_flag fixed bin ext; 13 137 dcl sect_eop_flag fixed bin defined (cobol_$sect_eop_flag); 13 138 dcl cobol_$para_eop_flag fixed bin ext; 13 139 dcl para_eop_flag fixed bin defined (cobol_$para_eop_flag); 13 140 dcl cobol_$priority_no fixed bin ext; 13 141 dcl priority_no fixed bin defined (cobol_$priority_no); 13 142 dcl cobol_$compile_count fixed bin ext; 13 143 dcl compile_count fixed bin defined (cobol_$compile_count); 13 144 dcl cobol_$ptr_assumption_ind fixed bin ext; 13 145 dcl ptr_assumption_ind fixed bin defined (cobol_$ptr_assumption_ind); 13 146 dcl cobol_$reg_assumption_ind fixed bin ext; 13 147 dcl reg_assumption_ind fixed bin defined (cobol_$reg_assumption_ind); 13 148 dcl cobol_$perform_para_index fixed bin ext; 13 149 dcl perform_para_index fixed bin defined (cobol_$perform_para_index); 13 150 dcl cobol_$perform_sect_index fixed bin ext; 13 151 dcl perform_sect_index fixed bin defined (cobol_$perform_sect_index); 13 152 dcl cobol_$alter_index fixed bin ext; 13 153 dcl alter_index fixed bin defined (cobol_$alter_index); 13 154 dcl cobol_$list_off fixed bin ext; 13 155 dcl list_off fixed bin defined (cobol_$list_off); 13 156 dcl cobol_$constant_offset fixed bin ext; 13 157 dcl constant_offset fixed bin defined (cobol_$constant_offset); 13 158 dcl cobol_$misc_max fixed bin ext; 13 159 dcl misc_max fixed bin defined (cobol_$misc_max); 13 160 dcl cobol_$pd_map_max fixed bin ext; 13 161 dcl pd_map_max fixed bin defined (cobol_$pd_map_max); 13 162 dcl cobol_$map_data_max fixed bin ext; 13 163 dcl map_data_max fixed bin defined (cobol_$map_data_max); 13 164 dcl cobol_$fixup_max fixed bin ext; 13 165 dcl fixup_max fixed bin defined (cobol_$fixup_max); 13 166 dcl cobol_$tag_table_max fixed bin ext; 13 167 dcl tag_table_max fixed bin defined (cobol_$tag_table_max); 13 168 dcl cobol_$temp_token_max fixed bin ext; 13 169 dcl temp_token_max fixed bin defined (cobol_$temp_token_max); 13 170 dcl cobol_$allo1_max fixed bin ext; 13 171 dcl allo1_max fixed bin defined (cobol_$allo1_max); 13 172 dcl cobol_$eln_max fixed bin ext; 13 173 dcl eln_max fixed bin defined (cobol_$eln_max); 13 174 dcl cobol_$debug_enable fixed bin ext; 13 175 dcl debug_enable fixed bin defined (cobol_$debug_enable); 13 176 dcl cobol_$non_source_offset fixed bin ext; 13 177 dcl non_source_offset fixed bin defined (cobol_$non_source_offset); 13 178 dcl cobol_$initval_flag fixed bin ext; 13 179 dcl initval_flag fixed bin defined (cobol_$initval_flag); 13 180 dcl cobol_$date_compiled_sw fixed bin ext; 13 181 dcl date_compiled_sw fixed bin defined (cobol_$date_compiled_sw); 13 182 dcl cobol_$include_cnt fixed bin ext; 13 183 dcl include_cnt fixed bin defined (cobol_$include_cnt); 13 184 dcl cobol_$fs_charcnt fixed bin ext; 13 185 dcl fs_charcnt fixed bin defined (cobol_$fs_charcnt); 13 186 dcl cobol_$ws_charcnt fixed bin ext; 13 187 dcl ws_charcnt fixed bin defined (cobol_$ws_charcnt); 13 188 dcl cobol_$coms_charcnt fixed bin ext; 13 189 dcl coms_charcnt fixed bin defined (cobol_$coms_charcnt); 13 190 dcl cobol_$ls_charcnt fixed bin ext; 13 191 dcl ls_charcnt fixed bin defined (cobol_$ls_charcnt); 13 192 dcl cobol_$cons_charcnt fixed bin ext; 13 193 dcl cons_charcnt fixed bin defined (cobol_$cons_charcnt); 13 194 dcl cobol_$value_cnt fixed bin ext; 13 195 dcl value_cnt fixed bin defined (cobol_$value_cnt); 13 196 dcl cobol_$cd_cnt fixed bin ext; 13 197 dcl cd_cnt fixed bin defined (cobol_$cd_cnt); 13 198 dcl cobol_$fs_wdoff fixed bin ext; 13 199 dcl fs_wdoff fixed bin defined (cobol_$fs_wdoff); 13 200 dcl cobol_$ws_wdoff fixed bin ext; 13 201 dcl ws_wdoff fixed bin defined (cobol_$ws_wdoff); 13 202 dcl cobol_$coms_wdoff fixed bin ext; 13 203 dcl coms_wdoff fixed bin defined (cobol_$coms_wdoff); 13 204 13 205 /* CHARACTER */ 13 206 dcl cobol_$scratch_dir char (168) aligned ext; 13 207 dcl scratch_dir char (168) aligned defined (cobol_$scratch_dir); /* -42- */ 13 208 dcl cobol_$obj_seg_name char (32) aligned ext; 13 209 dcl obj_seg_name char (32) aligned defined (cobol_$obj_seg_name); /* -8- */ 13 210 13 211 /* BIT */ 13 212 dcl cobol_$xref_bypass bit(1) aligned ext; 13 213 dcl xref_bypass bit(1) aligned defined (cobol_$xref_bypass); /* -1- */ 13 214 dcl cobol_$same_sort_merge_proc bit(1) aligned ext; 13 215 dcl same_sort_merge_proc bit(1) aligned defined (cobol_$same_sort_merge_proc); /* -1- */ 13 216 13 217 13 218 /* END INCLUDE FILE ... cobol_incl.pl1*/ 13 219 13 220 3 229 3 230 569 570 571 declare 1 fd_token based, 14 1 14 2 /* begin include file ... cobol_TYPE12.incl.pl1 */ 14 3 /* Last modified on 11/17/76 by ORN */ 14 4 14 5 /* header */ 14 6 2 size fixed bin, 14 7 2 line fixed bin, 14 8 2 column fixed bin, 14 9 2 type fixed bin, 14 10 /* body */ 14 11 2 string_ptr ptr, 14 12 2 prev_rec ptr, 14 13 2 info bit (8), 14 14 2 def_line fixed bin, 14 15 2 file_no fixed bin, 14 16 2 name_size fixed bin, 14 17 2 name char(0 refer(fd_token.name_size)); 14 18 14 19 /* end include file ... cobol_TYPE12.incl.pl1 */ 14 20 572 573 end cobol_write_gen; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0832.1 cobol_write_gen.pl1 >spec>install>MR12.3-1048>cobol_write_gen.pl1 568 1 03/27/82 0431.4 cobol_write_gen_info.incl.pl1 >ldd>include>cobol_write_gen_info.incl.pl1 1-120 2 03/27/82 0439.5 cobol_opr_write.incl.pl1 >ldd>include>cobol_opr_write.incl.pl1 569 3 03/27/82 0439.5 cobol_write_gen_data.incl.pl1 >ldd>include>cobol_write_gen_data.incl.pl1 3-223 4 11/11/82 1712.7 cobol_file_table.incl.pl1 >ldd>include>cobol_file_table.incl.pl1 3-224 5 11/11/82 1712.8 cobol_file_key.incl.pl1 >ldd>include>cobol_file_key.incl.pl1 3-225 6 11/11/82 1712.8 cobol_linage_rec.incl.pl1 >ldd>include>cobol_linage_rec.incl.pl1 3-226 7 03/27/82 0439.8 cobol_type1.incl.pl1 >ldd>include>cobol_type1.incl.pl1 7-15 8 11/11/82 1712.8 cobol_TYPE1.incl.pl1 >ldd>include>cobol_TYPE1.incl.pl1 3-227 9 03/27/82 0439.9 cobol_type9.incl.pl1 >ldd>include>cobol_type9.incl.pl1 9-17 10 11/11/82 1712.7 cobol_TYPE9.incl.pl1 >ldd>include>cobol_TYPE9.incl.pl1 3-228 11 03/27/82 0439.8 cobol_type19.incl.pl1 >ldd>include>cobol_type19.incl.pl1 11-17 12 03/27/82 0439.6 cobol_TYPE19.incl.pl1 >ldd>include>cobol_TYPE19.incl.pl1 3-229 13 11/11/82 1712.7 cobol_.incl.pl1 >ldd>include>cobol_.incl.pl1 572 14 03/27/82 0439.6 cobol_TYPE12.incl.pl1 >ldd>include>cobol_TYPE12.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. a 11 based bit(3) level 2 packed packed unaligned dcl 11-16 set ref 549 553* access 45 based fixed bin(17,0) level 2 dcl 4-25 ref 276 300 354 395 addr builtin function dcl 3-217 ref 88 102 106 107 134 135 147 149 149 204 206 206 223 223 225 243 297 315 318 325 332 334 334 400 404 405 407 407 456 460 461 467 469 469 aloff 000170 automatic fixed bin(17,0) initial dcl 77 set ref 77* 130* 132 alpha_type9 000050 internal static structure level 1 unaligned dcl 3-81 set ref 325 alt_seek_tag 000107 automatic fixed bin(17,0) dcl 33 set ref 99* 439* 442* alt_sw 000146 automatic bit(1) packed unaligned dcl 64 set ref 232* 342 366 383 417 alt_tag 000106 automatic fixed bin(17,0) dcl 33 set ref 98* alternate_keys 51 based fixed bin(17,0) level 2 dcl 4-25 ref 232 arg 4 000112 automatic structure array level 2 unaligned dcl 47 set ref 134 135 arg_ptr 000162 automatic pointer dcl 73 set ref 102* argb based bit(216) array packed unaligned dcl 67 set ref 134* 135* arglist_off 1 000112 automatic fixed bin(17,0) level 2 dcl 47 set ref 132* args 000112 automatic structure level 1 unaligned dcl 47 set ref 102 b 11(03) based bit(1) level 2 packed packed unaligned dcl 11-16 ref 109 236 373 body based fixed bin(15,0) level 2 dcl 6-22 set ref 491 493 493* 501* 524 524* body_int 4 based fixed bin(31,0) level 2 dcl 6-22 set ref 495* 500* 503* 514* 526* bottom 3 based fixed bin(15,0) level 2 dcl 6-22 set ref 530 532 532* bottom_int 7 based fixed bin(31,0) level 2 dcl 6-22 set ref 534* buf_off 000173 automatic fixed bin(17,0) dcl 82 set ref 248* 257* buflen_off 000172 automatic fixed bin(17,0) dcl 81 set ref 136* 192 197* 206 248* c 11(04) based bit(1) level 2 packed packed unaligned dcl 11-16 set ref 141 551* cobol_$next_tag 000370 external static fixed bin(17,0) dcl 13-128 set ref 93 94 95 96 97 98 99 100* 100 111 112 113* 113 117 118* 118 279 280* 280 484 485* 485 cobol_alloc$stack 000332 constant entry external dcl 3-197 ref 130 216 cobol_call_op 000330 constant entry external dcl 3-196 ref 160 261 267 345 376 387 439 cobol_code 000276 internal static fixed bin(17,0) level 2 dcl 3-166 set ref 103* 422 cobol_define_tag 000340 constant entry external dcl 3-200 ref 155 164 284 350 380 414 442 538 cobol_gen_ioerror 000326 constant entry external dcl 3-195 ref 162 270 348 378 390 441 cobol_gen_ioerror$finish_up 000324 constant entry external dcl 3-194 ref 427 cobol_get_size 000346 constant entry external dcl 3-205 ref 197 cobol_io_util$bin_to_dec 000360 constant entry external dcl 3-210 ref 306 cobol_io_util$bypass_mode_error 000364 constant entry external dcl 3-212 ref 282 cobol_io_util$file_desc 000352 constant entry external dcl 3-207 ref 385 436 cobol_io_util$fixed_add 000356 constant entry external dcl 3-209 ref 303 cobol_io_util$move_direct 000362 constant entry external dcl 3-211 ref 192 308 337 359 cobol_io_util$t9dec_to_bin 000354 constant entry external dcl 3-208 ref 206 cobol_ioop_util$bypass_reset 000314 constant entry external dcl 3-189 ref 487 cobol_ioop_util$disp 000316 constant entry external dcl 3-190 ref 257 cobol_ioop_util$set_fsb 000320 constant entry external dcl 3-192 ref 174 495 503 514 517 526 534 cobol_ioop_util$set_icode 000312 constant entry external dcl 3-188 ref 236 373 cobol_linage 000350 constant entry external dcl 3-206 ref 248 cobol_move_gen 000342 constant entry external dcl 3-203 ref 149 334 407 469 cobol_read_ft 000334 constant entry external dcl 3-198 ref 122 cobol_read_rand 000336 constant entry external dcl 3-199 ref 168 202 295 489 cobol_reg_manager$after_op 000322 constant entry external dcl 3-193 ref 422 cobol_set_fsbptr 000344 constant entry external dcl 3-204 ref 157 255 356 397 417 443 482 cobol_set_pr 000366 constant entry external dcl 3-213 ref 371 438 cobol_trans_alphabet$io 000310 constant entry external dcl 3-186 ref 223 code_set 76 based fixed bin(17,0) level 2 dcl 4-25 ref 212 223 223 code_set_clause 33(35) based bit(1) level 2 packed packed unaligned dcl 4-25 ref 212 code_set_sw 000147 automatic bit(1) packed unaligned dcl 64 set ref 212* 214 240 252 comp6_type9 000174 internal static structure level 1 unaligned dcl 3-121 set ref 461 data_name based structure level 1 unaligned dcl 9-16 desc 12 based char(40) level 2 packed packed unaligned dcl 5-17 ref 204 297 device 47 based fixed bin(17,0) level 2 dcl 4-25 ref 234 234 dn_ptr 000160 automatic pointer dcl 71 set ref 181 182 197* 216 221 223* 225* 371* 438* 554* 560* 561 end_stmt based structure level 1 unaligned dcl 11-16 eos_ptr 000200 automatic pointer dcl 11-13 set ref 92* 109 141 236 373 425 549 551 553 external 33(10) based bit(1) level 2 packed packed unaligned dcl 4-25 ref 276 354 f 11(07) based bit(2) level 2 packed packed unaligned dcl 11-16 ref 425 fd_token based structure level 1 unaligned dcl 571 file_desc_1_offset 13 based fixed bin(24,0) level 2 dcl 4-25 set ref 385* 436* file_key based structure level 1 unaligned dcl 5-17 file_key_desc based char(40) packed unaligned dcl 62 set ref 204* 297* 456* file_key_info 13 000050 internal static structure level 2 in structure "alpha_type9" unaligned dcl 3-81 in procedure "cobol_write_gen" file_key_info 13 000174 internal static structure level 2 in structure "comp6_type9" unaligned dcl 3-121 in procedure "cobol_write_gen" file_key_info 13 000230 internal static structure level 2 in structure "fkey_type9" unaligned dcl 3-135 in procedure "cobol_write_gen" set ref 204 297 456 file_key_info 13 000140 internal static structure level 2 in structure "num_type9" unaligned dcl 3-107 in procedure "cobol_write_gen" file_key_info 13 000104 internal static structure level 2 in structure "trans_type9" unaligned dcl 3-94 in procedure "cobol_write_gen" file_no 12 based fixed bin(17,0) level 2 dcl 571 ref 555 file_num 14 based fixed bin(17,0) level 2 dcl 9-16 ref 561 file_table based structure level 1 unaligned dcl 4-25 fixed builtin function dcl 3-217 ref 223 223 fkey_ptr 000156 automatic pointer dcl 70 set ref 202* 204 295* 297 fkey_type9 000230 internal static structure level 1 unaligned dcl 3-135 set ref 206 206 315 404 460 fn 000167 automatic fixed bin(17,0) dcl 76 set ref 122* 555* 561* footing 1 based fixed bin(15,0) level 2 dcl 6-22 set ref 507 509 509* footing_int 5 based fixed bin(31,0) level 2 dcl 6-22 set ref 514 517* fsb 124 based structure level 2 unaligned dcl 4-25 fsb_key 000307 internal static fixed bin(17,0) initial dcl 3-177 set ref 306* 322 329 403 fsb_keylen_sw 000306 internal static fixed bin(17,0) initial dcl 3-176 set ref 308* 337* 359* fsb_offset parameter fixed bin(17,0) dcl 454 ref 450 465 fsb_relkey 000305 internal static fixed bin(17,0) initial dcl 3-175 set ref 303* 306* ft_ptr 000154 automatic pointer dcl 69 set ref 122* 124 124 127 128 157* 162* 166 168 185 186 197 202 212 212 223 223 232 232 234 234 234 248* 255* 261 270* 276 276 276 290 292 292 295 300 300 316 322 329 348* 354 354 354 356* 378* 385 390* 395 395 395 397* 403 417* 427* 436 441* 443* 465 480 482* 489 good_tag 000101 automatic fixed bin(17,0) dcl 33 set ref 94* 160* 164* index_value parameter fixed bin(15,0) dcl 453 ref 450 456 iocb_arg 000022 internal static structure level 1 unaligned dcl 3-14 set ref 134 iocb_struct 000030 internal static structure level 1 unaligned dcl 3-66 set ref 107 ioerror 000276 internal static structure level 1 unaligned dcl 3-166 set ref 106 ioerror_ptr 000164 automatic pointer dcl 74 set ref 106* 162* 248* 270* 348* 378* 390* 427* 441* is_tag 2 000276 internal static fixed bin(17,0) level 2 dcl 3-166 set ref 112* 116* 425 item_length 16 based fixed bin(24,0) level 2 dcl 9-16 ref 182 linage 33(34) based bit(1) level 2 packed packed unaligned dcl 4-25 ref 166 261 480 linage_info 32 based char(5) level 2 packed packed unaligned dcl 4-25 set ref 168* 489* linage_ptr 000110 automatic pointer dcl 37 set ref 168* 170 172 172 174 456 489* 491 493 493 495 500 501 503 507 509 509 514 514 517 524 524 526 530 532 532 534 linage_rec based structure level 1 unaligned dcl 6-22 line 1 based fixed bin(17,0) level 2 dcl 7-14 set ref 197* max_cra_size 41 based fixed bin(24,0) level 2 dcl 4-25 ref 186 mode 6 000276 internal static fixed bin(17,0) level 2 dcl 3-166 set ref 105* mp based structure level 1 unaligned dcl 39 mp_ptr parameter pointer dcl 38 set ref 29 90 92 92 104 144 145 146 242 243 248* 252 314 399 459 554 555 556 556 560 mpout 000036 internal static structure level 1 unaligned dcl 3-74 set ref 149 149 334 334 407 407 469 469 n 3 000112 automatic fixed bin(17,0) level 2 in structure "args" dcl 47 in procedure "cobol_write_gen" set ref 133* n 000036 internal static fixed bin(17,0) initial level 2 in structure "mpout" dcl 3-74 in procedure "cobol_write_gen" set ref 458* n based fixed bin(17,0) level 2 in structure "mp" dcl 39 in procedure "cobol_write_gen" ref 92 name_desc 20 based char(40) array level 2 packed packed unaligned dcl 6-22 ref 456 ns_tag 3 000276 internal static fixed bin(17,0) level 2 dcl 3-166 set ref 111* 117* ntag 000174 automatic fixed bin(17,0) dcl 83 set ref 279* 282* 284* num_type9 000140 internal static structure level 1 unaligned dcl 3-107 set ref 318 400 off 24 000140 internal static fixed bin(17,0) level 3 in structure "num_type9" dcl 3-107 in procedure "cobol_write_gen" set ref 322* 403* off 125 based fixed bin(24,0) level 3 in structure "file_table" dcl 4-25 in procedure "cobol_write_gen" ref 128 322 329 403 465 off 24 000050 internal static fixed bin(17,0) level 3 in structure "alpha_type9" dcl 3-81 in procedure "cobol_write_gen" set ref 329* off 24 000104 internal static fixed bin(17,0) level 3 in structure "trans_type9" dcl 3-94 in procedure "cobol_write_gen" set ref 220* off 24 000174 internal static fixed bin(17,0) level 3 in structure "comp6_type9" dcl 3-121 in procedure "cobol_write_gen" set ref 465* offset 4 000030 internal static fixed bin(17,0) level 2 dcl 3-66 set ref 128* open_io 34(04) based bit(1) level 2 packed packed unaligned dcl 4-25 ref 276 354 organization 43 based fixed bin(17,0) level 2 dcl 4-25 set ref 124 124* 232 234 290 300 316 395 passed_tag parameter fixed bin(17,0) dcl 35 set ref 29 111* 425* places_left 17 000174 internal static fixed bin(17,0) level 3 in structure "comp6_type9" dcl 3-121 in procedure "cobol_write_gen" set ref 463* places_left 17 000140 internal static fixed bin(17,0) level 3 in structure "num_type9" dcl 3-107 in procedure "cobol_write_gen" set ref 319* 401* pr5_struct 000012 internal static structure level 1 unaligned dcl 3-6 set ref 88 pr5_struct_ptr 000010 internal static pointer dcl 3-4 set ref 88* 371* 438* pt 000022 internal static pointer initial level 2 in structure "iocb_arg" dcl 3-14 in procedure "cobol_write_gen" set ref 107* pt 2 based pointer array level 2 in structure "mp" dcl 39 in procedure "cobol_write_gen" set ref 90 92 104 144 145 146 242 243* 252* 314 399 459 554 555 556* 556 560 pt1 2 000036 internal static pointer level 2 dcl 3-74 set ref 144* 314* 399* 459* pt2 4 000036 internal static pointer level 2 dcl 3-74 set ref 145* 315* 400* 460* pt3 6 000036 internal static pointer level 2 dcl 3-74 set ref 146* 318* 325* 404* 461* pt4 10 000036 internal static pointer level 2 dcl 3-74 set ref 147* 332* 405* 467* r_key_info 22(18) based char(5) level 2 packed packed unaligned dcl 4-25 set ref 295* rec_do 33(33) based bit(1) level 2 packed packed unaligned dcl 4-25 ref 197 rec_do_info 25 based char(5) level 2 packed packed unaligned dcl 4-25 set ref 202* record_key 33(22) based bit(1) level 2 packed packed unaligned dcl 4-25 ref 292 relative_key 33(21) based bit(1) level 2 packed packed unaligned dcl 4-25 ref 292 395 reserved_word based structure level 1 unaligned dcl 7-14 retry_tag 1 000276 internal static fixed bin(17,0) level 2 dcl 3-166 set ref 93* 155* rw_ptr 000176 automatic pointer dcl 7-11 set ref 90* 197 save_mp2_ptr 000152 automatic pointer dcl 68 set ref 242* 252 seek_errno 000175 automatic fixed bin(17,0) initial dcl 3-180 set ref 3-180* seek_tag 000103 automatic fixed bin(17,0) dcl 33 set ref 96* 345* 350* seg 3 000030 internal static fixed bin(17,0) level 2 in structure "iocb_struct" dcl 3-66 in procedure "cobol_write_gen" set ref 127* seg 23 000174 internal static fixed bin(17,0) initial level 3 in structure "comp6_type9" dcl 3-121 in procedure "cobol_write_gen" set ref 464* seg 23 000050 internal static fixed bin(17,0) initial level 3 in structure "alpha_type9" dcl 3-81 in procedure "cobol_write_gen" set ref 327* seg 23 000104 internal static fixed bin(17,0) initial level 3 in structure "trans_type9" dcl 3-94 in procedure "cobol_write_gen" set ref 219* seg 124 based fixed bin(24,0) level 3 in structure "file_table" dcl 4-25 in procedure "cobol_write_gen" ref 127 seg 23 000140 internal static fixed bin(17,0) initial level 3 in structure "num_type9" dcl 3-107 in procedure "cobol_write_gen" set ref 320* 402* size 16 000050 internal static fixed bin(17,0) initial level 3 in structure "alpha_type9" dcl 3-81 in procedure "cobol_write_gen" set ref 326* size 16 000104 internal static fixed bin(17,0) initial level 3 in structure "trans_type9" dcl 3-94 in procedure "cobol_write_gen" set ref 221* size 16 000140 internal static fixed bin(17,0) initial level 3 in structure "num_type9" dcl 3-107 in procedure "cobol_write_gen" set ref 319* 401* size 16 000230 internal static fixed bin(17,0) initial level 3 in structure "fkey_type9" dcl 3-135 in procedure "cobol_write_gen" set ref 326 size 000171 automatic fixed bin(17,0) dcl 78 in procedure "cobol_write_gen" set ref 319* 326* 337 337 size based fixed bin(17,0) level 2 in structure "data_name" dcl 9-16 in procedure "cobol_write_gen" ref 216 221 size 16 000174 internal static fixed bin(17,0) initial level 3 in structure "comp6_type9" dcl 3-121 in procedure "cobol_write_gen" set ref 463* skip_tag 000105 automatic fixed bin(17,0) dcl 33 set ref 484* 487* 538* status_arg 000000 constant structure level 1 unaligned dcl 3-21 ref 135 stoff 000100 automatic fixed bin(17,0) dcl 32 set ref 216* 220 stream_tag 000102 automatic fixed bin(17,0) dcl 33 set ref 95* 261* 267* 387* 414* substr builtin function dcl 3-217 ref 192 192 337 337 temp 000166 automatic fixed bin(17,0) dcl 76 set ref 182* 186* 192 192 top 2 based fixed bin(15,0) level 2 dcl 6-22 set ref 170 172 172* top_int 6 based fixed bin(31,0) level 2 dcl 6-22 set ref 174* trans_type9 000104 internal static structure level 1 unaligned dcl 3-94 set ref 223 223 225 243 type19 000264 internal static structure level 1 unaligned dcl 3-148 set ref 147 332 405 467 type1_ptr 4 000276 internal static pointer level 2 dcl 3-166 set ref 104* unspec builtin function dcl 3-217 ref 134 135 192 192 337 337 var 000150 automatic bit(1) packed unaligned dcl 64 set ref 179 181* 185* 189 557* 562* variable 101(01) based bit(1) level 2 packed packed unaligned dcl 4-25 ref 185 variable_length 22(04) based bit(1) level 2 packed packed unaligned dcl 9-16 ref 181 write_tag 000104 automatic fixed bin(17,0) dcl 33 set ref 97* 376* 380* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. addrel builtin function dcl 3-217 allo1_max defined fixed bin(17,0) dcl 13-171 allo1_ptr defined pointer dcl 13-67 alter_flag defined fixed bin(17,0) dcl 13-135 alter_index defined fixed bin(17,0) dcl 13-153 alter_list_ptr defined pointer dcl 13-39 aq_struct internal static structure level 1 unaligned dcl 3-56 binary builtin function dcl 3-217 buff_arg internal static structure level 1 unaligned dcl 3-26 cd_cnt defined fixed bin(17,0) dcl 13-197 cobol_$allo1_max external static fixed bin(17,0) dcl 13-170 cobol_$allo1_ptr external static pointer dcl 13-66 cobol_$alter_flag external static fixed bin(17,0) dcl 13-134 cobol_$alter_index external static fixed bin(17,0) dcl 13-152 cobol_$alter_list_ptr external static pointer dcl 13-38 cobol_$cd_cnt external static fixed bin(17,0) dcl 13-196 cobol_$cobol_data_wd_off external static fixed bin(17,0) dcl 13-118 cobol_$compile_count external static fixed bin(17,0) dcl 13-142 cobol_$coms_charcnt external static fixed bin(17,0) dcl 13-188 cobol_$coms_wdoff external static fixed bin(17,0) dcl 13-202 cobol_$con_end_ptr external static pointer dcl 13-10 cobol_$con_wd_off external static fixed bin(17,0) dcl 13-92 cobol_$cons_charcnt external static fixed bin(17,0) dcl 13-192 cobol_$constant_offset external static fixed bin(17,0) dcl 13-156 cobol_$data_init_flag external static fixed bin(17,0) dcl 13-130 cobol_$date_compiled_sw external static fixed bin(17,0) dcl 13-180 cobol_$debug_enable external static fixed bin(17,0) dcl 13-174 cobol_$def_base_ptr external static pointer dcl 13-12 cobol_$def_max external static fixed bin(17,0) dcl 13-96 cobol_$def_wd_off external static fixed bin(17,0) dcl 13-94 cobol_$diag_ptr external static pointer dcl 13-70 cobol_$eln_max external static fixed bin(17,0) dcl 13-172 cobol_$eln_ptr external static pointer dcl 13-68 cobol_$fixup_max external static fixed bin(17,0) dcl 13-164 cobol_$fixup_ptr external static pointer dcl 13-30 cobol_$fs_charcnt external static fixed bin(17,0) dcl 13-184 cobol_$fs_wdoff external static fixed bin(17,0) dcl 13-198 cobol_$include_cnt external static fixed bin(17,0) dcl 13-182 cobol_$include_info_ptr external static pointer dcl 13-86 cobol_$init_stack_off external static fixed bin(17,0) dcl 13-124 cobol_$initval_base_ptr external static pointer dcl 13-32 cobol_$initval_file_ptr external static pointer dcl 13-34 cobol_$initval_flag external static fixed bin(17,0) dcl 13-178 cobol_$link_base_ptr external static pointer dcl 13-14 cobol_$link_max external static fixed bin(17,0) dcl 13-100 cobol_$link_wd_off external static fixed bin(17,0) dcl 13-98 cobol_$list_off external static fixed bin(17,0) dcl 13-154 cobol_$list_ptr external static pointer dcl 13-64 cobol_$ls_charcnt external static fixed bin(17,0) dcl 13-190 cobol_$main_pcs_ptr external static pointer dcl 13-84 cobol_$map_data_max external static fixed bin(17,0) dcl 13-162 cobol_$map_data_ptr external static pointer dcl 13-54 cobol_$max_stack_off external static fixed bin(17,0) dcl 13-122 cobol_$minpral5_ptr external static pointer dcl 13-50 cobol_$misc_base_ptr external static pointer dcl 13-60 cobol_$misc_end_ptr external static pointer dcl 13-62 cobol_$misc_max external static fixed bin(17,0) dcl 13-158 cobol_$non_source_offset external static fixed bin(17,0) dcl 13-176 cobol_$ntbuf_ptr external static pointer dcl 13-82 cobol_$obj_seg_name external static char(32) dcl 13-208 cobol_$op_con_ptr external static pointer dcl 13-80 cobol_$para_eop_flag external static fixed bin(17,0) dcl 13-138 cobol_$pd_map_index external static fixed bin(17,0) dcl 13-116 cobol_$pd_map_max external static fixed bin(17,0) dcl 13-160 cobol_$pd_map_ptr external static pointer dcl 13-28 cobol_$pd_map_sw external static fixed bin(17,0) dcl 13-126 cobol_$perform_list_ptr external static pointer dcl 13-36 cobol_$perform_para_index external static fixed bin(17,0) dcl 13-148 cobol_$perform_sect_index external static fixed bin(17,0) dcl 13-150 cobol_$priority_no external static fixed bin(17,0) dcl 13-140 cobol_$ptr_assumption_ind external static fixed bin(17,0) dcl 13-144 cobol_$ptr_status_ptr external static pointer dcl 13-56 cobol_$reg_assumption_ind external static fixed bin(17,0) dcl 13-146 cobol_$reg_status_ptr external static pointer dcl 13-58 cobol_$reloc_def_base_ptr external static pointer dcl 13-20 cobol_$reloc_def_max external static fixed bin(24,0) dcl 13-108 cobol_$reloc_link_base_ptr external static pointer dcl 13-22 cobol_$reloc_link_max external static fixed bin(24,0) dcl 13-110 cobol_$reloc_sym_base_ptr external static pointer dcl 13-24 cobol_$reloc_sym_max external static fixed bin(24,0) dcl 13-112 cobol_$reloc_text_base_ptr external static pointer dcl 13-18 cobol_$reloc_text_max external static fixed bin(24,0) dcl 13-106 cobol_$reloc_work_base_ptr external static pointer dcl 13-26 cobol_$reloc_work_max external static fixed bin(24,0) dcl 13-114 cobol_$reswd_ptr external static pointer dcl 13-78 cobol_$same_sort_merge_proc external static bit(1) dcl 13-214 cobol_$scratch_dir external static char(168) dcl 13-206 cobol_$sect_eop_flag external static fixed bin(17,0) dcl 13-136 cobol_$seg_init_flag external static fixed bin(17,0) dcl 13-132 cobol_$seg_init_list_ptr external static pointer dcl 13-40 cobol_$stack_off external static fixed bin(17,0) dcl 13-120 cobol_$statement_info_ptr external static pointer dcl 13-76 cobol_$sym_base_ptr external static pointer dcl 13-16 cobol_$sym_max external static fixed bin(17,0) dcl 13-104 cobol_$sym_wd_off external static fixed bin(17,0) dcl 13-102 cobol_$tag_table_max external static fixed bin(17,0) dcl 13-166 cobol_$tag_table_ptr external static pointer dcl 13-52 cobol_$temp_token_area_ptr external static pointer dcl 13-42 cobol_$temp_token_max external static fixed bin(17,0) dcl 13-168 cobol_$temp_token_ptr external static pointer dcl 13-44 cobol_$text_base_ptr external static pointer dcl 13-8 cobol_$text_wd_off external static fixed bin(17,0) dcl 13-90 cobol_$token_block1_ptr external static pointer dcl 13-46 cobol_$token_block2_ptr external static pointer dcl 13-48 cobol_$value_cnt external static fixed bin(17,0) dcl 13-194 cobol_$ws_charcnt external static fixed bin(17,0) dcl 13-186 cobol_$ws_wdoff external static fixed bin(17,0) dcl 13-200 cobol_$xref_bypass external static bit(1) dcl 13-212 cobol_$xref_chain_ptr external static pointer dcl 13-74 cobol_$xref_token_ptr external static pointer dcl 13-72 cobol_data_wd_off defined fixed bin(17,0) dcl 13-119 cobol_ioop_util$lda 000000 constant entry external dcl 3-191 cobol_make_tagref 000000 constant entry external dcl 3-187 compile_count defined fixed bin(17,0) dcl 13-143 coms_charcnt defined fixed bin(17,0) dcl 13-189 coms_wdoff defined fixed bin(17,0) dcl 13-203 con_end_ptr defined pointer dcl 13-11 con_wd_off defined fixed bin(17,0) dcl 13-93 cons_charcnt defined fixed bin(17,0) dcl 13-193 constant_offset defined fixed bin(17,0) dcl 13-157 data_init_flag defined fixed bin(17,0) dcl 13-131 date_compiled_sw defined fixed bin(17,0) dcl 13-181 debug_enable defined fixed bin(17,0) dcl 13-175 def_base_ptr defined pointer dcl 13-13 def_max defined fixed bin(17,0) dcl 13-97 def_wd_off defined fixed bin(17,0) dcl 13-95 diag_ptr defined pointer dcl 13-71 eln_max defined fixed bin(17,0) dcl 13-173 eln_ptr defined pointer dcl 13-69 extend_sw automatic bit(1) dcl 63 fixup_max defined fixed bin(17,0) dcl 13-165 fixup_ptr defined pointer dcl 13-31 fs_charcnt defined fixed bin(17,0) dcl 13-185 fs_wdoff defined fixed bin(17,0) dcl 13-199 fsb_arg internal static structure level 1 unaligned dcl 3-32 fsb_key_wd internal static fixed bin(17,0) initial dcl 3-178 include_cnt defined fixed bin(17,0) dcl 13-183 include_info_ptr defined pointer dcl 13-87 index builtin function dcl 3-217 init_stack_off defined fixed bin(17,0) dcl 13-125 initval_base_ptr defined pointer dcl 13-33 initval_file_ptr defined pointer dcl 13-35 initval_flag defined fixed bin(17,0) dcl 13-179 iomode_errno internal static fixed bin(17,0) initial dcl 3-181 length builtin function dcl 3-217 link_base_ptr defined pointer dcl 13-15 link_max defined fixed bin(17,0) dcl 13-101 link_wd_off defined fixed bin(17,0) dcl 13-99 list_off defined fixed bin(17,0) dcl 13-155 list_ptr defined pointer dcl 13-65 ls_charcnt defined fixed bin(17,0) dcl 13-191 main_pcs_ptr defined pointer dcl 13-85 map_data_max defined fixed bin(17,0) dcl 13-163 map_data_ptr defined pointer dcl 13-55 max_stack_off defined fixed bin(17,0) dcl 13-123 mcode_off internal static fixed bin(17,0) initial dcl 3-174 minpral5_ptr defined pointer dcl 13-51 misc_base_ptr defined pointer dcl 13-61 misc_end_ptr defined pointer dcl 13-63 misc_max defined fixed bin(17,0) dcl 13-159 mod builtin function dcl 3-217 name_ptr automatic pointer dcl 72 next_tag defined fixed bin(17,0) dcl 13-129 non_source_offset defined fixed bin(17,0) dcl 13-177 ntbuf_ptr defined pointer dcl 13-83 null builtin function dcl 3-217 obj_seg_name defined char(32) dcl 13-209 offset automatic fixed bin(17,0) dcl 79 op_con_ptr defined pointer dcl 13-81 para_eop_flag defined fixed bin(17,0) dcl 13-139 pd_map_index defined fixed bin(17,0) dcl 13-117 pd_map_max defined fixed bin(17,0) dcl 13-161 pd_map_ptr defined pointer dcl 13-29 pd_map_sw defined fixed bin(17,0) dcl 13-127 perform_list_ptr defined pointer dcl 13-37 perform_para_index defined fixed bin(17,0) dcl 13-149 perform_sect_index defined fixed bin(17,0) dcl 13-151 pr1_struct internal static structure level 1 unaligned dcl 3-39 priority_no defined fixed bin(17,0) dcl 13-141 ptag automatic fixed bin(17,0) dcl 36 ptr_assumption_ind defined fixed bin(17,0) dcl 13-145 ptr_status_ptr defined pointer dcl 13-57 reclen_off automatic fixed bin(17,0) dcl 80 reg_assumption_ind defined fixed bin(17,0) dcl 13-147 reg_status_ptr defined pointer dcl 13-59 rel builtin function dcl 3-217 reloc_def_base_ptr defined pointer dcl 13-21 reloc_def_max defined fixed bin(24,0) dcl 13-109 reloc_link_base_ptr defined pointer dcl 13-23 reloc_link_max defined fixed bin(24,0) dcl 13-111 reloc_sym_base_ptr defined pointer dcl 13-25 reloc_sym_max defined fixed bin(24,0) dcl 13-113 reloc_text_base_ptr defined pointer dcl 13-19 reloc_text_max defined fixed bin(24,0) dcl 13-107 reloc_work_base_ptr defined pointer dcl 13-27 reloc_work_max defined fixed bin(24,0) dcl 13-115 reswd_ptr defined pointer dcl 13-79 same_sort_merge_proc defined bit(1) dcl 13-215 scratch_dir defined char(168) dcl 13-207 sect_eop_flag defined fixed bin(17,0) dcl 13-137 seg_init_flag defined fixed bin(17,0) dcl 13-133 seg_init_list_ptr defined pointer dcl 13-41 stack_off defined fixed bin(17,0) dcl 13-121 statement_info_ptr defined pointer dcl 13-77 string builtin function dcl 3-217 sym_base_ptr defined pointer dcl 13-17 sym_max defined fixed bin(17,0) dcl 13-105 sym_wd_off defined fixed bin(17,0) dcl 13-103 tag_table_max defined fixed bin(17,0) dcl 13-167 tag_table_ptr defined pointer dcl 13-53 temp_arg internal static structure level 1 unaligned dcl 3-17 temp_token_area_ptr defined pointer dcl 13-43 temp_token_max defined fixed bin(17,0) dcl 13-169 temp_token_ptr defined pointer dcl 13-45 text based bit(36) array packed unaligned dcl 66 text_base_ptr defined pointer dcl 13-9 text_wd_off defined fixed bin(17,0) dcl 13-91 token_block1_ptr defined pointer dcl 13-47 token_block2_ptr defined pointer dcl 13-49 value_cnt defined fixed bin(17,0) dcl 13-195 write_errno internal static fixed bin(17,0) initial dcl 3-179 ws_charcnt defined fixed bin(17,0) dcl 13-187 ws_wdoff defined fixed bin(17,0) dcl 13-201 x1_struct internal static structure level 1 unaligned dcl 3-47 xref_bypass defined bit(1) dcl 13-213 xref_chain_ptr defined pointer dcl 13-75 xref_token_ptr defined pointer dcl 13-73 NAMES DECLARED BY EXPLICIT CONTEXT. EMIT_OP_91 001705 constant entry internal dcl 432 ref 342 366 cobol_write_gen 000015 constant entry external dcl 29 init_linage 002042 constant entry internal dcl 474 ref 251 linage_init 001772 constant entry internal dcl 450 ref 172 493 509 524 532 set_up 002330 constant entry internal dcl 545 ref 101 start 000025 constant label dcl 88 start_codegen 000214 constant label dcl 141 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2714 3306 2375 2724 Length 4100 2375 372 556 317 300 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_write_gen 234 external procedure is an external procedure. EMIT_OP_91 internal procedure shares stack frame of external procedure cobol_write_gen. linage_init internal procedure shares stack frame of external procedure cobol_write_gen. init_linage internal procedure shares stack frame of external procedure cobol_write_gen. set_up internal procedure shares stack frame of external procedure cobol_write_gen. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 pr5_struct_ptr cobol_write_gen 000012 pr5_struct cobol_write_gen 000022 iocb_arg cobol_write_gen 000030 iocb_struct cobol_write_gen 000036 mpout cobol_write_gen 000050 alpha_type9 cobol_write_gen 000104 trans_type9 cobol_write_gen 000140 num_type9 cobol_write_gen 000174 comp6_type9 cobol_write_gen 000230 fkey_type9 cobol_write_gen 000264 type19 cobol_write_gen 000276 ioerror cobol_write_gen 000305 fsb_relkey cobol_write_gen 000306 fsb_keylen_sw cobol_write_gen 000307 fsb_key cobol_write_gen STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_write_gen 000100 stoff cobol_write_gen 000101 good_tag cobol_write_gen 000102 stream_tag cobol_write_gen 000103 seek_tag cobol_write_gen 000104 write_tag cobol_write_gen 000105 skip_tag cobol_write_gen 000106 alt_tag cobol_write_gen 000107 alt_seek_tag cobol_write_gen 000110 linage_ptr cobol_write_gen 000112 args cobol_write_gen 000146 alt_sw cobol_write_gen 000147 code_set_sw cobol_write_gen 000150 var cobol_write_gen 000152 save_mp2_ptr cobol_write_gen 000154 ft_ptr cobol_write_gen 000156 fkey_ptr cobol_write_gen 000160 dn_ptr cobol_write_gen 000162 arg_ptr cobol_write_gen 000164 ioerror_ptr cobol_write_gen 000166 temp cobol_write_gen 000167 fn cobol_write_gen 000170 aloff cobol_write_gen 000171 size cobol_write_gen 000172 buflen_off cobol_write_gen 000173 buf_off cobol_write_gen 000174 ntag cobol_write_gen 000175 seek_errno cobol_write_gen 000176 rw_ptr cobol_write_gen 000200 eos_ptr cobol_write_gen THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as call_ext_out return_mac ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_alloc$stack cobol_call_op cobol_define_tag cobol_gen_ioerror cobol_gen_ioerror$finish_up cobol_get_size cobol_io_util$bin_to_dec cobol_io_util$bypass_mode_error cobol_io_util$file_desc cobol_io_util$fixed_add cobol_io_util$move_direct cobol_io_util$t9dec_to_bin cobol_ioop_util$bypass_reset cobol_ioop_util$disp cobol_ioop_util$set_fsb cobol_ioop_util$set_icode cobol_linage cobol_move_gen cobol_read_ft cobol_read_rand cobol_reg_manager$after_op cobol_set_fsbptr cobol_set_pr cobol_trans_alphabet$io THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cobol_$next_tag LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 29 000011 77 000022 3 180 000023 88 000025 90 000027 92 000034 93 000040 94 000042 95 000045 96 000050 97 000053 98 000056 99 000061 100 000064 101 000066 102 000067 103 000071 104 000073 105 000100 106 000101 107 000103 109 000105 111 000113 112 000116 113 000121 114 000123 116 000124 117 000125 118 000127 122 000130 124 000140 127 000146 128 000151 130 000153 132 000171 133 000173 134 000175 135 000204 136 000212 141 000214 144 000222 145 000227 146 000233 147 000237 149 000241 155 000251 157 000260 160 000267 162 000302 164 000313 166 000322 168 000326 170 000343 172 000346 174 000363 179 000376 181 000400 182 000405 183 000407 185 000410 186 000415 189 000417 192 000421 193 000454 197 000455 202 000476 204 000513 206 000520 212 000541 214 000552 216 000553 219 000573 220 000576 221 000601 223 000603 225 000625 232 000630 234 000641 236 000650 240 000663 242 000665 243 000672 248 000675 251 000715 252 000716 255 000725 257 000734 261 000743 267 000763 270 000776 272 001007 276 001010 279 001021 280 001024 282 001025 284 001037 290 001046 292 001052 295 001055 297 001074 300 001101 303 001110 306 001136 308 001166 311 001215 314 001216 315 001224 316 001226 318 001231 319 001233 320 001237 322 001241 323 001244 325 001245 326 001247 327 001252 329 001254 332 001257 334 001261 337 001271 342 001321 345 001324 348 001337 350 001350 354 001357 356 001371 359 001400 364 001427 366 001430 371 001433 373 001444 376 001457 378 001472 380 001503 383 001512 385 001514 387 001524 390 001537 395 001550 397 001562 399 001571 400 001577 401 001601 402 001604 403 001606 404 001612 405 001614 407 001616 414 001626 417 001635 422 001646 425 001660 427 001673 430 001704 432 001705 436 001706 438 001716 439 001727 441 001742 442 001753 443 001762 445 001771 450 001772 456 001774 458 002004 459 002006 460 002013 461 002015 463 002017 464 002021 465 002023 467 002027 469 002031 471 002041 474 002042 480 002043 482 002047 484 002056 485 002061 487 002062 489 002070 491 002106 493 002110 495 002125 497 002141 500 002142 501 002145 503 002147 507 002162 509 002165 514 002202 517 002220 521 002233 524 002234 526 002252 530 002265 532 002270 534 002305 538 002320 543 002327 545 002330 549 002331 551 002336 553 002340 554 002344 555 002351 556 002356 557 002360 558 002362 560 002363 561 002370 562 002372 565 002373 ----------------------------------------------------------- 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