COMPILATION LISTING OF SEGMENT pl1_abs Compiled by: Multics PL/I Compiler, Release 30, of February 16, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 10/06/88 1029.0 mst Thu Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 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(88-09-20,TLNguyen), approve(88-09-20,MCR7984), 17* audit(88-10-03,Parisek), install(88-10-06,MR12.2-1133): 18* Make the fortran_abs command accept the -card fortran compiler control 19* argument. 20* END HISTORY COMMENTS */ 21 22 23 /* This program sets up absentee jobs to do pl1, fortran, cobol, alm, algol68, and pascal compilations. 24* 25* Initially coded in Nov 1971 by Dennis Capps 26* Modified April 5, 1972 by Dennis Capps 27* Modified for use with Version II PL/I Sept 25, 1972 by Robert S. Coren 28* Modified 6/20/74 by Steve Herbst to accept all dprint and compiler options 29* Modified 9/20/76 by R.J.C. Kissel to accept the -profile control argument 30* Modified 761227 by PG to remove v1pl1_abs, v2pl1_abs, and switch to expand_pathname_ 31* Modified 7/12/78 by James R. Davis to add cobol 32* Modified 8/10/78 by Paul E. Smee to update options for fortran and pl1. 33* Modified 9/27/78 By JRD for level and no source and extend, (COBOL) 34* Modified 12/27/78 by Paul E. Smee to update fortran options for FORTRAN 5. 35* Modified 10/10/79 by Paul E. Smee to update options for MR8.0. 36* Modified 4 April 1980 by M. N. Davidoff to for pl1 -source, -symbols and to make -brief_table work. 37* Modified 23 September 1980 by G. Palter to allow absentee queue 4, add new Fortran control arguments, add "-ind" for 38* "-indent", use the site-settable default absentee queue as the default queue, and use the highest numbered dprint 39* queue when there is no dprint queue corresponding to the absentee queue. 40* Modified 14 October 1980 by G. Palter to add negative control arguments for PL/I and "-no_table" for PL/I, Fortran, and 41* COBOL. 42* Modified 20 May 1981 by EBush to add "-nsb" and "-target" to ALM. 43* Modified 2 Feb 1982 by Richard Wendland (SWURCC, Bath University, England) to handle Algol 68. 44* Modified 5 Dec 1983 by C Spitzer. add MR10.2 fortran control arguments. 45* Modified 18 Oct 1983 by S. Herbst to add pascal_abs (psa) 46**/ 47 48 /* format: style3,ll122 */ 49 50 pl1_abs: 51 pa: 52 procedure options (variable); 53 54 /* automatic */ 55 56 dcl abs_args_list_len fixed bin (21); 57 dcl abs_args_list_ptr pointer; 58 dcl abs_args_list_space char (256) varying; 59 dcl absentee_queue char (1); 60 dcl absentee_queue_n fixed bin; /* default absentee queue */ 61 dcl alm_arguments_collection 62 bit (1) aligned; /* collecting arguments to the assembly */ 63 dcl areap ptr; 64 dcl argcount fixed bin; 65 dcl arglen fixed bin (21); 66 dcl argno fixed bin; 67 dcl argp ptr; 68 dcl argu_auto char (24); 69 dcl checkdir char (168); 70 dcl checkent char (32); 71 dcl code fixed bin (35); 72 dcl curarg char (32); 73 dcl default_absentee_queue 74 bit (1) aligned; 75 dcl dp_args_list_len fixed bin (21); 76 dcl dp_args_list_ptr pointer; 77 dcl dp_args_list_space char (256) varying; 78 dcl dprint_queue char (1); 79 dcl error_sw bit (1) aligned; 80 dcl first_entryname char (32); 81 dcl function char (7); 82 dcl function_abs char (32); 83 dcl hold char (6) varying; 84 dcl i fixed bin; 85 dcl 1 lang, /* must init here because of multiple entries */ 86 2 algol68 bit (1) initial ("0"b), 87 2 alm bit (1) initial ("0"b), 88 2 cobol bit (1) initial ("0"b), 89 2 fortran bit (1) initial ("0"b), 90 2 pl1 bit (1) initial ("0"b), 91 2 pascal bit (1) initial ("0"b); 92 dcl limit_no pic "(9)z9"; 93 dcl limit_sw bit (1) aligned; 94 dcl no_of_copies_str char (1); 95 dcl out_file char (168); 96 dcl outsw bit (1) aligned; 97 dcl request_type char (32); 98 dcl 1 saw, 99 2 optimize bit (1), 100 2 safe_ot bit (1), 101 2 full_ot bit (1), 102 2 subscriptrange bit (1), 103 2 stringrange bit (1), 104 2 card bit (1), 105 2 ln bit (1), 106 2 ansi66 bit (1), 107 2 ansi77 bit (1), 108 2 quote bit (1), 109 2 point bit (1); 110 dcl segname_list_len fixed bin (21); 111 dcl segname_list_ptr pointer; 112 dcl segname_list_space char (256) varying; 113 dcl temp fixed bin (35); 114 115 /* based */ 116 117 dcl abs_args_list char (abs_args_list_len) varying based (abs_args_list_ptr); 118 dcl argu char (arglen) based (argp); 119 dcl digit_pic pic "9" based; 120 dcl dp_args_list char (dp_args_list_len) varying based (dp_args_list_ptr); 121 dcl segname_list char (segname_list_len) varying based (segname_list_ptr); 122 dcl system_area area based (areap); 123 124 /* builtin */ 125 126 dcl (addr, binary, codeptr, convert, hbound, index, lbound, length, 127 ltrim, max, maxlength, rtrim, string) 128 builtin; 129 130 /* condition */ 131 132 dcl cleanup condition; 133 134 /* internal static */ 135 136 dcl SP char (1) internal static options (constant) initial (" "); 137 dcl opt_table (29) char (12) internal static options (constant) 138 initial ("-list", "-ls", "-map", "-brief", "-bf", "-check", "-ck", "-table", "-tb", 139 "-brief_table", "-bftb", "-time", "-tm", "-debug", "-db", "-optimize", "-ot", "-profile", 140 "-pf", "-severity1", "-severity2", "-severity3", "-severity4", "-sv1", "-sv2", "-sv3", 141 "-sv4", "-no_table", "-ntb"); 142 143 /* external static */ 144 145 dcl error_table_$noarg fixed bin (35) external static; 146 dcl error_table_$badopt fixed bin (35) external static; 147 dcl error_table_$inconsistent 148 fixed bin (35) external static; 149 150 /* entry */ 151 152 dcl absolute_pathname_ entry (char (*), char (*), fixed bin (35)); 153 dcl com_err_ entry options (variable); 154 dcl com_err_$suppress_name 155 entry options (variable); 156 dcl cu_$arg_count entry (fixed bin, fixed bin (35)); 157 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); 158 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 159 dcl cv_oct_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 160 dcl enter_abs_request entry options (variable); 161 dcl expand_pathname_$add_suffix 162 entry (char (*), char (*), char (*), char (*), fixed bin (35)); 163 dcl get_system_free_area_ 164 entry returns (ptr); 165 dcl get_wdir_ entry returns (char (168) aligned); 166 dcl hcs_$fs_get_path_name 167 entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); 168 dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); 169 dcl ioa_ entry options (variable); 170 dcl iod_info_$generic_type 171 entry (char (*), char (32), fixed bin (35)); 172 dcl iod_info_$queue_data 173 entry (char (*), fixed bin, fixed bin, fixed bin (35)); 174 dcl requote_string_ entry (char (*)) returns (char (*)); 175 dcl suffixed_name_$new_suffix 176 entry (char (*), char (*), char (*), char (32), fixed bin (35)); 177 dcl system_info_$default_absentee_queue 178 entry (fixed bin); 179 dcl system_type_ entry (char (*), char (*), fixed bin (17), fixed bin (35)); 180 181 /* format: inddcls */ 182 183 /* program */ 184 185 lang.pl1 = "1"b; 186 function = "pl1"; 187 function_abs = "pl1_abs"; 188 goto START; 189 190 alm_abs: 191 aa: 192 entry options (variable); 193 194 lang.alm = "1"b; 195 function = "alm"; 196 function_abs = "alm_abs"; 197 goto START; 198 199 fortran_abs: 200 fa: 201 entry options (variable); 202 203 lang.fortran = "1"b; 204 function = "fortran"; 205 function_abs = "fortran_abs"; 206 goto START; 207 208 cobol_abs: 209 cba: 210 entry options (variable); 211 212 lang.cobol = "1"b; 213 function = "cobol"; 214 function_abs = "cobol_abs"; 215 goto START; 216 217 algol68_abs: 218 a68a: 219 entry options (variable); 220 221 lang.algol68 = "1"b; 222 function = "algol68"; 223 function_abs = "algol68_abs"; 224 goto START; 225 226 pascal_abs: 227 psa: 228 entry options (variable); 229 230 lang.pascal = "1"b; 231 function = "pascal"; 232 function_abs = "pascal_abs"; 233 goto START; 234 235 START: 236 areap = get_system_free_area_ (); 237 238 abs_args_list_space = ""; 239 abs_args_list_ptr = addr (abs_args_list_space); 240 abs_args_list_len = maxlength (abs_args_list_space); 241 242 alm_arguments_collection = "0"b; 243 default_absentee_queue = "1"b; 244 245 dp_args_list_space = ""; 246 dp_args_list_ptr = addr (dp_args_list_space); 247 dp_args_list_len = maxlength (dp_args_list_space); 248 249 error_sw = "0"b; 250 hold = "dprint"; /* dprint listing when done */ 251 limit_sw = "0"b; /* no absentee timer limit */ 252 no_of_copies_str = "1"; 253 outsw = "0"b; /* -output_file not used */ 254 request_type = "printer"; 255 256 segname_list_space = ""; 257 segname_list_ptr = addr (segname_list_space); 258 segname_list_len = maxlength (segname_list_space); 259 260 call system_info_$default_absentee_queue (absentee_queue_n); 261 if absentee_queue_n = 0 262 then absentee_queue_n = 3; /* default default absentee queue */ 263 absentee_queue = convert (digit_pic, absentee_queue_n); 264 dprint_queue = absentee_queue; 265 266 call cu_$arg_count (argcount, code); 267 if code ^= 0 268 then do; 269 call com_err_ (code, function_abs); 270 return; 271 end; 272 273 if argcount = 0 274 then do; 275 call com_err_$suppress_name (0, function_abs, "Usage: ^a paths {^a_args} {dp_args} {-control_args}", 276 function_abs, function); 277 return; 278 end; 279 280 on cleanup call cleaner_up (); 281 282 283 /* Start looking at arguments */ 284 285 string (saw) = ""b; 286 287 do argno = 1 to argcount; /* Loop ends at ENDLOOP */ 288 call cu_$arg_ptr (argno, argp, arglen, code); 289 if code ^= 0 290 then do; 291 call com_err_ (code, function_abs, "Argument ^d.", argno); 292 goto REQUEST_NOT_SUBMITTED; 293 end; 294 295 curarg = argu; 296 297 if alm_arguments_collection 298 then do; /* add this argument without interpretation */ 299 call add_requoted (argu, abs_args_list_ptr, abs_args_list_len, addr (abs_args_list_space)); 300 goto ENDLOOP; 301 end; 302 303 else if index (argu, "-") ^= 1 304 then begin; 305 dcl bitcnt fixed bin (24); 306 dcl type fixed bin (2); 307 308 call expand_pathname_$add_suffix (argu, function, checkdir, checkent, code); 309 if code ^= 0 310 then do; 311 call com_err_ (code, function_abs, "^a", argu); 312 goto REQUEST_NOT_SUBMITTED; 313 end; 314 315 call hcs_$status_minf (checkdir, checkent, 1, type, bitcnt, code); 316 if code ^= 0 317 then do; 318 call com_err_ (code, function_abs, "^a>^a", checkdir, checkent); 319 error_sw = "1"b; 320 end; 321 322 if segname_list = "" 323 then first_entryname = checkent; 324 325 call add_requoted (argu, segname_list_ptr, segname_list_len, addr (segname_list_space)); 326 goto ENDLOOP; 327 end; 328 329 /* Check for absentee control arguments */ 330 331 else if argu = "-hold" | argu = "-hd" 332 then do; 333 hold = "hold"; 334 goto ENDLOOP; 335 end; 336 337 else if argu = "-limit" | argu = "-li" 338 then do; 339 limit_sw = "1"b; 340 argno = argno + 1; 341 call cu_$arg_ptr (argno, argp, arglen, code); 342 if code ^= 0 343 then goto TOO_FEW_ARGS; 344 345 temp = cv_dec_check_ (argu, code); 346 if code ^= 0 | temp <= 0 347 then do; 348 call com_err_ (0, function_abs, "Invalid limit. ^a", argu); 349 goto REQUEST_NOT_SUBMITTED; 350 end; 351 352 limit_no = temp; 353 goto ENDLOOP; 354 end; 355 356 else if argu = "-queue" | argu = "-q" 357 then do; 358 argno = argno + 1; 359 call cu_$arg_ptr (argno, argp, arglen, code); 360 if code ^= 0 361 then goto TOO_FEW_ARGS; 362 363 temp = cv_dec_check_ (argu, code); 364 if code = 0 & 1 <= temp & temp <= 4 365 then absentee_queue = convert (digit_pic, temp); 366 else do; 367 call com_err_ (0, function_abs, "Invalid queue number. ^a", argu); 368 goto REQUEST_NOT_SUBMITTED; 369 end; 370 371 default_absentee_queue = "0"b; 372 dprint_queue = absentee_queue; 373 goto ENDLOOP; 374 end; 375 376 else if argu = "-output_file" | argu = "-of" 377 then do; 378 argno = argno + 1; 379 call cu_$arg_ptr (argno, argp, arglen, code); 380 if code ^= 0 381 then goto TOO_FEW_ARGS; 382 383 call absolute_pathname_ (argu, out_file, code); 384 if code ^= 0 385 then do; 386 call com_err_ (code, function_abs, "^a", argu); 387 goto REQUEST_NOT_SUBMITTED; 388 end; 389 390 outsw = "1"b; 391 goto ENDLOOP; 392 end; 393 394 /* Is this a dprint option? */ 395 396 else if argu = "-notify" | argu = "-nt" | argu = "-single" | argu = "-sg" | argu = "-no_endpage" 397 | argu = "-nep" | argu = "-non_edited" | argu = "-ned" | argu = "-access_label" 398 | argu = "-albl" | argu = "-truncate" | argu = "-tc" | argu = "-no_label" | argu = "-nlbl" 399 then do; 400 call add (argu, dp_args_list_ptr, dp_args_list_len, addr (dp_args_list_space)); 401 goto ENDLOOP; 402 end; 403 404 else if argu = "-destination" | argu = "-ds" | argu = "-header" | argu = "-he" | argu = "-label" 405 | argu = "-lbl" | argu = "-top_label" | argu = "-tlbl" | argu = "-bottom_label" | argu = "-blbl" 406 then do; 407 call add (argu, dp_args_list_ptr, dp_args_list_len, addr (dp_args_list_space)); 408 argno = argno + 1; 409 call cu_$arg_ptr (argno, argp, arglen, code); 410 if code ^= 0 411 then goto TOO_FEW_ARGS; 412 413 call add_requoted (argu, dp_args_list_ptr, dp_args_list_len, addr (dp_args_list_space)); 414 goto ENDLOOP; 415 end; 416 417 else if argu = "-request_type" | argu = "-rqt" 418 then begin; 419 dcl gen_type char (32); 420 421 call add (argu, dp_args_list_ptr, dp_args_list_len, addr (dp_args_list_space)); 422 argno = argno + 1; 423 call cu_$arg_ptr (argno, argp, arglen, code); 424 if code ^= 0 425 then goto TOO_FEW_ARGS; 426 427 call iod_info_$generic_type (argu, gen_type, code); 428 if code ^= 0 429 then do; 430 call com_err_ (code, function_abs, "Request type ^a.", argu); 431 goto REQUEST_NOT_SUBMITTED; 432 end; 433 434 if gen_type ^= "printer" 435 then do; 436 call com_err_ (0, function_abs, "Request type ^a is not for the printer.", argu); 437 goto REQUEST_NOT_SUBMITTED; 438 end; 439 440 request_type = argu; 441 call add (argu, dp_args_list_ptr, dp_args_list_len, addr (dp_args_list_space)); 442 goto ENDLOOP; 443 end; 444 445 else if argu = "-line_length" | argu = "-ll" 446 then do; 447 call add (argu, dp_args_list_ptr, dp_args_list_len, addr (dp_args_list_space)); 448 argno = argno + 1; 449 call cu_$arg_ptr (argno, argp, arglen, code); 450 if code ^= 0 451 then goto TOO_FEW_ARGS; 452 453 temp = cv_dec_check_ (argu, code); 454 if code ^= 0 | temp < 2 | temp > 136 455 then do; 456 call com_err_ (0, function_abs, "Invalid line length. ^a", argu); 457 goto REQUEST_NOT_SUBMITTED; 458 end; 459 460 call add (argu, dp_args_list_ptr, dp_args_list_len, addr (dp_args_list_space)); 461 goto ENDLOOP; 462 end; 463 464 else if argu = "-page_length" | argu = "-pl" 465 then do; 466 call add (argu, dp_args_list_ptr, dp_args_list_len, addr (dp_args_list_space)); 467 argno = argno + 1; 468 call cu_$arg_ptr (argno, argp, arglen, code); 469 if code ^= 0 470 then goto TOO_FEW_ARGS; 471 472 temp = cv_dec_check_ (argu, code); 473 if code ^= 0 | temp < 2 | temp > 66 474 then do; 475 call com_err_ (0, function_abs, "Invalid page length. ^a", argu); 476 goto REQUEST_NOT_SUBMITTED; 477 end; 478 479 call add (argu, dp_args_list_ptr, dp_args_list_len, addr (dp_args_list_space)); 480 goto ENDLOOP; 481 end; 482 483 else if argu = "-indent" | argu = "-ind" | argu = "-in" 484 then do; 485 call add (argu, dp_args_list_ptr, dp_args_list_len, addr (dp_args_list_space)); 486 argno = argno + 1; 487 call cu_$arg_ptr (argno, argp, arglen, code); 488 if code ^= 0 489 then goto TOO_FEW_ARGS; 490 491 temp = cv_dec_check_ (argu, code); 492 if code ^= 0 | temp < 1 | temp > 136 493 then do; 494 call com_err_ (0, function_abs, "Invalid indentation. ^a", argu); 495 goto REQUEST_NOT_SUBMITTED; 496 end; 497 498 call add (argu, dp_args_list_ptr, dp_args_list_len, addr (dp_args_list_space)); 499 goto ENDLOOP; 500 end; 501 502 else if argu = "-copy" | argu = "-cp" 503 then do; 504 argno = argno + 1; 505 call cu_$arg_ptr (argno, argp, arglen, code); 506 if code ^= 0 507 then goto TOO_FEW_ARGS; 508 509 temp = cv_dec_check_ (argu, code); 510 if code = 0 & 1 <= temp & temp <= 4 511 then no_of_copies_str = convert (digit_pic, temp); 512 else do; 513 call ioa_ (0, function_abs, "Invalid number of copies. ^a", argu); 514 goto REQUEST_NOT_SUBMITTED; 515 end; 516 517 goto ENDLOOP; 518 end; 519 520 /* Check for compiler control arguments */ 521 522 else if lang.pl1 523 then if argu = "-check_ansi" | argu = "-separate_static" | argu = "-ss" | argu = "-source" | argu = "-sc" 524 | argu = "-symbols" | argu = "-sb" | argu = "-single_symbol_list" | argu = "-ssl" 525 | argu = "-long_profile" | argu = "-lpf" | argu = "-long" | argu = "-lg" | argu = "-no_check" 526 | argu = "-nck" | argu = "-no_check_ansi" | argu = "-no_list" | argu = "-nls" 527 | argu = "-no_optimize" | argu = "-not" | argu = "-no_profile" | argu = "-npf" 528 | argu = "-no_separate_static" | argu = "-nss" | argu = "-no_debug" | argu = "-ndb" 529 | argu = "-no_time" | argu = "-ntm" 530 then goto FOUND_IT; 531 else if argu = "-prefix" 532 then do; 533 call add (argu, abs_args_list_ptr, abs_args_list_len, addr (abs_args_list_space)); 534 argno = argno + 1; 535 call cu_$arg_ptr (argno, argp, arglen, code); 536 if code ^= 0 537 then goto TOO_FEW_ARGS; 538 539 call add_requoted (argu, abs_args_list_ptr, abs_args_list_len, addr (abs_args_list_space)); 540 goto ENDLOOP; 541 end; 542 else ; 543 544 else if lang.fortran 545 then if argu = "-fold" | argu = "-round" | argu = "-truncate" | argu = "-relocatable" | argu = "-rlc" 546 | argu = "-time_ot" | argu = "-non_relocatable" | argu = "-nrlc" | argu = "-auto" 547 | argu = "-auto_zero" | argu = "-check_multiply" | argu = "-ckmpy" | argu = "-default_full" 548 | argu = "-dff" | argu = "-default_safe" | argu = "-dfs" | argu = "-free" 549 | argu = "-large_array" | argu = "-la" | argu = "-long" | argu = "-lg" | argu = "-long_profile" 550 | argu = "-lpf" | argu = "-no_auto_zero" | argu = "-no_check" | argu = "-nck" 551 | argu = "-no_check_multiply" | argu = "-nckmpy" | argu = "-no_fold" | argu = "-no_large_array" 552 | argu = "-nla" | argu = "-no_map" | argu = "-no_version" | argu = "-no_very_large_array" 553 | argu = "-nvla" | argu = "-no_vla_parm" | argu = "-static" | argu = "-version" 554 | argu = "-very_large_array" | argu = "-vla" | argu = "-vla_parm" | argu = "-top_down" 555 then goto FOUND_IT; 556 else if argu = "-ansi66" 557 then do; 558 saw.ansi66 = "1"b; 559 goto FOUND_IT; 560 end; 561 else if argu = "-ansi77" 562 then do; 563 saw.ansi77 = "1"b; 564 goto FOUND_IT; 565 end; 566 else if argu = "-card" 567 then do; 568 saw.card = "1"b; 569 goto FOUND_IT; 570 end; 571 else if argu = "-line_numbers" | argu = "-ln" 572 then do; 573 saw.ln = "1"b; 574 goto FOUND_IT; 575 end; 576 else if argu = "-no_line_numbers" | argu = "-nln" 577 then do; 578 saw.ln = "0"b; 579 goto FOUND_IT; 580 end; 581 else if argu = "-optimize" | argu = "-ot" 582 then do; 583 saw.optimize = "1"b; 584 goto FOUND_IT; 585 end; 586 else if argu = "-safe_optimize" | argu = "-safe_ot" 587 then do; 588 saw.safe_ot = "1"b; 589 goto FOUND_IT; 590 end; 591 else if argu = "-full_optimize" | argu = "-full_ot" 592 then do; 593 saw.full_ot = "1"b; 594 goto FOUND_IT; 595 end; 596 else if argu = "-no_optimize" | argu = "-not" 597 then do; 598 saw.optimize, saw.safe_ot, saw.full_ot = "0"b; 599 goto FOUND_IT; 600 end; 601 else if argu = "-subscriptrange" | argu = "-subrg" 602 then do; 603 saw.subscriptrange = "1"b; 604 goto FOUND_IT; 605 end; 606 else if argu = "-no_subscriptrange" | argu = "-nsubrg" 607 then do; 608 saw.subscriptrange = "0"b; 609 goto FOUND_IT; 610 end; 611 else if argu = "-stringrange" | argu = "-strg" 612 then do; 613 saw.stringrange = "1"b; 614 goto FOUND_IT; 615 end; 616 else if argu = "-no_stringrange" | argu = "-nstrg" 617 then do; 618 saw.stringrange = "0"b; 619 goto FOUND_IT; 620 end; 621 else ; 622 623 else if lang.alm 624 then if argu = "-list" | argu = "-ls" | argu = "-no_symbols" | argu = "-nsb" | argu = "-brief" 625 | argu = "-bf" 626 then goto FOUND_IT; 627 else if argu = "-target" | argu = "-tgt" 628 then do; 629 call add (argu, abs_args_list_ptr, abs_args_list_len, addr (abs_args_list_space)); 630 argno = argno + 1; 631 call cu_$arg_ptr (argno, argp, arglen, code); 632 if code ^= 0 633 then goto TOO_FEW_ARGS; 634 635 argu_auto = argu; 636 call system_type_ (argu_auto, (""), (0), code); 637 if code ^= 0 638 then do; 639 call com_err_ (code, function_abs, argu); 640 goto REQUEST_NOT_SUBMITTED; 641 end; 642 else do; 643 call add (argu, abs_args_list_ptr, abs_args_list_len, addr (abs_args_list_space)); 644 goto ENDLOOP; 645 end; 646 end; 647 else if argu = "-arguments" | argu = "-ag" 648 then do; 649 alm_arguments_collection = "1"b; 650 goto FOUND_IT; 651 end; 652 else goto UNREC_OPT; 653 654 else if lang.cobol 655 then if argu = "-format" | argu = "-fmt" | argu = "-runtime_check" | argu = "-rck" | argu = "-level1" 656 | argu = "-lev1" | argu = "-level2" | argu = "-lev2" | argu = "-level3" | argu = "-lev3" 657 | argu = "-level4" | argu = "-lev4" | argu = "-level5" | argu = "-lev5" | argu = "-expand" 658 | argu = "-exp" 659 then goto FOUND_IT; 660 else if argu = "-brief_table" | argu = "-bftb" | argu = "-optimize" | argu = "-ot" 661 then goto UNREC_OPT; /* cobol lacks these */ 662 else if argu = "-temp_dir" | argu = "-td" 663 then do; 664 call add (argu, abs_args_list_ptr, abs_args_list_len, addr (abs_args_list_space)); 665 argno = argno + 1; 666 call cu_$arg_ptr (argno, argp, arglen, code); 667 if code ^= 0 668 then goto TOO_FEW_ARGS; 669 670 call absolute_pathname_ (argu, "", code); 671 if code ^= 0 672 then do; 673 call com_err_ (code, function_abs, "^a", argu); 674 goto REQUEST_NOT_SUBMITTED; 675 end; 676 677 call add_requoted (argu, abs_args_list_ptr, abs_args_list_len, addr (abs_args_list_space)); 678 goto ENDLOOP; 679 end; 680 else; 681 682 else if lang.algol68 683 then if argu = "-severity0" | argu = "-sv0" | argu = "no_out_check" | argu = "-nock" 684 | argu = "-source" | argu = "-sc" | argu = "-no_list" | argu = "-nls" | argu = "no_check" 685 | argu = "-nck" 686 then goto FOUND_IT; 687 else if argu = "-brief" | argu = "-bf" | argu = "-optimize" | argu = "-ot" | argu = "-time" 688 | argu = "-tm" | argu = "-profile" | argu = "-pf" 689 then goto UNREC_OPT; 690 else if argu = "-card" 691 then do; 692 saw.card = "1"b; 693 goto FOUND_IT; 694 end; 695 else if argu = "-quote" 696 then do; 697 saw.quote = "1"b; 698 goto FOUND_IT; 699 end; 700 else if argu = "-point" 701 then do; 702 saw.point = "1"b; 703 goto FOUND_IT; 704 end; 705 else if argu = "-debug" | argu = "-db" 706 then do; 707 call add (argu, abs_args_list_ptr, abs_args_list_len, addr (abs_args_list_space)); 708 argno = argno + 1; 709 call cu_$arg_ptr (argno, argp, arglen, code); 710 if code ^= 0 711 then goto TOO_FEW_ARGS; 712 713 temp = cv_oct_check_ (argu, code); 714 if code ^= 0 715 then do; 716 call com_err_ (0, function_abs, 717 "Invalid octal number ^a supplied for -debug.", argu); 718 goto REQUEST_NOT_SUBMITTED; 719 end; 720 721 goto FOUND_IT; 722 end; 723 else; 724 725 else if lang.pascal 726 then if argu = "-add_exportable_names" | argu = "-aen" | argu = "-brief_map" | argu = "-bfm" 727 | argu = "-conditional_execution" | argu = "-cond" | argu = "-english" 728 | argu = "-error_messages" | argu = "-em" | argu = "-french" 729 | argu = "-full_extensions" | argu = "-full" | argu = "-interactive" | argu = "-int" 730 | argu = "-io_warnings" | argu = "-iow" | argu = "-long_profile" | argu = "-lpf" 731 | argu = "-no_debug" | argu = "-ndb" | argu = "-no_error_messages" | argu = "-nem" 732 | argu = "-no_interactive" | argu = "-nint" | argu = "-no_io_warnings" | argu = "-niow" 733 | argu = "-no_list" | argu = "-no_long_profile" | argu = "-nlpf" 734 | argu = "-no_private_storage" | argu = "-nps" | argu = "-no_profile" | argu = "-npf" 735 | argu = "-no_relocatable" | argu = "-nonrelocatable" | argu = "-nrlc" 736 | argu = "-no_standard" | argu = "-nonstandard" | argu = "-ns" 737 | argu = "-private_storage" | argu = "-ps" | argu = "-relocatable" | argu = "-rlc" 738 | argu = "-sol_extensions" | argu = "-sol" | argu = "-standard" 739 then goto FOUND_IT; 740 else; 741 742 743 do i = lbound (opt_table, 1) to hbound (opt_table, 1) while (argu ^= opt_table (i)); 744 end; 745 746 if i > hbound (opt_table, 1) 747 then goto UNREC_OPT; 748 749 FOUND_IT: 750 call add (argu, abs_args_list_ptr, abs_args_list_len, addr (abs_args_list_space)); 751 752 ENDLOOP: 753 end; 754 755 if saw.optimize & saw.safe_ot 756 then do; 757 call com_err_ (error_table_$inconsistent, function_abs, "-optimize and -safe_optimize"); 758 error_sw = "1"b; /* keep issuing messages */ 759 end; 760 761 if saw.optimize & saw.full_ot 762 then do; 763 call com_err_ (error_table_$inconsistent, function_abs, "-optimize and -full_optimize"); 764 error_sw = "1"b; 765 end; 766 767 if saw.full_ot & saw.safe_ot 768 then do; 769 call com_err_ (error_table_$inconsistent, function_abs, "-full_ot and -safe_ot"); 770 error_sw = "1"b; 771 end; 772 773 if saw.full_ot & saw.subscriptrange 774 then do; 775 call com_err_ (error_table_$inconsistent, function_abs, "-full_ot and -subscriptrange"); 776 error_sw = "1"b; 777 end; 778 779 if (saw.optimize & saw.subscriptrange) | (saw.safe_ot & saw.subscriptrange) 780 then do; 781 call com_err_ (error_table_$inconsistent, function_abs, 782 "^[-optimize^;-safe_optimize^] and -subscriptrange", saw.optimize); 783 error_sw = "1"b; 784 end; 785 786 if (saw.optimize & saw.stringrange) | (saw.safe_ot & saw.stringrange) 787 then do; 788 call com_err_ (error_table_$inconsistent, function_abs, 789 "^[-optimize^;-safe_optimize^] and -stringrange", saw.optimize); 790 error_sw = "1"b; 791 end; 792 793 if saw.ansi66 & saw.ansi77 794 then do; 795 call com_err_ (error_table_$inconsistent, function_abs, "-ansi66 and -ansi77"); 796 error_sw = "1"b; 797 end; 798 799 if saw.card & saw.ln 800 then do; 801 call com_err_ (error_table_$inconsistent, function_abs, "-card and -line_numbers"); 802 error_sw = "1"b; 803 end; 804 805 if saw.quote & saw.point 806 then do; 807 call com_err_ (error_table_$inconsistent, function_abs, "Only one form of stropping allowed."); 808 error_sw = "1"b; 809 end; 810 811 if saw.card & ^(saw.quote | saw.point) & lang.algol68 812 then do; 813 call com_err_ (error_table_$noarg, function_abs, "-card cannot be used without stropping."); 814 error_sw = "1"b; 815 end; 816 817 if error_sw 818 then goto REQUEST_NOT_SUBMITTED; 819 820 if segname_list = "" 821 then do; 822 call com_err_ (0, function_abs, "No segments to compile."); 823 goto REQUEST_NOT_SUBMITTED; 824 end; 825 826 if ^outsw 827 then do; 828 call suffixed_name_$new_suffix (first_entryname, function, "absout", checkent, code); 829 if code ^= 0 830 then do; 831 call com_err_ (code, function_abs, "^a with absout suffix.", first_entryname); 832 goto REQUEST_NOT_SUBMITTED; 833 end; 834 835 out_file = checkent; 836 end; 837 838 begin; 839 dcl default_queue fixed bin; 840 dcl max_queue fixed bin; 841 842 call iod_info_$queue_data (request_type, default_queue, max_queue, code); 843 if code ^= 0 844 then do; 845 call com_err_ (code, function_abs, "Request type ^a.", request_type); 846 goto REQUEST_NOT_SUBMITTED; 847 end; 848 849 if default_absentee_queue /* user didn't specify queue: use default without warnings */ 850 then dprint_queue = convert (digit_pic, default_queue); 851 852 if binary (dprint_queue, 17) < 1 | max_queue < binary (dprint_queue, 17) 853 then do; 854 call com_err_ (0, function_abs, 855 "Request type ^a does not have queue ^a. Dprint queue ^d assumed.", request_type, 856 dprint_queue, max_queue); 857 dprint_queue = convert (digit_pic, max_queue); 858 end; 859 end; 860 861 call hcs_$fs_get_path_name (codeptr (pl1_abs), checkdir, i, checkent, code); 862 863 if limit_sw 864 then call enter_abs_request (rtrim (checkdir) || ">translator_absin", "-queue", absentee_queue, "-restart", 865 "-output_file", rtrim (out_file), "-limit", ltrim (limit_no), "-arguments", rtrim (get_wdir_ ()), 866 rtrim (function), dprint_queue, (hold), no_of_copies_str, ltrim (segname_list), ltrim (abs_args_list), 867 ltrim (dp_args_list)); 868 869 else call enter_abs_request (rtrim (checkdir) || ">translator_absin", "-queue", absentee_queue, "-restart", 870 "-output_file", rtrim (out_file), "-arguments", rtrim (get_wdir_ ()), rtrim (function), dprint_queue, 871 (hold), no_of_copies_str, ltrim (segname_list), ltrim (abs_args_list), ltrim (dp_args_list)); 872 873 call cleaner_up; 874 875 return; 876 877 878 TOO_FEW_ARGS: 879 call com_err_ (code, function_abs, "After ^a.", curarg); 880 goto REQUEST_NOT_SUBMITTED; 881 882 UNREC_OPT: 883 call com_err_ (error_table_$badopt, function_abs, "^a", argu); 884 goto REQUEST_NOT_SUBMITTED; 885 886 REQUEST_NOT_SUBMITTED: 887 call com_err_ (0, function_abs, "Absentee request not submitted."); 888 call cleaner_up; 889 890 return; 891 892 /* format: ^inddcls */ 893 894 /* Add the argument to one of the arbitrarily lengthed output strings */ 895 896 add: 897 procedure (argument, output_ptr, output_len, output_space); 898 899 dcl argument character (*) parameter; 900 dcl output_ptr pointer parameter; 901 dcl output_len fixed binary (21) parameter; 902 dcl output_space pointer parameter; 903 dcl requote_argument bit (1) aligned; 904 dcl new_min_maxlength fixed binary (21); 905 dcl old_output_len fixed binary (21); 906 dcl old_output_ptr pointer; 907 dcl output_string character (output_len) varying based (output_ptr); 908 dcl old_output_string character (old_output_len) varying based (old_output_ptr); 909 910 requote_argument = "0"b; 911 goto START_ADDITION; 912 913 add_requoted: 914 entry (argument, output_ptr, output_len, output_space); 915 916 requote_argument = "1"b; 917 918 START_ADDITION: 919 new_min_maxlength = length (output_string) + length (SP) + length (argument); 920 if requote_argument /* room for possible requoting */ 921 then new_min_maxlength = new_min_maxlength + length (argument) + 2; 922 923 if new_min_maxlength > output_len 924 then do; /* need to make more space */ 925 old_output_ptr = output_ptr; 926 old_output_len = output_len; 927 output_len = max (2 * output_len, new_min_maxlength); 928 allocate output_string in (system_area) set (output_ptr); 929 output_string = old_output_string; 930 if old_output_ptr ^= output_space 931 then free old_output_string in (system_area); 932 end; 933 934 output_string = output_string || SP; 935 936 if requote_argument 937 then output_string = output_string || requote_string_ (argument); 938 else output_string = output_string || argument; 939 940 return; 941 942 end add; 943 944 945 946 cleaner_up: 947 procedure; 948 949 if abs_args_list_ptr ^= addr (abs_args_list_space) 950 then free abs_args_list in (system_area); 951 if dp_args_list_ptr ^= addr (dp_args_list_space) 952 then free dp_args_list in (system_area); 953 if segname_list_ptr ^= addr (segname_list_space) 954 then free segname_list in (system_area); 955 956 return; 957 958 end cleaner_up; 959 960 end pl1_abs; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/06/88 1029.0 pl1_abs.pl1 >spec>install>1133>pl1_abs.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. SP 011714 constant char(1) initial packed unaligned dcl 136 ref 918 934 abs_args_list based varying char dcl 117 ref 863 863 869 869 949 abs_args_list_len 000100 automatic fixed bin(21,0) dcl 56 set ref 240* 299* 533* 539* 629* 643* 664* 677* 707* 749* 949 abs_args_list_ptr 000102 automatic pointer dcl 57 set ref 239* 299* 533* 539* 629* 643* 664* 677* 707* 749* 863 863 869 869 949 949 abs_args_list_space 000104 automatic varying char(256) dcl 58 set ref 238* 239 240 299 299 533 533 539 539 629 629 643 643 664 664 677 677 707 707 749 749 949 absentee_queue 000205 automatic char(1) packed unaligned dcl 59 set ref 263* 264 364* 372 863* 869* absentee_queue_n 000206 automatic fixed bin(17,0) dcl 60 set ref 260* 261 261* 263 absolute_pathname_ 000016 constant entry external dcl 152 ref 383 670 addr builtin function dcl 126 ref 239 246 257 299 299 325 325 400 400 407 407 413 413 421 421 441 441 447 447 460 460 466 466 479 479 485 485 498 498 533 533 539 539 629 629 643 643 664 664 677 677 707 707 749 749 949 951 953 algol68 000460 automatic bit(1) initial level 2 packed packed unaligned dcl 85 set ref 85* 221* 682 811 alm 0(01) 000460 automatic bit(1) initial level 2 packed packed unaligned dcl 85 set ref 85* 194* 623 alm_arguments_collection 000207 automatic bit(1) dcl 61 set ref 242* 297 649* ansi66 0(07) 000551 automatic bit(1) level 2 packed packed unaligned dcl 98 set ref 558* 793 ansi77 0(08) 000551 automatic bit(1) level 2 packed packed unaligned dcl 98 set ref 563* 793 areap 000210 automatic pointer dcl 63 set ref 235* 928 930 949 951 953 argcount 000212 automatic fixed bin(17,0) dcl 64 set ref 266* 273 287 arglen 000213 automatic fixed bin(21,0) dcl 65 set ref 288* 295 299 299 303 308 308 311 311 325 325 331 331 337 337 341* 345 345 348 348 356 356 359* 363 363 367 367 376 376 379* 383 383 386 386 396 396 396 396 396 396 396 396 396 396 396 396 396 396 400 400 404 404 404 404 404 404 404 404 404 404 407 407 409* 413 413 417 417 421 421 423* 427 427 430 430 436 436 440 441 441 445 445 447 447 449* 453 453 456 456 460 460 464 464 466 466 468* 472 472 475 475 479 479 483 483 483 485 485 487* 491 491 494 494 498 498 502 502 505* 509 509 513 513 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 531 533 533 535* 539 539 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 556 561 566 571 571 576 576 581 581 586 586 591 591 596 596 601 601 606 606 611 611 616 616 623 623 623 623 623 623 627 627 629 629 631* 635 639 639 643 643 647 647 654 654 654 654 654 654 654 654 654 654 654 654 654 654 654 654 660 660 660 660 662 662 664 664 666* 670 670 673 673 677 677 682 682 682 682 682 682 682 682 682 682 687 687 687 687 687 687 687 687 690 695 700 705 705 707 707 709* 713 713 716 716 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 743 749 749 882 882 argno 000214 automatic fixed bin(17,0) dcl 66 set ref 287* 288* 291* 340* 340 341* 358* 358 359* 378* 378 379* 408* 408 409* 422* 422 423* 448* 448 449* 467* 467 468* 486* 486 487* 504* 504 505* 534* 534 535* 630* 630 631* 665* 665 666* 708* 708 709* argp 000216 automatic pointer dcl 67 set ref 288* 295 299 303 308 311 325 331 331 337 337 341* 345 348 356 356 359* 363 367 376 376 379* 383 386 396 396 396 396 396 396 396 396 396 396 396 396 396 396 400 404 404 404 404 404 404 404 404 404 404 407 409* 413 417 417 421 423* 427 430 436 440 441 445 445 447 449* 453 456 460 464 464 466 468* 472 475 479 483 483 483 485 487* 491 494 498 502 502 505* 509 513 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 531 533 535* 539 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 556 561 566 571 571 576 576 581 581 586 586 591 591 596 596 601 601 606 606 611 611 616 616 623 623 623 623 623 623 627 627 629 631* 635 639 643 647 647 654 654 654 654 654 654 654 654 654 654 654 654 654 654 654 654 660 660 660 660 662 662 664 666* 670 673 677 682 682 682 682 682 682 682 682 682 682 687 687 687 687 687 687 687 687 690 695 700 705 705 707 709* 713 716 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 743 749 882 argu based char packed unaligned dcl 118 set ref 295 299* 303 308* 311* 325* 331 331 337 337 345* 348* 356 356 363* 367* 376 376 383* 386* 396 396 396 396 396 396 396 396 396 396 396 396 396 396 400* 404 404 404 404 404 404 404 404 404 404 407* 413* 417 417 421* 427* 430* 436* 440 441* 445 445 447* 453* 456* 460* 464 464 466* 472* 475* 479* 483 483 483 485* 491* 494* 498* 502 502 509* 513* 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 522 531 533* 539* 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 544 556 561 566 571 571 576 576 581 581 586 586 591 591 596 596 601 601 606 606 611 611 616 616 623 623 623 623 623 623 627 627 629* 635 639* 643* 647 647 654 654 654 654 654 654 654 654 654 654 654 654 654 654 654 654 660 660 660 660 662 662 664* 670* 673* 677* 682 682 682 682 682 682 682 682 682 682 687 687 687 687 687 687 687 687 690 695 700 705 705 707* 713* 716* 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 725 743 749* 882* argu_auto 000220 automatic char(24) packed unaligned dcl 68 set ref 635* 636* argument parameter char packed unaligned dcl 899 set ref 896 913 918 920 936* 938 binary builtin function dcl 126 ref 852 852 bitcnt 000667 automatic fixed bin(24,0) dcl 305 set ref 315* card 0(05) 000551 automatic bit(1) level 2 packed packed unaligned dcl 98 set ref 568* 692* 799 811 checkdir 000226 automatic char(168) packed unaligned dcl 69 set ref 308* 315* 318* 861* 863 869 checkent 000300 automatic char(32) packed unaligned dcl 70 set ref 308* 315* 318* 322 828* 835 861* cleanup 000660 stack reference condition dcl 132 ref 280 cobol 0(02) 000460 automatic bit(1) initial level 2 packed packed unaligned dcl 85 set ref 85* 212* 654 code 000310 automatic fixed bin(35,0) dcl 71 set ref 266* 267 269* 288* 289 291* 308* 309 311* 315* 316 318* 341* 342 345* 346 359* 360 363* 364 379* 380 383* 384 386* 409* 410 423* 424 427* 428 430* 449* 450 453* 454 468* 469 472* 473 487* 488 491* 492 505* 506 509* 510 535* 536 631* 632 636* 637 639* 666* 667 670* 671 673* 709* 710 713* 714 828* 829 831* 842* 843 845* 861* 878* codeptr builtin function dcl 126 ref 861 861 com_err_ 000020 constant entry external dcl 153 ref 269 291 311 318 348 367 386 430 436 456 475 494 639 673 716 757 763 769 775 781 788 795 801 807 813 822 831 845 854 878 882 886 com_err_$suppress_name 000022 constant entry external dcl 154 ref 275 convert builtin function dcl 126 ref 263 364 510 849 857 cu_$arg_count 000024 constant entry external dcl 156 ref 266 cu_$arg_ptr 000026 constant entry external dcl 157 ref 288 341 359 379 409 423 449 468 487 505 535 631 666 709 curarg 000311 automatic char(32) packed unaligned dcl 72 set ref 295* 878* cv_dec_check_ 000030 constant entry external dcl 158 ref 345 363 453 472 491 509 cv_oct_check_ 000032 constant entry external dcl 159 ref 713 default_absentee_queue 000321 automatic bit(1) dcl 73 set ref 243* 371* 849 default_queue 000701 automatic fixed bin(17,0) dcl 839 set ref 842* 849 digit_pic based picture(1) packed unaligned dcl 119 ref 263 364 510 849 857 dp_args_list based varying char dcl 120 ref 863 863 869 869 951 dp_args_list_len 000322 automatic fixed bin(21,0) dcl 75 set ref 247* 400* 407* 413* 421* 441* 447* 460* 466* 479* 485* 498* 951 dp_args_list_ptr 000324 automatic pointer dcl 76 set ref 246* 400* 407* 413* 421* 441* 447* 460* 466* 479* 485* 498* 863 863 869 869 951 951 dp_args_list_space 000326 automatic varying char(256) dcl 77 set ref 245* 246 247 400 400 407 407 413 413 421 421 441 441 447 447 460 460 466 466 479 479 485 485 498 498 951 dprint_queue 000427 automatic char(1) packed unaligned dcl 78 set ref 264* 372* 849* 852 852 854* 857* 863* 869* enter_abs_request 000034 constant entry external dcl 160 ref 863 869 error_sw 000430 automatic bit(1) dcl 79 set ref 249* 319* 758* 764* 770* 776* 783* 790* 796* 802* 808* 814* 817 error_table_$badopt 000012 external static fixed bin(35,0) dcl 146 set ref 882* error_table_$inconsistent 000014 external static fixed bin(35,0) dcl 147 set ref 757* 763* 769* 775* 781* 788* 795* 801* 807* error_table_$noarg 000010 external static fixed bin(35,0) dcl 145 set ref 813* expand_pathname_$add_suffix 000036 constant entry external dcl 161 ref 308 first_entryname 000431 automatic char(32) packed unaligned dcl 80 set ref 322* 828* 831* fortran 0(03) 000460 automatic bit(1) initial level 2 packed packed unaligned dcl 85 set ref 85* 203* 544 full_ot 0(02) 000551 automatic bit(1) level 2 packed packed unaligned dcl 98 set ref 593* 598* 761 767 773 function 000442 automatic char(7) packed unaligned dcl 81 set ref 186* 195* 204* 213* 222* 231* 275* 308* 828* 863 863 869 869 function_abs 000444 automatic char(32) packed unaligned dcl 82 set ref 187* 196* 205* 214* 223* 232* 269* 275* 275* 291* 311* 318* 348* 367* 386* 430* 436* 456* 475* 494* 513* 639* 673* 716* 757* 763* 769* 775* 781* 788* 795* 801* 807* 813* 822* 831* 845* 854* 878* 882* 886* gen_type 000671 automatic char(32) packed unaligned dcl 419 set ref 427* 434 get_system_free_area_ 000040 constant entry external dcl 163 ref 235 get_wdir_ 000042 constant entry external dcl 165 ref 863 863 869 869 hbound builtin function dcl 126 ref 743 746 hcs_$fs_get_path_name 000044 constant entry external dcl 166 ref 861 hcs_$status_minf 000046 constant entry external dcl 168 ref 315 hold 000454 automatic varying char(6) dcl 83 set ref 250* 333* 863 869 i 000457 automatic fixed bin(17,0) dcl 84 set ref 743* 743* 746 861* index builtin function dcl 126 ref 303 ioa_ 000050 constant entry external dcl 169 ref 513 iod_info_$generic_type 000052 constant entry external dcl 170 ref 427 iod_info_$queue_data 000054 constant entry external dcl 172 ref 842 lang 000460 automatic structure level 1 packed packed unaligned dcl 85 lbound builtin function dcl 126 ref 743 length builtin function dcl 126 ref 918 918 918 920 limit_no 000461 automatic picture(10) packed unaligned dcl 92 set ref 352* 863 863 limit_sw 000464 automatic bit(1) dcl 93 set ref 251* 339* 863 ln 0(06) 000551 automatic bit(1) level 2 packed packed unaligned dcl 98 set ref 573* 578* 799 ltrim builtin function dcl 126 ref 863 863 863 863 863 863 863 863 869 869 869 869 869 869 max builtin function dcl 126 ref 927 max_queue 000702 automatic fixed bin(17,0) dcl 840 set ref 842* 852 854* 857 maxlength builtin function dcl 126 ref 240 247 258 new_min_maxlength 000713 automatic fixed bin(21,0) dcl 904 set ref 918* 920* 920 923 927 no_of_copies_str 000465 automatic char(1) packed unaligned dcl 94 set ref 252* 510* 863* 869* old_output_len 000714 automatic fixed bin(21,0) dcl 905 set ref 926* 930 old_output_ptr 000716 automatic pointer dcl 906 set ref 925* 929 930 930 old_output_string based varying char dcl 908 ref 929 930 opt_table 000000 constant char(12) initial array packed unaligned dcl 137 ref 743 743 743 746 optimize 000551 automatic bit(1) level 2 packed packed unaligned dcl 98 set ref 583* 598* 755 761 779 781* 786 788* out_file 000466 automatic char(168) packed unaligned dcl 95 set ref 383* 835* 863 863 869 869 output_len parameter fixed bin(21,0) dcl 901 set ref 896 913 923 926 927* 927 928 929 934 936 938 output_ptr parameter pointer dcl 900 set ref 896 913 918 925 928* 929 934 934 936 936 938 938 output_space parameter pointer dcl 902 ref 896 913 930 output_string based varying char dcl 907 set ref 918 928 929* 934* 934 936* 936 938* 938 outsw 000540 automatic bit(1) dcl 96 set ref 253* 390* 826 pascal 0(05) 000460 automatic bit(1) initial level 2 packed packed unaligned dcl 85 set ref 85* 230* 725 pl1 0(04) 000460 automatic bit(1) initial level 2 packed packed unaligned dcl 85 set ref 85* 185* 522 point 0(10) 000551 automatic bit(1) level 2 packed packed unaligned dcl 98 set ref 702* 805 811 quote 0(09) 000551 automatic bit(1) level 2 packed packed unaligned dcl 98 set ref 697* 805 811 request_type 000541 automatic char(32) packed unaligned dcl 97 set ref 254* 440* 842* 845* 854* requote_argument 000712 automatic bit(1) dcl 903 set ref 910* 916* 920 936 requote_string_ 000056 constant entry external dcl 174 ref 936 rtrim builtin function dcl 126 ref 863 863 863 863 863 863 863 869 869 869 869 869 869 869 safe_ot 0(01) 000551 automatic bit(1) level 2 packed packed unaligned dcl 98 set ref 588* 598* 755 767 779 786 saw 000551 automatic structure level 1 packed packed unaligned dcl 98 set ref 285* segname_list based varying char dcl 121 ref 322 820 863 863 869 869 953 segname_list_len 000552 automatic fixed bin(21,0) dcl 110 set ref 258* 325* 953 segname_list_ptr 000554 automatic pointer dcl 111 set ref 257* 322 325* 820 863 863 869 869 953 953 segname_list_space 000556 automatic varying char(256) dcl 112 set ref 256* 257 258 325 325 953 string builtin function dcl 126 set ref 285* stringrange 0(04) 000551 automatic bit(1) level 2 packed packed unaligned dcl 98 set ref 613* 618* 786 786 subscriptrange 0(03) 000551 automatic bit(1) level 2 packed packed unaligned dcl 98 set ref 603* 608* 773 779 779 suffixed_name_$new_suffix 000060 constant entry external dcl 175 ref 828 system_area based area(1024) dcl 122 ref 928 930 949 951 953 system_info_$default_absentee_queue 000062 constant entry external dcl 177 ref 260 system_type_ 000064 constant entry external dcl 179 ref 636 temp 000657 automatic fixed bin(35,0) dcl 113 set ref 345* 346 352 363* 364 364 364 453* 454 454 472* 473 473 491* 492 492 509* 510 510 510 713* type 000670 automatic fixed bin(2,0) dcl 306 set ref 315* NAMES DECLARED BY EXPLICIT CONTEXT. ENDLOOP 007274 constant label dcl 752 ref 300 326 334 353 373 391 401 414 442 461 480 499 517 540 644 678 FOUND_IT 007244 constant label dcl 749 ref 522 544 559 564 569 574 579 584 589 594 599 604 609 614 619 623 650 654 682 693 698 703 721 725 REQUEST_NOT_SUBMITTED 011351 constant label dcl 886 ref 292 312 349 368 387 431 437 457 476 495 514 640 674 718 817 823 832 846 880 884 START 001750 constant label dcl 235 ref 188 197 206 215 224 233 START_ADDITION 011431 constant label dcl 918 ref 911 TOO_FEW_ARGS 011265 constant label dcl 878 set ref 342 360 380 410 424 450 469 488 506 536 632 667 710 UNREC_OPT 011316 constant label dcl 882 ref 647 660 687 746 a68a 001671 constant entry external dcl 217 aa 001561 constant entry external dcl 190 add 011403 constant entry internal dcl 896 ref 400 407 421 441 447 460 466 479 485 498 533 629 643 664 707 749 add_requoted 011416 constant entry internal dcl 913 ref 299 325 413 539 677 algol68_abs 001701 constant entry external dcl 217 alm_abs 001571 constant entry external dcl 190 cba 001641 constant entry external dcl 208 cleaner_up 011610 constant entry internal dcl 946 ref 280 873 888 cobol_abs 001651 constant entry external dcl 208 fa 001611 constant entry external dcl 199 fortran_abs 001621 constant entry external dcl 199 pa 001532 constant entry external dcl 50 pascal_abs 001731 constant entry external dcl 226 pl1_abs 001542 constant entry external dcl 50 ref 861 861 psa 001721 constant entry external dcl 226 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 12324 12412 11716 12334 Length 12702 11716 66 253 405 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME pa 987 external procedure is an external procedure. on unit on line 280 64 on unit begin block on line 303 begin block shares stack frame of external procedure pa. begin block on line 417 begin block shares stack frame of external procedure pa. begin block on line 838 begin block shares stack frame of external procedure pa. add internal procedure shares stack frame of external procedure pa. cleaner_up 70 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME pa 000100 abs_args_list_len pa 000102 abs_args_list_ptr pa 000104 abs_args_list_space pa 000205 absentee_queue pa 000206 absentee_queue_n pa 000207 alm_arguments_collection pa 000210 areap pa 000212 argcount pa 000213 arglen pa 000214 argno pa 000216 argp pa 000220 argu_auto pa 000226 checkdir pa 000300 checkent pa 000310 code pa 000311 curarg pa 000321 default_absentee_queue pa 000322 dp_args_list_len pa 000324 dp_args_list_ptr pa 000326 dp_args_list_space pa 000427 dprint_queue pa 000430 error_sw pa 000431 first_entryname pa 000442 function pa 000444 function_abs pa 000454 hold pa 000457 i pa 000460 lang pa 000461 limit_no pa 000464 limit_sw pa 000465 no_of_copies_str pa 000466 out_file pa 000540 outsw pa 000541 request_type pa 000551 saw pa 000552 segname_list_len pa 000554 segname_list_ptr pa 000556 segname_list_space pa 000657 temp pa 000667 bitcnt begin block on line 303 000670 type begin block on line 303 000671 gen_type begin block on line 417 000701 default_queue begin block on line 838 000702 max_queue begin block on line 838 000712 requote_argument add 000713 new_min_maxlength add 000714 old_output_len add 000716 old_output_ptr add THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp call_ext_out_desc call_ext_out call_int_this call_int_other return_mac enable_op shorten_stack ext_entry int_entry any_to_any_truncate_ op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. absolute_pathname_ com_err_ com_err_$suppress_name cu_$arg_count cu_$arg_ptr cv_dec_check_ cv_oct_check_ enter_abs_request expand_pathname_$add_suffix get_system_free_area_ get_wdir_ hcs_$fs_get_path_name hcs_$status_minf ioa_ iod_info_$generic_type iod_info_$queue_data requote_string_ suffixed_name_$new_suffix system_info_$default_absentee_queue system_type_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$inconsistent error_table_$noarg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 85 001513 50 001531 185 001550 186 001552 187 001554 188 001557 190 001560 194 001577 195 001601 196 001604 197 001607 199 001610 203 001627 204 001631 205 001634 206 001637 208 001640 212 001657 213 001661 214 001664 215 001667 217 001670 221 001707 222 001711 223 001714 224 001717 226 001720 230 001737 231 001741 232 001744 233 001747 235 001750 238 001757 239 001760 240 001762 242 001764 243 001765 245 001767 246 001770 247 001772 249 001773 250 001774 251 002001 252 002002 253 002004 254 002005 256 002010 257 002011 258 002013 260 002015 261 002024 263 002030 264 002042 266 002043 267 002054 269 002056 270 002073 273 002074 275 002076 277 002132 280 002133 285 002155 287 002157 288 002167 289 002204 291 002206 292 002237 295 002240 297 002245 299 002247 300 002277 303 002300 308 002313 309 002347 311 002351 312 002403 315 002404 316 002443 318 002445 319 002477 322 002501 325 002512 326 002542 303 002543 331 002544 333 002555 334 002561 337 002562 339 002572 340 002574 341 002575 342 002612 345 002614 346 002637 348 002643 349 002677 352 002700 353 002707 356 002710 358 002720 359 002721 360 002736 363 002740 364 002763 367 003006 368 003045 371 003046 372 003047 373 003050 376 003051 378 003061 379 003062 380 003077 383 003101 384 003125 386 003127 387 003161 390 003162 391 003164 396 003165 400 003260 401 003310 404 003311 407 003361 408 003410 409 003411 410 003426 413 003430 414 003460 417 003461 421 003471 422 003521 423 003522 424 003537 427 003541 428 003565 430 003567 431 003625 434 003626 436 003632 437 003666 440 003667 441 003674 442 003724 417 003725 445 003726 447 003736 448 003765 449 003766 450 004003 453 004005 454 004030 456 004037 457 004076 460 004077 461 004127 464 004130 466 004140 467 004167 468 004170 469 004205 472 004207 473 004232 475 004241 476 004300 479 004301 480 004331 483 004332 485 004346 486 004375 487 004376 488 004413 491 004415 492 004440 494 004447 495 004506 498 004507 499 004537 502 004540 504 004550 505 004551 506 004566 509 004570 510 004613 513 004636 514 004672 517 004673 522 004674 531 005057 533 005063 534 005112 535 005113 536 005130 539 005132 540 005162 542 005163 544 005164 556 005435 558 005441 559 005443 561 005444 563 005450 564 005452 566 005453 568 005457 569 005461 571 005462 573 005472 574 005474 576 005475 578 005505 579 005507 581 005510 583 005520 584 005522 586 005523 588 005533 589 005535 591 005536 593 005546 594 005550 596 005551 598 005561 599 005567 601 005570 603 005600 604 005602 606 005603 608 005613 609 005615 611 005616 613 005626 614 005630 616 005631 618 005641 619 005643 621 005644 623 005645 627 005700 629 005710 630 005737 631 005740 632 005755 635 005757 636 005764 637 006012 639 006014 640 006040 643 006041 644 006071 647 006072 649 006102 650 006104 651 006105 654 006106 660 006211 662 006231 664 006241 665 006270 666 006271 667 006306 670 006310 671 006334 673 006336 674 006370 677 006371 678 006421 680 006422 682 006423 687 006476 690 006536 692 006542 693 006544 695 006545 697 006551 698 006553 700 006554 702 006560 703 006562 705 006563 707 006573 708 006622 709 006623 710 006640 713 006642 714 006665 716 006667 718 006723 721 006724 723 006725 725 006726 743 007221 744 007237 746 007241 749 007244 752 007274 755 007276 757 007302 758 007326 761 007330 763 007334 764 007360 767 007362 769 007366 770 007415 773 007417 775 007423 776 007447 779 007451 781 007466 783 007516 786 007520 788 007535 790 007565 793 007567 795 007573 796 007622 799 007624 801 007630 802 007657 805 007661 807 007667 808 007713 811 007715 813 007731 814 007755 817 007757 820 007761 822 007767 823 010017 826 010020 828 010022 829 010054 831 010056 832 010110 835 010111 842 010114 843 010140 845 010142 846 010174 849 010175 852 010211 854 010226 857 010266 861 010300 863 010333 869 010723 873 011257 875 011264 878 011265 880 011315 882 011316 884 011350 886 011351 888 011376 890 011402 896 011403 910 011414 911 011415 913 011416 916 011427 918 011431 920 011437 923 011444 925 011446 926 011450 927 011452 928 011457 929 011471 930 011502 934 011514 936 011526 938 011572 940 011606 946 011607 949 011615 951 011633 953 011651 956 011667 ----------------------------------------------------------- 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