bce_alert.pl1 11/11/89 1134.3r w 11/11/89 0826.1 17811 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ bce_alert: proc (p_ss_info_ptr); /* Write a message with alert on the operators console. Keith Loepere, January 1984. */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ dcl addr builtin; dcl arg char (arg_len) based (arg_ptr); dcl arg_count fixed bin; dcl arg_len fixed bin (21); dcl arg_num fixed bin; dcl arg_ptr ptr; dcl bce_data$console_alert_put_chars entry (ptr, ptr, fixed bin, fixed bin (35)) ext variable; dcl code fixed bin (35); dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin (35)); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl message char (256); dcl message_len fixed bin; dcl p_ss_info_ptr ptr parameter; dcl substr builtin; ss_info_ptr = p_ss_info_ptr; message_len = 0; call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code); if code = 0 then do arg_num = 1 to arg_count; call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, ss_info.arg_list_ptr); substr (message, message_len + 1, arg_len) = arg; substr (message, message_len + arg_len + 1, 1) = " "; message_len = message_len + arg_len + 1; end; message_len = message_len + 1; substr (message, message_len, 1) = " "; call bce_data$console_alert_put_chars (addr (bce_data$console_alert_put_chars), addr (message), message_len, code); return; %page; %include bce_subsystem_info_; end;  bce_appending_simulation.pl1 11/11/89 1134.3r w 11/11/89 0826.1 204669 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-01-14,Fawcett), approve(86-04-11,MCR7383), audit(86-05-12,Farley), install(86-07-17,MR12.0-1097): Changed to add Subvolume support. END HISTORY COMMENTS */ bce_appending_simulation: proc; /* Routine to access segments in the saved Multics memory image. Written October 1983 and beyond by Keith Loepere. Modified to better handle a few unusual occurences by Allen Ball, July 1984. Modified to correctly set cmep, Keith Loepere, November 1984. */ /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */ dcl Read bit (1) aligned static options (constant) init ("1"b); dcl Write bit (1) aligned static options (constant) init ("0"b); dcl abs_seg0$ (0:256 * 1024 - 1) bit (36) aligned ext; dcl abs_seg_pt (0:255) bit (36) aligned based (static.abs_seg_ptp); dcl abs_seg_pt_addr fixed bin (26); /* address of page table for abs_seg0 */ dcl absadr entry (ptr, fixed bin (35)) returns (fixed bin (26)); dcl addr builtin; dcl address fixed bin (26); /* absolute address to get */ dcl addwordno builtin; dcl bin builtin; dcl code fixed bin (35) parameter; dcl core_map$ external; dcl core_map_ptw bit (36) aligned; /* for finding its absadr */ dcl core_map_sdw fixed bin (71); /* for finding its absadr */ dcl core_map_segnum fixed bin (15); /* for getting its absadr */ dcl data_length fixed bin (18); /* amount left to get/put */ dcl data_part (data_part_length) bit (36) aligned based (data_ptr); dcl data_part_length fixed bin (18); /* of desired that fits (in page) under examination */ dcl data_ptr ptr; /* where to get/put */ dcl dbr_util_$dissect entry (ptr, ptr); dcl dbr_value bit (72) aligned parameter; /* descriptor base register value for simulation */ dcl desired_segnum fixed bin (15) parameter; dcl divide builtin; dcl dseg$ (0:511) fixed bin (71) ext; dcl dseg_page_address fixed bin (26); /* for finding dseg sdw */ dcl dseg_sdw fixed bin (71); dcl error_table_$argerr fixed bin (35) ext static; dcl error_table_$boundviol fixed bin (35) ext static; dcl error_table_$dev_offset_out_of_bounds fixed bin (35) ext static; dcl error_table_$fsdisk_pvtx_oob fixed bin (35) ext static; dcl error_table_$fsdisk_phydev_err fixed bin (35) ext static; dcl error_table_$invalidsegno fixed bin (35) ext static; dcl get_ptrs_$given_segno entry (fixed bin (15)) returns (ptr); dcl int_unpaged_page_tables$ external; dcl min builtin; dcl mod builtin; dcl multics_data_ptr ptr; dcl multics_high_mem$ (0:256 * 1024 - 1) bit (36) aligned ext; dcl multics_low_mem$ (0:256 * 1024 - 1) bit (36) aligned ext; dcl 1 my_cme aligned like cme; dcl my_dbr bit (72) aligned; /* either mine, or from crash */ dcl 1 my_dbr_info aligned like dbr_info; dcl 1 my_ptw_info aligned like ptw_info; dcl 1 my_sdw_info aligned like sdw_info; dcl op_not_complete condition; dcl parity condition; dcl p_address fixed bin (26) parameter; /* absolute address desired */ dcl p_data_length fixed bin (18) parameter; /* length desired */ dcl p_data_ptr ptr parameter; /* user's area */ dcl p_examine_crash bit (1) aligned parameter; /* as opposed to bce */ dcl p_last_segnum fixed bin (15) parameter; dcl p_seg_info_ptr ptr parameter; dcl p_seg_sdw fixed bin (71) parameter; dcl page_fault_error condition; dcl page_num fixed bin; /* loop counter */ dcl page_offset fixed bin (10); /* start of desired data in this page */ dcl pc$cleanup entry (ptr); dcl pc_wired$write_wait entry (ptr, fixed bin, fixed bin); dcl pmut$camp entry; dcl ptr builtin; dcl ptw_util_$dissect entry (ptr, ptr); dcl ptw_util_$make_core entry (ptr, fixed bin (26)); dcl ptw_util_$make_disk entry (ptr, fixed bin (20)); dcl ptw_util_$make_null_disk entry (ptr, fixed bin (20)); dcl ptw_util_$reset_phm entry (ptr); dcl ptw_util_$set_phm entry (ptr); dcl pvt$root_pvtx fixed bin external; dcl rdisk_seg$ external; /* for reading/writing disk pages */ dcl read_write bit (1) aligned; /* get versus put operation */ dcl sdw_util_$dissect entry (ptr, ptr); dcl sdw_util_$get_address entry (ptr, fixed bin (26)); dcl seg_sdw fixed bin (71); /* describe new segment */ dcl segno builtin; dcl 1 static aligned internal static, /* things remembered about current simulation */ 2 abs_seg_ptp ptr, /* page table ptr for abs_seg0 */ 2 core_map_address fixed bin (26), /* for finding cme entries */ 2 core_map_present bit (1) aligned, /* coremap exists to resolve out-of-service pages */ 2 current_abs_seg_addr fixed bin (26) init (-256 * 1024), /* current absolute address of pages described by abs_seg0 initial value is such as to be not confused with a good abs-seg addr */ 2 dseg_info aligned like seg_info, 2 examine_crash bit (1) aligned, /* as opposed to bce memory */ 2 high_mem_astep ptr, /* astep for multics_high_mem */ 2 last_segnum fixed bin (15) init (-1), /* highest valid segno for this dbr */ 2 low_mem_astep ptr, /* astep for multics_low_mem */ 2 rdisk_astep ptr, /* for reading page of arbitrary disk */ 2 rdisk_ptp ptr, /* to ptw for rdisk_seg */ 2 rdisk_ptr ptr, /* to seg for reading arbitrary disk pages */ 2 toehold_addr fixed bin (26), /* absadr of toehold */ 2 toehold_data_addr fixed bin (26); /* absadr of toehold_data (holder of first two pages of low mem) */ dcl size builtin; dcl store condition; dcl substr builtin; dcl sys_boot_info$bce_dbr bit (72) aligned external; dcl 1 toehold$ external aligned like toe_hold; dcl toehold_data$ external; dcl unspec builtin; %page; init: entry (p_examine_crash, code); /* Initialize various static variables. */ code = 0; static.examine_crash = p_examine_crash; call sdw_util_$get_address (addr (dseg$ (segno (addr (abs_seg0$)))), abs_seg_pt_addr); static.abs_seg_ptp = ptr (addr (int_unpaged_page_tables$), abs_seg_pt_addr - absadr (addr (int_unpaged_page_tables$), (0))); static.toehold_data_addr = absadr (addr (toehold_data$), (0)); static.toehold_addr = absadr (addr (toehold$), (0)); static.low_mem_astep = get_ptrs_$given_segno (segno (addr (multics_low_mem$))); static.high_mem_astep = get_ptrs_$given_segno (segno (addr (multics_high_mem$))); static.rdisk_ptr = addr (rdisk_seg$); static.rdisk_astep = get_ptrs_$given_segno (segno (static.rdisk_ptr)); static.rdisk_ptp = addwordno (static.rdisk_astep, size (aste)); static.rdisk_astep -> aste.pvtx = pvt$root_pvtx; /* good initial state */ call ptw_util_$make_disk (static.rdisk_ptp, 0); static.current_abs_seg_addr = -256 * 1024; if static.examine_crash then my_dbr = toehold$.multics_state.dbr; /* assume dbr from mc */ else my_dbr = sys_boot_info$bce_dbr; call new_dbr (my_dbr, (0), code); abort: return; %page; new_dbr: entry (dbr_value, p_last_segnum, code); /* Supply a new dseg for the simulation. */ code = 0; dbr_info_ptr = addr (my_dbr_info); sdw_info_ptr = addr (my_sdw_info); ptw_info_ptr = addr (my_ptw_info); on page_fault_error call page_error; /* Examine the new dbr. */ call dbr_util_$dissect (addr (dbr_value), dbr_info_ptr); static.last_segnum, p_last_segnum = divide (dbr_info.bound, 2, 15) - 1; static.dseg_info.sdwi.paged = dbr_info.paged; static.dseg_info.sdwi.address = dbr_info.address; /* Get the sdw & page table for dseg. */ if static.dseg_info.sdwi.paged then do; call get_absolute (static.dseg_info.sdwi.address - size (aste), size (aste) + divide (dbr_info.bound + 1023, 1024, 8), addr (static.dseg_info.sst_data), code); if code ^= 0 then return; call ptw_util_$dissect (addr (static.dseg_info.page_table (0)), ptw_info_ptr); call get_absolute (ptw_info.address, 2, addr (dseg_sdw), code); if code ^= 0 then return; end; else do; call get_absolute (static.dseg_info.sdwi.address, 2, addr (dseg_sdw), code); if code ^= 0 then return; end; call sdw_util_$dissect (addr (dseg_sdw), addr (static.dseg_info.sdwi)); /* Find the core_map, if present, which is needed to resolve pages that were out of service for io. */ static.core_map_present = "0"b; if segno (addr (core_map$)) <= p_last_segnum then do; core_map_segnum = segno (addr (core_map$)); /* in first dseg page - known to be in memory */ if static.dseg_info.sdwi.paged then dseg_page_address = ptw_info.address; else dseg_page_address = static.dseg_info.sdwi.address; call get_absolute (dseg_page_address + 2 * core_map_segnum, 1, addr (core_map_sdw), code); if code ^= 0 then return; call sdw_util_$dissect (addr (core_map_sdw), sdw_info_ptr); if sdw_info.paged then do; call get_absolute (sdw_info.address, 1, addr (core_map_ptw), code); if code ^= 0 then return; call ptw_util_$dissect (addr (core_map_ptw), ptw_info_ptr); static.core_map_address = ptw_info.address; end; else static.core_map_address = sdw_info.address; static.core_map_present = static.core_map_address ^= 0; end; return; %page; get_absolute: entry (p_address, p_data_length, p_data_ptr, code); read_write = Read; go to absolute; put_absolute: entry (p_address, p_data_length, p_data_ptr, code); read_write = Write; absolute: /* Get or put a range of memory given an absolute address. We access Multics memory through one of three segments. The segment multics_low_mem maps onto the first 256k of memory (saved to disk). (Actually, pages 0 and 1 of this memory are actually in toehold_data within this segment.) multics_high_mem is the next 256k. The abs-seg abs_seg0 is mapped onto the nth 256k; its page table is changed as needed. We do all of this one page at a time, backwards, to provide better disk latency. */ code = 0; on page_fault_error call page_error; on parity call mem_error; on store call mem_error; on op_not_complete call mem_error; data_length = p_data_length; /* We march the address we desire downwards, by at most a page at a time. */ do while (data_length > 0); /* Find amount of data in this page. */ data_part_length = mod (p_address + data_length - 1, 1024) + 1; /* amount from start of page to last word */ if data_part_length <= data_length then address = p_address + data_length - data_part_length; /* data crosses into this page */ else do; /* data within a page */ address = p_address; data_part_length = data_length; end; page_num = divide (address, 1024, 16); data_ptr = addwordno (p_data_ptr, address - p_address); if ^static.examine_crash | (address >= (512 * 1024)) then if (static.current_abs_seg_addr <= address) & (address < (static.current_abs_seg_addr + 256 * 1024)) then do; /* memory extent we already have mapped */ multics_data_ptr = ptr (addr (abs_seg0$), address - static.current_abs_seg_addr); if read_write = Read then data_ptr -> data_part = multics_data_ptr -> data_part; else multics_data_ptr -> data_part = data_ptr -> data_part; end; else do; /* we must re-map abs_seg0$ */ static.current_abs_seg_addr = divide (address, 256 * 1024, 8) * 256 * 1024; do page_num = 0 to 255; call ptw_util_$make_core (addr (abs_seg_pt (page_num)), static.current_abs_seg_addr + page_num * 1024); end; call pmut$camp; multics_data_ptr = ptr (addr (abs_seg0$), address - static.current_abs_seg_addr); if read_write = Read then data_ptr -> data_part = multics_data_ptr -> data_part; else multics_data_ptr -> data_part = data_ptr -> data_part; end; else if address >= 256 * 1024 then do; /* Must be low memory of crash image to examine */ multics_data_ptr = ptr (addr (multics_high_mem$), address - 256 * 1024); if read_write = Read then data_ptr -> data_part = multics_data_ptr -> data_part; else do; multics_data_ptr -> data_part = data_ptr -> data_part; call pc_wired$write_wait (static.high_mem_astep, page_num - 256, 1); end; end; else if address >= static.toehold_addr + 2048 then do; multics_data_ptr = ptr (addr (multics_low_mem$), address); if read_write = Read then data_ptr -> data_part = multics_data_ptr -> data_part; else do; multics_data_ptr -> data_part = data_ptr -> data_part; call pc_wired$write_wait (static.low_mem_astep, page_num, 1); end; end; else if address >= static.toehold_addr then do; /* toehold stays in memory */ multics_data_ptr = ptr (addr (toehold$), address - static.toehold_addr); if read_write = Read then data_ptr -> data_part = multics_data_ptr -> data_part; else multics_data_ptr -> data_part = data_ptr -> data_part; end; else if address >= 2 * 1024 then do; /* below toehold */ multics_data_ptr = ptr (addr (multics_low_mem$), address); if read_write = Read then data_ptr -> data_part = multics_data_ptr -> data_part; else do; multics_data_ptr -> data_part = data_ptr -> data_part; call pc_wired$write_wait (static.low_mem_astep, page_num, 1); end; end; else do; /* page is in toehold_data area of saved memory */ multics_data_ptr = ptr (addr (multics_low_mem$), static.toehold_data_addr + address); if read_write = Read then data_ptr -> data_part = multics_data_ptr -> data_part; else do; multics_data_ptr -> data_part = data_ptr -> data_part; call pc_wired$write_wait (static.low_mem_astep, divide (static.toehold_data_addr, 1024, 16) + page_num, 1); end; end; data_length = data_length - data_part_length; end; return; %page; new_segment: entry (desired_segnum, p_seg_info_ptr, code); /* This entry specifies what segment future calls to put/get_virtual will reference. The virtual operations are broken apart into this routine (which specifies the segment number portion of an address) and the get/put_virtual entries which supply the word number. This is done for efficiency. */ code = 0; seg_info_ptr = p_seg_info_ptr; on page_fault_error call page_error; if desired_segnum > static.last_segnum then do; code = error_table_$invalidsegno; go to bad_segment; end; /* We will get the user's new segment's sdw and page table. We use virtual to get the seg's sdw. */ call get_virtual (addr (static.dseg_info), desired_segnum * 2, 2, addr (seg_sdw), code); if code ^= 0 then go to bad_segment; go to new_sdw_join; new_sdw: entry (p_seg_sdw, p_seg_info_ptr, code); code = 0; seg_sdw = p_seg_sdw; seg_info_ptr = p_seg_info_ptr; on page_fault_error call page_error; new_sdw_join: call sdw_util_$dissect (addr (seg_sdw), addr (seg_info.sdwi)); if seg_info.sdwi.faulted then do; code = error_table_$invalidsegno; go to bad_segment; end; if seg_info.sdwi.paged then do; /* Get the seg's aste/page table */ call get_absolute (seg_info.sdwi.address - size (aste), size (aste) + divide (seg_info.sdwi.size + 1023, 1024, 8), addr (seg_info.sst_data), code); if code ^= 0 then do; /* It could just be that the page table is in good memory and has no aste in front of it, but... */ seg_info.sdwi.faulted = "1"b; bad_segment: return; end; end; return; %page; get_virtual: entry (p_seg_info_ptr, p_address, p_data_length, p_data_ptr, code); read_write = Read; go to virtual; put_virtual: entry (p_seg_info_ptr, p_address, p_data_length, p_data_ptr, code); read_write = Write; virtual: /* Fetch a given set of words from the current segment. */ code = 0; seg_info_ptr = p_seg_info_ptr; on page_fault_error call page_error; ptw_info_ptr = addr (my_ptw_info); data_length = p_data_length; if p_address + data_length > seg_info.sdwi.size then do; data_part_length = min (data_length, p_address + data_length - seg_info.sdwi.size); data_ptr = addwordno (p_data_ptr, data_length - data_part_length); unspec (data_ptr -> data_part) = "0"b; code = error_table_$boundviol; data_length = data_length - data_part_length; end; if seg_info.sdwi.paged then do; do while (data_length > 0); data_part_length = mod (p_address + data_length - 1, 1024) + 1; /* amount from start of page to last word */ if data_part_length <= data_length then address = p_address + data_length - data_part_length; /* data crosses into this page */ else do; /* data within a page */ address = p_address; data_part_length = data_length; end; data_ptr = addwordno (p_data_ptr, address - p_address); page_num = divide (address, 1024, 8); page_offset = mod (address, 1024); /* Find the appropriate page. Move the amount found in that page to the user's area. */ if page_num < 0 | page_num > 255 then go to bad_page; call ptw_util_$dissect (addr (seg_info.page_table (page_num)), ptw_info_ptr); if ptw_info.valid then /* properly in memory */ if read_write = Read then call get_absolute (ptw_info.address + page_offset, data_part_length, data_ptr, code); else do; call put_absolute (ptw_info.address + page_offset, data_part_length, data_ptr, code); if ^ptw_info.phm then do; /* must update phm in ptw */ call ptw_util_$set_phm (addr (seg_info.page_table (page_num))); call put_absolute (seg_info.sdwi.address + page_num, 1, addr (seg_info.page_table (page_num)), code); end; end; else if ptw_info.add_type = add_type.disk then do; if ptw_info.null_disk then if read_write = Read then go to zero_page; else go to bad_page; else if read_write = Read then do; call map_for_read ((ptw_info.address), code); if code = 0 then do; data_ptr -> data_part = addwordno (static.rdisk_ptr, page_offset) -> data_part; call pc$cleanup (static.rdisk_astep); end; else go to bad_page; end; else do; call map_for_update ((ptw_info.address), code); if code = 0 then do; addwordno (static.rdisk_ptr, page_offset) -> data_part = data_ptr -> data_part; call pc$cleanup (static.rdisk_astep); end; else go to bad_page; end; end; else if ptw_info.add_type = add_type.core then do; if ^ptw_info.os then go to bad_page; if ^static.core_map_present then go to bad_page; /* find core map entry */ cmep = addr (my_cme); call get_absolute (static.core_map_address + 8 + size (cme) * divide (ptw_info.address, 1024, 16), size (cme), cmep, code); if code ^= 0 then go to bad_page; if substr (cme.devadd, 19, 4) ^= add_type.disk then go to bad_page; if substr (cme.devadd, 1, 1) then go to bad_page; if read_write = Read then do; if cme.io then call get_absolute (ptw_info.address + page_offset, data_part_length, data_ptr, code); /* page was being written -> memory good */ else do; /* reading -> disk is better */ call map_for_read (bin (substr (cme.devadd, 1, 18), 18), code); if code = 0 then do; data_ptr -> data_part = addwordno (static.rdisk_ptr, page_offset) -> data_part; call pc$cleanup (static.rdisk_astep); end; else go to bad_page; end; end; else do; if cme.io then do; /* was being written - memory is best */ call put_absolute (ptw_info.address + page_offset, data_part_length, data_ptr, code); /* page was being written -> memory good */ call map_for_write (bin (substr (cme.devadd, 1, 18), 18), code); /* save on disk */ if code = 0 then do; call get_absolute (ptw_info.address, 1024, static.rdisk_ptr, code); call pc$cleanup (static.rdisk_astep); end; else go to bad_page; end; else do; /* reading -> disk is better */ call map_for_update (bin (substr (cme.devadd, 1, 18), 18), code); if code = 0 then do; addwordno (static.rdisk_ptr, page_offset) -> data_part = data_ptr -> data_part; call put_absolute (ptw_info.address, 1024, static.rdisk_ptr, code); call pc$cleanup (static.rdisk_astep); end; else go to bad_page; end; end; end; else do; bad_page: if code = 0 then code = error_table_$argerr; zero_page: if read_write = Read then unspec (data_ptr -> data_part) = "0"b; end; data_length = data_length - data_part_length; end; end; else do; /* in memory (unpaged) */ address = seg_info.sdwi.address + p_address; if read_write = Read then call get_absolute (address, p_data_length, p_data_ptr, code); else call put_absolute (address, p_data_length, p_data_ptr, code); end; return; %page; map_for_read: proc (record_num, code); /* Map rdisk_seg onto the desired page. This routine is actually a streamlined version of read_disk for this purpose and uses the nice rdisk_seg aste built by read_disk. */ dcl code fixed bin (35) parameter; dcl record_num fixed bin (20) parameter; dcl write_op bit (1) aligned; map_for_update: entry (record_num, code); write_op = "0"b; go to map; map_for_write: entry (record_num, code); /* previous contents don't matter */ write_op = "1"b; map: pvtp = addr (pvt$); code = 0; if seg_info.sst_data.pvtx < 1 | seg_info.sst_data.pvtx > pvt.n_entries then do; code = error_table_$fsdisk_pvtx_oob; return; end; pvtep = addr (addr (pvt.array) -> pvt_array (seg_info.sst_data.pvtx)); if record_num < 0 | record_num >= rec_per_sv (pvte.device_type) then do; code = error_table_$dev_offset_out_of_bounds; return; end; static.rdisk_astep -> aste.pvtx = seg_info.sst_data.pvtx; static.rdisk_astep -> aste.npfs = "0"b; if write_op then call ptw_util_$make_null_disk (static.rdisk_ptp, record_num); else call ptw_util_$make_disk (static.rdisk_ptp, record_num); return; end; page_error: proc; /* Abort rdisk activity, return error code. */ call ptw_util_$reset_phm (static.rdisk_ptp); /* don't let pc try to write */ call pc$cleanup (static.rdisk_astep); mem_error: entry; code = error_table_$fsdisk_phydev_err; go to abort; end; %page; %include add_type; %page; %include bce_appending_seg_info; %page; %include cmp; %page; %include dbr_info; %page; %include fs_dev_types; %page; %include ptw_info; %page; %include pvt; %page; %include pvte; %page; %include toe_hold; end;  bce_copy_disk.pl1 11/11/89 1134.3r w 11/11/89 0826.1 159345 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1986 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-01-17,Fawcett), approve(86-01-17,MCR7220), audit(86-05-14,Farley), install(86-07-17,MR12.0-1097): Created by Keith Loepere March 1985 to copy a disk pack to another disk pack. 2) change(86-01-17,Fawcett), approve(86-04-11,MCR7383), audit(86-05-14,Farley), install(86-07-17,MR12.0-1097): Changed to support subvolumes by adding call to disk_name_pvtx. END HISTORY COMMENTS */ bce_copy_disk: proc (p_ss_info_ptr); /* Routine to copy a disk pack to another disk pack. Written in March 1985 by Keith Loepere. */ /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */ /* Parameters */ dcl p_ss_info_ptr ptr parameter; /* Variables */ dcl arg_count fixed bin; dcl arg_len fixed bin (21); dcl arg_list_ptr ptr; dcl arg_num fixed bin; dcl arg_ptr ptr; dcl buffer_address fixed bin (26); dcl buffer_num fixed bin; dcl buffer_ptr (2) ptr; dcl buffer_to_read (9) fixed bin; /* buffer number to read in at given state */ dcl buffer_to_write (9) fixed bin; /* buffer number to write out at given state */ dcl buffer_waiting_for (9) fixed bin; /* buffer whose completion we are waiting for */ dcl code fixed bin (35); dcl device_type fixed bin; dcl end_state (9) fixed bin; /* state to enter when the last read has completed */ dcl f_record fixed bin (18); dcl force bit (1) aligned; /* don't ask questions */ dcl from_devname char (8); dcl from_pvtx fixed bin; dcl l_record fixed bin (18); dcl 1 my_label aligned like label; dcl max_io_pages fixed bin; /* max pages to handle at a time - normally 3, but is temp set to 1 for error recovery */ dcl normal_state (9) fixed bin; /* state to enter after a read/write completes */ dcl 1 record_info aligned, 2 read aligned, 3 new_record fixed bin (18), 3 prev_record fixed bin (18), 3 prev_record_in_cylinder fixed bin, 3 records_this_cylinder fixed bin, 2 buffer (2) aligned like record_info.read; dcl state fixed bin; dcl temp_astep ptr; dcl temp_seg_ptr ptr; dcl to_devname char (8); dcl to_is_Multics bit (1) aligned; dcl to_pvtx fixed bin; dcl waiting_for_read (9) bit (1) aligned;/* are we waiting for a read to complete? */ dcl working_buffer fixed bin; dcl yes_no bit (1) aligned; /* Constants */ /* State names */ dcl E1R2 fixed bin init (5) static options (constant); dcl E1W2 fixed bin init (8) static options (constant); dcl Me char (32) static options (constant) init ("copy_disk"); dcl R1E2 fixed bin init (1) static options (constant); dcl R1W2 fixed bin init (7) static options (constant); dcl START fixed bin init (9) static options (constant); dcl W1E2 fixed bin init (4) static options (constant); dcl W1R2 fixed bin init (3) static options (constant); /* External */ dcl error_table_$bad_arg fixed bin (35) ext static; dcl error_table_$not_done fixed bin (35) ext static; /* Based */ dcl arg char (arg_len) based (arg_ptr); /* Entries */ dcl absadr entry (ptr, fixed bin (35)) returns (fixed bin (24)); dcl bce_check_abort entry; dcl disk_name_pvtx entry (char (8), fixed bin, fixed bin (35)); dcl bce_parse_disk_spec entry (char (32), ptr, fixed bin, fixed bin, ptr, fixed bin (18), fixed bin (18), entry (ptr, fixed bin, ptr, fixed bin (35)), ptr, fixed bin (35)); dcl bootload_disk_io$queue_read entry (fixed bin, fixed bin (18), fixed bin, ptr, fixed bin, fixed bin (35)); dcl bootload_disk_io$queue_write entry (fixed bin, fixed bin (18), fixed bin, ptr, fixed bin, fixed bin (35)); dcl bootload_disk_io$test_done entry (fixed bin, fixed bin (35)); dcl bce_query$yes_no entry options (variable); dcl com_err_ entry () options (variable); dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin (35)); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl get_ptrs_$given_segno entry (fixed bin (15)) returns (ptr); dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35)); dcl ioa_ entry () options (variable); dcl pc_abs$unwire_abs entry (ptr, fixed bin, fixed bin); dcl pc_abs$wire_abs_contig entry (ptr, fixed bin, fixed bin, fixed bin (35)); dcl read_disk entry (fixed bin, fixed bin (18), ptr, fixed bin (35)); dcl release_temp_segment_ entry (char (*), ptr, fixed bin (35)); /* Misc */ dcl (addr, addrel, max, min, mod, null, segno) builtin; dcl cleanup condition; %page; arg_list_ptr = p_ss_info_ptr -> ss_info.arg_list_ptr; pvtp = addr (pvt$); pvt_arrayp = addr (pvt.array); labelp = addr (my_label); call cu_$arg_count_rel (arg_count, arg_list_ptr, code); if code ^= 0 then do; call com_err_ (code, Me); return; end; if arg_count < 2 then do; call ioa_ ("Usage:^/ ^a ( ...)", Me); return; end; arg_num = 2; call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, arg_list_ptr); if code ^= 0 then do; call com_err_ (code, Me, "Can't get arg"); return; end; to_devname = arg; call disk_name_pvtx (to_devname, to_pvtx, code); if code ^= 0 then do; call com_err_ (code, Me, "^a", arg); go to RETURN; end; call read_disk (to_pvtx, (LABEL_ADDR), labelp, code); if code ^= 0 then do; call com_err_ (code, Me, "Could not read label record of ^a.", to_devname); return; end; to_is_Multics = (label.Multics = Multics_ID_String); arg_num = 1; call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, arg_list_ptr); if code ^= 0 then do; call com_err_ (code, Me, "Can't get arg"); return; end; from_devname = arg; call disk_name_pvtx (from_devname, from_pvtx, code); if code ^= 0 then do; call com_err_ (code, Me, "^a", arg); go to RETURN; end; call read_disk (from_pvtx, (LABEL_ADDR), labelp, code); if code ^= 0 then do; call com_err_ (code, Me, "Could not read label record of ^a.", from_devname); return; end; device_type = pvt_array (from_pvtx).device_type; if pvt_array (to_pvtx).device_type ^= device_type then do; call com_err_ (0, Me, "^a is not the same type as ^a.", from_devname, to_devname); return; end; if from_pvtx = to_pvtx then do; call com_err_ (0, Me, "^a is the same disk as ^a.", from_devname, to_devname); return; end; force = "0"b; arg_num = 3; call bce_parse_disk_spec (Me, arg_list_ptr, arg_num, device_type, labelp, f_record, l_record, no_parse, null, code); if code ^= 0 then return; /* Now that f_record and l_record are assigned we will give them their chance to turn back. */ if f_record = l_record then call ioa_ ("Writing to record number ^oo on ^a.", f_record, to_devname); else call ioa_ ("Writing to records ^oo through ^oo (inclusive) on ^a.", f_record, l_record, to_devname); if ^force then do; call bce_query$yes_no (yes_no, "Do you wish to write to the ^[non ^;^]^a - ^a? ", ^to_is_Multics, Multics_ID_String, to_devname); if ^yes_no then return; end; %page; /* Find work area */ temp_seg_ptr = null; call get_temp_segment_ (Me, temp_seg_ptr, code); if code ^= 0 then do; call com_err_ (code, Me, "Unable to get temp disk buffer."); return; end; buffer_ptr (1) = temp_seg_ptr; buffer_ptr (2) = addrel (temp_seg_ptr, 3 * 1024); temp_astep = get_ptrs_$given_segno (segno (temp_seg_ptr)); call pc_abs$wire_abs_contig (temp_astep, 0, 6, code); /* double buffer of three pages */ if code ^= 0 then do; call com_err_ (code, Me, "Unable to wire temp disk buffer."); call release_temp_segment_ (Me, temp_seg_ptr, code); return; end; buffer_address = absadr (temp_seg_ptr, code); disk_post_area_ptr = addr (bootload_disk_post_seg$); disk_post_area.number = 2; disk_post_area.buffer_coreadd (1) = buffer_address; disk_post_area.buffer_coreadd (2) = buffer_address + 3 * 1024; disk_post_area.disk_complete (1) = "0"b; disk_post_area.disk_complete (2) = "0"b; disk_post_area.disk_error_code (1) = 0; disk_post_area.disk_error_code (2) = 0; on cleanup call clean_up; /* remember, this is only called during bce_check_abort */ %page; /* Now for the real work. The basic flow of this program is to keep reading pages from the from_pvtx and write them to the to_pvtx, using relatively standard double buffering techniques. This process is done backwards, and (normally) three pages at a time, to minimize latency between i/o's, to maximize the time we have between i/o's to get our next request in, within the constraints that bootload_disk_io can handle a maximum of 4 pages at a time. Three pages is optimal both for 451 and 501 style drives. However, we don't want to read/write a set of pages that cross a cylinder boundary, so we check for this. As such, a set may contain less than 3 pages. Also, in case of error (explained below), only one page is read/written so the bad pages may be found. So that the program does not become overly complicated via code, it is expressed as a finite state machine. The idea is to start in a state where both buffers are doing nothing, move to a state where buffer 1 is reading and in which we are waiting for buffer 1's i/o to complete, move to a state in which buffer 1 is writing and buffer 2 is reading (the next set of pages) and in which we are waiting for buffer 1's i/o to complete, move to a state where buffer 1 is done and we are waiting for buffer 2 to finish, etc. At any given state, we are waiting for the i/o of a particular buffer to complete before moving to the next state. Error philosophy: when an error occurs, we want to be sure we read/write all of the pages that we can. When an error occurs on a multiple page read, the read is simple retried, asking this time for only the last (since we are reading backwards) page. If an error occurs on a single page read, though, we must give up on that page, and inform the user of same. The copy is restarted, at the record before (less than) the faulting record. Errors during writing are pretty much the reverse of the above. If a single page write fails, we must give up on the page, and inform the user. As far as the state goes, we pretend the write was successful and go to the corresponding state (waiting for the next read to write out). If a multi-page write fails, though, we must start writing pages one at a time to find the bad ones. We could just do this from the data already read, but this would be too hard to keep track of. Besides, we are screwed, latency-wise, having to re-write, so we wait for any read in progress to finish, and re-read the last page of the previous read (the first page we want to write now) so that the buffers come back into sync. In the finite state diagram that follows, the codes (such as e1 w2) mean that buffer 1 is empty, and buffer 2 is in process of being written. */ %page; /* ------- ------- | END | |START| ------- /-last 1 done-|r1 e2| ^ /-- ------- 1 done /- \ 1 done | v v ------- ------- ------- ------- |w1 e2|<-last 1 done-|r1 e2|-1 done->|w1 r2| | END | ------- ------- ------- ------- ^ | ^ 2 done 1 done 2 done | v | ------- ------- ------- |r1 w2|<-2 done-|e1 r2|-last 2 done->|e1 w2| ------- ------- ------- */ end_state (*) = 0; normal_state (*) = 0; buffer_to_read (*) = 0; buffer_to_write (*) = 0; buffer_waiting_for (*) = 0; waiting_for_read (*) = "0"b; buffer_to_read (START) = 1; buffer_waiting_for (START) = 1; waiting_for_read (START) = "1"b; end_state (START) = W1E2; normal_state (START) = W1R2; buffer_waiting_for (R1E2) = 1; waiting_for_read (R1E2) = "1"b; end_state (R1E2) = W1E2; normal_state (R1E2) = W1R2; buffer_to_read (W1R2) = 2; buffer_to_write (W1R2) = 1; buffer_waiting_for (W1R2) = 1; normal_state (W1R2) = E1R2; buffer_waiting_for (E1R2) = 2; waiting_for_read (E1R2) = "1"b; end_state (E1R2) = E1W2; normal_state (E1R2) = R1W2; buffer_to_read (R1W2) = 1; buffer_to_write (R1W2) = 2; buffer_waiting_for (R1W2) = 2; normal_state (R1W2) = R1E2; buffer_to_write (E1W2) = 2; buffer_waiting_for (E1W2) = 2; buffer_to_write (W1E2) = 1; buffer_waiting_for (W1E2) = 1; %page; max_io_pages = 3; /* normally read/write a max of three pages at a time */ RESTART: record_info.read.prev_record = l_record + 1; record_info.read.prev_record_in_cylinder = mod (record_info.read.prev_record, rec_per_cyl (device_type)); if record_info.read.prev_record <= f_record then state = 0; else state = START; do while (state ^= 0); call bce_check_abort; working_buffer = buffer_to_write (state); if working_buffer > 0 then /* last read must have finished */ call bootload_disk_io$queue_write (to_pvtx, record_info.buffer (working_buffer).new_record, record_info.buffer (working_buffer).records_this_cylinder, buffer_ptr (working_buffer), working_buffer, code); working_buffer = buffer_to_read (state); if working_buffer > 0 then do; if record_info.read.prev_record_in_cylinder = 0 then record_info.read.prev_record_in_cylinder = rec_per_cyl (device_type); /* next cylinder */ record_info.read.records_this_cylinder = min (record_info.read.prev_record_in_cylinder, max_io_pages); /* num pages to do this time around */ record_info.read.new_record = max (record_info.read.prev_record - record_info.read.records_this_cylinder, f_record); /* don't go over requested area */ record_info.read.records_this_cylinder = record_info.read.prev_record - record_info.read.new_record; /* real amt to do */ call bootload_disk_io$queue_read (from_pvtx, record_info.read.new_record, record_info.read.records_this_cylinder, buffer_ptr (working_buffer), working_buffer, code); record_info.buffer (working_buffer) = record_info.read; /* record what pages are in this buffer */ end; working_buffer = buffer_waiting_for (state); code = error_table_$not_done; do while (code = error_table_$not_done); call bootload_disk_io$test_done (working_buffer, code); end; if waiting_for_read (state) then if code = 0 then do; record_info.read.prev_record = record_info.read.new_record; /* advance to next (prev) pages */ record_info.read.prev_record_in_cylinder = record_info.read.prev_record_in_cylinder - record_info.read.records_this_cylinder; max_io_pages = 3; /* allow full batch next time around - on error cases we keep it at 1 assuming that next record will be bad also (same track?) */ end; else do; if record_info.read.records_this_cylinder > 1 then /* try i/o on just 1 record to find fault one */ l_record = record_info.read.prev_record - 1; /* start with last record not processed */ else do; call com_err_ (0, Me, "Could not read record ^oo of ^a.", record_info.read.new_record, from_devname); l_record = record_info.read.prev_record - 2; /* skip the current record */ end; go to IO_ERROR; end; else if code ^= 0 then do; /* error on write */ if record_info.buffer (working_buffer).records_this_cylinder = 1 then /* consider page as done */ call com_err_ (0, Me, "Could not write record ^oo to ^a.", record_info.buffer (working_buffer).new_record, to_devname); else do; /* multi-record, wait for all io to finish, restart */ l_record = record_info.buffer (working_buffer).prev_record - 1; /* restart read at pages attempted written */ IO_ERROR: do buffer_num = 1 to 2; code = error_table_$not_done; do while (code = error_table_$not_done); call bootload_disk_io$test_done (buffer_num, code); end; end; max_io_pages = 1; /* force just one page i/o next time */ go to RESTART; end; end; if record_info.read.prev_record <= f_record then state = end_state (state); else state = normal_state (state); end; call clean_up; RETURN: return; clean_up: proc; do buffer_num = 1 to 2; code = error_table_$not_done; do while (code = error_table_$not_done); call bootload_disk_io$test_done (buffer_num, code); end; end; disk_post_area.number = 0; call pc_abs$unwire_abs (temp_astep, 0, 3); call release_temp_segment_ (Me, temp_seg_ptr, code); return; end; %page; no_parse: proc (arg_list_ptr, arg_num, info_ptr, code); /* called by bce_parse_disk_spec when it doesn't like something */ dcl arg_list_ptr ptr parameter; dcl arg_num fixed bin parameter; dcl code fixed bin (35) parameter; dcl info_ptr ptr parameter; call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, arg_list_ptr); if arg = "-force" | arg = "-fc" then force = "1"b; else do; code = error_table_$bad_arg; call com_err_ (code, Me, "^a", arg); end; return; end no_parse; %page; %include bce_subsystem_info_; %page; %include bootload_post_area; %page; %include disk_pack; %page; %include fs_dev_types; %page; %include fs_vol_label; %page; %include pvt; %page; %include pvte; end bce_copy_disk;  bce_display_disk_label.pl1 11/11/89 1134.3r w 11/11/89 0826.2 26865 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-01-14,Fawcett), approve(86-04-11,MCR7383), audit(86-05-14,Farley), install(86-07-17,MR12.0-1097): Changed to add Subvolume support. END HISTORY COMMENTS */ bce_display_disk_label: proc (p_ss_info_ptr); /* Program written by Allen Ball June of '84 to display a disk label in bce. */ /* format: style4,initcol1,indattr,declareind8,dclind4,idind35,ifthenstmt,ifthen,^indproc,delnl,insnl */ dcl addr builtin; dcl arg char (arg_len) based (arg_ptr); dcl arg_count fixed bin; dcl arg_len fixed bin (21); dcl arg_ptr ptr; dcl code fixed bin (35); dcl disk_name_pvtx entry (char (8), fixed bin (17), fixed bin (35)); dcl com_err_ entry options (variable); dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin (35)); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl display_disk_label_ entry (ptr); dcl devname char (8); dcl ioa_ entry options (variable); dcl me char (18) static options (constant) init ("display_disk_label"); dcl 1 my_label aligned like label; dcl p_ss_info_ptr ptr parameter; dcl pvtx fixed bin; dcl read_disk_label entry (fixed bin, ptr, char (*), fixed bin (35)); dcl reason char (128); ss_info_ptr = p_ss_info_ptr; call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code); if code ^= 0 then do; call com_err_ (code, me); return; end; if arg_count ^= 1 then do; call ioa_ ("Usage:^/ display_disk_label {device}"); return; end; call cu_$arg_ptr_rel (1, arg_ptr, arg_len, code, ss_info.arg_list_ptr); if code ^= 0 then do; call com_err_ (code, me); return; end; pvtp = addr (pvt$); pvt_arrayp = addr (pvt.array); devname = arg; call disk_name_pvtx (devname, pvtx, code); /* validate name and get the pvtx */ if code ^= 0 then do; /* not a valid name or valid drive */ call com_err_ (code, me, "^a", arg); return; end; call read_disk_label (pvtx, addr (my_label), reason, code); if code ^= 0 then call com_err_ (code, me, "^a", reason); else call display_disk_label_ (addr (my_label)); return; /* format: ^insnl */ %page; %include bce_subsystem_info_; %page; %include fs_vol_label; %page; %include pvt; %page; %include pvte; end /* bce_display_disk_label */;  bce_get_flagbox.pl1 11/11/89 1134.3r w 11/11/89 0826.3 40068 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ bce_get_flagbox: proc (P_ss_info_ptr); /* Version of get_flagbox for bce. Stolen by Keith Loepere, December 1983. */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ dcl P_ss_info_ptr ptr parameter; dcl active_fnc_err_ entry options (variable); dcl active_function bit (1) aligned; /* as opposed to command usage */ dcl addbitno builtin; dcl addr builtin; dcl af_return char (af_return_len) based (af_return_ptr) var; /* return for active function */ dcl af_return_len fixed bin (21); dcl af_return_ptr ptr; dcl arg char (arg_len) based (arg_ptr); /* command line arg */ dcl arg_count fixed bin; dcl arg_len fixed bin (21); dcl arg_ptr ptr; dcl bit_ptr ptr; /* to bit in flagbox to examine/set */ dcl code fixed bin (35); dcl com_err_ entry options (variable); dcl cu_$af_return_arg_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin); dcl error variable entry options (variable); dcl error_table_$badopt fixed bin (35) ext; dcl flag_num fixed bin; /* which flag bit in flagbox */ dcl flagbox_bit bit (1) based (bit_ptr); /* bit in flagbox flags */ dcl ioa_ entry options (variable); dcl me char (11); /* program name */ dcl old_value char (256) var; /* result of command */ dcl option char (12); /* value desired */ dcl requote_string_ entry (char (*)) returns (char (*)); dcl rtrim builtin; dcl set bit (1) aligned; /* as opposed to get operation */ set = "0"b; me = "get_flagbox"; go to join; bce_set_flagbox: entry (P_ss_info_ptr); set = "1"b; me = "set_flagbox"; join: ss_info_ptr = P_ss_info_ptr; arg_list_ptr = ss_info.arg_list_ptr; call cu_$af_return_arg_rel (arg_count, af_return_ptr, af_return_len, code, arg_list_ptr); active_function = (code = 0); if active_function then error = active_fnc_err_; else error = com_err_; if set then if arg_count ^= 2 then do; call error (0, me, "Usage is: set_flagbox name old_value"); return; end; else ; else if arg_count ^= 1 then do; call error (0, me, "Usage is: get_flagbox name"); return; end; fgbxp = addr (flagbox$); call cu_$arg_ptr_rel (1, arg_ptr, arg_len, code, arg_list_ptr); option = arg; if option = "bce_command" then old_value = rtrim (fgbx.return_to_bce_command); else do; flag_num = cv_dec_check_ (option, code); if code ^= 0 then do; do flag_num = 1 to 36 while (option ^= flagbox_flag_names (flag_num)); end; end; if flag_num <= 36 then bit_ptr = addbitno (addr (fgbx.flags), flag_num - 1); else if option = "ssenb" then bit_ptr = addr (fgbx.ssenb); else if option = "manual_crash" then bit_ptr = addr (fgbx.manual_crash); else if option = "call_bce" then bit_ptr = addr (fgbx.call_bce); else if option = "shut" then bit_ptr = addr (fgbx.shut); else go to fail1; if flagbox_bit then old_value = "true"; else old_value = "false"; end; if set then do; call cu_$arg_ptr_rel (2, arg_ptr, arg_len, code, arg_list_ptr); if option = "bce_command" then fgbx.return_to_bce_command = arg; else do; if arg = "true" then flagbox_bit = "1"b; else if arg = "false" then flagbox_bit = "0"b; else do; code = error_table_$badopt; go to fail; end; end; end; if active_function then af_return = requote_string_ ((old_value)); else if ^set then call ioa_ (old_value); return; fail1: code = error_table_$badopt; fail: call error (code, me, "^a", arg); return; %page; %include bce_subsystem_info_; %page; %include flagbox; %page; %include flagbox_flags; end;  bce_lock_mca.pl1 11/11/89 1134.3r w 11/11/89 0826.3 28431 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-09-11,Farley), approve(85-09-11,MCR6979), audit(86-02-28,Coppola), install(86-03-21,MR12.0-1033): Created for IMU support (control MCA). END HISTORY COMMENTS */ bce_lock_mca: proc (p_ss_info_ptr); /* Written by Paul K Farley June 1985 to allow the MCA operator interface to be either disabled (locked) or enabled (unlocked). */ /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */ dcl Me char (10); dcl arg_count fixed bin; dcl arg char (arg_len) based (arg_ptr); dcl arg_len fixed bin (21); dcl arg_ptr ptr; dcl args_expected fixed bin; dcl code fixed bin (35); dcl lock_mca bit (1); dcl mca_number fixed bin (35); dcl mca_to_unlock char (4); dcl P99 pic "99" based; dcl com_err_ entry () options (variable); dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin (35)); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl ioa_ entry () options (variable); dcl ocdcm_$reconfigure entry (char (4), fixed bin, fixed bin (35)); dcl p_ss_info_ptr ptr parameter; dcl convert builtin; %page; lock_mca = "1"b; Me = "lock_mca"; args_expected = 0; goto join; bce_lock_mca$bce_unlock_mca: entry (p_ss_info_ptr); lock_mca = "0"b; Me = "unlock_mca"; args_expected = 1; join: ss_info_ptr = p_ss_info_ptr; call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code); if code ^= 0 then do; call com_err_ (code, Me); return; end; if arg_count ^= args_expected then do; if lock_mca then call ioa_ ("lock_mca: This command takes NO arguments.^/Usage: lock_mca"); else call ioa_ ("unlock_mca: This command requires one argument.^/Usage: unlock_mca MCA_NUMBER"); return; end; if lock_mca then do; call ocdcm_$reconfigure ("", LOCK_MCA_INPUT, code); call ioa_ ("lock_mca: MCA interface^[ NOT^] locked.", (code ^= 0)); return; end; call cu_$arg_ptr_rel (1, arg_ptr, arg_len, code, ss_info.arg_list_ptr); mca_number = cv_dec_check_ (arg, code); if code ^= 0 | mca_number < 0 | mca_number > 31 then do; call ioa_ ("unlock_mca: Illegal MCA number. Range is 0 - 31."); return; end; mca_to_unlock = "M_" || convert (P99, mca_number); call ocdcm_$reconfigure (mca_to_unlock, UNLOCK_MCA_INPUT, code); call ioa_ ("unlock_mca: MCA(^a) interface^[ NOT^] unlocked.", convert (P99, mca_number), (code ^= 0)); return; %page; %include bce_subsystem_info_; %page; %include opc_reconfig_options; end bce_lock_mca;  bce_parse_disk_spec.pl1 11/11/89 1134.3r w 11/11/89 0826.3 92745 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1986 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-01-17,Fawcett), approve(86-01-17,MCR7220), audit(86-05-14,Farley), install(86-07-17,MR12.0-1097): Extracted from bce_test_disk (Allen Ball) by Keith Loepere, This is used by bce_copy_disk, and bce_test_disk. 2) change(86-01-17,Fawcett), approve(86-04-11,MCR7383), audit(86-05-14,Farley), install(86-07-17,MR12.0-1097): Changed to support subvolumes by using last_sv_rec_num (device_type) instead of last_rec_num (device_type). END HISTORY COMMENTS */ bce_parse_disk_spec: proc (caller, arg_list_ptr, arg_num, device_type, p_labelp, f_record, l_record, caller_arg_parser, info_ptr, code); /* Routine to parse a bce specification of a disk range, interspersed with other control arguments. Extracted from bce_test_disk (Allen Ball) by Keith Loepere, March 1985. */ /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */ /* Parameters */ dcl arg_list_ptr ptr parameter; /* to arg list for calling program */ dcl arg_num fixed bin parameter;/* arg pos in arg list to start with */ dcl caller char (32) parameter;/* name for error messages */ dcl caller_arg_parser entry (ptr, fixed bin, ptr, fixed bin (35)) parameter; /* routine to pass of to for a non disk spec arg */ dcl code fixed bin (35) parameter; dcl device_type fixed bin parameter;/* as in fs_dev_types */ dcl f_record fixed bin (18) parameter; /* first rec in range */ dcl info_ptr ptr parameter; /* passed to caller_arg_parser */ dcl l_record fixed bin parameter;/* last rec in range */ dcl p_labelp ptr parameter; /* to label for disk */ /* Constants */ dcl First fixed bin (18) static options (constant) init (-1); dcl Last fixed bin (18) static options (constant) init (-2); dcl Octal fixed bin static options (constant) init (8); dcl Unassigned fixed bin (18) static options (constant) init (-3); /* Variables */ dcl arg_count fixed bin; dcl arg_len fixed bin (21); dcl arg_ptr ptr; dcl n_record fixed bin (18); /* number of records to be read or written after f_record or before l_record */ dcl number fixed bin (35); dcl partition char (4); dcl parts_index fixed bin; /* index of part in label list */ /* Based */ dcl arg char (arg_len) based (arg_ptr); /* Entries */ dcl com_err_ entry () options (variable); dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin (35)); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl cv_integer_string_check_ entry (char (*), fixed bin, fixed bin (35)) returns (fixed bin (35)); /* External */ dcl error_table_$bad_arg fixed bin (35) ext static; dcl error_table_$dev_offset_out_of_bounds fixed bin (35) ext static; dcl error_table_$fsdisk_not_storage fixed bin (35) ext static; dcl error_table_$noarg fixed bin (35) ext static; dcl error_table_$nopart fixed bin (35) ext static; %page; f_record = Unassigned; l_record = Unassigned; n_record = Unassigned; partition = ""; labelp = p_labelp; call cu_$arg_count_rel (arg_count, arg_list_ptr, code); do arg_num = arg_num to arg_count; call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, arg_list_ptr); if arg = "-partition" | arg = "-part" then do; if label.Multics ^= Multics_ID_String then do; code = error_table_$fsdisk_not_storage; call com_err_ (code, caller, "partition"); return; end; call get_next_arg ("partition"); partition = arg; end; else if arg = "-record" | arg = "-rec" then do; if f_record ^= Unassigned | l_record ^= Unassigned then go to bad_rec_spec; call get_next_arg ("record"); number = cv_integer_string_check_ (arg, Octal, code); if code = 0 then do; if number < 0 then goto no_neg_rec_nums; else do; f_record = number; l_record = number; end; end; else do; if arg = "first" then do; f_record = First; l_record = First; end; else if arg = "last" then do; f_record = Last; l_record = Last; end; else goto bad_arg; end; end; else if arg = "-first_record" | arg = "-frec" then do; call get_next_arg ("first_record"); if f_record ^= Unassigned then goto bad_rec_spec; number = cv_integer_string_check_ (arg, Octal, code); if code = 0 then do; if number < 0 then goto no_neg_rec_nums; else f_record = number; end; else do; if arg = "first" then f_record = First; else if arg = "last" then f_record = Last; else goto bad_arg; end; end; else if arg = "-n_records" | arg = "-nrec" then do; if n_record ^= Unassigned then goto bad_rec_spec; call get_next_arg ("n_records"); number = cv_integer_string_check_ (arg, Octal, code); if code = 0 then do; if number <= 0 then goto no_neg_rec_nums; n_record = number; end; else goto bad_arg; end; else if arg = "-last_record" | arg = "-lrec" then do; if l_record ^= Unassigned then goto bad_rec_spec; call get_next_arg ("last_record"); number = cv_integer_string_check_ (arg, Octal, code); if code = 0 then do; if number < 0 then do; no_neg_rec_nums: code = error_table_$dev_offset_out_of_bounds; call com_err_ (code, caller, "^d", number); return; end; else l_record = number; end; else do; if arg = "first" then l_record = First; else if arg = "last" then l_record = Last; else goto bad_arg; end; end; else do; call caller_arg_parser (arg_list_ptr, arg_num, info_ptr, code); if code ^= 0 then return; /* routine printed error */ end; next_arg: end; %page; /* Now figure out what f_record and l_record are. */ if f_record ^= Unassigned & l_record ^= Unassigned & n_record ^= Unassigned then goto bad_rec_spec; /* -frec, -lrec, and -nrec are (all three) incompatible */ if partition ^= "" then do; do parts_index = 1 to label.nparts while (label.parts (parts_index).part ^= partition); end; if parts_index > label.nparts then do; code = error_table_$nopart; call com_err_ (code, caller, "^a", partition); return; end; if n_record = Unassigned then do; if f_record = Unassigned | f_record = First then f_record = label.parts (parts_index).frec; else if f_record = Last then f_record = label.parts (parts_index).frec + label.parts (parts_index).nrec - 1; else f_record = f_record + label.parts (parts_index).frec; if l_record = Unassigned | l_record = Last then l_record = label.parts (parts_index).frec + label.parts (parts_index).nrec - 1; else if l_record = First then l_record = label.parts (parts_index).frec; else l_record = l_record + label.parts (parts_index).frec; end; else do; if f_record ^= Unassigned then do; if f_record = First then f_record = label.parts (parts_index).frec; else if f_record = Last then f_record = label.parts (parts_index).frec + label.parts (parts_index).nrec - 1; else f_record = f_record + label.parts (parts_index).frec; l_record = f_record + n_record - 1; end; else if l_record ^= Unassigned then do; if l_record = First then l_record = label.parts (parts_index).frec; else if l_record = Last then l_record = label.parts (parts_index).frec + label.parts (parts_index).nrec - 1; else l_record = l_record + label.parts (parts_index).frec; f_record = l_record - n_record + 1; end; end; end; %page; else do; if n_record = Unassigned then do; if f_record = Unassigned | f_record = First then f_record = first_rec_num (device_type); else if f_record = Last then f_record = last_sv_rec_num (device_type); if l_record = Unassigned | l_record = Last then l_record = last_sv_rec_num (device_type); else if l_record = First then l_record = first_rec_num (device_type); end; else do; if f_record ^= Unassigned then do; if f_record = First then f_record = first_rec_num (device_type); else if f_record = Last then f_record = last_sv_rec_num (device_type); l_record = f_record + n_record - 1; end; else if l_record ^= Unassigned then do; if l_record = First then l_record = first_rec_num (device_type); else if l_record = Last then l_record = last_sv_rec_num (device_type); f_record = l_record - n_record + 1; end; end; end; %page; /* Out of range checks */ if f_record < first_rec_num (device_type) | f_record > first_rec_num (device_type) + rec_per_dev (device_type) - 1 then do; code = error_table_$dev_offset_out_of_bounds; call com_err_ (code, caller, "^d", f_record); return; end; if l_record < first_rec_num (device_type) | l_record > first_rec_num (device_type) + rec_per_dev (device_type) - 1 then do; code = error_table_$dev_offset_out_of_bounds; call com_err_ (code, caller, "^d", l_record); return; end; if l_record < f_record then do; code = error_table_$dev_offset_out_of_bounds; call com_err_ (code, caller, "^d is less than ^d", l_record, f_record); return; end; code = 0; /* passes all tests */ RETURN: return; %page; get_next_arg: proc (arg_needed); dcl arg_needed char (32); arg_num = arg_num + 1; if arg_num > arg_count then do; code = error_table_$noarg; call com_err_ (code, caller, arg_needed); go to RETURN; end; call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, arg_list_ptr); return; end get_next_arg; bad_rec_spec: code = error_table_$dev_offset_out_of_bounds; call com_err_ (0, caller, "Incompatible use of record specifiers."); return; bad_arg: code = error_table_$bad_arg; call com_err_ (code, caller, "^a", arg); return; %page; %include fs_dev_types; %page; %include fs_vol_label; end bce_parse_disk_spec;  bce_query_af.pl1 11/11/89 1134.3r w 11/11/89 0826.3 26073 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ bce_query_af: proc (P_ss_info_ptr); /* Version of query and response active functions for bce. Keith Loepere, January 1984. */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ dcl P_ss_info_ptr ptr parameter; dcl active_fnc_err_ entry options (variable); dcl active_function bit (1) aligned; /* as opposed to command usage */ dcl af_return char (af_return_len) based (af_return_ptr) var; /* return for active function */ dcl af_return_len fixed bin (21); dcl af_return_ptr ptr; dcl arg char (arg_len) based (arg_ptr); /* command line arg */ dcl arg_count fixed bin; dcl arg_len fixed bin (21); dcl arg_ptr ptr; dcl bce_query entry options (variable); dcl bce_query$yes_no entry options (variable); dcl code fixed bin (35); dcl com_err_ entry options (variable); dcl cu_$af_return_arg_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl error variable entry options (variable); dcl ioa_ entry options (variable); dcl me char (11); /* program name */ dcl must_be_yes_no bit (1) aligned; dcl requote_string_ entry (char (*)) returns (char (*)); dcl response char (256); dcl rtrim builtin; dcl yes_no bit (1); me = "query"; must_be_yes_no = "1"b; go to join; bce_response_af: entry (P_ss_info_ptr); me = "response"; must_be_yes_no = "0"b; join: ss_info_ptr = P_ss_info_ptr; arg_list_ptr = ss_info.arg_list_ptr; call cu_$af_return_arg_rel (arg_count, af_return_ptr, af_return_len, code, arg_list_ptr); active_function = (code = 0); if active_function then error = active_fnc_err_; else error = com_err_; if arg_count ^= 1 then do; call error (0, me, "Usage is: ^a question", me); return; end; call cu_$arg_ptr_rel (1, arg_ptr, arg_len, code, ss_info.arg_list_ptr); if must_be_yes_no then do; call bce_query$yes_no (yes_no, "^a ", arg); if yes_no then response = "true"; else response = "false"; end; else call bce_query (response, "^a ", arg); if active_function then af_return = requote_string_ (rtrim (response)); else call ioa_ (rtrim (response)); return; %page; %include bce_subsystem_info_; end;  bce_ready.pl1 11/11/89 1134.3r 11/11/89 0826.3 16614 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ bce_ready: proc (prompt); /* print ready message for bootload Multics. Written June 1983 by Keith Loepere. */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ dcl addr builtin; dcl bce_data$error_put_chars entry (ptr, ptr, fixed bin, fixed bin (35)) ext variable; dcl buffer char (40); dcl buffer_len fixed bin; dcl clock builtin; dcl code fixed bin (35); dcl date_time_ entry (fixed bin (71), char (*)); dcl ioa_$rsnnl entry() options(variable); dcl length builtin; dcl new_line bit (1) aligned; dcl output_buffer char (buffer_len) based (addr (buffer)); dcl prompt char (*) parameter; dcl substr builtin; dcl time_string char (24); new_line = "1"b; go to join; nnl: entry (prompt); new_line = "0"b; join: call date_time_ (clock (), time_string); call ioa_$rsnnl ("^a (^a) ^a: ", buffer, buffer_len, prompt, COLLECTION_1_PHASE_NAMES (sys_info$collection_1_phase), substr (time_string, 11, 6)); if new_line then do; buffer_len = buffer_len + 1; substr (output_buffer, buffer_len, 1) = " "; end; call bce_data$error_put_chars (addr (bce_data$error_put_chars), addr (output_buffer), length (output_buffer), code); return; %page; %include collection_1_phases; end;  bce_severity.pl1 11/11/89 1134.3r w 11/11/89 0826.3 23193 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ bce_severity: proc (P_ss_info_ptr); /* Version of severity for bce. Keith Loepere, January 1984. */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ dcl P_ss_info_ptr ptr parameter; dcl active_fnc_err_ entry options (variable); dcl active_function bit (1) aligned; /* as opposed to command usage */ dcl af_return char (af_return_len) based (af_return_ptr) var; /* return for active function */ dcl af_return_len fixed bin (21); dcl af_return_ptr ptr; dcl arg char (arg_len) based (arg_ptr); /* command line arg */ dcl arg_count fixed bin; dcl arg_len fixed bin (21); dcl arg_ptr ptr; dcl bce_dump$severity entry () returns (fixed bin); dcl code fixed bin (35); dcl com_err_ entry options (variable); dcl cu_$af_return_arg_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl error variable entry options (variable); dcl error_table_$badopt fixed bin (35) ext; dcl error_table_$not_act_fnc fixed bin (35) ext; dcl ioa_ entry options (variable); dcl me char (8) init ("severity") static options (constant);/* program name */ dcl value fixed bin; ss_info_ptr = P_ss_info_ptr; arg_list_ptr = ss_info.arg_list_ptr; call cu_$af_return_arg_rel (arg_count, af_return_ptr, af_return_len, code, arg_list_ptr); active_function = (code = 0); if active_function then error = active_fnc_err_; else error = com_err_; if arg_count ^= 1 then do; call error (0, me, "Usage is: severity command_name"); return; end; call cu_$arg_ptr_rel (1, arg_ptr, arg_len, code, arg_list_ptr); if arg = "dump" then value = bce_dump$severity (); else do; call error (error_table_$badopt, me, "^a", arg); return; end; if active_function then af_return = ltrim (character (value)); else call ioa_ ("^d", value); return; %page; %include bce_subsystem_info_; end;  bce_shutdown_state.pl1 11/11/89 1134.3r w 11/11/89 0826.3 21501 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ bce_shutdown_state: proc (P_ss_info_ptr); /* Fetch the shutdown state from the rpv. Keith Loepere, January 1984. */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ dcl P_ss_info_ptr ptr parameter; dcl active_fnc_err_ entry options (variable); dcl active_function bit (1) aligned; /* as opposed to command usage */ dcl addr builtin; dcl af_return char (af_return_len) based (af_return_ptr) var; /* return for active function */ dcl af_return_len fixed bin (21); dcl af_return_ptr ptr; dcl arg_count fixed bin; dcl character builtin; dcl code fixed bin (35); dcl com_err_ entry options (variable); dcl cu_$af_return_arg_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl error variable entry options (variable); dcl ioa_ entry options (variable); dcl ltrim builtin; dcl me char (14) init ("shutdown_state") static options (constant); /* program name */ dcl pvt$root_pvtx fixed bin external; dcl 1 my_label aligned like label; dcl read_disk entry (fixed bin, fixed bin, ptr, fixed bin (35)); ss_info_ptr = P_ss_info_ptr; arg_list_ptr = ss_info.arg_list_ptr; call cu_$af_return_arg_rel (arg_count, af_return_ptr, af_return_len, code, arg_list_ptr); active_function = (code = 0); if active_function then error = active_fnc_err_; else error = com_err_; if arg_count ^= 0 then do; call error (0, me, "Usage is: ^a", me); return; end; labelp = addr (my_label); call read_disk (pvt$root_pvtx, 0, labelp, code); if code ^= 0 then call error (code, me); if active_function then af_return = ltrim (character (label.shutdown_state)); else call ioa_ ("^d", label.shutdown_state); return; %page; %include bce_subsystem_info_; %page; %include fs_vol_label; end;  bce_state.pl1 11/11/89 1134.3r w 11/11/89 0826.3 19080 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ bce_state: proc (P_ss_info_ptr); /* Return state (collection_1_phase) for bce. Keith Loepere, May 1984. */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ dcl P_ss_info_ptr ptr parameter; dcl active_fnc_err_ entry options (variable); dcl active_function bit (1) aligned; /* as opposed to command usage */ dcl af_return char (af_return_len) based (af_return_ptr) var; /* return for active function */ dcl af_return_len fixed bin (21); dcl af_return_ptr ptr; dcl arg_count fixed bin; dcl code fixed bin (35); dcl com_err_ entry options (variable); dcl cu_$af_return_arg_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl error variable entry options (variable); dcl error_table_$not_act_fnc fixed bin (35) ext; dcl ioa_ entry options (variable); dcl me char (9) init ("bce_state") static options (constant);/* program name */ ss_info_ptr = P_ss_info_ptr; arg_list_ptr = ss_info.arg_list_ptr; call cu_$af_return_arg_rel (arg_count, af_return_ptr, af_return_len, code, arg_list_ptr); active_function = (code = 0); if active_function then error = active_fnc_err_; else error = com_err_; if arg_count ^= 0 then do; call error (0, me, "Usage is: bce_state"); return; end; if active_function then af_return = rtrim (COLLECTION_1_PHASE_NAMES ( sys_info$collection_1_phase)); else call ioa_ ("^a", COLLECTION_1_PHASE_NAMES (sys_info$collection_1_phase)); return; %page; %include bce_subsystem_info_; %page; %include collection_1_phases; end;  bce_test_disk.pl1 11/11/89 1134.3r w 11/11/89 0826.3 117378 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-01-17,Fawcett), approve(86-01-17,MCR7220), audit(86-05-14,Farley), install(86-07-17,MR12.0-1097): Keith Loepere to extract disk spec parsing code and call bce_parse_disk_spec (created for bce_copy_disk). 2) change(86-01-17,Fawcett), approve(86-04-11,MCR7383), audit(86-05-14,Farley), install(86-07-17,MR12.0-1097): Changed to support subvolumes by adding call to disk_name_pvtx. END HISTORY COMMENTS */ bce_test_disk: proc (p_ss_info_ptr); /* Written by Allen Ball June of 1984 to replace BOS command TEST. */ /* Modified 85-01-09 ADB to fix d451. 'last' still refers to last record number before alt partition but user can still refer to records past the beginning of the alt partition. */ /* Modified 85-02-09 Keith Loepere, to use bootload disk i/o for performance. */ /* Modified 85-03-10 Keith Loepere to extract disk spec parsing code. */ /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */ /* Constants */ dcl Me char (32) static options (constant) init ("test_disk"); /* Parameters */ dcl p_ss_info_ptr ptr parameter; /* Variables */ dcl arg_count fixed bin; dcl arg_len fixed bin (21); dcl arg_num fixed bin; dcl arg_ptr ptr; dcl code fixed bin (35); dcl device_type fixed bin; /* as in fs_dev_types */ dcl drive char (8); /* device name */ dcl error_on_write bit (1); /* report error for write op, not read */ dcl f_record fixed bin (18); /* first record to be read or written */ dcl force bit (1) aligned; /* don't ask questions */ dcl key char (2); dcl l_record fixed bin (18); /* last record to be read or written */ dcl 1 my_label aligned like label; dcl new_record fixed bin (18); /* first record of new set to read/write */ dcl page_num fixed bin; dcl 1 pattern aligned, 2 word_pattern_len fixed bin, 2 pattern_buffer bit (1024 * 36) aligned; /* build area for pattern to write to disk */ dcl pattern_buffer_ptr ptr; dcl prev_record fixed bin (18); /* last record read/written */ dcl prev_record_in_cylinder fixed bin; /* (0 origin) record number within cylinder (used for detecting cylinder crossing) */ dcl pvtx fixed bin; dcl read_sw bit (1); dcl read_then_write bit (1); dcl records_this_cylinder fixed bin; dcl temp_astep ptr; /* to temp_seg in use */ dcl temp_seg_ptr ptr; /* to temp_seg (which we wire) */ dcl write_then_read bit (1); dcl write_sw bit (1); dcl yes_no bit (1); /* External */ dcl error_table_$bad_arg fixed bin (35) ext static; dcl error_table_$noarg fixed bin (35) ext static; /* Entries */ dcl bce_check_abort entry; dcl disk_name_pvtx entry (char (8), fixed bin (17), fixed bin (35)); dcl bce_parse_disk_spec entry (char (32), ptr, fixed bin, fixed bin, ptr, fixed bin (18), fixed bin (18), entry (ptr, fixed bin, ptr, fixed bin (35)), ptr, fixed bin (35)); dcl bce_query$yes_no entry options (variable); dcl bootload_disk_io$read entry (fixed bin, fixed bin (18), fixed bin, ptr, fixed bin (35)); dcl bootload_disk_io$write entry (fixed bin, fixed bin (18), fixed bin, ptr, fixed bin (35)); dcl com_err_ entry () options (variable); dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin (35)); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl cv_oct_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl get_ptrs_$given_segno entry (fixed bin (15)) returns (ptr); dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35)); dcl ioa_ entry () options (variable); dcl pc_abs$unwire_abs entry (ptr, fixed bin, fixed bin); dcl pc_abs$wire_abs_contig entry (ptr, fixed bin, fixed bin, fixed bin (35)); dcl read_disk entry (fixed bin, fixed bin (18), ptr, fixed bin (35)); dcl release_temp_segment_ entry (char (*), ptr, fixed bin (35)); /* Based */ dcl arg char (arg_len) based (arg_ptr); dcl bootload_disk_buffer (0:2) bit (1024 * 36) aligned based (temp_seg_ptr); dcl word bit (36) aligned based; dcl word_pattern bit (word_pattern_len * 36) based (pattern_buffer_ptr) aligned; /* Misc */ dcl cleanup condition; dcl (addr, addrel, copy, divide, max, min, mod, null, segno, unspec) builtin; %page; ss_info_ptr = p_ss_info_ptr; pattern_buffer_ptr = addr (pattern.pattern_buffer); pvtp = addr (pvt$); pvt_arrayp = addr (pvt.array); call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code); if code ^= 0 then do; call com_err_ (code, Me); return; end; if arg_count < 2 then do; call ioa_ ("Usage:^/ ^a ( ...)", Me); return; end; arg_num = 1; call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, ss_info.arg_list_ptr); if code ^= 0 then do; call com_err_ (code, Me, "Can't get arg"); return; end; if arg_len < 1 | arg_len > 2 then goto bad_key; key = arg; if ^(key = "r" | key = "w" | key = "rw" | key = "wr") then do; bad_key: call ioa_ ("^a: Unrecognized key - ^a", Me, arg); return; end; read_sw = (key = "r"); write_sw = (key = "w"); read_then_write = (key = "rw"); write_then_read = (key = "wr"); arg_num = 2; call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, ss_info.arg_list_ptr); drive = arg; call disk_name_pvtx (drive, pvtx, code); if code ^= 0 then do; call com_err_ (code, Me, "^a", arg); return; end; pattern.word_pattern_len = 0; force = "0"b; labelp = addr (my_label); call read_disk (pvtx, (LABEL_ADDR), labelp, code); if code ^= 0 then do; call com_err_ (code, Me, "Could not read label of ^a.", drive); return; end; device_type = pvt_array (pvtx).device_type; arg_num = 3; call bce_parse_disk_spec (Me, ss_info.arg_list_ptr, arg_num, device_type, labelp, f_record, l_record, pattern_parse, addr (pattern), code); if code ^= 0 then return; /* Now that f_record and l_record are assigned we will give them their chance to turn back. */ if write_sw | write_then_read then do; if f_record = l_record then call ioa_ ("Writing to record number ^oo on ^a.", f_record, drive); else call ioa_ ("Writing to records ^oo through ^oo (inclusive) on ^a.", f_record, l_record, drive); if ^force then do; call bce_query$yes_no (yes_no, "Do you wish to write to the ^[non ^;^]^a - ^a? ", (label.Multics ^= Multics_ID_String), Multics_ID_String, drive); if ^yes_no then return; end; end; if pattern.word_pattern_len = 0 then unspec (pattern.pattern_buffer) = "0"b; else pattern.pattern_buffer = copy (word_pattern, divide (1024, pattern.word_pattern_len, 17) + 1); %page; /* Now for the real work. The basic loop structure below implements the 4 keys as follows. For "r", we simply keep reading into our wired buffer. For "w", we copy our pattern into the wired buffer once, and then keep writing from it. For "rw", we read into and write back from the wired buffer. For "wr", though, we must copy the pattern into the wired buffer each time through. The i/o is done backwards, and (normally) three pages at a time. This is to minimize latency between i/o's, to maximize the time we have between i/o's to get our next request in, within the constraints that bootload_disk_io can handle a maximum of 4 pages at a time. Three pages is optimal both for 451 and 501 style drives. However, we don't want to read/write a set of pages that cross a cylinder boundary, so we check for this. Also, if an i/o error occurs, we go back to reading/writing a single page, so that we can eventually track down which page(s) really can't be read/written. */ /* try to find wired work area */ temp_seg_ptr = null; call get_temp_segment_ (Me, temp_seg_ptr, code); if code ^= 0 then do; call com_err_ (code, Me, "Unable to get temp disk buffer."); return; end; temp_astep = get_ptrs_$given_segno (segno (temp_seg_ptr)); call pc_abs$wire_abs_contig (temp_astep, 0, 3, code); if code ^= 0 then do; call com_err_ (code, Me, "Unable to wire temp disk buffer."); call release_temp_segment_ (Me, temp_seg_ptr, code); return; end; on cleanup call clean_up; /* remember, this is only called during bce_check_abort */ if write_sw then do page_num = 0 to 2; bootload_disk_buffer (page_num) = pattern.pattern_buffer; end; prev_record = l_record + 1; prev_record_in_cylinder = mod (prev_record, rec_per_cyl (device_type)); do while (prev_record > f_record); /* stop when processed lowest record */ if prev_record_in_cylinder = 0 then prev_record_in_cylinder = rec_per_cyl (device_type); /* next cylinder */ records_this_cylinder = min (prev_record_in_cylinder, 3); /* num pages to do this time around */ new_record = max (prev_record - records_this_cylinder, f_record); /* don't go over requested area */ records_this_cylinder = prev_record - new_record; /* real amt to do */ retry: call bce_check_abort; if write_then_read then do; do page_num = 0 to records_this_cylinder - 1; bootload_disk_buffer (page_num) = pattern.pattern_buffer; end; call bootload_disk_io$write (pvtx, new_record, records_this_cylinder, temp_seg_ptr, code); if code ^= 0 then do; error_on_write = "1"b; go to io_error; end; end; if ^write_sw then do; call bootload_disk_io$read (pvtx, new_record, records_this_cylinder, temp_seg_ptr, code); if code ^= 0 then do; error_on_write = "0"b; go to io_error; end; end; if read_then_write | write_sw then do; call bootload_disk_io$write (pvtx, new_record, records_this_cylinder, temp_seg_ptr, code); if code ^= 0 then do; error_on_write = "1"b; io_error: if records_this_cylinder > 1 then do; /* try i/o on just 1 record to find fault one */ new_record = prev_record - 1; records_this_cylinder = 1; go to retry; end; else do; call com_err_ (0, Me, "Could not ^[write^;read^] record ^oo on ^a.", error_on_write, new_record, drive); go to next_record; end; end; end; if write_then_read then do page_num = 0 to records_this_cylinder - 1; if bootload_disk_buffer (page_num) ^= pattern.pattern_buffer then call ioa_ ("^a: What was read did not match what was written at record ^oo of ^a.", Me, new_record + page_num, drive); end; next_record: prev_record = new_record; prev_record_in_cylinder = prev_record_in_cylinder - records_this_cylinder; end; call clean_up; return; clean_up: proc; call pc_abs$unwire_abs (temp_astep, 0, 3); call release_temp_segment_ (Me, temp_seg_ptr, code); return; end; %page; pattern_parse: proc (arg_list_ptr, arg_num, info_ptr, code); /* called by bce_parse_disk_spec when it doesn't like something, most likely a pattern spec */ dcl arg_list_ptr ptr parameter; dcl arg_num fixed bin parameter; dcl code fixed bin (35) parameter; dcl info_ptr ptr parameter; dcl number fixed bin (35); call cu_$arg_count_rel (arg_count, arg_list_ptr, code); call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, arg_list_ptr); if arg = "-force" | arg = "-fc" then force = "1"b; else if arg = "-pattern" | arg = "-pat" then do; pattern.word_pattern_len = 0; if key = "rw" | key = "r" then do; code = error_table_$bad_arg; call com_err_ (code, Me, "-pattern is incompatible with the ^a key.", key); return; end; next_word: arg_num = arg_num + 1; if arg_num > arg_count then go to end_pattern; call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, arg_list_ptr); number = cv_oct_check_ (arg, code); if code ^= 0 then do; /* not a number */ arg_num = arg_num - 1; /* most likely a new control arg */ end_pattern: if pattern.word_pattern_len ^= 0 then code = 0; else do; /* pattern spec missing */ code = error_table_$noarg; call com_err_ (code, Me, "pattern"); end; return; end; else do; addrel (pattern_buffer_ptr, pattern.word_pattern_len) -> word = unspec (number); pattern.word_pattern_len = pattern.word_pattern_len + 1; goto next_word; end; end; else do; code = error_table_$bad_arg; call com_err_ (code, Me, "^a", arg); return; end; code = 0; return; end pattern_parse; %page; %include bce_subsystem_info_; %page; %include disk_pack; %page; %include fs_dev_types; %page; %include fs_vol_label; %page; %include pvt; %page; %include pvte; end bce_test_disk;  bootload_fs_cmds_.pl1 11/11/89 1134.3r w 11/11/89 0826.3 103014 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ bootload_fs_cmds_: proc; return; /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ /* Bootload multics commands to directly operate on bootload fs objects. Initially coded March 1983 by Keith Loepere Modified August 1983 by Keith Loepere for new bce switches */ %include bce_subsystem_info_; %include bootload_fs_list; dcl active bit (1) aligned; /* called as an active function */ dcl active_fnc_err_ entry options (variable); dcl arg char (arg_len) based (arg_ptr); dcl arg2 char (arg_len2) based (arg_ptr2); dcl arg_count fixed bin; dcl arg_len fixed bin (21); dcl arg_len2 fixed bin (21); dcl arg_ptr ptr; dcl arg_ptr2 ptr; dcl bce_data$put_chars entry (ptr, ptr, fixed bin, fixed bin (35)) ext variable; dcl bce_query$yes_no entry options (variable); dcl bootload_file_partition$ external; dcl bootload_fs_$get_ptr entry (char (*), ptr, fixed bin (21), fixed bin (35)); dcl bootload_fs_$delete entry (char (*), fixed bin (35)); dcl bootload_fs_$init entry (bit (1) aligned, fixed bin (19), fixed bin (35)); dcl bootload_fs_$list entry (area (*), ptr, fixed bin (35)); dcl bootload_fs_$rename entry (char (*), char (*), fixed bin (35)); dcl check_star_name_$entry entry (char (*), fixed bin (35)); dcl code fixed bin (35); dcl com_err_ entry options (variable); dcl cu_$af_return_arg_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin (35)); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl dseg$ (0:511) bit (72) aligned external; dcl error entry options (variable) variable; /* who prints our error */ dcl error_table_$bad_arg fixed bin (35) ext static; dcl error_table_$bad_equal_name fixed bin (35) ext static; dcl error_table_$badstar fixed bin (35) ext static; dcl error_table_$noentry fixed bin (35) ext static; dcl error_table_$not_act_fnc fixed bin (35) ext static; dcl file char (file_len) based (file_ptr); /* to be printed */ dcl file_found bit (1) aligned; /* a file matched the current star name */ dcl file_len fixed bin (21); dcl file_num fixed bin; /* loop index */ dcl file_ptr ptr; dcl get_equal_name_ entry (char (*), char (*), char (32), fixed bin (35)); dcl get_equal_name_$check_equal_name_ entry (char (*), fixed bin (35)); dcl i fixed bin; /* loop index */ dcl ioa_ entry options (variable); dcl length builtin; dcl match_star_name_ entry (char (*), char (*), fixed bin (35)); dcl me char (12); dcl my_area area (2048); /* for listing files */ dcl new_name char (32); /* for renaming */ dcl request_abort_ condition; /* abort command line */ dcl result char (result_len) based (result_ptr) var; /* active function result */ dcl result_len fixed bin (21); dcl result_ptr ptr; dcl sdw_util_$get_size entry (ptr, fixed bin (19)); dcl seg_size fixed bin (19); /* of initted partition */ dcl yes_no bit (1); init: entry (ss_info_ptr); me = "init_files"; call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code); if code ^= 0 then do; call com_err_ (code, me); signal request_abort_; end; if arg_count = 0 then do; call bce_query$yes_no (yes_no, "Do you really want to initialize the bootload file system? "); if ^yes_no then go to TERMINATE; end; else if arg_count > 1 then do; call com_err_ (0, me, "Usage is: ^a {-force | -fc}", me); go to TERMINATE; end; else do; call cu_$arg_ptr_rel (1, arg_ptr, arg_len, code, ss_info.arg_list_ptr); if ^(arg = "-force" | arg = "-fc") then do; call com_err_ (error_table_$bad_arg, me, "^a", arg); go to TERMINATE; end; end; call sdw_util_$get_size (addr (dseg$ (segno (addr (bootload_file_partition$)))), seg_size); call bootload_fs_$init ("1"b, seg_size, code); if code ^= 0 then do; call com_err_ (code, me); go to TERMINATE; end; return; print: entry (ss_info_ptr); me = "print"; call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code); if code ^= 0 then do; call com_err_ (code, me); signal request_abort_; end; if arg_count ^= 1 then do; call com_err_ (0, me, "Usage is: ^a .", me); go to TERMINATE; end; call cu_$arg_ptr_rel (1, arg_ptr, arg_len, code, ss_info.arg_list_ptr); call bootload_fs_$get_ptr (arg, file_ptr, file_len, code); if code ^= 0 then do; call com_err_ (code, me, "^a", arg); go to TERMINATE; end; call bce_data$put_chars (addr (bce_data$put_chars), file_ptr, (file_len), code); return; list: entry (ss_info_ptr); me = "list"; call cu_$af_return_arg_rel (arg_count, result_ptr, result_len, code, ss_info.arg_list_ptr); if code = error_table_$not_act_fnc then do; active = "0"b; error = com_err_; call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code); end; else do; active = "1"b; error = active_fnc_err_; result = ""; end; if code ^= 0 then do; call error (code, me); signal request_abort_; end; if active & arg_count < 1 then do; call error (0, me, "Usage: [^a ]", me); go to TERMINATE; end; do i = 1 to arg_count; /* validate starnames */ call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, ss_info.arg_list_ptr); call check_star_name_$entry (arg, code); if code = error_table_$badstar then do; call com_err_ (code, me, "^a", arg); go to TERMINATE; end; end; call bootload_fs_$list (my_area, bootload_fs_list_ptr, code); if code ^= 0 then do; if code = error_table_$noentry then do; if active then result = ""; else call ioa_ ("No files."); return; end; else do; call error (code, me); go to TERMINATE; end; end; if ^ active then call ioa_ ("Length^-File Name^/"); file_found = "0"b; do i = min (1, arg_count) to arg_count; /* zero pass => ** for 0 args */ if i > 0 then call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, ss_info.arg_list_ptr); do file_num = 1 to bootload_fs_list.n_files; /* match all unmatched file names against current star name */ if i > 0 & (bootload_fs_list.files (file_num).name ^= "") then call match_star_name_ (bootload_fs_list.files (file_num).name, arg, code); else code = 0; if code = 0 then do; if active then result = result || bootload_fs_list.files (file_num).name || " "; else do; call ioa_ ("^6d^-^a", bootload_fs_list.files (file_num).length, bootload_fs_list.files (file_num).name); end; bootload_fs_list.files (file_num).name = ""; /* don't list again */ file_found = "1"b; end; end; end; if active & file_found then result = substr (result, 1, length (result) - 1); /* extraneous trailing blank */ if ^active & ^file_found then call ioa_ ("No such file(s)."); return; delete: entry (ss_info_ptr); me = "delete"; call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code); if code ^= 0 then do; call com_err_ (code, me); signal request_abort_; end; if arg_count = 0 then do; call com_err_ (0, me, "Usage is: ^a ", me); go to TERMINATE; end; do i = 1 to arg_count; call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, ss_info.arg_list_ptr); call check_star_name_$entry (arg, code); if code = error_table_$badstar then do; call com_err_ (code, me, "^a", arg); go to TERMINATE; end; end; call bootload_fs_$list (my_area, bootload_fs_list_ptr, code); if code ^= 0 then do; if code = error_table_$noentry then call ioa_ ("No files."); else call com_err_ (code, me, "Getting file list."); go to TERMINATE; end; do i = 1 to arg_count; call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, ss_info.arg_list_ptr); file_found = "0"b; do file_num = 1 to bootload_fs_list.n_files; if bootload_fs_list.files (file_num).name ^= "" then call match_star_name_ (bootload_fs_list.files (file_num).name, arg, code); if code = 0 then do; call bootload_fs_$delete (bootload_fs_list.files (file_num).name, code); if code ^= 0 then call com_err_ (code, me, "^a", bootload_fs_list.files (file_num).name); bootload_fs_list.files (file_num).name = ""; /* don't delete again */ file_found = "1"b; end; end; if ^file_found then call com_err_ (0, me, "File(s) not found. ^a", arg); end; return; rename: entry (ss_info_ptr); me = "rename"; call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code); if code ^= 0 then do; call com_err_ (code, me); signal request_abort_; end; if arg_count = 0 | mod (arg_count, 2) ^= 0 then do; call com_err_ (0, me, "Usage is: ^a { ...}", me); go to TERMINATE; end; do i = 2 to arg_count by 2; call cu_$arg_ptr_rel (i - 1, arg_ptr, arg_len, code, ss_info.arg_list_ptr); call check_star_name_$entry (arg, code); if code = error_table_$badstar then do; call com_err_ (code, me, "^a", arg); go to TERMINATE; end; call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, ss_info.arg_list_ptr); call get_equal_name_$check_equal_name_ (arg, code); if code = error_table_$bad_equal_name then do; call com_err_ (code, me, "^a", arg); go to TERMINATE; end; end; call bootload_fs_$list (my_area, bootload_fs_list_ptr, code); if code ^= 0 then do; if code = error_table_$noentry then call ioa_ ("No files."); else call com_err_ (code, me, "Getting file list."); go to TERMINATE; end; do i = 2 to arg_count by 2; call cu_$arg_ptr_rel (i - 1, arg_ptr, arg_len, code, ss_info.arg_list_ptr); call cu_$arg_ptr_rel (i, arg_ptr2, arg_len2, code, ss_info.arg_list_ptr); file_found = "0"b; do file_num = 1 to bootload_fs_list.n_files; if bootload_fs_list.files (file_num).name ^= "" then call match_star_name_ (bootload_fs_list.files (file_num).name, arg, code); if code = 0 then do; call get_equal_name_ (bootload_fs_list.files (file_num).name, arg2, new_name, code); if code ^= 0 then go to rename_error; call bootload_fs_$rename (bootload_fs_list.files (file_num).name, new_name, code); if code ^= 0 then rename_error: call com_err_ (code, me, "^a to ^a", bootload_fs_list.files (file_num).name, new_name); bootload_fs_list.files (file_num).name = ""; /* don't rename again */ file_found = "1"b; end; end; if ^file_found then call com_err_ (0, me, "File(s) not found. ^a", arg); end; return; TERMINATE: return; end;  bootload_qedx.pl1 11/11/89 1134.3r w 11/11/89 0826.3 90423 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1983 * * * *********************************************************** */ /* format: off */ /* bootload Multics qedx Editor command interface */ /* Created: April 1983 by Keith Loepere from January 1983 creation by G. Palter as part of implementation of qedx_ subroutine interface */ /* format: on,style4,delnl,insnl,ifthenstmt,ifthen */ bootload_qedx: procedure (ss_info_ptr); dcl argument character (argument_lth) unaligned based (argument_ptr); dcl argument_ptr pointer; dcl argument_lth fixed binary (21); dcl (n_arguments, argument_idx) fixed binary; dcl input_filename character (32); dcl input_file_ptr pointer; dcl exec_filename character (32); dcl exec_buffer_lth fixed binary (21); dcl exec_buffer_ptr pointer; dcl args_buffer character (args_buffer_lth) based (args_buffer_ptr); dcl args_buffer_lth fixed bin (21); dcl args_buffer_used fixed binary (21); dcl args_buffer_ptr ptr; dcl 1 local_qi aligned, /* describes how we want the invocation setup */ 2 header like qedx_info.header, 2 buffers (6) like qedx_info.buffers; /* 0, 1, 2, 3, exec, args */ dcl ok_to_continue bit (1) aligned; dcl (no_rw_path, have_pathname, have_macro_pathname, have_macro_arguments) bit (1) aligned; dcl idx fixed binary; dcl code fixed binary (35); dcl invocation_level fixed binary static initial (0); /* # of active invocations of qedx */ dcl NL character (1) static options (constant) initial (" "); dcl QEDX character (32) static options (constant) initial ("bootload_qedx"); /* format: off */ dcl (error_table_$badopt, error_table_$bigarg, error_table_$inconsistent, error_table_$noarg, error_table_$too_many_args) fixed binary (35) external; dcl sys_info$max_seg_size fixed bin (18) static external; /* format: on */ dcl bootload_fs_$get_ptr entry (char (*), ptr, fixed bin (21), fixed bin (35)); dcl com_err_ entry () options (variable); dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin (35)); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl get_temp_segment_ entry (character (*), pointer, fixed binary (35)); dcl qedx_ entry (pointer, fixed binary (35)); dcl release_temp_segment_ entry (character (*), pointer, fixed binary (35)); dcl (cleanup, request_abort_) condition; dcl (divide, length, index, null, segno, substr, string) builtin; %page; /* bootload_qedx: procedure (ss_info_ptr); */ call cu_$arg_count_rel (n_arguments, ss_info.arg_list_ptr, code); if code ^= 0 then do; call com_err_ (code, QEDX); signal request_abort_; end; if invocation_level > 0 then do; /* it would be nice to eliminate this... */ call com_err_ (0, QEDX, "A suspended invocation is somehow on the stack."); return; end; invocation_level = invocation_level + 1; /* another qedx */ input_file_ptr, /* for cleanup handler */ exec_buffer_ptr, args_buffer_ptr = null (); on condition (cleanup) call cleanup_qedx_invocation (); /* format: off */ /* Process arguments: syntax of the qedx command is -- qedx {-control_args} {macro_path {macro_arguments}} */ /* format: on */ no_rw_path, /* allow r/w with pathnames and R/W */ have_pathname, /* haven't seen -pathname yet */ have_macro_pathname, /* haven't seen first non-control argument yet */ have_macro_arguments = "0"b; /* haven't seen any macro arguments */ do argument_idx = 1 to n_arguments; call cu_$arg_ptr_rel (argument_idx, argument_ptr, argument_lth, code, ss_info.arg_list_ptr); if code ^= 0 then do; /* sigh */ call com_err_ (code, QEDX, "Fetching argument #^d.", argument_idx); go to RETURN_FROM_QEDX; end; if ^have_macro_pathname then /* no non-control argument yet: can still accept -ca's */ if index (argument, "-") = 1 then /* ... a control argument */ if argument = "-no_rw_path" then no_rw_path = "1"b; else if argument = "-rw_path" then no_rw_path = "0"b; else if (argument = "-pathname") | (argument = "-pn") then if have_pathname then do; call com_err_ (error_table_$too_many_args, QEDX, """-pathname"" may only be specified once for this command."); go to RETURN_FROM_QEDX; end; else do; /* initial contents for buffer 0 ... */ have_pathname = "1"b; if argument_idx = n_arguments then do; call com_err_ (error_table_$noarg, QEDX, "Pathname after ""^a"".", argument); go to RETURN_FROM_QEDX; end; argument_idx = argument_idx + 1; call cu_$arg_ptr_rel (argument_idx, argument_ptr, argument_lth, code, ss_info.arg_list_ptr); if code ^= 0 then do; call com_err_ (code, QEDX, "Fetching argument #^d.", argument_idx); go to RETURN_FROM_QEDX; end; input_filename = argument; call bootload_fs_$get_ptr (argument, input_file_ptr, (0), code); if code ^= 0 then do; /* the file doesn't exist (sigh) */ call com_err_ (code, QEDX, "-pathname ^a", argument); go to RETURN_FROM_QEDX; end; input_file_ptr = null (); end; else do; call com_err_ (error_table_$badopt, QEDX, """^a""", argument); go to RETURN_FROM_QEDX; end; else do; /* first non-control argument: macro pathname */ have_macro_pathname = "1"b; if index (reverse (rtrim (argument)), "xdeq.") = 1 then exec_filename = argument; else exec_filename = rtrim (argument) || ".qedx"; call bootload_fs_$get_ptr (exec_filename, exec_buffer_ptr, exec_buffer_lth, code); if code ^= 0 then do; /* the file doesn't exist (sigh) */ call com_err_ (code, QEDX, "Macro file: ^a", exec_filename); go to RETURN_FROM_QEDX; end; end; else do; /* Nth non-control argument: a macro argument */ if ^have_macro_arguments then do; /* ... first macro argument */ call get_temp_segment_ (QEDX, args_buffer_ptr, code); if code ^= 0 then do; call com_err_ (code, QEDX, "Obtaining buffer space for macro arguments"); go to RETURN_FROM_QEDX; end; args_buffer_lth = sys_info$max_seg_size * 4; args_buffer_used = 0; have_macro_arguments = "1"b; end; call add_to_args_buffer (argument); call add_to_args_buffer (NL); end; end; if no_rw_path & ^have_pathname then do; call com_err_ (error_table_$inconsistent, QEDX, """-no_rw_path"" must be used with ""-pathname""."); go to RETURN_FROM_QEDX; end; /* Arguments have been validated: setup qedx_info data structure and invoke qedx_ */ local_qi.header.version = QEDX_INFO_VERSION_1; local_qi.header.editor_name = QEDX; string (local_qi.header.flags) = ""b; local_qi.header.no_rw_path = no_rw_path; local_qi.header.query_if_modified = "1"b; /* finally after all these years ... */ local_qi.header.n_buffers = 0; /* no initial buffers yet */ if have_pathname then do; /* include a buffer 0 containing requested file ... */ local_qi.header.n_buffers, idx = 1; local_qi.buffers (idx).buffer_name = "0"; local_qi.buffers (idx).buffer_pathname = input_filename; string (local_qi.buffers (idx).flags) = ""b; end; if have_macro_pathname then do; /* exec buffer containing a macro to execute ... */ local_qi.header.n_buffers, idx = local_qi.header.n_buffers + 1; local_qi.buffers (idx).buffer_name = "exec"; local_qi.buffers (idx).buffer_pathname = ""; /* ... no pathname by default */ local_qi.buffers (idx).region_ptr = exec_buffer_ptr; local_qi.buffers (idx).region_max_lth, /* ... get size from the system */ local_qi.buffers (idx).region_initial_lth = exec_buffer_lth; string (local_qi.buffers (idx).flags) = ""b; local_qi.buffers (idx).read_write_region, local_qi.buffers (idx).execute_buffer = "1"b; end; /* ... get initial content from us but can't write back */ if have_macro_arguments then do; /* a "file" of arguments to the macro ... */ local_qi.header.n_buffers, idx = local_qi.header.n_buffers + 1; local_qi.buffers (idx).buffer_name = "args"; local_qi.buffers (idx).buffer_pathname = ""; /* ... no pathname by default */ local_qi.buffers (idx).region_ptr = args_buffer_ptr; local_qi.buffers (idx).region_max_lth, local_qi.buffers (idx).region_initial_lth = args_buffer_used; string (local_qi.buffers (idx).flags) = ""b; local_qi.buffers (idx).read_write_region = "1"b; end; /* ... get initial content from us but can't write back */ call qedx_ (addr (local_qi), code); /* INVOKE THE EDITOR */ RETURN_FROM_QEDX: call cleanup_qedx_invocation (); return; %page; /* Add a character string to the macro arguments buffer */ add_to_args_buffer: procedure (p_string); dcl p_string character (*) parameter; if (args_buffer_used + length (p_string)) > length (args_buffer) then do; call com_err_ (error_table_$bigarg, QEDX, "Too many macro arguments. First failing argument: ""^a"".", argument); go to RETURN_FROM_QEDX; end; substr (args_buffer, (args_buffer_used + 1), length (p_string)) = p_string; args_buffer_used = args_buffer_used + length (p_string); return; end add_to_args_buffer; /* Cleanup after an invocation of qedx */ cleanup_qedx_invocation: procedure (); if args_buffer_ptr ^= null () then do; call release_temp_segment_ (QEDX, args_buffer_ptr, (0)); args_buffer_ptr = null (); end; invocation_level = invocation_level - 1; /* all gone */ return; end cleanup_qedx_invocation; %page; %include qedx_info; %page; %include access_mode_values; %page; %include bce_subsystem_info_; end bootload_qedx;  config_deck_edit_.pl1 11/11/89 1134.3r w 11/11/89 0826.3 88488 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ config_deck_edit_: proc (ss_info_ptr); /* Program to use qedx_ to edit config decks. config_deck_parse_ is used for ascii/binary conversions. In the ascii form, each field is considered to be of two types, labeled and unlabeled. Labeled fields are fields preceeded by a label, such as "-port 7" ("-port" is the label; "7" is the value). Unlabeled fields are fields not so labeled; the config card name is considered the first of these. Normal text editing operations are performed on this source form within qedx_. Writing the config deck out performs a per card validity check in the process of conversion to binary form. Buffer 0 is wired (default path set) to . Reads and writes without a pathname operate on the binary config deck. */ /* Initially coded February 1983 by Keith Loepere */ /* Modified August 1983 by Keith Loepere for new bce switches */ /* Modified November 1983 by Keith Loepere to use qedx_. */ /* Modified March 1984 by Keith Loepere to accept a command line deck name */ /* Modified January 1985 by Keith Loepere to run at crash time. */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ dcl NL char (1) static options (constant) init (" "); dcl addr builtin; dcl arg char (arg_lth) based (arg_ptr); dcl arg_count fixed bin; dcl arg_lth fixed bin (21); dcl arg_ptr ptr; dcl bootload_fs_$get entry (char (*), ptr, fixed bin (21), fixed bin (21), fixed bin (35)); dcl bootload_fs_$get_ptr entry (char (*), ptr, fixed bin (21), fixed bin (35)); dcl bootload_fs_$put entry (char (*), ptr, fixed bin (21), bit (1) aligned, fixed bin (35)); dcl code fixed bin (35); dcl com_err_ entry () options (variable); dcl config_deck_parse_$ascii_to_binary entry (char (256) var, ptr, fixed bin); dcl config_deck_parse_$binary_to_ascii entry (ptr, char (256) var); dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin (35)); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl disk_config_deck$ (4096) bit (36) aligned external static; dcl error_table_$recoverable_error fixed bin (35) ext static; dcl get_ptrs_$given_segno entry (fixed bin (15)) returns (pointer); dcl index builtin; dcl ioa_ entry () options (variable); dcl length builtin; dcl me char (11) static options (constant) init ("config_edit"); dcl null builtin; dcl 1 my_qedx_info aligned, 2 header like qedx_info.header, 2 buffers (1) like qedx_info.buffers; dcl pc_wired$write_wait entry (pointer, fixed bin, fixed bin); dcl qedx_ entry (ptr, fixed bin (35)); dcl segno builtin; dcl string builtin; dcl substr builtin; dcl sys_boot_info$config_has_been_modified bit (1) aligned external static; %page; if ss_info_ptr ^= null () then do; call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code); if code ^= 0 then go to TERMINATE; /* active function? */ end; else arg_count = 0; if arg_count > 1 then do; call ioa_ ("Usage is: config_edit {file_name}"); go to TERMINATE; end; else if arg_count = 1 then begin; dcl buffer_lth fixed bin (21); dcl buffer_ptr ptr; call cu_$arg_ptr_rel (1, arg_ptr, arg_lth, code, ss_info.arg_list_ptr); call bootload_fs_$get_ptr (arg, buffer_ptr, buffer_lth, code); if code ^= 0 then do; call com_err_ (code, me, "^a", arg); go to TERMINATE; end; call write_config_deck (buffer_ptr, buffer_lth); return; end; /* Enter config deck editor */ config_max_cards, config_n_cards = 256; qedx_info_ptr = addr (my_qedx_info); qedx_info.header.version = QEDX_INFO_VERSION_1; qedx_info.editor_name = me; qedx_info.buffer_io = config_deck_io; string (qedx_info.header.flags) = ""b; qedx_info.header.query_if_modified = "1"b; qedx_info.caller_does_io = "1"b; qedx_info.n_buffers = 1; qedx_info.buffers (1).buffer_name = "0"; qedx_info.buffers (1).buffer_pathname = ""; string (qedx_info.buffers (1).flags) = ""b; qedx_info.buffers (1).locked_pathname, qedx_info.buffers (1).default_read_ok, qedx_info.buffers (1).default_write_ok = "1"b; call qedx_ (qedx_info_ptr, code); if code ^= 0 then if code ^= error_table_$recoverable_error then call com_err_ (code, me, "from qedx_"); TERMINATE: return; %page; config_deck_io: proc (qedx_buffer_io_info_ptr, io_okay) options (non_quick); /* The routine to fetch data from ascii files. It also knows how to read and write the binary config deck. */ dcl io_okay bit (1) aligned parameter; /* read or write successful */ dcl qedx_buffer_io_info_ptr ptr parameter; qbii_ptr = qedx_buffer_io_info_ptr; if qedx_buffer_io_info.version ^= QEDX_BUFFER_IO_INFO_VERSION_1 then do; call com_err_ (0, me, "Incorrect version of qedx_buffer_io_info supplied."); go to TERMINATE; end; if qedx_buffer_io_info.pathname ^= "" then do; if qedx_buffer_io_info.direction = QEDX_READ_FILE then call bootload_fs_$get (qedx_buffer_io_info.pathname, qedx_buffer_io_info.buffer_ptr, qedx_buffer_io_info.buffer_max_lth, qedx_buffer_io_info.buffer_lth, code); else call bootload_fs_$put (qedx_buffer_io_info.pathname, qedx_buffer_io_info.buffer_ptr, qedx_buffer_io_info.buffer_lth, "0"b, code); if code ^= 0 then call com_err_ (code, me, "^a", qedx_buffer_io_info.pathname); io_okay = (code = 0); end; else do; if qedx_buffer_io_info.direction = QEDX_READ_FILE then do; call read_config_deck (qedx_buffer_io_info.buffer_ptr, qedx_buffer_io_info.buffer_max_lth, qedx_buffer_io_info.buffer_lth); io_okay = "1"b; end; else if sys_info$collection_1_phase = CRASH_INITIALIZATION then do; call com_err_ (0, me, "The config deck cannot be modified with a saved crash image present."); io_okay = "0"b; end; else do; call write_config_deck (qedx_buffer_io_info.buffer_ptr, qedx_buffer_io_info.buffer_lth); io_okay = "1"b; end; end; return; end; %page; read_config_deck: proc (buffer_ptr, buffer_max_lth, buffer_lth); /* read in the current config deck into the area supplied by qedx */ dcl ascii_config_card char (256) var; dcl buffer char (buffer_max_lth) based (buffer_ptr); dcl buffer_max_lth fixed bin (21) parameter; dcl buffer_lth fixed bin (21) parameter; dcl buffer_ptr ptr parameter; dcl cards_to_read fixed bin; dcl config_card_num fixed bin; /* counter to card */ configp = addr (disk_config_deck$); /* using real deck easy */ config_max_cards, config_n_cards = 256; do config_card_num = 1 to 256 while (config_deck.cards (config_card_num).word ^= FREE_CARD_WORD); end; /* found last true card */ cards_to_read = config_card_num - 1; /* here we convert the config deck to an ascii form */ buffer_lth = 0; do config_card_num = 1 to cards_to_read; cardp = addr (config_deck.cards (config_card_num)); call config_deck_parse_$binary_to_ascii (cardp, ascii_config_card); if buffer_lth + length (ascii_config_card) + 1 /* nl */ > buffer_max_lth then do; call com_err_ (0, me, "Converted config deck does not fit in file."); return; end; substr (buffer, buffer_lth + 1, length (ascii_config_card)) = ascii_config_card; buffer_lth = buffer_lth + length (ascii_config_card) + 1; substr (buffer, buffer_lth, 1) = NL; end; return; end; %page; write_config_deck: proc (buffer_ptr, buffer_lth); /* Convert the supplied ascii text into a binary deck. */ dcl ascii_config_card char (256) var; dcl buffer char (buffer_lth) based (buffer_ptr); dcl buffer_lth fixed bin (21) parameter; dcl buffer_pos fixed bin (21); /* starting pos in buffer for this new line */ dcl buffer_ptr ptr parameter; dcl card_len fixed bin (21); /* length of text in card (minus nl) */ dcl output_card_num fixed bin; configp = addr (disk_config_deck$); sys_boot_info$config_has_been_modified = "1"b; config_max_cards, config_n_cards = 256; output_card_num = 0; buffer_pos = 1; do while (buffer_pos <= buffer_lth); output_card_num = output_card_num + 1; cardp = addr (config_deck.cards (output_card_num)); card_len = index (substr (buffer, buffer_pos), NL); if card_len = 0 then card_len = buffer_lth - buffer_pos + 1; else card_len = card_len - 1; ascii_config_card = substr (buffer, buffer_pos, card_len); buffer_pos = buffer_pos + card_len + 1; call config_deck_parse_$ascii_to_binary (ascii_config_card, cardp, output_card_num); end; do output_card_num = output_card_num + 1 to config_max_cards; /* blank out rest of deck */ config_deck.cards (output_card_num).word = FREE_CARD_WORD; end; /* call total_config_deck_check; */ call pc_wired$write_wait (get_ptrs_$given_segno (segno (addr (disk_config_deck$))), 0, 4); /* save on disk */ return; end; %page; %include bce_subsystem_info_; %page; %include collection_1_phases; %page; %include config_deck; %page; %include qedx_buffer_io_info; %page; %include qedx_info; end;  init_clocks.pl1 12/11/99 1838.0r w 12/11/99 1815.0 81639 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* INIT_CLOCKS -- read time string from operator, set all clocks */ /* format: style2 */ /* BIM 10/82 */ /* Modified 2/83 by Keith Loepere to use bce_command_processor_ and environment */ /* Modified 6/83 by Keith Loepere so operator doesn't have to enter time. */ /* Modified 4/84 by Keith Loepere for simplification */ /* Modified 7/84 by J Falksen for new date/time software */ /* Modified 1/85 by Keith Loepere to check RPV time unmounted. */ /* Modified 1/85 by Keith Loepere to not set date/time defaults and to use time_info_ to automatically set delta given a zone. */ /****^ HISTORY COMMENTS: 1) change(86-12-04,Fawcett), approve(86-12-17,MECR0006), audit(86-12-12,GDixon), install(86-12-17,MR12.0-1250): Changed to call date_time_$set_time_defaults. If the operator inputs a new time string with a time zone the correct time will set. 2) change(87-01-08,Fawcett), approve(87-01-08,MCR7600), audit(87-01-13,GJohnson), install(87-01-13,MR12.0-1270): This closes MECR0006. 3) change(99-06-23,Haggett): Y2K END HISTORY COMMENTS */ init_clocks: procedure (success); /* Parameters */ declare success bit (1) aligned parameter; /* Constants */ declare me char (11) init ("init_clocks") static options (constant); declare time_format char (41) int static options (constant) init ("^dn, ^mn ^Z9dm, ^9999yc ^Z9Hd:^MH:^SM ^za"); /* Entries */ declare bce_query entry options (variable); declare bce_query$yes_no entry options (variable); declare com_err_ entry options (variable); declare convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35)); declare date_time_$format entry (char (*), fixed bin (71), char (*), char (*)) returns (char (250) var); declare date_time_$set_time_defaults entry (); declare ioa_ entry () options (variable); declare privileged_mode_ut$sscr entry (fixed bin (3), fixed bin (6), fixed bin (71)); declare read_disk entry (fixed bin, fixed bin, ptr, fixed bin (35)); /* Variables */ declare TIME fixed bin (71); declare bootload_scu fixed bin (3); declare code fixed bin (35); declare line char (80); declare time_correction fixed bin (71); declare time_string char (64) var; declare zone char (4); declare 1 rpv_label aligned like label; /* External */ declare disk_config_deck$ external static; declare pvt$root_pvtx fixed bin external static; declare sys_info$clock_ bit (3) aligned external static; declare sys_info$first_reasonable_time fixed bin (71) external static; declare sys_info$last_reasonable_time fixed bin (71) external static; declare sys_info$time_correction_constant fixed bin (71) aligned external static; declare sys_info$time_zone char (4) aligned external static; /* Misc */ declare (addr, addrel, bin, clock, divide, fixed, hbound, lbound, rtrim, size, substr, unspec) builtin; %page; success = "0"b; call find_zone; /* zone defined by current clock "card" */ bootload_scu = fixed (sys_info$clock_, 3); TIME = clock (); call read_rpv_label (); time_string = date_time_$format (time_format, label.time_unmounted, zone, ""); call ioa_ ("Multics Y2K. System was last shudown/ESD at:^/^a", time_string); call check_time; line = "xxx"; do while (^(line = "n" | line = "no")); call bce_query (line, "Is this correct? "); if line = "y" | line = "yes" then do; call set_defaults; /* if things were correct set the date_time defaults */ call check_rpv; success = "1"b; return; end; else if line = "abort" then return; end; CHECK_TIME: call bce_query (line, "Enter time: "); if line = "abort" then do; ABORT: success = "0"b; return; end; call set_defaults; call convert_date_to_binary_ (line, TIME, code); if code ^= 0 then do; /* Operator's time string invalid? */ call com_err_ (code, me, "^a", rtrim (line)); go to CHECK_TIME; end; if scs$controller_data (bootload_scu).type < "0010"b then do; /* help out operator */ call ioa_ ("SCU Switches (octal): ^w ^w", substr (unspec (TIME), 1, 36), substr (unspec (TIME), 37)); call bce_query (line, "Enter anything after the switches have been set. "); TIME = clock (); end; call check_time; line = "xxx"; do while (^(line = "n" | line = "no")); call bce_query (line, "Is this correct? "); if line = "y" | line = "yes" then do; if scs$controller_data (bootload_scu).type < "0010"b then ; else call set_clocks; /* set in all controllers */ call check_rpv; success = "1"b; return; end; else if line = "abort" then return; end; go to CHECK_TIME; %page; set_defaults: proc; sys_info$time_zone = zone; sys_info$time_correction_constant = time_correction; call date_time_$set_time_defaults (); end set_defaults; set_clocks: proc; declare controllerx fixed bin (3); do controllerx = lbound (scs$controller_data, 1) to hbound (scs$controller_data, 1); if bin (scs$controller_data (controllerx).type, 4) >= 0010b & scs$controller_data (controllerx).online then call privileged_mode_ut$sscr (controllerx, SC_ETC, TIME); end; return; end; find_zone: proc; /* Find time zone, checking that it is in time_info_. We must do this by looking at disk_config_deck. */ declare idx fixed bin; declare lang_index fixed bin; declare zone_index fixed bin; cardp = addr (disk_config_deck$); config_max_cards = divide (4096 - 1, size (config_card), 17, 0); /* Assume four page default */ do idx = 1 to config_max_cards while (config_card.word ^= FREE_CARD_WORD & config_card.word ^= CLOK_CARD_WORD); cardp = addrel (cardp, size (config_card)); /* on to the next card */ end; if idx <= config_max_cards then if config_card.word = CLOK_CARD_WORD then do; clok_cardp = cardp; zone = clok_card.zone; do lang_index = 1 to ti_zone.number_lang; do zone_index = 1 to ti_zone.number_zone; if ti_zone.short (lang_index, zone_index) = clok_card.zone then go to found_zone; end; end; call com_err_ (0, me, "The zone named on the CLOK card is not in time_info_"); goto ABORT; found_zone: time_correction = ti_zone.delta (lang_index, zone_index); end; else go to no_clok; else do; no_clok: call com_err_ (0, me, "No clok card in config deck."); go to ABORT; end; return; end; check_time: proc; time_string = date_time_$format (time_format, TIME, zone, ""); call ioa_ ("Current system time is: ^a.", time_string); if TIME <= sys_info$first_reasonable_time | TIME >= sys_info$last_reasonable_time | TIME < label.time_unmounted then do; call ioa_ ("This is clearly incorrect."); go to CHECK_TIME; end; return; end; %page; check_rpv: proc; /* Make sure the time is reasonable relative to the RPV time unmounted. */ dcl yes_no bit (1) aligned; if label.time_unmounted <= sys_info$first_reasonable_time | label.time_unmounted >= sys_info$last_reasonable_time then return; /* bogus label times */ if clock () < label.time_unmounted then do; call bce_query$yes_no (yes_no, "The current time is *before* the last shutdown time recorded in the RPV. Are you sure the time is correct? "); if ^yes_no then go to CHECK_TIME; end; if clock () > label.time_unmounted + clok_card.boot_delta * 3600 * 1000000 then do; call bce_query$yes_no (yes_no, "The current time is more than the supplied boot_delta hours beyond the unmounted time recorded in the RPV label. Is this correct? "); if ^yes_no then go to CHECK_TIME; if (divide (clock () - label.time_unmounted, 3600 * 1000000, 17, 0) > 12) then do; call bce_query$yes_no (yes_no, "The current time I'm using is more than 12 hours after the last shutdown time recorded in the RPV label. Are you sure this is correct? "); if ^yes_no then goto CHECK_TIME; end; end; return; /* okay */ end; %skip; read_rpv_label: proc; labelp = addr (rpv_label); call read_disk (pvt$root_pvtx, LABEL_ADDR, labelp, code); if code ^= 0 then do; call com_err_ (code, me, "RPV label"); go to ABORT; end; return; end read_rpv_label; %page; %include config_deck; %page; %include config_clok_card; %page; %include disk_pack; %page; %include fs_vol_label; %page; %include scr; %page; %include scs; %page; %include time_names; end init_clocks; 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