bce_create_sstnt.pl1 11/11/89 1133.6r w 11/11/89 0825.6 96876 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-01-14,Fawcett), approve(86-04-11,MCR7383), audit(86-05-12,Farley), install(86-07-17,MR12.0-1097): Add support for devices using 512_WORD_IO 2) change(87-02-04,Farley), approve(87-04-15,MCR7660), audit(87-04-16,Lippard), install(87-04-28,MR12.1-1028): Changed to correct the calculation of vtoc_offset. END HISTORY COMMENTS */ bce_create_sstnt: proc (sst_abs_start, sst_abs_end); /* Program to generate the sst_names_ segment for Multics within bce. Written August 1984 by Keith Loepere. */ /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */ /* The sst_names_ segment gives the name of the segment corresponding to each aste. The segment may be maintained by Multics, by specifying the "astk" parm, or by this program. The sst_names_ maintained by this program fetches the name for an aste from the corresponding vtoce. */ /* Parameters */ dcl sst_abs_end fixed bin (26) parameter; dcl sst_abs_start fixed bin (26) parameter; /* Constants */ dcl ME char (12) init ("create_sstnt") static options (constant); dcl page_table_sizes (0:3) fixed bin init (4, 16, 64, 256) static options (constant); /* Entries */ dcl bce_appending_simulation$get_absolute entry (fixed bin (26), fixed bin (18), ptr, fixed bin (35)); dcl bce_appending_simulation$get_virtual entry (ptr, fixed bin (26), fixed bin (18), ptr, fixed bin (35)); dcl bce_appending_simulation$new_segment entry (fixed bin (15), ptr, fixed bin (35)); dcl bce_appending_simulation$put_virtual entry (ptr, fixed bin (26), fixed bin (18), ptr, fixed bin (35)); dcl bce_check_abort entry; dcl com_err_ entry () options (variable); dcl ioa_ entry () options (variable); dcl read_disk$read_disk_no_test entry (fixed bin, fixed bin (18), ptr, fixed bin (35)); /* Variables */ dcl aste_num fixed bin; /* loop index on astes in a pool */ dcl aste_pool fixed bin; /* loop index on aste pools */ dcl code fixed bin (35); dcl 1 my_aste aligned like aste; /* read in aste */ dcl 1 my_sstnt_seg_info aligned like seg_info; /* description of sstnt */ dcl sst_buffer bit (36 * 1024) aligned; /* fetch the sst a page at a time for efficiency */ dcl sst_buffer_offset fixed bin (18); /* this ptr shows how much of page buffer we've processed */ dcl sst_name char (32) var; /* element of sst_names_ */ dcl sst_seg_offset fixed bin (26); /* of data in sst_buffer */ dcl sst_sizes (0:3) fixed bin; /* size of pools */ dcl sstnt_buffer bit (36 * 1024) aligned; /* write the sstnt a page at a time for efficiency */ dcl sstnt_buffer_offset fixed bin (18); /* this ptr shows how much of page buffer we've processed */ dcl sstnt_header_size fixed bin (18); /* everything before the names */ dcl sstnt_seg_offset fixed bin (26); /* of start of data in sstnt_buffer */ dcl vtoc_offset fixed bin; /* offset of desired vtoce within page */ dcl vtoc_record bit (36 * 1024) aligned; /* for reading vtoces */ dcl vtoc_record_num fixed bin (18); /* page number holding vtoce */ /* Misc */ dcl addr builtin; dcl addrel builtin; dcl currentsize builtin; dcl divide builtin; dcl max builtin; dcl min builtin; dcl mod builtin; dcl rtrim builtin; dcl segno builtin; dcl size builtin; dcl substr builtin; dcl unspec builtin; dcl wordno builtin; %page; seg_info_ptr = addr (my_sstnt_seg_info); call bce_appending_simulation$new_segment (segno (addr (sst_names_$)), seg_info_ptr, code); if code ^= 0 then go to sstnt_error; sstnp = addr (sstnt_buffer); /* fetch current sst_names_ header */ sstnt_header_size = wordno (addr (sstnt.names)) - wordno (sstnp); call bce_appending_simulation$get_virtual (seg_info_ptr, 0, sstnt_header_size, sstnp, code); if code ^= 0 then go to sstnt_error; /* Now for some validity checks on sst_names_. */ if sstnt.valid & sstnt.multics_or_bce = "mult" then return; if sstnt.ast_sizes (0) ^= page_table_sizes (0) + size (aste) | sstnt.ast_sizes (1) ^= page_table_sizes (1) + size (aste) | sstnt.ast_sizes (2) ^= page_table_sizes (2) + size (aste) | sstnt.ast_sizes (3) ^= page_table_sizes (3) + size (aste) then return; /* not initialized */ sst_sizes (0) = sstnt.ast_name_offsets (1); /* size of pools */ sst_sizes (1) = sstnt.ast_name_offsets (2) - sstnt.ast_name_offsets (1); sst_sizes (2) = sstnt.ast_name_offsets (3) - sstnt.ast_name_offsets (2); sst_sizes (3) = sstnt.nentries - sstnt.ast_name_offsets (3); if sstnt.ast_offsets (1) ^= sstnt.ast_offsets (0) + /* check pool sizes versus supplied offsets */ sst_sizes (0) * (page_table_sizes (0) + size (aste)) then return; if sstnt.ast_offsets (2) ^= sstnt.ast_offsets (1) + sst_sizes (1) * (page_table_sizes (1) + size (aste)) then return; if sstnt.ast_offsets (3) ^= sstnt.ast_offsets (2) + sst_sizes (2) * (page_table_sizes (2) + size (aste)) then return; if sst_abs_end - sst_abs_start + 1 < sstnt.ast_offsets (3) + sst_sizes (3) * (page_table_sizes (3) + size (aste)) then return; if seg_info.size < currentsize (sstnt) then return; /* sstnt not big enough for names - not made paged yet? */ /* We keep a (1 page) buffer of the sst at all times for efficiency. For our purposes, we don't need the sst header. We'll start reading with the start of the astes. So, we start by fetching that buffers' worth of the sst that contains the start of the astes. */ sst_seg_offset = sstnt.ast_offsets (0); sst_buffer_offset = mod (sst_seg_offset, size (sst_buffer)); call bce_appending_simulation$get_absolute (sst_abs_start + sst_seg_offset - sst_buffer_offset, size (sst_buffer), addr (sst_buffer), code); /* We also keep a (1 page) buffer of the sstnt waiting to be written. Start us out as writing after the header (which we'll write later). */ sstnt_buffer_offset = sstnt_header_size; sstnt_seg_offset = 0; sstnt.multics_or_bce = "bce"; sstnt.valid = "1"b; call ioa_ ("Filling sst_names_"); %page; astep = addr (my_aste); /* Read each aste. For all valid ones, grab the name from the vtoce. */ pvt_arrayp = addr (pvt$array); do aste_pool = 0 to 3; do aste_num = 1 to sst_sizes (aste_pool); sst_name = ""; call get_next_aste (page_table_sizes (aste_pool)); if aste.uid = "0"b then go to next_aste; if aste.uid = "777777777777"b3 then do; sst_name = ">"; go to next_aste; end; if aste.hc then go to next_aste; if aste.vtocx = -1 then go to next_aste; if aste.pvtx > pvt$max_n_entries then goto next_aste; pvtep = addr (pvt_array (aste.pvtx)); vtoc_record_num = VTOC_ORIGIN + divide (aste.vtocx, VTOCES_PER_RECORD (pvte.device_type), 17); vtoc_offset = sect_per_vtoc (pvte.device_type) * words_per_sect (pvte.device_type) * mod (aste.vtocx, VTOCES_PER_RECORD (pvte.device_type)); call read_disk$read_disk_no_test ((aste.pvtx), vtoc_record_num, addr (vtoc_record), code); if code ^= 0 then go to next_aste; vtocep = addrel (addr (vtoc_record), vtoc_offset); sst_name = rtrim (vtoce.primary_name); next_aste: call add_name_to_sstnt; call bce_check_abort; end; end; call add_name_to_sstnt$flush; return; sstnt_error: call com_err_ (code, ME); return; %page; add_name_to_sstnt: proc; /* This subproc adds sst_name to the end of sstnt_buffer. If this runs off the end, the current buffer is written and the excess added to the new buffer's worth. */ dcl sst_name_bits bit (size (sst_name) * 36) aligned based (addr (sst_name)); dcl words_in_current_page fixed bin; dcl words_in_new_page fixed bin; words_in_current_page = min (size (sstnt_buffer) - sstnt_buffer_offset, size (sst_name)); substr (sstnt_buffer, 1 + sstnt_buffer_offset * 36, words_in_current_page * 36) = substr (sst_name_bits, 1, words_in_current_page * 36); sstnt_buffer_offset = sstnt_buffer_offset + words_in_current_page; if sstnt_buffer_offset = size (sstnt_buffer) then do; call bce_appending_simulation$put_virtual (seg_info_ptr, sstnt_seg_offset, size (sstnt_buffer), addr (sstnt_buffer), code); sstnt_seg_offset = sstnt_seg_offset + size (sstnt_buffer); words_in_new_page = size (sst_name) - words_in_current_page; substr (sstnt_buffer, 1, words_in_new_page * 36) = substr (sst_name_bits, 1 + words_in_current_page * 36, words_in_new_page * 36); sstnt_buffer_offset = words_in_new_page; end; return; add_name_to_sstnt$flush: entry; call bce_appending_simulation$put_virtual (seg_info_ptr, sstnt_seg_offset, sstnt_buffer_offset, addr (sstnt_buffer), code); return; end add_name_to_sstnt; %page; get_next_aste: proc (page_table_size); /* This subproc returns the next aste in the sst. It skips over the page table. It reads in the next page of sst if necessary to do this. */ dcl page_table_size fixed bin parameter; dcl aste_size fixed bin; dcl words_in_current_page fixed bin; dcl words_in_page_to_be_fetched fixed bin; dcl words_to_copy fixed bin; aste_size = page_table_size + size (aste); words_in_current_page = min (size (sst_buffer) - sst_buffer_offset, aste_size); words_to_copy = min (words_in_current_page, size (aste)); substr (unspec (aste), 1, words_to_copy * 36) = substr (sst_buffer, 1 + sst_buffer_offset * 36, words_to_copy * 36); sst_seg_offset = sst_seg_offset + words_in_current_page; sst_buffer_offset = sst_buffer_offset + words_in_current_page; if sst_buffer_offset >= size (sst_buffer) then do; call bce_appending_simulation$get_absolute (sst_abs_start + sst_seg_offset, size (sst_buffer), addr (sst_buffer), code); words_in_page_to_be_fetched = aste_size - words_in_current_page; words_to_copy = max (size (aste) - words_in_current_page, 0); substr (unspec (aste), 1 + words_in_current_page * 36, words_to_copy * 36) = substr (sst_buffer, 1, words_to_copy * 36); sst_seg_offset = sst_seg_offset + words_in_page_to_be_fetched; sst_buffer_offset = words_in_page_to_be_fetched; end; return; end get_next_aste; %page; %include bce_appending_seg_info; %page; %include disk_pack; %page; %include fs_dev_types_sector; %page; %include ptw_info; %page; %include pvte; %page; %include sstnt; %page; %include vtoce; end bce_create_sstnt;  bce_dump.pl1 11/11/89 1133.6r w 11/11/89 0825.6 245574 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-01-14,Fawcett), approve(86-04-11,MCR7383), audit(86-05-12,Farley), install(86-07-17,MR12.0-1097): Change the call to find_partition$given_drive for subvolumes END HISTORY COMMENTS */ bce_dump: proc (ss_info_ptr); /* Program to perform a disk dump of a crashed Multics system within bootload Multics. Written November 1983 by Keith Loepere. */ /* Modified August 1984 by Keith Loepere for sstnt option and to change defaults. */ /* Modified November 1984 by M. Pandolf to include hc_lock. */ /* Modified January 1985 by Keith Loepere for new find_partition, and to get severity right. */ /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */ /* Names of process categories and options. */ dcl All fixed bin init (1) static options (constant); /* process_group_num */ dcl Directories fixed bin init (1) static options (constant); /* segment_group_num */ dcl Eligible fixed bin init (2) static options (constant); /* process_group_num */ dcl Hardcore fixed bin init (2) static options (constant); /* segment_group_num */ dcl Initializer fixed bin init (3) static options (constant); /* process_group_num */ dcl Modifying_dirs fixed bin init (3) static options (constant); /* segment_group_num */ dcl Per_process fixed bin init (4) static options (constant); /* segment_group_num */ dcl Process_group_names (4) char (32) static options (constant) init ("-all", "-eligible", "-initializer", "-running"); dcl Process_group_names_short (4) char (5) static options (constant) init ("-all", "-elig", "-inzr", "-run"); dcl Running fixed bin init (4) static options (constant); /* process_group_num */ dcl Segment_group_names (6) char (32) static options (constant) init ("directories", "hardcore", "modifying_dirs", "per_process", "stacks", "writeable"); dcl Segment_group_names_short (6) char (6) static options (constant) init ("dir", "hc", "moddir", "pp", "stk", "wrt"); dcl Stacks fixed bin init (5) static options (constant); /* segment_group_num */ dcl Writeable fixed bin init (6) static options (constant); /* segment_group_num */ dcl addcharno builtin; dcl addr builtin; dcl addrel builtin; dcl after builtin; dcl apte_num fixed bin; /* loop var */ dcl arg char (arg_len) based (arg_ptr); dcl arg_len fixed bin (21); dcl arg_num fixed bin; /* loop var */ dcl arg_ptr ptr; dcl before builtin; dcl bce_appending_simulation$get_absolute entry (fixed bin (26), fixed bin (18), ptr, fixed bin (35)); dcl bce_appending_simulation$get_virtual entry (ptr, fixed bin (26), fixed bin (18), ptr, fixed bin (35)); dcl bce_appending_simulation$init entry (bit (1) aligned, fixed bin (35)); dcl bce_appending_simulation$new_dbr entry (bit (72) aligned, fixed bin (15), fixed bin (35)); dcl bce_appending_simulation$new_sdw entry (fixed bin (71), ptr, fixed bin (35)); dcl bce_appending_simulation$new_segment entry (fixed bin (15), ptr, fixed bin (35)); dcl bce_check_abort entry; dcl bce_create_sstnt entry (fixed bin (26), fixed bin (26)); dcl bce_query$yes_no entry options (variable); dcl bin builtin; dcl bit builtin; dcl clock builtin; dcl code fixed bin (35); dcl com_err_ entry () options (variable); dcl crash_dbr bit (72) aligned; dcl crash_dbr_addr fixed bin (26); dcl create_sstnt bit (1) aligned; dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin (35)); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl current_dbr bit (72) aligned; dcl current_dump_record fixed bin (18); /* record on disk of start of this segment */ dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl dbr_util_$dissect entry (ptr, ptr); dcl dimension builtin; dcl directory_mod bit (36) aligned; /* modify field of dir */ dcl divide builtin; dcl drive_num char (4); dcl dump_severity fixed bin init (3) static; dcl dseg$ external; dcl dseg_buffer (0:511) fixed bin (71); /* buffer page of dseg to optimize sdw checking */ dcl 1 dseg_info aligned like seg_info; dcl dseg_no fixed bin (15); /* segno of dseg */ dcl dump_astep ptr; /* for dump_seg */ dcl dump_disk_pvid bit (36) aligned; dcl dump_disk_pvtx fixed bin; dcl dump_drive_name char (8); dcl dump_number fixed bin; /* user supplied */ dcl dump_options (4) bit (6) aligned;/* options for processes to dump (process_group_num, segment_group_num) */ dcl dump_ptp ptr; /* page table for dump_seg */ dcl dump_seg$ external; /* mapped onto dump partition */ dcl dumped_hc_seg (0:255) bit (1) unal; /* set true when we succeed in dumping hc seg n */ dcl error_table_$bad_arg fixed bin (35) ext static; dcl error_table_$noarg fixed bin (35) ext static; dcl examine_crash bit (1) aligned; dcl find_partition entry (char (*), fixed bin, bit (36) aligned, fixed bin (18), fixed bin (18), fixed bin (35)); dcl find_partition$given_drive entry (char (*), char (4), char (4), fixed bin, bit (36) aligned, fixed bin (18), fixed bin (18), fixed bin (35)); dcl first_dump_record fixed bin (18); /* first record in partition */ dcl force bit (1) aligned; dcl get_ptrs_$given_segno entry (fixed bin (15)) returns (ptr); dcl hbound builtin; dcl hreg fixed bin; /* loop var */ dcl i fixed bin; /* loop var */ dcl ioa_ entry () options (variable); dcl kst_no fixed bin (15); /* segno of kst */ dcl kst_seg$ external; dcl last_apte fixed bin; /* range of aptes to dump */ dcl last_segnum fixed bin (15); /* range of valid segnos */ dcl lbound builtin; dcl me char (8) static init ("bce_dump") options (constant); dcl min builtin; dcl mod builtin; dcl 1 my_apte aligned like apte; dcl 1 my_aste aligned like aste; dcl 1 my_dbr_info aligned like dbr_info; dcl 1 my_dump aligned like dump; dcl my_page_buffer bit (1024 * 36) aligned; dcl 1 my_ptw_info aligned like ptw_info; dcl 1 my_sdw_info aligned like sdw_info; dcl 1 my_seg_info aligned like seg_info; dcl n_args fixed bin; /* command line args */ dcl not_option bit (1) aligned; /* true => use not of current option */ dcl null_page bit (1) aligned; /* false => found non-null page in segment */ dcl num_pages fixed bin; /* in segment to dump */ dcl num_records fixed bin (18); /* in dump part */ dcl page_buffer bit (1024 * 36) aligned based; dcl page_num fixed bin; /* loop var */ dcl pc$cleanup entry (ptr); dcl pds$ external; dcl pds_no fixed bin (15); /* segno of pds */ dcl prds$ external; dcl prds_no fixed bin (15); /* segno of prds */ dcl proc_options bit (6) unal; /* options (segment_group_num) for segments for this proc */ dcl process_group_num fixed bin; /* loop var */ dcl processed_crash_dbr bit (1) aligned; /* true when we found the apte for the crashing process */ dcl ptw_util_$dissect entry (ptr, ptr); dcl ptw_util_$make_null_disk entry (ptr, fixed bin (20)); dcl read_disk entry (fixed bin, fixed bin (18), ptr, fixed bin (35)); dcl request_abort_ condition; dcl rsw_util$port_info entry (fixed bin (3), bit (1) aligned, fixed bin, fixed bin, fixed bin (3)); dcl scu_base fixed bin; dcl scu_enabled bit (1) aligned; dcl scu_interlace fixed bin (3); dcl scu_size fixed bin; dcl scu_tag fixed bin (3); dcl sdw_util_$dissect entry (ptr, ptr); dcl seg_sdw fixed bin (71) based (seg_sdw_ptr); dcl seg_sdw_ptr ptr; dcl segment_group_num fixed bin; /* loop var */ dcl segno builtin; dcl segnum fixed bin (15); /* loop var */ dcl size builtin; dcl sst_bit_map bit (16384) aligned;/* map which implies which astes have been dumped, figuring that each aste/pt takes at least 16 words */ dcl sst_end fixed bin (26); /* range of addresses for sst page segs */ dcl sst_index fixed bin; /* index into sst_bit_map for this apparent aste */ dcl sst_seg$ external; dcl sst_start fixed bin (26); dcl substr builtin; dcl subsystem char (4); dcl sys_boot_info$bce_dbr bit (72) aligned external; dcl sys_info$clock_ bit (3) aligned external; dcl tc_data$ external; dcl tc_data_addr fixed bin (26); /* absadr */ dcl tc_data_no fixed bin (15); /* segno of tc_data */ dcl 1 toehold$ aligned like toe_hold external; dcl unspec builtin; dcl wordno builtin; dcl write_disk entry (fixed bin, fixed bin (18), ptr, fixed bin (35)); dcl yes_no bit (1); %page; /* Start by finding supplied dump options. */ dump_severity = 2; unspec (dump_options) = "0"b; dump_number = 0; force = "0"b; create_sstnt = "1"b; /* defaults */ dump_drive_name = ""; examine_crash = (sys_info$collection_1_phase = CRASH_INITIALIZATION | sys_info$collection_1_phase = BCE_CRASH_INITIALIZATION); call cu_$arg_count_rel (n_args, ss_info.arg_list_ptr, code); if code ^= 0 then signal request_abort_; if n_args = 0 then do; call ioa_ ("Usage is: dump {-force | -fc}."); call ioa_ ("Options are:"); call ioa_ (" -dump #"); call ioa_ (" -sstnt | -no_sstnt"); call ioa_ (" -drive | -dv "); call ioa_ (" -brief | -bf | -standard | -std | -long | -lg"); call ioa_ (" -crash | -bce"); call ioa_ (" <-process_group> "); call ioa_ (" Process groups are:"); do i = 1 to dimension (Process_group_names, 1); call ioa_ (" ^a ^a", Process_group_names (i), Process_group_names_short (i)); end; call ioa_ (" Segment options are:"); do i = 1 to dimension (Segment_group_names, 1); call ioa_ (" ^a ^a", Segment_group_names (i), Segment_group_names_short (i)); end; return; end; arg_num = 1; do while (arg_num <= n_args); call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, ss_info.arg_list_ptr); arg_num = arg_num + 1; if arg = "-dump" then do; if arg_num > n_args then do; call com_err_ (error_table_$noarg, me, "dump number"); return; end; call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, ss_info.arg_list_ptr); arg_num = arg_num + 1; dump_number = cv_dec_check_ (arg, code); if code ^= 0 then do; call com_err_ (0, me, "Bad dump number. ^a", arg); return; end; end; else if arg = "-drive" | arg = "-dv" then do; if arg_num > n_args then do; call com_err_ (error_table_$noarg, me, "drive name"); return; end; call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, ss_info.arg_list_ptr); arg_num = arg_num + 1; dump_drive_name = arg; end; else if arg = "-force" | arg = "-fc" then force = "1"b; else if arg = "-crash" then examine_crash = "1"b; else if arg = "-bce" then examine_crash = "0"b; else if arg = "-sstnt" then create_sstnt = "1"b; else if arg = "-no_sstnt" then create_sstnt = "0"b; else if arg = "-brief" | arg = "-bf" then do; unspec (dump_options) = "0"b; substr (dump_options (Running), Hardcore, 1) = "1"b; substr (dump_options (Running), Modifying_dirs, 1) = "1"b; substr (dump_options (Running), Per_process, 1) = "1"b; end; else if arg = "-standard" | arg = "-std" then do; unspec (dump_options) = "0"b; substr (dump_options (Running), Hardcore, 1) = "1"b; substr (dump_options (Running), Modifying_dirs, 1) = "1"b; substr (dump_options (Running), Per_process, 1) = "1"b; substr (dump_options (Eligible), Hardcore, 1) = "1"b; substr (dump_options (Eligible), Stacks, 1) = "1"b; dump_options (Initializer) = dump_options (Eligible); end; else if arg = "-long" | arg = "-lg" then do; unspec (dump_options) = "0"b; substr (dump_options (All), Writeable, 1) = "1"b; end; else do; do process_group_num = 1 to dimension (Process_group_names, 1) while (Process_group_names (process_group_num) ^= arg & Process_group_names_short (process_group_num) ^= arg); end; if process_group_num > dimension (Process_group_names, 1) then do; call com_err_ (error_table_$bad_arg, me, "^a", arg); return; end; if arg_num > n_args then do; call com_err_ (error_table_$noarg, me, "segment group options"); return; end; next_segment_option: call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, ss_info.arg_list_ptr); if arg_len > 0 then if substr (arg, 1, 1) = "^" then do; not_option = "1"b; arg_len = arg_len - 1; arg_ptr = addcharno (arg_ptr, 1); /* eat not flag */ end; else not_option = "0"b; else not_option = "0"b; do segment_group_num = 1 to dimension (Segment_group_names, 1) while (Segment_group_names (segment_group_num) ^= arg & Segment_group_names_short (segment_group_num) ^= arg); end; if segment_group_num <= dimension (Segment_group_names, 1) then do; substr (dump_options (process_group_num), segment_group_num, 1) = ^not_option; arg_num = arg_num + 1; if arg_num <= n_args then go to next_segment_option; /* else we fall through and see this ctl-arg on next loop up */ end; end; end; dump_options (Eligible) = dump_options (Eligible) | dump_options (All); /* merge options */ dump_options (Running) = dump_options (Running) | dump_options (Eligible); call ioa_ ("Dumping ^[Multics image^;bce^].", examine_crash); %page; /* Setup and initialization. */ if examine_crash then crash_dbr = toehold$.multics_state.dbr; else crash_dbr = sys_boot_info$bce_dbr; dbr_info_ptr = addr (my_dbr_info); call dbr_util_$dissect (addr (crash_dbr), dbr_info_ptr); crash_dbr_addr = dbr_info.address; dumpptr = addr (my_dump); call bce_appending_simulation$init (examine_crash, code); if code ^= 0 then do; apnd_error: call com_err_ (code, me, "appending simulation package"); return; end; if dump_drive_name = "" then call find_partition ("dump", dump_disk_pvtx, dump_disk_pvid, first_dump_record, num_records, code); else do; /* oper supplied drive */ subsystem = before (dump_drive_name, "_"); drive_num = after (dump_drive_name, "_"); if code ^= 0 then do; call com_err_ (0, me, "Bad dump partition drive_name."); return; end; call find_partition$given_drive ("dump", subsystem, drive_num, dump_disk_pvtx, dump_disk_pvid, first_dump_record, num_records, code); end; if code ^= 0 then do; dump_partition_error: call com_err_ (code, me, "dump partition"); return; end; /* Get current header. */ call read_disk (dump_disk_pvtx, first_dump_record, dumpptr, code); if code ^= 0 then go to dump_partition_error; if dump.valid then if ^force then do; call bce_query$yes_no (yes_no, "dump: The dump partition contains the supposedly valid dump #^d.^/Do you wish to overwrite it? ", dump.erfno); if ^yes_no then do; dump_severity = 1; return; end; end; dump.valid = "0"b; if dump_number > 0 then dump.erfno = dump_number; else dump.erfno = dump.erfno + 1; call ioa_ ("Dump #^d", dump.erfno); call write_disk (dump_disk_pvtx, first_dump_record, dumpptr, code); /* hedge against crash */ if code ^= 0 then go to dump_partition_error; dump.words_dumped = 0; begin; dcl kludge_valid bit (36) aligned based (addr (dump.valid)); kludge_valid = "111111111111111111111111111111111111"b; /* azm expects it */ end; dump.time = clock; /* fill in header */ dump.num_segs = 0; dump.valid_355 = "0"b; dump.dumped_355s = "0"b; dump.time_355 = 0; dump.version = DUMP_VERSION_2; /* save the various toehold information into the header. */ dump.dbr = crash_dbr; dump.low_order_port = sys_info$clock_; if examine_crash then do; dump.amptwregs = toehold$.ptwam_regs; dump.amptwptrs = toehold$.ptwam_ptrs; dump.amsdwregs = toehold$.sdwam_regs; dump.amsdwptrs = toehold$.sdwam_ptrs; do hreg = 0 to 15; dump.ouhist (hreg) = toehold$.ou_history_registers (hreg); dump.cuhist (hreg) = toehold$.cu_history_registers (hreg); dump.duhist (hreg) = toehold$.du_history_registers (hreg); dump.auhist (hreg) = toehold$.apu_history_registers (hreg); end; dump.prs = toehold$.mc_.prs; unspec (dump.regs) = unspec (toehold$.mc_.regs); dump.mctime = bin (toehold$.mc_.fault_time, 54); unspec (dump.scu) = unspec (toehold$.mc_.scu); unspec (dump.mcm) = unspec (toehold$.masks); substr (dump.intrpts, 1, 16) = substr (toehold$.interrupt, 1, 16); substr (dump.intrpts, 17, 16) = substr (toehold$.interrupt, 37, 16); dump.bar = toehold$.bar; dump.modereg = toehold$.mode_reg; dump.cmodereg = toehold$.cache_mode_reg; dump.faultreg = toehold$.mc_.fault_reg; dump.ptrlen = toehold$.mc_.eis_info; end; do scu_tag = lbound (dump.coreblocks.num_first, 1) to hbound (dump.coreblocks.num_first, 1); call rsw_util$port_info (scu_tag, scu_enabled, scu_base, scu_size, scu_interlace); dump.coreblocks.num_first (scu_tag) = bit (scu_base, 18); dump.coreblocks.num_blocks (scu_tag) = bit (scu_size, 18); end; %page; current_dump_record = first_dump_record + 66; /* 2 for header and 64 for (obsolete) fnp dumping */ dseg_no = segno (addr (dseg$)); /* interesting per-process(or) segments */ pds_no = segno (addr (pds$)); prds_no = segno (addr (prds$)); kst_no = segno (addr (kst_seg$)); aptep = addr (my_apte); /* ptrs to local copies of things */ sdw_info_ptr = addr (my_sdw_info); ptw_info_ptr = addr (my_ptw_info); seg_info_ptr = addr (my_seg_info); astep = addr (my_aste); dp = addr (directory_mod); dump_astep = get_ptrs_$given_segno (segno (addr (dump_seg$))); dump_ptp = addrel (dump_astep, size (aste)); dump_astep -> aste.pvtx = dump_disk_pvtx; do page_num = 0 to 255; call ptw_util_$make_null_disk (addrel (dump_ptp, page_num), first_dump_record + page_num); /* safe initial state */ end; /* Find range of aptes to dump from tc_data. */ tcmp = addr (tc_data$); tc_data_no = segno (addr (tc_data$)); call bce_appending_simulation$new_segment (tc_data_no, seg_info_ptr, code); if code ^= 0 then last_apte = 0; else do; if seg_info.paged then do; call ptw_util_$dissect (addr (seg_info.page_table (0)), ptw_info_ptr); tc_data_addr = ptw_info.address; end; else tc_data_addr = seg_info.address; call bce_appending_simulation$get_absolute (tc_data_addr + wordno (addr (tcm.apt_size)), 1, addr (last_apte), code); if code ^= 0 then last_apte = 0; end; /* Get sst bounds (for finding sst paged segments). */ sst_start = 0; sst_end = -1; call bce_appending_simulation$new_segment (segno (addr (sst_seg$)), seg_info_ptr, code); if code = 0 then do; if seg_info.paged then do; call ptw_util_$dissect (addr (seg_info.page_table (0)), ptw_info_ptr); sst_start = ptw_info.address; end; else sst_start = seg_info.address; sst_end = sst_start + seg_info.size - 1; end; processed_crash_dbr = "0"b; dumped_hc_seg (*) = "0"b; sst_bit_map = "0"b; if create_sstnt then call bce_create_sstnt (sst_start, sst_end); %page; /* Walk down through aptes, dumping what the operator wants dumped for each one. */ /* We iterate over all aptes in tc_data. When we find the apte that matches the process that crashed, we set processed_crash_dbr. Otherwise, this isn't set and we make one more pass (0) which picks this process up. */ do apte_num = 1 to last_apte, 0 while (^processed_crash_dbr); /* include dbr in machine conditions */ call bce_check_abort; /* operator wants to stop? */ if apte_num > 0 then do; /* else using crash dbr */ call bce_appending_simulation$get_absolute (tc_data_addr + wordno (addr (tcm.apt)) + (apte_num - 1) * size (apte), size (apte), aptep, code); if code ^= 0 then go to next_apte; if apte.state = Empty_apte then go to next_apte; current_dbr = unspec (apte.dbr); /* Find options that apply to this process. */ if dump_options (Running) ^= "0"b & (apte.dbr_loaded | apte.state = Stopped_apte) then proc_options = dump_options (Running); else if apte.eligible then proc_options = dump_options (Eligible); else proc_options = dump_options (All); if apte_num = 1 then proc_options = proc_options | dump_options (Initializer); /* inzr is first apte */ end; else do; current_dbr = crash_dbr; proc_options = dump_options (Running) | dump_options (Initializer); /* grab all you can */ end; call dbr_util_$dissect (addr (current_dbr), dbr_info_ptr); if dbr_info.address = crash_dbr_addr then processed_crash_dbr = "1"b; if proc_options = "0"b then go to next_apte; /* not interesting */ substr (proc_options, Hardcore, 1) = "1"b; /* need to dump these, if any, so that process is visible in dump (a decrease in segnos appears) */ call bce_appending_simulation$new_dbr (current_dbr, last_segnum, code); if code ^= 0 then go to next_apte; call bce_appending_simulation$new_segment (dseg_no, addr (dseg_info), code); if code ^= 0 then go to next_apte; call ioa_ ("proc ^o, dbr = ^24.3b", apte_num, current_dbr); %page; /* Process segments desired. */ do segnum = 0 to last_segnum; call bce_check_abort; /* last chance for operator to stop */ /* optimization - keep around a page of dseg; see if an sdw is faulted before expending new_segment on it */ if mod (segnum, dimension (dseg_buffer, 1)) = 0 then /* crossed into next buffer of sdw's (next dseg page) */ call bce_appending_simulation$get_virtual (addr (dseg_info), segnum * 2, size (dseg_buffer), addr (dseg_buffer), code); /* zero sdw's on error */ seg_sdw_ptr = addr (dseg_buffer (mod (segnum, dimension (dseg_buffer, 1)))); call sdw_util_$dissect (seg_sdw_ptr, sdw_info_ptr); if sdw_info.faulted then go to next_seg; call bce_appending_simulation$new_sdw (seg_sdw, seg_info_ptr, code); if code ^= 0 then go to next_seg; /* See if we should dump this segment. */ if substr (proc_options, Hardcore, 1) then if segnum = dseg_no | segnum = pds_no | segnum = prds_no | segnum = kst_no then go to dump_seg; if ^seg_info.write then go to next_seg; if dbr_info.stack_base_segnum = 0 /* idle or initialization (all segs hc) */ | segnum < dbr_info.stack_base_segnum then /* hc seg */ if segnum > hbound (dumped_hc_seg, 1) then go to dump_seg; else if ^dumped_hc_seg (segnum) then do; dumped_hc_seg (segnum) = "1"b; go to dump_seg; /* dump for first proc */ end; else go to next_seg; /* not for others */ if substr (proc_options, Stacks, 1) & (dbr_info.stack_base_segnum <= segnum & segnum < dbr_info.stack_base_segnum + 8) then go to dump_seg; /* stacks */ if ^seg_info.paged then go to dump_seg; /* unpaged non-hardcore - rare */ if sst_start > 0 then do; /* there was a sst */ if seg_info.address < sst_start | sst_end < seg_info.address then go to dump_seg; /* not sst paged seg - rare for non-hc */ /* We now have a non-hardcore standard paged segment. */ if ^substr (proc_options, Writeable, 1) then do; /* if we don't want all writable, segments need some justification */ if seg_info.sst_data.per_process & substr (proc_options, Per_process, 1) then go to consider_seg; if seg_info.sst_data.dirsw then do; if substr (proc_options, Directories, 1) then go to consider_seg; if substr (proc_options, Modifying_dirs, 1) then do; call bce_appending_simulation$get_virtual (seg_info_ptr, wordno (addr (dir.modify)) - wordno (dp), 1, dp, code); if dir.modify then go to consider_seg; end; end; go to next_seg; end; consider_seg: /* We want to dump this segment. First, though, we ask if we dumped it before (we have processed its aste before). Since no two astes can fit in the same 16 words of memory (they are at least 16 words long), we can divide the sst into 16 word blocks. If two segments claim different (starting) blocks, we say they have different astes and are different segments. */ sst_index = divide (seg_info.address - sst_start + 8, 16, 14) + 1; if substr (sst_bit_map, sst_index, 1) then go to next_seg; /* already dumped */ substr (sst_bit_map, sst_index, 1) = "1"b; end; else go to next_seg; %page; dump_seg: /* Time to dump this segment. See if it will fit. */ if dump.num_segs = dimension (dump.segs, 1) then do; call ioa_ ("Segment array overflow."); go to end_dump; end; dump.num_segs = dump.num_segs + 1; dump.segs.segno (dump.num_segs) = bit (bin (segnum, 18), 18); dump.segs.length (dump.num_segs) = "0"b; /* Map dump_seg onto next area of dump part. */ num_pages = divide (seg_info.size + 1023, 1024, 8); if current_dump_record + num_pages > first_dump_record + num_records then do; call ioa_ ("Dump partition overflow."); go to end_dump; end; do page_num = 0 to num_pages - 1; call ptw_util_$make_null_disk (addrel (dump_ptp, page_num), current_dump_record + page_num); end; /* We must find the last non-zero page. After this, we move it into dump_seg and then page the rest of the segment into there. We read the segment backwards, for possible i/o latency improvement. */ null_page = "1"b; do page_num = num_pages - 1 to 0 by -1 while (null_page); call bce_appending_simulation$get_virtual (seg_info_ptr, page_num * 1024, min (1024, seg_info.size - page_num * 1024), addr (my_page_buffer), code); if my_page_buffer ^= "0"b then null_page = "0"b; end; if null_page then go to next_seg; /* empty seg */ page_num = page_num + 1; /* last non-null page */ addrel (addr (dump_seg$), page_num * 1024) -> page_buffer = my_page_buffer; if page_num > 0 then call bce_appending_simulation$get_virtual (seg_info_ptr, 0, min (seg_info.size, page_num * 1024), addr (dump_seg$), code); call pc$cleanup (dump_astep); /* write out */ current_dump_record = current_dump_record + page_num + 1; dump.segs.length (dump.num_segs) = bit (bin ((page_num + 1) * 16, 18), 18); dump.words_dumped = dump.words_dumped + (page_num + 1) * 1024; next_seg: end; next_apte: end; dump_severity = 0; /* all done! */ %page; end_dump: /* Write out header */ call write_disk (dump_disk_pvtx, first_dump_record + 1, addrel (dumpptr, 1024), code); call write_disk (dump_disk_pvtx, first_dump_record, dumpptr, code); return; %page; severity: entry () returns (fixed bin); return (dump_severity); %page; %include apte; %page; %include bce_appending_seg_info; %page; %include bce_subsystem_info_; %page; %include bos_dump; %page; %include collection_1_phases; %page; %include dbr_info; %page; %include dir_header; %page; %include ptw_info; %page; %include state_equs; %page; %include tcm; %page; %include hc_lock; %page; %include toe_hold; end; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- 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