



		    dir_dump.pl1                    11/11/89  1059.4r w 11/11/89  0807.8       24246



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/* Written anonymously in time immemorial. */
/* Modified for salvager_severities BIM 831118 */

dir_dump: proc (a_dp, a_cur_len);
						/* dump directory during salvage */
dcl (dp, a_dp, print_ptr) ptr,
    i fixed bin (18),
    (cur_len, a_cur_len, start) fixed bin (17),
     for_vtoce bit (1) aligned,
     w (8) fixed bin (35) based (print_ptr),
     zero_line bit (36*8) based (print_ptr),
    (t_line, char_fmt) char (32) aligned,
     1 pad_stg aligned int static,
	2 pd1 bit (4*36) init ((16) "001111111"b),
	2 pd2 bit (4*36) init ((16) "001111111"b),
     tb_line bit (8*36) based (addr (t_line)),
     salv_err_msg ext entry options (variable),
    (addr, fixed, rel, ptr, translate, unspec, collate, substr) builtin;

dcl  first bit (1) aligned int static init ("1"b);
dcl map_string char (128) int static;			/* ascii translation table for dir printeng */

%include salv_data;
%include salvager_severities;

	dp = a_dp;
	cur_len = a_cur_len * 1024;			/* express in words */
	for_vtoce = "0"b;

doub:

/* Setup mask for dump_dir. */

	if first then do;
	     map_string = collate ();
	     substr (map_string, 1, 32) = (32) ".";
	     substr (map_string, 128, 1) = ".";
	     first = "0"b;
	end;
	if salv_data$on_line then return;
	if ^salv_data$dump then return;

	start = fixed (rel (dp));

	do i = start to (cur_len + start) -8 by 8;	/* print 8 word lines */
	     print_ptr = ptr (dp, i);
	     if zero_line ^= "0"b then do;
		call salv_err_msg (SALV_DEBUG, "^6o^4x^w^2x^w^2x^w^2x^w^2x^w^2x^w^2x^w^2x^w",
		     i, w (1), w (2), w (3), w (4), w (5), w (6), w (7), w (8));
		tb_line = zero_line & unspec (pad_stg);	/* set up for char printout */
		char_fmt = translate (t_line, map_string);
		call salv_err_msg (SALV_DEBUG, "^88x^a", char_fmt);
	     end;
loop_c:	end;

	return;

vtoce:	entry(a_vtocep);				/* dump only vtoce */
						/* now to print out vtoce */
dcl a_vtocep ptr;

	for_vtoce = "1"b;
	dp = a_vtocep;
	cur_len = 192;				/* vtoce is 192 words */
	goto doub;


     end dir_dump;




		    disk_rebuild.pl1                11/11/89  1059.4rew 11/11/89  0808.0      335376



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1989   *
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1983 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */

/* disk_rebuild (from_pvtx, to_pvtx, label_pagep, opt_bits, addr_delta, code);

   Assume from_pvtx was volume salvaged and is currently in use.
   From_pvtx is rebuilt by moving low partitions to make room
   for the increased vtoc, and copying all vtoce pages by
   using addr_delta address assignment (since disk rotation
   makes it impossible to address consecutively laid out segments
   in the same rotation).

   Written by B. S. Greenberg
   Modified 8/79 by Mike Grady to fix two bugs - partition display following
   a rebuild, and to skip ehs entries on rpv rebuild.
   Modified 03/21/81, W. Olin Sibert, for ADP PTWs and SDWs
   Modified 03/08/82, J. Bongiovanni, to set pvte.n_vtoce on "to" volume,
   for new PVTE, and to allow VTOC compression
   Modified 12/06/82, J. Bongiovanni, for VTOCE checksums
   Modified 8/9/83, E. N. Kittlitz, search_ast$check, lock ast
*/

/****^  HISTORY COMMENTS:
  1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387),
     audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056):
     Correct error message documentation.
  2) change(86-06-02,Fawcett), approve(86-04-11,MCR7383),
     audit(86-06-29,Beattie), install(86-07-17,MR12.0-1097):
     Add support for 512_WORD_IO devices, calculating n_vtoce
     per device_type.
  3) change(86-10-23,Fawcett), approve(86-10-23,MCR7517),
     audit(86-10-30,Beattie), install(86-11-03,MR12.0-1206):
     Changed to remove the word BOS from message.
  4) change(87-09-23,Fawcett), approve(87-09-23,MECR0009),
     audit(87-09-23,Beattie), install(87-09-24,MR12.1-1120):
     Change to the internal proc CHECK_VTOC_SIZES.  Fix a bug so that the new
     number of vtoces will be calculated on the pvtx2 device type instead of
     pvtx1.
  5) change(89-09-07,Farley), approve(89-10-05,MCR8137),
     audit(89-10-11,WAAnderson), install(89-10-11,MR12.3-1090):
     Changed to call the "no test" entries of read_disk and write_disk, except
     when reading or writing the label record.  This will speed up processing
     of the rebuild.
     
     Added a call to pc_wired$write to update modified pages of entry-held
     (ehs) segments back to disk, except when they are contained in a hardcore
     partition.  (phx14387)
     
     Modified the CHECK_VTOC_SIZES procedure to only check the valid vtoc map
     bits.  Bits on in the PAD bit fields of the words, due to an inconsistent
     volume, was resulting in a failure to do VTOC compression. (phx15063 &
     phx17219)
     
     Removed a non-local goto at the end of the CLEAN_UP procedure that was
     prematurely stopping the unwinder's cleanup process.
                                                   END HISTORY COMMENTS */

/* format: style4 */
disk_rebuild: proc (a_pvtx1, a_pvtx2, label_pagep, opt_bits, addr_delta, a_code);


dcl  (a_pvtx1, a_pvtx2, pvtx) fixed bin;		/* Physical volume table index of vol to be salvaged */
dcl  (pvtx1, pvtx2) fixed bin,
     (i, j, k, l, r, first_free, last_free) fixed bin;
dcl  (vtoce_incr, n_vtoce, addr_delta) fixed bin;
dcl  (baseadd1, baseadd2, old_vtoc_size, lost_pages) fixed bin,
     (addr_index, map_size) fixed bin,
     (lp, label_pagep) ptr,
     opt_bits bit (36) aligned,
     save_vtocx fixed bin init (-1),
     damaged_count fixed bin init (0),
     delta fixed bin;
dcl  vtoc_buf bit (36 * 192) aligned,
     vtoc_bufp ptr;
dcl  page_buf bit (36 * 1024) aligned,
     bufp ptr;
dcl  (a_code, code) fixed bin (35);			/* Error code */

dcl  no_free_aste_err fixed bin (35) internal static init (1);

dcl  table1p ptr;					/* Pointer to table1, i.e. bit_table */
dcl  table3p ptr;					/* Pointer to table3, i.e. new_bit_map */

dcl  s_ptr ptr;

dcl  ptp pointer;					/* Pointer to page table in aste */
dcl  vtocx fixed bin;				/* Index of the vtoc entry being processed */
dcl  pvid bit (36) aligned;				/* ID of volume being processed */
dcl  n_used_rec fixed bin;				/* Number of records used */
dcl  n_free_vtoce fixed bin;				/* Number of free vtoc entries */
dcl  max_n_vtoc_seg fixed bin internal static init (16);
dcl  free_count fixed bin;				/* count of free vtoces added to consolidated list */
dcl  p99 pic "99";					/* for name conversion */
dcl  (dname1, dname2) char (9) varying;


dcl  1 table1 based (table1p) aligned,
       2 bit_table (0:label.vol_size - 1) bit (1) unaligned;


dcl  pds$processid ext bit (36) aligned;

dcl  sst$astl bit (36) aligned external;
dcl  sst$astsize fixed bin external;
dcl  sst$checksum_filemap fixed bin external;
dcl  1 sst$level (0:3) aligned external,
       2 ausedp bit (18) unaligned,
       2 no_aste bit (18) unaligned;
dcl  sst$pts (0:3) fixed bin external;
dcl  sst$root_pvtx fixed bin external;

dcl  pv_salv_seg$ fixed bin external static;
dcl  volmap_abs_seg$ external static;
dcl  dseg$ (0:1023) fixed bin (71) aligned external static;

dcl  filemap_checksum_ entry (ptr, fixed bin, bit (36) aligned);
dcl  get_aste entry (fixed bin) returns (ptr);
dcl  get_ptrs_$given_segno entry (fixed bin) returns (ptr);
dcl  get_ptrs_$given_astep entry (ptr) returns (fixed bin (71) aligned);
dcl  get_pvtx$hold_pvtx entry (bit (36) aligned, fixed bin, fixed bin (35));
dcl  get_pvtx$release_pvtx entry (bit (36) aligned, fixed bin (35));
dcl  lock$lock_ast entry;
dcl  lock$unlock_ast entry;
dcl  page$cam entry;
dcl  pc$cleanup ext entry (ptr);
dcl  pc$truncate_deposit_all entry (ptr);
dcl  pc_wired$write entry (ptr, fixed bin, fixed bin);
dcl  pc_wired$write_wait entry (ptr, fixed bin, fixed bin);
dcl  pmut$swap_sdw entry (ptr, ptr);
dcl  ptw_util_$make_null entry (pointer, bit (22) aligned);
dcl  put_aste entry (ptr);
dcl  read_disk entry (fixed bin, fixed bin, ptr, fixed bin (35));
dcl  read_disk$read_disk_no_test entry (fixed bin, fixed bin, ptr, fixed bin (35));
dcl  salvager$set_options ext entry (bit (36) aligned);
dcl  salv_err_msg entry options (variable);
dcl  salv_err_msg$code entry options (variable);
dcl  search_ast$check ext entry (bit (36) aligned, bit (36) aligned, fixed bin, fixed bin (35)) returns (ptr);
dcl  syserr entry options (variable);
dcl  thread$out entry (ptr, bit (18));
dcl  update_vtoce ext entry (ptr);
dcl  vm_vio$clean_up entry (fixed bin);
dcl  vm_vio$get_vtocep entry (fixed bin, fixed bin) returns (ptr);
dcl  vm_vio$init entry (fixed bin, fixed bin (35)) returns (ptr);
dcl  vtoc_man$get_vtoce ext entry (bit (36) aligned, fixed bin, fixed bin, bit (3) aligned, ptr, fixed bin (35));
dcl  vtoce_stock_man$drain_stock_range entry (ptr, fixed bin, fixed bin);
dcl  write_disk entry (fixed bin, fixed bin, ptr, fixed bin (35));
dcl  write_disk$write_disk_no_test entry (fixed bin, fixed bin, ptr, fixed bin (35));

dcl  (cleanup, page_fault_error) condition;

dcl  (min, null, addr, addrel, baseno, bit, ceil, divide, fixed, mod, ptr, rel, rtrim, substr, unspec) builtin;

%page;

/* MAIN PROGRAM */

	vtoc_bufp = addr (vtoc_buf);
	bufp = addr (page_buf);

	begin;					/* allocate tables for address incrementation */

dcl  last_used (addr_delta) fixed bin;

	     delta = addr_delta;
	     lp = label_pagep;
	     pvtx1 = a_pvtx1;
	     pvtx2, pvtx = a_pvtx2;
	     code = 0;
	     free_count = 0;
	     pvt_arrayp = addr (pvt$array);

	     call salvager$set_options (opt_bits);
	     p99 = pvt_array (pvtx1).logical_area_number;
	     dname1 = rtrim (pvt_array (pvtx1).devname || "_" || p99 || pvt_array (pvtx1).sv_name);
	     p99 = pvt_array (pvtx2).logical_area_number;
	     dname2 = rtrim (pvt_array (pvtx2).devname || "_" || p99 || pvt_array (pvtx2).sv_name);

	     call salv_err_msg (SALV_ANNOUNCE, "disk_rebuild: Begin disk rebuild of ^a onto ^a.", dname1, dname2);
	     if pvtx1 = pvtx2 then do;
		call salv_err_msg (SALV_ANNOUNCE, "disk_rebuild: same drive specified for source and copy, aborting.");
		goto err_ret;
	     end;

	     if ^pvt_array (pvtx1).used then do;
		call salv_err_msg (SALV_ANNOUNCE, "disk_rebuild: ^a must be mounted for rebuild.", dname1);
		goto err_ret;
	     end;

	     if pvt_array (pvtx2).used then do;
		call salv_err_msg (SALV_ANNOUNCE, "disk_rebuild: ^a must not be mounted for rebuild.", dname2);
		goto err_ret;
	     end;

	     call CHECK_VTOC_SIZES;

	     pvtep = addr (pvt_array (pvtx2));
	     pvid = addr (pvt_array (pvtx1)) -> pvte.pvid;/* get first disk id */

/* cop label so vm_vio init works */
	     do i = 0 to VTOC_ORIGIN - 0;
		if i = 0 then call copy_page (0, 0, "1"b);
		else call copy_page (i, i, "0"b);
	     end;

	     on cleanup begin;
		     if salv_data$debug then call syserr (CRASH, "disk_rebuild: salv cleanup debugging stop, dump and type go.");
		     call CLEAN_UP;
		end;

/* label.vtoc_size has been updated to new value, other info  old */
	     s_ptr = vm_vio$init (pvtx, code); if code ^= 0 then goto err_ret;

	     labelp = ptr (s_ptr, LABEL_ADDR * 1024);
	     vol_mapp = ptr (s_ptr, VOLMAP_ADDR * 1024);
	     vtoc_headerp = ptr (s_ptr, DUMPER_BIT_MAP_ADDR * 1024);
	     vtoc_mapp = ptr (s_ptr, VTOC_MAP_ADDR * 1024);

	     call salv_err_msg (SALV_DEBUG, "^/disk_rebuild: Summary of original disk contents follows:^/");
	     call REPORT_SUMMARY;

/* Set up VTOC header for pre-MR10 compatibility */

	     vtoc_header.n_vtoce = n_vtoce;
	     vtoc_header.n_free_vtoce = 0;
	     vtoc_header.first_free_vtocx = -1;
	     vtoc_header.vtoc_last_recno = label.vtoc_size - 1;

/* The VTOC Map has been copied from the old volume. Null it out. */

	     vtoc_map.n_vtoce = n_vtoce;
	     vtoc_map.vtoc_last_recno = label.vtoc_size - 1;
	     vtoc_map.bit_map_n_words = divide (n_vtoce + 31, 32, 17);
	     unspec (vtoc_map.bit_map) = ""b;

	     pvt_array (pvtx2).n_vtoce = n_vtoce;	/* So vtoc_man works */
	     vtoce_incr = n_vtoce - old_vtoc_size;
	     vtoc_header.vtoc_last_recno = label.vtoc_size - 1;
						/* find out about partition changes */
	     first_free = label.vtoc_size;
update_frec:   do i = 1 to lp -> label.nparts;
		if lp -> label.parts (i).frec = first_free then do;
		     first_free = first_free + lp -> label.parts (i).nrec;
		     goto update_frec;
		end;
	     end;

	     last_free = lp -> label.vol_size;
	     do j = 1 to lp -> label.nparts;
		if lp -> label.parts (j).frec > first_free then if lp -> label.parts (j).frec < last_free then
			last_free = lp -> label.parts (j).frec;
	     end;

	     last_free = last_free - 1;
	     lost_pages = vol_map.n_rec - (last_free - first_free);
	     if lost_pages > vol_map.n_free_rec then do;
		call salv_err_msg (SALV_ANNOUNCE, "disk_rebuild: not enough free records (only ^d.) for increase (need ^d.)",
		     vol_map.n_free_rec, lost_pages);
		goto err_out;
	     end;

	     baseadd1 = vol_map.base_add;
	     baseadd2 = first_free;

	     if baseadd1 ^= baseadd2 then
		call salv_err_msg (SALV_DEBUG, "disk_rebuild: base of paging region changed from  ^d. to ^d.", baseadd1, baseadd2);

	     vol_map.base_add = baseadd2;
	     map_size, vol_map.n_rec = vol_map.n_rec - lost_pages;
	     vol_map.bit_map_n_words = ceil (map_size / 32);
						/* now copy matching partitions */
	     do i = 1 to lp -> label.nparts;
		do j = 1 to label.nparts;
		     if lp -> label.parts (i).part = label.parts (j).part then do;
			r = min (lp -> label.parts (i).nrec, label.parts (j).nrec);
			if lp -> label.parts (i).part = "bos"
			     | lp -> label.parts (i).part = "alt" then r = 0;
			call salv_err_msg (SALV_DEBUG, "disk_rebuild: copying ^d. rec of part ^a", r, label.parts (j).part);
			k = label.parts (j).frec;
			do l = lp -> label.parts (i).frec to lp -> label.parts (i).frec + (r - 1);
			     call copy_page (k, l, "0"b);
			     k = k + 1;
			end;
		     end;
		end;
	     end;
						/* now copy new label page, old one not needed anymore */
	     call write_disk (pvtx2, 0, lp, code);
	     if code ^= 0 then do;
		call salv_err_msg$code (SALV_ANNOUNCE, "", code, "disk_rebuild: Error writing label:");
		goto err_out;
	     end;
	     labelp = lp;				/* all new references go to new label copy */
%page;

	     call INIT_TABLES (table1p, table3p, code);

	     n_free_vtoce = 0;
	     n_used_rec = 0;
	     save_vtocx = -1;
						/* initialize to get assigned addresses to cycle above baseadd2 */
	     do i = 1 to delta;
		last_used (i) = baseadd2 - i;
	     end;
						/* copy each permanent, valid vtoce */
	     call copy_vtoc;			/* and move all pages onto new disk */

	     call UPDATE_VOL_MAP;

	     call UPDATE_VTOC_MAP;

	     call FORCE_VTOC_ON_DISK;

	     call FORCE_LABEL_ON_DISK;

	     call salv_err_msg (SALV_DEBUG, "disk_rebuild: End of rebuilding. New summary report follows:^/");

	     call REPORT_SUMMARY;


err_out:
	     if free_count > 0 then call salv_err_msg (SALV_ANNOUNCE, "disk_rebuild: ^d. vtoces added to list of free vtoces", free_count);
	     if code = 0 then call salv_err_msg (SALV_ANNOUNCE, "disk_rebuild: Disk rebuild finished.");
	     else call salv_err_msg$code (SALV_ANNOUNCE, "", code, "disk_rebuild: disk rebuild finished with error:");


	     call CLEAN_UP;

err_ret:	     a_code = code;
	     if ^pvt_array (pvtx2).used
	     then pvt_array (pvtx2).n_vtoce = 0;

	     return;
%page;

copy_vtoc: proc;

dcl  r fixed bin;

dcl  whole_vtoce bit (192 * 36) based aligned;

	do vtocx = 0 to min (old_vtoc_size, n_vtoce) - 1; /* could have shrunk */
	     if mod (vtocx, 1000) = 0 then if vtocx > 0 then
		     call syserr (ANNOUNCE, "disk_rebuild: processing VTOCE #^d.", vtocx);
	     call vtoc_man$get_vtoce (pvid, pvtx1, vtocx, "111"b, vtoc_bufp, code);
	     if code ^= 0 then do;
		call salv_err_msg$code (SALV_ANNOUNCE, "", code, "disk_rebuild: reading vtocx ^oo:", vtocx);
		goto err_out;
	     end;

/* get ptr to spot for  new one */
	     vtocep = vm_vio$get_vtocep (pvtx2, vtocx);
	     if vtoc_bufp -> vtoce.uid = "0"b then do;
		call FREE_VTOCE;
		goto next_vtocx;
	     end;
	     if ^vtoc_bufp -> vtoce.dirsw then do;
		if vtoc_bufp -> vtoce.per_process then do;
		     if salv_data$debug then call salv_err_msg (SALV_DEBUG, "disk_rebuild: freeing per process vtocx ^oo: ^a",
			     vtocx, vtoc_bufp -> vtoce.primary_name);
		     call FREE_VTOCE;
		     goto next_vtocx;
		end;
		if vtoc_bufp -> vtoce.deciduous then do;
		     if salv_data$debug then call salv_err_msg (SALV_DEBUG, "disk_rebuild: freeing deciduous vtocx ^oo: ^a",
			     vtocx, vtoc_bufp -> vtoce.primary_name);
		     call FREE_VTOCE;
		     goto next_vtocx;
		end;
	     end;
						/* see if have to update */
	     call lock$lock_ast;
	     astep = search_ast$check ((vtoc_bufp -> vtoce.uid), pvid, vtocx, (0)); /* ignore double-uid error */
	     if astep ^= null then do;
		if ^aste.ehs then			/* if we don't need this */
		     call pc$cleanup (astep);		/* get everything updated on disk */
		else if ^aste.hc_part then		/* if needed, at least get modified */
		     call pc_wired$write (astep, 0, -1);/* pages updated to disk */
		call update_vtoce (astep);
		call lock$unlock_ast;		/* don't really need it any more */
		call vtoc_man$get_vtoce (pvid, pvtx1, vtocx, "111"b, vtoc_bufp, code);
		if code ^= 0 then do;
		     call salv_err_msg$code (SALV_ANNOUNCE, "", code, "disk_rebuild: reading vtocx ^oo:", vtocx);
		     goto err_out;
		end;
	     end;
	     else call lock$unlock_ast;		/* unlocked no matter what */

	     if vtoc_bufp -> vtoce.damaged then damaged_count = damaged_count + 1;

	     vtocep -> whole_vtoce = vtoc_bufp -> whole_vtoce;
	     do i = 0 to 255;
		if substr (vtoce.fm (i), 1, 1) ^= "1"b then do;
		     call get_new_addr (vtocx, r);
		     call copy_page (fixed (substr (vtoce.fm (i), 2, 17), 17), r, "0"b);
		     vtoce.fm (i) = bit (fixed (r, 18), 18);
		     n_used_rec = n_used_rec + 1;
		end;
	     end;
	     if sst$checksum_filemap = 0 then do;
		vtocep -> vtoce.fm_checksum_valid = "0"b;
		vtocep -> vtoce.fm_checksum = ""b;
	     end;
	     else do;
		vtocep -> vtoce.fm_checksum_valid = "1"b;
		call filemap_checksum_ (addr (vtocep -> vtoce.fm),
		     fixed (vtocep -> vtoce.csl), vtocep -> vtoce.fm_checksum);
	     end;
	     vtocep -> vtoce.fm_damaged = "0"b;

next_vtocx:
	end;

	if old_vtoc_size ^= n_vtoce then
	     call salv_err_msg (SALV_ANNOUNCE, "disk_rebuild: no. vtoces changed from ^d. to ^d.", old_vtoc_size, n_vtoce);
	if n_vtoce > old_vtoc_size then do vtocx = old_vtoc_size to n_vtoce - 1;
	     vtocep = vm_vio$get_vtocep (pvtx2, vtocx);
	     call FREE_VTOCE;
	end;

     end copy_vtoc;
%page;

copy_page: proc (from, to, sp_bit);

dcl  (from, to) fixed bin;
dcl  sp_bit bit (1) aligned;

	if sp_bit then
	     call read_disk (pvtx1, from, bufp, code);
	else call read_disk$read_disk_no_test (pvtx1, from, bufp, code);
	if code ^= 0 then do;
	     call salv_err_msg$code (SALV_ANNOUNCE, "", code, "disk_rebuild: Error from read_disk, aborting:");
	     goto err_out;
	end;

	if sp_bit then do;
	     bufp -> label.vtoc_size = lp -> label.vtoc_size;
	     call write_disk (pvtx2, to, bufp, code);
	end;
	else call write_disk$write_disk_no_test (pvtx2, to, bufp, code);
	if code ^= 0 then do;
	     call salv_err_msg$code (SALV_ANNOUNCE, "", code, "disk_rebuild: Error from write_disk, aborting:");
	     goto err_out;
	end;

     end copy_page;

get_new_addr: proc (a_vtocx, a_addr);
						/* last_used (delta) is array of last awarded cyclic addresses */
dcl  a_vtocx fixed bin,
     a_addr fixed bin;

	if a_vtocx ^= save_vtocx then do;		/* switch  to next slot cycle */
	     addr_index = 1;
	     do j = 1 to delta;
		if last_used (j) < last_used (addr_index) then addr_index = j;
	     end;
	     save_vtocx = a_vtocx;
	end;

	a_addr, last_used (addr_index) = last_used (addr_index) + delta;
	bit_table (last_used (addr_index)) = "1"b;
						/* check next address to see if oob */
	if last_used (addr_index) + delta > map_size + baseadd2 then do;
	     call salv_err_msg (SALV_ANNOUNCE, "disk_rebuild: out of room on vtocx ^oo , page ^oo", vtocx, i);
	     goto err_out;
	end;
     end get_new_addr;
%page;

FREE_VTOCE: proc;

dcl  bitx fixed bin;
dcl  wordx fixed bin;


	if vtoce.uid ^= "0"b then free_count = free_count + 1;

	unspec (vtoce) = "0"b;

	wordx = divide (vtocx, 32, 17);
	bitx = mod (vtocx, 32) + 1;
	bit_map_wordp = addr (vtoc_map.bit_map (wordx));
	substr (bit_map_word.bits, bitx, 1) = "1"b;

	n_free_vtoce = n_free_vtoce + 1;

	return;

     end FREE_VTOCE;



UPDATE_VOL_MAP: proc;

dcl  1 old_map (vol_map.bit_map_n_words) based (addr (vol_map.bit_map)) aligned,
       2 pad1 bit (1) unaligned,
       2 bits bit (32) unaligned,
       2 pad2 bit (3) unaligned;

dcl  1 new_map (vol_map.bit_map_n_words) based (table3p) aligned like old_map;

dcl  bit_table_map (1000) bit (32) based (addr (bit_table (vol_map.base_add))) unaligned;

dcl  w fixed bin;
dcl  j fixed bin;
dcl  n_free_rec fixed bin;



	unspec (new_map) = "0"b;

	do w = 1 to vol_map.bit_map_n_words;
	     new_map (w).bits = ^bit_table_map (w);
	end;

	j = mod (vol_map.n_rec, 32);
	if j ^= 0 then substr (new_map (w - 1).bits, j + 1) = "0"b;

	if unspec (old_map) = unspec (new_map) then ;
	else do;
	     call report_bit_map_changed;
	     unspec (old_map) = unspec (new_map);
	end;

	n_free_rec = vol_map.n_rec - n_used_rec;

	if vol_map.n_free_rec ^= n_free_rec then
	     do;
	     call report_n_free_rec_changed;
	     vol_map.n_free_rec = n_free_rec;
	end;
	return;

%page;

report_bit_map_changed: proc;
	     call salv_err_msg (SALV_DEBUG, "disk_rebuild: Map of assigned addresses changed");
	     return;
	end;

report_n_free_rec_changed: proc;
	     call salv_err_msg (SALV_DEBUG, "disk_rebuild: no. of free recs changed from ^d. to ^d.",
		vol_map.n_free_rec, n_free_rec);
	     return;
	end;

     end UPDATE_VOL_MAP;


UPDATE_VTOC_MAP: proc;

	if vtoc_map.n_free_vtoce ^= n_free_vtoce then do;
	     call report_n_free_vtoce;
	     vtoc_map.n_free_vtoce = n_free_vtoce;
	end;


	return;


report_n_free_vtoce: proc;
	     call salv_err_msg (SALV_DEBUG, "disk_rebuild: no. of free vtoces changed from ^d. to ^d.",
		vtoc_header.n_free_vtoce, n_free_vtoce);
	     return;
	end;

     end UPDATE_VTOC_MAP;







FORCE_VTOC_ON_DISK: proc;

dcl  i fixed bin;


	do i = 1 to max_n_vtoc_seg - 1;
	     astep = get_ptrs_$given_segno (fixed (baseno (s_ptr)) + i);
	     if astep ^= null then call pc_wired$write_wait (astep, 0, -1);
	end;

	return;

     end FORCE_VTOC_ON_DISK;
%page;
FORCE_LABEL_ON_DISK: proc;

	astep = get_ptrs_$given_segno (fixed (baseno (s_ptr)));

	if astep ^= null then call pc_wired$write_wait (astep, LABEL_ADDR, 1);

	return;

     end FORCE_LABEL_ON_DISK;
%page;
REPORT_SUMMARY: procedure;

