convert_v1_fdump.pl1 10/01/82 1523.5rew 10/01/82 1523.6 95850 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ convert_v1_fdump: procedure options (variable); /* * CONVERT_V1_FDUMP * * This command converts a version 1 FDUMP image (from before MR9.0) into * a version 2 FDUMP image. The change is that the dump header has been * reorganized, and is now two pages long, rather than one. * * 03/18/81, W. Olin Sibert */ dcl arg char (al) based (ap); dcl al fixed bin (21); dcl ap pointer; dcl (nargs, argno) fixed bin; dcl code fixed bin (35); dcl page (1024) bit (36) aligned based; dcl 1 old_dump aligned like v1_dump automatic; dcl 1 new_dump aligned like dump automatic; dcl fs_mode fixed bin (5); dcl ename_prefix char (32) varying; dcl ename_suffix char (32) varying; dcl ename char (32); dcl dump_seg_lth fixed bin; dcl total_pages fixed bin; dcl remaining_pages fixed bin; dcl idx fixed bin; dcl error_sw bit (1) aligned; dcl in_place bit (1) aligned; dcl seg_zero_ename char (32); dcl old_dname char (168); dcl old_ptrs (0 : 31) pointer; dcl n_old_segs fixed bin; dcl old_bc (0 : 31) fixed bin (24); dcl old_lth (0 : 31) fixed bin; dcl old_page_ptr pointer; dcl old_seg fixed bin; dcl new_dname char (168); dcl new_equal_name char (32); dcl new_ptrs (0 : 31) pointer; dcl new_name (0 : 31) char (32) unaligned; dcl n_new_segs fixed bin; dcl new_page_ptr pointer; dcl new_seg fixed bin; dcl absolute_pathname_ entry (char (*), char (*), fixed bin (35)); dcl com_err_ entry options (variable); dcl copy_acl_ entry (char (*), char (*), char (*), char (*), bit (1) aligned, fixed bin (35)); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, pointer, fixed bin (21), fixed bin (35)); dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); dcl get_equal_name_ entry (char (*), char (*), char (32), fixed bin (35)); dcl hcs_$fs_get_mode entry (pointer, fixed bin (5), fixed bin (35)); dcl hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), pointer, fixed bin (35)); dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), pointer, fixed bin (35)); dcl hcs_$set_bc_seg entry (pointer, fixed bin (24), fixed bin (35)); dcl ioa_ entry options (variable); dcl sys_info$max_seg_size fixed bin (18) external static; dcl error_table_$noentry fixed bin (35) external static; dcl error_table_$no_w_permission fixed bin (35) external static; dcl WHOAMI char (32) internal static options (constant) init ("convert_v1_fdump"); dcl (addr, char, divide, ltrim, null, pointer, rtrim, substr) builtin; /* */ call cu_$arg_count (nargs, code); if code ^= 0 then do; call com_err_ (code, WHOAMI); MAIN_RETURN: return; end; if (nargs < 1) | (nargs > 2) then do; call com_err_ (0, WHOAMI, "Usage: ^a path-of-comp-zero {equal-path-of-new-comp-zero}", WHOAMI); goto MAIN_RETURN; end; call cu_$arg_ptr (1, ap, al, (0)); call expand_pathname_ (arg, old_dname, ename, code); if code ^= 0 then do; call com_err_ (code, WHOAMI, "^a", arg); goto MAIN_RETURN; end; seg_zero_ename = ename; ename_prefix = substr (ename, 1, 12); /* MMDDYY.HHMM. */ ename_suffix = after (substr (ename, 13), "."); /* ERF number */ if verify (ename_prefix, "0123456789.") ^= 0 then do; BAD_ENAME: call com_err_ (0, WHOAMI, "^a is not the entryname of component zero of an FDUMP.", ename); goto MAIN_RETURN; end; if ename_suffix = "" then goto BAD_ENAME; ename_suffix = "." || rtrim (ename_suffix); if substr (ename, 12, 3) ^= ".0." then goto BAD_ENAME; if nargs > 1 then do; /* Get new dirname */ call cu_$arg_ptr (2, ap, al, (0)); call expand_pathname_ (arg, new_dname, new_equal_name, code); if code ^= 0 then do; call com_err_ (code, WHOAMI, "^a", arg); goto MAIN_RETURN; end; if index (new_equal_name, "=") = 0 then do; call com_err_ (0, WHOAMI, "Entryname for converted dump must be an equal name. ^a", new_equal_name); goto MAIN_RETURN; end; in_place = "0"b; end; else do; new_dname = old_dname; new_equal_name = "=="; in_place = "1"b; end; new_ptrs (*) = null (); old_ptrs (*) = null (); /* First, look for all the segments which are part of this FDUMP image. Stop looking when there are no more. This loop also initiates or creates the output segments. */ total_pages = 0; do idx = 0 by 1; ename = ename_prefix || rtrim (ltrim (char (idx))) || ename_suffix; call hcs_$initiate_count (old_dname, ename, "", old_bc (idx), 0, old_ptrs (idx), code); if old_ptrs (idx) = null () then do; if code = error_table_$noentry then if idx > 0 then goto FINISHED_INITIATING; call com_err_ (code, WHOAMI, "^a^[>^]^a", old_dname, (old_dname ^= ">"), ename); goto MAIN_RETURN; end; old_lth (idx) = divide ((old_bc (idx) + (36 * 1024) - 1), 36 * 1024, 17, 0); total_pages = total_pages + old_lth (idx); call get_equal_name_ (ename, new_equal_name, ename, code); if code ^= 0 then goto BAD_NEW_SEGMENT; new_name (idx) = ename; call hcs_$make_seg (new_dname, ename, "", 01010b, new_ptrs (idx), code); if new_ptrs (idx) = null () then do; BAD_NEW_SEGMENT: call com_err_ (code, WHOAMI, "^a^[>^]^a", new_dname, (new_dname ^= ">"), ename); goto MAIN_RETURN; end; call hcs_$fs_get_mode (new_ptrs (idx), fs_mode, code); if code ^= 0 then goto BAD_NEW_SEGMENT; code = error_table_$no_w_permission; if substr (bit (binary (fs_mode, 5), 5), 4, 1) = "0"b then goto BAD_NEW_SEGMENT; end; /* Now, figure out how many segments there are, what the max length of the dump image segments is, and possibly create another output segment -- this is necessary if all the existing segments are completely full, so that adding a page would cause an overflow into the next segment. */ FINISHED_INITIATING: n_old_segs = idx - 1; if n_old_segs > 0 then /* Zero-Origin */ dump_seg_lth = old_lth (0); else dump_seg_lth = divide (sys_info$max_seg_size, 1024, 17, 0); if old_lth (n_old_segs) + 1 > dump_seg_lth then do; ename = ename_prefix || rtrim (ltrim (char (n_old_segs + 1))) || ename_suffix; n_new_segs = n_old_segs + 1; call get_equal_name_ (ename, new_equal_name, ename, code); if code ^= 0 then goto BAD_NEW_SEGMENT; call hcs_$make_seg (new_dname, ename, "", 01010b, new_ptrs (n_new_segs), code); if new_ptrs (n_new_segs) = null () then goto BAD_NEW_SEGMENT; call hcs_$fs_get_mode (new_ptrs (n_new_segs), fs_mode, code); if code ^= 0 then goto BAD_NEW_SEGMENT; code = error_table_$no_w_permission; if substr (bit (binary (fs_mode, 5), 5), 4, 1) = "0"b then goto BAD_NEW_SEGMENT; end; else n_new_segs = n_old_segs; /* Now loop backward through all the pages in the dump, copying page N into page N+1; that is, shifting it all right by one page. The pages are numbered zero-origin, but the loop terminates at one because the page zero of segment zero is the header page, and cannot be simply copied. */ do idx = total_pages - 1 to 1 by -1; old_seg = divide (idx, dump_seg_lth, 17, 0); old_page_ptr = pointer (old_ptrs (old_seg), (1024 * mod (idx, dump_seg_lth))); new_seg = divide (idx + 1, dump_seg_lth, 17, 0); new_page_ptr = pointer (new_ptrs (new_seg), (1024 * mod (idx + 1, dump_seg_lth))); new_page_ptr -> page = old_page_ptr -> page; end; /* Now, set the bitcounts everywhere to indicate the appropriate sizes -- it's max length for all segments but the last. */ remaining_pages = total_pages; do idx = 0 to n_new_segs; if remaining_pages > dump_seg_lth then call hcs_$set_bc_seg (new_ptrs (idx), (36 * 1024 * dump_seg_lth), (0)); else call hcs_$set_bc_seg (new_ptrs (idx), (36 * 1024 * remaining_pages), (0)); remaining_pages = remaining_pages - dump_seg_lth; end; /* Finally, the dump headers are converted. The old dump header is copied into automatic, and all the corresponding information is copied into an automatic version of the new header, which is finally inserted into the new FDUMP image. This cannot use by-name assignment, more's the pity, because there are several arrays with different bounds which must be copied, as well as the scalar items. */ unspec (old_dump) = unspec (old_ptrs (0) -> v1_dump); unspec (new_dump) = ""b; new_dump.dump_header = old_dump.dump_header; do idx = 1 to hbound (old_dump.segs, 1); new_dump.segs (idx) = old_dump.segs (idx); end; do idx = 0 to hbound (old_dump.amptwregs, 1); new_dump.amptwregs (idx) = old_dump.amptwregs (idx); new_dump.amptwptrs (idx) = old_dump.amptwptrs (idx); new_dump.amsdwregs (idx) = old_dump.amsdwregs (idx); new_dump.amsdwptrs (idx) = old_dump.amsdwptrs (idx); end; do idx = 0 to hbound (old_dump.ouhist, 1); new_dump.ouhist (idx) = old_dump.ouhist (idx); new_dump.cuhist (idx) = old_dump.cuhist (idx); new_dump.duhist (idx) = old_dump.duhist (idx); new_dump.auhist (idx) = old_dump.auhist (idx); end; unspec (new_dump.prs) = unspec (old_dump.prs); /* Avoid validating pointers */ new_dump.regs = old_dump.regs; new_dump.low_order_port = old_dump.low_order_port; new_dump.mctime = old_dump.mctime; new_dump.misc_registers = old_dump.misc_registers; new_dump.ptrlen = old_dump.ptrlen; new_dump.coreblocks (*) = old_dump.coreblocks (*); new_dump.version = DUMP_VERSION_2; unspec (new_ptrs (0) -> dump) = unspec (new_dump); if ^in_place then do; /* Only do this if something actually moved */ do idx = 0 to n_new_segs; /* Now, copy the ACLs to make it all perfectly clean */ call copy_acl_ (old_dname, seg_zero_ename, new_dname, new_name (idx), error_sw, code); end; /* Just ignore errors -- they are benign */ end; call ioa_ ("^a: Converted ^d pages from ^a^[>^]^a^[^/^3xinto ^a^[>^]^a^]", WHOAMI, total_pages, old_dname, (old_dname ^= ">"), seg_zero_ename, (^in_place), new_dname, (new_dname ^= ">"), new_name (0)); goto MAIN_RETURN; %page; %include bos_dump; end convert_v1_fdump;  copy_from_dump.pl1 10/01/82 1523.5rew 10/01/82 1523.6 33093 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1981 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ copy_from_dump: proc (dump_ptrs, seg_index, offset, words, to_ptr, words_copied, code); /* Subroutine to copy all or a portion of a segment from a BOS dump file. The segment is identified by its index in the BOS dump header. An array of pointers to the BOS dump components is passed as a parameter --this array points to segments of the dump in order (0, 1, 2, ...). Written March 1981 by J. Bongiovanni */ /* Parameter */ dcl dump_ptrs (*) ptr; /* array of ptrs to dump components, in order */ dcl seg_index fixed bin; /* index of segment to copy in bos dump array */ dcl offset fixed bin (18); /* first word in segment to dump */ dcl words fixed bin (18); /* number of words to dump */ dcl to_ptr ptr; /* where to copy data */ dcl words_copied fixed bin (18); /* number of words actually copied */ dcl code fixed bin (35); /* standard error code */ /* Automatic */ dcl dump_ptr_index fixed bin; dcl dump_seg_offset fixed bin (18); dcl fp ptr; dcl sector fixed bin (24); dcl segnum fixed bin; dcl tp ptr; dcl word_offset fixed bin (24); dcl words_left fixed bin (18); dcl words_move fixed bin (18); /* Static */ dcl HEADER_WORDS fixed bin (18) init (2048) int static options (constant); /* size of header for this version of FDUMP */ dcl VERSION fixed bin init (2) int static options (constant); /* version expected */ /* Based */ dcl based_move (words_move) fixed bin (35) aligned based; /* External */ dcl error_table_$bad_arg fixed bin (35) ext; dcl error_table_$improper_data_format fixed bin (35) ext; dcl sys_info$max_seg_size fixed bin (18) ext; /* Builtin */ dcl addrel builtin; dcl bin builtin; dcl divide builtin; dcl hbound builtin; dcl max builtin; dcl min builtin; dcl mod builtin; dcl ptr builtin; %page; code = 0; dumpptr = dump_ptrs (1); if dump.version ^= VERSION then do; code = error_table_$improper_data_format; /* bad Fdump */ return; end; if seg_index > dump.num_segs then do; /* segment not in dump */ code = error_table_$bad_arg; return; end; /* Compute word address of beginning of segment within dump file */ sector = 0; if seg_index > 1 then do segnum = 1 to seg_index - 1; sector = sector + bin (dump.segs (segnum).length, 18); end; word_offset = sector * 64 + HEADER_WORDS + offset; dump_ptr_index = divide (word_offset, sys_info$max_seg_size, 17) + 1; dump_seg_offset = mod (word_offset, sys_info$max_seg_size); words_left = min (words, 64 * bin (dump.segs.length (seg_index), 18)); words_copied = max (words_left, 0); tp = to_ptr; do while (words_left > 0); if dump_ptr_index > hbound (dump_ptrs, 1) then do; code = error_table_$bad_arg; return; end; fp = ptr (dump_ptrs (dump_ptr_index), dump_seg_offset); words_move = min (sys_info$max_seg_size - dump_seg_offset, words_left); tp -> based_move = fp -> based_move; words_left = words_left - words_move; dump_ptr_index = dump_ptr_index + 1; dump_seg_offset = 0; tp = addrel (tp, words_move); end; %page; %include bos_dump; end copy_from_dump;  display_am_.pl1 10/01/82 1523.5rew 10/01/82 1523.6 167346 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1981 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ display_am_: proc (); return; /* should never enter here */ /* Associative memory display program for ol_dump. * Last modified 08/25/80 W. Olin Sibert, to make it work properly for PRDS assoc mems * Last modified 09/09/80 R. L. Coppola, to make it work for l68 or DPS8/70 cpu's * Last Modified June 1981 by Rich Coppola to add consistency checking. */ dcl (idx, jdx, type, IDX, first_entry, last_entry, first_level, last_level) fixed bin; dcl CPU_NO fixed bin (3); dcl tag (0:7) char (1) int static options (constant) init ("a", "b", "c", "d", "e", "f", "g", "h"); dcl AM_LEVEL (1:4) char (1) int static options (constant) init ("A", "B", "C", "D"); /* levels of dps8 AMs */ dcl DPS8xxM bit (1); /* denotes a dps8 cpu */ dcl val_btld bit (1) init ("0"b); dcl code fixed bin (35); dcl def_offset fixed bin (18); dcl error bit (1); dcl (reg_ptr, ptr_ptr) ptr; dcl seg_ptr pointer; dcl flag_string char (7); dcl dup_entry (0:63) bit (1) unal; dcl (first, last) fixed bin int static; dcl (sdw_regs_ptr, sdw_ptrs_ptr, ptw_regs_ptr, ptw_ptrs_ptr) pointer; dcl 1 sdw_regs (0:63) aligned like amsdwreg based (sdw_regs_ptr); dcl 1 sdw_ptrs (0:63) aligned like amsdwptr based (sdw_ptrs_ptr); dcl 1 ptw_regs (0:63) aligned like amptwreg based (ptw_regs_ptr); dcl 1 ptw_ptrs (0:63) aligned like amptwptr based (ptw_ptrs_ptr); dcl ioa_ entry options (variable); dcl ioa_$rsnnl entry options (variable); dcl namef_ entry (ptr, ptr) returns (char (*)); dcl namef_$no_comp entry (ptr, ptr) returns (char (*)); dcl ring0_get_$definition_given_slt entry (ptr, char (*), char (*), fixed bin (18), fixed bin, fixed bin (35), ptr, ptr, ptr); dcl ol_dump_util_$get_ptr entry (fixed bin, ptr, fixed bin (35), ptr); /* :: */ dcl ol_dump_util_$fnd_dbr entry (fixed bin (24), fixed bin (35), fixed bin (35), ptr); dcl (addr, addrel, binary, baseptr, fixed, null, substr) builtin; dcl usage_string char (8); dcl nregs fixed bin; /* number of regs/ptrs in am saved by fim. * Could be 16/64 depending on whether * the cpu is a dpse or l68 */ /* */ display_am_$sdw: entry (odsp, CPU_NO); call get_args ("0"b, error, nregs); /* get additional args, etc */ if error then return; /* if problem, go back to request */ call validate_am_sdw (nregs, odsp); first_entry = 0; last_entry = 15; if DPS8xxM then do; first_level = 1; last_level = 4; end; else do; first_level = 1; last_level = 1; end; call ioa_ (" ADDRESS^2xRINGS^2xBOUND^2xREWPUGC^4xCL F/E USAGE-CT SEG # SEG_NAME"); do IDX = first_level to last_level; if DPS8xxM then call ioa_ ("^/LEVEL [^a]^/", AM_LEVEL (IDX)); do idx = first_entry to last_entry; call ioa_$rsnnl ("^[R^; ^]^[E^; ^]^[W^; ^]^[P^; ^]^[U^; ^]^[G^; ^]^[C^; ^]", flag_string, (0), /* generate the REWPUGC string */ sdw_regs (idx).read, sdw_regs (idx).execute, sdw_regs (idx).write, sdw_regs (idx).privileged, sdw_regs (idx).unpaged, sdw_regs (idx).entry_bound_sw, sdw_regs (idx).cache); if ^DPS8xxM then call ioa_$rsnnl ("^6x^2d", usage_string, (0), binary (sdw_ptrs (idx).usage, 4)); else call ioa_$rsnnl ("^2x^6b", usage_string, (0), sdw_ptrs (idx).usage); call ioa_ ("^8o^2x^1.3b,^1.3b,^1.3b ^6o^2x^7a ^[^5o^;^s^4x-^]^2x^[F^;E^]^2x^8a ^5o ^[^a^;^s N/A^]^[^/^-*** POSSIBLE DUPLICATE ENTRY ***^]", binary (sdw_regs (idx).addr, 24), sdw_regs (idx).r1, sdw_regs (idx).r2, sdw_regs (idx).r3, binary ((sdw_regs (idx).bound || "0000"b), 18), flag_string, ((^sdw_regs (idx).entry_bound_sw) & sdw_regs (idx).execute), /* skip next if there is none */ binary (sdw_regs (idx).cl, 14), sdw_ptrs (idx).valid, usage_string, binary (sdw_ptrs (idx).pointer, 15), sdw_ptrs (idx).valid, /* skip the naming if the entry isn't valid */ namef_$no_comp (baseptr (binary (sdw_ptrs (idx).pointer, 15)), odsp), dup_entry (idx)); end; first_entry = last_entry + 1; last_entry = first_entry +15; end; return; /* */ display_am_$ptw: entry (odsp, CPU_NO); call get_args ("1"b, error, nregs); /* get additional args, etc */ if error then return; /* if problem, go back to request */ call ioa_ (" ADDRESS^3xM^2xF/E USAGE_CT SEG # PAGE SEG_NAME|OFFSET"); call validate_am_ptw (nregs, odsp); first_entry = 0; last_entry = 15; if DPS8xxM then do; first_level = 1; last_level = 4; end; else do; first_level = 1; last_level = 1; end; do IDX = first_level to last_level; if DPS8xxM then call ioa_ ("^/LEVEL [^a]^/", AM_LEVEL (IDX)); do idx = first_entry to last_entry; seg_ptr = addrel (baseptr (binary (ptw_ptrs (idx).pointer, 15)), (binary (ptw_ptrs (idx).pageno, 12) * 16)); /* get a pointer to the segment, so we can get its name */ if ^DPS8xxM then call ioa_$rsnnl ("^6x^2d", usage_string, (0), binary (ptw_ptrs (idx).usage, 4)); else call ioa_$rsnnl ("^2x^6b", usage_string, (0), ptw_ptrs (idx).usage); call ioa_ ("^8o^2x^[yes^;no ^]^2x^[F^;E^]^2x^8a ^5o ^4o ^[^a^;^s N/A^]^[^/^-*** POSSIBLE DUPLICATE ENTRY ***^]", binary ((ptw_regs (idx).addr || "000000"b), 24), ptw_regs (idx).modif, ptw_ptrs (idx).valid, usage_string, binary (ptw_ptrs (idx).pointer, 15), divide (binary (ptw_ptrs (idx).pageno, 12), 16, 12, 0), ptw_ptrs (idx).valid, /* skip the naming if this PTWAM entry is empty */ namef_ (seg_ptr, odsp), dup_entry (idx)); end; first_entry = last_entry + 1; last_entry = first_entry +15; end; return; /* */ get_args: proc (sp_bit, err_bit, nregs); /* get_args - internal proc to process args for assosiative memory display requests */ dcl (sp_bit, err_bit) bit (1); dcl am_data_ptr pointer; dcl prds_ptr pointer; dcl def_offset fixed bin (18); dcl nregs fixed bin; dcl tempp ptr; dcl last_three_sets bit (48*36) based; /* # regs * bits/words in the rest of the set */ err_bit = "0"b; /* reset error flag */ dumpptr = dumpp (0); /* set dump ptr to comp. 0 */ if argcnt < 1 then do; /* if no args, prt assosiative mem. from dump */ sdw_regs_ptr = addr (dump.amsdwregs); sdw_ptrs_ptr = addr (dump.amsdwptrs); ptw_regs_ptr = addr (dump.amptwregs); ptw_ptrs_ptr = addr (dump.amptwptrs); end; else do; /* user wants them from prds */ if argcnt > 1 | arg (1) ^= "prds" then do; /* tell user what to type */ call ioa_ ("Usage: am^[sdw^;ptw^] {prds}", sp_bit); err_bit = "1"b; /* set error flag */ return; end; call ol_dump_util_$get_ptr (prdsseg, prds_ptr, code, odsp); /* get ptr to prds */ if prds_ptr = null then do; /* did'nt find */ err_bit = "1"b; /* set error flag */ return; end; call ring0_get_$definition_given_slt (null, "prds", "am_data", def_offset, type, code, sltptr, sltnp, defptr); am_data_ptr = addrel (prds_ptr, def_offset); call ring0_get_$definition_given_slt (null, "prds", "ptw_am_regs", def_offset, type, code, sltptr, sltnp, defptr); ptw_regs_ptr = addrel (prds_ptr, def_offset); call ring0_get_$definition_given_slt (null, "prds", "ptw_am_ptrs", def_offset, type, code, sltptr, sltnp, defptr); ptw_ptrs_ptr = addrel (prds_ptr, def_offset); call ring0_get_$definition_given_slt (null, "prds", "sdw_am_regs", def_offset, type, code, sltptr, sltnp, defptr); sdw_regs_ptr = addrel (prds_ptr, def_offset); call ring0_get_$definition_given_slt (null, "prds", "sdw_am_ptrs", def_offset, type, code, sltptr, sltnp, defptr); sdw_ptrs_ptr = addrel (prds_ptr, def_offset); end; call ioa_ ("^[PTW^;SDW^] Associative Memory (from CPU ^a) ^[at time of dump^;at prds$am_data^].", sp_bit, tag (CPU_NO), (argcnt = 0)); tempp = addrel (ptw_regs_ptr, 16); /* base to 2'nd set of am */ if tempp -> last_three_sets = "0"b then /* if second set is zero then */ nregs = 15; /* am from l68 */ else nregs = 63; /* am from dps8/70m */ if nregs = 15 then DPS8xxM = "0"b; else DPS8xxM = "1"b; return; end get_args; %page; validate_am: proc; dcl no_regs fixed bin; dcl (i, j) fixed bin; dcl a_odsp ptr; validate_am_sdw: entry (no_regs, a_odsp); dup_entry (*) = "0"b; do i = 0 to no_regs -1; do j = i+1 to no_regs; if (sdw_ptrs (i).valid & sdw_ptrs (j).valid) then do; if sdw_regs (i).addr = sdw_regs (j).addr then do; dup_entry (i) = "1"b; dup_entry (j) = "1"b; end; else if sdw_ptrs (i).pointer = sdw_ptrs (j).pointer then do; dup_entry (i) = "1"b; dup_entry (j) = "1"b; end; else if sdw_ptrs (i).usage = sdw_ptrs (j).usage then do; if ^DPS8xxM then do; /* if its not a dps8 */ dup_entry (i) = "1"b; /* for dps8 it is LRU not usage ctr */ dup_entry (j) = "1"b; end; end; if (dup_entry (i) & dup_entry (j)) then do; if sdw_regs (i).addr = sdw_regs (j).addr then if sdw_regs (i).bound = sdw_regs (j).bound then if (sdw_regs (i).r2 & sdw_regs (i).r3) ^= (sdw_regs (j).r2 & sdw_regs (j).r3) then if sdw_ptrs (i).pointer ^= sdw_ptrs (j).pointer then do; if DPS8xxM then go to cancel_dup_sdw; if sdw_ptrs (i).usage ^= sdw_ptrs (j).usage then do; cancel_dup_sdw: dup_entry (i), dup_entry (j) = "0"b; end; end; end; if ((dup_entry (i) & dup_entry (j)) & val_btld) then do; call ioa_ ("^/Possible duplicate entry in SDW associative memory for CPU ^a;^/", tag (CPU_NO)); call ioa_ (" ADDRESS^2xRINGS^2xBOUND^2xREWPUGC^4xCL F/E USAGE-CT SEG # SEG_NAME"); reg_ptr = addr (sdw_regs (i)); ptr_ptr = addr (sdw_ptrs (i)); call display_mismatch_sdw (reg_ptr, ptr_ptr); reg_ptr = addr (sdw_regs (j)); ptr_ptr = addr (sdw_ptrs (j)); call display_mismatch_sdw (reg_ptr, ptr_ptr); end; end; end; end; return; validate_am_ptw: entry (no_regs, a_odsp); dup_entry (*) = "0"b; do i = 0 to no_regs -1; do j = i+1 to no_regs; if (ptw_ptrs (i).valid & ptw_ptrs (j).valid) then do; if ptw_regs (i).addr = ptw_regs (j).addr then do; dup_entry (i) = "1"b; dup_entry (j) = "1"b; end; else if ptw_ptrs (i).usage = ptw_ptrs (j).usage then do; if ^DPS8xxM then do; /* if its not a dps8 */ dup_entry (i) = "1"b; dup_entry (j) = "1"b; end; end; else if (ptw_ptrs (i).pointer = ptw_ptrs (j).pointer) & (ptw_ptrs (i).pageno = ptw_ptrs (j).pageno) then do; dup_entry (i) = "1"b; dup_entry (j) = "1"b; end; if (dup_entry (i) & dup_entry (j)) then do; if ptw_regs (i).addr = ptw_regs (j).addr then if ptw_ptrs (i).pointer ^= ptw_ptrs (j).pointer then do; if DPS8xxM then go to cancel_dup_ptw; if ptw_ptrs (i).usage ^= ptw_ptrs (j).usage then do; cancel_dup_ptw: dup_entry (i), dup_entry (j) = "0"b; end; end; end; if ((dup_entry (i) & dup_entry (j)) & val_btld) then do; call ioa_ ("^/Possible duplicate entry in PTW associative memory for CPU ^a;^/", tag (CPU_NO)); call ioa_ (" ADDRESS^3xM^2xF/E USAGE_CT SEG # PAGE"); reg_ptr = addr (ptw_regs (i)); ptr_ptr = addr (ptw_ptrs (i)); call display_mismatch_ptw (reg_ptr, ptr_ptr); reg_ptr = addr (ptw_regs (j)); ptr_ptr = addr (ptw_ptrs (j)); call display_mismatch_ptw (reg_ptr, ptr_ptr); end; end; end; end; return; end validate_am; %page; /* This routine compares the assoc mem to what is in the dseg/sst to validate the contents of SDW and PTW assoc mem are correct */ validate_am_btld: entry (odsp, seg_len, CPU_NO, icode); dcl (tempp, tdsegp, tasdwp, taptwp, sptp) ptr; dcl tdsdw bit (72) based (tdsegp); dcl tasdw bit (72) based (tasdwp); dcl tdsdw_mask bit (72) init ("777777777770777777777777"b3); dcl tsptw bit (36) based (sptp); dcl taptw bit (36) based (taptwp); dcl tsptw_mask bit (36) init ("777777000100"b3); dcl (seg_len, icode) fixed bin (35); dcl (j, ptsz) fixed bin; dcl dump_dbr fixed bin (24); dcl last_three_sets bit (48*36) based; /* # regs * bits/words in the rest of the set */ val_btld = "1"b; dumpptr = dumpp (0); /* set dump ptr to comp. 0 */ dump_dbr = fixed (substr (dump.dbr, 1, 24), 24); ol_dump_struc.boot_dbr = dump_dbr; call ol_dump_util_$fnd_dbr (dump_dbr, seg_len, icode, odsp); sdw_regs_ptr = addr (dump.amsdwregs); sdw_ptrs_ptr = addr (dump.amsdwptrs); ptw_ptrs_ptr = addr (dump.amptwptrs); ptw_regs_ptr = addr (dump.amptwregs); tempp = addrel (sdw_ptrs_ptr, 16); /* base to 2'nd set of am */ if tempp -> last_three_sets = "0"b then /* if second set is zero then */ nregs = 15; /* am from l68 */ else nregs = 63; /* am from dps8/70m */ if nregs = 15 then DPS8xxM = "0"b; else DPS8xxM = "1"b; VALIDATE_SDW: call validate_am_sdw (nregs, odsp); do idx = 0 to nregs; /* cycle thru ass mem */ if sdw_ptrs (idx).valid then do; /* only for valid entries */ tdsegp = addrel (dsegp, (bin (sdw_ptrs (idx).pointer, 15) * 2)); tasdwp = addr (sdw_regs (idx)); if (tdsdw & tdsdw_mask) ^= tasdw then do; call ioa_ ("^/Mis-Match between SDWAM and dseg on BOS CPU (^a);^/", tag (CPU_NO)); call ioa_ (" ADDRESS^2xRINGS^2xBOUND^2xREWPUGC^4xCL F/E USAGE-CT SEG # SEG_NAME"); reg_ptr = addr (sdw_regs (idx)); ptr_ptr = addr (sdw_ptrs (idx)); call display_mismatch_sdw (reg_ptr, ptr_ptr); call display_dseg_entry (tdsegp); end; end; end; VALIDATE_PTW: call validate_am_ptw (nregs, odsp); if sstptr = null then return; sstp = sstptr; do idx = 0 to nregs; if ptw_ptrs (idx).valid then do; sdwp = addr (dsegp -> sdwa (bin (ptw_ptrs (idx).pointer, 15))); ptp = ptr (sstp, fixed (sdw.add, 24) - fixed (sst.ptwbase, 18)); /* get a ptr to page tbl */ astep = addrel (ptp, -sst.astsize); ptsz = sst.pts (fixed (aste.ptsi, 3)); sptp = addrel (ptp, (divide (binary (ptw_ptrs (idx).pageno, 12), 16, 12, 0))); taptwp = addr (ptw_regs (idx)); if (tsptw & tsptw_mask) ^= taptw then do; /* found a bad one */ call ioa_ ("^/Mis-Match between PTWAM and page table on BOS CPU (^a);^/", tag (CPU_NO)); call ioa_ (" ADDRESS^3xM^2xF/E USAGE_CT SEG # PAGE"); reg_ptr = addr (ptw_regs (idx)); ptr_ptr = addr (ptw_ptrs (idx)); call display_mismatch_ptw (reg_ptr, ptr_ptr); call display_sst_entry (sptp); end; end; end; return; %page; display_mismatch_sdw: proc (a_sdw_reg_ptr, a_sdw_ptr_ptr); dcl (a_sdw_reg_ptr, a_sdw_ptr_ptr) ptr; dcl 1 a_sdw_reg aligned like amsdwreg based (a_sdw_reg_ptr); dcl 1 a_sdw_ptr aligned like amsdwptr based (a_sdw_ptr_ptr); call ioa_$rsnnl ("^[R^; ^]^[E^; ^]^[W^; ^]^[P^; ^]^[U^; ^]^[G^; ^]^[C^; ^]", flag_string, (0), /* generate the REWPUGC string */ a_sdw_reg.read, a_sdw_reg.execute, a_sdw_reg.write, a_sdw_reg.privileged, a_sdw_reg.unpaged, a_sdw_reg.entry_bound_sw, a_sdw_reg.cache); if ^DPS8xxM then call ioa_$rsnnl ("^6x^2d", usage_string, (0), binary (a_sdw_ptr.usage, 4)); else call ioa_$rsnnl ("^2x^6b", usage_string, (0), a_sdw_ptr.usage); call ioa_ ("^8o^2x^1.3b,^1.3b,^1.3b ^6o^2x^7a ^[^5o^;^s^4x-^]^2x^[F^;E^]^2x^8a ^5o", binary (a_sdw_reg.addr, 24), a_sdw_reg.r1, a_sdw_reg.r2, a_sdw_reg.r3, binary ((a_sdw_reg.bound || "0000"b), 18), flag_string, ((^a_sdw_reg.entry_bound_sw) & a_sdw_reg.execute), /* skip next if there is none */ binary (a_sdw_reg.cl, 14), a_sdw_ptr.valid, usage_string, binary (a_sdw_ptr.pointer, 15)); return; end; %page; display_dseg_entry: proc (dseg_entp); dcl dseg_entp ptr; dcl flag_string char (7); dcl 1 dseg_ent based (dseg_entp), (2 addr bit (24), 2 ring1 bit (3), 2 ring2 bit (3), 2 ring3 bit (3), 2 pad1 bit (4), 2 bounds bit (14), 2 rd bit (1), 2 ex bit (1), 2 wrt bit (1), 2 priv bit (1), 2 unp bit (1), 2 ebs bit (1), 2 cache bit (1), 2 cl bit (14)) unal; call ioa_$rsnnl ("^[R^; ^]^[E^; ^]^[W^; ^]^[P^; ^]^[U^; ^]^[G^; ^]^[C^; ^]", flag_string, (0), /* generate the REWPUGC string */ dseg_ent.rd, dseg_ent.ex, dseg_ent.wrt, dseg_ent.priv, dseg_ent.unp, dseg_ent.ebs, dseg_ent.cache); call ioa_ ("^8o^2x^1.3b,^1.3b,^1.3b ^6o^2x^7a ^[^5o^]^-(dseg entry)", binary (dseg_ent.addr, 24), dseg_ent.ring1, dseg_ent.ring2, dseg_ent.ring3, binary ((dseg_ent.bounds || "0000"b), 18), flag_string, ((^dseg_ent.ebs) & dseg_ent.ex), binary (dseg_ent.cl, 14)); return; end; %page; display_mismatch_ptw: proc (a_ptw_reg_ptr, a_ptw_ptr_ptr); dcl (a_ptw_reg_ptr, a_ptw_ptr_ptr) ptr; dcl 1 a_ptw_reg aligned like amptwreg based (a_ptw_reg_ptr); dcl 1 a_ptw_ptr aligned like amptwptr based (a_ptw_ptr_ptr); if ^DPS8xxM then call ioa_$rsnnl ("^6x^2d", usage_string, (0), binary (a_ptw_ptr.usage, 4)); else call ioa_$rsnnl ("^2x^6b", usage_string, (0), a_ptw_ptr.usage); call ioa_ ("^8o^2x^[yes^;no ^]^2x^[F^;E^]^2x^8a ^5o ^4o", binary ((a_ptw_reg.addr || "000000"b), 24), a_ptw_reg.modif, a_ptw_ptr.valid, usage_string, binary (a_ptw_ptr.pointer, 15), divide (binary (a_ptw_ptr.pageno, 12), 16, 12, 0)); return; end; %page; display_sst_entry: proc (a_ptp); dcl a_ptp ptr; dcl 1 page_wd based (a_ptp), (2 addr bit (18), 2 padd1 bit (11), 2 modifd bit (1), 2 padd2 bit (6) unal); call ioa_ ("^8o^2x^[yes^;no ^]^2x(page table in memory)", binary ((page_wd.addr || "000000"b), 24), page_wd.modifd); return; end; %page; %include ol_dump_struc; %page; %include assoc_mem; %page; %include bos_dump; %page; %include sst; %page; %include aste; %page; %include sdw; %page; %include ptw; end display_am_;  display_ast_.pl1 10/01/82 1523.5rew 10/01/82 1523.6 97515 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1981 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ display_ast_: proc (odsp); /* ********************************************************************** * Routine to display the ASTE/PT of a segment. * * Modified June 1981 by Warren Johnson to add the asbadr entrypoint * * to display the absolute address given segment and offset. * * Modified March 1982 by J. Bongiovanni for new PVTE * * Modified August 1982 by E. N. Kittlitz to move core map. * ********************************************************************** */ dcl ring0_get_$segptr_given_slt entry (char (*), char (*), ptr, fixed (35), ptr, ptr); dcl (ioa_$nnl, ioa_, ioa_$rsnnl) entry options (variable); dcl cv_oct_check_ entry (char (*), fixed (35)) returns (fixed (35)); dcl ol_dump_util_$get_ptr entry (fixed, ptr, fixed (35), ptr); dcl ol_dump_util_$get_segno entry (char (32) varying, ptr) returns (fixed); dcl ol_dump_util_$dump_oct entry (ptr, fixed, fixed); dcl namef_$no_comp entry (ptr, ptr) returns (char (*)); dcl get_line_length_$switch entry (ptr, fixed (35)) returns (fixed); dcl date_time_ entry (fixed (71), char (*) aligned); dcl (i, segno, offset, pts, ll, ln, page, word) fixed; dcl (segln, code) fixed (35); dcl sptp ptr; dcl pt_word fixed based (ptp); dcl repeat bit (1); dcl (core_add, fdevadd) fixed (18); dcl devadd bit (22); dcl devadd_add_type bit (4) defined (devadd) pos (19); dcl devadd_nulled_flag bit (1) defined (devadd); dcl devadd_record_no bit (18) defined (devadd); dcl last_ptw bit (36); dcl (str, cdevadd) char (16); dcl pvtx_name char (16) varying; dcl vs char (99) varying; dcl 1 local_cme aligned like cme; dcl (ptr, addr, substr, null, addrel, rel, baseno, baseptr, divide, fixed, length, size, unspec, mod) builtin; %page (1); if argcnt < 1 then do; call ioa_ ("ast segno/name"); return; end; if sstptr = null () then do; call ioa_ ("No sst."); return; end; if coremapptr = null () then call ioa_ ("No core_map. Device addresses of in-core pages are shown as 0."); sstp = sstptr; /* copy arg */ ll = get_line_length_$switch (null (), segln); /* get terminal lin length */ segno = cv_oct_check_ (substr (arg (1), 1, length (arg (1))), code); /* get segment number in binary */ if code ^= 0 then do; /* non-octal, try special name */ segno = ol_dump_util_$get_segno (arg (1), odsp); if segno = -1 then return; else; end; else; sdwp = addr (dsegp -> sdwa (segno)); /* get a pointer to the SDW for the segment */ if sdw.unpaged then do; /* see if the segment is paged */ call ioa_ ("Segment ^a is not paged.", arg (1)); return; end; else; astep = ptr (sstp, fixed (sdw.add, 24) - fixed (sst.ptwbase, 18) - sst.astsize); /* get a pointer to the ast entry */ offset = fixed (rel (astep), 18) - fixed (rel (sstp), 18); call ioa_ ("ASTE For Segment ^a (seg ^o), at SST|^o^/", namef_$no_comp (baseptr (segno), odsp), segno, offset); call ol_dump_util_$dump_oct (astep, offset, sst.astsize); call ring0_get_$segptr_given_slt ("", "pvt", pvtp, code, sltptr, sltnp); /* get ptr to pvt */ if code ^= 0 then pvtx_name = "??????"; else do; call ol_dump_util_$get_ptr (fixed (baseno (pvtp), 15), pvtp, segln, odsp); if pvtp = null () then pvtx_name = "??????"; else do; pvt_arrayp = addr (pvt.array); pvtep = addr (pvt_array (aste.pvtx)); if substr (pvte.devname, 1, 3) = "dsk" then call ioa_$rsnnl ("^a device ^d", pvtx_name, ln, pvte.devname, pvte.logical_area_number); else pvtx_name = ""; end; end; call ioa_ ("^/uid = ^w, vtocx ^o on pvtx ^o^[ (^a)^]", fixed (aste.uid, 35), aste.vtocx, aste.pvtx, pvtx_name ^= "", pvtx_name); call ioa_ ("max len ^d, ^d recs used, ^d in core, cur len ^d", fixed (aste.msl, 9), fixed (aste.records, 9), fixed (aste.np, 9), fixed (aste.csl, 9)); if aste.dtu then call ioa_ ("Used ^a", dtc (aste.dtu)); else call ioa_ ("Not updated as used."); if aste.dtm then call ioa_ ("Modified ^a", dtc (aste.dtm)); else call ioa_ ("Not updated as modified."); if aste.par_astep | aste.infl | aste.infp then call ioa_ ("Par astep = ^o, Son = ^o, brother = ^o", fixed (aste.par_astep, 18), fixed (aste.infp, 18), fixed (aste.infl, 18)); if aste.uid = "0"b then call ioa_ ("Hardcore segno = ^o", fixed (aste.strp, 18)); else if aste.strp then call ioa_ ("Trailer thread = ^o", fixed (aste.strp, 18)); else call ioa_ ("No trailer thread."); if aste.dirsw then do; if aste.master_dir then call ioa_ ("Aste for a master directory."); else call ioa_ ("Aste for a directory."); end; else if aste.master_dir then call ioa_ ("Says master dir, but not directory."); else; if aste.quota (0) ^= 0 | aste.quota (1) ^= 0 then call ioa_ (" Quota (S D) = (^d ^d)", aste.quota (0), aste.quota (1)); else; if aste.used (0) ^= 0 | aste.used (1) ^= 0 then call ioa_ (" QUsed (S D) = (^d ^d)", aste.used (0), aste.used (1)); else; vs = ""; call ioa_$nnl ("^/"); if aste.usedf then call vput ("usedf "); else; if aste.init then call vput ("init "); else; if aste.gtus then call vput ("gtus "); else; if aste.hc then call vput ("hc "); else; if aste.hc_sdw then call vput ("hc_sdw "); else; if aste.any_access_on then call vput ("aaon "); else; if aste.write_access_on then call vput ("waccon "); else; if aste.inhibit_cache then call vput ("inhcch "); else; if aste.explicit_deact_ok then call vput ("xdok "); else; if aste.ehs then call vput ("ehs "); else; if aste.nqsw then call vput ("nqsw "); else; if aste.tqsw (0) then call vput ("seg-tqsw "); else; if aste.tqsw (1) then call vput ("dir-tqsw "); else; if aste.fmchanged then call vput ("fmch "); else; if aste.fms then call vput ("fms "); else; if aste.npfs then call vput ("npfs "); else; if aste.gtpd then call vput ("gtpd "); else; if aste.dnzp then call vput ("dnzp "); else; if aste.per_process then call vput ("per_proc "); else; if aste.fmchanged1 then call vput ("fmch1 "); else; if aste.damaged then call vput ("damaged "); else; if aste.ddnp then call vput ("ddnp "); else; if aste.pack_ovfl then call vput ("oopv "); else; call vput ("FLUSH"); pts = sst.pts (fixed (aste.ptsi, 3)); call ioa_ ("^/PAGE PT DEVADD^/"); repeat = "0"b; sptp = addrel (astep, size (aste)); do i = 0 to pts-1 by 1; ptp = addr (sptp -> ptwa (i)); devadd = ptp -> mptw.devadd; if i ^= 0 & i ^= pts - 1 & unspec (ptw) = last_ptw & devadd_add_type = "000"b & ^ptw.df then repeat = "1"b; else do; if repeat then do; repeat = "0"b; call ioa_ ("===="); end; else; if ptw.df then do; core_add = fixed (devadd_record_no); core_add = divide (core_add, 16, 18, 0); if coremapptr ^= null then do; cmep = addr (coremapptr -> cma (core_add)); devadd = cme.devadd; end; else devadd = "0"b; end; fdevadd = fixed (devadd_record_no); if devadd_add_type & add_type.non_null then call ioa_$rsnnl ("^6o", cdevadd, ln, fdevadd); else cdevadd = " null"; if devadd_nulled_flag & devadd_add_type = add_type.disk then do; devadd_nulled_flag = "0"b; fdevadd = fixed (devadd_record_no); call ioa_ ("^4o ^w ^6o (nulled)", i, pt_word, fdevadd); end; else call ioa_ ("^4o ^w ^6a", i, pt_word, cdevadd); end; last_ptw = unspec (ptw); end; return; %page (1); absadr: entry (odsp); if argcnt < 1 then do; absadr_label: call ioa_ ("absadr segno/name {offset}"); return; end; else; if sstptr = null () then do; call ioa_ ("No sst."); return; end; else; sstp = sstptr; segno = cv_oct_check_ (substr (arg (1), 1, length (arg (1))), code); /* get segment number in binary */ if code ^= 0 then do; /* non-octal, try special name */ segno = ol_dump_util_$get_segno (arg (1), odsp); if segno = -1 then return; else; end; else; if argcnt < 2 then do; offset = 0; go to GET_SDWP; end; offset = cv_oct_check_ (substr (arg (2), 1, length (arg (2))), code); /* get segment offset */ if code ^= 0 then go to absadr_label; else; GET_SDWP: sdwp = addr (dsegp -> sdwa (segno)); /* get a pointer to the SDW for the segment */ if sdw.unpaged /* see if the segment is paged */ then if sdw.df /* segment fault? */ then do; /* nope, got the address */ offset = fixed (sdw.add, 24) + offset; call ioa_ ("^o", offset); return; end; else do; /* segment not active */ call ioa_ ("Segment ^o is unpaged and faulted.", segno); return; end; else; word = mod (offset, 1024); /* get word within page */ page = divide (offset, 1024, 17, 0); /* get PTW index */ ptp = ptr (sstp, fixed (sdw.add, 24) - fixed (sst.ptwbase, 18)); /* get a pointer to page table */ astep = addrel (ptp, -sst.astsize); /* get ptr to ASTE */ pts = sst.pts (fixed (aste.ptsi, 3)); if page >= pts then do; call ioa_ ("Offset ^o not found in segment ^o.", offset, segno); return; end; else ptp = addrel (ptp, page); /* get ptr to PTW */ if ptw.df /* is page in memory? */ then do; /* yes, it's there */ offset = fixed (ptw.add, 18) * 64; offset = offset + word; call ioa_ ("^o", offset); end; else call ioa_ ("Page ^o of segment ^o is not in main memory.", page, segno); return; %page (1); vput: proc (x); dcl x char (*) parameter; if x = "FLUSH" | length (vs) > ll - 10 then do; if vs = "" then call ioa_ ("No Flags."); else call ioa_ ("Flags: ^a", vs); vs = ""; end; else; vs = vs || x; return; end vput; %page (1); dtc: proc (b) returns (char (24)); dcl b bit (36) parameter; dcl buf bit (72); dcl fbuf fixed (71); dcl date char (24) aligned; buf = "0"b; substr (buf, 21) = b; unspec (fbuf) = unspec (buf); call date_time_ (fbuf, date); return (date); end dtc; %page (1); %include ol_dump_struc; %page (1); %include sst; %page (1); %include aste; %page (1); %include cmp; %page (1); %include pvt; %page (1); %include pvte; %page (1); %include add_type; %page (1); %include sdw; %page (1); %include ptw; end display_ast_;  display_dump_.pl1 11/10/82 1713.3rew 11/10/82 0916.5 83070 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* Modified Oct 1982 by Rich Coppola to not change DBR when dumping HC seg as it was a needless operation. */ display_dump_: proc (odsp); % include ol_dump_struc; dcl db_print entry (ptr, char (*) aligned, ptr, char (*), fixed bin, fixed bin, ptr, fixed bin, fixed bin); dcl cv_oct_check_ entry (char (*), fixed bin) returns (fixed bin); dcl object_info_$display entry (ptr, fixed bin (24), ptr, fixed bin (35)); dcl ring0_get_$name_given_slt entry (char (*) aligned, char (*) aligned, ptr, fixed bin, ptr, ptr); dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); dcl (ioa_, com_err_) entry options (variable); dcl ol_dump_util_$fnd_dbr entry (fixed bin (24), fixed bin (35), fixed bin, ptr); dcl ol_dump_util_$get_ptr entry (fixed bin, ptr, fixed bin (35), ptr); /* :: */ dcl ol_dump_util_$get_segno entry (char (32) varying, ptr) returns (fixed bin); /* :: */ dcl ol_dump_util_$fnd_hcseg entry (char (32) aligned, ptr, fixed bin (24), ptr); /* :: */ dcl ol_dump_util_$dump_oct entry (ptr, fixed bin, fixed bin); dcl ol_dump_util_$is_hardcore_seg entry (fixed bin, ptr) returns (bit (1)); dcl namef_ entry (ptr, ptr) returns (char (*)); dcl (segln, bcode) fixed bin (35); dcl (i, j, count, first, segno, code, k, edoc, offset) fixed bin; dcl (substr, unspec, fixed, length, ptr, addr, addrel, rel, divide, null, baseptr) builtin; dcl 1 oi aligned like object_info; /* For compatibility with new object segment */ dcl char_type char (1) aligned; dcl ename char (32) aligned; dcl (mem_add, dbrsvm, sdwad) fixed bin (24) aligned; dcl bitcnt fixed bin (24); dcl (p, pm) ptr; dcl (init_hard, premature_end, mem_dump, offset_flag) bit (1) unaligned; dcl paged char (7) varying; dcl off18 fixed bin (18) aligned; dcl saved_kstseg fixed bin; dcl saved_kstptr ptr; /* */ if argcnt < 1 | argcnt > 5 then do; /* user goofed, tell him what to type in */ dump_label: call ioa_ ("dump segno/name/mem {addr {+_offset}} {count} {mode}"); return; end; char_type = "o"; /* set up default mode (octal dump) */ count = 1; /* and unit count */ first = 0; /* and starting address */ saved_kstseg = kstseg; /* save values of the */ saved_kstptr = kstptr; /* process as it will change */ dbrsvm = dbrsv; sstp = sstptr; /* process arguments */ if argcnt = 1 then /* only segno/name specified */ if arg (1) = "mem" then /* mem dump needs address */ go to dump_label; else count = -1; /* set count later (segment length) */ else if argcnt >= 2 then do; mem_add = cv_oct_check_ (substr (arg (2), 1, length (arg (2))), code); if code ^= 0 then go to dump_label; if arg (1) ^= "mem" then first = mem_add; end; if argcnt >= 3 then do; /* process count or offset arg */ if substr (arg (3), 1, 1) = "+" | substr (arg (3), 1, 1) = "-" then do; offset = cv_oct_check_ (substr (arg (3), 2, length (arg (3)) - 1), code); if code ^= 0 then go to dump_label; if substr (arg (3), 1, 1) = "+" then first = first + offset; else first = first - offset; if first < 0 then first = 0; offset_flag = "1"b; end; else do; count = cv_oct_check_ (substr (arg (3), 1, length (arg (3))), code); if code ^= 0 then go to dump_label; offset_flag = "0"b; end; end; if argcnt >= 4 then do; if offset_flag then do; count = cv_oct_check_ (substr (arg (4), 1, length (arg (4))), code); if code ^= 0 then go to dump_label; end; else char_type = arg (4); end; if argcnt = 5 then char_type = arg (5); if arg (1) = "mem" then do; if code ^= 0 then go to dump_label; off18 = 0; mem_dump = "1"b; if offset_flag then mem_add = mem_add + first; substr (unspec (off18), 19, 14) = substr (unspec (mem_add), 13, 14); do k = 0 to no_apt; aptep = addrel (aptap, k * apt_entry_size); sdwp = addr (aptep -> apte.dbr); call ol_dump_util_$fnd_dbr (fixed (sdw.add, 24), segln, edoc, odsp); if edoc ^= -1 then do; edoc = divide (segln, 2, 17, 0) - 1; do i = 0 to edoc; sdwp = addrel (dsegp, i * 2); if sdw.add | i = 1 then do; sdwad = fixed (sdw.add, 24); if sdw.unpaged then do; j = ((fixed (sdw.bound, 14) + 1) * 16) - 1; if mem_add >= sdwad & mem_add <= sdwad + j then do; first = mem_add - sdwad; paged = "unpaged"; go to match; end; else go to nxt_lap; end; else do; ptp = addrel (sstptr, sdwad - fixed (sst.ptwbase, 18)); astep = addrel (ptp, - (sst.astsize)); do j = 0 to fixed (aste.csl, 9); if ^ptw.df then go to pt_lap; if fixed (ptw.add, 18) = off18 then do; first = j * 1024 + mod (mem_add, 1024); paged = "paged"; go to match; end; pt_lap: ptp = addrel (ptp, 1); end; end; end; nxt_lap: end; end; end; call ioa_ ("Memory Address ^o is in free store", mem_add); go to restore_dbr; match: pm = addrel (baseptr (i), first); call ioa_ ("^o = ^a segment ^p ^a Process DBR ^o", mem_add, paged, pm, namef_ (pm, odsp), dbrsv); segno = i; end; else do; /* a segment dump requested */ segno = cv_oct_check_ (substr (arg (1), 1, length (arg (1))), code); if code ^= 0 then do; segno = ol_dump_util_$get_segno (arg (1), odsp); if segno = -1 then return; end; mem_dump = "0"b; end; call ol_dump_util_$get_ptr (segno, p, segln, odsp); if count = -1 then count = segln; /* requested to dump entire segment */ premature_end, init_hard = "0"b; if p ^= null then do; if first > segln then do; /* check limits */ call ioa_ ("Offset ^o not found in segment ^o. Last location = ^o", first, segno, segln); go to restore_dbr; end; if char_type = "a" then do; if first + count * 4 > segln then do; count = (segln - first) * 4; premature_end = "1"b; end; end; else do; if first + count > segln then do; count = segln - first; premature_end = "1"b; end; end; if char_type = "o" then call ol_dump_util_$dump_oct (addrel (p, first), first, count); else call db_print (null, "", addrel (p, first), (char_type), first, count, null, 0, 0); if premature_end then call ioa_ ("End of segment"); go to restore_dbr; end; ck_mem: if mem_dump then go to restore_dbr; if p = null then do; /* Pick up segment from search dirs */ p = baseptr (segno); call ring0_get_$name_given_slt ("", ename, p, code, sltptr, sltnp); if code ^= 0 then do; call ioa_ ("Segment ^o not found", segno); go to restore_dbr; end; call ol_dump_util_$fnd_hcseg (ename, p, bitcnt, odsp); /* go find segment in search dirs */ if p = null then go to restore_dbr; /* if not found */ init_hard = "1"b; call ioa_ ("Segment ^a (^o) found in ^a", ename, segno, search_dirs (libx)); oi.version_number = object_info_version_2; /* Set version for object_info_ */ call object_info_$display (p, bitcnt, addr (oi), bcode); if bcode ^= 0 then do; call com_err_ (bcode, "ol_dump"); go to term_h; end; if first > oi.tlng then do; /* Requested words not in text section */ if first < oi.tlng + oi.dlng then do; i = first - fixed (rel (oi.defp)); call ioa_ ("^o|^o found in definition section|^o", segno, first, i); go to term_h; end; else if first < oi.tlng + oi.dlng + oi.llng then do; i = first - fixed (rel (oi.linkp)); call ioa_ ("^o|^o found in linkage section|^o", segno, first, i); go to term_h; end; else if first < oi.tlng + oi.dlng + oi.llng + oi.slng then do; i = first - fixed (rel (oi.symbp)); call ioa_ ("^o|^o found in symbol section |^o", segno, first, i); go to term_h; end; else call ioa_ ("Offset ^o not found in segment ^o", first, segno); go to term_h; end; else if first + count > oi.tlng then do; count = oi.tlng - first; premature_end = "1"b; end; end; p = addrel (p, first); call ioa_ ("^/"); /* print out new line */ call db_print (null, "", p, "i", first, count, null, 0, 0); if premature_end then call ioa_ ("End of text section "); term_h: if init_hard then call hcs_$terminate_noname (p, bcode); /* terminate segment */ restore_dbr: dbrsv = dbrsvm; kstseg = saved_kstseg; kstptr = saved_kstptr; call ol_dump_util_$fnd_dbr (dbrsvm, segln, i, odsp); call ol_dump_util_$get_ptr (kstseg, kstptr, segln, odsp); return; %page; % include aste; % include sst; % include object_info; % include sdw; % include ptw; % include apte; end display_dump_;  display_dump_events.pl1 10/01/82 1523.5rew 10/01/82 1523.6 104013 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1981 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ display_dump_events: proc; /* Program to examine an FDUMP, extracting all interesting time-stamped events, and printing these events in reverse-chronological order. Calling sequence: display_dump_events {Control Arguments} where Control Arguments are the following: -erf (Required) -dump_dir, -dd {dump directory} Specifies the directory in which the dump lives (default is >dumps) -last, -lt Specifies the number of events to print (default is to print all) -time