COMPILATION LISTING OF SEGMENT cobol_source_formatter_ 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 1029.3 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_source_formatter_.pl1 Reformatted code to new Cobol 19* standard. 20* END HISTORY COMMENTS */ 21 22 23 /* Modified on 07/20/81 by FCH, reformatted to improve readability, phx10605(BUG495) */ 24 /* Modified on 03/06/81 by FCH, [4.4-2], last line not processed unless it ends in c.r. char, BUG469(TR9264) */ 25 /* Modified on 09/22/80 by FCH, [4.4-1], tabs not handled properly (BUG444) */ 26 /* Modified since Version 4.4 */ 27 28 29 30 31 /* format: style3 */ 32 cobol_source_formatter_: 33 proc (inp, outp, bc, ctype, mtype); 34 35 dcl inp ptr; 36 dcl outp ptr; 37 dcl bc fixed bin (24); 38 dcl ctype fixed bin; /* -1=lower_case; +1=upper_case */ 39 dcl mtype fixed bin; /* 0=ignore leading blanks; 1=take leading blanks into account within areas */ 40 dcl shift bit (1); 41 dcl (identsw, datasw, procsw) 42 bit (1); 43 dcl contsw bit (1); 44 dcl periodsw bit (1); 45 dcl last_periodsw bit (1); 46 dcl char_count fixed bin (35); 47 dcl code fixed bin (35); 48 dcl source_length fixed bin; 49 dcl inoff fixed bin; 50 dcl outoff fixed bin; 51 dcl cct fixed bin; 52 dcl nl char (1) static options (constant) init (" 53 "); 54 dcl tab char (1) static options (constant) init (" "); 55 dcl blank char (1) static options (constant) init (" "); 56 dcl spaces char (256) static options (constant) init (""); 57 dcl period char (1) static options (constant) init ("."); 58 dcl quote char (1) static options (constant) init (""""); 59 dcl chars char (256) based; 60 dcl char_array (300) char (1) based; 61 dcl (ini, outi, nli, tabj, quotei, quotej) 62 fixed bin; 63 dcl (blanki, periodi) fixed bin; 64 dcl (i, j, len, n) fixed bin; 65 dcl first_quote fixed bin; 66 dcl tline char (300); 67 dcl line char (300) varying; 68 dcl spec_name (20) char (16) varying static 69 init ("01", "77", "1", "fd", "sd", "cd", "rd", "program-id", "author", "installation", 70 "date-written", "date-compiled", "security", "source-computer", "object-computer", 71 "special-names", "file-control", "i-o-control", "declaratives", "end"); 72 73 dcl (addr, index, substr, length, divide) 74 builtin; 75 76 77 /*************************************/ 78 start: 79 shift = "1"b; 80 go to join; 81 82 /*************************************/ 83 no_shift: 84 entry (inp, outp, bc, ctype); 85 shift = "0"b; 86 /*************************************/ 87 join: 88 char_count = 0; 89 identsw, datasw, procsw = "0"b; 90 contsw = "0"b; 91 last_periodsw = "1"b; 92 nli = index (inp -> chars, nl); /*[4.4-2]*/ 93 cct = divide (bc, 9, 31, 0); 94 95 do while ("1"b); 96 97 /*[4.4-2]*/ 98 if nli <= 0 99 then nli = cct + 1; 100 101 if substr (inp -> chars, 1, 1) = "*" | substr (inp -> chars, 1, 1) = "/" 102 | substr (inp -> chars, 1, 7) = " *" | substr (inp -> chars, 1, 7) = " /" 103 then do; 104 105 if substr (inp -> chars, 1, 1) = blank 106 then inoff = 7; 107 else inoff = 1; 108 109 tline = substr (inp -> chars, 1, nli); 110 substr (outp -> chars, 1, 6) = ""; 111 outoff = 7; 112 113 do i = nli - 1 to inoff by -1 while (substr (tline, i, 1) = blank); 114 end; 115 116 outi = i + 1; 117 substr (tline, outi, 1) = nl; 118 go to skip_shift; 119 120 end; 121 122 convert_tabs_and_case: 123 tline = ""; /* convert tabs and case if necessary */ 124 ini, outi = 1; 125 126 do while (ini < nli); 127 128 quotej = index (substr (inp -> chars, ini, nli - ini), quote); 129 if quotej = 0 130 then quotej = nli - ini + 1; 131 132 quotei = ini + quotej - 1; 133 first_quote = quotej; 134 135 do while (ini < quotei); 136 137 tabj = index (substr (inp -> chars, ini, quotei - ini), tab); 138 139 if tabj = 0 140 then do; 141 142 tabj = quotei - ini + 1; 143 n = 0; 144 end; 145 else do; 146 147 n = 10 - mod (outi + tabj - 1, 10); 148 if n = 0 149 then n = 10; 150 end; 151 152 if ctype = 0 153 then substr (tline, outi, tabj - 1) = substr (inp -> chars, ini, tabj - 1); 154 else do; 155 156 if ctype > 0 157 then line = upper_case (substr (inp -> chars, ini, tabj - 1)); 158 else line = lower_case (substr (inp -> chars, ini, tabj - 1)); 159 160 substr (tline, outi, tabj - 1) = line; 161 162 end; 163 164 ini = ini + tabj; 165 outi = outi + tabj + n - 1; 166 167 168 169 end; 170 171 if quotei < nli 172 then do; 173 174 quotej = index (substr (inp -> chars, quotei + 1, nli - quotei), quote); 175 176 177 if quotej = 0 178 then do; /* a continued nonnumeric literal */ 179 180 quotej = nli - ini + 1; 181 contsw = "1"b; 182 end; 183 else quotej = quotej + 1; /* include both quotes */ 184 185 substr (tline, outi, quotej) = substr (inp -> chars, quotei, quotej); 186 ini = quotei + quotej; 187 outi = outi + quotej; 188 189 end; 190 191 end; 192 193 check_empty_line: 194 if outi = 1 | tline = "" 195 then do; /* an empty line */ 196 197 outi = 1; 198 outoff = 1; 199 inoff = 1; 200 substr (tline, 1, 1) = nl; 201 go to skip_shift; 202 end; 203 204 if ^shift 205 then do; 206 207 substr (tline, outi, 1) = nl; 208 outoff = 1; 209 inoff = 1; 210 go to skip_shift; 211 212 end; 213 214 strip_trailing_blanks: 215 substr (outp -> chars, 1, 256) = ""; 216 217 /* strip trailing blanks and convert to lower case */ 218 219 periodsw = last_periodsw; 220 221 if ^contsw 222 then do; 223 224 do i = outi - 1 to 1 by -1 while (substr (tline, i, 1) = blank); 225 end; 226 227 if substr (tline, i, 1) = period 228 then last_periodsw = "1"b; 229 else last_periodsw = "0"b; 230 231 outi = i + 1; 232 233 end; 234 else do; 235 236 contsw = "0"b; 237 last_periodsw = "0"b; 238 end; 239 240 substr (tline, outi, 1) = nl; 241 line = lower_case (substr (tline, 1, outi)); 242 243 explicit_check: 244 if substr (line, 1, 2) = "a*" 245 then do; /* check for explicit area specification */ 246 247 substr (line, 1, 2) = ""; 248 call division_check; 249 outoff = 8; 250 251 do inoff = 3 to outi while (substr (line, inoff, 1) = blank); 252 end; 253 254 if substr (line, inoff, 2) = "1 " | substr (line, inoff, 2) = "1" || nl 255 then do; 256 257 if inoff = 3 | inoff > 6 | mtype = 0 258 then outoff = 9; 259 else inoff = 3; 260 261 end; 262 else if inoff < 7 263 then inoff = 3; 264 265 /* maintain A area indentation */ 266 267 end; 268 269 else if substr (line, 1, 1) = "-" | substr (line, 1, 7) = " -" 270 then do; 271 272 if substr (line, 1, 1) = "-" 273 then inoff = 2; 274 else inoff = 8; 275 276 do inoff = inoff to outi while (substr (line, inoff, 1) = blank); 277 end; 278 279 substr (outp -> chars, 7, 1) = "-"; 280 outoff = 12; 281 282 end; 283 else if substr (line, 1, 2) = "d*" 284 then do; 285 286 substr (outp -> chars, 7, 1) = "d"; 287 inoff = 3; 288 substr (line, 1, 2) = ""; 289 290 go to implicit_check; 291 292 end; 293 else if substr (line, 1, 3) = "da*" 294 then do; 295 296 substr (outp -> chars, 7, 1) = "d"; 297 outoff = 8; 298 299 do inoff = 4 to outi while (substr (line, inoff, 1) = blank); 300 end; 301 302 if substr (line, inoff, 2) = "1 " | substr (line, inoff, 2) = "1" || nl 303 then do; 304 305 if inoff = 4 | inoff > 7 | mtype = 0 306 then outoff = 9; 307 else inoff = 4; 308 end; 309 else if inoff < 8 310 then inoff = 4; 311 312 end; 313 else do; /* no explicit specification - must figure it out */ 314 315 inoff = 1; 316 317 implicit_check: 318 outoff = 0; /* until we know */ 319 320 if ^identsw 321 then do; /* check for section names and section headers */ 322 323 section_check: 324 n = index (line, " section"); 325 326 if n > 0 & n < first_quote 327 then if substr (line, n + 8, 1) = period | substr (line, n + 8, 1) = blank 328 | substr (line, n + 8, 1) = nl 329 then outoff = 8; 330 331 end; 332 333 if outoff = 0 334 then call division_check; /* check for division headers */ 335 336 if outoff = 0 & procsw 337 then do; /* check for user-defined paragraph names */ 338 339 paragraph_check: /*[4.4-1]*/ 340 do i = inoff to outi while (substr (line, i, 1) = blank); 341 end; 342 343 /* position to first non-blank */ 344 345 blanki = index (substr (line, i, nli - i), blank); 346 347 /*[4.4-1]*/ 348 if blanki = 0 349 then blanki = outi; 350 else blanki = blanki + i - 1; 351 /* set relative to beginning of line */ 352 353 periodi = index (line, period); 354 355 if periodi > 1 356 then if substr (line, periodi + 1, 1) = nl | substr (line, periodi + 1, 1) = blank 357 then do; 358 359 if periodi > blanki 360 then do; /* ignore blanks immediately preceding period */ 361 362 do j = periodi - 1 to blanki by -1 363 while (substr (line, j, 1) = blank); 364 end; 365 366 periodi = j + 1; 367 368 end; 369 else j = periodi - 1; 370 371 j = j - i + 1; 372 373 if periodi <= blanki & periodsw 374 then if (substr (line, i, j) ^= "exit") 375 & (substr (line, i, j) ^= "suppress") 376 then outoff = 8; 377 378 /* paragraph name */ 379 380 end; 381 382 end; 383 else if outoff = 0 & ^procsw & periodsw 384 then do; /* check for level indicators */ 385 386 level_number_check: 387 if mtype = 0 388 then do i = inoff to nli while (substr (line, i, 1) = blank); 389 end; 390 else i = inoff; 391 392 /* don't adjust B area level numbers already indented */ 393 394 blanki = index (substr (line, i, nli - i), blank); 395 396 if blanki = 2 397 then do; 398 399 if substr (line, i, 1) >= "2" & substr (line, i, 1) <= "9" 400 then outoff = 8 + fixed (substr (line, i, 1)); 401 402 403 end; 404 405 else if blanki = 3 & substr (line, i + 1, 1) ^= "d" 406 then do; /* FD, CD, RD, or SD */ 407 408 if substr (line, i, 1) >= "0" & substr (line, i, 1) <= "8" 409 then if substr (line, i + 1, 1) >= "0" & substr (line, i + 1, 1) <= "9" 410 then outoff = 7 + fixed (substr (line, i, 2)); 411 412 if outoff = 8 | outoff = 84 413 then outoff = 0; 414 /* catch 01 and 77 as reserved words */ 415 else if outoff = 7 | outoff > 56 416 then outoff = 12; 417 /* illegal and 66 and 88 */ 418 419 end; 420 421 end; 422 423 reserved_word_check: 424 if procsw 425 then i = 20; /* include "end cobol" only */ 426 else if periodsw 427 then i = 1; /* include level numbers */ 428 else i = 4; 429 430 do i = i to 20 while (outoff = 0); /* check for other Area A reserved words */ 431 432 n = index (line, spec_name (i)); 433 434 if n > 0 435 then if n = 1 | substr (line, 1, n - 1) = substr (spaces, 1, n - 1) 436 then if substr (line, n + length (spec_name (i)), 1) = blank 437 | (substr (line, n + length (spec_name (i)), 1) = period & i > 3) 438 | substr (line, n + length (spec_name (i)), 1) = nl 439 then do; 440 441 if i = 3 442 then do; /* "1" */ 443 444 outoff = 9; 445 446 do i = inoff to outi while (substr (line, i, 1) = blank); 447 end; 448 449 if i < inoff + 4 & i ^= inoff 450 then inoff = inoff + 1; 451 else inoff = i; 452 453 end; 454 else if i = 20 455 /*"end" */ 456 then if procsw 457 then outoff = 8; 458 /* end cobol */ 459 else outoff = 12; 460 /* end key */ 461 462 else outoff = 8; 463 464 end; 465 466 end; 467 468 if outoff = 0 /* nothing special - shift to Area B */ 469 then if procsw & ^periodsw & mtype = 0 470 then outoff = 16; 471 else outoff = 12; 472 473 474 else if outoff = 8 475 then do; /* get rid of leading blanks */ 476 477 do i = inoff to outi while (substr (line, i, 1) = blank); 478 end; 479 480 if i ^< inoff + 4 481 then inoff = i; 482 483 end; 484 485 end; /* eliminate existing margins unless -lm specified */ 486 487 if mtype = 0 488 then do inoff = inoff to outi while (substr (line, inoff, 1) = blank); 489 end; 490 491 skip_shift: /* output this line and look at next */ 492 source_length = outi - inoff + 1; 493 substr (outp -> chars, outoff, source_length) = substr (tline, inoff, source_length); 494 inp = addr (inp -> char_array (nli + 1)); 495 char_count = char_count + source_length + outoff - 1; 496 outp = addr (outp -> char_array (source_length + outoff)); 497 498 /*[4.4-2]*/ 499 cct = cct - nli; 500 501 /*[4.4-2]*/ 502 if cct <= 0 /*[4.4-2]*/ 503 then do; 504 bc = 9 * char_count; /*[4.4-2]*/ 505 return; /*[4.4-2]*/ 506 end; 507 508 nli = index (inp -> chars, nl); 509 510 end; 511 512 /*************************************/ 513 514 division_check: 515 proc; 516 start_division_check: 517 n = index (line, " division"); 518 519 if n > 0 & n < first_quote 520 then if substr (line, n + 9, 1) = period | substr (line, n + 9, 1) = blank | substr (line, n + 9, 1) = nl 521 then do; 522 523 if identsw 524 then do; 525 526 n = index (line, "environment "); 527 528 if n = 0 529 then n = index (line, "data "); 530 531 if n = 0 532 then n = index (line, "procedure "); 533 534 if n > 0 535 then if n = 1 | substr (line, 1, n - 1) = substr (spaces, 1, n - 1) 536 then do; 537 identsw = "0"b; 538 outoff = 8; 539 end; 540 541 end; 542 543 else do; 544 outoff = 8; 545 546 547 if index (line, "identification") > 0 548 then identsw = "1"b; 549 550 end; 551 552 if index (line, "procedure") > 0 553 then do; 554 555 procsw = "1"b; 556 identsw, datasw = "0"b; /* just for consistency in weird cases */ 557 end; 558 else if index (line, "data") > 0 559 then do; 560 561 datasw = "1"b; 562 identsw, procsw = "0"b; 563 end; 564 565 end; 566 567 end division_check; 568 569 570 /*************************************/ 571 lower_case: 572 proc (str) returns (char (300) varying); 573 dcl str char (*); 574 dcl lc_alphabet char (128) static options (constant) init (" 575  !""#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\]^_`abcdefghijklmnopqrstuvwxyz{|}~"); 576 dcl translate builtin; 577 return (translate (str, lc_alphabet)); 578 end lower_case; 579 580 upper_case: 581 proc (str) returns (char (300) varying); 582 dcl str char (*); 583 dcl lc_alphabet char (128) static options (constant) init (" 584  !""#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~"); 585 dcl translate builtin; 586 return (translate (str, lc_alphabet)); 587 end upper_case; 588 589 end cobol_source_formatter_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0837.3 cobol_source_formatter_.pl1 >spec>install>MR12.3-1048>cobol_source_formatter_.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. addr builtin function dcl 73 ref 494 496 bc parameter fixed bin(24,0) dcl 37 set ref 32 83 93 504* blank 003170 constant char(1) initial packed unaligned dcl 55 ref 105 113 224 251 276 299 326 339 345 355 362 386 394 434 446 477 487 519 blanki 000122 automatic fixed bin(17,0) dcl 63 set ref 345* 348 348* 350* 350 359 362 373 394* 396 405 cct 000113 automatic fixed bin(17,0) dcl 51 set ref 93* 98 499* 499 502 char_array based char(1) array packed unaligned dcl 60 set ref 494 496 char_count 000107 automatic fixed bin(35,0) dcl 46 set ref 87* 495* 495 504 chars based char(256) packed unaligned dcl 59 set ref 92 101 101 101 101 105 109 110* 128 137 152 156 156 158 158 174 185 214* 279* 286* 296* 493* 508 contsw 000104 automatic bit(1) packed unaligned dcl 43 set ref 90* 181* 221 236* ctype parameter fixed bin(17,0) dcl 38 ref 32 83 152 156 datasw 000102 automatic bit(1) packed unaligned dcl 41 set ref 89* 556* 561* divide builtin function dcl 73 ref 93 first_quote 000127 automatic fixed bin(17,0) dcl 65 set ref 133* 326 519 i 000124 automatic fixed bin(17,0) dcl 64 set ref 113* 113* 116 224* 224* 227 231 339* 339* 345 345 350 371 373 373 386* 386* 390* 394 394 399 399 399 405 408 408 408 408 408 423* 426* 428* 430* 430* 432 434 434 434 434 441 446* 446* 449 449 451 454* 477* 477* 480 480 identsw 000101 automatic bit(1) packed unaligned dcl 41 set ref 89* 320 523 537* 547* 556* 562* index builtin function dcl 73 ref 92 128 137 174 323 345 353 394 432 508 516 526 528 531 547 552 558 ini 000114 automatic fixed bin(17,0) dcl 61 set ref 124* 126 128 128 129 132 135 137 137 142 152 156 156 158 158 164* 164 180 186* inoff 000111 automatic fixed bin(17,0) dcl 49 set ref 105* 107* 113 199* 209* 251* 251* 254 254 257 257 259* 262 262* 272* 274* 276* 276 276* 287* 299* 299* 302 302 305 305 307* 309 309* 315* 339 386 390 446 449 449 449* 449 451* 477 480 480* 487* 487 487* 491 493 inp parameter pointer dcl 35 set ref 32 83 92 101 101 101 101 105 109 128 137 152 156 156 158 158 174 185 494* 494 508 j 000125 automatic fixed bin(17,0) dcl 64 set ref 362* 362* 366 369* 371* 371 373 373 last_periodsw 000106 automatic bit(1) packed unaligned dcl 45 set ref 91* 219 227* 229* 237* lc_alphabet 000040 constant char(128) initial packed unaligned dcl 574 in procedure "lower_case" ref 577 lc_alphabet 000000 constant char(128) initial packed unaligned dcl 583 in procedure "upper_case" ref 586 length builtin function dcl 73 ref 434 434 434 line 000243 automatic varying char(300) dcl 67 set ref 156* 158* 160 241* 243 247* 251 254 254 269 269 272 276 283 288* 293 299 302 302 323 326 326 326 339 345 353 355 355 362 373 373 386 394 399 399 399 405 408 408 408 408 408 432 434 434 434 434 446 477 487 516 519 519 519 526 528 531 534 547 552 558 mtype parameter fixed bin(17,0) dcl 39 ref 32 257 305 386 468 487 n 000126 automatic fixed bin(17,0) dcl 64 set ref 143* 147* 148 148* 165 323* 326 326 326 326 326 432* 434 434 434 434 434 434 434 516* 519 519 519 519 519 526* 528 528* 531 531* 534 534 534 534 nl constant char(1) initial packed unaligned dcl 52 ref 92 117 200 207 240 254 302 326 355 434 508 519 nli 000116 automatic fixed bin(17,0) dcl 61 set ref 92* 98 98* 109 113 126 128 129 171 174 180 345 386 394 494 499 508* outi 000115 automatic fixed bin(17,0) dcl 61 set ref 116* 117 124* 147 152 160 165* 165 185 187* 187 193 197* 207 224 231* 240 241 241 251 276 299 339 348 446 477 487 491 outoff 000112 automatic fixed bin(17,0) dcl 50 set ref 111* 198* 208* 249* 257* 280* 297* 305* 317* 326* 333 336 373* 383 399* 408* 412 412 412* 415 415 415* 430 444* 454* 459* 462* 468 468* 471* 474 493 495 496 538* 544* outp parameter pointer dcl 36 set ref 32 83 110 214 279 286 296 493 496* 496 period 003067 constant char(1) initial packed unaligned dcl 57 ref 227 326 353 434 519 periodi 000123 automatic fixed bin(17,0) dcl 63 set ref 353* 355 355 355 359 362 366* 369 373 periodsw 000105 automatic bit(1) packed unaligned dcl 44 set ref 219* 373 383 426 468 procsw 000103 automatic bit(1) packed unaligned dcl 41 set ref 89* 336 383 423 454 468 555* 562* quote constant char(1) initial packed unaligned dcl 58 ref 128 174 quotei 000120 automatic fixed bin(17,0) dcl 61 set ref 132* 135 137 142 171 174 174 185 186 quotej 000121 automatic fixed bin(17,0) dcl 61 set ref 128* 129 129* 132 133 174* 177 180* 183* 183 185 185 186 187 shift 000100 automatic bit(1) packed unaligned dcl 40 set ref 78* 85* 204 source_length 000110 automatic fixed bin(17,0) dcl 48 set ref 491* 493 493 495 496 spaces 003070 constant char(256) initial packed unaligned dcl 56 ref 434 534 spec_name 000100 constant varying char(16) initial array dcl 68 ref 432 434 434 434 str parameter char packed unaligned dcl 573 in procedure "lower_case" ref 571 577 str parameter char packed unaligned dcl 582 in procedure "upper_case" ref 580 586 substr builtin function dcl 73 set ref 101 101 101 101 105 109 110* 113 117* 128 137 152* 152 156 156 158 158 160* 174 185* 185 200* 207* 214* 224 227 240* 241 241 243 247* 251 254 254 269 269 272 276 279* 283 286* 288* 293 296* 299 302 302 326 326 326 339 345 355 355 362 373 373 386 394 399 399 399 405 408 408 408 408 408 434 434 434 434 434 446 477 487 493* 493 519 519 519 534 534 tab constant char(1) initial packed unaligned dcl 54 ref 137 tabj 000117 automatic fixed bin(17,0) dcl 61 set ref 137* 139 142* 147 152 152 156 156 158 158 160 164 165 tline 000130 automatic char(300) packed unaligned dcl 66 set ref 109* 113 117* 122* 152* 160* 185* 193 200* 207* 224 227 240* 241 241 493 translate builtin function dcl 576 in procedure "lower_case" ref 577 translate builtin function dcl 585 in procedure "upper_case" ref 586 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. code automatic fixed bin(35,0) dcl 47 len automatic fixed bin(17,0) dcl 64 NAMES DECLARED BY EXPLICIT CONTEXT. check_empty_line 000751 constant label dcl 193 cobol_source_formatter_ 000317 constant entry external dcl 32 convert_tabs_and_case 000470 constant label dcl 122 division_check 002237 constant entry internal dcl 514 ref 248 333 explicit_check 001070 constant label dcl 243 implicit_check 001331 constant label dcl 317 ref 290 join 000342 constant label dcl 87 ref 80 level_number_check 001543 constant label dcl 386 lower_case 002400 constant entry internal dcl 571 ref 158 241 no_shift 000334 constant entry external dcl 83 paragraph_check 001373 constant label dcl 339 reserved_word_check 001722 constant label dcl 423 section_check 001334 constant label dcl 323 skip_shift 002151 constant label dcl 491 ref 118 201 210 start 000324 constant label dcl 78 start_division_check 002240 constant label dcl 516 strip_trailing_blanks 001000 constant label dcl 214 upper_case 002434 constant entry internal dcl 580 ref 156 NAMES DECLARED BY CONTEXT OR IMPLICATION. fixed builtin function ref 399 408 mod builtin function ref 147 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3246 3256 3174 3256 Length 3434 3174 10 142 51 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_source_formatter_ 447 external procedure is an external procedure. division_check internal procedure shares stack frame of external procedure cobol_source_formatter_. lower_case 65 internal procedure is called during a stack extension. upper_case 65 internal procedure is called during a stack extension. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_source_formatter_ 000100 shift cobol_source_formatter_ 000101 identsw cobol_source_formatter_ 000102 datasw cobol_source_formatter_ 000103 procsw cobol_source_formatter_ 000104 contsw cobol_source_formatter_ 000105 periodsw cobol_source_formatter_ 000106 last_periodsw cobol_source_formatter_ 000107 char_count cobol_source_formatter_ 000110 source_length cobol_source_formatter_ 000111 inoff cobol_source_formatter_ 000112 outoff cobol_source_formatter_ 000113 cct cobol_source_formatter_ 000114 ini cobol_source_formatter_ 000115 outi cobol_source_formatter_ 000116 nli cobol_source_formatter_ 000117 tabj cobol_source_formatter_ 000120 quotei cobol_source_formatter_ 000121 quotej cobol_source_formatter_ 000122 blanki cobol_source_formatter_ 000123 periodi cobol_source_formatter_ 000124 i cobol_source_formatter_ 000125 j cobol_source_formatter_ 000126 n cobol_source_formatter_ 000127 first_quote cobol_source_formatter_ 000130 tline cobol_source_formatter_ 000243 line cobol_source_formatter_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp call_int_this_desc return_mac mdfx1 shorten_stack ext_entry int_entry_desc set_chars_eis index_chars_eis any_to_any_truncate_ NO EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 32 000312 78 000324 80 000326 83 000327 85 000341 87 000342 89 000343 90 000346 91 000347 92 000351 93 000365 98 000370 101 000375 105 000420 107 000426 109 000430 110 000434 111 000441 113 000443 114 000457 116 000462 117 000464 118 000467 122 000470 124 000473 126 000476 128 000501 129 000520 132 000525 133 000530 135 000532 137 000535 139 000554 142 000555 143 000561 144 000562 147 000563 148 000573 152 000576 156 000607 158 000636 160 000664 164 000674 165 000676 169 000702 171 000703 174 000706 177 000725 180 000726 181 000732 182 000734 183 000735 185 000736 186 000743 187 000746 191 000750 193 000751 197 000760 198 000762 199 000763 200 000764 201 000766 204 000767 207 000771 208 000774 209 000776 210 000777 214 001000 219 001006 221 001010 224 001012 225 001023 227 001026 229 001035 231 001036 233 001040 236 001041 237 001042 240 001043 241 001046 243 001070 247 001076 248 001100 249 001101 251 001103 252 001117 254 001121 257 001133 259 001145 261 001147 262 001150 267 001154 269 001155 272 001166 274 001174 276 001176 277 001211 279 001213 280 001221 282 001223 283 001224 286 001227 287 001235 288 001237 290 001241 293 001242 296 001246 297 001254 299 001256 300 001271 302 001273 305 001305 307 001317 308 001321 309 001322 312 001326 315 001327 317 001331 320 001332 323 001334 326 001343 333 001362 336 001365 339 001373 341 001407 345 001411 348 001425 350 001431 353 001434 355 001446 359 001460 362 001462 364 001477 366 001502 368 001504 369 001505 371 001507 373 001513 382 001534 383 001535 386 001543 389 001561 390 001564 394 001566 396 001602 399 001604 403 001634 405 001635 408 001645 412 001705 415 001714 423 001722 426 001727 428 001734 430 001736 432 001745 434 001757 441 002011 444 002014 446 002016 447 002031 449 002033 451 002044 453 002046 454 002047 459 002056 462 002061 466 002063 468 002065 471 002101 474 002104 477 002106 478 002121 480 002123 487 002131 489 002147 491 002151 493 002155 494 002165 495 002172 496 002202 499 002212 502 002214 504 002216 505 002221 508 002222 510 002235 589 002236 514 002237 516 002240 519 002247 523 002264 526 002266 528 002275 531 002305 534 002315 537 002330 538 002331 541 002333 544 002334 547 002336 552 002347 555 002356 556 002360 557 002362 558 002363 561 002372 562 002374 567 002376 571 002377 577 002413 580 002433 586 002447 ----------------------------------------------------------- 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