dcl  i fixed bin, ptot fixed bin (24);

	call salv_err_msg (SALV_DEBUG, "^/disk_rebuild: Summary Report^/^5xVolume ^a of logical volume ^a.^/",
	     label.pv_name, label.lv_name);

	call salv_err_msg (SALV_DEBUG, "Paging region begins at record ^d. (^oo), for ^d. (^oo) records.",
	     vol_map.base_add, vol_map.base_add, vol_map.n_rec, vol_map.n_rec);
	call salv_err_msg (SALV_DEBUG, "^d. (^oo) free records therein.", vol_map.n_free_rec, vol_map.n_free_rec);

	call salv_err_msg (SALV_DEBUG, "Label/VTOC size is ^d. records, ^d. VTOCEs.", label.vtoc_size, vtoc_header.n_vtoce);
	call salv_err_msg (SALV_DEBUG, "VTOC version ^d., ^d. free VTOCEs.^/", vtoc_header.version, vtoc_header.n_free_vtoce);

	if label.nparts = 0 then call salv_err_msg (SALV_DEBUG, "No partitions defined.");
	else do;
	     ptot = 0;
	     call salv_err_msg (SALV_DEBUG, "^/^10xPartition Map^/Name^16xStart^15xLength^/");
	     do i = 1 to label.nparts;
		call salv_err_msg (SALV_DEBUG, "^4a^6x^9d.^x(^6oo)^x^9d.^x(^6oo)",
		     label.parts.part (i), label.parts (i).frec, label.parts (i).frec, label.parts (i).nrec,
		     label.parts (i).nrec);
		ptot = ptot + label.parts (i).nrec;
	     end;
	     call salv_err_msg (SALV_DEBUG, "^35x______^2x_______^/^31x^9d.^x(^6oo)^/", ptot, ptot);
	end;
	call salv_err_msg (SALV_DEBUG, "Volume size is ^d. (^oo) records total.^/", label.vol_size, label.vol_size);

	if damaged_count > 0 then call salv_err_msg (SALV_DEBUG, "^/^10x^d. damaged segments.", damaged_count);


     end REPORT_SUMMARY;
%page;
CHECK_VTOC_SIZES:
     proc;

/* Validates the size of the new VTOC. It may be equal to or larger than the
   old VTOC. Or it may be smaller, provided that there are no active VTOCEs
   in the region of the old VTOC being truncated. */

dcl  all_free bit (1);
dcl  bit_map_words fixed bin;
dcl  first_free_word fixed bin;
dcl  res fixed bin;
dcl  tsdw fixed bin (71);
dcl  wordx fixed bin;

dcl  ALL_FREE bit (36) aligned internal static options (constant)
	init ("377777777770"b3);


	old_vtoc_size = pvt_array (pvtx1).n_vtoce;
	n_vtoce = (lp -> label.vtoc_size - VTOC_ORIGIN) * VTOCES_PER_RECORD (pvt_array (pvtx2).device_type);

	if n_vtoce >= old_vtoc_size then return;

/* Get all free VTOCEs in the truncated region into the VTOC Map */

	call vtoce_stock_man$drain_stock_range (addr (pvt_array (pvtx1)), n_vtoce, old_vtoc_size - 1);

	call pmut$swap_sdw (addr (volmap_abs_seg$), addr (pvt_array (pvtx1).volmap_seg_sdw));
	vtoc_mapp = ptr (addr (volmap_abs_seg$), pvt_array (pvtx1).vtoc_map_offset);

	on page_fault_error begin;
		call salv_err_msg (SALV_ANNOUNCE, "disk_rebuild: Read error accessing VTOC Map of ^a",
		     dname1);
		tsdw = 0;
		call pmut$swap_sdw (addr (volmap_abs_seg$), addr (tsdw));
		goto err_ret;
	     end;

	all_free = "1"b;
	first_free_word = divide (n_vtoce + 32, 32, 17);
	bit_map_words = divide (old_vtoc_size + 31, 32, 17);
	if (bit_map_words - 2) >= first_free_word
	then do wordx = first_free_word to bit_map_words - 2
		while (all_free);
	     if (vtoc_map.bit_map (wordx) & ALL_FREE) ^= ALL_FREE
	     then all_free = "0"b;
	end;

	res = mod (n_vtoce, 32);
	if res ^= 0
	then do;
	     bit_map_wordp = addr (vtoc_map.bit_map (first_free_word - 1));
	     if substr (bit_map_word.bits, res + 1, 32 - res) ^= substr (ALL_FREE, 2, 32 - res)
	     then all_free = "0"b;
	end;

	res = mod (old_vtoc_size, 32);
	if res = 0 then res = 32;
	bit_map_wordp = addr (vtoc_map.bit_map (bit_map_words - 1));
	if substr (bit_map_word.bits, 1, res) ^= substr (ALL_FREE, 2, res)
	then all_free = "0"b;

	tsdw = 0;
	call pmut$swap_sdw (addr (volmap_abs_seg$), addr (tsdw));
	vtoc_mapp = null ();

	if ^all_free then do;
	     call salv_err_msg (SALV_ANNOUNCE, "disk_rebuild: Cannot compress VTOC on ^a because active VTOCEs in the truncated region.",
		dname1);
	     goto err_ret;
	end;

	return;

     end;

%page;
CLEAN_UP: proc;


dcl  segno fixed bin;


	segno = fixed (baseno (addr (pv_salv_seg$)), 18);

	astep = get_ptrs_$given_segno (segno);

	if astep ^= null then
	     do;

	     dseg$ (segno) = 0;
	     call page$cam;

	     call pc$truncate_deposit_all (astep);
	     if aste.usedf then call get_pvtx$release_pvtx ((pvt_array.pvid (aste.pvtx)), (aste.pvtx));

	     if sst$astl ^= pds$processid then call lock$lock_ast;
	     call put_aste (astep);
	     call lock$unlock_ast;

	end;

	call vm_vio$clean_up (pvtx);

     end CLEAN_UP;
%page;
INIT_TABLES: proc (table1p, table3p, code);

dcl  table1p ptr;
dcl  table3p ptr;
dcl  code fixed bin (35);

dcl  pv_salv_seg$ ext;

dcl  1 pv_salv_seg based (addr (pv_salv_seg$)) aligned,

       2 table1,
         3 bit_table (0:label.vol_size - 1) bit (1) unaligned,

       2 table3,
         3 new_map (1:vol_map.bit_map_n_words) bit (36) aligned,

       2 end bit (36) aligned;

dcl  segno fixed bin,				/* segno assigned to this segment  */
     pvtx fixed bin,				/* PVT index for this segment  */
     msl fixed bin;					/* number of pages for this segment  */

dcl  (i, pts, ptsi) fixed bin;

dcl  tsdw fixed bin (71);

	code = 0;

	segno = fixed (baseno (addr (pv_salv_seg$)), 18);
	pvtx = sst$root_pvtx;
	msl = divide (fixed (rel (addr (pv_salv_seg.end)), 18), 1024, 17, 0) + 1;


/* ALLOCATE AN ASTE OF THE APPROPRIATE SIZE */

	call lock$lock_ast;

	astep = get_aste (msl);			/* Get an ASTE with the appropriate size PT */

	if astep = null then
	     do;
	     call lock$unlock_ast;
	     code = no_free_aste_err;
	     call syserr (ANNOUNCE, "disk_rebuild: INIT_TABLES: aste pool ^oo too small", msl);
	     return;
	end;

	ptsi = fixed (aste.ptsi);
	pts = sst$pts (ptsi);


/* ZERO THE ASTE  */

	astep -> aste_part.two = "0"b;		/* Zero the rest of the ASTE except ptsi and marker */


/* INITIALIZE THE PAGE TABLE WITH NULL ADDRESSES AND PAGE FAULT BITS */

	ptp = addrel (astep, sst$astsize);		/* get a pointer to the page table */

	do i = 0 to pts - 1;
	     call ptw_util_$make_null (addrel (ptp, i), fill_page_table_null_addr); /* Make null PTWs */
	end;


/* INITIALIZE THE ASTE */

	astep -> aste.vtocx = -1;			/* show there is no VTOCE for the segment */
	astep -> aste.dnzp = "1"b;
	astep -> aste.nqsw = "1"b;			/* turn on no quota switch */
	astep -> aste.strp = bit (fixed (segno, 18), 18); /* store segment number in AST */
	astep -> aste.msl = bit (fixed (msl, 9), 9);	/* set the max length */
	astep -> aste.pvtx = pvtx;			/* store the root physical volume table index */


/* THE CLEAN_UP OPERATION WILL DEPEND ON THE ORDER IN WHICH THE NEXT ACTIONS ARE PERFORMED */

	tsdw = get_ptrs_$given_astep (astep);		/* Get initial  SDW. */
	dseg$ (segno) = tsdw;			/* store temp SDW in the descriptor segment */
	call page$cam;
	call get_pvtx$hold_pvtx ((pvt_array (pvtx).pvid), pvtx, (0)); /* Hold this vol */

	astep -> aste.usedf = "1"b;			/* mark it as being used - as late as possible */

	call thread$out (astep, sst$level (ptsi).ausedp); /* thread the entry out of the used list */

	call lock$unlock_ast;


/* INITIALIZE POINTERS TO TABLES */

	table1p = addr (pv_salv_seg.table1);
	table3p = addr (pv_salv_seg.table3);

	return;

     end INIT_TABLES;

	end;					/* begin block and proc */

/* format: off */

%page; %include aste;
%page; %include disk_pack;
%page; %include fs_vol_label;
%page; %include null_addresses;
%page; %include pvte;
%page; %include salv_data;
%page; %include salvager_severities;
%page; %include syserr_constants;
%page; %include vol_map;
%page; %include vtoc_header;
%page; %include vtoc_map;
%page; %include vtoce;

/* format: on */
%page;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   disk_rebuild: Begin disk rebuild of DSKX_NN{s} onto DSKY_MM{s}

   S:	$salvout

   T:	$dskr

   M:	This message is printed when disk rebuilding begins.

   A:	$ignore

   Message:
   disk_rebuild: salv cleanup debugging stop, dump and type go

   S:	$crash

   T:	During disk rebuild

   M:	A disk rebuild has aborted due to a crawlout, and the debug switch is set.
   This message causes the system to return to BCE so that a dump can be taken.

   A:	Follow programmer instructions.


   Message:
   disk_rebuild: INIT_TABLES: aste pool WWWo too small

   S:	$info

   T:	$run

   M:	The physical volume salvager
   was unable to
   obtain the necessary temporary AST entries
   for its work segments.
   No salvaging was done.

   A:	Shut down,
   manually correct the SST card,
   and reboot.
   Then salvage all volumes,
   since the indicator that volumes need salvaging
   may have been lost.

   Message:
   disk_rebuild: processing VTOCE #XXX.

   S:	$info

   T:	$dskr

   M:	This message indicates that a disk rebuild is progressing normally.
   It is printed every 1000. VTOC entries.

   A:	$ignore


   Message:
   disk_rebuild: not enough free records (only XXX.) for increase (need YYY.)

   S:	$salvout

   T:	$dskr

   M:	An attempt was made to increase the size
   of some partitions
   or of the VTOC.
   This required a decrease in the size of the paging region.
   The paging region is too full to be shrunk as required.
   The disk rebuild is aborted.

   A:	Issue a different disk_rebuild command,
   or bring up Multics and delete some segments from the pack before trying again.


   Message:
   disk_rebuild: same drive specified for source and copy, aborting

   S:	$salvout

   T:	During disk rebuilding

   M:	The operator attempted to specify the same drive as input and output.
   No action was taken.

   A:	Enter a corrected command.


   Message:
   disk_rebuild: base of paging region changed from XXX. to YYY.

   S:	$salvout

   T:	$dskr

   M:	The base of the paging
   region for the new pack is different from that for the old one.

   A:	$ignore


   Message:
   disk_rebuild: copying XXX. rec of part NAME

   S:	$salvout

   T:	$dskr

   M:	A disk rebuild is reformatting a pack
   which contains non-paging partitions.
   The contents of these partitions are copied exactly.

   A:	$ignore


   Message:
   disk_rebuild: Error writing label: ERRORMESS

   S:	$salvout

   T:	$dskr

   M:	A disk error has occurred writing the new label during a disk rebuild.
   The disk rebuild is aborted.

   A:	Correct the problem and issue a new command.


   Message:
   disk_rebuild: Summary of original disk contents follows:

   S:	$salvout

   T:	$dskr

   M:	A summary report of the volume parameters before rebuilding is printed.

   A:	$ignore


   Message:
   disk_rebuild: End of rebuilding. New summary report follows:

   S:	$salvout

   T:	$dskr

   M:	Rebuilding has completed.  A summary report of the new volume parameter
   is printed.

   A:	$ignore


   Message:
   disk_rebuild: Summary Report
   .br
        Volume PVNAME of logical volume LVNAME.
   .sp
   Paging region begins at record DD. (WWo), for LL. (XXo) records.
   .br
   DD. (WWo) free records therein.
   .br
   Label/VTOC size is RR. records, MM. VTOCEs.
   .br
   VTOC version X., TTT. free VTOCEs.
   .sp
             Partition Map
   .br
   Name                Start               Length
   .sp
   NAME            DDD. (   WWWo)       DDD. (   WWWo)
   .br
                                      ______  _______
   .br
                                        DDD. (   WWWo)
   .sp
   Volume size is DDDD. (YYYYo) records total.
   .sp
             DD. damaged segments.

   S:	$salvout

   T:	During disk rebuilding.

   M:	This is a report summarizing physical volume parameters printed by
   the disk rebuilder both before and after rebuilding.
   The partition map is omitted if no partitions are defined on the volume.

   A:	$ignore


   Message:
   disk_rebuild: Disk rebuild finished.

   S:	$salvout

   T:	$dskr

   M:	The disk rebuild has completed.

   A:	$ignore


   Message:
   disk_rebuild: vtocx XXXo NAME branch unconnected due to YYYo

   S:	$salvout

   T:	$dskr

   M:	This is debugging output
   produced only if the debug switch is on
   during a disk rebuild with branch checking.
   It informs the system programmers of the
   reasons for connection failure.

   A:	$ignore


   Message:
   disk_rebuild:  Disk rebuild finished with errors: ERRORMESS

   S:     $salvout

   T:     $dskr

   M:     The disk rebuild has been aborted due to the indicated ERRORMESS.

   A:     $inform


   Message:
   disk_rebuild: Error from read_disk, aborting: ERRORMESS

   S:	$salvout

   T:	$dskr

   M:	$err
   The disk rebuild is aborted.

   A:	$inform


   Message:
   disk_rebuild: Error from write_disk, aborting: ERRORMESS

   S:	$salvout

   T:	$dskr

   M:	$err
   The disk rebuild is aborted.

   A:	$inform


   Message:
   disk_rebuild: out of room on vtocx XXXo, page YYYo

   S:	$salvout

   T:	$dskr

   M:	$err
   The disk rebuild is aborted.

   A:	$inform


   Message:
   disk_rebuild: reading vtocx XXXo: ERRORMESS

   S:	$salvout

   T:	$dskr

   M:	$err

   A:	$inform


   Message:
   disk_rebuild: NN vtoces added to list of free vtoces.

   S:	$salvout

   T:	$dskr

   M:	NN free VTOC entries
   were found while salvaging and added to the list of free VTOC entries.
   This is a normal message.

   A:	$ignore


   Message:
   disk_rebuild: freeing deciduous vtocx XXXo: NAME

   S:	$salvout

   T:	$dskr

   M:	The segment originally named NAME
   at vtoc index XXXo
   was deciduous, and has been deleted from the RPV.
   This is debugging output
   printed for system programmers
   if a SALV DEBG card is supplied.

   A:	$ignore


   Message:
   disk_rebuild: freeing process vtocx XXXo: NAME

   S:	$salvout

   T:	$dskr

   M:	The segment originally named NAME
   at vtoc index XXXo
   was per-process
   and has been deleted.
   This is debugging output
   printed for system programmers
   if a SALV DEBG card is used.

   A:	$ignore


   Message:
   disk_rebuild: Map of assigned addresses changed

   S:	$salvout

   T:	$dskr

   M:	If any corrections were made to the
   map on the volume
   which shows which addresses are free and which are in use,
   this message is printed.
   If the volume was not properly shut down, this message is to be expected.

   A:	$ignore


   Message:
   disk_rebuild: no. of free recs changed from OLD. to NEW.

   S:	$salvout

   T:	$dskr

   M:	If The number of free records
   in the volume label
   is changed by a volume salvage,
   this message is printed.
   If the volume was not properly shut down, this message is to be expected.

   A:	$ignore


   Message:
   disk_rebuild: no. of free vtoces changed from OLD. to NEW. 

   S:	$salvout

   T:	$dskr

   M:	If the number of
   free VTOC entries
   in the volume label
   is changed by a volume salvage,
   this message is printed.

   A:	$ignore


   Message:
   disk_rebuild: dskX_NN{s} must be mounted for rebuild.

   S:     $salvout

   T:	$dskr

   M:	The "from" volume must be mounted for the rebuild.

   A:	Mount the logical volume to which the "from" volume belongs
   and try the rebuild abain.

   Message:
   disk_rebuild: dskX_NN{s} must not be mounted for rebuild.

   S:     $salvout

   T:	$dskr

   M:	The "to" volume must not be mounted to the Storage System for
   a rebuild.

   A:     Demount the logical volume to which the volume belongs and retry
   the rebuild.

   Message:
   disk_rebuild: Read error accessing VTOC Map of dskX_NN{s}

   S:     $salvout

   T:	$dskr

   M:	$err
   The rebuild is aborted.

   A:     $inform

   Message:
   disk_rebuild: Cannot compress VTOC on dskX_NN{s} because active VTOCEs in the
   truncated region.

   S:     $salvout

   T:     $dskr

   M:     A rebuild was requested in which the number of VTOCEs on the new
   volume was smaller than the number of VTOCEs on the old volume. This is
   permitted only if there are no active VTOCEs in the truncated region
   (that is, no active VTOCEs on the old volume have VTOCE indices which
   would be too high for the new volume).

   A:     Run sweep_pv -from num_vtoces
   to remove these VTOCEs from the old volume and retry the rebuild. It
   may be necessary to salvage the volume to recover lost VTOCEs in the
   truncated region.


   END MESSAGE DOCUMENTATION */

     end disk_rebuild;




		    on_line_salvager.pl1            11/11/89  1059.4rew 11/11/89  0806.7       83907



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/* format: style4,delnl,insnl,ifthenstmt,ifthen,indnoniterend,indend,^indproc */
/* format: off */
on_line_salvager:
     proc (a_dp, a_code);

/* Modified by Kobziar on 12-6-73 to delete only user from acl in dump */
/* Modified by Kobizar on 12-3-74 to give all users access under AI */
/* Modified by R. Bratt on 06/03/76 to call find_$finished */
/* Last modified by Greenberg 07/26/76 to terminate processes cleanly, also cleaned up AST length getting */
/* Modified by S. Barr 9/76 to use new hash table format. */
/* Modified by Greenberg 11/18/76 for setting AIM out of service. */
/* Modified by S. Barr 4/77 to force rebuild. */
/* Rewritten by S. Barr 7/77 to fix bugs and to call the new salvager primatives. */
/* Rewritten 7/77 by S. Barr for multiprocess salvaging. */
/* Modified 6/79 by Mike Grady for stack 0 sharing */
/* Modified 10 Aug 1981, W. Olin Sibert, to handle errors while creating dump copies */
/* Modified 25 February 1985, Keith Loepere, to use the real internal get_pathname_. */

dcl  a_dp pointer parameter;
dcl  a_code fixed bin (35) parameter;

dcl  dir_name char (168);
dcl  ename char (32);
dcl  path_name char (168) var;
dcl  set_sw fixed bin (35);
dcl  (i, l) fixed bin;
dcl  (root, old_modify) bit (1);
dcl  entry_time char (24);
dcl  (dir_name_len, save_level) fixed bin (17);
dcl  code fixed bin (35);
dcl  salvlp ptr;					/* ptr to salv_data$lock. */

dcl  unlock_parent bit (1) aligned;
dcl  rb (3) fixed bin (6) init (7, 7, 7);

dcl  1 args aligned like salv_args;

dcl  pds$process_group_id char (32) aligned external static;
dcl  pds$process_dir_name char (32) aligned external static;
dcl  pds$ fixed bin external static;
dcl  pds$processid bit (36) aligned external static;
dcl  pds$stack_0_ptr pointer external static;

dcl  error_table_$argerr fixed bin (35) external static;
dcl  error_table_$mylock fixed bin (35) external static;
dcl  error_table_$root fixed bin (35) external static;
dcl  error_table_$salv_pdir_procterm fixed bin (35) external static;

dcl  date_time_ entry (fixed bin (71), char (*));
dcl  get_pathname_			entry (fixed bin (17), char (*) varying, fixed bin (35));
dcl  level$get entry (fixed bin);
dcl  level$set entry (fixed bin);
dcl  lock$dir_unlock entry (pointer);
dcl  lock$unlock_fast entry (ptr);
dcl  lock$lock_fast entry (ptr);
dcl  salvager$online entry (ptr);
dcl  salv_directory$online_salvage entry (ptr, ptr, ptr, fixed bin (35));
dcl  salv_dump_copy entry (pointer, fixed bin, char (*));
dcl  salv_err_msg entry options (variable);
dcl  set_privileges$dir_priv_off entry (fixed bin (35));
dcl  set_privileges$dir_priv_on entry (fixed bin (35));
dcl  sum$getbranch_root_my entry (pointer, bit (36) aligned, pointer, fixed bin (35));
dcl  syserr entry options (variable);
dcl  syserr$error_code entry options (variable);
dcl  vtoc_attributes$get_info entry (bit (36) aligned, bit (36) aligned, fixed bin, ptr, fixed bin (35));

dcl  typelock bit (36) aligned options (constant) static init ("1"b);

dcl  WHOAMI char (32) internal static options (constant) init ("on_line_salvager");

dcl  cleanup condition;

dcl  (addr, clock, index, length, max, ptr, rel, reverse, segno, substr) builtin;



	a_code = 0;
	dp = a_dp;
	if rel (dp) ^= "0"b then do;
	     a_code = error_table_$argerr;
	     return;
	     end;

	root, unlock_parent = "0"b;

/* salv_data lock prevents two processes from online salvaging at the same time.  (Output would be mixed up.) */

	call level$get (save_level);
	set_sw = 1;

	salvlp = addr (salv_data$lock);
	on cleanup
	     begin;
		if salvlp -> lock.pid = pds$processid then call lock$unlock_fast (salvlp);
		call level$set (save_level);
		if set_sw = 0 then call set_privileges$dir_priv_off ((0));
		if unlock_parent then call lock$dir_unlock (ptr (ep, 0));
		end;

	call lock$lock_fast (salvlp);

/* Get ptr to branch and lock parent directory. */

	root = "0"b;
	call sum$getbranch_root_my (dp, typelock, ep, code);
	if code = 0 then unlock_parent = "1"b;
	else if code = error_table_$root then root = "1"b;
	else if code ^= error_table_$mylock then
	     call syserr$error_code (CRASH, code, "^a: error from sum on ^p", WHOAMI, dp);

/* Get pathname and print salvage message. */

	path_name, dir_name, ename = "";
	call get_pathname_ (segno (dp), path_name, code);
	if code ^= 0 then call syserr$error_code (CRASH, code, "^a: Getting pathname of ^p", WHOAMI, dp);

	i = index (reverse (path_name), ">");
	l = length (path_name);
	dir_name_len = max (l - i, 1);
	if dir_name_len = 1 then dir_name_len = 0;
	dir_name = substr (path_name, 1, dir_name_len);
	ename = substr (path_name, l + 2 - i, i - 1);

	call date_time_ (clock (), entry_time);

	args.pathname = path_name;
	call salvager$online (addr (args));
	call syserr (ANNOUNCE, "^a: Begin salvaging of directory ^a for ^a", WHOAMI, args.pathname,
	     pds$process_group_id);

/* Put out the first message */

	call salv_err_msg (SALV_JUST_LOG, "^a:Begin salvaging of directory ^a for ^a", entry_time, args.pathname,
	     pds$process_group_id);

	call get_dumps;
	old_modify = (dir.modify ^= "0"b);
	dir.modify = "0"b;

	call salv_directory$online_salvage (addr (args), ep, dp, a_code);

	if unlock_parent then call lock$dir_unlock (ptr (ep, 0));
	call salv_err_msg (SALV_ANNOUNCE, "on_line_salvager: salvaging completed.");

	call lock$unlock_fast (salvlp);

/* Terminate user's process if the process directory was salvaged. */

	if old_modify & (substr (args.pathname, 1, 16) = ">process_dir_dir" | substr (args.pathname, 1, 4) = ">pdd")
	then if ename = substr (pds$process_dir_name, 18, 15) then do;
		call salv_err_msg (SALV_LOG, "on_line_salvager: user process ^a terminated because of bad process directory",
		     pds$process_group_id);
		a_code = error_table_$salv_pdir_procterm;
						/* Cause verify lock to terminate the process */
		end;

	return;



/* * Copy the stack and the directory into segments in >dumps.  The validation level is temporarily set to zero for
   * these copies.  No dump is made for a bad root directory, since it would have to be used in order to find >dump.
   * No dump is made for level 1 directories, since the root is locked.
   * No dump is made for the directory dumps itself or for any directories in its subtree.
   *	stack		<date/time>stack
   *	directory		<date/time>name
*/

get_dumps:
     proc;

dcl  cname_prefix char (11);

/* The root and level 1 directories get a null dir_name from fs_get$path_name */

	if dir_name = "" | substr (args.pathname, 1, 6) = ">dumps" then return;

	call level$set (0);				/* to copy dir */
	call set_privileges$dir_priv_on (set_sw);	/* allow access to copy data into >dumps */

	cname_prefix =
	     substr (entry_time, 1, 2) || substr (entry_time, 4, 2) || substr (entry_time, 7, 2) || "."
	     || substr (entry_time, 11, 6) || ".";

	call vtoc_attributes$get_info ((entry.uid), (entry.pvid), (entry.vtocx), addr (sc_info), code);
	if code ^= 0 then
	     call syserr$error_code (LOG, code, "^a: cannot get activation info on ^p", WHOAMI, dp);
	else call salv_dump_copy (dp, sc_info.csl, cname_prefix || ename);

	call salv_dump_copy (pds$stack_0_ptr, 16384, cname_prefix || "stack");
	call salv_dump_copy (addr (pds$), 4096, cname_prefix || "pds");

	call level$set (save_level);
	if set_sw = 0 then call set_privileges$dir_priv_off ((0));

	return;
     end get_dumps;

/* format: style2 */
%page;
%include quota_cell;
%page;
%include salv_args;
%page;
%include salvager_severities;
%page;
%include dir_header;
%page;
%include dir_entry;
%page;
%include salv_data;
%page;
%include sc_info;
%page;
%include syserr_constants;
%page;
%include hc_lock;

/**/

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   on_line_salvager: lock error ERROMESSAGE

   S: $crash

   T: $run

   M: The on line salvager could not lock its data base.
   $err

   A: $inform
   $recover
   Be sure that a dump is taken.

   Message:
   on_line_salvager: error from sum on PPPPP ERRORMESSAGE

   S: $crash

   T: $run

   M: The on line salvager could not access the branch for a sdirectory
   to be salvaged.
   $err

   A: $inform
   $recover

   Message:
   on_line_salvager: cannot get activation info on PPPPP ERRORMESSAGE

   S: $info

   T: $run

   M: The on line salvager could not determine the length of a directory to be
   salvaged. A truncated copy will be made in >dumps.

   A: $inform

   Message:
   on_line_salvager: Getting pathname of PPPPP

   S: $crash

   T: $run

   M: The on line  salvager cannot obtain the pathname of a directory to be
   salvaged.
   $err

   A: Take a dump.
   $inform
   $recover

   END MESSAGE DOCUMENTATION */
     end on_line_salvager;




		    salv_check_vtoce_.pl1           11/11/89  1059.4rew 11/11/89  0805.2       79092



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/* * The entry chain is searched and the VTOC entries for segments and directories are verified or updated.
   *
   * 1.  Update VTOC entry using branch information.
   * 	- UID path	Message.
   * 	- primary name	No message.
   * 	- branch_rp	No message.
   * 	- access class	Message and the branch is set security out-of-service.
   *
   * 2.  Master directory	If the master directory switch in the VTOC doesn't match the one in the branch,
   * 			both switches are corrected using the quota field.
*/

