COMPILATION LISTING OF SEGMENT map355 Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1628.3 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 map355: 12 procedure (); 13 14 15 /* "map355" -- command to assemble a Macro Assembly for */ 16 /* the DataNet-355 computer. This assembly process is */ 17 /* currently performed by invoking the GCOS simulator. This */ 18 /* particular method has the drawbacks that 1) it tends to use */ 19 /* features of the Honeywell/6180 which Multics does not use */ 20 /* (and thus are more unlikely to work properly) and 2) it */ 21 /* uses the GCOS simulator which is actually designed for use */ 22 /* by the GCOS Daemon. It is this particular problem which */ 23 /* causes this program to do such things as link to things */ 24 /* in the process directory (to get temporary segments). */ 25 26 /* Originally coded by D. M. Wells in Spring, 1973. */ 27 /* Modified by D. M. Wells in February, 1974, to prepare */ 28 /* for installation. */ 29 /* Modified by T. Casey, May 1974, for compatibility with new */ 30 /* gcos simulator. */ 31 /* Modified by M. Grady, May, 1976, to fix core size and */ 32 /* cleanup code. */ 33 /* Modified by Robert coren, April, 1978, to supply severity value */ 34 35 36 37 /* * * * * PARAMETER DECLARATIONS * * * * * * * */ 38 39 /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ 40 41 declare 42 ((num_args, pddl) fixed binary (17), 43 (arg_length, bit_count, string_len) fixed binary (24), 44 err_code bit (36) aligned, 45 NP character (1), /* cant put this in a canonicalized file */ 46 ename character (32), 47 dirname character (168), 48 (base_name, job_name, map355_options) character (32) varying, 49 (gcos_list_pathname, list_pathname, macro_file_pathname, jobdeck_pathname, 50 process_dir, source_dir, working_dir, pdd) character (168) varying, 51 argsw bit (1) aligned init ("0"b), 52 args char (200) varying init ("-brief"), 53 var_line char (300) varying init (""), 54 command_line char (300) init (""), 55 (acl_info_ptr, arg_ptr, object_seg_ptr) pointer) 56 automatic; 57 58 declare 59 1 options unaligned automatic, 60 2 only_check bit (1), 61 2 from_comdk bit (1), 62 2 make_comdk bit (1), 63 2 make_list bit (1), 64 2 make_gcos_list bit (1); 65 66 declare 67 1 status aligned automatic, 68 2 error_code bit (36) aligned, 69 2 detail_info unaligned, 70 3 successful_logical_initiation bit (1), 71 3 successful_logical_completion bit (1), 72 3 successful_physical_initiation bit (1), 73 3 successful_physical_completion bit (1), 74 3 transaction_terminated bit (1), 75 3 unassigned_bits_42_to_45 (42 : 45) bit (1), 76 3 end_of_logical_data_indicator bit (1), 77 3 end_of_physical_data_indicator bit (1), 78 3 unassigned_bits_48_to_51 (48 : 51) bit (1), 79 3 stream_name_detached bit (1), 80 3 unassigned_bit_53 bit (1), 81 3 transaction_aborted bit (1), 82 3 transaction_index bit (18); 83 84 /* * * * * TEXT SECTION REFERENCES * * * * * * * */ 85 86 declare 87 NL initial (" 88 ") 89 character (1) internal static; 90 91 declare 92 (comdk_suffix character (6) initial (".comdk"), 93 source_suffix character (7) initial (".map355"), 94 job_deck_stream character (16) initial ("map355_job_deck_")) 95 internal static; 96 97 /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */ 98 99 declare 100 based_argument character (arg_length) 101 based; 102 103 /* * * * * EXTERNAL STATIC DECLARATIONS * * * * */ 104 105 declare 106 error_table_$badopt 107 bit (36) aligned external static; 108 declare 109 map355_severity_ fixed bin (35) ext static; 110 111 /* * * * * ENTRY & PROCEDURE DECLARATIONS * * * */ 112 113 declare 114 adjust_bit_count_ entry (char (168), char (32), bit (1) aligned, fixed bin (24), bit (36) aligned), 115 com_err_ entry options (variable), 116 cu_$arg_count entry (fixed bin (17)), 117 cu_$arg_list_ptr entry () returns (ptr), 118 cu_$arg_ptr_rel entry (fixed bin (17), ptr, fixed bin (24), bit (36) aligned, ptr), 119 cu_$cp ext entry (ptr, fixed bin, bit (36) aligned), 120 delete_$path entry (char (*), char (*), bit (6), char (*), bit (36) aligned), 121 expand_path_ entry (ptr, fixed bin (24), ptr, ptr, bit (36) aligned), 122 get_pdir_ entry () returns (char (168) aligned), 123 get_shortest_pathname_ entry (char (*), char (*), bit (36) aligned), 124 get_wdir_ entry () returns (char (168) aligned), 125 hcs_$append_link entry (char (*), char (*), char (*), bit (36) aligned), 126 hcs_$delentry_file entry (char (*), char (*), bit (36) aligned), 127 hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, bit (36) aligned), 128 hcs_$set_bc entry (char (*), char (*), fixed bin (24), bit (36) aligned), 129 hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), bit (36) aligned), 130 hcs_$terminate_noname entry (ptr, bit (36) aligned), 131 ioa_ entry options (variable), 132 ioa_$ioa_stream entry options (variable), 133 ios_$attach entry (char (*), char (*), char (*), char (*), 1 aligned like status), 134 ios_$detach entry (char (*), char (*), char (*), 1 aligned like status), 135 ios_$seek entry (char (*), char (*), char (*), fixed bin (24), 1 aligned like status), 136 ios_$write_ptr entry (ptr, fixed bin (24), fixed bin (24)), 137 tssi_$finish_segment entry (ptr, fixed bin (24), bit (36) aligned, ptr, bit (36) aligned), 138 tssi_$get_segment entry (char (*), char (*), ptr, ptr, bit (36) aligned); 139 140 declare 141 (addr, divide, index, length, null, reverse, substr, unspec, verify) 142 builtin; 143 144 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 145 146 map355_severity_ = 0; /* initially */ 147 unspec (NP) = "000001100"b; 148 149 dirname = get_pdir_ (); 150 string_len = length (dirname) - verify (reverse (dirname), " ") + 1; 151 process_dir = substr (dirname, 1, string_len); 152 153 dirname = get_wdir_ (); 154 string_len = length (dirname) - verify (reverse (dirname), " ") + 1; 155 working_dir = substr (dirname, 1, string_len); 156 157 call ioa_ ("MAP355"); 158 159 call cu_$arg_count (num_args); 160 161 if num_args = 0 162 then do; 163 call ioa_ ("Usage is:^/^10xmap355 source -options-"); 164 call ioa_ ("Current options are: -list, -comdk, -check, -noconvert, -gcos_list, -macro_file -ag "); 165 map355_severity_ = 2; 166 return; 167 end; 168 169 call process_options (cu_$arg_list_ptr (), num_args); 170 171 pddl = length (process_dir) - index (reverse (process_dir), ">"); /* get length of pdd */ 172 pdd = substr (process_dir, 1, pddl); /* get process dir dir name */ 173 call reduce_path_name (pdd); /* reduce pdd name */ 174 process_dir = pdd || substr (process_dir, pddl + 1); /* reconstruct name */ 175 176 call reduce_path_name (working_dir); 177 call reduce_path_name (source_dir); 178 call reduce_path_name (macro_file_pathname); 179 180 jobdeck_pathname = process_dir || ">" || job_name || ".jobdk_"; 181 182 call ios_$attach ((job_deck_stream), "file_", (jobdeck_pathname), "w", status); 183 if status.error_code ^= ""b 184 then do; 185 err_code = status.error_code; 186 goto print_err_code; 187 end; 188 189 call ios_$seek ((job_deck_stream), "write", "first", 0, status); 190 191 call ioa_$ioa_stream ((job_deck_stream), "$ snumb assm"); 192 call ioa_$ioa_stream ((job_deck_stream), "$ ident 1234,ident"); 193 194 map355_options = ""; 195 if options.only_check 196 then map355_options = map355_options || "ndeck,"; 197 else map355_options = map355_options || "deck,"; 198 if options.make_comdk 199 then map355_options = map355_options || "comdk,"; 200 else map355_options = map355_options || "ncomdk,"; 201 202 map355_options = substr (map355_options, 1, length (map355_options) - 1); 203 call ioa_$ioa_stream ((job_deck_stream), "$ 355map ^a", map355_options); 204 call ioa_$ioa_stream ((job_deck_stream), "$ limits 20,128k 0.20 = 12 minutes"); 205 206 if options.from_comdk 207 then call ioa_$ioa_stream ((job_deck_stream), "$ prmfl g*,r,l,^a>^a.comdk", source_dir, base_name); 208 else do; 209 call ioa_$ioa_stream ((job_deck_stream), "$ data g*"); 210 call ioa_$ioa_stream ((job_deck_stream), "$ select ^a>^a^x-ascii", (source_dir), base_name || 211 source_suffix); 212 end; 213 214 215 call ioa_$ioa_stream ((job_deck_stream), "$ prmfl **,r,r,^a", macro_file_pathname); 216 if options.make_gcos_list 217 then gcos_list_pathname = working_dir || ">" || base_name || ".glist"; 218 else gcos_list_pathname = process_dir || ">" || base_name || ".glist_"; 219 220 call ioa_$ioa_stream ((job_deck_stream), "$ prmfl p*,r/w,l,^a", gcos_list_pathname); 221 222 if ^ options.only_check 223 then call ioa_$ioa_stream ((job_deck_stream), "$ prmfl c*,r/w,l,^a>^a.objdk", working_dir, base_name); 224 225 if options.make_comdk 226 then call ioa_$ioa_stream ((job_deck_stream), "$ prmfl k*,r/w,l,^a>^a.comdk", working_dir, base_name); 227 228 call ioa_$ioa_stream ((job_deck_stream), "$ endjob"); 229 230 call ios_$seek ((job_deck_stream), "bound", "write", 0, status); 231 232 call ios_$detach ((job_deck_stream), "", "", status); 233 234 if ^ options.only_check 235 then do; 236 call tssi_$get_segment ((working_dir), base_name || ".objdk", object_seg_ptr, acl_info_ptr, err_code); 237 if err_code ^= ""b 238 then do; 239 call com_err_ (err_code, "map355", "Attempting to create object segment."); 240 map355_severity_ = 2; 241 return; 242 end; 243 end; 244 245 call hcs_$append_link ((working_dir), (job_name || ".jobdk_.job_deck"), 246 (jobdeck_pathname || ".job_deck"), err_code); 247 248 var_line = "gcos " || jobdeck_pathname || " -hd -tnc " || args; 249 command_line = var_line; 250 call cu_$cp (addr (command_line), length (var_line), err_code); 251 252 if options.make_list 253 then list_pathname = working_dir || ">" || base_name || ".list"; 254 else list_pathname = process_dir || ">" || base_name || ".list_"; 255 256 var_line = "gcos_sysprint " || gcos_list_pathname || " " || list_pathname || " -lower_case"; 257 command_line = var_line; 258 call cu_$cp (addr (command_line), length (var_line), err_code); 259 260 call check_error_messages ((list_pathname)); 261 262 if ^ options.only_check 263 then do; 264 call adjust_bit_count_ ((working_dir), base_name || ".objdk", "0"b, bit_count, err_code); 265 call tssi_$finish_segment (object_seg_ptr, bit_count, "1000"b, acl_info_ptr, err_code); 266 if err_code ^= ""b 267 then do; 268 call com_err_ (err_code, "map355", "Calling tssi_$finish_segment."); 269 map355_severity_ = 2; 270 return; 271 end; 272 end; 273 274 if options.make_comdk 275 then call abc_new_comdk (); 276 277 dirname = process_dir; /* copy process dir name for calls to hardcore */ 278 279 if ^ options.make_list 280 then call delete_$path (dirname, base_name || ".list_", "100110"b, "map355", err_code); 281 282 if ^ options.from_comdk 283 then call delete_$path (dirname, base_name || ".comdk_", "100110"b, "map355", err_code); 284 285 call hcs_$delentry_file (dirname, job_name || ".jobdk_", err_code); 286 call hcs_$delentry_file (dirname, job_name || ".jobdk_.job_deck", err_code); 287 288 if ^ options.make_gcos_list 289 then call delete_$path (dirname, base_name || ".glist_", "100110"b, "map355", err_code); 290 291 dirname = working_dir; 292 293 call hcs_$delentry_file (dirname, job_name || ".jobdk_.sysprint", err_code); 294 call hcs_$delentry_file (dirname, job_name || ".jobdk_.job_deck", err_code); 295 296 return; 297 298 /* * * * * * * * * * * * * * * * * * * * * * * * */ 299 300 print_err_code: 301 unexpected_error: 302 call com_err_ (err_code, "map355", ""); 303 map355_severity_ = 2; 304 305 return; 306 307 /* * * * * * * * * * * * * * * * * * * * * * * * */ 308 309 path_name_error: 310 call com_err_ ((36)"0"b, "map355", "path_name_error"); 311 312 return_to_caller: 313 map355_severity_ = 2; 314 return; 315 316 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 317 318 reduce_path_name: 319 procedure (bv_path_name); 320 321 /* * * * * PARAMETER DECLARATIONS * * * * * * * */ 322 323 declare 324 bv_path_name character (168) varying 325 parameter; 326 327 /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ 328 329 declare 330 string_len fixed binary (24) 331 automatic; 332 333 /* * * * * * * * * * * * * * * * * * * * * * * * */ 334 335 dirname = bv_path_name; 336 337 call get_shortest_pathname_ (dirname, dirname, err_code); 338 if err_code ^= ""b then goto print_err_code; 339 340 string_len = length (dirname) - verify (reverse (dirname), " ") + 1; 341 bv_path_name = substr (dirname, 1, string_len); 342 343 return; 344 345 end reduce_path_name; 346 347 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 348 349 abc_new_comdk: 350 procedure (); 351 352 /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ 353 354 declare 355 bit_count fixed binary (24) 356 automatic; 357 358 /* * * * * * * * * * * * * * * * * * * * * * * * */ 359 360 call hcs_$status_minf ((working_dir), base_name || ".comdk", 1b, (0), bit_count, err_code); 361 if err_code ^= ""b 362 then do; 363 call com_err_ (err_code, "map355", "unable to set bit count on new comdk"); 364 map355_severity_ = 2; 365 return; 366 end; 367 368 bit_count = divide (bit_count, 36, 24, 0); 369 bit_count = divide (bit_count, 320, 24, 0); 370 bit_count = bit_count * 320; 371 bit_count = bit_count + 320; 372 bit_count = bit_count * 36; 373 374 call hcs_$set_bc ((working_dir), base_name || ".comdk", bit_count, err_code); 375 if err_code ^= ""b 376 then do; 377 call com_err_ (err_code, "map355", "unable to set bit count (^d) on new comdk", bit_count); 378 map355_severity_ = 2; 379 return; 380 end; 381 382 return; 383 384 end abc_new_comdk; 385 386 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 387 388 check_error_messages: 389 procedure (bv_list_pathname); 390 391 /* * * * * PARAMETER DECLARATIONS * * * * * * * */ 392 393 declare 394 bv_list_pathname character (*) 395 parameter; 396 397 /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ 398 399 declare 400 (seg_type fixed binary (2), 401 (message_seg, seg_indx) fixed binary (12), 402 (bit_count, cur_position, last_char, newline_pos, temp_pos, the_end_pos) fixed binary (24), 403 seg_length (0 : 9) fixed binary (24), 404 temp_char character (1), 405 entry_name character (32), 406 dir_name character (168), 407 seg_pointer (0 : 9) pointer) 408 automatic; 409 410 /* * * * * TEXT SECTION REFERENCES * * * * * * * */ 411 412 declare 413 number (0 : 9) character (1) initial ("0", "1", "2", "3", "4", "5", "6", "7", "8", "9") 414 internal static; 415 416 /* * * * * BASED & TEMPLATE REFERENCES * * * * * */ 417 418 declare 419 based_seg character (last_char) 420 based; 421 422 /* * * * * STACK REFERENCES * * * * * * * * * * */ 423 424 declare 425 program_interrupt condition; 426 427 /* * * * * * * * * * * * * * * * * * * * * * * * */ 428 call expand_path_ (addr (bv_list_pathname), length (bv_list_pathname), addr (dir_name), addr (entry_name), 429 err_code); 430 if err_code ^= ""b 431 then goto err; 432 433 call hcs_$status_minf (dir_name, entry_name, 1b, seg_type, bit_count, err_code); 434 /* see if this is a multisegment file */ 435 if err_code ^= ""b 436 then goto err; 437 438 if seg_type = 2 439 then do; /* this is a directory (read: multi-segment file) */ 440 call expand_path_ (addr (bv_list_pathname), length (bv_list_pathname), addr (dir_name), 441 null (), err_code); 442 do seg_indx = 0 to bit_count - 1; 443 call hcs_$initiate_count (dir_name, (number (seg_indx)), "", seg_length (seg_indx), 0, 444 seg_pointer (seg_indx), err_code); 445 if seg_pointer (seg_indx) = null () 446 then goto err; 447 end; 448 449 /* seg_pointer and seg_length arrays now hold addresses and */ 450 /* bit_counts of each of N segs from 0 to N - 1 */ 451 end; 452 else do; 453 bit_count = 1; 454 call hcs_$initiate_count (dir_name, entry_name, "", seg_length (0), 0, seg_pointer (0), err_code); 455 if seg_pointer (0) = null () 456 then goto err; 457 end; 458 459 seg_indx = bit_count; 460 461 cur_position = 0; 462 do while (cur_position = 0); 463 seg_indx = seg_indx - 1; 464 if seg_indx < 0 465 then do; 466 call com_err_ ((36)"0"b, "map355", "can't find assembly error count message"); 467 goto terminate; 468 end; 469 470 last_char = divide (seg_length (seg_indx), 9, 24, 0); /* get char lenth of a seg */ 471 cur_position, the_end_pos = index (seg_pointer (seg_indx) -> based_seg, 472 "warning flags in the above assembly"); 473 /* look for assembly total error count */ 474 end; 475 476 /* Now, character cur_position in segment seg_indx */ 477 /* points to the middle of the error count line, if this */ 478 /* count is non-zero, we also want to print the error lines */ 479 480 message_seg = seg_indx; 481 482 call ios_$write_ptr (seg_pointer (message_seg), cur_position - 19, 54); 483 if substr (seg_pointer (message_seg) -> based_seg, cur_position - 4, 2) ^= "no" 484 then do; /* if there are any errors, print messages */ 485 map355_severity_ = 1; /* and remember the fact */ 486 on program_interrupt /* if user doesn't want to see these lines, */ 487 goto terminate; /* let him suppress the printing of them */ 488 489 do seg_indx = 0 by 1 to message_seg; /* loop to print errors */ 490 last_char = divide (seg_length (seg_indx), 9, 24, 0); /* get char length of a seg */ 491 if seg_indx = 0 492 then do; 493 cur_position = index (substr (seg_pointer (0) -> based_seg, 1, last_char), "program break"); 494 /* don't print alter listing */ 495 if cur_position = 0 496 then do; 497 call com_err_ ((36)"0"b, "map355", "can't find ""program break""."); 498 cur_position = 1; 499 end; 500 end; 501 else cur_position = 1; 502 503 do while (cur_position < last_char); 504 if (seg_indx = message_seg) & (cur_position >= the_end_pos) 505 then goto terminate; /* no need to look further */ 506 507 newline_pos = index (substr (seg_pointer (seg_indx) -> based_seg, cur_position, 508 last_char + 1 - cur_position), NL); 509 if newline_pos = 0 510 then goto done; /* done with this segment */ 511 512 temp_char = substr (seg_pointer (seg_indx) -> based_seg, cur_position + newline_pos, 1); 513 if (temp_char ^= " ") & (temp_char ^= NP) & 514 (index ("0123456789", temp_char) = 0) & (temp_char ^= NL) 515 then do; 516 temp_pos = index (substr (seg_pointer (seg_indx) -> based_seg, 517 cur_position + newline_pos, last_char - cur_position - newline_pos + 1), NL); 518 /* look for next newline */ 519 if temp_pos = 0 520 then temp_pos = last_char - cur_position - newline_pos + 1; /* this indicates */ 521 /* error in last line in seg -- NP */ 522 call ioa_ (substr (seg_pointer (seg_indx) -> based_seg, cur_position + newline_pos, 523 temp_pos - 1)); 524 /* print line in error */ 525 end; 526 cur_position = cur_position + newline_pos; 527 end; 528 done: end; 529 end; 530 531 terminate: 532 revert program_interrupt; 533 534 do seg_indx = 0 to bit_count - 1; 535 call hcs_$terminate_noname (seg_pointer (seg_indx), err_code); 536 end; 537 538 return; 539 540 /* * * * * * * * * * * * * * * * * * * * * * * * */ 541 542 err: 543 call com_err_ (err_code, "map355", "checking for error messages in listing file."); 544 map355_severity_ = 2; /* couldn't find error message, something must be wrong */ 545 546 return; 547 548 end check_error_messages; 549 550 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 551 552 process_options: 553 procedure (bv_arg_list_ptr, bv_num_args); 554 555 /* * * * * PARAMETER DECLARATIONS * * * * * * * */ 556 557 declare 558 (bv_num_args fixed binary (17), 559 bv_arg_list_ptr pointer) 560 parameter; 561 562 /* * * * * AUTOMATIC STORAGE DECLARATIONS * * * */ 563 564 declare 565 (indx fixed binary (17), 566 string_len fixed binary (24)) 567 automatic; 568 569 /* * * * * * * * * * * * * * * * * * * * * * * * */ 570 571 call cu_$arg_ptr_rel (1, arg_ptr, arg_length, err_code, bv_arg_list_ptr); 572 if err_code ^= ""b 573 then goto unexpected_error; 574 575 call expand_path_ (arg_ptr, arg_length, addr (dirname), addr (ename), err_code); 576 if err_code ^= ""b 577 then goto print_err_code; 578 579 string_len = length (dirname) - verify (reverse (dirname), " ") + 1; 580 source_dir = substr (dirname, 1, string_len); 581 582 string_len = length (ename) - verify (reverse (ename), " ") + 1; 583 if options.from_comdk then do; 584 if string_len > length (comdk_suffix) 585 then if substr (ename, string_len + 1 - length (comdk_suffix), length (comdk_suffix)) = comdk_suffix 586 then string_len = string_len - length (comdk_suffix); 587 end; 588 else do; 589 if string_len > length (source_suffix) 590 then if substr (ename, string_len + 1 - length (source_suffix), length (source_suffix)) = source_suffix 591 then string_len = string_len - length (source_suffix); 592 end; 593 594 base_name = substr (ename, 1, string_len); 595 596 if length (base_name) > 11 then 597 job_name = substr (base_name, 1, 11); 598 else job_name = base_name; 599 600 macro_file_pathname = ">ldd>mcs>info>355_macros"; 601 602 options.only_check = "0"b; 603 options.make_comdk = "0"b; 604 options.from_comdk = "0"b; 605 options.make_list = "0"b; 606 options.make_gcos_list = "0"b; 607 608 do indx = 2 by 1 to bv_num_args; 609 call cu_$arg_ptr_rel (indx, arg_ptr, arg_length, err_code, bv_arg_list_ptr); 610 if err_code ^= ""b 611 then goto unexpected_error; 612 613 call process_control_argument (arg_ptr -> based_argument); 614 end; 615 616 return; 617 618 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 619 620 process_control_argument: 621 procedure (bv_control_argument); 622 623 /* * * * * PARAMETER DECLARATIONS * * * * * * * */ 624 625 declare 626 bv_control_argument character (*) 627 parameter; 628 629 /* * * * * * * * * * * * * * * * * * * * * * * * */ 630 631 if argsw then do; 632 args = args || " " || bv_control_argument; 633 return; 634 end; 635 636 if (bv_control_argument = "-ag" | bv_control_argument = "-arguments") then do; 637 argsw = "1"b; 638 args = ""; /* clear the default of -brief */ 639 return; 640 end; 641 642 if bv_control_argument = "-noconvert" 643 then do; 644 options.from_comdk = "1"b; 645 return; 646 end; 647 648 if (bv_control_argument = "-list") | (bv_control_argument = "-ls") 649 then do; 650 options.make_list = "1"b; 651 return; 652 end; 653 654 if bv_control_argument = "-comdk" 655 then do; 656 options.make_comdk = "1"b; 657 return; 658 end; 659 660 if bv_control_argument = "-check" 661 then do; 662 options.only_check = "1"b; 663 return; 664 end; 665 666 if (bv_control_argument = "-gcos_list") | (bv_control_argument = "-gcls") 667 then do; 668 options.make_gcos_list = "1"b; 669 return; 670 end; 671 672 if (bv_control_argument = "-macro_file") 673 then do; 674 indx = indx + 1; 675 call cu_$arg_ptr_rel (indx, arg_ptr, arg_length, err_code, bv_arg_list_ptr); 676 if err_code ^= ""b 677 then do; 678 call com_err_ (err_code, "map355", "getting pathname of macros"); 679 goto return_to_caller; 680 end; 681 call expand_path_ (arg_ptr, arg_length, addr (dirname), null (), err_code); 682 if err_code ^= ""b 683 then do; 684 call com_err_ (err_code, "map355", "Expanding pathname of macro file."); 685 goto return_to_caller; 686 end; 687 macro_file_pathname = dirname; 688 return; 689 end; 690 691 call com_err_ (error_table_$badopt, "map355", bv_control_argument); 692 693 goto return_to_caller; 694 695 end process_control_argument; 696 697 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 698 699 end process_options; 700 701 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 702 703 end map355; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1504.6 map355.pl1 >dumps>old>recomp>map355.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. NL constant char(1) initial unaligned dcl 86 ref 507 513 516 NP 000106 automatic char(1) unaligned dcl 41 set ref 147* 513 acl_info_ptr 001270 automatic pointer dcl 41 set ref 236* 265* addr builtin function dcl 140 ref 250 250 258 258 428 428 428 428 428 428 440 440 440 440 575 575 575 575 681 681 adjust_bit_count_ 000014 constant entry external dcl 113 ref 264 arg_length 000102 automatic fixed bin(24,0) dcl 41 set ref 571* 575* 609* 613 613 675* 681* arg_ptr 001272 automatic pointer dcl 41 set ref 571* 575* 609* 613 675* 681* args 000755 automatic varying char(200) initial dcl 41 set ref 41* 248 632* 632 638* argsw 000754 automatic bit(1) initial dcl 41 set ref 41* 631 637* base_name 000171 automatic varying char(32) dcl 41 set ref 206* 210 216 218 222* 225* 236 252 254 264 279 282 288 360 374 594* 596 596 598 based_argument based char unaligned dcl 99 set ref 613* based_seg based char unaligned dcl 418 ref 471 483 493 507 512 516 522 522 bit_count 000103 automatic fixed bin(24,0) dcl 41 in procedure "map355" set ref 264* 265* bit_count 000103 automatic fixed bin(24,0) dcl 399 in procedure "check_error_messages" set ref 433* 442 453* 459 534 bit_count 001320 automatic fixed bin(24,0) dcl 354 in procedure "abc_new_comdk" set ref 360* 368* 368 369* 369 370* 370 371* 371 372* 372 374* 377* bv_arg_list_ptr parameter pointer dcl 557 set ref 552 571* 609* 675* bv_control_argument parameter char unaligned dcl 625 set ref 620 632 636 636 642 648 648 654 660 666 666 672 691* bv_list_pathname parameter char unaligned dcl 393 set ref 388 428 428 428 428 440 440 440 440 bv_num_args parameter fixed bin(17,0) dcl 557 ref 552 608 bv_path_name parameter varying char(168) dcl 323 set ref 318 335 341* com_err_ 000016 constant entry external dcl 113 ref 239 268 300 309 363 377 466 497 542 678 684 691 comdk_suffix 000012 constant char(6) initial unaligned dcl 91 ref 584 584 584 584 584 command_line 001154 automatic char(300) initial unaligned dcl 41 set ref 41* 249* 250 250 257* 258 258 cu_$arg_count 000020 constant entry external dcl 113 ref 159 cu_$arg_list_ptr 000022 constant entry external dcl 113 ref 169 169 cu_$arg_ptr_rel 000024 constant entry external dcl 113 ref 571 609 675 cu_$cp 000026 constant entry external dcl 113 ref 250 258 cur_position 000104 automatic fixed bin(24,0) dcl 399 set ref 461* 462 471* 482 483 493* 495 498* 501* 503 504 507 507 512 516 516 519 522 522 526* 526 delete_$path 000030 constant entry external dcl 113 ref 279 282 288 dir_name 000134 automatic char(168) unaligned dcl 399 set ref 428 428 433* 440 440 443* 454* dirname 000117 automatic char(168) unaligned dcl 41 set ref 149* 150 150 151 153* 154 154 155 277* 279* 282* 285* 286* 288* 291* 293* 294* 335* 337* 337* 340 340 341 575 575 579 579 580 681 681 687 divide builtin function dcl 140 ref 368 369 470 490 ename 000107 automatic char(32) unaligned dcl 41 set ref 575 575 582 582 584 589 594 entry_name 000124 automatic char(32) unaligned dcl 399 set ref 428 428 433* 454* err_code 000105 automatic bit(36) dcl 41 set ref 185* 236* 237 239* 245* 250* 258* 264* 265* 266 268* 279* 282* 285* 286* 288* 293* 294* 300* 337* 338 360* 361 363* 374* 375 377* 428* 430 433* 435 440* 443* 454* 535* 542* 571* 572 575* 576 609* 610 675* 676 678* 681* 682 684* error_code 001300 automatic bit(36) level 2 dcl 66 set ref 183 185 error_table_$badopt 000010 external static bit(36) dcl 105 set ref 691* expand_path_ 000032 constant entry external dcl 113 ref 428 440 575 681 from_comdk 0(01) 001276 automatic bit(1) level 2 packed unaligned dcl 58 set ref 206 282 583 604* 644* gcos_list_pathname 000224 automatic varying char(168) dcl 41 set ref 216* 218* 220* 256 get_pdir_ 000034 constant entry external dcl 113 ref 149 get_shortest_pathname_ 000036 constant entry external dcl 113 ref 337 get_wdir_ 000040 constant entry external dcl 113 ref 153 hcs_$append_link 000042 constant entry external dcl 113 ref 245 hcs_$delentry_file 000044 constant entry external dcl 113 ref 285 286 293 294 hcs_$initiate_count 000046 constant entry external dcl 113 ref 443 454 hcs_$set_bc 000050 constant entry external dcl 113 ref 374 hcs_$status_minf 000052 constant entry external dcl 113 ref 360 433 hcs_$terminate_noname 000054 constant entry external dcl 113 ref 535 index builtin function dcl 140 ref 171 471 493 507 513 516 indx 001330 automatic fixed bin(17,0) dcl 564 set ref 608* 609* 674* 674 675* ioa_ 000056 constant entry external dcl 113 ref 157 163 164 522 ioa_$ioa_stream 000060 constant entry external dcl 113 ref 191 192 203 204 206 209 210 215 220 222 225 228 ios_$attach 000062 constant entry external dcl 113 ref 182 ios_$detach 000064 constant entry external dcl 113 ref 232 ios_$seek 000066 constant entry external dcl 113 ref 189 230 ios_$write_ptr 000070 constant entry external dcl 113 ref 482 job_deck_stream 000003 constant char(16) initial unaligned dcl 91 ref 182 189 191 192 203 204 206 209 210 215 220 222 225 228 230 232 job_name 000202 automatic varying char(32) dcl 41 set ref 180 245 285 286 293 294 596* 598* jobdeck_pathname 000425 automatic varying char(168) dcl 41 set ref 180* 182 245 248 last_char 000105 automatic fixed bin(24,0) dcl 399 set ref 470* 471 483 490* 493 493 503 507 507 512 516 516 519 522 522 length builtin function dcl 140 ref 150 154 171 202 250 250 258 258 340 428 428 440 440 579 582 584 584 584 584 589 589 589 589 596 list_pathname 000277 automatic varying char(168) dcl 41 set ref 252* 254* 256 260 macro_file_pathname 000352 automatic varying char(168) dcl 41 set ref 178* 215* 600* 687* make_comdk 0(02) 001276 automatic bit(1) level 2 packed unaligned dcl 58 set ref 198 225 274 603* 656* make_gcos_list 0(04) 001276 automatic bit(1) level 2 packed unaligned dcl 58 set ref 216 288 606* 668* make_list 0(03) 001276 automatic bit(1) level 2 packed unaligned dcl 58 set ref 252 279 605* 650* map355_options 000213 automatic varying char(32) dcl 41 set ref 194* 195* 195 197* 197 198* 198 200* 200 202* 202 202 203* map355_severity_ 000012 external static fixed bin(35,0) dcl 108 set ref 146* 165* 240* 269* 303* 312* 364* 378* 485* 544* message_seg 000101 automatic fixed bin(12,0) dcl 399 set ref 480* 482 483 489 504 newline_pos 000106 automatic fixed bin(24,0) dcl 399 set ref 507* 509 512 516 516 519 522 522 526 null builtin function dcl 140 ref 440 440 445 455 681 681 num_args 000100 automatic fixed bin(17,0) dcl 41 set ref 159* 161 169* number 000000 constant char(1) initial array unaligned dcl 412 ref 443 object_seg_ptr 001274 automatic pointer dcl 41 set ref 236* 265* only_check 001276 automatic bit(1) level 2 packed unaligned dcl 58 set ref 195 222 234 262 602* 662* options 001276 automatic structure level 1 packed unaligned dcl 58 pdd 000701 automatic varying char(168) dcl 41 set ref 172* 173* 174 pddl 000101 automatic fixed bin(17,0) dcl 41 set ref 171* 172 174 process_dir 000500 automatic varying char(168) dcl 41 set ref 151* 171 171 172 174* 174 180 218 254 277 program_interrupt 000232 stack reference condition dcl 424 ref 486 531 reverse builtin function dcl 140 ref 150 154 171 340 579 582 seg_indx 000102 automatic fixed bin(12,0) dcl 399 set ref 442* 443 443 443 445* 459* 463* 463 464 470 471 480 489* 490 491 504 507 512 516 522 522* 534* 535* seg_length 000111 automatic fixed bin(24,0) array dcl 399 set ref 443* 454* 470 490 seg_pointer 000206 automatic pointer array dcl 399 set ref 443* 445 454* 455 471 482* 483 493 507 512 516 522 522 535* seg_type 000100 automatic fixed bin(2,0) dcl 399 set ref 433* 438 source_dir 000553 automatic varying char(168) dcl 41 set ref 177* 206* 210 580* source_suffix 000010 constant char(7) initial unaligned dcl 91 ref 210 589 589 589 589 589 status 001300 automatic structure level 1 dcl 66 set ref 182* 189* 230* 232* string_len 001331 automatic fixed bin(24,0) dcl 564 in procedure "process_options" set ref 579* 580 582* 584 584 584* 584 589 589 589* 589 594 string_len 000104 automatic fixed bin(24,0) dcl 41 in procedure "map355" set ref 150* 151 154* 155 string_len 001310 automatic fixed bin(24,0) dcl 329 in procedure "reduce_path_name" set ref 340* 341 substr builtin function dcl 140 ref 151 155 172 174 202 341 483 493 507 512 516 522 522 580 584 589 594 596 temp_char 000123 automatic char(1) unaligned dcl 399 set ref 512* 513 513 513 513 temp_pos 000107 automatic fixed bin(24,0) dcl 399 set ref 516* 519 519* 522 522 the_end_pos 000110 automatic fixed bin(24,0) dcl 399 set ref 471* 504 tssi_$finish_segment 000072 constant entry external dcl 113 ref 265 tssi_$get_segment 000074 constant entry external dcl 113 ref 236 unspec builtin function dcl 140 set ref 147* var_line 001040 automatic varying char(300) initial dcl 41 set ref 41* 248* 249 250 250 256* 257 258 258 verify builtin function dcl 140 ref 150 154 340 579 582 working_dir 000626 automatic varying char(168) dcl 41 set ref 155* 176* 216 222* 225* 236 245 252 264 291 360 374 NAMES DECLARED BY EXPLICIT CONTEXT. abc_new_comdk 004007 constant entry internal dcl 349 ref 274 check_error_messages 004265 constant entry internal dcl 388 ref 260 done 005143 constant label dcl 528 ref 509 err 005173 constant label dcl 542 ref 430 435 445 455 map355 000611 constant entry external dcl 11 path_name_error 003672 constant label dcl 309 print_err_code 003643 constant label dcl 300 set ref 186 338 576 process_control_argument 005505 constant entry internal dcl 620 ref 613 process_options 005226 constant entry internal dcl 552 ref 169 reduce_path_name 003727 constant entry internal dcl 318 ref 173 176 177 178 return_to_caller 003723 constant label dcl 312 ref 679 685 693 terminate 005145 constant label dcl 531 ref 467 486 504 unexpected_error 003643 constant label dcl 300 set ref 572 610 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 6430 6526 6075 6440 Length 6772 6075 76 230 332 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME map355 940 external procedure is an external procedure. reduce_path_name internal procedure shares stack frame of external procedure map355. abc_new_comdk internal procedure shares stack frame of external procedure map355. check_error_messages 242 internal procedure is called during a stack extension, and enables or reverts conditions. on unit on line 486 64 on unit process_options internal procedure shares stack frame of external procedure map355. process_control_argument internal procedure shares stack frame of external procedure map355. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME check_error_messages 000100 seg_type check_error_messages 000101 message_seg check_error_messages 000102 seg_indx check_error_messages 000103 bit_count check_error_messages 000104 cur_position check_error_messages 000105 last_char check_error_messages 000106 newline_pos check_error_messages 000107 temp_pos check_error_messages 000110 the_end_pos check_error_messages 000111 seg_length check_error_messages 000123 temp_char check_error_messages 000124 entry_name check_error_messages 000134 dir_name check_error_messages 000206 seg_pointer check_error_messages map355 000100 num_args map355 000101 pddl map355 000102 arg_length map355 000103 bit_count map355 000104 string_len map355 000105 err_code map355 000106 NP map355 000107 ename map355 000117 dirname map355 000171 base_name map355 000202 job_name map355 000213 map355_options map355 000224 gcos_list_pathname map355 000277 list_pathname map355 000352 macro_file_pathname map355 000425 jobdeck_pathname map355 000500 process_dir map355 000553 source_dir map355 000626 working_dir map355 000701 pdd map355 000754 argsw map355 000755 args map355 001040 var_line map355 001154 command_line map355 001270 acl_info_ptr map355 001272 arg_ptr map355 001274 object_seg_ptr map355 001276 options map355 001300 status map355 001310 string_len reduce_path_name 001320 bit_count abc_new_comdk 001330 indx process_options 001331 string_len process_options THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out call_int_this_desc return tra_ext enable shorten_stack ext_entry int_entry int_entry_desc set_cs_eis index_cs_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. adjust_bit_count_ com_err_ cu_$arg_count cu_$arg_list_ptr cu_$arg_ptr_rel cu_$cp delete_$path expand_path_ get_pdir_ get_shortest_pathname_ get_wdir_ hcs_$append_link hcs_$delentry_file hcs_$initiate_count hcs_$set_bc hcs_$status_minf hcs_$terminate_noname ioa_ ioa_$ioa_stream ios_$attach ios_$detach ios_$seek ios_$write_ptr tssi_$finish_segment tssi_$get_segment THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt map355_severity_ LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000610 41 000616 146 000627 147 000630 149 000632 150 000643 151 000661 153 000670 154 000702 155 000720 157 000727 159 000742 161 000751 163 000753 164 000767 165 001003 166 001006 169 001007 171 001020 172 001035 173 001044 174 001046 176 001073 177 001076 178 001100 180 001102 182 001146 183 001222 185 001225 186 001226 189 001227 191 001272 192 001320 194 001346 195 001347 197 001365 198 001377 200 001415 202 001427 203 001435 204 001472 206 001520 209 001562 210 001610 212 001674 215 001675 216 001732 218 002002 220 002047 222 002102 225 002143 228 002204 230 002233 232 002276 234 002330 236 002333 237 002411 239 002414 240 002442 241 002445 245 002446 248 002537 249 002603 250 002610 252 002627 254 002677 256 002744 257 003020 258 003025 260 003044 262 003064 264 003070 265 003133 266 003155 268 003157 269 003205 270 003210 274 003211 277 003215 279 003221 282 003277 285 003356 286 003416 288 003456 291 003535 293 003542 294 003601 296 003641 300 003643 303 003666 305 003671 309 003672 312 003723 314 003726 318 003727 335 003731 337 003736 338 003755 340 003757 341 003775 343 004006 349 004007 360 004010 361 004076 363 004101 364 004127 365 004132 368 004133 369 004136 370 004140 371 004142 372 004144 374 004147 375 004222 377 004225 378 004257 379 004262 382 004263 388 004264 428 004300 430 004326 433 004331 435 004370 438 004373 440 004376 442 004424 443 004433 445 004504 447 004512 451 004514 453 004515 454 004517 455 004561 459 004565 461 004567 462 004570 463 004572 464 004574 466 004576 467 004626 470 004627 471 004632 474 004645 480 004646 482 004650 483 004672 485 004702 486 004705 489 004724 490 004732 491 004735 493 004737 495 004746 497 004747 498 004777 500 005001 501 005002 503 005004 504 005007 507 005015 509 005036 512 005037 513 005044 516 005071 519 005110 522 005115 525 005137 526 005140 527 005142 528 005143 531 005145 534 005146 535 005155 536 005170 538 005172 542 005173 544 005222 546 005225 552 005226 571 005230 572 005252 575 005254 576 005277 579 005301 580 005317 582 005326 583 005344 584 005347 587 005357 589 005360 594 005370 596 005400 598 005411 600 005416 602 005423 603 005425 604 005427 605 005431 606 005433 608 005435 609 005445 610 005465 613 005467 614 005502 616 005504 620 005505 631 005516 632 005520 633 005556 636 005560 637 005572 638 005574 639 005575 642 005576 644 005602 645 005604 648 005605 650 005615 651 005617 654 005620 656 005624 657 005626 660 005627 662 005633 663 005635 666 005636 668 005646 669 005650 672 005651 674 005655 675 005656 676 005676 678 005700 679 005726 681 005727 682 005752 684 005754 685 006002 687 006003 688 006010 691 006011 693 006035 ----------------------------------------------------------- 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