COMPILATION LISTING OF SEGMENT do_subtree Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1733.9 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 dos: do_subtree: proc; 12 13 /* (walk_subtree) Initially coded in September 1969 by V. Voydock */ 14 /* Converted to pl1 in May 1970 by V. Voydock */ 15 /* Modified on May 4, 1970 at 12:25 midnight by V. Voydock */ 16 /* Modified on January 4, 1971 (to add pi handler) by V. Voydock */ 17 /* Modified on July 8, 1971 by J. Stern 18* Command name changed from "global" to "execute_in_subdirectories". 19* Command format and options changed ("-bottom_up" option added). */ 20 /* Modified Dec 13 1973 by S. Herbst 21* Converted to Version II 22* Names changed to walk_subtree and ws_recursive. 23* Var. length temporary command line. */ 24 /* Bugs fixed 12/9/75 by Steve Herbst: walking through MSF's and 25* cwd in command line changing walk */ 26 27 /* do_subtree built off this umble base, multiprocess circus 28* Just about all of previous "improvements" thrown away, and 29* just about every line changed or recoded somehow, 30* BSG, magister multicis 2/20/77 */ 31 32 dcl (cleanup, da_err_1_, undispatch_err_1_) condition; 33 34 dcl starting_dir char (168); 35 dcl temp_dname char (168); 36 dcl working_dir char (168); 37 dcl command_line char (clng) based (cp), 38 bu_command_line char (buclng) based (buclp), 39 starting_node char (slng) based (sp), /* starting node of subtree of subdirectories */ 40 arg char (lng) based (ap), 41 b36 bit (36) based aligned, 42 myname char (15) static options (constant) init ("do_subtree"), 43 procpicvar pic "99" init (0); /* Varying for &2 */ 44 45 dcl (lng, clng, buclng, slng) fixed bin init (0); /* various lengths for indirect strings */ 46 dcl (level init (0), first_level init (1), last_level init (999)) fixed bin; 47 dcl i fixed bin; 48 49 dcl (nnn, code) fixed bin (35); 50 51 /* This set of flags is initialized from the command line in master process, or only 52* process if that is the case. They are picked up from com seg for slave procs. */ 53 54 dcl (bottom_up_flag init ("0"b), /* 1 => exists bottomup comline */ 55 f_option_flag init ("0"b), /* 1 => -first was used */ 56 top_down_flag init ("0"b), /* 1 => exists topdown comline */ 57 trace_flag init ("0"b), /* 1 => print pathnames (default) */ 58 privf init ("0"b), /* 1 => call hphcs_ instead of hcs_ star */ 59 msff init ("0"b) /* 1 => treat msfs not as dirs */ 60 ) bit (1) aligned; 61 62 63 dcl abort_entry bit (1) aligned init ("0"b); 64 65 dcl (ap, arp, cp, sp, buclp) ptr init (null ()); 66 67 dcl tem_ area based (arp); 68 dcl error_table_$badopt ext fixed bin (35); 69 dcl error_table_$noarg ext fixed bin (35); 70 71 dcl (addr, fixed, null, substr, stacq) builtin, 72 cv_dec_check_ external entry (char (*), fixed bin (35)) returns (fixed bin (35)), 73 cu_$arg_ptr ext entry (fixed bin (17), ptr, fixed bin (17), fixed bin (35)), 74 cu_$arg_count ext entry (fixed bin (17)), 75 get_system_free_area_ ext entry returns (ptr), 76 get_wdir_ external entry returns (char (168)), 77 ioa_ ext entry options (variable), 78 com_err_ ext entry options (variable); 79 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 80 dcl absolute_pathname_ entry (char (*), char (*), fixed bin (35)); 81 82 /* */ 83 84 /* Stuff for multiprocess feature */ 85 86 dcl 1 mpdata based (mpdatap) aligned, /* Element block for one process in circus */ 87 2 pid bit (36) aligned, /* process id */ 88 2 wait_list, /* IPC event channel data */ 89 3 nchan fixed bin, /* 1 */ 90 3 evchn fixed bin (71), /* Event channel on which to wake this px */ 91 2 px fixed bin, /* process index (in array ) */ 92 2 gostac bit (36) aligned, /* Set NZ to "grab" px for dispatch */ 93 2 data_avl bit (36) aligned, /* set when data available */ 94 2 uid (-1:15) fixed bin, /* "cnt" for directories */ 95 2 slevel fixed bin, /* starting "-ft" level */ 96 2 shlev fixed bin, /* starting hierarchy lev of dispatch */ 97 2 dname char (168) varying, /* dirname at dispatch */ 98 2 flags unal, 99 3 ready bit (1), /* px exists */ 100 3 died bit (1); /* known to have failed wakeup */ 101 102 dcl mpdatap ptr; /* process element ptr */ 103 104 dcl 1 global_mpdata based (gmpdata_p) aligned, /* global com seg for 1 circus */ 105 2 startctl bit (36) aligned, /* pid of FIRST guy to join circus */ 106 2 cnt fixed bin (35) aligned, /* tag generator for diirectories */ 107 2 first_hdepth fixed bin, /* starting hierarchy depth */ 108 2 last_hdepth fixed bin, /* finishing hierarchy depph */ 109 2 sfirst fixed bin, /* "-first" stuff */ 110 2 slast fixed bin, /* -last */ 111 2 global_flags unal, 112 3 trace_flag bit (1), /* 1 => print pathnames */ 113 3 top_down_flag bit (1), /* 1 => Exists topdown line */ 114 3 bottom_up_flag bit (1), /* 1 => exists bottomup line */ 115 3 msf_flag bit (1), /* 1 => dont walk msfs */ 116 3 priv_flag bit (1), /* 1 => call hphcs_ */ 117 2 comlinel fixed bin, /* length of topdown line */ 118 2 command_line char (300), /* value of topdown line */ 119 2 bu_comlinel fixed bin, /* length of bottomup line */ 120 2 bu_comline char (300), /* value of bottomup line */ 121 2 stopflags unal, 122 3 eoj bit (1), /* All dirs have been exited => job done */ 123 3 abort bit (1), /* GET OUT OF WATER FAST! */ 124 2 nprocs fixed bin (35) aligned, /* current number of px's */ 125 2 meters, 126 3 executions fixed bin, 127 3 dxeqs fixed bin, 128 3 recursions fixed bin, 129 3 pickups fixed bin, 130 3 dispatches fixed bin, 131 3 decursions fixed bin, 132 3 getworks fixed bin, 133 3 wakeups fixed bin, 134 3 blocks fixed bin, 135 2 perprocess (36) like mpdata aligned, /* Array of process elements */ 136 2 dir_table (1 : global_mpdata.cnt), /* indexed by cnt-generated index */ 137 3 procbits (36) bit (1) unaligned; /* "1"b => process 2sub in dir # 1sub */ 138 139 140 dcl b_comline char (global_mpdata.comlinel) based (addr (global_mpdata.command_line)); 141 dcl b_bu_comline char (global_mpdata.bu_comlinel) based (addr (global_mpdata.bu_comline)); 142 143 dcl gmpdata_p ptr; 144 145 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin, ptr, fixed bin (35)); 146 dcl ipc_$block entry (ptr, ptr, fixed bin (35)); 147 dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); 148 dcl get_process_id_ entry returns (bit (36) aligned); 149 dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)); 150 151 152 dcl hlev fixed bin; 153 dcl px fixed bin; 154 155 dcl my_pid bit (36) aligned; 156 dcl event_msg (4) fixed bin (71); 157 dcl my_px fixed bin; 158 dcl my_evchn fixed bin (71); 159 dcl mpf bit (1) init ("0"b); 160 dcl command_process bit (1) init ("1"b); 161 dcl do entry options (variable); 162 /* */ 163 164 /* Get starting node name */ 165 call cu_$arg_ptr (1, sp, slng, code); 166 if code ^= 0 then do; 167 call com_err_ (code, myname); 168 return; 169 end; 170 171 /* "-wd" => current working directory */ 172 if starting_node = "-wd" then do; 173 working_dir = get_wdir_ (); 174 sp = addr (working_dir); 175 slng = length (rtrim (working_dir)); 176 end; 177 178 179 /* Check for options */ 180 do i = 2 by 1; 181 call cu_$arg_ptr (i, ap, lng, code); 182 if code ^= 0 then go to endopt; 183 184 /* Identify options */ 185 if arg = "-ft" | arg = "-first" | arg = "-last" | arg = "-lt" then do; 186 f_option_flag = substr (arg, 2, 1) = "f"; 187 i = i + 1; 188 call cu_$arg_ptr (i, ap, lng, code); 189 if code ^= 0 then do; 190 call com_err_ (error_table_$noarg, myname, "Level number missing."); 191 return; 192 end; 193 nnn = cv_dec_check_ (arg, code); 194 if code ^= 0 | nnn <= 0 then do; 195 call com_err_ (0, myname, "Bad level number: ^a.", arg); 196 return; 197 end; 198 if f_option_flag then first_level = nnn; 199 else last_level = nnn; 200 end; 201 else if arg = "-td" | arg = "-top_down" then do; 202 i = i + 1; 203 call cu_$arg_ptr (i, cp, clng, code); 204 if code ^= 0 then do; 205 call com_err_ (error_table_$noarg, myname, "Top-down command line missing."); 206 return; 207 end; 208 top_down_flag = "1"b; 209 end; 210 else if arg = "-bu" | arg = "-bottom_up" then do; 211 i = i + 1; 212 call cu_$arg_ptr (i, buclp, buclng, code); 213 if code ^= 0 then do; 214 call com_err_ (error_table_$noarg, myname, "Bottom-up command line missing."); 215 return; 216 end; 217 bottom_up_flag = "1"b; 218 end; 219 else if arg = "-lg" | arg = "-long" then trace_flag = "1"b; 220 else if arg = "-mp" | arg = "-multiprocess" then mpf = "1"b; 221 else if arg = "-priv" then privf = "1"b; 222 else if arg = "-no_msf" then msff = "1"b; 223 else do; 224 call com_err_ (error_table_$badopt, myname, arg); 225 return; 226 end; 227 end; 228 endopt: 229 230 231 /* Control comes here when all arguments have been processed. */ 232 if last_level < first_level then do; 233 code = 0; 234 call com_err_ (0, myname, "Last level (^d) must be >= first level (^d)", last_level, first_level); 235 return; 236 end; 237 238 /* Get area in which star handler can allocate information */ 239 arp = get_system_free_area_ (); 240 241 242 if starting_node = "-slave" then do; 243 command_process = "0"b; 244 starting_dir = starting_node; 245 mpf = "1"b; 246 end; 247 else do; 248 call absolute_pathname_ (starting_node, starting_dir, code); 249 if code ^= 0 then do; 250 call com_err_ (code, myname, starting_node); 251 return; 252 end; 253 end; 254 255 slng = length (rtrim (starting_dir)); 256 sp = addr (starting_dir); /* bind starting-node to starting_dir */ 257 258 if mpf then do; 259 call establish_self_mp; 260 if command_process then call recurse$dispatch (starting_node); 261 call multiprocess_ws; 262 end; 263 else call recurse (starting_node); 264 265 266 return; 267 268 ABORT: call com_err_ (0, myname, "Multiprocess abort signalled."); 269 NLX: return; 270 /* */ 271 272 recurse: proc (node); 273 274 /* Internal procedure to execute the command line set up in the main body of 275* the program at all specified points of the file system hierarchy */ 276 277 /* In a single-process execution, this procedure recurses over the whole specified 278* subtree. In multiprocess executions, each dispatched process calls it to recurse 279* over the dispatch point. It always executes the topdown line: 280* the bottom up line must be scheduled. */ 281 282 283 dcl node char (*); 284 285 dcl (np, ep) ptr init (null); 286 287 dcl dispatch_buf char (168); 288 dcl dispatch_name char (dispatch_namel) based (addr (dispatch_buf)); 289 dcl (k, ecount) fixed bin; 290 291 dcl cnt fixed bin; 292 293 dcl ename char (enamel) based (enamep); 294 dcl enamep ptr; 295 296 dcl (dispatch_namel, enamel) fixed bin; 297 298 dcl code fixed bin (35); 299 300 dcl (hcs_$star_, hphcs_$star_) ext entry (char (*), char (*), fixed bin (2), ptr, fixed bin (17), ptr, ptr, fixed bin (35)); 301 dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); 302 303 dcl bitcount fixed bin (24), type fixed bin (2); 304 305 dcl error_table_$no_s_permission ext fixed bin (35); 306 dcl error_table_$nomatch ext fixed bin (35); 307 308 dcl names (100) char (32) based (np) aligned; 309 310 dcl 1 ent (ecount) based (ep) aligned, 311 2 type bit (2) unaligned, 312 2 nname bit (16) unaligned, 313 2 nindex fixed bin (17) unaligned; 314 315 /* */ 316 317 /* Establish cleanup handler */ 318 on condition (cleanup) begin; 319 if ep ^= null then free ent; 320 if np ^= null then free names; 321 end; 322 323 /* Push level of recursion */ 324 325 if mpf then do; 326 global_mpdata.recursions = global_mpdata.recursions + 1; 327 if global_mpdata.abort then go to ABORT; 328 cnt = stacq_countgen (global_mpdata.cnt); /* get dir id */ 329 /* We are provably the first process to 330* encounter this dir. Generate unique index for it */ 331 addr (global_mpdata.dir_table (cnt)) -> b36 = "0"b; 332 /* err 338, 'string a (2, *) not implemented yet' */ 333 dir_table (cnt).procbits (my_px) = "1"b; /* dir goes busy */ 334 mpdata.uid (hlev) = cnt; 335 hlev = hlev + 1; 336 end; 337 level = level+1; 338 339 /* See if top-down trace is wanted */ 340 341 if top_down_flag then call executor (command_line); 342 343 /* If this is last level then skip looking for subdirectories */ 344 if level >= last_level then ecount, code = 0; 345 346 347 /* Get list of all subdirectories */ 348 else do; 349 if privf then call hphcs_$star_ (node, "**", 2, arp, ecount, ep, np, code); 350 else call hcs_$star_ (node, "**", 2, arp, ecount, ep, np, code); 351 if code ^= 0 then do; 352 ecount = 0; 353 if code ^= error_table_$nomatch 354 then call com_err_ (code, myname, node); 355 end; 356 end; 357 358 359 /* Execute command in all subdirectories which are in range */ 360 do k = 1 to ecount; 361 enamep = addr (names (ent (k).nindex)); 362 enamel = length (rtrim (names (ent (k).nindex))); 363 if is_it_a_dir ((ent (k).type)) then do; 364 365 dispatch_buf = node; 366 if node = ">" then do; 367 substr (dispatch_buf, 2) = ename; 368 dispatch_namel = 1 + length (ename); 369 end; 370 else do; 371 substr (dispatch_buf, length (node) + 1, 1) = ">"; 372 substr (dispatch_buf, length (node) + 2) = ename; 373 dispatch_namel = length (node) + 1 + length (ename); 374 end; 375 376 /* Essence of do_subtree work scheduler: If I can't find someone else (now idle) to do it, do it myself. */ 377 378 if ^dispatch (dispatch_name) then call recurse (dispatch_name); 379 380 end; 381 end; 382 383 384 /* Clear out level flag and do bottom-up xeq */ 385 386 if mpf then do; 387 if ^dir_busyp (cnt, my_px, "0"b) /* Unmark self from dir, test. */ 388 then if bottom_up_flag then call executor (bu_command_line); 389 /* xec the b_u line iff I am last guy out! */ 390 hlev = hlev - 1; /* Count down hierarchy depth. */ 391 end; 392 393 else if bottom_up_flag then call executor (bu_command_line); 394 395 level = level - 1; /* note that executor looks at this */ 396 397 if ep ^= null then free ent; 398 if np ^= null then free names; 399 400 return; 401 402 executor: procedure (com_line); /* exec command right here */ 403 404 dcl com_line char (*); 405 406 if level < first_level then return; 407 408 if trace_flag then call ioa_ ("^-^a", node); 409 call do (com_line, node, procpicvar); 410 if mpf then global_mpdata.executions = global_mpdata.executions + 1; 411 412 end executor; 413 414 is_it_a_dir: proc (btype) returns (bit (1)); 415 416 dcl btype bit (2); 417 418 if btype ^= "10"b then return ("0"b); 419 420 if ^msff then return ("1"b); /* This is a silly thing */ 421 422 call hcs_$status_minf (node, ename, 0, type, bitcount, code); 423 424 if code ^= 0 then if code ^= error_table_$no_s_permission then do; 425 call com_err_ (code, myname, "^a^[>^]^a", node, node ^= ">", ename); 426 return ("0"b); 427 end; 428 429 return ((type = 2) & (bitcount = 0)); 430 431 end is_it_a_dir; 432 433 /* */ 434 435 dispatch: proc (s) returns (bit (1) aligned); 436 437 /* This s/r is called with the name of a directory. It looks for some currently idle process to 438* do it, and returns "1"b if it found someone. Otherwise, returns "0"b. The target process' 439* process element is "loaded" from current process & "cnt". He is marked in dir_table as 440* busy in all the dirs from his dispatch point up. */ 441 442 443 dcl s char (*); 444 445 dcl 1 ampdata like mpdata aligned based (ampdatap); 446 dcl ampdatap ptr; 447 dcl dpx fixed bin; 448 dcl dx fixed bin; 449 450 if ^mpf then return ("0"b); 451 452 do dpx = 1 to global_mpdata.nprocs; 453 ampdatap = addr (global_mpdata.perprocess (dpx)); 454 if ampdata.ready then 455 if stac (addr (ampdata.gostac), my_pid) then do; 456 ampdata.dname = s; 457 ampdata.uid = mpdata.uid; 458 ampdata.uid (hlev - 1) = cnt; 459 ampdata.slevel = level; 460 ampdata.shlev = hlev; 461 do dx = global_mpdata.first_hdepth - 1 to hlev - 1; 462 if dir_busyp (ampdata.uid (dx), dpx, "1"b) then; 463 end; 464 if ^stac (addr (ampdata.data_avl), my_pid) then signal da_err_1_; 465 global_mpdata.dispatches = global_mpdata.dispatches + 1; 466 467 if waker (ampdatap) then return ("1"b); 468 else do dx = global_mpdata.first_hdepth - 1 to hlev - 1; 469 if ^dir_busyp (mpdata.uid (dx), dpx, "0"b) then signal undispatch_err_1_; 470 end; 471 end; 472 end; 473 return ("0"b); 474 475 end dispatch; 476 477 recurse$dispatch: entry (node); /* entry to roll the ball */ 478 /* Dispatch the root node. */ 479 480 hlev = global_mpdata.first_hdepth; 481 cnt = stacq_countgen (global_mpdata.cnt); /* Corresp. to Root node's FATHER */ 482 if ^dispatch (node) then do; 483 call com_err_ (code, myname, "Cannot dispatch root job."); 484 go to NLX; 485 end; 486 return; 487 488 489 end recurse; 490 491 492 /* This page intentionally left blank 493* */ 494 495 multiprocess_ws: proc; 496 497 /* Clear my gostac-word. Wait for work, which will be indicated by data_avl NZ. Load auto vars 498* from process element and global data. Recurse over dispatch point, and decurse up. */ 499 500 dcl 1 dmpdata like mpdata aligned based (dmpdatap); 501 dcl dmpdatap ptr; 502 dcl upnamel fixed bin, upward_name char (upnamel) based (addr (temp_dname)); 503 504 getwork: 505 global_mpdata.getworks = global_mpdata.getworks + 1; 506 do while (mpdata.gostac = "0"b & mpdata.data_avl = "0"b); 507 global_mpdata.blocks = global_mpdata.blocks + 1; 508 call ipc_$block (addr (mpdata.wait_list), addr (event_msg), code); 509 if code ^= 0 then do; 510 call com_err_ (code, myname, "From ipc_$block"); 511 mpdata.died = "1"b; 512 return; 513 end; 514 if global_mpdata.abort then go to ABORT; 515 if global_mpdata.eoj then return; 516 end; 517 518 global_mpdata.pickups = global_mpdata.pickups + 1; 519 520 trace_flag = global_mpdata.trace_flag; 521 msff = global_mpdata.msf_flag; 522 privf = global_mpdata.priv_flag; 523 bottom_up_flag = global_mpdata.bottom_up_flag; 524 top_down_flag = global_mpdata.top_down_flag; 525 starting_dir = mpdata.dname; 526 level = mpdata.slevel; 527 first_level = global_mpdata.sfirst; 528 last_level = global_mpdata.slast; 529 530 hlev = mpdata.shlev; 531 532 sp = addr (starting_dir); 533 slng = length (mpdata.dname); 534 535 cp = addr (global_mpdata.command_line); 536 clng = global_mpdata.comlinel; 537 buclp = addr (global_mpdata.bu_comline); 538 buclng = global_mpdata.bu_comlinel; 539 540 call recurse (starting_node); 541 542 if global_mpdata.abort then go to ABORT; 543 544 545 temp_dname = mpdata.dname; 546 upnamel = length (mpdata.dname); 547 548 549 550 551 /* Go back down looking for directories left upon us to undo. */ 552 553 do hlev = hlev - 1 by -1 to global_mpdata.first_hdepth; 554 upnamel = max (upnamel - index (reverse (upward_name), ">"), 1); 555 if ^dir_busyp (mpdata.uid (hlev), my_px, "0"b) then do; 556 if bottom_up_flag then do; 557 558 /* Tollite jugum meum, dixit ad eos */ 559 560 global_mpdata.dxeqs = global_mpdata.dxeqs + 1; 561 if trace_flag then call ioa_ ("^9x*^a", upward_name); 562 call do (bu_command_line, upward_name, procpicvar); 563 end; 564 565 global_mpdata.decursions = global_mpdata.decursions + 1; 566 end; 567 end; 568 569 if ^dir_busyp (mpdata.uid (hlev), my_px, "0"b) then call sig_eoj; 570 /* PL/I leaves behind last val of 'hlev'-1 */ 571 572 mpdata.data_avl = "0"b; /* need no stacq */ 573 if stacq (mpdata.gostac, "0"b, (mpdata.gostac)) then; 574 /* Leave self open for work */ 575 go to getwork; 576 577 578 end multiprocess_ws; 579 580 waker: proc (xmpdp) returns (bit (1) aligned); 581 /* Send wakeup to px of which xmpdp -> */ 582 583 dcl 1 xmpd like mpdata based (xmpdp) aligned; 584 dcl xmpdp ptr; 585 586 call hcs_$wakeup (xmpd.pid, xmpd.evchn, 0, code); 587 global_mpdata.wakeups = global_mpdata.wakeups + 1; 588 if code = 0 then return ("1"b); 589 xmpd.died = "1"b; 590 591 call com_err_ (code, myname, "Process ^d died while in ^a.", xmpd.px, xmpd.dname); 592 if global_mpdata.abort &^abort_entry then goto ABORT; 593 /* Good place to pick up his burden */ 594 return ("0"b); 595 end waker; 596 597 598 599 600 establish_self_mp: proc; 601 602 /* Find the circus' seg. Establish who's first. If this is the command px, fill in automatic parameters 603* into global ones. Initialize my process element. */ 604 605 606 dcl save_first_possible bit (36) aligned; 607 608 call get_com_seg; 609 610 call get_process_parameters; 611 612 /* This is for the first guy, whether master or not */ 613 614 save_first_possible = global_mpdata.startctl; 615 if stac (addr (global_mpdata.startctl), my_pid) then do; /* Are we the FIRST (not nec. Master)? */ 616 global_mpdata.nprocs = 0; 617 global_mpdata.cnt = 0; 618 string (global_mpdata.stopflags) = "0"b; 619 unspec (global_mpdata.meters) = "0"b; 620 end; 621 622 if command_process then do; /* real starting stuff */ 623 global_mpdata.trace_flag = trace_flag; 624 global_mpdata.msf_flag = msff; 625 global_mpdata.priv_flag = privf; 626 global_mpdata.bottom_up_flag = bottom_up_flag; 627 global_mpdata.top_down_flag = top_down_flag; 628 global_mpdata.comlinel = length (command_line); 629 global_mpdata.command_line = command_line; 630 global_mpdata.bu_comlinel = buclng; 631 global_mpdata.bu_comline = bu_command_line; 632 global_mpdata.first_hdepth = count_greater_thans (starting_node); 633 global_mpdata.last_hdepth = global_mpdata.first_hdepth + last_level - first_level; 634 global_mpdata.sfirst = first_level; 635 global_mpdata.slast = last_level; 636 end; 637 638 if global_mpdata.nprocs ^< hbound (global_mpdata.dir_table.procbits, 2) 639 then do; 640 if command_process then call com_err_ (0, myname, "Too many slave processes to add master."); 641 else call com_err_ (0, myname, "too many processes to add another."); 642 go to NLX; 643 end; 644 645 my_px = stacq_countgen (global_mpdata.nprocs); 646 procpicvar = my_px; /* Set for &2 hack */ 647 call ioa_ ("Process ^d in ^a.", my_px, get_wdir_ ()); 648 mpdatap = addr (global_mpdata.perprocess (my_px)); 649 unspec (mpdata) = "0"b; 650 651 mpdata.pid = my_pid; 652 mpdata.px = my_px; 653 mpdata.nchan = 1; 654 mpdata.evchn = my_evchn; 655 mpdata.ready = "1"b; 656 657 end establish_self_mp; 658 659 get_process_parameters: procedure; /* Get ev chan & pid */ 660 661 call ipc_$create_ev_chn (my_evchn, code); 662 if code ^= 0 then do; 663 call com_err_ (code, myname, "Cannot create event channel."); 664 go to NLX; 665 end; 666 my_pid = get_process_id_ (); 667 return; 668 669 end get_process_parameters; 670 671 672 673 /* 674* 675* Now comes all the dirt and language apologies. */ 676 677 dir_busyp: proc (acnt, apx, abit) returns (bit (1) aligned); 678 679 /* This procedure is the heart of the bottom_up and completion scheduling technique. As "abit" is "0"b or "1"b, 680* respectively, it marks the process whos index is "apx" as out of, or in, respectively, 681* the dir whose index is "acnt". The bit diddling is done unitarily (with stacq), such that it 682* is known, in the case of taking a process _o_u_t of a dir, if this was th last process out. 683* This is the condition for b_u comline execution. The last process out of the root node's father 684* declares tthe entire circus over. */ 685 686 dcl acnt fixed bin; 687 dcl apx fixed bin; 688 dcl abit bit (1) aligned; 689 690 dcl p ptr; 691 dcl (b, c) bit (36) aligned; 692 dcl dummy bit (1) aligned; 693 694 695 p = addr (global_mpdata.dir_table (acnt)); 696 r: b = string (global_mpdata.dir_table (acnt)); 697 c = b; 698 substr (c, apx, 1) = abit; 699 dummy = "1"b; /* This is to get around PL1 bug 1664, 700* _i_n _q_u_o state_man doesn't flush substr 701* references. This clears the a-register. HELP! */ 702 if stacq (p -> b36, c, b) then do; 703 substr (b, apx, 1) = "0"b; 704 return (b ^= "0"b); 705 end; 706 else go to r; 707 708 end dir_busyp; 709 710 711 712 count_greater_thans: proc (s) returns (fixed bin); 713 714 /* Determines "hierarchy depth" from # of greater thans */ 715 716 717 dcl s char (*); 718 dcl (i, j) fixed bin; 719 dcl c fixed bin; 720 721 if s = ">" then return (0); 722 723 i = 1; 724 c = 0; 725 do while ("1"b); 726 j = index (substr (s, i), ">"); 727 if j = 0 then return (c); 728 c = c + 1; 729 i = i + j; 730 end; 731 end count_greater_thans; 732 733 734 stacq_countgen: proc (reference) returns (fixed bin (35)); 735 736 737 /* Take a unique tag from loc "reference", incrementing it by 1 in so doing. Exactly 738* like the ticket machine in the bakery. */ 739 740 dcl reference fixed bin (35); 741 dcl bit_reference bit (36) aligned based (addr (reference)); /* This is ILLEGAL, but necessary. */ 742 /* We hope we don't get optimized away. */ 743 dcl v fixed bin (35); 744 745 r: v = reference; 746 if stacq (bit_reference, bit (fixed (v + 1, 36), 36), bit (fixed (v, 36), 36)) 747 then return (v + 1); 748 else go to r; 749 750 end stacq_countgen; 751 752 sig_eoj: proc; 753 754 /* Broadcast the fact of completion */ 755 756 dcl 1 empdata like mpdata based (empdatap); 757 dcl empdatap ptr; 758 759 dcl epx fixed bin; 760 global_mpdata.eoj = "1"b; 761 762 j: do epx = 1 to global_mpdata.nprocs; 763 empdatap = addr (global_mpdata.perprocess (epx)); 764 if waker (empdatap) then; 765 end; 766 return; 767 768 sig_abort: entry; 769 770 global_mpdata.abort = "1"b; 771 abort_entry = "1"b; 772 go to j; 773 774 end sig_eoj; 775 776 abort: entry; 777 778 call get_com_seg; 779 780 abort_entry = "1"b; 781 call sig_abort; 782 return; 783 /* */ 784 785 recover: entry; 786 787 call cu_$arg_ptr (1, ap, lng, code); 788 if code ^= 0 then do; 789 call com_err_ (code, myname); 790 return; 791 end; 792 793 my_px = cv_dec_check_ (arg, code); 794 if code ^= 0 then do; 795 call com_err_ (0, myname, "Bad process number: ^a.", arg); 796 return; 797 end; 798 procpicvar = my_px; 799 800 call get_com_seg; 801 802 if my_px < 0 | my_px > global_mpdata.nprocs then do; 803 call com_err_ (0, myname, "Invalid process number: ^d.", my_px); 804 return; 805 end; 806 807 mpdatap = addr (global_mpdata.perprocess (my_px)); 808 call get_process_parameters; 809 810 mpdata.pid = my_pid; 811 mpdata.evchn = my_evchn; 812 mpdata.nchan = 1; 813 814 call ioa_ ("Recovering process ^d in ^a.", my_px, get_wdir_ ()); 815 816 mpf = "1"b; 817 command_process = "0"b; 818 819 if mpdata.died then do; 820 mpdata.data_avl = "0"b; 821 if stacq (mpdata.gostac, "0"b, (mpdata.gostac)) then; 822 mpdata.died = "0"b; 823 end; 824 825 arp = get_system_free_area_ (); 826 827 call multiprocess_ws; 828 return; 829 830 /* */ 831 832 status: entry; 833 834 call get_com_seg; 835 call ioa_ ("Seg at ^p", gmpdata_p); 836 call ioa_ ("Starter was ^w, count at ^d, ^d processes.", 837 global_mpdata.startctl, global_mpdata.cnt, global_mpdata.nprocs); 838 call ioa_ ("Flags: ^[^^^]tracing, ^[^^^]top-down, ^[^^^]bot-up, ^[^^^]eoj, ^[^^^]abort ^[^^^]no_msf ^[^^^]priv", 839 ^global_mpdata.trace_flag, ^global_mpdata.top_down_flag, ^global_mpdata.bottom_up_flag, 840 ^global_mpdata.eoj, ^global_mpdata.abort, ^global_mpdata.msf_flag, ^global_mpdata.priv_flag); 841 call ioa_ ("^d dispatches, ^d pickups, ^d getworks, ^d wakeups.", 842 global_mpdata.dispatches, global_mpdata.pickups, 843 global_mpdata.getworks, global_mpdata.wakeups); 844 call ioa_ ("^d blocks, ^d recursions, ^d decursions.", 845 global_mpdata.blocks, global_mpdata.recursions, global_mpdata.decursions); 846 call ioa_ ("^d recurse executions, ^d decurse executions.", 847 global_mpdata.executions, global_mpdata.dxeqs); 848 call ioa_ ("first ^d last ^d first hd ^d last hd ^d", 849 global_mpdata.sfirst, global_mpdata.slast, 850 global_mpdata.first_hdepth, global_mpdata.last_hdepth); 851 if global_mpdata.top_down_flag then call ioa_ ("Top command: ^a", b_comline); 852 if global_mpdata.bottom_up_flag then call ioa_ ("Bottom command: ^a", b_bu_comline); 853 854 do px = 1 to global_mpdata.nprocs; 855 mpdatap = addr (global_mpdata.perprocess (px)); 856 call ioa_ ("^/Px ^d PID ^w at ^p, evchn = ^o.", 857 mpdata.px, mpdata.pid, mpdatap, mpdata.evchn); 858 call ioa_ ("gostac ^w data_avl ^w.", 859 mpdata.gostac, mpdata.data_avl); 860 call ioa_ ("Uid array ^(^d ^).", mpdata.uid); 861 call ioa_ ("Last seen at ^a, s-lev ^d, s-hlev ^d.", 862 mpdata.dname, mpdata.slevel, mpdata.shlev); 863 call ioa_ ("Flags: ^[^^^]ready, ^[^^^]died.", 864 ^mpdata.ready, ^mpdata.died); 865 end; 866 return; 867 868 get_com_seg: proc; 869 870 call hcs_$make_seg (get_wdir_ (), "dos_mp_seg", "", 1011b, gmpdata_p, code); 871 if gmpdata_p = null then do; 872 call com_err_ (code, myname, "Cannot get pointer to communications segment."); 873 go to NLX; 874 end; 875 end get_com_seg; 876 877 878 879 end dos; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1519.5 do_subtree.pl1 >dumps>old>recomp>do_subtree.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. abit parameter bit(1) dcl 688 ref 677 698 abort 237(01) based bit(1) level 3 packed unaligned dcl 104 set ref 327 514 542 592 770* 838 abort_entry 000317 automatic bit(1) initial dcl 63 set ref 63* 592 771* 780* absolute_pathname_ 000030 constant entry external dcl 80 ref 248 acnt parameter fixed bin(17,0) dcl 686 ref 677 695 696 addr builtin function dcl 71 ref 174 256 331 361 378 378 453 454 464 508 508 508 508 532 535 537 554 561 562 615 648 695 746 763 807 851 852 855 ampdata based structure level 1 dcl 445 ampdatap 000224 automatic pointer dcl 446 set ref 453* 454 454 456 457 458 459 460 462 464 467* ap 000320 automatic pointer initial dcl 65 set ref 65* 181* 185 185 185 185 186 188* 193 195 201 201 210 210 219 219 220 220 221 222 224 787* 793 795 apx parameter fixed bin(17,0) dcl 687 ref 677 698 703 arg based char unaligned dcl 37 set ref 185 185 185 185 186 193* 195* 201 201 210 210 219 219 220 220 221 222 224* 793* 795* arp 000322 automatic pointer initial dcl 65 set ref 65* 239* 349* 350* 825* b 000102 automatic bit(36) dcl 691 set ref 696* 697 702 703* 704 b36 based bit(36) dcl 37 set ref 331* 702 b_bu_comline based char unaligned dcl 141 set ref 852* b_comline based char unaligned dcl 140 set ref 851* bit_reference based bit(36) dcl 741 ref 746 bitcount 000167 automatic fixed bin(24,0) dcl 303 set ref 422* 429 blocks 251 based fixed bin(17,0) level 3 dcl 104 set ref 507* 507 844* bottom_up_flag 000311 automatic bit(1) initial dcl 54 in procedure "do_subtree" set ref 54* 217* 387 393 523* 556 626 bottom_up_flag 6(02) based bit(1) level 3 in structure "global_mpdata" packed unaligned dcl 104 in procedure "do_subtree" set ref 523 626* 838 852 btype parameter bit(2) unaligned dcl 416 ref 414 418 bu_comline 124 based char(300) level 2 dcl 104 set ref 537 631* 852 bu_comlinel 123 based fixed bin(17,0) level 2 dcl 104 set ref 538 630* 852 852 bu_command_line based char unaligned dcl 37 set ref 387* 393* 562* 631 buclng 000301 automatic fixed bin(17,0) initial dcl 45 set ref 45* 212* 387 387 393 393 538* 562 562 630 631 buclp 000330 automatic pointer initial dcl 65 set ref 65* 212* 387 393 537* 562 631 c 000420 automatic fixed bin(17,0) dcl 719 in procedure "count_greater_thans" set ref 724* 727 728* 728 c 000103 automatic bit(36) dcl 691 in procedure "dir_busyp" set ref 697* 698* 702 cleanup 000000 stack reference condition dcl 32 ref 318 clng 000300 automatic fixed bin(17,0) initial dcl 45 set ref 45* 203* 341 341 536* 628 629 cnt 000160 automatic fixed bin(17,0) dcl 291 in procedure "recurse" set ref 328* 331 333 334 387* 458 481* cnt 1 based fixed bin(35,0) level 2 in structure "global_mpdata" dcl 104 in procedure "do_subtree" set ref 328* 481* 617* 836* code 000166 automatic fixed bin(35,0) dcl 298 in procedure "recurse" set ref 344* 349* 350* 351 353 353* 422* 424 424 425* 483* code 000310 automatic fixed bin(35,0) dcl 49 in procedure "do_subtree" set ref 165* 166 167* 181* 182 188* 189 193* 194 203* 204 212* 213 233* 248* 249 250* 508* 509 510* 586* 588 591* 661* 662 663* 787* 788 789* 793* 794 870* 872* com_err_ 000026 constant entry external dcl 71 ref 167 190 195 205 214 224 234 250 268 353 425 483 510 591 640 641 663 789 795 803 872 com_line parameter char unaligned dcl 404 set ref 402 409* comlinel 7 based fixed bin(17,0) level 2 dcl 104 set ref 536 628* 851 851 command_line 10 based char(300) level 2 in structure "global_mpdata" dcl 104 in procedure "do_subtree" set ref 535 629* 851 command_line based char unaligned dcl 37 in procedure "do_subtree" set ref 341* 628 629 command_process 000357 automatic bit(1) initial unaligned dcl 160 set ref 160* 243* 260 622 640 817* cp 000324 automatic pointer initial dcl 65 set ref 65* 203* 341 535* 628 629 cu_$arg_ptr 000016 constant entry external dcl 71 ref 165 181 188 203 212 787 cv_dec_check_ 000014 constant entry external dcl 71 ref 193 793 da_err_1_ 000000 stack reference condition dcl 32 ref 464 data_avl 10 based bit(36) level 2 in structure "mpdata" dcl 86 in procedure "do_subtree" set ref 506 572* 820* 858* data_avl 10 based bit(36) level 2 in structure "ampdata" dcl 445 in procedure "dispatch" set ref 464 decursions 246 based fixed bin(17,0) level 3 dcl 104 set ref 565* 565 844* died 107(01) based bit(1) level 3 in structure "xmpd" packed unaligned dcl 583 in procedure "waker" set ref 589* died 107(01) based bit(1) level 3 in structure "mpdata" packed unaligned dcl 86 in procedure "do_subtree" set ref 511* 819 822* 863 dir_table 5312 based structure array level 2 dcl 104 set ref 331 695 696 dispatch_buf 000104 automatic char(168) unaligned dcl 287 set ref 365* 367* 371* 372* 378 378 dispatch_name based char unaligned dcl 288 set ref 378* 378* dispatch_namel 000164 automatic fixed bin(17,0) dcl 296 set ref 368* 373* 378 378 378 378 dispatches 245 based fixed bin(17,0) level 3 dcl 104 set ref 465* 465 841* dname 34 based varying char(168) level 2 in structure "ampdata" dcl 445 in procedure "dispatch" set ref 456* dname 34 based varying char(168) level 2 in structure "mpdata" dcl 86 in procedure "do_subtree" set ref 525 533 545 546 861* dname 34 based varying char(168) level 2 in structure "xmpd" dcl 583 in procedure "waker" set ref 591* do 000044 constant entry external dcl 161 ref 409 562 dpx 000226 automatic fixed bin(17,0) dcl 447 set ref 452* 453 462* 469* dummy 000104 automatic bit(1) dcl 692 set ref 699* dx 000227 automatic fixed bin(17,0) dcl 448 set ref 461* 462* 468* 469* dxeqs 242 based fixed bin(17,0) level 3 dcl 104 set ref 560* 560 846* ecount 000157 automatic fixed bin(17,0) dcl 289 set ref 319 344* 349* 350* 352* 360 397 empdatap 000430 automatic pointer dcl 757 set ref 763* 764* ename based char unaligned dcl 293 set ref 367 368 372 373 422* 425* enamel 000165 automatic fixed bin(17,0) dcl 296 set ref 362* 367 368 372 373 422 422 425 425 enamep 000162 automatic pointer dcl 294 set ref 361* 367 368 372 373 422 425 ent based structure array level 1 dcl 310 ref 319 397 eoj 237 based bit(1) level 3 packed unaligned dcl 104 set ref 515 760* 838 ep 000102 automatic pointer initial dcl 285 set ref 285* 319 319 349* 350* 361 362 363 397 397 epx 000432 automatic fixed bin(17,0) dcl 759 set ref 762* 763* error_table_$badopt 000010 external static fixed bin(35,0) dcl 68 set ref 224* error_table_$no_s_permission 000054 external static fixed bin(35,0) dcl 305 ref 424 error_table_$noarg 000012 external static fixed bin(35,0) dcl 69 set ref 190* 205* 214* error_table_$nomatch 000056 external static fixed bin(35,0) dcl 306 ref 353 evchn 4 based fixed bin(71,0) level 3 in structure "mpdata" dcl 86 in procedure "do_subtree" set ref 654* 811* 856* evchn 4 based fixed bin(71,0) level 3 in structure "xmpd" dcl 583 in procedure "waker" set ref 586* event_msg 000342 automatic fixed bin(71,0) array dcl 156 set ref 508 508 executions 241 based fixed bin(17,0) level 3 dcl 104 set ref 410* 410 846* f_option_flag 000312 automatic bit(1) initial dcl 54 set ref 54* 186* 198 first_hdepth 2 based fixed bin(17,0) level 2 dcl 104 set ref 461 468 480 553 632* 633 848* first_level 000304 automatic fixed bin(17,0) initial dcl 46 set ref 46* 198* 228 234* 406 527* 633 634 fixed builtin function dcl 71 ref 746 746 flags 107 based structure level 2 in structure "mpdata" packed unaligned dcl 86 in procedure "do_subtree" flags 107 based structure level 2 in structure "xmpd" packed unaligned dcl 583 in procedure "waker" flags 107 based structure level 2 in structure "ampdata" packed unaligned dcl 445 in procedure "dispatch" get_process_id_ 000040 constant entry external dcl 148 ref 666 get_system_free_area_ 000020 constant entry external dcl 71 ref 239 825 get_wdir_ 000022 constant entry external dcl 71 ref 173 647 647 814 814 870 870 getworks 247 based fixed bin(17,0) level 3 dcl 104 set ref 504* 504 841* global_flags 6 based structure level 2 packed unaligned dcl 104 global_mpdata based structure level 1 dcl 104 gmpdata_p 000334 automatic pointer dcl 143 set ref 326 326 327 328 331 333 410 410 452 453 461 465 465 468 480 481 504 504 507 507 514 515 518 518 520 521 522 523 524 527 528 535 536 537 538 542 553 560 560 565 565 587 587 592 614 615 616 617 618 619 623 624 625 626 627 628 629 630 631 632 633 633 634 635 638 638 645 648 695 696 760 762 763 770 802 807 835* 836 836 836 838 838 838 838 838 838 838 841 841 841 841 844 844 844 846 846 848 848 848 848 851 851 851 851 852 852 852 852 854 855 870* 871 gostac 7 based bit(36) level 2 in structure "ampdata" dcl 445 in procedure "dispatch" set ref 454 gostac 7 based bit(36) level 2 in structure "mpdata" dcl 86 in procedure "do_subtree" set ref 506 573 573 821 821 858* hcs_$make_seg 000032 constant entry external dcl 145 ref 870 hcs_$star_ 000046 constant entry external dcl 300 ref 350 hcs_$status_minf 000052 constant entry external dcl 301 ref 422 hcs_$wakeup 000036 constant entry external dcl 147 ref 586 hlev 000336 automatic fixed bin(17,0) dcl 152 set ref 334 335* 335 390* 390 458 460 461 468 480* 530* 553* 553* 555* 569 hphcs_$star_ 000050 constant entry external dcl 300 ref 349 i 000416 automatic fixed bin(17,0) dcl 718 in procedure "count_greater_thans" set ref 723* 726 729* 729 i 000306 automatic fixed bin(17,0) dcl 47 in procedure "do_subtree" set ref 180* 181* 187* 187 188* 202* 202 203* 211* 211 212* ioa_ 000024 constant entry external dcl 71 ref 408 561 647 814 835 836 838 841 844 846 848 851 852 856 858 860 861 863 ipc_$block 000034 constant entry external dcl 146 ref 508 ipc_$create_ev_chn 000042 constant entry external dcl 149 ref 661 j 000417 automatic fixed bin(17,0) dcl 718 set ref 726* 727 729 k 000156 automatic fixed bin(17,0) dcl 289 set ref 360* 361 362 363* last_hdepth 3 based fixed bin(17,0) level 2 dcl 104 set ref 633* 848* last_level 000305 automatic fixed bin(17,0) initial dcl 46 set ref 46* 199* 228 234* 344 528* 633 635 level 000303 automatic fixed bin(17,0) initial dcl 46 set ref 46* 337* 337 344 395* 395 406 459 526* lng 000277 automatic fixed bin(17,0) initial dcl 45 set ref 45* 181* 185 185 185 185 186 188* 193 193 195 195 201 201 210 210 219 219 220 220 221 222 224 224 787* 793 793 795 795 meters 241 based structure level 2 dcl 104 set ref 619* mpdata based structure level 1 dcl 86 set ref 649* mpdatap 000332 automatic pointer dcl 102 set ref 334 457 469 506 506 508 508 511 525 526 530 533 545 546 555 569 572 573 573 648* 649 651 652 653 654 655 807* 810 811 812 819 820 821 821 822 855* 856 856 856* 856 858 858 860 861 861 861 863 863 mpf 000356 automatic bit(1) initial unaligned dcl 159 set ref 159* 220* 245* 258 325 386 410 450 816* msf_flag 6(03) based bit(1) level 3 packed unaligned dcl 104 set ref 521 624* 838 msff 000316 automatic bit(1) initial dcl 54 set ref 54* 222* 420 521* 624 my_evchn 000354 automatic fixed bin(71,0) dcl 158 set ref 654 661* 811 my_pid 000340 automatic bit(36) dcl 155 set ref 454 464 615 651 666* 810 my_px 000352 automatic fixed bin(17,0) dcl 157 set ref 333 387* 555* 569* 645* 646 647* 648 652 793* 798 802 802 803* 807 814* myname 000000 constant char(15) initial unaligned dcl 37 set ref 167* 190* 195* 205* 214* 224* 234* 250* 268* 353* 425* 483* 510* 591* 640* 641* 663* 789* 795* 803* 872* names based char(32) array dcl 308 set ref 320 361 362 398 nchan 2 based fixed bin(17,0) level 3 dcl 86 set ref 653* 812* nindex 0(18) based fixed bin(17,0) array level 2 packed unaligned dcl 310 ref 361 362 nnn 000307 automatic fixed bin(35,0) dcl 49 set ref 193* 194 198 199 node parameter char unaligned dcl 283 set ref 272 349* 350* 353* 365 366 371 372 373 408* 409* 422* 425* 425 477 482* np 000100 automatic pointer initial dcl 285 set ref 285* 320 320 349* 350* 361 362 398 398 nprocs 240 based fixed bin(35,0) level 2 dcl 104 set ref 452 616* 638 645* 762 802 836* 854 null builtin function dcl 71 ref 65 65 65 65 65 285 285 319 320 397 398 871 p 000100 automatic pointer dcl 690 set ref 695* 702 perprocess 252 based structure array level 2 dcl 104 set ref 453 648 763 807 855 pickups 244 based fixed bin(17,0) level 3 dcl 104 set ref 518* 518 841* pid based bit(36) level 2 in structure "xmpd" dcl 583 in procedure "waker" set ref 586* pid based bit(36) level 2 in structure "mpdata" dcl 86 in procedure "do_subtree" set ref 651* 810* 856* priv_flag 6(04) based bit(1) level 3 packed unaligned dcl 104 set ref 522 625* 838 privf 000315 automatic bit(1) initial dcl 54 set ref 54* 221* 349 522* 625 procbits 5312 based bit(1) array level 3 packed unaligned dcl 104 set ref 333* 638 procpicvar 000276 automatic picture(2) initial unaligned dcl 37 set ref 37* 409* 562* 646* 798* px 6 based fixed bin(17,0) level 2 in structure "mpdata" dcl 86 in procedure "do_subtree" set ref 652* 856* px 000337 automatic fixed bin(17,0) dcl 153 in procedure "do_subtree" set ref 854* 855* px 6 based fixed bin(17,0) level 2 in structure "xmpd" dcl 583 in procedure "waker" set ref 591* ready 107 based bit(1) level 3 in structure "mpdata" packed unaligned dcl 86 in procedure "do_subtree" set ref 655* 863 ready 107 based bit(1) level 3 in structure "ampdata" packed unaligned dcl 445 in procedure "dispatch" ref 454 recursions 243 based fixed bin(17,0) level 3 dcl 104 set ref 326* 326 844* reference parameter fixed bin(35,0) dcl 740 set ref 734 745 746 s parameter char unaligned dcl 443 in procedure "dispatch" ref 435 456 s parameter char unaligned dcl 717 in procedure "count_greater_thans" ref 712 721 726 save_first_possible 000400 automatic bit(36) dcl 606 set ref 614* sfirst 4 based fixed bin(17,0) level 2 dcl 104 set ref 527 634* 848* shlev 33 based fixed bin(17,0) level 2 in structure "mpdata" dcl 86 in procedure "do_subtree" set ref 530 861* shlev 33 based fixed bin(17,0) level 2 in structure "ampdata" dcl 445 in procedure "dispatch" set ref 460* slast 5 based fixed bin(17,0) level 2 dcl 104 set ref 528 635* 848* slevel 32 based fixed bin(17,0) level 2 in structure "ampdata" dcl 445 in procedure "dispatch" set ref 459* slevel 32 based fixed bin(17,0) level 2 in structure "mpdata" dcl 86 in procedure "do_subtree" set ref 526 861* slng 000302 automatic fixed bin(17,0) initial dcl 45 set ref 45* 165* 172 175* 242 244 248 248 250 250 255* 260 260 263 263 533* 540 540 632 632 sp 000326 automatic pointer initial dcl 65 set ref 65* 165* 172 174* 242 244 248 250 256* 260 263 532* 540 632 stacq builtin function dcl 71 ref 573 702 746 821 startctl based bit(36) level 2 dcl 104 set ref 614 615 836* starting_dir 000100 automatic char(168) unaligned dcl 34 set ref 244* 248* 255 256 525* 532 starting_node based char unaligned dcl 37 set ref 172 242 244 248* 250* 260* 263* 540* 632* stopflags 237 based structure level 2 packed unaligned dcl 104 set ref 618* substr builtin function dcl 71 set ref 186 367* 371* 372* 698* 703* 726 temp_dname 000152 automatic char(168) unaligned dcl 35 set ref 545* 554 561 562 top_down_flag 000313 automatic bit(1) initial dcl 54 in procedure "do_subtree" set ref 54* 208* 341 524* 627 top_down_flag 6(01) based bit(1) level 3 in structure "global_mpdata" packed unaligned dcl 104 in procedure "do_subtree" set ref 524 627* 838 851 trace_flag 000314 automatic bit(1) initial dcl 54 in procedure "do_subtree" set ref 54* 219* 408 520* 561 623 trace_flag 6 based bit(1) level 3 in structure "global_mpdata" packed unaligned dcl 104 in procedure "do_subtree" set ref 520 623* 838 type based bit(2) array level 2 in structure "ent" packed unaligned dcl 310 in procedure "recurse" ref 363 type 000170 automatic fixed bin(2,0) dcl 303 in procedure "recurse" set ref 422* 429 uid 11 based fixed bin(17,0) array level 2 in structure "ampdata" dcl 445 in procedure "dispatch" set ref 457* 458* 462* uid 11 based fixed bin(17,0) array level 2 in structure "mpdata" dcl 86 in procedure "do_subtree" set ref 334* 457 469* 555* 569* 860* undispatch_err_1_ 000000 stack reference condition dcl 32 ref 469 upnamel 000370 automatic fixed bin(17,0) dcl 502 set ref 546* 554* 554 554 561 561 562 562 upward_name based char unaligned dcl 502 set ref 554 561* 562* v 000100 automatic fixed bin(35,0) dcl 743 set ref 745* 746 746 746 wait_list 2 based structure level 2 in structure "mpdata" dcl 86 in procedure "do_subtree" set ref 508 508 wait_list 2 based structure level 2 in structure "xmpd" dcl 583 in procedure "waker" wakeups 250 based fixed bin(17,0) level 3 dcl 104 set ref 587* 587 841* working_dir 000224 automatic char(168) unaligned dcl 36 set ref 173* 174 175 xmpd based structure level 1 dcl 583 xmpdp parameter pointer dcl 584 ref 580 586 586 589 591 591 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. cu_$arg_count 000000 constant entry external dcl 71 dmpdata based structure level 1 dcl 500 dmpdatap automatic pointer dcl 501 empdata based structure level 1 unaligned dcl 756 expand_pathname_ 000000 constant entry external dcl 79 tem_ based area(1024) dcl 67 NAMES DECLARED BY EXPLICIT CONTEXT. ABORT 001615 constant label dcl 268 ref 327 514 542 592 NLX 001642 constant label dcl 269 ref 484 642 664 873 abort 001644 constant entry external dcl 776 count_greater_thans 005603 constant entry internal dcl 712 ref 632 dir_busyp 005536 constant entry internal dcl 677 ref 387 462 469 555 569 dispatch 004200 constant entry internal dcl 435 ref 378 482 do_subtree 000627 constant entry external dcl 11 dos 000637 constant entry external dcl 11 endopt 001405 constant label dcl 228 ref 182 establish_self_mp 005155 constant entry internal dcl 600 ref 259 executor 003706 constant entry internal dcl 402 ref 341 387 393 get_com_seg 005765 constant entry internal dcl 868 ref 608 778 800 834 get_process_parameters 005464 constant entry internal dcl 659 ref 610 808 getwork 004440 constant label dcl 504 ref 575 is_it_a_dir 004003 constant entry internal dcl 414 ref 363 j 005724 constant label dcl 762 ref 772 multiprocess_ws 004437 constant entry internal dcl 495 ref 261 827 r 005551 constant label dcl 696 in procedure "dir_busyp" ref 702 r 005671 constant label dcl 745 in procedure "stacq_countgen" ref 746 recover 001660 constant entry external dcl 785 recurse 003011 constant entry internal dcl 272 ref 263 378 540 recurse$dispatch 003602 constant entry internal dcl 477 ref 260 sig_abort 005756 constant entry internal dcl 768 ref 781 sig_eoj 005720 constant entry internal dcl 752 ref 569 stacq_countgen 005664 constant entry internal dcl 734 ref 328 481 645 status 002164 constant entry external dcl 832 waker 005037 constant entry internal dcl 580 ref 467 764 NAMES DECLARED BY CONTEXT OR IMPLICATION. bit builtin function ref 746 746 hbound builtin function ref 638 index builtin function ref 554 726 length builtin function ref 175 255 362 368 371 372 373 373 533 546 628 max builtin function ref 554 reverse builtin function ref 554 rtrim builtin function ref 175 255 362 stac builtin function ref 454 464 615 string builtin function ref 618 696 unspec builtin function set ref 619 649* STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 6422 6502 6107 6432 Length 6752 6107 60 233 313 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME do_subtree 652 external procedure is an external procedure. recurse 312 internal procedure enables or reverts conditions. on unit on line 318 64 on unit executor internal procedure shares stack frame of internal procedure recurse. is_it_a_dir internal procedure shares stack frame of internal procedure recurse. dispatch internal procedure shares stack frame of internal procedure recurse. multiprocess_ws internal procedure shares stack frame of external procedure do_subtree. waker 98 internal procedure is called by several nonquick procedures. establish_self_mp internal procedure shares stack frame of external procedure do_subtree. get_process_parameters internal procedure shares stack frame of external procedure do_subtree. dir_busyp 69 internal procedure is called by several nonquick procedures. count_greater_thans internal procedure shares stack frame of external procedure do_subtree. stacq_countgen 68 internal procedure is called by several nonquick procedures. sig_eoj internal procedure shares stack frame of external procedure do_subtree. get_com_seg internal procedure shares stack frame of external procedure do_subtree. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME dir_busyp 000100 p dir_busyp 000102 b dir_busyp 000103 c dir_busyp 000104 dummy dir_busyp do_subtree 000100 starting_dir do_subtree 000152 temp_dname do_subtree 000224 working_dir do_subtree 000276 procpicvar do_subtree 000277 lng do_subtree 000300 clng do_subtree 000301 buclng do_subtree 000302 slng do_subtree 000303 level do_subtree 000304 first_level do_subtree 000305 last_level do_subtree 000306 i do_subtree 000307 nnn do_subtree 000310 code do_subtree 000311 bottom_up_flag do_subtree 000312 f_option_flag do_subtree 000313 top_down_flag do_subtree 000314 trace_flag do_subtree 000315 privf do_subtree 000316 msff do_subtree 000317 abort_entry do_subtree 000320 ap do_subtree 000322 arp do_subtree 000324 cp do_subtree 000326 sp do_subtree 000330 buclp do_subtree 000332 mpdatap do_subtree 000334 gmpdata_p do_subtree 000336 hlev do_subtree 000337 px do_subtree 000340 my_pid do_subtree 000342 event_msg do_subtree 000352 my_px do_subtree 000354 my_evchn do_subtree 000356 mpf do_subtree 000357 command_process do_subtree 000370 upnamel multiprocess_ws 000400 save_first_possible establish_self_mp 000416 i count_greater_thans 000417 j count_greater_thans 000420 c count_greater_thans 000430 empdatap sig_eoj 000432 epx sig_eoj recurse 000100 np recurse 000102 ep recurse 000104 dispatch_buf recurse 000156 k recurse 000157 ecount recurse 000160 cnt recurse 000162 enamep recurse 000164 dispatch_namel recurse 000165 enamel recurse 000166 code recurse 000167 bitcount recurse 000170 type recurse 000224 ampdatap dispatch 000226 dpx dispatch 000227 dx dispatch stacq_countgen 000100 v stacq_countgen THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other_desc call_int_other return tra_ext stac signal enable ext_entry int_entry int_entry_desc free_based stacq THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. absolute_pathname_ com_err_ cu_$arg_ptr cv_dec_check_ do get_process_id_ get_system_free_area_ get_wdir_ hcs_$make_seg hcs_$star_ hcs_$status_minf hcs_$wakeup hphcs_$star_ ioa_ ipc_$block ipc_$create_ev_chn THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$no_s_permission error_table_$noarg error_table_$nomatch LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 37 000566 45 000573 46 000577 54 000604 63 000612 65 000613 159 000621 160 000622 11 000626 165 000645 166 000664 167 000666 168 000703 172 000704 173 000712 174 000721 175 000723 180 000735 181 000737 182 000754 185 000756 186 001000 187 001005 188 001006 189 001023 190 001025 191 001054 193 001055 194 001100 195 001104 196 001143 198 001144 199 001150 200 001151 201 001152 202 001162 203 001163 204 001200 205 001202 206 001226 208 001227 209 001231 210 001232 211 001242 212 001243 213 001260 214 001262 215 001306 217 001307 218 001311 219 001312 220 001325 221 001340 222 001347 224 001356 225 001402 227 001403 228 001405 233 001410 234 001411 235 001445 239 001446 242 001455 243 001463 244 001464 245 001467 246 001471 248 001472 249 001516 250 001520 251 001544 255 001545 256 001557 258 001561 259 001563 260 001564 261 001601 262 001602 263 001603 266 001614 268 001615 269 001642 776 001643 778 001652 780 001653 781 001655 782 001656 785 001657 787 001666 788 001705 789 001707 790 001724 793 001725 794 001752 795 001754 796 002013 798 002014 800 002023 802 002024 803 002031 804 002062 807 002063 808 002066 810 002067 811 002071 812 002074 814 002076 816 002131 817 002133 819 002134 820 002140 821 002141 822 002150 825 002152 827 002161 828 002162 832 002163 834 002172 835 002173 836 002214 838 002244 841 002350 844 002402 846 002431 848 002455 851 002507 852 002537 854 002571 855 002601 856 002605 858 002642 860 002671 861 002712 863 002742 865 002777 866 003001 285 003003 272 003010 318 003025 319 003041 320 003050 321 003057 325 003060 326 003063 327 003065 328 003073 331 003110 333 003113 334 003120 335 003124 337 003125 341 003126 344 003143 349 003152 350 003226 351 003277 352 003301 353 003302 360 003327 361 003336 362 003346 363 003361 365 003372 366 003400 367 003404 368 003411 369 003414 371 003415 372 003420 373 003432 378 003436 381 003473 386 003475 387 003500 390 003540 391 003543 393 003544 395 003561 397 003564 398 003572 400 003600 477 003601 480 003616 481 003622 482 003635 483 003656 484 003702 486 003705 402 003706 406 003717 408 003724 409 003747 410 003775 412 004002 414 004003 418 004005 420 004017 422 004027 424 004072 425 004077 426 004154 429 004162 435 004200 450 004211 452 004217 453 004227 454 004234 456 004245 457 004260 458 004264 459 004267 460 004271 461 004273 462 004304 463 004327 464 004331 465 004343 467 004346 468 004366 469 004401 470 004430 472 004432 473 004434 495 004437 504 004440 506 004442 507 004447 508 004451 509 004470 510 004472 511 004517 512 004522 514 004523 515 004527 516 004533 518 004534 520 004536 521 004541 522 004545 523 004551 524 004555 525 004561 526 004565 527 004567 528 004571 530 004573 532 004575 533 004577 535 004602 536 004605 537 004610 538 004612 540 004615 542 004630 545 004634 546 004641 553 004643 554 004652 555 004672 556 004715 560 004717 561 004721 562 004745 565 004774 567 004776 569 005001 572 005024 573 005026 575 005035 580 005036 586 005044 587 005066 588 005071 589 005077 591 005104 592 005140 594 005152 600 005155 608 005156 610 005157 614 005160 615 005162 616 005167 617 005171 618 005172 619 005174 622 005177 623 005201 624 005206 625 005213 626 005220 627 005225 628 005232 629 005234 630 005241 631 005243 632 005250 633 005267 634 005274 635 005276 638 005300 640 005304 641 005334 642 005361 645 005362 646 005374 647 005403 648 005441 649 005446 651 005451 652 005453 653 005455 654 005457 655 005461 657 005463 659 005464 661 005465 662 005476 663 005500 664 005524 666 005525 667 005534 677 005535 695 005543 696 005551 697 005557 698 005560 699 005565 702 005567 703 005574 704 005577 712 005603 721 005614 723 005624 724 005626 726 005627 727 005650 728 005654 729 005655 730 005656 731 005657 734 005663 745 005671 746 005674 752 005720 760 005721 762 005724 763 005734 764 005740 765 005753 766 005755 768 005756 770 005757 771 005762 772 005764 868 005765 870 005766 871 006040 872 006044 873 006070 875 006071 ----------------------------------------------------------- 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