/****^  HISTORY COMMENTS:
  1) change(77-07-01,Barr), approve(), audit(), install():
      Pre-hcom comments.
      Written by S.E. Barr 7/77
      Fixed by BSG 7/11/78 to loop properly if connection failures hit.
      Modified June 1981 by J. Bongiovanni to treat invalid VTOCE index as
       as connection failure
      Modified March 1982 by J. Bongiovanni to fix empty directory bug
      Modified 831111 BIM to protection_audit_ SOOS settings.
      Modified 84-12-05 by EJ Sharpe to use access_audit_ instead of protection_audit_
  2) change(86-06-26,Lippard), approve(86-06-17,MCR7433),
     audit(86-06-26,Hartogs), install(86-07-11,MR12.0-1091):
      Change calling sequence of error message routine.
                                                   END HISTORY COMMENTS */


salv_check_vtoce_: proc (arg_dp, path, delete_connection_failures, print);

/* PARAMETERS */

dcl  arg_dp ptr;					/* ptr to base of directory being checked. */
dcl  path char (*);
dcl  delete_connection_failures bit (1) aligned;
dcl  print entry options (variable);

/* AUTOMATIC */

dcl  acc_class_str char (32) aligned;
dcl  code fixed bin (35);
dcl  connection_failures_occured bit (1) init ("0"b);
dcl 1 event_flags aligned like audit_event_flags;
dcl  next_ptr ptr;					/* for threading */
dcl  i fixed bin;
dcl  level fixed bin;
dcl  lv_p ptr;					/* ptr to logical volume table entry. */
dcl  uid (0:15) bit (36) aligned;
dcl  pvtx fixed bin;
dcl 1 update aligned like salv_update_info;
dcl  name char (32);				/* primary name of entry. */
dcl 1 vtoce_copy aligned like vtoce;
dcl (null, addr, ptr, rel, string) builtin;

/* EXTERNAL */

dcl  get_pvtx entry (bit (36) aligned, fixed bin (35)) returns (fixed bin);
dcl  vtoc_attributes$salv_update entry (bit (36) aligned, bit (36) aligned, fixed bin, ptr, fixed bin (35));
dcl  vtoc_man$get_vtoce entry (bit (36) aligned, fixed bin, fixed bin, bit (3), ptr, fixed bin (35));
dcl  logical_volume_manager$lvtep entry (bit (36) aligned, ptr, fixed bin (35));
dcl  uid_path_util$get entry (ptr, (0:15) bit (36) aligned, fixed bin (35));
dcl  delentry$salv_delete_branch entry (ptr, fixed bin (35));
dcl  access_audit_$log_obj_class entry options (variable);  /* cannot use log_entry_ptr because we don't
	     					want access_audit_ poking around in the directories */
dcl  display_access_class_ entry (bit(72) aligned) returns(char(32) aligned);
dcl  level$get entry () returns (fixed bin);

dcl  access_operations_$fs_obj_set_soos bit (36) aligned ext;
dcl  error_table_$invalid_vtocx fixed bin (35) external;
dcl  error_table_$ai_entry_vtoce_mismatch fixed bin (35) external;

/* CONSTANTS */

dcl  ME char (17) int static options (constant) init ("salv_check_vtoce_");

%page;
	dp = arg_dp;

/* Get the UID path for this directory and add its UID to get the UID path for the branches. */

	level = dir.tree_depth;
	call uid_path_util$get (dp, uid, code);
	if code ^= 0 then do;
	     call print (0, ME, code, "salv_check_vtoce_: getting UID path for ^a", path);
	     return;
	end;
	uid (level) = dir.uid;

/* If the physical volume that holds the segments for this directory is not mounted, then print an error message
   and do not check any segments. */
	call logical_volume_manager$lvtep (dir.sons_lvid, lv_p, code);
	if lv_p = null & (dir.seg_count > 0)
	then call print (4, ME, 0,
	     "Unable to check VTOC entries for segments because the volume is not mounted.  LVID = ^w", dir.sons_lvid);
	vtocep = addr (vtoce_copy);

	next_ptr = null;
	do ep = ptr (dp, dir.entryfrp) repeat next_ptr while (rel (ep));
	     next_ptr = ptr (dp, entry.efrp);

	     if entry.bs & (entry.dirsw | lv_p ^= null) then do;
		name = addr (entry.primary_name) -> names.name;
		string (update.flags) = "0"b;

		pvtx = get_pvtx ((entry.pvid), code);
		if code ^= 0 then call print (4, ME, code, name);
		else do;
		     call vtoc_man$get_vtoce ((entry.pvid), pvtx, (entry.vtocx), "101"b, vtocep, code);

		     if code ^= 0 & code ^= error_table_$invalid_vtocx
			then call print (4, ME, code, name);
		     else do;
			if vtoce.uid ^= entry.uid | code = error_table_$invalid_vtocx
			     then do;		/* Connection failure */
			     connection_failures_occured = "1"b; /* for later message */
			     if delete_connection_failures then do;
				call print (4, ME, 0, "Deleting ^a due to connection failure.", name);
				call delentry$salv_delete_branch (ep, code);
				if code ^= 0 then call print (4, ME, code, "Error deleting branch for ^a.", name);
			     end;
			     else call print (4, ME, 0, "Connection failure for ^a.", name);
			end;
			else do;

/* UID path */
			     do i = 0 to 15;
				if vtoce.uid_path (i) ^= uid (i) then do;
				     call print (4, ME, 0, "UID path at level ^d changed from ^w to ^w for ^a",
					i, vtoce.uid_path (i), uid (i), name);
				     update.set_uid_path = "1"b;
				end;
			     end;
			     if update.set_uid_path then update.uid_path (*) = uid (*);

/* primary name */
			     if vtoce.primary_name ^= name then do;
				update.primary_name = name;
				update.set_primary_name = "1"b;
			     end;

/* Master directory has non-zero quota. */
			     if vtoce.master_dir ^= entry.master_dir then do;
				entry.master_dir = (vtoce.quota (0) > 0);
				if vtoce.master_dir ^= entry.master_dir then do;
				     update.set_master_dir = "1"b;
				     update.master_dir = entry.master_dir;
				end;
				call print (4, ME, 0, "Set master directory switch ^[on^;off^] for ^a",
				     entry.master_dir, name);
			     end;

/* If the access class fields do not match, the branch is set security out-of-service. */
			     if vtoce.access_class ^= entry.access_class then do;
				string(event_flags) = ""b;
				event_flags.special_op = "1"b;
				event_flags.grant = "1"b;
				/* can't tell if this is a normal user who encountered a
				bad directory or a system salvager, we'll leave the priv_op
				flag off */
				acc_class_str = display_access_class_ (vtoce.access_class);
				call access_audit_$log_obj_class ("salv_check_vtoce_", level$get(),
				     string(event_flags), access_operations_$fs_obj_set_soos,
				     ep->entry.access_class, path, error_table_$ai_entry_vtoce_mismatch,
				     null(), 0, "vtoce class is ^a", acc_class_str);
				call print (4, ME, 0,
				     "^a set security out-of-service: vtoce access = ^w and entry access class = ^w",
				     name, vtoce.access_class, entry.access_class);
				entry.security_oosw = "1"b;
			     end;

/* Update VTOC entry, if necessary. */
			     if string (update.flags) then do;
				call vtoc_attributes$salv_update ((entry.uid), (entry.pvid), (entry.vtocx),
				     addr (update), code);
				if code ^= 0 then call print (4, ME, code, name);
			     end;
			end;
		     end;
		end;
	     end;
	end;


	if connection_failures_occured & ^delete_connection_failures
	     then call print (0, ME, 0, "Connection failures detected in ^a.", path);

	return;

/*  */
%include access_audit_eventflags;
%include dir_header;
%include dir_entry;
%include dir_name;
%include vtoce_salv_update;
%include vtoce;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   AUDIT (salv_check_vtoce_): GRANTED modification of security out-of-service ADDED_INFO

   S:	$access_audit

   T:	$run

   M:	Security out-of-service switch was set because vtoce access class did
not match the entry access class for the specified
file system entry.

   A:	$inform_ssa


   Message:
   salv_check_vtoce_: ERROR_MESSAGE.

   S:     $log

   T:     Salvaging

   M:     An error occurred while checking VTOCEs.

   A:     $inform

   END MESSAGE DOCUMENTATION */

 
     end salv_check_vtoce_;




		    salv_dir_checker_.pl1           11/11/89  1059.4r   11/11/89  0808.0      544500



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */




/****^  HISTORY COMMENTS:
  1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387),
     audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056):
     Correct error message documentation.
  2) change(86-05-22,Lippard), approve(86-06-17,MCR7433),
     audit(86-06-26,Hartogs), install(86-07-11,MR12.0-1091):
     Make ascii_check detect case when name is all blanks, which will
     not hash properly.
                                                   END HISTORY COMMENTS */


/* format: style4,delnl,insnl,tree,ifthenstmt,indnoniterend */
salv_dir_checker_:
     proc (arg_source_ptr, arg_salv_ptr, error, arg_set_security_oosw, arg_new_dir_pages);

/* * This procedure checks the directory for syntatic errors, variation from the information supplied in the branch,
   * and makes plausibility checks on the contents of the information blocks.  If any errors
   * are found while checking the directory, it is rebuilt. The default action can be modified by these flags:
   *
   *	compact			Force a rebuild if at least one page can be saved.
   *	force_rebuild		Force a rebuild of the directory.
   *
   * The following are returned:
   *	new_dir_pages = 0		The directory was not rebuilt.
   *	new_dir_pages > 0		Number of pages in rebuilt directory.
   *
   *	set_security_oosw = "0"b	No AIM errors were detected.
   *	set_security_oosw = "1"b	An AIM error was detected.
   *
   *  AIM checking is only done if a branch was specified.  Protection auditing is done for AIM errors and
   *  change in ACL counts for entries.
   *	- The access class in the branch for the directory is not the same as the access class in the directory header.
   *	- Some branch in the directory has an invalid access class.
   *
   *  All corrections are made after the error message is printed.  The following conventions are used:
   *	SYSTEM	 0	Unexpected errors that indicate software/hardware bugs.
   *	LOSS	 2	Loss of information.
   *	CORRECTION 4	Correctable errors and changes in directory size.
   *	DUMP	 5	Debugging information.  (salvage_directory will dump the directory in the off line case
   *			for these messages.)
   *
   * Constructs used for performance reasons:
   *	- ONES is used as a constant since the copy builtin causes allocates and frees
   *	- The chain threading code is duplicated to prevent the cost of recursion.
*/
/* Written 3/77 by S.E. Barr */
/* Modified 6/77 to remove unreferenced access names after rebuilding directory. */
/* Modified December 1981 by C. Hornig for 205K directories */
/* Modified BIM 2/82 for zero length block protection, directed fault */
/* Modified March 1982 by J. Bongiovanni to eliminate use of FSDCT */
/* Modified 84-12-05 by EJ Sharpe to change protection_audit_ calls to access_audit_ */

/* parameters */

dcl  arg_new_dir_pages fixed bin;			/* Number of pages in rebuilt directory */
dcl  arg_salv_ptr ptr;				/* ptr to information about directory */
dcl  arg_set_security_oosw bit (1) aligned;		/* ON if the branch should be set security out-of-service */
dcl  arg_source_ptr ptr;				/* pointer to directory */
dcl  error entry options (variable);			/* error routine to print messages */

/* automatic */

dcl  audit bit (1) aligned;				/* ON, if have branch, so that audit will make sense */
dcl  branch_ptr ptr;				/* ptr to the branch for this directory */
dcl  check_access_names bit (1) aligned;		/* ON, it should free unused access names from list */
dcl  correct_oosw bit (1) aligned;			/* ON if should put directories back in service. */
dcl  count fixed bin;				/* number of valid blocks on list */
dcl  dir_access_class bit (72) aligned;			/* access class of directory for AIM */
dcl  dir_acl_cnt fixed bin;				/* total number of ACLs for directory */
dcl  dir_name_cnt fixed bin;				/* Value of htused (number of names in directory) */
dcl  dir_size fixed bin;				/* offset of last word in directory */
dcl  dir_uid bit (36) aligned;			/* UID of directory */
dcl  1 event_flags aligned like audit_event_flags;	/* particulars of the operation */
dcl  time bit (36) aligned;				/* Highest value allowed for dates */
dcl  output_area_ptr ptr;				/* ptr to area header in rebuilt directory */
dcl  prodigal_search bit (1) aligned;			/* ON if looking for blocks that can't be reached by chains */
dcl  rebuilding bit (1) aligned;			/* ON if rebuilding directory */
dcl  ring fixed bin;				/* ring number for initial ACLs */
dcl  salv_ptr ptr;					/* ptr to information about the directory */
dcl  scratch_ptr ptr;				/* ptr to scratch segment */
dcl  security_oos bit (1) aligned;			/* ON if directory should be set security out of service */
dcl  source_ptr ptr;				/* ptr to directory being verified */
dcl  stop_at_error bit (1) aligned;			/* ON if rebuild should occur at first uncorrectable error */
dcl  target_ptr ptr;				/* ptr to the new version of the directory */
dcl  trace bit (1) aligned;				/* ON if debugging information should be printed. */

/* based */

dcl  1 block_template aligned based,			/* First two words of all information blocks */
       2 frp bit (18) unaligned,
       2 brp bit (18) unaligned,
       2 type bit (18) unaligned,
       2 size fixed bin (17) unaligned;
dcl  directory_space char (dir_size + 1) aligned based (scratch_ptr);
dcl  1 info aligned like salv_args based (salv_ptr);
dcl  1 input_dir aligned like dir based (source_ptr);	/* original directory */
dcl  1 output_dir aligned like dir based (target_ptr);	/* rebuilt version of the directory */

/* internal static */

dcl  ONES char (1024) aligned int static;
dcl  block_sizes (9) fixed bin int static;
dcl  header_area_size fixed bin int static;		/* number of words in header + area header */
dcl  root_lvid bit (36) int static;
dcl  static_init bit (1) aligned int static init ("0"b);

/* external */

dcl  acc_name_$encode entry (ptr, ptr, fixed bin (35));
dcl  access_audit_$log_obj_class entry options (variable);	/* don't use log_entry_ptr entry for
						   fear of looping on bad dirs */
dcl  access_operations_$fs_obj_set_soos bit (36) aligned external;
dcl  access_operations_$fs_obj_access_mod bit (36) aligned external;
dcl  active_hardcore_data$alloc_sizes (8) ext fixed bin;
dcl  active_hardcore_data$dir_hdrsize ext fixed bin;
dcl  active_hardcore_data$hash_table_sizes (1) ext fixed bin;
dcl  active_hardcore_data$elcsize ext fixed bin;
dcl  active_hardcore_data$aclsize ext fixed bin;
dcl  active_hardcore_data$dir_arearp fixed bin (18) aligned ext;
dcl  active_hardcore_data$ensize ext fixed bin;
dcl  active_hardcore_data$esize ext static fixed bin;
dcl  active_hardcore_data$nalloc_sizes ext fixed bin;
dcl  active_hardcore_data$num_hash_table_sizes fixed bin ext;
dcl  aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
dcl  aim_check_$greater_or_equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
dcl  allocate_dir_ht_ entry (ptr, fixed bin, fixed bin (35));
dcl  display_access_class_ entry (bit (72) aligned, char (32) aligned);
dcl  fs_alloc$alloc entry (ptr, fixed bin, ptr, fixed bin (35));
dcl  fs_alloc$init entry (ptr, fixed bin, ptr, fixed bin);
dcl  fs_alloc$free entry (ptr, fixed bin, ptr);
dcl  level$get entry () returns (fixed bin);
dcl  pvt$root_lvid bit (36) ext;
dcl  hash$in entry (ptr, ptr, fixed bin (35));
dcl  hash$search entry (ptr, ptr, ptr, fixed bin (35));
dcl  syserr entry options (variable);
dcl  sys_info$access_class_ceiling ext static bit (72) aligned;
dcl  sys_info$default_dir_max_length ext static fixed bin (19);
dcl  salv_data$debugging_fault_dir_checker bit (1) aligned ext static;


dcl  (addr, rel, null, bit, copy, divide, fixed, index, ptr, string, substr, unspec, length, mod, rtrim) builtin;

/* constants */

dcl  BLOCK_NAME (9) char (20) int static options (constant)
	init ("access name", "ACL", "directory header", "directory", "link", "name", "segment", "entry", "hash table");
dcl  CORRECTION fixed bin int static options (constant) init (4);
dcl  DUMP fixed bin int static options (constant) init (5);
dcl  entry_type fixed bin int static options (constant) init (8);
dcl  INVALID_RP bit (18) unal int static options (constant) init ("000001"b3);
dcl  LOSS fixed bin int static options (constant) init (2);
dcl  ME char (17) int static options (constant) init ("salv_dir_checker_");
dcl  SYSTEM fixed bin int static options (constant) init (0);
%page;

	if salv_data$debugging_fault_dir_checker
	then begin;
declare  sfp pointer;
declare  1 sfp_val aligned like its_unsigned;
declare  falter bit (36) aligned based (sfp);

	     sfp_val.pad1 = ""b;
	     sfp_val.segno = 0;
	     sfp_val.ringno = 0;
	     sfp_val.pad2 = ""b;
	     sfp_val.its_mod = "47"b3;		/* Directed Fault 3 */
	     unspec (sfp) = unspec (sfp_val);
	     call syserr (SL_LOG_CRASH, "salv_dir_checker_: Faulting on purpose.");
	     sfp -> falter = "123456"b3;
	end;

	arg_new_dir_pages = 0;
	call setup;
	if valid_header () then do;
	     if ^rebuilding
	     then if info.compact then call check_free_list;
RESTART:
	     call mark_space_used (source_ptr, header_area_size);
	     stop_at_error = ^rebuilding;
	     dir_acl_cnt = 0;
	     if rebuilding then call setup_dir_header;

/* Check access names and check entries */

	     call process_list (input_dir.proj_frp, input_dir.proj_brp, (null), access_name_type, null,
		output_dir.proj_frp, output_dir.proj_brp, count);

	     call process_list (input_dir.pers_frp, input_dir.pers_brp, (null), access_name_type, null,
		output_dir.pers_frp, output_dir.pers_brp, count);

	     call entry_chain;

/* Check initial ACLs for segments and directories for each ring.  (There is no ring 0 initial ACL) */

	     do ring = 1 to 7;
		call process_list (input_dir.seg_frp (ring), input_dir.seg_brp (ring), (null), acle_type, null,
		     output_dir.seg_frp (ring), output_dir.seg_brp (ring), count);
		if count ^= input_dir.iacl_count (ring).seg then do;
		     call error (LOSS, ME, "Segment initial ACL count for ring ^d changed from ^d to ^d", ring,
			input_dir.iacl_count (ring).seg, count);
		     input_dir.iacl_count (ring).seg = count;
		     end;
		if rebuilding then output_dir.iacl_count (ring).seg = count;
		dir_acl_cnt = dir_acl_cnt + count;

		call process_list (input_dir.dir_frp (ring), input_dir.dir_brp (ring), (null), acle_type, null,
		     output_dir.dir_frp (ring), output_dir.dir_brp (ring), count);
		if count ^= input_dir.iacl_count (ring).dir then do;
		     call error (LOSS, ME, "Directory initial ACL count for ring ^d changed from ^d to ^d", ring,
			input_dir.iacl_count (ring).dir, count);
		     input_dir.iacl_count (ring).dir = count;
		     end;
		if rebuilding then output_dir.iacl_count (ring).dir = count;
		dir_acl_cnt = dir_acl_cnt + count;
	     end;
	     if dir_acl_cnt ^= input_dir.acle_total then do;
		call error (LOSS, ME, "ACL count changed from ^d to ^d", input_dir.acle_total, dir_acl_cnt);
		input_dir.acle_total = dir_acl_cnt;
		check_access_names = "1"b;
		end;
	     if rebuilding then do;
		output_dir.acle_total = dir_acl_cnt;	/* Replace kludge by correct value */
		if check_access_names then do;
		     call delete_unused_access_names (output_dir.pers_frp, output_dir.pers_brp);
		     call delete_unused_access_names (output_dir.proj_frp, output_dir.proj_brp);
		     end;
		end;
	     end;

	arg_set_security_oosw = security_oos;
	if rebuilding then call copy_directory;
	return;

START_REBUILD:
	rebuilding = "1"b;
	directory_space = "";
	call mark_space_used (ptr (source_ptr, input_dir.hash_table_rp),
	     (ptr (source_ptr, input_dir.hash_table_rp) -> hash_table.size));
	goto RESTART;
%page;
/* This procedure checks and/or rebuilds the entry chain.  After each entry is verified, its names are checked and
   in the case of segments and directories, the ACL chain is verified.
   At the end of the entry chain, the name count should match the total expected.  If it doesn't, the prodigal search
   is done.  This search checks the space not yet marked used, for valid entry or name blocks.
*/
entry_chain:
     proc;

dcl  back_rp bit (18);				/* back ptr expected */
dcl  dir_cnt fixed bin;				/* number of directoies found */
dcl  entry_rp bit (18);				/* relative pointer to entry block */
dcl  ep ptr;					/* ptr to entry block */
dcl  forward bit (1) aligned;				/* ON for forward loop; OFF for tracing back chain */
dcl  last_good_entry bit (18) unal;
dcl  link_cnt fixed bin;				/* number of links found */
dcl  name_cnt fixed bin;				/* total entry names in the directory */
dcl  seg_cnt fixed bin;				/* number of segments found */

	name_cnt, link_cnt, seg_cnt, dir_cnt = 0;
	forward = "1"b;
	back_rp = "0"b;

/* If the forward thread is zero, but the backward thread is non-zero, then force the forward chain to fail
   to salvage entries using the backward thread.
*/
	entry_rp = input_dir.entryfrp;
	if entry_rp = "0"b
	then if input_dir.entrybrp ^= "0"b then entry_rp = INVALID_RP;

	do while (entry_rp ^= "0"b);
	     ep = ptr (source_ptr, entry_rp);

/* If the block is not valid, then the back chain is used to recover the rest of the entries. */
/* The back chain is not started, if the back pointer specifies the same bad block.
*/
	     if ^valid_block (ep, entry_type, dir_uid, back_rp) then do;
		if trace then call trace_message ("Invalid block found on entry chain", ep);
		if stop_at_error then goto START_REBUILD;
		if ^forward
		then entry_rp = "0"b;
		else do;
		     forward = "0"b;
		     back_rp = INVALID_RP;		/* can't check back ptr while following the chain backward */
		     last_good_entry = entry_rp;
		     if entry_rp = input_dir.entrybrp
		     then entry_rp = "0"b;
		     else entry_rp = input_dir.entrybrp;
		     end;
		end;
	     else do;
		call mark_space_used (ep, 2);		/* Mark threads & size/type used */
		call process_entry (ep);

		if forward then do;
		     back_rp = entry_rp;
		     entry_rp = ep -> entry.efrp;
		     end;
		else do;
		     entry_rp = ep -> entry.ebrp;
		     if entry_rp = last_good_entry then entry_rp = "0"b;
		     end;
		end;
	end;

	if dir_name_cnt ^= name_cnt then do;
	     if stop_at_error then goto START_REBUILD;
	     call prodigal;
	     end;

/* Check and correct totals. */

	if seg_cnt ^= input_dir.seg_count then do;
	     call error (LOSS, ME, "Segment count changed from ^d to ^d", input_dir.seg_count, seg_cnt);
	     input_dir.seg_count = seg_cnt;
	     end;
	if dir_cnt ^= input_dir.dir_count then do;
	     call error (LOSS, ME, "Directory count changed from ^d to ^d", input_dir.dir_count, dir_cnt);
	     input_dir.dir_count = dir_cnt;
	     end;
	if link_cnt ^= input_dir.lcount then do;
	     call error (LOSS, ME, "Link count changed from ^d to ^d", input_dir.lcount, link_cnt);
	     input_dir.lcount = link_cnt;
	     end;

	if name_cnt ^= dir_name_cnt then do;
	     call error (LOSS, ME, "Name count changed from ^d to ^d", dir_name_cnt, name_cnt);
	     end;

	return;
%page;
/* This code checks and rebuilds one entry -- its contents, ACLs and names */
process_entry:
	proc (arg_ep);

dcl  arg_ep ptr;

dcl  ep ptr;
dcl  code fixed bin;
dcl  type_expected fixed bin;
dcl  (auth_valid, bc_auth_valid) bit (1);
dcl  count fixed bin;				/*  count of ACLs or names found on chain */
dcl  new_ep ptr;					/* ptr to entry in rebuilt directory */
	     ep = arg_ep;
	     new_ep = null;
	     type_expected = fixed (ep -> entry.type, 18);
	     call entry_contents;
	     if code ^= 0 then do;
		if trace then call trace_message ("Invalid entry contents", ep);
		return;
		end;

	     call mark_space_used (ep, (ep -> entry.size));

/* If the directory is being rebuilt, the entry is copied into the new directory, and then the name
   and ACL information is cleared.
*/
	     if rebuilding then do;
		call move (ep, output_dir.entryfrp, output_dir.entrybrp, (null), new_ep);
		new_ep -> entry.name_frp, new_ep -> entry.name_brp = "0"b;
		if ep -> entry.bs then new_ep -> entry.acl_frp, new_ep -> entry.acl_brp = "0"b;
		if type_expected = seg_type
		then output_dir.seg_count = output_dir.seg_count + 1;
		else if type_expected = link_type
		     then output_dir.lcount = output_dir.lcount + 1;
		     else if type_expected = dir_type then output_dir.dir_count = output_dir.dir_count + 1;
		end;
	     if type_expected = seg_type
	     then seg_cnt = seg_cnt + 1;
	     else if type_expected = dir_type
		then dir_cnt = dir_cnt + 1;
		else link_cnt = link_cnt + 1;

/* Check name list */
	     if ep -> entry.name_frp ^= rel (addr (ep -> entry.primary_name)) then do;
		if stop_at_error then goto START_REBUILD;
		call error (CORRECTION, ME, "Corrected primary name pointer for ^a", entry_name (ep));
		ep -> entry.name_frp = rel (addr (ep -> entry.primary_name));
		end;
	     call process_list (ep -> entry.name_frp, ep -> entry.name_brp, new_ep, name_type, ep,
		new_ep -> entry.name_frp, new_ep -> entry.name_brp, count);

/* If no names were good, add a unique name. */
	     if count = 0 then do;
		if stop_at_error then goto START_REBUILD;
		call get_unique_name (new_ep);
		count = 1;
		end;

/* Check number of names found against number expected. */

	     if ep -> entry.nnames ^= count then do;
		if stop_at_error then goto START_REBUILD;
		call error (LOSS, ME, "Corrected count of names from ^d to ^d for ^a", ep -> entry.nnames, count,
		     entry_name (new_ep));
		ep -> entry.nnames = count;
		end;
	     if rebuilding then new_ep -> entry.nnames = count;
	     name_cnt = name_cnt + count;

/* Check author */

	     call check_acl_ref (addr (ep -> entry.author), code);
	     auth_valid = (code = 0);
	     if ^auth_valid then do;
		code = 0;
		if stop_at_error then goto START_REBUILD;
		call error (LOSS, ME, "Invalid author found for ^a", entry_name (ep));
		end;

/* Check ACL list and set bc_author for directories and segments */

	     if ep -> entry.bs then do;
		call process_list (ep -> entry.acl_frp, ep -> entry.acl_brp, (null), acle_type, ep,
		     new_ep -> entry.acl_frp, new_ep -> entry.acl_brp, count);
		if ep -> entry.acle_count ^= count then do;
		     if stop_at_error then goto START_REBUILD;
		     call error (LOSS, ME, "Corrected count of ACLs from ^d to ^d for ^a", ep -> entry.acle_count, count,
			addr (ep -> entry.primary_name) -> names.name);
		     if audit
		     then call access_audit_$log_obj_class ("salv_dir_checker_", level$get (), unspec (event_flags),
			     access_operations_$fs_obj_access_mod, ep -> entry.access_class,
			     target (info.pathname, entry_name (ep)), 0, null (), 0,
			     "ACL count changed from ^d to ^d", ep -> entry.acle_count, count);
		     ep -> entry.acle_count = count;
		     end;
		dir_acl_cnt = dir_acl_cnt + count;

		call check_acl_ref (addr (ep -> entry.bc_author), code);
		bc_auth_valid = (code = 0);
		if ^bc_auth_valid then do;
		     code = 0;
		     if stop_at_error then goto START_REBUILD;
		     call error (LOSS, ME, "Invalid bit count author found for ^a", entry_name (ep));
		     end;
		if rebuilding then do;
		     new_ep -> entry.acle_count = count;
		     if bc_auth_valid
		     then call set_acl_ref (addr (ep -> entry.bc_author), addr (new_ep -> entry.bc_author));
		     else call set_acl_ref$damaged (null (), addr (new_ep -> entry.bc_author));
		     end;
		end;

	     if rebuilding
	     then if auth_valid
		then call set_acl_ref (addr (ep -> entry.author), addr (new_ep -> entry.author));
		else call set_acl_ref$damaged (null (), addr (new_ep -> entry.author));
%page;
entry_contents:
	     proc;

		code = 0;

		if ep -> entry.uid = "0"b then do;
		     if stop_at_error then goto START_REBUILD;
		     code = 1;
		     if prodigal_search then return;
		     call error (LOSS, ME, "Deleted ^a ^a with zero UID", BLOCK_NAME (type_expected), entry_name (ep));
		     return;
		     end;

/* Link */
		if type_expected = link_type then do;
		     call ascii_check (addr (ep -> link.pathname), (ep -> link.pathname_size), code);
		     if code ^= 0 then do;
			if stop_at_error then goto START_REBUILD;
			if ^prodigal_search then do;
			     if code = 1
			     then call error (LOSS, ME, "Deleted link ^a with non-ASCII pathname ^a", entry_name (ep),
				     ep -> link.pathname);
			     else call error (LOSS, ME, "Deleted link with blank pathname");
			     end;
			return;
			end;
		     if ep -> entry.bs then do;
			call error (CORRECTION, ME, "Corrected link branch switch for ^a", entry_name (ep));
			ep -> link.bs = "0"b;
			end;
		     call check_dates;
		     return;
		     end;

/* Segments and directories */
/* Print message for out-of-service switch.  Don't reset for online case. */

		if ep -> entry.dirsw & ep -> entry.oosw then do;
		     if correct_oosw then do;
			call error (CORRECTION, ME, "Directory ^a was put back in service", entry_name (ep));
			ep -> entry.oosw = "0"b;
			end;
		     else call error (LOSS, ME, "Directory ^a was found out-of-service", entry_name (ep));
		     end;

		if ^ep -> entry.bs then do;
		     call error (CORRECTION, ME, "Corrected ^a branch switch for ^a", BLOCK_NAME (type_expected),
			entry_name (ep));
		     ep -> entry.bs = "1"b;
		     end;
		if (ep -> entry.dirsw ^= (ep -> entry.type = DIR_TYPE)) then do;
		     call error (CORRECTION, ME, "Corrected directory switch for ^a", entry_name (ep));
		     ep -> entry.dirsw = (type_expected = dir_type);
		     end;
		call check_dates;
		if ^audit then return;		/* Can only check access, if have branch */

/* Multiple class segments are allowed for ring 0 and ring 1 segments only. */

		if ^ep -> entry.dirsw
		then if ep -> entry.multiple_class
		     then if fixed (ep -> entry.ring_brackets (3)) > 1 then do;
			     call error (LOSS, ME,
				"Access error for ^a - invalid ring brackets (^d) for multiple class segment",
				entry_name (ep), ep -> entry.ring_brackets (3));
			     security_oos = "0"b;
			     return;
			     end;

/*  Make sure access class is less than or equal maximum value. */

		if (ep -> entry.access_class & (^sys_info$access_class_ceiling)) = "0"b then do;

/* Multiple class segments and branches must be >= parent.
   Non-multiple class segments and branches must be = parent.
*/
		     if ep -> entry.multiple_class then do;
			if aim_check_$greater_or_equal (ep -> entry.access_class, dir_access_class) then return;
			end;
		     else if aim_check_$equal (ep -> entry.access_class, dir_access_class) then return;
		     end;

		call error (LOSS, ME, "Access class error for ^a, parent ^a, branch ^a", entry_name (ep),
		     cv_access (dir_access_class), cv_access (ep -> entry.access_class));
		call access_audit_$log_obj_class ("salv_dir_checker_", level$get (), unspec (event_flags),
		     access_operations_$fs_obj_set_soos, ep -> entry.access_class,
		     target (info.pathname, entry_name (ep)), 0, null (), 0, "Parent class: ^a",
		     cv_access (dir_access_class));
		ep -> entry.access_class = ep -> entry.access_class & sys_info$access_class_ceiling;
		security_oos = "1"b;

	     end entry_contents;
%page;
check_dates:
	     proc;

/* BUG fix: Fix, but do not print message for zero dtem. */
		if ep -> entry.dtem > time | ep -> entry.dtem = "0"b then do;
		     if ep -> entry.dtem ^= "0"b then do;
			call error (CORRECTION, ME, "Corrected dtem for ^a ^a",
			     BLOCK_NAME (fixed (ep -> entry.type, 18)), entry_name (ep));
			end;
		     ep -> entry.dtem = time;
		     end;

		if ep -> entry.type ^= LINK_TYPE then do;
		     if ep -> entry.dtd > time then do;
			call error (CORRECTION, ME, "Corrected dtd for ^a ^a",
			     BLOCK_NAME (fixed (ep -> entry.type, 18)), entry_name (ep));
			ep -> entry.dtd = "0"b;	/* So it will be dumped */
			end;
		     end;

	     end check_dates;

	end process_entry;
%page;
/* This procedure searches the directory for blocks that are not on the entry chain.
   The salvager has already marked the space that is occupied by valid entry, name and ACL blocks.  Only
   initial ACL's have not been marked.  The procedure loops through the directory area free chain and
   marks the blocks that have been released.  If there is any space left that is not marked used, the salvager
   tries to recover the missing blocks within that space.
*/
prodigal:
	proc;

dcl  (i, num_words) fixed bin;
dcl  code fixed bin;
dcl  bp ptr;
dcl  1 block aligned like block_template based (bp);

	     prodigal_search = "1"b;
	     if trace then call trace_message ("prodigal search", null);
	     trace = "0"b;

/* Loop through the unused space looking for name or entry blocks. */
	     i = 0;
	     do while (i < dir_size);
		num_words = index (substr (directory_space, i + 1, dir_size - i + 1), " ") - 1;
		if num_words = -1 then return;
		if num_words = 0
		then i = i + 2;
		else i = i + num_words + mod (num_words, 2);
		if i > dir_size - 3 then go to prodend;
		bp = ptr (source_ptr, i);
		if block.type = SEG_TYPE | block.type = DIR_TYPE | block.type = LINK_TYPE then do;
		     if valid_block (bp, (entry_type), dir_uid, (INVALID_RP)) then do;
			call process_entry (bp);
			end;

		     end;
		else if block.type = NAME_TYPE then call restore_name;
	     end;

prodend:
	     prodigal_search = "0"b;
	     trace = info.print_trace;
	     return;
%page;
/*  This procedure recovers a name block.  The name block must reference an entry that has already been verified. */
restore_name:
	     proc;

dcl  a_code fixed bin (35);
dcl  ep ptr;					/* ptr to entry block for name */
dcl  new_ep ptr;
dcl  np ptr;					/* ptr to name block */
dcl  p ptr;

/* Find entry block for the name.  If it has not yet been verified, check it. */

		np = bp;
		ep = ptr (source_ptr, np -> names.entry_rp);
		if valid_block (ep, entry_type, dir_uid, INVALID_RP) then do;
		     call process_entry (ep);
		     end;

		if fixed (rel (ep), 18) + block_sizes (entry_type) - 1 <= dir_size then do;
		     if substr (directory_space, fixed (rel (ep), 18) + 1, 1) = "E" then do;

/* Check structure and contents of name block. */
			if valid_block (np, name_type, ep -> entry.uid, (INVALID_RP)) then do;
			     call check_contents (np, name_type, ep, code);
			     if code = 0 then do;
				call mark_space_used (np, block_sizes (name_type));

/* Find entry block in rebuilt directory in order to connect the name to it. */
				p = addr (addr (ep -> entry.primary_name) -> names.name);
				call hash$search (target_ptr, p, new_ep, a_code);
				if a_code = 0
				then call move (np, new_ep -> entry.name_frp, new_ep -> entry.name_brp, new_ep,
					(null));
				end;
			     end;
			end;
		     end;
		return;

	     end restore_name;

	end prodigal;

     end entry_chain;
%page;
/* One directory chain is checked and or rebuilt. */
process_list:
     proc (head, tail, a_new_owner_bp, a_type_expected, a_entry_p, a_new_head, a_new_tail, a_count);

/* parameters */

dcl  head bit (18) unal;				/* head of list */
dcl  tail bit (18) unal;				/* end of list */
dcl  a_entry_p ptr;					/* ptr to entry block (used for ACLs and names) */
dcl  a_new_owner_bp ptr;				/* ptr to a_new entry block for threading names */
dcl  a_type_expected fixed bin;			/* type of blocks on list */
dcl  a_count fixed bin;				/* number of valid blocks found */
dcl  a_new_head bit (18) unal;			/* rebuild: head of list in new directory */
dcl  a_new_tail bit (18) unal;			/* rebuild: tail of list in new directory */

/* automatic */

dcl  back_rp bit (18);
dcl  block_rp bit (18);
dcl  bp ptr;
dcl  code fixed bin;
dcl  count fixed bin;
dcl  entry_p ptr;
dcl  forward bit (1) aligned;				/* ON for forward walk of list */
dcl  last_good_block bit (18) unal;			/* Last good block from forward walk. Used to terminate
						   backward walk. */
dcl  new_bp ptr;					/* ptr to block in new directory after the move */
dcl  new_head bit (18) unal;
dcl  new_tail bit (18) unal;
dcl  new_owner_bp ptr;				/* UID of owner block. */
dcl  owner_expected bit (36) aligned;
dcl  type_expected fixed bin;

dcl  1 block aligned like block_template based (bp);

	new_owner_bp = a_new_owner_bp;
	type_expected = a_type_expected;
	entry_p = a_entry_p;
	if rebuilding then do;
	     new_head = a_new_head;
	     new_tail = a_new_tail;
	     end;

/* For names and ACLs of entries the owner is the entry.  For all other blocks, the owner is the directory. */
	if entry_p ^= null
	then owner_expected = entry_p -> entry.uid;
	else owner_expected = dir_uid;
	count = 0;
	forward = "1"b;
	back_rp = "0"b;

/* If the forward thread is zero, but the backward thread is non-zero, then force the forward chain to fail
   to salvage those entries.
*/
	block_rp = head;
	if block_rp = "0"b
	then if tail ^= "0"b then block_rp = INVALID_RP;

	do while (block_rp ^= "0"b);
	     bp = ptr (source_ptr, block_rp);

/* If the block is not valid, then the back chain is used to recover the rest of the entries.
   ACL blocks can not be recoved this way, since the order is important.
*/
	     if ^valid_block (bp, type_expected, owner_expected, back_rp) then do;
		if trace then call trace_message ("Invalid block found on chain " || BLOCK_NAME (type_expected), bp);
		if stop_at_error then goto START_REBUILD;
		if ^forward
		then block_rp = "0"b;
		else do;
		     forward = "0"b;
		     if type_expected = acle_type
		     then block_rp = "0"b;
		     else do;
			back_rp = INVALID_RP;	/* can't check back ptr while following the chain backward */
			last_good_block = block_rp;
			if block_rp = tail
			then block_rp = "0"b;
			else block_rp = tail;
			end;
		     end;
		end;
	     else do;
		call mark_space_used (bp, 2);		/* Mark threads & size/type used */
		call check_contents (bp, type_expected, entry_p, code);
		if code = 0 then do;
		     call mark_space_used (bp, block_sizes (type_expected));
		     if rebuilding then do;
			call move (bp, new_head, new_tail, new_owner_bp, new_bp);
			if type_expected = acle_type
			then call set_acl_ref (addr (bp -> acl_entry.name), addr (new_bp -> acl_entry.name));
			else if type_expected = access_name_type then do;
				new_bp -> access_name.usage = 0;
				output_dir.acle_total = output_dir.acle_total + 1;
						/* This is a kludge. We move access names before
						   moving ACL entries, so the thread is quite
						   long even though dir.acle_total would be zero.
						   But acc_name_$encode (used to move ACLE) uses
						   acle_total to check for looped access name thread.
						   So we put in a number which will fool acc_name_.
						   What should really be done is to have a new
						   item, dir.access_name_total, but that is too much
						   work for right now. THVV */
				end;
			end;
		     count = count + 1;
		     end;
		else if trace
		     then call trace_message (rtrim (BLOCK_NAME (type_expected)) || " chain has invalid contents", bp)
			     ;
		if forward then do;
		     back_rp = block_rp;
		     block_rp = bp -> block.frp;
		     end;
		else do;
		     block_rp = bp -> block.brp;
		     if block_rp = last_good_block then block_rp = "0"b;
		     end;
		end;
	end;

	if rebuilding then do;
	     a_new_head = new_head;
	     a_new_tail = new_tail;
	     end;
	a_count = count;

	return;
     end process_list;
%page;
/* This procedure verifies the structure of a block.  It returns "0", if these conditions fail:
   1.  The block is within the directory and does not overlap any space that has been marked used.
   2.  The owner field matches the one expected.

   The following are not fatal errors and will be corrected. (except for the prodigal case)
   1.  The type and size fields found are not compatible with the type expected.
   2.  The back relative pointer is not the one expected.

   Any errors during a prodigal search, cause "0"b to be returned
*/
valid_block:
     proc (arg_tp, arg_type_expected, owner_expected, brp_expected) returns (bit (1) aligned);

/* parameters */

dcl  arg_tp ptr;					/* ptr to block */
dcl  arg_type_expected fixed bin;
dcl  owner_expected bit (36) aligned;
dcl  brp_expected bit (18) unal;

dcl  bp ptr;
dcl  type_expected fixed bin;
dcl  nwords fixed bin;
dcl  i fixed bin;
dcl  1 block aligned like block_template based (bp);


/* Check that the block falls within the directory and does not overlap previously accepted blocks. */

	bp = arg_tp;
	type_expected = arg_type_expected;
	if ^space_free (bp, block_sizes (type_expected)) then return ("0"b);

	goto btype (type_expected);

/* entry - directory, segment, link */
btype (8):
	if bp -> block.type = DIR_TYPE
	then type_expected = dir_type;
	else if bp -> block.type = SEG_TYPE
	     then type_expected = seg_type;
	     else if bp -> block.type = LINK_TYPE
		then type_expected = link_type;
		else return ("0"b);

	goto btype (type_expected);

/* access name */
btype (1):
	if bp -> access_name.owner ^= owner_expected then return ("0"b);
	goto CHECK_TYPE;

/* acl */
btype (2):
	if bp -> acl_entry.owner ^= owner_expected then return ("0"b);
	goto CHECK_TYPE;

/* segment or directory */
btype (7):
btype (4):
	if bp -> entry.owner ^= owner_expected then return ("0"b);
	goto CHECK_TYPE;

/* link */
/* The pathname size must be verified first, since the link structure uses it with the refer. */
btype (5):
	if bp -> link.pathname_size < 1 | bp -> link.pathname_size > 168 then return ("0"b);
	nwords = active_hardcore_data$elcsize + 3 + divide (bp -> link.pathname_size + 3, 4, 17, 0);
	do i = 1 to active_hardcore_data$nalloc_sizes while (nwords > active_hardcore_data$alloc_sizes (i));
	end;
	nwords = active_hardcore_data$alloc_sizes (i);
	if ^space_free (bp, nwords) then return ("0"b);
	if bp -> link.owner ^= owner_expected then return ("0"b);
	if bp -> link.size ^= nwords then do;
	     if prodigal_search then return ("0"b);
	     call error (CORRECTION, ME, "Corrected size field in link block");
	     bp -> link.size = nwords;
	     end;
	goto CHECK_BP;

/* name */
btype (6):
	if bp -> names.owner ^= owner_expected then return ("0"b);
	goto CHECK_TYPE;

/* The type and size fields must be correct for the prodigal search.  They will be corrected for the normal loop. */

CHECK_TYPE:
	if fixed (bp -> block.type, 18) ^= type_expected then do;
	     if prodigal_search then return ("0"b);
	     call error (CORRECTION, ME, "Invalid type in ^a block", BLOCK_NAME (type_expected));
	     bp -> block.type = bit (fixed (type_expected, 18), 18);
	     end;
	if bp -> block.size ^= block_sizes (type_expected) then do;
	     if prodigal_search then return ("0"b);
	     call error (CORRECTION, ME, "Corrected size field in ^a block", BLOCK_NAME (type_expected));
	     bp -> block.size = block_sizes (type_expected);
	     end;

/* Check and correct the back ptr.  Do not print message for prodigals since it  is assumed they are not on chains. */

CHECK_BP:
	if brp_expected ^= INVALID_RP
	then if bp -> block.brp ^= brp_expected then do;
		call error (CORRECTION, ME, "Corrected invalid back pointer in ^a", BLOCK_NAME (type_expected));
		bp -> block.brp = brp_expected;
		end;

	return ("1"b);

     end valid_block;
%page;
/* This procedure makes plausibility checks on the contents of the block.
   code = 0		No uncorrectable errors were found.
   code ^= 0		The block can not be salvaged.
*/
check_contents:
     proc (arg_bp, type_expected, entry_p, code);

dcl  arg_bp ptr;
dcl  type_expected fixed bin;
dcl  entry_p ptr;
dcl  code fixed bin;

dcl  a_code fixed bin (35);
dcl  bp ptr;
dcl  p ptr;

	code = 0;
	bp = arg_bp;
	goto check (type_expected);

/* access names must be ASCII */
check (1):
	call ascii_check (addr (bp -> access_name.name), length (bp -> access_name.name), code);
	if code ^= 0 then do;
	     if stop_at_error then goto START_REBUILD;
	     if code = 1
	     then call error (LOSS, ME, "Deleted non-ASCII access name ^a", bp -> access_name.name);
	     else call error (LOSS, ME, "Deleted blank access name");
	     end;
	if rebuilding
	then if bp -> access_name.usage = 0 then code = 1;

	return;

/* The ACL entry must point to valid person and project names and have an ASCII tag.  All access names are verified
   before any ACLs are checked. */
check (2):
	call check_acl_ref (addr (bp -> acl_entry.name), code);
	return;

/* The entry pointer must match the one expected.
   The name must contain only ASCII characters
   The name must not yet be in the hash table
*/
check (6):
	call ascii_check (addr (bp -> names.name), length (bp -> names.name), code);
	if code ^= 0 then do;
	     if stop_at_error then goto START_REBUILD;
	     if ^prodigal_search then do;
		if code = 1
		then call error (LOSS, ME, "Deleted non-ASCII name  ^a", bp -> names.name);
		else call error (LOSS, ME, "Deleted blank name");
		end;
	     return;
	     end;

/* Entry ptr check. */
	if rel (entry_p) ^= bp -> names.entry_rp then do;
	     if stop_at_error then goto START_REBUILD;
	     call error (CORRECTION, ME, "Corrected entry ptr for name ^a", bp -> names.name);
	     bp -> names.entry_rp = rel (entry_p);
	     end;

/* Name duplication check. */
	if rebuilding
	then p = target_ptr;
	else p = source_ptr;
	call hash$search (p, addr (bp -> names.name), (null), a_code);
	if a_code = 0 then do;
	     code = 1;
	     if stop_at_error then goto START_REBUILD;
	     if ^prodigal_search then call error (LOSS, ME, "Deleted duplicate name ^a", bp -> names.name);
	     return;
	     end;

/* Hash name back into source directory. */
	if ^rebuilding then do;
	     call hash$in (source_ptr, bp, a_code);
	     if a_code ^= 0 then do;
		call error (SYSTEM, ME, "Unexpected error from hash$in for ^a", bp -> names.name);
		goto START_REBUILD;
		end;
	     end;
	return;




     end check_contents;
%page;
/* This procedure turns on characters in the array directory_space to mark blocks of information that have been checked.
   This is done so that chains which loop back on themselves can be detected.  One character in directory_space
   corresponds to one word in the directory being checked.
   Entry blocks are special cased so that the primary name block, that is within the entry block, is left empty.

   The first character of the directory_space block is set:
   .	E	Entry block.  Used by prodigal search when a name has been found.
   .	A	Access name block.  Used in checking ACLs.  ACLs must point to verified access names.
*/
mark_space_used:
     proc (bp, num_words);

dcl  bp ptr;
dcl  num_words fixed bin;

dcl  start fixed bin;

dcl  1 block aligned based (bp) like block_template;

	start = fixed (rel (bp), 18) + 1;
	substr (directory_space, start, num_words) = substr (ONES, 1, num_words);

	if num_words > 2 then do;
	     if bp -> block.type = LINK_TYPE | bp -> block.type = DIR_TYPE | bp -> block.type = SEG_TYPE then do;
		substr (directory_space, start, 1) = "E";
		start = fixed (rel (addr (bp -> entry.primary_name)), 18) + 1;
		substr (directory_space, start, block_sizes (name_type)) = " ";
		end;
	     else if bp -> block.type = ACCESS_NAME_TYPE then substr (directory_space, start, 1) = "A";
	     end;

     end mark_space_used;



/* This procedure returns  "1"b, if the space specified is unused. */

space_free:
     proc (bp, num_words) returns (bit (1) aligned);

dcl  bp ptr;					/* pointer to block */
dcl  num_words fixed bin;				/* size of block */

dcl  start fixed bin;

	if num_words ^> 0 then call error (SYSTEM, ME, "salv_dir_checker_$space_fre called with num_words = 0");

	start = fixed (rel (bp), 18) + 1;
	if start + num_words - 2 > dir_size then return ("0"b);

/* HARDWARE BUG  get last character in, in case it is on a different page */
	if substr (directory_space, start + num_words - 1, 1) ^= " " then return ("0"b);
	return (substr (directory_space, start, num_words) = " ");

     end space_free;
%page;
/* This procedure is called to verify a name used in an ACL.  All access names are validated before any ACL's are
   checked.  The directory space array has an "A" at the start of all verified access names (stored by mark_space_used)
*/
check_acl_ref:
     proc (a_p, code);

dcl  a_p ptr;
dcl  p ptr;
dcl  code fixed bin;
dcl  1 name unal like acl_entry.name based (p);

	p = a_p;
	code = 0;
	if substr (unspec (name.tag), 1, 2) then do;
	     code = 1;
	     check_access_names = "1"b;
	     return;
	     end;
	if name.pers_rp ^= "0"b then call find_access_name (ptr (source_ptr, name.pers_rp));
	if code = 0
	then if name.proj_rp ^= "0"b then call find_access_name (ptr (source_ptr, name.proj_rp));
	if code = 1 then check_access_names = "1"b;




find_access_name:
	proc (np);

dcl  np ptr;

	     if fixed (rel (np), 18) + block_sizes (access_name_type) - 1 <= dir_size
	     then if substr (directory_space, fixed (rel (np), 18) + 1, 1) = "A" then return;
	     code = 1;

	end find_access_name;

     end check_acl_ref;




/* This procedure checks for ASCII characters.  ASCII characters have the 2 high order bits off. */

ascii_check:
     proc (name_ptr, num_chars, code);

dcl  name_ptr ptr;
dcl  num_chars fixed bin;
dcl  code fixed bin;

dcl  i fixed bin;
dcl  name bit (i) aligned based (name_ptr);

dcl  1 ascii_mask aligned static options (constant),
       2 part1 bit (9 * 16) init ((16)"110000000"b),
       2 part2 bit (9 * 16) init ((16)"110000000"b);

dcl  1 spaces aligned static options (constant),
       2 part1 bit (9 * 16) init ((16)"040"b3),
       2 part2 bit (9 * 16) init ((16)"040"b3);

	i = num_chars * 9;
	if (name & unspec (ascii_mask)) = "0"b
	then code = 0;
	else code = 1;

	if name = unspec (spaces) then code = 2;         /* Check to see if name is blank. */

     end ascii_check;
%page;
setup:
     proc;
	if ^static_init then do;
	     block_sizes (dir_header_type) = active_hardcore_data$dir_hdrsize;
	     block_sizes (seg_type), block_sizes (dir_type), block_sizes (entry_type) = active_hardcore_data$esize;
	     block_sizes (acle_type) = active_hardcore_data$aclsize;
	     block_sizes (access_name_type), block_sizes (name_type) = active_hardcore_data$ensize;
	     header_area_size = active_hardcore_data$dir_hdrsize + active_hardcore_data$nalloc_sizes + 2;
	     ONES = copy ("1", length (ONES));
	     root_lvid = pvt$root_lvid;
	     static_init = "1"b;
	     end;

	salv_ptr = arg_salv_ptr;
	branch_ptr = info.branch_ptr;
	source_ptr = arg_source_ptr;
	target_ptr = info.temp1_ptr;
	scratch_ptr = info.temp2_ptr;
	prodigal_search, check_access_names = "0"b;
	rebuilding = info.force_rebuild;
	correct_oosw = info.correct_oosw;
	trace = info.print_trace;
	security_oos = "0"b;
	time = info.salv_time;

/* Use the value in the area header if it is plausible. MR6.0 has garbage after the end of the area.
   After this release, unused portion of the last page of the directory will be zero, so the next
   version can use the current length.
*/
	dir_size = ptr (source_ptr, active_hardcore_data$dir_arearp) -> area.lu - 1;
	if dir_size > 1024 * info.current_length | dir_size < 1024 * (info.current_length - 1)
	then dir_size = info.current_length * 1024 - 1;
	directory_space = " ";

	string (event_flags) = ""b;
	event_flags.special_op = "1"b;
	event_flags.grant = "1"b;			/* can't know whether we're doing this under privileged
						   maint operation or as user who encountered a bad dir.
						   assume the latter... */

     end setup;
%page;
/* This procedure returns an entry name as characters, if it is ASCII or as octal, if it is not. */

entry_name:
     proc (ep) returns (char (32));

dcl  ep ptr;

dcl  string char (32 * 3);
dcl  np ptr;

dcl  code fixed bin;
dcl  word8 bit (288) aligned based;			/* the name as a bit string for formline_ */

	np = addr (ep -> entry.primary_name);
	call ascii_check (addr (np -> names.name), length (np -> names.name), code);
	if code = 0 then return (np -> names.name);
	call format ("^(^8w^)", addr (np -> names.name) -> word8, string);
	return (string);
     end entry_name;


format:
     proc (control_string, name_string, output_string) options (non_quick);

dcl  control_string char (*);
dcl  name_string bit (288) aligned;
dcl  output_string char (*);

dcl  formline_ entry (fixed bin, fixed bin, ptr, fixed bin, fixed bin);

	call formline_ (1, 2, addr (output_string), length (output_string), 0);

     end format;
%page;
/* Space for the block is allocated in the new directory and the new block is threaded onto the chain
   specified by the head and tail pointers.
   The primary name for an entry is contained within the entry block, so space is not allocated for it.
   Names are put in the hash table and their entry rel pointers set.
*/
move:
     proc (bp, head, tail, entry_bp, new_ptr);

dcl  bp ptr;					/* ptr to entry in old directory */
dcl  head bit (18) unal;				/* head of chain */
dcl  tail bit (18) unal;				/* tail of chain */
dcl  entry_bp ptr;					/* pointer to entry for a name block */
dcl  new_ptr ptr;					/* pointer to block in rebuilt directory */

dcl  code fixed bin (35);
dcl  num_words fixed bin;
dcl  last_ep ptr;					/* pointer to entry that was processed before the entry
						   for the this name. */

dcl  copy (num_words) bit (36) aligned based;
dcl  1 block aligned like block_template based (bp);

	num_words = bp -> block.size;

/* The first name on a chain is the primary name. */

	if bp -> block.type = NAME_TYPE & head = "0"b then do;
	     new_ptr = addr (entry_bp -> entry.primary_name);
	     end;
	else call fs_alloc$alloc (output_area_ptr, num_words, new_ptr, code);

	new_ptr -> copy = bp -> copy;
	new_ptr -> block.frp = "0"b;

	if head = "0"b then do;
	     head, tail = rel (new_ptr);
	     new_ptr -> block.brp = "0"b;
	     end;
	else do;
	     new_ptr -> block.brp = tail;
	     ptr (target_ptr, tail) -> block.frp = rel (new_ptr);
	     tail = rel (new_ptr);
	     end;

/* Names are hashed into the new directory.  This code special cases rebuilding a directory whose hash table size
   is about to grow.  The code in hash will walk the entry chain and put the names into the new hash table.
   The current entry must be removed from the entry chain, since its name is not yet in the hash table. */

	if new_ptr -> block.type = NAME_TYPE then do;
	     if output_dir.htused = output_dir.htsize then do;
		last_ep = ptr (target_ptr, entry_bp -> entry.ebrp);
		last_ep -> entry.efrp = "0"b;
		end;
	     else last_ep = null;
	     call hash$in (target_ptr, new_ptr, code);
	     if code ^= 0 then call error (SYSTEM, ME, "Unable to hash name ^a", new_ptr -> names.name);
	     ;
	     if last_ep ^= null then last_ep -> entry.efrp = rel (entry_bp);
	     new_ptr -> names.entry_rp = rel (entry_bp);
	     end;

     end move;
%page;
/* The ACL pointers to the access name and access project are changed to the locations in the rebuilt directory. */

set_acl_ref:
     proc (a_old_p, a_new_p);

dcl  a_old_p ptr;					/* ptr to access name structure in old directory */
dcl  a_new_p ptr;					/* ptr to access name structure in new directory */
dcl  p ptr;
dcl  code35 fixed bin (35);
dcl  1 acl_info aligned,				/* template for access name encoding */
       2 name,
         3 pers char (32),
         3 proj char (32),
         3 tag char (1),
       2 pad (2) bit (36);
dcl  1 name aligned like acl_entry.name based (p);

	p = a_old_p;
	if name.pers_rp = "0"b
	then acl_info.pers = "*";
	else acl_info.pers = ptr (source_ptr, name.pers_rp) -> access_name.name;

	if name.proj_rp = "0"b
	then acl_info.proj = "*";
	else acl_info.proj = ptr (source_ptr, name.proj_rp) -> access_name.name;
	acl_info.tag = name.tag;

join:
	call acc_name_$encode (a_new_p, addr (acl_info), code35);
	if code35 ^= 0 then do;
	     call error (SYSTEM, ME, "Unexpected error from acc_name_$encode ^w for ^a.^a.^a", code35, name.pers, name.proj,
		name.tag);
	     end;

	return;

set_acl_ref$damaged:
     entry (a_old_p, a_new_p);			/* Called to put in constant. */

	acl_info.pers = "Salvager";
	acl_info.proj = "SysDaemon";
	acl_info.tag = "z";

	go to join;


     end set_acl_ref;
%page;
/* If the compact option was specified, then the space on the free list is totaled.  If it contains a page or more
   space, then a rebuild is forced.  If any errors are detected, a rebuild is forced.
*/
check_free_list:
     proc;

dcl  bp ptr;
dcl  i fixed bin;
dcl  sum fixed bin;
dcl  1 block aligned like block_template based (bp);

	areap = ptr (source_ptr, input_dir.arearp);
	sum = 0;

	do i = 1 to area.nsizes;
	     do bp = ptr (source_ptr, area.array (i).fptr) repeat ptr (source_ptr, bp -> block.frp) while (rel (bp));

		if area.array (i).size ^> 0 then go to START_REBUILD;
		if ^space_free (bp, (area.array (i).size)) then goto START_REBUILD;
		sum = sum + area.array (i).size;
		if sum > 1024 then goto START_REBUILD;
		call mark_space_used (bp, (area.array (i).size));
	     end;
	end;

     end check_free_list;
%page;
/* Fields in the header are checked against values supplied in the branch and storage system constants
   Errors cause a message to be printed and the rebuilding flag to be set.  No corrections are made here,
   setup_header sets all fields using the branch information.

   "0"b	If the UID in the branch does not equal the UID in the header
   "1"b	The UID does match.

   If the access_class does not match, the branch will be set security_oos.
*/
valid_header:
     proc () returns (bit (1) aligned);

dcl  1 branch aligned based (branch_ptr) like entry;

dcl  num_buckets fixed bin;
dcl  i fixed bin;
dcl  block (i) bit (36) based (htp);
dcl  1 hash_table aligned based (htp),
       2 pad bit (36),
       2 type bit (18) unal,
       2 size fixed bin (17) unal,
       2 buckets (num_buckets) bit (18) unal;

	if branch_ptr = null then do;
	     audit = "0"b;

	     dir_uid = input_dir.uid;
	     end;
	else do;
	     audit = "1"b;

/* If the UID in the header doesn't match the one in the branch, then a valid empty directory will be created. */

	     if input_dir.uid ^= branch.uid then do;
		call error (LOSS, ME, "Invalid directory header - no information recovered");
		dir_name_cnt = 0;
		call setup_dir_header;
		rebuilding = "1"b;
		return ("0"b);
		end;

	     if input_dir.owner ^= branch.owner then call header_err ("owner");
	     if input_dir.pvid ^= branch.pvid then call header_err ("physical volume id");
	     if input_dir.sons_lvid ^= branch.sons_lvid then call header_err ("sons logical volume id");
	     if input_dir.vtocx ^= branch.vtocx then call header_err ("vtoc index");
	     if input_dir.master_dir ^= branch.master_dir then call header_err ("master directory switch");
	     if input_dir.master_dir_uid ^= info.master_dir_uid then call header_err ("master directory UID");
	     dir_uid = branch.uid;
	     dir_access_class = branch.access_class;

/* AIM check */
	     if input_dir.access_class ^= dir_access_class then do;
		call error (LOSS, ME, "Branch access class ^a does not match directory header access class ^a",
		     cv_access (branch.access_class), cv_access (input_dir.access_class));

/* BUG FIX: This field is not always set, due to a bug in reclassify.  Add check after 6.0 */
/*
   *		call access_audit_$log_obj_class ("salv_dir_checker_", level$get(), unspec(event_flags),
   *		     access_operations_$fs_obj_set_soos, branch.access_class, info.pathname, 0, null(), 0,
   *		     "Dir header class: ^a", cv_access (dir_access_class));
   *		     security_oos = "1"b;
*/
		end;
	     end;
	if input_dir.type ^= DIR_HEADER_TYPE then call header_err ("type");
	if input_dir.size ^= active_hardcore_data$dir_hdrsize then call header_err ("size");
	if input_dir.version_number ^= version_number_2 then call header_err ("version_number");
	if input_dir.arearp ^= bit (active_hardcore_data$dir_arearp, 18) then call header_err ("area pointer");

/* Check area header */

	areap = ptr (source_ptr, active_hardcore_data$dir_arearp);
	if area.nsizes ^= active_hardcore_data$nalloc_sizes
	then call header_err ("area header");
	else do;
	     do i = 1 to active_hardcore_data$nalloc_sizes;
		if area.array (i).size ^= active_hardcore_data$alloc_sizes (i) then do;
		     i = active_hardcore_data$nalloc_sizes;
		     call header_err ("area header");
		     end;
	     end;
	     end;

	if area.lw ^= sys_info$default_dir_max_length - 1 then call header_err ("area size");

/* Check hash block structure, clear the hash table information, and mark the space used.
   If rehashing is set, the procedure hash was rehashing to a larger table size when an error was detected. */

	dir_name_cnt = input_dir.htused;
	if ^input_dir.rehashing then do;
	     htp = ptr (source_ptr, input_dir.hash_table_rp);

/* This code depends on being the last check in valid_header. */
/* If the return statement inside is not executed, then the */
/* control point falls through to the error message */

	     if hash_table.size > 0			/* has to be believable */
	     then if space_free (htp, (hash_table.size)) then do;
		     do i = 1 to active_hardcore_data$num_hash_table_sizes
			while (input_dir.htsize ^= active_hardcore_data$hash_table_sizes (i));
		     end;
		     if i <= active_hardcore_data$num_hash_table_sizes then do;
			num_buckets = active_hardcore_data$hash_table_sizes (i);
			if input_dir.htused <= num_buckets | i = active_hardcore_data$num_hash_table_sizes then do;
			     i = hash_table.size;
			     if hash_table.type = HASH_TABLE_TYPE & block (i) = dir_uid then do;
				unspec (buckets) = "0"b;
				input_dir.htused = 0;
				call mark_space_used (htp, (hash_table.size));
				return ("1"b);
				end;
			     end;
			end;
		     end;
	     end;
	call error (CORRECTION, ME, "Invalid hash table found");
	rebuilding = "1"b;
	return ("1"b);




header_err:
	proc (string);

dcl  string char (*);

	     call error (CORRECTION, ME, "Corrected ^a in header", string);
	     rebuilding = "1"b;

	end header_err;
     end valid_header;
%page;
setup_dir_header:
     proc;

dcl  i fixed bin;

dcl  1 branch aligned like entry based (branch_ptr);

	unspec (output_dir) = "0"b;
	if branch_ptr ^= null then do;
	     output_dir.owner = branch.owner;
	     output_dir.uid = branch.uid;
	     output_dir.pvid = branch.pvid;
	     output_dir.sons_lvid = branch.sons_lvid;
	     output_dir.master_dir = branch.master_dir;
	     output_dir.access_class = branch.access_class;
	     output_dir.per_process_sw = branch.per_process_sw;
	     output_dir.vtocx = branch.vtocx;
	     if input_dir.force_rpv & branch.sons_lvid = root_lvid
	     then output_dir.force_rpv = "1"b;
	     else output_dir.force_rpv = "0"b;
	     end;

	output_dir.master_dir_uid = info.master_dir_uid;
	output_dir.tree_depth = info.tree_depth;
	output_dir.type = DIR_HEADER_TYPE;
	output_dir.size = active_hardcore_data$dir_hdrsize;
	output_dir.dts = time;
	output_dir.version_number = version_number_2;
	output_dir.arearp = bit (active_hardcore_data$dir_arearp, 18);
	i = sys_info$default_dir_max_length - fixed (output_dir.arearp, 18);
	output_area_ptr = ptr (target_ptr, active_hardcore_data$dir_arearp);
	call fs_alloc$init (output_area_ptr, i, addr (active_hardcore_data$alloc_sizes),
	     active_hardcore_data$nalloc_sizes);
	i = dir_name_cnt;
	if i < 0 | i > 5 * input_dir.htsize then i = 0;
	call allocate_dir_ht_ (target_ptr, i, (0));

     end setup_dir_header;
%page;
/* The rebuilt version is copied into the source.  The unused portion of the last page must be cleared so that
   it will not be "recovered" in a future prodigal search.
*/
copy_directory:
     proc;

dcl  num_pages fixed bin;				/* number of pages in new directory */
dcl  num_words fixed bin (18);			/* number of used words in directory. */
dcl  zero_len fixed bin;				/* number of unused words on last page */
dcl  1 copy_dir aligned based,
       2 contents (num_words) bit (36) aligned,
       2 zero bit (zero_len) aligned;

	num_words = output_area_ptr -> area.lu;		/* Note: lu is NEXT available block and offsets start at 0 */
	output_area_ptr -> area.lw = sys_info$default_dir_max_length - 1;

	num_pages = divide (num_words + 1023, 1024, 17, 0);
	if num_pages > info.current_length
	then call error (CORRECTION, ME, "Directory pages increased from ^d to ^d.", info.current_length, num_pages);
	if num_words > dir_size + 1
	then call error (CORRECTION, ME, "Directory length increased from ^d to ^d", dir_size + 1, num_words);
	zero_len = mod (num_words, 1024);
	if zero_len > 0 then do;
	     zero_len = (1024 - zero_len) * 36;
	     source_ptr -> copy_dir.zero = "0"b;
	     end;
	source_ptr -> copy_dir.contents = target_ptr -> copy_dir.contents;

	arg_new_dir_pages = num_pages;

     end copy_directory;
%page;
/*  This procedure supplies a unique primary name for an entry.  It is only called when rebuilding. */
get_unique_name:
     proc (ep);

dcl  ep ptr;					/* ptr to entry block */

dcl  1 new_name aligned like names;
dcl  unique_chars_ entry (bit (*)) returns (char (15));

	new_name.name = unique_chars_ ("0"b);
	new_name.owner = ep -> entry.uid;
	new_name.type = NAME_TYPE;
	new_name.size = active_hardcore_data$ensize;
	call move (addr (new_name), ep -> entry.name_frp, ep -> entry.name_brp, ep, (null));
	call error (LOSS, ME, "Unique name ^a supplied for ^a", new_name.name, BLOCK_NAME (fixed (ep -> entry.type, 18)));

	ep -> entry.nnames = 1;


     end get_unique_name;
%page;
/* This procedure prints debugging information. */

trace_message:
     proc (string, p);

dcl  string char (*);
dcl  p ptr;

	call error (DUMP, ME, "salv_dir_checker_ trace information - ^a at ^p", string, p);

     end trace_message;
%page;
cv_access:
     proc (access) returns (char (32) aligned);

dcl  access bit (72) aligned;
dcl  string char (32) aligned;

	call display_access_class_ (access, string);
	return (string);

     end cv_access;
%page;
/* This procedure searches the access_name list and frees any names with a zero access count.
   Unused access names occur because the access name list is recovered before any of the ACL's that reference them.
*/
delete_unused_access_names:
     proc (head, tail);

dcl  head bit (18) unal;
dcl  tail bit (18) unal;

dcl  bp ptr;
dcl  next_rp bit (18);

	do bp = ptr (target_ptr, head) repeat ptr (target_ptr, next_rp) while (rel (bp));

	     next_rp = bp -> access_name.frp;
	     if bp -> access_name.usage = 0 then do;
		if bp -> access_name.brp
		then ptr (target_ptr, bp -> access_name.brp) -> access_name.frp = bp -> access_name.frp;
		else head = bp -> access_name.frp;

		if bp -> access_name.frp
		then ptr (target_ptr, bp -> access_name.frp) -> access_name.brp = bp -> access_name.brp;
		else tail = bp -> access_name.brp;

		call fs_alloc$free (output_area_ptr, block_sizes (access_name_type), bp);
		end;
	end;

     end delete_unused_access_names;
%page;
target: proc (dir, ent) returns (char (*));

dcl	dir	char (*) parameter;
dcl	ent	char (*) parameter;

	if dir = ">"
	then return (">"||ent);
	else return (rtrim(dir)||">"||ent);

     end target;
%include dir_header;
%include dir_entry;
%include dir_link;
%include dir_acl;
%include dir_name;
%include dir_ht;
%include dir_allocation_area;
%include salv_args;
%include fs_types;
%include salv_data;
%include sys_log_constants;
%include its;
%include access_audit_eventflags;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   AUDIT (salv_dir_checker_): GRANTED modification of fs_obj access ADDED_INFO

   S: $access_audit

   T: Salvaging

   M: The salvager has truncated the ACL of a branch.

   A: $inform_ssa


   Message:
   ADUIT (salv_dir_checker_): GRANTED modification of security out-of-service ADDED_INFO

   S: $access_audit

   T: Salvaging

   M: The security-out-of-service switch has been set on
   a directory because of an AIM error.  The access class of
   a branch was not equal to that of the containing directory,
   or the access class in the directory's branch was not equal
   to the access class stored in its header.

   A: $inform_ssa


   Message:
   salv_dir_checker_: MESSAGE.

   S:     $log

   T:     Salvaging

   M:     Various messages are printed by salv_dir_checker_ indicating
   what salvaging is taking place--ACL counts being changed, entry counts
   being changed, unique names supplied for segments with invalid names,
   etc.

   A:     $ignore

   END MESSAGE DOCUMENTATION */

     end salv_dir_checker_;




		    salv_directory.pl1              11/11/89  1059.4rew 11/11/89  0807.4      192636



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/* format: style4,delnl,insnl,tree,ifthenstmt,indnoniterend */
salv_directory:
     proc (arg_info_p, message, arg_old_dir_p, arg_old_dir_len, arg_code);

/* One directory is found and salvaged.
   *
   * salv_directory		hphcs_ gate entry.  Used to invoke salvager from ring 4.
   *
   * ring0_salvage		regular call from salvager for the ring 1 salv command.
   *
   * online_salvage		Online salvager call.
*/

/****^  HISTORY COMMENTS:
  1) change(77-07-01,Barr), approve(), audit(), install():
      Written by S.E. Barr.
  2) change(79-11-01,Grady), approve(), audit(), install():
      Modified by Mike Grady to add cleanup handler.
  3) change(81-11-12,Sibert), approve(), audit(), install():
      Modified by W. Olin Sibert to set the dir.uid properly to avoid an
      online salvage when locking.
  4) change(81-12-01,Hornig), approve(), audit(), install():
      Modified by C. Hornig for 205K directories.
  5) change(82-02-01,Margulies), approve(), audit(), install():
      Modified by BIM for new salv dir locking.
  6) change(82-03-01,Bongiovanni), approve(), audit(), install():
      Modified by J. Bongiovanni to eliminate use of FSDCT.
  7) change(82-03-01,Margulies), approve(), audit(), install():
      Modified for new vtoc_attributes info.
  8) change(84-07-01,Loepere), approve(), audit(), install():
      Modified by Keith Loepere to use the new dc_find.
  9) change(84-11-01,Loepere), approve(), audit(), install():
      Modified to clean up a little.
 10) change(84-12-05,EJSharpe), approve(), audit(), install():
      Modified to use access_audit_ instead of protection_audit_.
 11) change(86-05-23,Lippard), approve(86-06-17,MCR7433),
     audit(86-06-26,Hartogs), install(86-07-11,MR12.0-1091):
      Modified by Jim Lippard to establish cleanup handler before call to
      hold_segs.
 12) change(86-11-11,Lippard), approve(86-12-08,MCR7590),
     audit(87-04-16,Dickson), install(87-04-28,MR12.1-1028):
      Modified to copy caller name correctly for printing error messages.
                                                   END HISTORY COMMENTS */


/* Parameters */

dcl  arg_branch_p ptr;				/* ONLINE: ptr to branch for directory. */
dcl  arg_code fixed bin (35);				/* 0 = salvage completed. */
dcl  arg_dp ptr;					/* ONLINE: ptr to directory. */
dcl  arg_info_p ptr;				/* ptr to argument structure */
dcl  arg_old_dir_len fixed bin;			/* RING_4: Number of words in dump segment. */
dcl  arg_old_dir_p ptr;				/* RING_4: Buffer for copy of directory. */
dcl  message char (*) var;				/* RING_4: Error message segment. */

/* Automatic */

dcl  astep (4) ptr;					/* RING_4: ptrs for segments that were entry held. */
dcl  branch_p ptr;					/* ptr to branch for directory. */
dcl  caller fixed bin;				/* Identifies the entry point */
dcl  child_dirmod bit (1) aligned;			/* changed this dir */
dcl  code fixed bin (35);
dcl  1 copy_args aligned like salv_args;		/* Copy of args for ring 4. */
dcl  dir_uid bit (36) aligned;			/* The UID in the vtoce when the dir was made known */
dcl  1 event_flags aligned like audit_event_flags;	/* specifics of the operation */
dcl  info_p ptr;					/* Copy of argument structure ptr. */
dcl  new_dir_pages fixed bin;				/* Number of pages in rebuilt directory. */
dcl  parent_dirmod bit (1) aligned;			/* changed containing dir */
dcl  root bit (1) aligned;				/* ON, if root is being salaged. */
dcl  1 root_entry aligned like entry;			/* Dummy branch for the root. */
dcl  set_security_oosw bit (1) aligned;			/* ON, if the security_oosw in branch should be set. */
dcl  should_dump bit (1) aligned;			/* ON, if the directory has not yet been dumped. */
dcl  unlock_dir bit (1) aligned;			/* ON, if directory should be unlocked. */
dcl  unlock_parent bit (1) aligned;			/* ON, if parent directory should be unlocked. */

/* Based */

dcl  1 dir_branch aligned like entry based (branch_p);
dcl  1 info aligned like salv_args based (info_p);

/* Constants */

dcl  ME char (14) int static options (constant) init ("salv_directory");
dcl  MAX_MESSAGE_SIZE fixed bin (18) int static options (constant) init (16 * 1024);
dcl  NEW_LINE char (1) int static options (constant) init ("
");
dcl  ONLINE fixed bin int static options (constant) init (3);
dcl  RING_0 fixed bin int static options (constant) init (1);
dcl  RING_4 fixed bin int static options (constant) init (2);
dcl  packed_null ptr unal int static options (constant) init (null ());

/* External */

dcl  access_operations_$fs_obj_set_soos bit (36) aligned external;
dcl  error_table_$ external static;
dcl  error_table_$no_terminal_quota fixed bin (35) external;
dcl  error_table_$mylock fixed bin (35) external static;
dcl  pds$processid bit (36) aligned external static;
dcl  pvt$root_lvid bit (36) aligned external;
dcl  pvt$root_pvid bit (36) aligned external;
dcl  pvt$root_vtocx fixed bin (17) external;
dcl  sys_info$default_dir_max_length fixed bin (19) external;

/* Entries */

dcl  access_audit_$log_obj_class entry options (variable);
dcl  arg_count_ entry returns (fixed bin);
dcl  arg_list_ptr_ entry returns (pointer);
dcl  dir_dump entry (ptr, fixed bin);
dcl  formline_ entry (fixed bin, fixed bin, ptr, fixed bin, fixed bin (35));
dcl  grab_aste$prewithdraw entry (ptr, fixed bin (18), fixed bin (35)) returns (ptr);
dcl  grab_aste$release_prewithdraw entry (ptr);
dcl  level$get entry () returns (fixed bin);
dcl  lock$dir_unlock entry (pointer);
dcl  lock$dir_unlock_given_uid entry (bit (36) aligned);
dcl  salv_dir_checker_ entry (ptr, ptr, entry, bit (1) aligned, fixed bin);
dcl  salv_check_vtoce_ entry (ptr, char (*), bit (1) aligned, entry);
dcl  salv_err_msg$path entry options (variable);
dcl  sum$dirmod entry (pointer);
dcl  sum$getbranch_root_my entry (ptr, bit (1) aligned, ptr, fixed bin (35));
dcl  syserr entry options (variable);
dcl  truncate_vtoce entry (ptr, fixed bin, fixed bin (35));
dcl  vtoc_attributes$get_info entry (bit (36) aligned, bit (36) aligned, fixed bin, ptr, fixed bin (35));
dcl  vtoc_attributes$set_max_lth
	entry (bit (36) aligned, bit (36) aligned, fixed bin, fixed bin (9), bit (1) aligned, fixed bin (35));

/* Misc */

dcl  cleanup condition;

dcl  (addr, baseno, divide, hbound, length, min, null, ptr, rel, rtrim, string, substr, unspec) builtin;
%page;
/* Copy arguments and entry hold segments. */

	call setup;
	caller = RING_4;
	arg_old_dir_len = 0;
	copy_args = arg_info_p -> salv_args;
	info_p = addr (copy_args);

	goto START;


ring0_salvage:
     entry (arg_info_p, arg_code);

	call setup;
	caller = RING_0;
	info_p = arg_info_p;
	goto START;


/* ONLINE:  Already have pointers to the branch and the directory. */
/*	  and the appropriate locks are locked */

online_salvage:
     entry (arg_info_p, arg_branch_p, arg_dp, arg_code);

	call setup;
	info_p = arg_info_p;
	branch_p = arg_branch_p;
	dp = arg_dp;
	caller = ONLINE;


START:
	arg_code = 0;


/* We do not want to allow verify_lock to salvage (again) the directory */
/* in which the salvager has just taken a fault. This can cause locking */
/* difficulties, and is generally not very useful. Since salvager.pl1 */
/* has an any_other handler that hand-calls verify_lock, we have to */
/* always have a cleanup handler to unlock our locks, so that verify_lock */
/* will not find them. salvager makes an explicit call to the unwinder */
/* to insure that our cleanup handler runs. */

	unlock_dir, unlock_parent = "0"b;

	on cleanup call clean_up;

	if caller = RING_4 then do;
	     call hold_segs (code);
	     if code ^= 0 then do;
		arg_code = code;
		call rel_segs;
		return;
		end;
	     end;

	call get_dir (code);
	if code = 0 then do;

/* Fill information for this directory: master_dir_uid, tree depth, branch_ptr. */
	     should_dump = info.dump;

	     if dir_branch.master_dir
	     then info.master_dir_uid = dir_branch.uid;
	     else info.master_dir_uid = ptr (branch_p, 0) -> dir.master_dir_uid;

	     if root
	     then info.tree_depth = 0;
	     else info.tree_depth = ptr (branch_p, 0) -> dir.tree_depth + 1;

	     info.branch_ptr = branch_p;

/* current length and quota */

	     call vtoc_attributes$get_info ((dir_branch.uid), (dir_branch.pvid), (dir_branch.vtocx), addr (sc_info),
		code);
	     if code = 0 then do;
		info.current_length = divide (sc_info.csl + 1023, 1024, 17, 0);
		if sc_info.msl ^= sys_info$default_dir_max_length then do;
		     call vtoc_attributes$set_max_lth ((dir_branch.uid), (dir_branch.pvid), (dir_branch.vtocx),
			divide (sys_info$default_dir_max_length, 1024, 9, 0), "0"b, code);
		     if code = 0
		     then call print (SALV_LOG, ME, "Changed max length in VTOCE from ^d to ^d.", sc_info.msl,
			     sys_info$default_dir_max_length);
		     else call print_code (SALV_LOG, ME, code, "Changing max length in VTOCE.");
		     end;

		call salv_dir_checker_ (dp, info_p, print, set_security_oosw, new_dir_pages);

/* If the directory was rebuilt (new_dir_pages > 0), then print error message and truncate the directory. */
		if new_dir_pages > 0 then do;
		     child_dirmod = "1"b;

		     if new_dir_pages < info.current_length then do;
			call truncate_vtoce (branch_p, new_dir_pages, code);
			if code ^= 0
			then call print_code (SALV_ANNOUNCE, ME, code, "truncate_vtoce to length ^d failed.",
				new_dir_pages);
			code = 0;
			end;
		     end;
		call check_upgraded_dir;
		if set_security_oosw then do;
		     dir_branch.security_oosw = "1"b;
		     parent_dirmod = "1"b;
		     end;

		if info.check_vtoce
		then call salv_check_vtoce_ (dp, (info.pathname), (info.delete_connection_failure), print_code);
						/* Call protection audit for any branches that are security out-of-service. */

		do ep = ptr (dp, dir.entryfrp) repeat ptr (dp, entry.efrp) while (rel (ep));

		     if entry.bs
		     then if entry.security_oosw then do;
			     call print (SALV_LOG, ME,
				"Branch is security out-of-service: " || addr (entry.primary_name) -> names.name);
			     string(event_flags) = ""b;
			     event_flags.special_op = "1"b;
			     event_flags.grant = "1"b; /* we're not doing anything but auditing */
			     if caller = RING_4
			     then event_flags.priv_op = "1"b;
			     call access_audit_$log_obj_class ("salv_directory", level$get(),
				string(event_flags), access_operations_$fs_obj_set_soos,
				entry.access_class, target (info.pathname,
				(addr(entry.primary_name)->names.name)), 0, null(), 0,
				"switch found already on");

			     end;

		end;
		end;
	     end;
	call clean_up;

	if code ^= 0 then do;			/* vtoc_attributes$get_info failed */
	     call print_code (SALV_ANNOUNCE, ME, code, "Could not read VTOCE attributes.");
	     arg_code = code;
	     end;

	return;
%page;
/* AIM - Upgraded directories must have non-zero quota.  If such a directory is found, it will be
   set security out-of-service */
check_upgraded_dir:
     proc;

dcl  1 quota_info aligned like quota_cell defined (sc_info.qcell (0));

	if root then return;
	if ptr (branch_p, 0) -> dir.access_class = dir.access_class then return;
	if quota_info.quota = 0 then do;
	     call print (SALV_ANNOUNCE, ME, "Upgraded dir set security out-of-service due to no quota.");
	     string(event_flags) = ""b;
	     event_flags.special_op = "1"b;
	     event_flags.grant = "1"b;
	     if caller = RING_4
	     then event_flags.priv_op = "1"b;
	     call access_audit_$log_obj_class ("salv_directory", level$get(),
		string(event_flags), access_operations_$fs_obj_set_soos, dir.access_class,
		info.pathname, error_table_$no_terminal_quota, null(), 0);
	     set_security_oosw = "1"b;
	     end;

     end check_upgraded_dir;
%page;
get_dir:
     proc (code);

dcl  code fixed bin (35) parameter;

	root = (info.pathname = ">");
	code = 0;


/* Directory and parent are already locked in the online case. */

	if caller = ONLINE then do;
	     if root then call setup_root_branch;
	     return;
	     end;

/* Find and lock directory.  If the directory is out-of-service, salvage anyway. */

	call dc_find$dir_salvage (info.pathname, dir_uid, dp, code);
	if code ^= 0 then return;
	unlock_dir = "1"b;

	dir.modify = pds$processid;

/* Lock the parent directory and get the branch.  The root needs a phony branch. */

	if root
	then call setup_root_branch;
	else do;
	     call sum$getbranch_root_my (dp, "1"b, branch_p, code);
	     if code = 0
	     then unlock_parent = "1"b;
	     else if code ^= error_table_$mylock then return;
	     end;

	return;

     end get_dir;
%page;
hold_segs:
     proc (code);

dcl  code fixed bin (35) parameter;

	astep (*) = null;

/* Message segment. */
	astep (1) = grab_aste$prewithdraw (addr (message), MAX_MESSAGE_SIZE, code);
	if code ^= 0 then return;

/* Copy of directory for the case of a dump */
	if info.dump then do;
	     astep (2) = grab_aste$prewithdraw (arg_old_dir_p, 255 * 1024, code);
	     if code ^= 0 then return;
	     end;

/* Storage image of the directory is 1/4th of the size of the directory. */

	astep (3) = grab_aste$prewithdraw (info.temp2_ptr, 64 * 1024, code);
	if code ^= 0 then return;

/* Rebuilt directory. */

	astep (4) = grab_aste$prewithdraw (info.temp1_ptr, 255 * 1024, code);
	return;

     end hold_segs;
%page;
clean_up:
     proc;

/* On non-RING_0 salvages we could leave it to verify_lock to */
/* clean things up, but that would produce salvages of parent dirs. */

	if dp ^= null then dir.modify = "0"b;

	if child_dirmod
	then call sum$dirmod (dp);
	else if parent_dirmod then call sum$dirmod (ptr (branch_p, 0));

	if unlock_dir then call lock$dir_unlock_given_uid (dir_uid);
	if unlock_parent then call lock$dir_unlock (ptr (branch_p, 0));
	if dp ^= null then call dc_find$finished (dp, "0"b);

	if caller = RING_4 then call rel_segs;

     end clean_up;



rel_segs:
     proc;

dcl  i fixed bin;

	do i = 1 to hbound (astep, 1);
	     if astep (i) ^= null then call grab_aste$release_prewithdraw (astep (i));
	end;

     end rel_segs;
%page;
print:
     procedure options (variable);


dcl  arg_list_arg_count fixed bin;
dcl  arg_list_ptr pointer;
dcl  caller_name char (32);
dcl  copy_len fixed bin;
dcl  have_code bit (1) aligned;			/* ON, if non-zero code was specified with call. */
dcl  line char (256);				/* Complete output line. */
dcl  line_len fixed bin;				/* Number of characters for output */
dcl  msg_len fixed bin;				/* Number of characters in error_table_message. */
dcl  msg_p ptr unal;				/* ptr to error_table_ message structure. */
dcl  pic pic "99";
dcl  severity fixed bin;				/* copy of severity level. */
dcl  start fixed bin;				/* index of 1st arg for message. */
dcl  string char (253) defined (line) pos (3);		/* Message from formline. */

dcl  based_code fixed bin (35) based;
dcl  based_severity fixed bin based;
dcl  based_caller_name char (32) based;
dcl  copy (copy_len) bit (36) based;
dcl  1 et aligned based (msg_p),			/* An error_table_ message */
       2 len fixed bin (8) unal,			/* Length of the message */
       2 msg char (et.len) unal;			/* The message */
%page;
	have_code = "0"b;
	start = 3;
	goto FORMAT;

print_code:
     entry options (variable);

	have_code = "1"b;				/* can correct later if code = 0 */
	start = 4;

FORMAT:						/* Format line:  <blank> <blank> <message> <new_line>    */
	arg_list_ptr = arg_list_ptr_ ();
	arg_list_arg_count = arg_count_ ();

	if arg_list_arg_count < 3 then call syserr (CRASH, "salv_directory: Invalid call to error message printer.");

	severity = arg_list_ptr -> arg_list_with_envptr.arg_ptrs (1) -> based_severity;
	caller_name = substr (arg_list_ptr -> arg_list_with_envptr.arg_ptrs (2) -> based_caller_name,
	     1, arg_list_ptr -> arg_list_with_envptr.desc_ptrs (2) -> arg_descriptor.size);
	if have_code
	then code = arg_list_ptr -> arg_list_with_envptr.arg_ptrs (3) -> based_code;
	else code = 0;
	if code = 0 then have_code = "0"b;		/* dont bother to print null message */

	line_len = length (string);
	call formline_ (start, start + 1, addr (string), line_len, (0));
	line_len = length (rtrim (substr (string, 1, line_len)));
	substr (line, 1, 2) = "";
	line_len = line_len + 2;

/* Add error_table_ message. Interpret code as a packed ptr that points to the error message. */

	if have_code then do;
	     unspec (msg_p) = unspec (code);
	     if baseno (msg_p) = baseno (packed_null) then do;
		msg_p = ptr (addr (error_table_$), rel (msg_p));
		msg_len = min (length (line) - line_len, et.len + 1);
		if msg_len > 0 then do;
		     substr (line, line_len + 1, msg_len) = " " || et.msg;
		     line_len = line_len + msg_len;
		     end;
		end;
	     end;


/* Put message in ring 4 segment or call hardcore print routine */

	if caller = RING_4 then do;
	     pic = severity;
	     if length (message) + line_len < MAX_MESSAGE_SIZE then do;
		message = message || pic;
		message = message || substr (line, 1, line_len) || NEW_LINE;
		if (severity = SALV_DEBUG) & should_dump then do;
		     copy_len, arg_old_dir_len = info.current_length * 1024;
		     arg_old_dir_p -> copy = dp -> copy;
		     should_dump = "0"b;
		     end;
		end;
	     end;
	else do;
	     call salv_err_msg$path (severity, info.pathname, rtrim (caller_name) || ": " || substr (line, 1, line_len));
	     if (severity = SALV_DEBUG) & should_dump then do;
		call dir_dump (dp, info.current_length);
		should_dump = "0"b;
		end;
	     end;

     end print;
%page;
setup_root_branch:
     procedure;

	branch_p = addr (root_entry);
	unspec (root_entry) = "0"b;
	root_entry.uid, root_entry.owner = (36)"1"b;
	root_entry.pvid = pvt$root_pvid;
	root_entry.sons_lvid = pvt$root_lvid;
	root_entry.vtocx = pvt$root_vtocx;
	root_entry.dirsw = "1"b;
	root_entry.master_dir = "1"b;
	root_entry.name_frp = rel (addr (root_entry.primary_name));
	addr (root_entry.primary_name) -> names.name = ">";
	root_entry.per_process_sw = "0"b;
	root_entry.bs = "1"b;
	root_entry.access_class = "0"b;

     end setup_root_branch;

setup:
     procedure;

/* Initialize here for benefit of handlers */

	dp, branch_p = null ();
	unlock_dir, unlock_parent = "0"b;
	parent_dirmod, child_dirmod = "0"b;
     end setup;
%page;
target: proc (dir, ent) returns (char (*));

dcl	dir	char (*) parameter;
dcl	ent	char (*) parameter;

	if dir = ">"
	then return (">"||ent);
	else return (rtrim(dir)||">"||ent);

     end target;
%page;
%include arg_descriptor;
%page;
%include arg_list;
%page;
%include dc_find_dcls;
%page;
%include dir_allocation_area;
%page;
%include dir_entry;
%page;
%include dir_header;
%page;
%include dir_name;
%page;
%include quota_cell;
%page;
%include salv_args;
%page;
%include salvager_severities;
%page;
%include sc_info;
%page;
%include syserr_constants;
%page;
%include access_audit_eventflags;
%page;

/* BEGIN MESSAGE DOCUMENTAION

   Message:
   AUDIT (salv_directory): GRANTED modification of security out-of-service ADDED_INFO switch found already on

   S:	$access_audit

   T:	Salvaging

   M:	At a previous time the system set the branch security out-of-service
   because of an AIM error.

   A:	$inform_ssa


   Message:
   AUDIT (salv_directory): GRANTED modification of security out-of-service ADDED_INFO

   S:	$access_audit

   T:	Salvaging

   M:	The directory has a different access class from its parent and
   it has no quota.  This is an AIM violation.

   A:	$inform_ssa

   Message:
   salv_directory: Changed max length in VTOCE from LENGTH to MAXLENGTH.

   S:     $log

   T:     Salvaging

   M:     The max length of a directory was changed to the system default.

   A:     $ignore


   Message:
   salv_directory: ERROR_MESSAGE. Changing max length in VTOCE.

   S:     $log

   T:     Salvaging

   M:     An error occurred while changing a dir's max length.

   A:     $inform


   Message:
   salv_directory: ERROR_MESSAGE. truncate_vtoce to length LENGTH failed.

   S:     $log

   T:     Salvaging

   M:     An error occurred while truncating a directory.

   A:     $inform


   Message:
   salv_directory: Branch is security out-of-service: BRANCH_NAME

   S:     $log

   T:     Salvaging

   M:     A branch is security out-of-service.

   A:     $inform_ssa


   Message:
   salv_directory: ERROR_MESSAGE. Could not read VTOCE attributes.

   S:     $log

   T:     Salvaging

   M:     An error occurred while reading the VTOCE.

   A:     $inform_sa


   Message:
   salv_directory: Upgraded dir set security out-of-service due to no quota.

   S:     $log

   T:     Salvaging

   M:     An upgraded directory was set soos due to not having terminal quota.

   A:     $inform_ssa


   Message:
   salv_directory: Invalid call to error message printer.

   S:     $log

   T:     Salvaging

   M:     An programming error resulted in an invalid call to the error
   message printing procedure.

   A:     $inform

   END MESSAGE DOCUMENTATION */

     end salv_directory;




		    salv_dump_copy.pl1              11/11/89  1059.4rew 11/11/89  0805.2       41130



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


salv_dump_copy: proc (a_block_p, a_block_len, a_name);

/* *	SALV_DUMP_COPY
   *
   *	Procedure to copy data into a segment in >dumps, with condition handlers
   *	to deal with the unexpected. It is the callers responsibility to ensure that
   *	the this will not cause a mylock error on >dumps.
   *
   *	Created, from on_line_salvager, 10 August 1981, W. Olin Sibert
   */

dcl  a_block_p ptr parameter; 			/* ptr to block. */
dcl  a_block_len fixed bin parameter;			/* Number of words in block. */
dcl  a_name char (*) parameter;			/* name of segment in >dumps */

dcl  block_p pointer;
dcl  block_len fixed bin;
dcl  name char (32);
dcl  rings (3) fixed bin (3);
dcl  seg_p ptr;					/* Ptr. to segment in >dumps */
dcl  code fixed bin (35);
dcl  copy (block_len) bit (36) aligned based;		/* Used to copy block. */

dcl 1 del_acl aligned,
    2 user char (32),
    2 err_code fixed bin (35);

dcl  pds$process_group_id char (32) external static;

dcl  append$branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin (3), char (*),
     fixed bin (1), fixed bin (1), fixed bin (24), fixed bin (35));
dcl  asd_$del_sentries entry (char (*), char (*), ptr, fixed bin, fixed bin (35));
dcl  delentry$dseg entry (pointer, fixed bin (35));
dcl  initiate$priv_init entry (char (*) aligned, char (*) aligned, char (*) aligned,
     fixed bin (1), fixed bin (2), ptr, fixed bin (35));
dcl  syserr entry options (variable);
dcl  syserr$error_code entry options (variable);

dcl  WHOAMI char (32) internal static options (constant) init ("salv_dump_copy");

dcl  seg_fault_error condition;

dcl (addr, null, ptr) builtin;

/*  */

	block_p = a_block_p;
	block_len = a_block_len;
	name = a_name;

	rings (*) = 7;
	call append$branchx (">dumps", name, RW_ACCESS_BIN, rings, pds$process_group_id, 0, 0, 36 * block_len, code);
	if code ^= 0 then do;
	     call syserr$error_code (LOG, code, "^a: Appending ^a to dump directory.", WHOAMI, name);
	     return;
	     end;

	call initiate$priv_init (">dumps", (name), "", 0, 0, seg_p, code); /* get a pointer to the new seg */
	if seg_p = null then do;
	     call syserr$error_code (LOG, code, "^a: Intiating ^a.", WHOAMI, name);
	     return;
	     end;

	on condition (seg_fault_error) begin;
	     call syserr (LOG, "^a: seg_fault_error copying ^p into >dumps>^a", WHOAMI, block_p, name);
	     call delentry$dseg (seg_p, (0));		/* Get rid of it to avoid embarassment later */
	     goto DUMP_FINISHED;
	     end;

	seg_p -> copy = block_p -> copy;		/* copy the information */

	del_acl.user = pds$process_group_id;		/* set to delete user */
	call asd_$del_sentries (">dumps", name, addr (del_acl), 1, (0));

DUMP_FINISHED:
	return;

%page; %include syserr_constants;
%page; %include access_mode_values;

/*  */

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   salv_dump_copy: Appending SEGNAME to dump directory ERRORMESSAGE

   S: $log

   T: $run

   M: The directory salvager could not append a copy of a directory being
   salvaged or the stack at the time of salvage to the system dump directory.

   A: Check the ACL on the system dump directory, and site exec_coms which set it.
   $notify_sa

   Message:
   salv_dump_copy: Initiating SEGNAME ERRORMESSAGE

   S: $log

   T: $run

   M: The directory salvager could not initiate a copy of a
   ring 0 stack or directory being salvaged in the system dump directory.
   There may be ACL problems in the system dump directory.

   A: $notify_sa

   Message:
   salv_dump_copy: seg_fault_error copying PPPP into >dumps>SEGNAME

   S: $log

   T: $run

   M: The directory salvager attempted to create a copy of a segment in >dumps,
   but encountered a seg_fault_error condition
   while attempting to copy it. This is probably caused by quota problems in
   >dumps or insufficient space on the logical volume.

   A: $notify_sa

   END MESSAGE DOCUMENTATION */

	end salv_dump_copy;




		    salv_err_msg.pl1                11/11/89  1059.4rew 11/11/89  0808.0       47385



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(76-01-01,Kobziar), approve(), audit(), install():
     Pre-hcom comments.
     written 1-76 by Kobziar
     Rewritten 7/77 by S.E. Barr
     Modified 16 August, 1981, W. Olin Sibert, to eliminate use of
        online_salvager_output
     Modified July 1982 by J. Bongiovanni to eliminate salv_data$console
     Modified 831111 BIM to not drop 4,5 on the floor
  2) change(86-11-11,Lippard), approve(86-12-08,MCR7590),
     audit(87-04-16,Dickson), install(87-04-28,MR12.1-1028):
     Stop going OOSB when given a standard (error_table_) error code.
                                                   END HISTORY COMMENTS */


/* format: style4 */

salv_err_msg: proc (a_severity);


/* * Logs messages in the syserr log. Translates salvager severity to
   * syserr severity.
   *
   *    Salv  Sys   Interpretation
   *    ---------------------------
   *	1 CRASH    After printing the message on the operator's console, crash the system.
   *	2 ANNOUNCE Print message on salvager output and operators's console.
   *	4,5 LOG    Print on console if log is full, else just log.
   *	6 JUST_LOG As the man said ...
*/

/* PARAMETERS */

dcl  a_severity fixed bin;				/* severity level for message */
dcl  a_path char (*);				/* pathname assoc. with message */
dcl  arg_msg_ptr ptr unal;				/* Multics standard error code */

/* AUTOMATIC */

dcl  severity fixed bin;				/* copy of severity level */
dcl  syserr_severity fixed bin;			/* correct syserr message code */
dcl  code fixed bin (35);
dcl  have_code bit (1) aligned;			/* ON, for code entry point. */
dcl  path char (170);				/* <path>:<new_line> */
dcl  line_len fixed bin;				/* number of characters in message */
dcl  line char (303);				/* 168 (path) +2 (:nl) +132 (message) +1 (nl) */
dcl  start fixed bin;				/* number of first argument for formline_ */
dcl  msg_ptr ptr unal;				/* packed ptr into error table */
dcl  msg_len fixed bin;				/* number of characters remaining in line for message. */

dcl  (addr, length, substr, rtrim, min, ptr, rel, unspec) builtin;

dcl  1 et aligned based (msg_ptr),			/* An error table message */
       2 len fixed bin (8) unal,			/* Length of the message */
       2 msg char (et.len) unal;			/* The message */

/* EXTERNAL */

dcl  error_table_$ fixed bin ext;
dcl  syserr entry options (variable);
dcl  formline_ entry (fixed bin, fixed bin, ptr, fixed bin, fixed bin);
dcl  utility_print entry (fixed bin, char (*));

/* CONSTANTS */

dcl  COLON_NEW_LINE char (2) int static options (constant) init (":
");
dcl  NEW_LINE int static options (constant) char (1) init ("
");

/* INTERNAL STATIC */

dcl  sys_last_path char (170) int static init ("");	/* Last path printed on console. */

/**/
	start = 2;
	path = "";
	have_code = "0"b;
	goto START;


path: entry (a_severity, a_path);

	start = 3;
	path = a_path;
	have_code = "0"b;
	goto START;


code: entry (a_severity, a_path, arg_msg_ptr);

	start = 4;
	path = a_path;
	have_code = (unspec (arg_msg_ptr) ^= "0"b);
	goto START;

START:

/* Format line and path */

	severity = a_severity;
	line_len = length (line);
	call formline_ (start, start + 1, addr (line), line_len, (0));

/* Get error table message. */

	if have_code then do;
	     msg_ptr = arg_msg_ptr;
	     if baseno (msg_ptr) = "007777"b3 then msg_ptr = ptr (addr (error_table_$), rel (msg_ptr));
	     msg_len = length (line) - line_len;
	     if msg_len > 0 then do;
		substr (line, line_len + 1, msg_len) = et.msg;
		line_len = line_len + et.len;
	     end;
	end;
	line_len = min (line_len + 1, length (line));	/* Make sure there is space for new-line */
	substr (line, line_len, 1) = NEW_LINE;

	if path ^= "" then path = rtrim (path) || COLON_NEW_LINE;

/* Online salvage already has pathname */

	if severity < 0 then severity = 0;
	if severity > 6 then severity = 6;
	if salv_data$rpv then if severity < 4 then severity = 2;

	go to SALV_SEVERITY (severity);

SALV_SEVERITY (1):
	syserr_severity = CRASH;
	go to SYSERR;
SALV_SEVERITY (3):					/* supposedly unused */
SALV_SEVERITY (0):
SALV_SEVERITY (2):
	syserr_severity = ANNOUNCE;
	go to SYSERR;
SALV_SEVERITY (4):
SALV_SEVERITY (5):
	syserr_severity = LOG;
	go to SYSERR;
SALV_SEVERITY (6):
	syserr_severity = JUST_LOG;

SYSERR:
	if path ^= "" & path ^= sys_last_path then do;
	     call syserr (syserr_severity, "^a^a", path, substr (line, 1, line_len - 1));
	     sys_last_path = path;
	end;
	else call syserr (syserr_severity, substr (line, 1, line_len - 1));

	return;

%page; %include salv_data;
%page; %include syserr_constants;

     end salv_err_msg;




		    salvage_pv.pl1                  11/11/89  1059.4rew 11/11/89  0806.0      326907



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1989   *
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/*



   salvage_pv (pvtx, code);


   INPUT ASSUMPTIONS.

   1. There is a segment header for each of the following segments:

   salv_abs_seg_00 to n, where n is the no. of 256k segs required to
   to linearly address the entire vtoc.
   pv_salv_seg

   2. This procedure can be executed by any process. However a given physical
   volume can be salvaged by only one process at a time.

   3. The physical volume being salvaged is not available for normal vtoc_man
   operations.

   4. The following items are supposed to have been checked prior to calling
   this procedure and are assumed to have a correct value:

   label.vol_size
   label.vtoc_size

   vol_map.n_rec
   vol_map.base_add
   vol_map.bit_map_n_words

   vtoc_header.n_vtoce

   pvte.being_salvaged = 0
   pvte.vtoc_segno     = 0
   pvte.vtoc_size      = 0

   Written by Andre Bensoussan 1976
   Extensively modified by Andrew Kobziar, who integrated it with rest of salvager, 1976.
   5/13/76 by Greenberg for seg-by-seg PD flusher.
   6/25/76 by Greenberg for last n bits of bit map being zero.
   11/1/76 by Greenberg for fixing disk_rebuild-created problems,
   pc$truncate_deposit_all, summary report.
   03/22/81, W. Olin Sibert, for ADP PTW formats
   03/07/82, J. Bongiovanni, for new PVTE, validate vtoce.trp, vtoce.trp_time,
	   convert_vtoc, VTOC map
   06/15/82, J. Bongiovanni, to free per-bootload VTOCEs and print summary of 
             damaged segments
   10/26/82, J. Bongiovanni, for fm_damaged

*/


/****^  HISTORY COMMENTS:
  1) change(86-01-16,Fawcett), approve(86-04-11,MCR7383),
     audit(86-06-17,Beattie), install(86-07-17,MR12.0-1097):
     Add support for 512_WORD_IO devices, 3380 and 3390.
  2) change(89-08-14,Farley), approve(89-09-18,MCR8134),
     audit(89-09-21,WAAnderson), install(89-09-29,MR12.3-1075):
     Corrected the VTOCE.records adjustment in the RESOLVE_CONFLICT procedure.
     It was using (vtoce.records - 1), which was causing an incorrect records
     setting, resulting in et$invalid_vtoce errors.
                                                   END HISTORY COMMENTS */




salvage_pv : procedure (a_pvtx, a_code);


dcl (a_pvtx, pvtx) fixed bin;				/* Physical volume table index of vol to be salvaged */
dcl (a_code, code) fixed bin (35);			/* Error code */

dcl  no_free_aste_err fixed bin (35) internal static init (1);
dcl  get_vtocep_err fixed bin (35) internal static init (3);

dcl  table1p ptr;					/* Pointer to table1, i.e. bit_table */
dcl  table2p ptr;					/* Pointer to table2, i.e. vtocx_table */
dcl  table3p ptr;					/* Pointer to table3, i.e. new_bit_map */
dcl  table4p ptr;					/* Pointer to incremental dump table */
dcl  table5p ptr;					/* Pointer to consolidated dump table */
dcl  table6p ptr;					/* Pointer to VTOC map */

dcl  s_ptr ptr;

dcl  r0 fixed bin;					/* First record number used for paging on this volume */
dcl  r1 fixed bin;					/* Last record number used for paging on this volume */
dcl  ptp pointer;					/* Pointer to page table in aste */
dcl  vtocx fixed bin;				/* Index of the vtoc entry being processed */
dcl  pvid bit (36) aligned;				/* ID of volume being processed */
dcl  n_used_rec fixed bin;				/* Number of records used */
dcl  n_free_vtoce fixed bin;				/* Number of free vtoc entries */
dcl  max_n_vtoc_seg fixed bin internal static init (4);
dcl  damaged_count fixed bin;				/* Count damaged segments */
dcl  damaged_by_me fixed bin;				/* Count of segments damaged by this salvage */
dcl  salvage_call bit (1);				/* TRUE is called for salvage */
dcl  previous_damaged_sw bit (1);			/* TRUE if vtoce.damaged on at top of loop */
dcl  complained bit (1);				/* TRUE if set damaged and wrote message */
dcl  not_enabled_sw bit (1) aligned;			/* dumper threading operational? */
dcl  free_count fixed bin;				/* count of free vtoces added to consolidated list */
dcl  comp_time fixed bin (71);			/* fb time */
dcl  hdr_time (2) bit (36) aligned;			/* bit time in label */
dcl  root_pack bit (1) aligned;			/* set to indicate directories ok on this pack */
dcl  salv_mode char (32) var;				/* mode of volsalv */
dcl  p99 pic "99";
dcl  curtime bit (36);				/* Current file system time */
dcl  trp_bad bit (1) aligned;				/* Flag for trp validation */
	   

dcl 1 table1 based (table1p) aligned,
    2 bit_table (0 : label.vol_size - 1) bit (1) unaligned;

dcl 1 table2 based (table2p) aligned,
    2 vtocx_table (0 : label.vol_size - 1) fixed bin (17) unaligned;

dcl 1 table3 based (table3p) aligned,
    2 new_map (1 : vol_map.map_n_words) bit (36) aligned;

dcl 1 table4 based (table4p) aligned,
    2 incr_map (0 : vtoc_header.n_vtoce -1) bit (1) unaligned;

dcl 1 table5 based (table5p) aligned,
    2 cons_map (0 : vtoc_header.n_vtoce -1) bit (1) unaligned;

dcl  1 salv_vtoc_map aligned based (table6p) like vtoc_map;

dcl  sst$astl bit (36) aligned external;
dcl  sst$astsize fixed bin external;
dcl  sst$damaged_ct fixed bin external;
dcl  1 sst$level (0 : 3) aligned external,
     2 ausedp bit (18) unaligned,
     2 no_aste bit (18) unaligned;
dcl  sst$pts (0 : 3) fixed bin external;
dcl  sst$root_pvtx fixed bin external;

dcl  pds$processid ext bit (36) aligned;

dcl  dseg$ (0 : 1023) fixed bin (71) external static;
dcl  pv_salv_seg$ ext;

dcl  dir_dump$vtoce ext entry (ptr);
dcl  get_aste entry (fixed bin) returns (ptr);
dcl  get_ptrs_$given_astep entry (ptr) returns (fixed bin (71) aligned);
dcl  get_ptrs_$given_segno entry (fixed bin) returns (ptr);
dcl  get_pvtx$hold_pvtx entry (bit (36) aligned, fixed bin, fixed bin (35));
dcl  get_pvtx$release_pvtx entry (bit (36) aligned, fixed bin (35));
dcl  lock$lock_ast entry;
dcl  lock$unlock_ast entry;
dcl  page$cam entry;
dcl  pc$truncate_deposit_all entry (ptr);
dcl  pc_wired$write_wait entry (ptr, fixed bin, fixed bin);
dcl  ptw_util_$make_null entry (pointer, bit (22) aligned);
dcl  put_aste entry (ptr);
dcl  salv_err_msg entry options (variable);
dcl  salv_err_msg$code entry options (variable);
dcl  syserr entry options (variable);
dcl  syserr$binary ext entry options (variable);
dcl  thread$out entry (ptr, bit (18));
dcl  vm_vio$clean_up entry (fixed bin);
dcl  vm_vio$get_vtocep entry (fixed bin, fixed bin) returns (ptr);
dcl  vm_vio$init entry (fixed bin, fixed bin (35)) returns (ptr);

dcl  cleanup condition;
dcl  (addr, addrel, baseno, bin, bit, ceil, clock, convert, divide, fixed, max, mod, null, ptr, rel, substr, unspec) builtin;


/* MAIN PROGRAM */

          salvage_call = "1"b;
	salv_mode = "Volume salvage";
	goto COMMON;

convert_vtoc:
	entry (a_pvtx, a_code);

	salvage_call = "0"b;
	salv_mode = "VTOC conversion";

COMMON:	
	pvtx = a_pvtx;
	code = 0;
	pvt_arrayp = addr (pvt$array);
	pvtep = addr (pvt_array (pvtx));
	curtime = substr (bit (bin (clock (), 71), 71), 20, 36);

	on cleanup call CLEAN_UP;

	s_ptr = vm_vio$init (pvtx, code); if code ^= 0 then goto RTN;

	labelp = ptr (s_ptr, LABEL_ADDR * 1024);
	vol_mapp = ptr (s_ptr, VOLMAP_ADDR * 1024);
	vtoc_headerp = ptr (s_ptr, DUMPER_BIT_MAP_ADDR * 1024);
	vtoc_mapp = ptr (s_ptr, VTOC_MAP_ADDR * 1024);

	pvid = label.pvid;


	call salv_err_msg (SALV_ANNOUNCE, "salvage_pv: ^a of ^a_^a, volume ^a of logical vol ^a.",
	     salv_mode, pvte.devname, (convert (p99, pvte.logical_area_number) || pvte.sv_name),
	     label.pv_name, label.lv_name);

	comp_time = clock ();

	if salvage_call then do;
	     call CHECK_LABEL_VOLMAP_HEADER (code); if code ^= 0 then goto CLEAN;
               n_used_rec = 0;
	     free_count = 0;

	     r0 = vol_map.base_add;
	     r1 = vol_map.n_rec - 1 + r0;
	end;

	damaged_count = 0;
	damaged_by_me = 0;

	call INIT_TABLES (table1p, table2p, table3p, table4p, table5p, table6p, code); if code ^= 0 then goto CLEAN;

	n_free_vtoce = 0;

	if label.volmap_version = 1
	     | label.volmap_version = 2		/* VTOC Map exists */
	     then do;
	     salv_vtoc_map.n_vtoce = vtoc_map.n_vtoce;
	     salv_vtoc_map.n_free_vtoce = vtoc_map.n_free_vtoce;
	     salv_vtoc_map.bit_map_n_words = vtoc_map.bit_map_n_words;
	     salv_vtoc_map.vtoc_last_recno = vtoc_map.vtoc_last_recno;
	end;
	else do;
	     salv_vtoc_map.n_vtoce = vtoc_header.n_vtoce;
	     salv_vtoc_map.n_free_vtoce = vtoc_header.n_free_vtoce;
	     salv_vtoc_map.bit_map_n_words
		= divide (vtoc_header.n_vtoce + 31, 32, 17);
	     salv_vtoc_map.vtoc_last_recno = vtoc_header.vtoc_last_recno;
	end;
	

	do vtocx = 0 to vtoc_header.n_vtoce - 1;

	     vtocep = vm_vio$get_vtocep (pvtx, vtocx);
	     if vtocep = null then do;
		code = get_vtocep_err;
		goto CLEAN;
	     end;


	     if vtoce.uid = "0"b then do;
		vtoce.pad_free_vtoce_chain = ""b;	/* Clean out old field */
		if vtoce_parts (1) ^= "0"b then call salv_err_msg (SALV_DEBUG,
		     "salvage_pv: vtoce ^oo free but not zero", vtocx);
		call FREE_VTOCE;
	     end;
	     else if salvage_call then do;
		complained = "0"b;			/* Only report damage if we didn't set it ourself */
		previous_damaged_sw = vtoce.damaged;
		if ^vtoce.dirsw then do;
		     if vtoce.per_process then do;
			if salv_data$debug then call salv_err_msg (SALV_DEBUG,
			     "salvage_pv: freeing ^w per process vtocx ^oo: ^a",
			     vtoce.uid, vtocx, vtoce.primary_name);
			call FREE_VTOCE;
			go to NEXT_VTOCE;
		     end;
		     else if vtoce.deciduous then do;
			if salv_data$debug then call salv_err_msg (SALV_DEBUG,
			     "salvage_pv: freeing ^w deciduous vtocx ^oo: ^a",
			     vtoce.uid, vtocx, vtoce.primary_name);
			call FREE_VTOCE;
			go to NEXT_VTOCE;
		     end;
		     else if vtoce.perm_flags.per_bootload then do;
			if salv_data$debug then call salv_err_msg (SALV_DEBUG,
			     "salvage_pv: freeing ^w per-bootload vtocx ^oo: ^a",
			     vtoce.uid, vtocx, vtoce.primary_name);
			call FREE_VTOCE;
			goto NEXT_VTOCE;
		     end;
		end;
		call CHECK_VTOCE;
		if previous_damaged_sw & ^complained
		then call salv_err_msg (SALV_DEBUG, "salvage_pv: damaged switch found on for ^w vtocx ^oo: ^a",
		     vtoce.uid, vtocx, vtoce.primary_name);
		if vtoce.damaged then do;
		     damaged_count = damaged_count + 1;
		     if ^previous_damaged_sw
			then damaged_by_me = damaged_by_me + 1;
		     if complained then do;
			segdamage.pvid = label.pvid;
			segdamage.lvid = label.lvid;
			segdamage.uid = vtoce.uid;
			segdamage.vtocx = vtocx;
			segdamage.pno = -1;
			segdamage.uid_path = vtoce.uid_path;
			call syserr$binary (SALV_LOG, addr (segdamage), SB_vtoc_salv_dam, SBL_vtoc_salv_dam,
			     "salvage_pv: setting damaged switch on ^a (^oo) on pv ^a.",
			     vtoce.primary_name, vtocx, label.pv_name);
			sst$damaged_ct = sst$damaged_ct + 1;
		     end;
		end;

	     end;
NEXT_VTOCE:
	end;

	if salvage_call
	     then do;
	     call UPDATE_VOL_MAP;
	     pvte.vol_trouble_count = 0;
	end;

	call UPDATE_VTOC_MAP;

	call FORCE_VTOC_ON_DISK;

	call UPDATE_LABEL;

	call FORCE_LABEL_ON_DISK;

	if free_count > 0 then call salv_err_msg (SALV_DEBUG, "salvage_pv: ^d free vtoces added to free list.", free_count);
	if damaged_count > 0
	     then call salv_err_msg (SALV_ANNOUNCE,
	     "salvage_pv: ^d damaged segments on volume ^a (^d damaged in this salvage)",
	     damaged_count, label.pv_name, damaged_by_me);
CLEAN:	if code = 0 then call salv_err_msg (SALV_DEBUG, "salvage_pv: ^a finished.", salv_mode);
	else call salv_err_msg$code (SALV_DEBUG, "", "salvage_pv: ^a finished with error.", code, salv_mode);
	call CLEAN_UP;

RTN:	a_code = code;

	return;

CHECK_VTOCE : proc;

dcl (records, csl, msl, i, r, conflict) fixed bin;

	     csl, records, conflict = 0;
	     msl = 256;

	     do i = 0 to msl - 1;

SAME_I:		if substr (vtoce.fm (i), 1, 1) = "1"b then goto NEXT_I; /* Null address */

		r = fixed (substr (vtoce.fm (i), 2, 17), 17);

		if r < r0 | r > r1 then
		     do;
		     call report_out_of_range;
		     vtoce.fm (i) = pv_salv_null_addr; goto NEXT_I;
		end;

		if bit_table (r) = "1"b then
		     do;
		     conflict = 1; call RESOLVE_CONFLICT (i); goto SAME_I;
		end;

		vtocx_table (r) = vtocx;
		bit_table (r) = "1"b;
		records = records + 1;
		csl = i + 1;
NEXT_I:
	     end;

	     do i = msl to 255;
		if substr (vtoce.fm (i), 1, 1) = "0"b then vtoce.fm (i) = pv_salv_null_addr;
	     end;

	     if conflict ^= 0 then do; csl = RECOMPUTE_CSL (vtocep); records = RECOMPUTE_RECORDS (vtocep); end;

	     n_used_rec = n_used_rec + records;

	     if fixed (vtoce.records, 9) ^= records then
		do;
		call report_records;
		vtoce.records = bit (fixed (records, 9));
	     end;

	     if fixed (vtoce.csl, 9) ^= csl then
		do;
		call report_csl;
		vtoce.csl = bit (fixed (csl, 9));
	     end;

	     if fixed (vtoce.msl, 9) > msl | fixed (vtoce.msl, 9) < csl then
		do;
		call report_msl;
		vtoce.msl = bit (fixed (msl, 9));
	     end;

	     trp_bad = "0"b;
	     do i = 0 to 1;
		if vtoce.trp (i) < 0 | fixed (vtoce.trp_time (i), 36) > fixed (curtime, 36)
		     then trp_bad = "1"b;
	     end;
	     if trp_bad then do;
		call report_trp;
		do i = 0 to 1;
		     vtoce.trp (i) = 0;
		     vtoce.trp_time = curtime;
		end;
	     end;

	     if vtoce.dirsw then if ^root_pack then do;
		     call salv_err_msg (SALV_DEBUG,
			"salvage_pv: dirsw turned off for vtocx ^oo: ^a", vtocx, vtoce.primary_name);
		     if salv_data$dump then call dir_dump$vtoce (vtocep);
		     vtoce.dirsw = "0"b;
		     vtoce.damaged, complained = "1"b;
		end;

	     vtoce.fm_damaged = "0"b;
	     vtoce.fm_checksum_valid = "0"b;
	     vtoce.fm_checksum = ""b;

	     if fixed (vtoce.dtm) > fixed (hdr_time (1)) then call THREAD_FOR_DUMPER (1);
	     if fixed (vtoce.dtm) > fixed (hdr_time (2)) then call THREAD_FOR_DUMPER (2);

	     return;




report_out_of_range : proc;
		call salv_err_msg (SALV_DEBUG, "salvage_pv: vtoce ^a at ^oo: page ^oo disk_addr ^oo bad",
		     vtoce.primary_name, vtocx, i, r);
		vtoce.damaged, complained = "1"b;
		return;
	     end;

report_records : proc;
		call salv_err_msg (SALV_DEBUG, "salvage_pv: vtoce ^a at ^oo: rec used changed from ^oo to ^oo",
		     vtoce.primary_name, vtocx, fixed (vtoce.records), records);
		vtoce.damaged, complained = "1"b;
		return;
	     end;

report_csl :   proc;
		call salv_err_msg (SALV_DEBUG, "salvage_pv: vtoce ^a at ^oo: cur len changed from ^oo to ^oo",
		     vtoce.primary_name, vtocx, fixed (vtoce.csl), csl);
		vtoce.damaged, complained = "1"b;
		return;
	     end;

report_msl :   proc;
		call salv_err_msg (SALV_DEBUG, "salvage_pv: vtoce ^a at ^oo: max len changed from ^oo to ^oo",
		     vtoce.primary_name, vtocx, fixed (vtoce.msl), msl);
		vtoce.damaged, complained = "1"b;
		return;
	     end;

report_trp:    proc;
	          call salv_err_msg (SALV_DEBUG, "salvage_pv: vtoce ^a at ^oo: time-record-product reset to zero",
		     vtoce.primary_name, vtocx);
		return;
	     end;

	end CHECK_VTOCE;





FREE_VTOCE : proc;

dcl  bit_no fixed bin;
dcl  word_no fixed bin;

	     if vtoce.uid ^= "0"b then free_count = free_count + 1;

	     unspec (vtoce) = "0"b;

	     n_free_vtoce = n_free_vtoce + 1;

	     word_no = divide (vtocx, 32, 17);
	     bit_no = mod (vtocx, 32);
	     bit_map_wordp = addr (salv_vtoc_map.bit_map (word_no));
	     substr (bit_map_word.bits, bit_no + 1, 1) = "1"b;

	     call THREAD_FOR_DUMPER (2);

	     return;

	end FREE_VTOCE;


THREAD_FOR_DUMPER: proc (index);

dcl  index fixed bin;

	     if not_enabled_sw then return;

	     if index = 1 then
		incr_map (vtocx) = "1"b;
	     else
	     cons_map (vtocx) = "1"b;

	     return;

	end THREAD_FOR_DUMPER;


RESOLVE_CONFLICT : proc (i);

dcl (i, I, r, VTOCX, del, DEL) fixed bin;

dcl  VTOCEP ptr;
dcl 1 VTOCE like vtoce aligned based (VTOCEP);



	     r = fixed (substr (vtoce.fm (i), 2, 17), 17);

	     VTOCX = vtocx_table (r);
	     VTOCEP = vm_vio$get_vtocep (pvtx, VTOCX);

	     do I = 0 to 255 while (VTOCE.fm (I) ^= vtoce.fm (i));
	     end;

	     if I > 255 then go to del_eq_1;;

	     DEL, del = 0;

	     if vtoce.dirsw = VTOCE.dirsw then DEL, del = 1;
	     if vtoce.dirsw & ^VTOCE.dirsw then DEL = 1;
	     if ^vtoce.dirsw & VTOCE.dirsw then del = 1;

	     if del = 1 then
del_eq_1:		do;
		call report_page_del;
		vtoce.fm (i) = pv_salv_null_addr;
	     end;

	     if DEL = 1 then
		do;
		call report_page_DEL;
		vtocx_table (r) = 0;
		bit_table (r) = "0"b;

		VTOCE.fm (I) = pv_salv_null_addr;

		if vtocep ^= VTOCEP then
		     do;
		     VTOCE.csl = bit (fixed (RECOMPUTE_CSL (VTOCEP), 9));
		     VTOCE.records = bit (fixed (fixed (VTOCE.records, 9) - 1, 9), 9);

		     n_used_rec = n_used_rec - 1;
		end;
	     end;

	     return;

report_page_del : proc;
		call salv_err_msg (SALV_DEBUG,
		     "salvage_pv: vtoce ^a at ^oo: ref to pageno ^oo at addr ^oo deleted, dirsw is ^b",
		     vtoce.primary_name, vtocx, i, r, vtoce.dirsw);
		vtoce.damaged, complained = "1"b;
		return;
	     end;

report_page_DEL : proc;
		call salv_err_msg (SALV_DEBUG,
		     "salvage_pv: vtoce ^a at ^oo: ref to pageno ^oo at addr ^oo deleted, dirsw is ^b",
		     VTOCE.primary_name, VTOCX, I, r, VTOCE.dirsw);
		if ^VTOCE.damaged & VTOCX < vtocx then do;
		     damaged_count = damaged_count + 1;
		     damaged_by_me = damaged_by_me + 1;
		end;
		if VTOCE.damaged | VTOCX > vtocx then return;
		segdamage.pvid = label.pvid;
		segdamage.lvid = label.lvid;
		segdamage.uid = VTOCE.uid;
		segdamage.vtocx = VTOCX;
		segdamage.pno = I;
		segdamage.uid_path = VTOCE.uid_path;
		call syserr$binary (SALV_LOG, addr (segdamage), SB_vtoc_salv_dam, SBL_vtoc_salv_dam,
		     "salvage_pv: setting damaged switch on ^a (^oo) on pv ^a.",
		     VTOCE.primary_name, VTOCX, label.pv_name);
		sst$damaged_ct = sst$damaged_ct + 1;
		VTOCE.damaged = "1"b;
		return;
	     end;

	end RESOLVE_CONFLICT;




RECOMPUTE_CSL : proc (vtoce_ptr) returns (fixed bin);

dcl  vtoce_ptr ptr;
dcl (i, csl) fixed bin;

	     csl = 0;
	     do i = 0 to 255; if substr (vtoce_ptr -> vtoce.fm (i), 1, 1) = "0"b then csl = i + 1;
	     end;
	     return (csl);

	end RECOMPUTE_CSL;



RECOMPUTE_RECORDS : proc (vtoce_ptr) returns (fixed bin);

dcl  vtoce_ptr ptr;
dcl (i, records) fixed bin;

	     records = 0;
	     do i = 0 to 255; if substr (vtoce_ptr -> vtoce.fm (i), 1, 1) = "0"b then records = records + 1;
	     end;
	     return (records);

	end RECOMPUTE_RECORDS;

CHECK_LABEL_VOLMAP_HEADER: proc (code);

dcl  code fixed bin (35);
dcl  rightsize fixed bin (24);


	     code = 0;

	     if label.time_last_dmp (1) = 0 then not_enabled_sw = "1"b;
	     else do;
		if comp_time < max (label.time_mounted, label.time_map_updated,
		label.time_unmounted, label.time_salvaged, label.time_of_boot) then do;
		     call salv_err_msg (SALV_ANNOUNCE,
			"salvage_pv: Label times in advance of clock. The clock may be wrong.");
		end;
	     end;

	     hdr_time (1) = substr(bit (fixed (label.time_last_dmp (1), 52), 52),1,36);
	     hdr_time (2) = substr(bit (fixed (label.time_last_dmp (2), 52), 52),1,36);

	     root_pack = (label.lv_name = "root");

	     rightsize = ceil (vol_map.n_rec/32);
	     if vol_map.bit_map_n_words ^= rightsize then do;
		call salv_err_msg (SALV_DEBUG,
		     "salvage_pv: Bit map size is ^d. (^oo) words, s/b ^d. (^oo), changing to latter.",
		     vol_map.bit_map_n_words, vol_map.bit_map_n_words, rightsize, rightsize);
		vol_map.bit_map_n_words = rightsize;
	     end;					/* COULD BE MAKING MISTAKE BY MAKING LARGER, OR n_rec MIGHT BE
						   WRONG. MORE POWERFUL HEURISTIC NEEDED. FIXES ERRORS CAUSED
						   BY 4.1 disk_rebuild. */



	     return;

	end CHECK_LABEL_VOLMAP_HEADER;



UPDATE_VOL_MAP : proc;

dcl 1 old_map (vol_map.bit_map_n_words) based (addr (vol_map.bit_map)) aligned,
    2 pad1 bit (1) unaligned,
    2 bits bit (32) unaligned,
    2 pad2 bit (3) unaligned;

dcl 1 new_map (vol_map.bit_map_n_words) based (table3p) aligned like old_map;

dcl  bit_table_map (1000) bit (32) based (addr (bit_table (r0))) unaligned;

dcl  w fixed bin;
dcl  j fixed bin;
dcl  n_free_rec fixed bin;



	     unspec (new_map) = "0"b;

	     do w = 1 to vol_map.bit_map_n_words;
		new_map (w).bits = ^ bit_table_map (w);
	     end;

	     j = mod (vol_map.n_rec, 32);
	     if j ^= 0 then substr (new_map (w - 1).bits, j + 1) = "0"b;

	     if unspec (old_map) ^= unspec (new_map) then
		do;
		call report_bit_map_changed;
		unspec (old_map) = unspec (new_map);
	     end;

	     n_free_rec = vol_map.n_rec - n_used_rec;

	     if vol_map.n_free_rec ^= n_free_rec then
		do;
		call report_n_free_rec_changed;
		vol_map.n_free_rec = n_free_rec;
	     end;
	     return;


report_bit_map_changed : proc;
		call salv_err_msg (SALV_DEBUG, "salvage_pv: map of assigned addresses changed");
		return;
	     end;

report_n_free_rec_changed : proc;
		call salv_err_msg (SALV_DEBUG, "salvage_pv: no. of free recs changed from ^d to ^d",
		     vol_map.n_free_rec, n_free_rec);
		return;
	     end;

	end UPDATE_VOL_MAP;

UPDATE_VTOC_MAP : proc;
	     
	     if (salv_vtoc_map.n_free_vtoce ^= n_free_vtoce) & salvage_call
		then call report_n_free_vtoce;
	     salv_vtoc_map.n_free_vtoce = n_free_vtoce;
	     
	     unspec (vtoc_map) = unspec (salv_vtoc_map);

	     return;


report_n_free_vtoce : proc;
		call salv_err_msg (SALV_DEBUG, "salvage_pv: no. of free vtoces changed from ^d to ^d",
		     salv_vtoc_map.n_free_vtoce, n_free_vtoce);
		return;
	     end;

	end UPDATE_VTOC_MAP;







FORCE_VTOC_ON_DISK : proc;

dcl  i fixed bin;


	     do i = 1 to max_n_vtoc_seg - 1;
		astep = get_ptrs_$given_segno (fixed (baseno (s_ptr)) + i);
		if astep ^= null then call pc_wired$write_wait (astep, 0, -1);
	     end;

	     return;

	end FORCE_VTOC_ON_DISK;

UPDATE_LABEL : proc;

	     label.time_map_updated = comp_time;
	     label.time_salvaged = comp_time;
						/* copy dump maps back into label */

	     label.vol_trouble_count = 0;		/* Either salvage or conversion, OK in either case */

	     if label.volmap_version ^= 1 then do;	/* Converted VTOC */
		if label.volmap_version ^= 2		/* From pre-MR10 */
		     then do;
		     old_labelp = labelp;
		     label.time_unmounted = old_label.time_unmounted;
		end;
		label.volmap_version = 1;		/* Force salvage on pre-MR10 system */

	     end;

	     return;

	end UPDATE_LABEL;







FORCE_LABEL_ON_DISK : proc;


	     astep = get_ptrs_$given_segno (fixed (baseno (s_ptr)));

	     if astep ^= null then call pc_wired$write_wait (astep, LABEL_ADDR, 1);

	     return;

	end FORCE_LABEL_ON_DISK;

CLEAN_UP : proc;


dcl segno fixed bin;


	     segno = fixed (baseno (addr (pv_salv_seg$)), 18);

	     astep = get_ptrs_$given_segno (segno);

	     if astep ^= null then
		do;

		dseg$ (segno) = 0;
		call page$cam;

		call pc$truncate_deposit_all (astep);
		if aste.usedf then call get_pvtx$release_pvtx ((pvt_array.pvid (aste.pvtx)), (aste.pvtx));
		if sst$astl ^= pds$processid then call lock$lock_ast;
		call put_aste (astep);
		call lock$unlock_ast;


	     end;

	     call vm_vio$clean_up (pvtx);		/* this releases printer and abs segs */

	     return;

	end CLEAN_UP;

INIT_TABLES : proc (table1p, table2p, table3p, table4p, table5p, table6p, code);

dcl  table1p ptr;
dcl  table2p ptr;
dcl  table3p ptr;
dcl  table4p ptr;
dcl  table5p ptr;
dcl  table6p ptr;
dcl  code fixed bin (35);

dcl 1 pv_salv_seg based (addr (pv_salv_seg$)) aligned,

    2 table1,
      3 bit_table (0 : label.vol_size - 1) bit (1) unaligned,

    2 table2,
      3 vtocx_table (0 : label.vol_size - 1) fixed bin (17) unaligned,

    2 table3,
      3 new_map (1 : vol_map.bit_map_n_words) bit (36) aligned,

    2 table4,
      3 incr_map (0 : vtoc_header.n_vtoce -1) bit (1) unaligned,

    2 table5,
      3 cons_map (0 : vtoc_header.n_vtoce -1) bit (1) unaligned,

    2 table6 aligned like vtoc_map,

    2 end bit (36) aligned;

dcl  segno fixed bin,				/* segno assigned to this segment  */
     pvtx fixed bin,				/* PVT index for this segment  */
     msl fixed bin;					/* number of pages for this segment  */

dcl (i, pts, ptsi) fixed bin;

dcl  tsdw fixed bin (71);


	     code = 0;

	     segno = fixed (baseno (addr (pv_salv_seg$)), 18);
	     pvtx = sst$root_pvtx;
	     msl = divide (fixed (rel (addr (pv_salv_seg.end)), 18), 1024, 17, 0) + 1;


/* ALLOCATE AN ASTE OF THE APPROPRIATE SIZE */

	     call lock$lock_ast;

	     astep = get_aste (msl);			/* Get an ASTE with the appropriate size PT */

	     if astep = null then
		do;
		call lock$unlock_ast;
		code = no_free_aste_err;
		call syserr (ANNOUNCE, "salvage_pv: INIT_TABLES: aste pool ^oo too small", msl);
		return;
	     end;

	     ptsi = fixed (aste.ptsi);
	     pts = sst$pts (ptsi);


/* ZERO THE ASTE  */

	     astep -> aste_part.two = "0"b;		/* Zero the rest of the ASTE except ptsi and marker */


/* INITIALIZE THE PAGE TABLE WITH NULL ADDRESSES AND PAGE FAULT BITS */

	     ptp = addrel (astep, sst$astsize);		/* get a pointer to the page table */

	     do i = 0 to pts - 1;
		call ptw_util_$make_null (addrel (ptp, i), fill_page_table_null_addr); /* Make up remaining PTWS */
	     end;


/* INITIALIZE THE ASTE */

	     astep -> aste.vtocx = -1;		/* show there is no VTOCE for the segment */
	     astep -> aste.dnzp = "1"b;
	     astep -> aste.nqsw = "1"b;		/* turn on no quota switch */
	     astep -> aste.strp = bit (fixed (segno, 18), 18); /* store segment number in AST */
	     astep -> aste.msl = bit (fixed (msl, 9), 9); /* set the max length */
	     astep -> aste.pvtx = pvtx;		/* store the root physical volume table index */


/* THE CLEAN_UP OPERATION WILL DEPEND ON THE ORDER IN WHICH THE NEXT ACTIONS ARE PERFORMED */

	     tsdw = get_ptrs_$given_astep (astep);	/* Get initial  SDW. */
	     dseg$ (segno) = tsdw;			/* store temp SDW in the descriptor segment */
	     call page$cam;


	     call get_pvtx$hold_pvtx ((pvt_array.pvid (pvtx)), pvtx, (0));	/* Hold the RPV */
	     astep -> aste.usedf = "1"b;		/* mark it as being used - as late as possible */

	     call thread$out (astep, sst$level (ptsi).ausedp); /* thread the entry out of the used list */

	     call lock$unlock_ast;


/* INITIALIZE POINTERS TO TABLES */

	     table1p = addr (pv_salv_seg.table1);
	     table2p = addr (pv_salv_seg.table2);
	     table3p = addr (pv_salv_seg.table3);
	     table4p = addr (pv_salv_seg.table4);
	     table5p = addr (pv_salv_seg.table5);
	     table6p = addr (pv_salv_seg.table6);

	     return;

	end INIT_TABLES;

%page; %include aste;
%page; %include disk_pack;
%page; %include fs_vol_label;
%page; %include null_addresses;
%page; %include old_fs_vol_label;
%page; %include pvte;
%page; %include salv_data;
%page; %include salvager_severities;
%page; %include segdamage_msg;
%page; %include syserr_binary_def;
%page; %include syserr_constants;
%page; %include vol_map;
%page; %include vtoc_header;
%page; %include vtoc_map;
%page; %include vtoce;

/*  */
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   salvage_pv: INIT_TABLES: aste pool WWWo too small.

   S:	$info

   T:	$run

   M:	The physical volume salvager was unable to
   obtain a temporary AST entry for segment requiring
   WWWo ptws. No salvaging was done.

   A:	Shut down,
   manually correct the SST card,
   and reboot.
   Then salvage all volumes,
   since the indicator that volumes need salvaging
   may have been lost.

   Message:
   salvage_pv: Volume salvage of dskX_NN{s}, volume PVNAME of logical vol LVNAME.

   S:	$salvout

   T:	$salvt

   M:	This message is printed when volume salvaging begins.

   A:	$ignore

   Message:
   salvage_pv: VTOC Conversion of dskX_NN{s}, volume PVNAME of logical vol LVNAME.

   S:	$salvout

   T:	$salvt

   M:	This message is printed when a pre-MR10 disk pack is first
   mounted on an MR10 or later system. The equivalent of a salvage
   is being done to create the VTOC Map, which did not exist prior
   to MR10.

   A:	$ignore


   Message:
   salvage_pv: Bit map size is DD. (WWo) words, s/b EE. (FFo), changing to latter.

   S:	$salvout

   T:	$salvt

   M:	The bit map size in the volume label was incorrect and has been corrected.

   A:	$ignore


   Message:
   salvage_pv: Label times in advance of clock. The clock may be wrong.

   S:	$salvout

   T:	$salvt

   M:	The label of the volume being salvaged
   contains one or more clock readings in advance of the current clock.
   Salvaging will proceed.
   The times are not corrected.
   If there is reason to believe that the system clock is incorrect,
   shut the system down as soon as possible and take steps to recover
   that part of the hierarchy which may have been contaminated with bad
   clock values.

   A:	$ignore


   Message:
   salvage_pv: NN free vtoces added to free list.

   S:	$salvout

   T:	$salvt

   M:	NN free VTOC entries
   were found while salvaging and added to the list of free VTOC entries.
   This is a normal message.

   A:	$ignore


   Message:
   salvage_pv: damaged switch found on for UUUU vtocx XXXo: NAME

   S:	$salvout

   T:	$salvt

   M:	The segment originally named NAME
   with unique ID UUUU at vtoc index XXXo
   was found to have its damaged switch on.
   The damaged switch can be set during the running of the system
   if page control encounters an I/O error.
   Damaged segments cannot be used until the damaged switch is reset.

   A:	$ignore


   Message:
   salvage_pv: dirsw turned off for vtocx XXXo: NAME

   S:	$salvout

   T:	$salvt

   M:	The segment originally named NAME
   at vtoc index XXXo
   has had its directory switch turned off.

   A:	$ignore


   Message:
   salvage_pv: freeing UUUU deciduous vtocx XXXo: NAME

   S:	$salvout

   T:	$salvt

   M:	The segment originally named NAME
   with unique ID UUUU
   at vtoc index XXXo
   was deciduous, and has been deleted from the RPV.
   This is debugging output
   printed for system programmers
   if a SALV DEBG card is supplied.

   A:	$ignore


   Message:
   salvage_pv: freeing UUUU per-bootload vtocx XXXo: NAME

   S:     $salvout

   T:	$salvt

   M:	The segment originally named NAME with unique ID UUU
   at vtoc index XXXo was per-bootload (inferior to a prior >sl1),
   and has been deleted. This is debugging output printed for system 
   programmers if a SALV DEBG card is supplied.

   A:  $ignore


   Message:
   salvage_pv: freeing UUUU per process vtocx XXXo: NAME

   S:	$salvout

   T:	$salvt

   M:	The segment originally named NAME
   with unique ID UUUU
   at vtoc index XXXo
   was per-process
   and has been deleted.
   This is debugging output
   printed for system programmers
   if a SALV DEBG card is used.

   A:	$ignore


   Message:
   salvage_pv: map of assigned addresses changed.

   S:	$salvout

   T:	$salvt

   M:	If any corrections were made to the
   map on the volume
   which shows which addresses are free and which are in use,
   this message is printed.
   If the volume was not properly shut down, this message is to be expected.

   A:	$ignore


   Message:
   salvage_pv: no. of free recs changed from OLD to NEW (dec).

   S:	$salvout

   T:	$salvt

   M:	If the number of free records
   in the volume label
   is changed by a volume salvage,
   this message is printed.
   If the volume was not properly shut down, this message is to be expected.

   A:	$ignore


   Message:
   salvage_pv: no. of free vtoces changed from OLD to NEW (dec).

   S:	$salvout

   T:	$salvt

   M:	If the number of
   free VTOC entries
   in the volume label
   is changed by a volume salvage,
   this message is printed.

   A:	$ignore



   Message:
   salvage_pv: vtoce NAME at XXXo: cur len changed from OLD to NEW (octal)

   S:	$salvout

   T:	$salvt

   M:	The segment originally named NAME
   at vtoc index XXXo
   had a current length which did not agree
   with the file map.
   The current length was corrected
   and the damaged switch set on the segment.
   This message usually indicates that a segment was damaged before a crash
   by failure to write out its pages to disk before the crash.
   The segment may have to be recovered.

   A:	$ignore


   Message:
   salvage_pv: vtoce NAME at XXXo: max len changed from OLD to NEW (octal).

   S:	$salvout

   T:	$salvt

   M:	The segment originally named NAME
   at vtoc index XXXo
   had a maximum segment length which did not agree
   with the file map
   or was less than the current length.
   The maximum length was corrected
   and the damaged switch set.

   A:	$ignore


   Message:
   salvage_pv: vtoce NAME at XXXo: time-record-product reset to zero.

   S:     $salvout

   T:     $salvt

   M:     The segment originally named NAME at vtoc index XXXo
   had an invalid value for one of the time-record-product fields.
   All time-record-product fields have been reset to zero.

   A:     $ignore


   Message:
   salvage_pv: vtoce NAME at XXXo: page PPPo disk_addr DDDDo bad.

   S:	$salvout

   T:	$salvt

   M:	The segment originally named NAME
   at vtoc index XXXo
   had an invalid disk address DDDDo for page PPPo.
   The address is nulled,
   causing a page of zeroes,
   and the damaged switch set.

   A:	$ignore


   Message:
   salvage_pv: vtoce NAME at XXXo: rec used changed from OLD to NEW (octal).

   S:	$salvout

   T:	$salvt

   M:	The segment originally named NAME
   at vtoc index XXXo
   had a records used which
   did not agree with the file map.
   The records used field was corrected
   and the damaged switch set.
   This message usually indicates that a segment was damaged before a
   crash by failure to write out its pages to disk before the crash.
   The segment may have to be recovered.

   A:	$ignore


   Message:
   salvage_pv: vtoce NAME at XXXo: ref to pageno PPo at addr DDDDo deleted, dirsw is X.

   S:	$salvout

   T:	$salvt

   M:	The segment originally named NAME
   at vtoc index XXXo
   had a reused address conflict with another segment.
   The page reference
   was determined to be incorrect,
   and a null address placed in the segment's file map,
   causing a page of zeroes,
   and the damaged switch set.
   This message may be symptomatic of disk or other hardware problems.

   A:	$ignore


   Message:
   salvage_pv: vtoce XXXo free but not zero.

   S:	$salvout

   T:	$salvt

   M:	The VTOC entry with index XXXo
   was marked free but was not all zero.
   It was zeroed and made free.

   A:	$ignore

   Message:
   salvage_pv: setting damaged switch on PRIMARYNAME (VTOCXo) on pv PVNAME.

   S: $log

   T: $salvt

   M: The volume salvager has discovered possible damage to a segment and has
   turned on the damaged switch.

   A: $ignore
   This message is logged in order to trigger automatic processing of damaged
   segments.


   Message:
   salvage_pv: VTOC conversion finished.

   S: $salvout

   T: $salvt

   M: VTOC conversion finished.

   A: $ignore


   Message:
   salvage_pv: VTOC conversion finished with errors.

   S: $salvout

   T: $salvt

   M: VTOC conversion finished with errors.

   A: $inform


   Message:
   salvage_pv: Volume salvage finished.

   S: $salvout

   T: $salvt

   M: Volume salvage finished.

   A: $ignore


   Message:
   salvage_pv: Volume salvage finished with errors.

   S: $salvout

   T: $salvt

   M: Volume salvage finished with errors.

   A: $inform


   Message:
   salvage_pv: DDD damaged segments on volume PVNAME (NNN damaged in this salvage).

   S: $info

   T: $salvt

   M: DDD damaged segments were found on the volume PVNAME, which has
   just been volume-salvaged. The damaged switch was set for NNN of these
   segments during this volume salvage. The  damaged switch  for the 
   other segments had been set prior to the salvage.

   A: Inspect the syserr and Answering Service log to identify
   damaged segments.  Prepare to recover them if necessary.



   END MESSAGE DOCUMENTATION */


     end salvage_pv;




		    salvager.pl1                    11/11/89  1059.4rew 11/11/89  0806.0       57159



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/* Main Program for the Multics Salvager.
   5/23/69 - Noel I. Morris		 */
/* last modified by Kobziar on 5/1/74 to set cur_length in dummy root branch */
/* Extensively modified by Andrew M. Kobziar for NSS, with minor changes by Greenberg */
/* Set sons lvid in dummy root branch, 07/26/76 BSG */
/* Modified 9/76 by S. Barr for variable size hash tables. */
/* Modified 3/77 by S.E. Barr to add information to the dummy branch for the root. */
/* Rewritten 8/77 by S.E. Barr for invoking salvaging from ring 4. */
/* Rewritten February 1982 by C. Hornig for new salvaging strategy. */
/* Modified March 1982 by J. Bongiovanni to add convert_vtoc entry */
/* Modified July 1982 by J. Bongiovanni to eliminate salv_data$console */

salvager:
     procedure;

dcl  arg_salv_opt_bits bit (36) aligned parameter;
dcl  arg_code fixed bin (35) parameter;
dcl  a_info_p ptr parameter;				/* online:  ptr to salv_args structure to fill. */
dcl  a_pvtx fixed bin parameter;
dcl  a_path char (*) parameter;

dcl  ec fixed bin (35);
dcl  start_time fixed bin (71);
dcl  i fixed bin;
dcl  update_vtoce bit (1) aligned;			/* ON, Update perm. info. in VTOC entry during dir salv. */
dcl  delete_connection_failure_flag bit (1) aligned;	/* ON, Delete Branches with no VTOCEs */
dcl  rebuild bit (1) aligned;				/* ON, to force rebuild. */
dcl  salv_info_p ptr;				/* ptr to salv argument structure. */

dcl  1 salv_info aligned like salv_args;
dcl  (addr, fixed, ptr, bit, hbound, rel, null, divide, unspec, rtrim) builtin;

/* EXTERNAL */

dcl  salv_temp_dir$ ext;
dcl  salv_dir_space$ ext;

dcl  find entry (char (4) aligned, ptr);
dcl  salvage_pv entry (fixed bin, fixed bin (35));
dcl  salvage_pv$convert_vtoc entry (fixed bin, fixed bin (35));
dcl  salv_directory$ring0_salvage entry (ptr, fixed bin (35));
dcl  syserr entry options (variable);
dcl  syserr$error_code entry options (variable);
%page;
volume_salvage:
     entry (a_pvtx, arg_salv_opt_bits, arg_code);		/* Salvage another volume */

	salv_opt_bits = arg_salv_opt_bits;
	call set_salv_data (salv_opt_bits);
	call salvage_pv (a_pvtx, arg_code);
	return;


convert_vtoc:
     entry (a_pvtx, arg_salv_opt_bits, arg_code);		/* Convert the VTOC for a volume */

          salv_opt_bits = arg_salv_opt_bits;
	call set_salv_data (salv_opt_bits);
	call salvage_pv$convert_vtoc (a_pvtx, arg_code);


set_options:
     entry (arg_salv_opt_bits);

	salv_opt_bits = arg_salv_opt_bits;
	call set_salv_data (salv_opt_bits);
	return;


online:
     entry (a_info_p);

	call set_salv_data ("0"b);
	call setup_args (a_info_p);

	salv_data$on_line = "1"b;
	return;


dir_salv_boot:
     entry (a_path);

	call set_salv_data ("0"b);
	salv_data$rpv = "1"b;
	call setup_args (addr (salv_info));
	salv_info.pathname = a_path;
	salv_info.options.check_vtoce = "1"b;
	salv_info.options.delete_connection_failure = "1"b;
	call salv_directory$ring0_salvage (addr (salv_info), ec);
	if ec ^= 0 then call syserr$error_code (3, ec, "salvager: Error salvaging ^a.", salv_info.pathname);
	salv_data$rpv = "0"b;
	return;
%page;
set_salv_data:
     procedure (options_bit);

dcl  options_bit bit (36) aligned;
dcl  1 options aligned like salv_opts based (addr (options_bit));

dcl  dump_bad_dir bit (1) aligned;			/* ON, Print dump of bad directories. */
dcl  print_pathnames bit (1) aligned;			/* ON, Print pathname of each directory that is salvaged. */
dcl  debug bit (1) aligned;

/* Set system default values. */

	debug, dump_bad_dir, print_pathnames, rebuild, update_vtoce, delete_connection_failure_flag = "0"b;

/* Override standard defaults with salv config card. */

	salv_cardp = null ();
	call find ("salv", salv_cardp);
	if salv_cardp ^= null () then do;
	     do i = 1 to salv_card.n_fields;
		if /* case */ salv_card.options (i) = "debg" then debug = "1"b;
		else if salv_card.options (i) = "dump" then dump_bad_dir = "1"b;
		else if salv_card.options (i) = "rbld" then rebuild = "1"b;
		else if salv_card.options (i) = "dcf" then delete_connection_failure_flag = "1"b;
		else if salv_card.options (i) = "path" then print_pathnames = "1"b;
	     end;
	     end;

/* Override salv card with options specified with call. */

	if options_bit ^= "0"b then do;
	     if options.debug then debug = "1"b;
	     if options.ndebug then debug = "0"b;
	     if options.dump then dump_bad_dir = "1"b;
	     if options.ndump then dump_bad_dir = "0"b;
	     if options.pnames then print_pathnames = "1"b;
	     if options.npnames then print_pathnames = "0"b;
	     if options.rbld then rebuild = "1"b;
	     if options.nrbld then rebuild = "0"b;
	     if options.dcf then delete_connection_failure_flag = "1"b;
	     if options.ndcf then delete_connection_failure_flag = "0"b;
	     update_vtoce = options.check | options.dcf;
	     end;

/* Set salv_data. */

	salv_data$on_line = "0"b;
	salv_data$dump = dump_bad_dir;
	salv_data$debug = debug;
	salv_data$print_path = print_pathnames;

	return;

     end set_salv_data;
%page;
setup_args:
     procedure (salv_p);

dcl  salv_p ptr;					/* ptr to args structure. */
dcl  1 args aligned like salv_args based (salv_p);

	args.salv_time = bit (binary (clock (), 52));
	args.force_rebuild = rebuild;
	args.check_vtoce = update_vtoce;
	args.delete_connection_failure = delete_connection_failure_flag;
	args.print_trace = salv_data$debug;
	args.dump = salv_data$dump;
	args.correct_oosw = "1"b;
	args.temp1_ptr = addr (salv_temp_dir$);
	args.temp2_ptr = addr (salv_dir_space$);
	return;
     end setup_args;
%page;
%include config_salv_card;
%include salv_args;
%include salv_data;
%include salv_options;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   END MESSAGE DOCUMENTATION */

     end salvager;




		    vm_vio.pl1                      11/11/89  1059.4r w 11/11/89  0806.7      128646



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-01-16,Fawcett), approve(86-04-11,MCR7383),
     audit(86-05-28,Beattie), install(86-07-17,MR12.0-1097):
     Add support for 512_WORD_IO devices, 3380 and 3390.
                                                   END HISTORY COMMENTS */


vm_vio: proc;

/* original coding 9/75 by Bensoussan. Use of linear 256k seg for access changed
   5/76 by Kobziar to be a table of abs segs used round robin fashion  and initialized to 64k size.
   Modified 03/21/81, W. Olin Sibert, for ADP PTW formats
   Modified 03/08/82, J. Bongiovanni, for new PVTE
   */

/* The first abs seg (first 64k) is not releasable, and its ptr is always valid.
   Handling of reused addresses fits in as there is no dependence on any other abs seg  (ptr) */

/* Optimized for  linearly increasing vtocx index. Only case this not true is in processing
   a reused address, an event which is too infrequent (and happens only if unlucky hardware
   failure during crash) to code for. Thus read ahead and write behind will cause extra work
   due to possible reinitializing already written pages only in this case. */

/* Note that cleanup entry now releases printer */

dcl (pvtx, a_pvtx) fixed bin,
    (vtocx, a_vtocx, devx) fixed bin,
    (code, a_code) fixed bin (35);

dcl  rec_size fixed bin internal static options (constant) init (1024);
dcl  n_rec_per_seg fixed bin internal static options (constant) init (64);

dcl  segnos_initialized bit (1) internal static init ("0"b);

dcl  s (0 : 4) fixed bin internal static;		/* use 5 abs segs for addressibility */

dcl 1 seg_list (0 : 4) internal static,
    2 basep ptr,					/* seg ptr to be used for this abs seg */
    2 recno fixed bin,				/* starting addr of this seg w.r.t. disk 0 */
    2 perm bit (1) aligned,				/* slot frozen for this disk - header ptrs remain valid */
    2 used bit (1) aligned;				/* indicates slot initialized */

dcl  i fixed bin;
dcl  ptp pointer;

dcl  dseg$ (0 : 1023) fixed bin (71) external static;
dcl  pds$processid ext bit (36) aligned;
dcl  pvt$n_entries fixed bin external;
dcl  salv_abs_seg_00$ external;
dcl  salv_data$vol_read_ahead fixed bin external;
dcl  sst$astl bit (36) aligned external;
dcl  sst$astsize fixed bin external;
dcl  1 sst$level (0 : 3) aligned external,
     2 ausedp bit (18) unaligned,
     2 no_aste bit (18) unaligned;
dcl  sst$pts (0 : 3) fixed bin external;

dcl  get_aste entry (fixed bin) returns (ptr);
dcl  get_ptrs_$given_astep entry (ptr) returns (fixed bin (71) aligned);
dcl  get_ptrs_$given_segno entry (fixed bin) returns (ptr);
dcl  lock$lock_ast entry;
dcl  lock$unlock_ast entry;
dcl  page$cam entry;
dcl  pc$cleanup entry (ptr);
dcl  pc_wired$read entry (ptr, fixed bin, fixed bin);
dcl  pc_wired$write entry (ptr, fixed bin, fixed bin);
dcl  ptw_util_$make_disk entry (pointer, fixed bin (20));
dcl  ptw_util_$make_null entry (pointer, bit (22) aligned);
dcl  put_aste entry (pointer);
dcl  syserr entry options (variable);
dcl  thread$out entry (pointer, bit (18) unaligned);

dcl (addr, addrel, baseno, baseptr, bit, divide, hbound, mod, null, ptr, fixed) builtin;

dcl  cleanup condition;

/*  */

get_vtocep : entry (a_pvtx, a_vtocx) returns (ptr);

	pvtx = a_pvtx;
	vtocx = a_vtocx;
	pvt_arrayp = addr (pvt$array);
	devx = pvt_array (pvtx).device_type;
	vtocep = GET_VTOCEP (pvtx, vtocx);

	return (vtocep);






init :	entry (a_pvtx, a_code) returns (ptr);

	pvtx = a_pvtx;
	code = 0;
	pvt_arrayp = addr (pvt$array);
	devx = pvt_array (pvtx).device_type;
	on cleanup call CLEAN_UP;

	call INIT (pvtx, code);

	a_code = code;

	if code ^= 0 then do; call CLEAN_UP; return (null); end;

	return (seg_list (0).basep);





clean_up : entry (a_pvtx);

	pvtx = a_pvtx;
	pvt_arrayp = addr (pvt$array);
	devx = pvt_array (pvtx).device_type;
	call CLEAN_UP;

	return;

GET_VTOCEP : procedure (pvtx, vtocx) returns (ptr);


/* FUNCTION - This procedure returns a pointer to the vtoc entry whose  vtoc  index
   is (vtocx) in the physical volume that has been assigned the entry number (pvtx) in
   the physical volume table. */


dcl  pvtx fixed bin,
     vtocx fixed bin;

dcl  recno fixed bin;
dcl  compno fixed bin;
dcl  segno fixed bin;
dcl  word_number fixed bin;

dcl  vtoce_size fixed bin;
dcl  n_vtoce_per_rec fixed bin;

dcl  vtoce_ptr ptr;

dcl  k fixed bin;


	     if pvtx <= 0 | pvtx > pvt$n_entries then
		do;
		call syserr (ANNOUNCE, "vm_vio: get_vtocep: invalid pvtx: ^oo", pvtx);
		return (null);
	     end;
	  devx = pvt_array (pvtx).device_type;


/* The vtoce_size calculation is done this way so that for disk devices that
   only do 512 word io will appear to have a vtoce size of 512 instead of 192
   because there is only one vtoce per sector and the remaining 320 are not
   used. Therefore the calculation of word_number will always point to the
   begining of the vtoce. */

               vtoce_size = sect_per_vtoc (devx) * words_per_sect (devx);
	     n_vtoce_per_rec = divide (rec_size, vtoce_size, 17, 0);
	     recno = divide (vtocx, n_vtoce_per_rec, 17, 0) + VTOC_ORIGIN;
	     compno = get_segno (recno);
	     segno = s (compno);

	     if vtocx < 0 | recno >= pvt_array (pvtx).vtoc_size then
		do;
		call syserr (ANNOUNCE, "vm_vio: get_vtocep: invalid vtocx ^oo on pvtx ^oo", vtocx, pvtx);
		return (null);
	     end;

	     word_number = mod (recno, n_rec_per_seg) * rec_size
		+ mod (vtocx, n_vtoce_per_rec) * vtoce_size;

	     vtoce_ptr = ptr (baseptr (segno), word_number);

	     k = salv_data$vol_read_ahead;
	     if k > 0 then if mod (vtocx, n_vtoce_per_rec * k) = 0 then call READ_AHEAD ;

	     return (vtoce_ptr);


READ_AHEAD :   proc ;				/* INTERNAL TO GET_VTOCEP */



dcl (r, r1, r2) fixed bin;
dcl (j, n (0:1)) fixed bin;
dcl  first (0:1) fixed bin;
dcl  astep (0:1) ptr;
dcl  index fixed bin;


		r1 = recno + k;
		r2 = r1 + k - 1;

		n (0), n (1), j = 0;

		do r = recno + 1 to r2 while (r < pvt_array (pvtx).vtoc_size);
		     if mod (r, n_rec_per_seg) = 0 then j = 1;
		     if r >= r1 then n (j) = n (j) + 1;
		end;

		do j = 0, 1;
		     if n (j) > 0 then
			do;
			if j = 0 then astep (0) = get_ptrs_$given_segno (s (compno));
			else do;
			     index = get_segno (recno + n_rec_per_seg);
			     astep (j) = get_ptrs_$given_segno (s (index));
			end;
			if j = 0 then
			first (j) = mod (r1, n_rec_per_seg); else first (j) = mod (r1 + n (0), n_rec_per_seg);
			if astep (j) ^= null then call pc_wired$read (astep (j), first (j), n (j));
			else  call syserr  (CRASH, "vm_vio: no AST pointer at readahead.");
		     end;
		end;


		index = mod (recno, n_rec_per_seg);
		if index >= k then
		     do;
		     if n (0) = 0 then astep (0) = get_ptrs_$given_segno (s (compno));
		     if astep (0) ^= null then call pc_wired$write (astep (0), index - k, k);
		end;

		return;

	     end READ_AHEAD;


get_segno:     proc (pageno) returns (fixed bin);

dcl  pageno fixed bin;
dcl  fbtemp fixed bin;

		do i = 0 to hbound (s, 1);
		     if seg_list (i).used then if seg_list (i).recno <= pageno
			then if pageno <= seg_list (i).recno +n_rec_per_seg -1 then return (i);
		end;
						/* must update slot */
		fbtemp = 1;
						/* used to be only one loop with test for perm bit */
		do i = 1 to hbound (s, 1);
		     if seg_list (i).recno < seg_list (fbtemp).recno then fbtemp = i;
		end;

		call init_seg_list (fbtemp, pageno);
		return (fbtemp);
	     end get_segno;

init_seg_list: proc (index, pageno);

dcl (index, pageno) fixed bin;
dcl  start fixed bin;

		astep = get_ptrs_$given_segno (s (index));
		call pc_wired$write (astep, 0, -1);
		call pc$cleanup (astep);

		start = divide (pageno, n_rec_per_seg, 17, 0) * n_rec_per_seg;

		ptp = addrel (astep, sst$astsize);
		do i = 0 to n_rec_per_seg - 1;
		     call ptw_util_$make_disk (addrel (ptp, i), start + i); /* Appropriate record, out on disk */
		end;

		seg_list (index).recno = start;

	     end init_seg_list;
	end GET_VTOCEP;

INIT :	proc (pvtx, code);

dcl  pvtx fixed bin;
dcl  code fixed bin (35);

dcl  vtoc_size fixed bin;
dcl  start_recno fixed bin;


	     code = 0;

	     if ^ segnos_initialized then
		do;
		seg_list (0).basep = addr (salv_abs_seg_00$);
		s (0) = fixed (baseno (seg_list (0).basep));
		seg_list (0).used = "0"b;
		seg_list (0).perm = "0"b;

		do i = 1 to hbound (s, 1);
		     s (i) = s (0) + i;
		     seg_list (i).basep = baseptr (s (i));
		     seg_list (i).used = "0"b;
		     seg_list (i).perm = "0"b;
		end;

		segnos_initialized = "1"b;
	     end;

	     start_recno = 0;
	     call INIT_VTOC_SEG (s (0), pvtx, start_recno, n_rec_per_seg, code);
	     if code ^= 0 then return;

	     seg_list (0).used = "1"b;
	     seg_list (0).perm = "1"b;
	     seg_list (0).recno = 0;

	     labelp = ptr (baseptr (s (0)), LABEL_ADDR * rec_size);

	     vtoc_size = label.vtoc_size;

	     do i = 1 to hbound (s, 1);
		start_recno = start_recno + n_rec_per_seg;
		call INIT_VTOC_SEG (s (i), pvtx, start_recno, n_rec_per_seg, code);
		if code ^= 0 then return;
		seg_list (i).used = "1"b;
		seg_list (i).perm = "0"b;
		seg_list (i).recno = start_recno;
	     end;

	     pvt_array (pvtx).vtoc_size = vtoc_size; /* Needed by vm_vio$get_vtocep */
	     return;

	end INIT;

INIT_VTOC_SEG : proc (segno, pvtx, first_recno, n_records, code) ;


dcl  segno fixed bin,				/* segno assigned to this vtoc segment - input */
     pvtx fixed bin,				/* PVT index for this vtoc segment - input */
     first_recno fixed bin,				/* device add for page 0 of this vtoc segment - input */
     n_records fixed bin,				/* number of pages for this vtoc segment - input */
     code fixed bin (35);

dcl (i, pts, ptsi) fixed bin;

dcl  tsdw fixed bin (71);


/* ALLOCATE AN ASTE OF THE APPROPRIATE SIZE */

	     code = 0;

	     call lock$lock_ast;

	     astep = get_aste (n_records);		/* Get an ASTE with the appropriate size PT */

	     ptsi = fixed (aste.ptsi);
	     pts = sst$pts (ptsi);


/* ZERO THE ASTE */

	     astep -> aste_part.two = "0"b;		/* Zero the rest of the ASTE except ptsi and marker */

/* INITIALIZE THE PAGE TABLE WITH DISK ADDRESSES AND PAGE FAULT BITS */

	     ptp = addrel (astep, sst$astsize);	/* get a pointer to the page table */

	     do i = 0 to n_records - 1;		/* initialize the page table array for the entry */
		call ptw_util_$make_disk (addrel (ptp, i), first_recno + i); /* Appropriate record, out on disk */
	     end;

	     do i = n_records to pts - 1;
		call ptw_util_$make_null (addrel (ptp, i), fill_page_table_null_addr); /* Make up remaining PTWS */
	     end;



/* INITIALIZE THE ASTE */

	     astep -> aste.vtocx = -1;		/* show there is no VTOCE for the segment */
	     astep -> aste.dnzp = "1"b;
	     astep -> aste.gtpd = "1"b;		/* do not put pages in the paging device */
	     astep -> aste.nqsw = "1"b;		/* turn on no quota switch */
	     astep -> aste.strp = bit (fixed (segno, 18), 18); /* store segment number in AST */
	     astep -> aste.csl = bit (fixed (n_records, 9), 9); /* set the current length */
	     astep -> aste.msl = bit (fixed (n_records, 9), 9); /* set the max length */
	     astep -> aste.records = bit (fixed (n_records, 9), 9); /* set the number of records used */
	     astep -> aste.pvtx = pvtx;		/* store the physical volume table index */



/* THE CLEAN_UP OPERATION WILL DEPEND ON THE ORDER IN WHICH THE NEXT ACTIONS ARE PERFORMED */

	     tsdw = get_ptrs_$given_astep (astep);	/* Get initial  SDW. */
	     dseg$ (segno) = tsdw;			/* store temp SDW in the descriptor segment */
	     call page$cam;

	     astep -> aste.usedf = "1"b;		/* mark it as being used - as late as possible */

	     call thread$out (astep, sst$level (ptsi).ausedp); /* thread the entry out of the used list */

	     call lock$unlock_ast;

	     return;

	end INIT_VTOC_SEG;

CLEAN_UP : proc;

dcl  k fixed bin;


	     if ^ segnos_initialized then return;

	     if sst$astl ^= pds$processid then call lock$lock_ast;

	     do k = 0 to hbound (s, 1);;
		if seg_list (k).used then do;
		     astep = get_ptrs_$given_segno (s (k));

		     if astep ^= null then
			if fixed (aste.strp, 18) = s (k) then
			     do;
			     dseg$ (s (k)) = 0;
			     call page$cam;
			     call pc$cleanup (astep);
			     call put_aste (astep);
			end;
		     seg_list (k).used = "0"b;
		     seg_list (k).perm = "0"b;
		end;
	     end;

	     call lock$unlock_ast;

	     addr (pvt$array) -> pvt_array (pvtx).vtoc_size = 0;

	     return;

	end CLEAN_UP;

%page; %include aste;
%page; %include disk_pack;
%page; %include fs_vol_label;
%page; %include null_addresses;
%page; %include pvte;
%page; %include vtoce;
%page; %include syserr_constants;
%page; %include fs_dev_types_sector;
/*  */

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   vm_vio: get_vtocep: invalid pvtx: PPPo

   S: $info

   T: Volume salvaging or disk rebuilding.

   M: The Volume Salvager virtual access package has been given a bad
   PVT index parameter, PPP (shown in octal).
   $err

   A: Salvaging will not proceed.
   $boot_tape

   Message:
   vm_vio: get_vtocep: invalid vtocx VVVo on pvtx PPPo

   S: $info

   T: Volume salvaging or disk rebuilding.

   M: An out-of-range VTOC index (VVV) has been given to the Volume Salvager
   virtual access package while processing PV at pvtx PPP. The vtocx and pvtx
   are shown in octal.
   $err

   A: Salvaging may fail.
   $note

   Message:
   vm_vio: no AST pointer at readahead.

   S: $crash

   T: Volume salvaging or disk rebuilding.

   M: No AST entry pointer was found for a VTOC-addressing
   segment used by the Volume Salvager virtual access package.
   $err

   A: $recover
   $note

   END MESSAGE DOCUMENTATION */

     end vm_vio;





		    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
