bce_alm_die.alm 11/11/89 1135.9r 11/11/89 0837.1 8127 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1984 * " * * " *********************************************************** segdef bce_alm_die " Kill ourselves (bce) off, irretrievably. Keith Loepere, Jan 84. " Made a better die, Keith Loepere, Jan 85. bce_alm_die: inhibit on lda 2048*4,dl " clobber toehold epp bp,toehold$0 " prevents exceuting switches mlr (),(pr,rl) desc9a 0,0 desc9a bp|0,al lda 128*4,dl " clobber fault_vector epp bp,fault_vector$0 " prevents future faults from mlr (),(pr,rl) " reentering bce desc9a 0,0 desc9a bp|0,al dis tra -1,ic " DIE!!! end  bce_check_abort.pl1 11/11/89 1135.9rew 11/11/89 0839.0 27351 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ bce_check_abort: proc; /* Check to see if the operator wants us to abort (unsolicited request key). If so, ask operator (at console) to what extent he wants to abort. Keith Loepere, November 1983. */ /****^ HISTORY COMMENTS: 1) change(86-04-22,Farley), approve(86-07-18,MCR7439), audit(86-08-18,Fawcett), install(86-10-20,MR12.0-1189): Added check of ss_info.flags.request_handling_opr_aborts to see if handling required. END HISTORY COMMENTS */ dcl Abort char (7) static options (constant) init ("Abort? "); dcl Unknown_response char (18) static options (constant) init ("Unknown response. "); dcl bce_data$console_get_line entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)) variable ext; dcl bce_data$console_put_chars entry (ptr, ptr, fixed bin, fixed bin (35)) variable ext; dcl bce_data$subsys_info_ptr ptr external; dcl buffer char (16); dcl buffer_read char (n_read) based (addr (buffer)); dcl n_read fixed bin; dcl (addr, length) builtin; dcl request_abort_ condition; dcl sub_request_abort_ condition; dcl sys_boot_info$at_bce_cl bit (1) aligned external; dcl wired_hardcore_data$abort_request bit (1) aligned external; if ^wired_hardcore_data$abort_request then return; if ^sys_boot_info$at_bce_cl then return; if bce_data$subsys_info_ptr -> ss_info.flags.request_handling_opr_aborts then return; query: wired_hardcore_data$abort_request = "0"b; call bce_data$console_put_chars (addr (bce_data$console_put_chars), addr (Abort), length (Abort), (0)); call bce_data$console_get_line (addr (bce_data$console_get_line), addr (buffer), length (buffer), n_read, (0)); n_read = n_read - 1; /* no nl */ if buffer_read = "n" | buffer_read = "no" then return; /* false alarm */ else if buffer_read = "y" | buffer_read = "yes" then signal sub_request_abort_; else if buffer_read = "request" | buffer_read = "req" | buffer_read = "r" then signal sub_request_abort_; else if buffer_read = "command" | buffer_read = "com" | buffer_read = "c" then signal request_abort_; else if buffer_read = "all" | buffer_read = "a" then go to bce_data$subsys_info_ptr -> ss_info.abort_label; else do; call bce_data$console_put_chars (addr (bce_data$console_put_chars), addr (Unknown_response), length (Unknown_response), (0)); go to query; end; %page; %include bce_subsystem_info_; end;  bce_console_io.pl1 11/11/89 1135.9r w 11/11/89 0839.0 38214 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* BCE_CONSOLE_IO.PL1 bootload command environment console io */ /* Wrapper for odcdm_ for the command environment */ /* Written by BIM sometime in '82 */ /* Modified 830620 for new ocdcm_ interface... -E. A. Ranzenbach /* Simplified 8/83 by Keith Loepere, for new bce switches */ /* Modified 11/83 by Keith Loepere to loop waiting for non-zero input line */ /* Modified 12/83 by Keith Loepere for put_chars_alert */ /* Modified 840418 to zero console io before filling... -E. A. Ranzenbach */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ bce_console_io: procedure; /* Entrypoints are get_line, put_chars */ /* This program loops on the console by calling ocdcm until */ /* it returns success */ dcl Buffer_ptr ptr parameter; dcl Buffer_len fixed bin parameter; dcl Buffer char (Buffer_len) based (Buffer_ptr); dcl Code fixed bin (35) parameter; dcl Switch_ptr ptr parameter; dcl N_read fixed bin parameter; dcl bce_check_abort entry; dcl oc_trans_input_ entry (ptr, fixed bin, fixed bin, ptr, fixed bin); dcl oc_trans_output_ entry (ptr, fixed bin (21), fixed bin (21), ptr, fixed bin (19), fixed bin (17), bit (1) aligned); dcl ocdcm_$priority_io entry (ptr); dcl alert bit (1) aligned; dcl cont bit (1) aligned; dcl cur_ptr pointer; dcl internal_buffer char (256) aligned; dcl 1 my_console_io aligned like console_io; dcl n_done fixed bin (21); dcl n_to_send fixed bin (19); dcl n_to_write fixed bin (21); dcl addcharno builtin; dcl addr builtin; dcl length builtin; dcl min builtin; dcl substr builtin; dcl unspec builtin; %page; /* For now, assume that we will always be called with a big enough */ /* buffer to hold an entire input line, converted. */ get_line: entry (Switch_ptr, Buffer_ptr, Buffer_len, N_read, Code); Code = 0; read: unspec (my_console_io) = ""b; console_io_ptr = addr (my_console_io); console_io.event_chan = 0; /* build the I/O..*/ console_io.read = "1"b; console_io.alert = "0"b; console_io.sequence_no = 0; call ocdcm_$priority_io (console_io_ptr); /* do the input...*/ if console_io.leng = 0 then go to read; /* wait for non-null line */ call oc_trans_input_ (addr (internal_buffer), length (internal_buffer), N_read, addr (console_io.text), (console_io.leng)); substr (Buffer, 1, min (length (Buffer), N_read)) = substr (internal_buffer, 1, min (length (Buffer), N_read)); return; put_chars: entry (Switch_ptr, Buffer_ptr, Buffer_len, Code); alert = "0"b; go to put; put_chars_alert: entry (Switch_ptr, Buffer_ptr, Buffer_len, Code); alert = "1"b; put: internal_buffer = ""; n_to_write = length (Buffer); /* so they want trailing blanks ! */ cont = "0"b; cur_ptr = addr (Buffer); do while (n_to_write > 0); /* The unused arguments are an output word count and a type flag */ call bce_check_abort; call oc_trans_output_ (cur_ptr, n_to_write, n_done, addr (internal_buffer), n_to_send, 80, cont); /* cont is input_output */ unspec (my_console_io) = ""b; console_io_ptr = addr (my_console_io); console_io.event_chan = 0; /* build the I/O..*/ console_io.read = "0"b; console_io.alert = alert; console_io.sequence_no = 0; console_io.leng = n_to_send; console_io.text = substr (internal_buffer, 1, n_to_send * 4); call ocdcm_$priority_io (console_io_ptr); /* do the output */ n_to_write = n_to_write - n_done; cur_ptr = addcharno (cur_ptr, n_done); end; Code = 0; return; %page; %include oc_data; end bce_console_io;  bce_continue.pl1 11/11/89 1135.9rew 11/11/89 0839.0 20286 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(87-02-26,Farley), approve(87-04-15,MCR7661), audit(87-04-21,Fawcett), install(87-04-28,MR12.1-1028): Added check for fgbx.io_reconfig, which will be on when an attempted I/O reconfiguration may corrupt memory (e.g. adding an IOM). END HISTORY COMMENTS */ bce_continue: proc; /* return to Multics; also return to bos. Keith Loepere, January 1984. */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ dcl addr builtin; dcl com_err_ entry () options (variable); dcl pmut$special_bce_return entry (bit (72) aligned); dcl ssenb bit (1) aligned; dcl sys_boot_info$assume_config_deck bit (1) aligned external; dcl 1 toehold$ aligned like toe_hold external; dcl unspec builtin; if ^ (sys_info$collection_1_phase = CRASH_INITIALIZATION | sys_info$collection_1_phase = BCE_CRASH_INITIALIZATION) then do; call com_err_ (0, "continue", "No image to restart."); return; end; fgbxp = addr (flagbox$); if fgbx.io_reconfig then do; call com_err_ (0, "continue", "Not allowed to restart. Memory may have been corrupted."); return; end; ssenb = fgbx.rtb.ssenb; /* zero all rtb except ssenb */ unspec (fgbx.rtb) = "0"b; fgbx.rtb.ssenb = ssenb; call pmut$special_bce_return (toehold$.entry_sequences (TOE_HOLD_RESTART_ENTRY)); return; bce_bos: entry; if ^sys_boot_info$assume_config_deck then do; call com_err_ (0, "bos", "BOS is not present."); return; end; call pmut$special_bce_return (toehold$.entry_sequences (TOE_HOLD_BOS_MULTICS_ENTRY)); return; %page; %include collection_1_phases; %page; %include flagbox; %page; %include toe_hold; end;  bce_data.cds 11/11/89 1135.9rew 11/11/89 0837.1 20736 /* *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* BCE_DATA.CDS data for the Bootload Command Environment */ /* BIM 8/82 */ /* Modified by Keith Loepere various times in 83 for bce switches */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ bce_data: procedure; declare create_data_segment_ entry (ptr, fixed bin (35)); declare com_err_ entry () options (variable); declare code fixed bin (35); declare PADSTAR (1) char (32) init ("pad*") int static options (constant); declare 1 bce_data_static aligned, /* bce switches--- these must be in entry-ptr order */ 2 console_put_chars entry, 2 console_put_chars_data_ptr ptr init (null), 2 console_get_line entry, 2 console_get_line_data_ptr ptr init (null), 2 console_alert_put_chars entry, 2 console_alert_put_chars_data_ptr ptr init (null), 2 get_line entry, 2 get_line_data_ptr ptr init (null), 2 put_chars entry, 2 put_chars_data_ptr ptr init (null), 2 error_put_chars entry, 2 error_put_chars_data_ptr ptr init (null), 2 exec_com_get_line entry, 2 command_abs_data_ptr pointer init (null), /* miscelaneous */ 2 free_area_ptr pointer init (null), 2 subsys_info_ptr pointer init (null), 2 number_of_temp_segs fixed bin; %include cds_args; declare 1 CDSA aligned like cds_args; declare (null, size) builtin; CDSA.sections (1).p = null (); CDSA.sections (1).len = 0; CDSA.sections (2).p = addr (bce_data_static); CDSA.sections (2).len = size (bce_data_static); CDSA.sections (2).struct_name = "bce_data_static"; CDSA.seg_name = "bce_data"; CDSA.num_exclude_names = 1; CDSA.exclude_array_ptr = addr (PADSTAR); CDSA.have_static = "1"b; CDSA.switches.have_text = "0"b; call create_data_segment_ (addr (CDSA), code); if code ^= 0 then call com_err_ (code, "bce_data"); return; end bce_data;  bce_die.pl1 11/11/89 1135.9r w 11/11/89 0839.0 17424 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ bce_die: proc (P_ss_info_ptr); /* kill ourselves off. Keith Loepere, January 1984. */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ dcl P_ss_info_ptr ptr parameter; dcl arg char (arg_len) based (arg_ptr); dcl arg_count fixed bin; dcl arg_len fixed bin (21); dcl arg_ptr ptr; dcl bce_alm_die entry; dcl bce_query$yes_no entry options (variable); dcl code 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 me char (3) static options (constant) init ("die"); dcl request_abort_ condition; dcl yes_no bit (1); ss_info_ptr = P_ss_info_ptr; call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code); if code ^= 0 then go to arg_error; if arg_count > 0 then do; call cu_$arg_ptr_rel (1, arg_ptr, arg_len, code, ss_info.arg_list_ptr); if arg = "-force" | arg = "-fc" then call bce_alm_die; else go to arg_error; if arg_count > 1 then do; arg_error: call com_err_ (code, me, "Usage is: die {-force | -fc}"); return; end; end; call bce_query$yes_no (yes_no, "Do you really wish bce to die? "); if yes_no then call bce_alm_die; else signal request_abort_; %page; %include bce_subsystem_info_; end;  bce_error.pl1 11/11/89 1135.9r w 11/11/89 0839.1 38682 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* BCE_ERROR -- com_err_ replacement for bootload environment */ /* BIM '82 */ /* Modified by Keith Loepere in 8/83 for new bce switches */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ bce_error: procedure (Code) /* options (variable) */; declare Code fixed bin (35) parameter; declare Me char (*) parameter; declare 1 error_code aligned, 2 pad_segno bit (18) unaligned, /* for now, assume error_table_ */ 2 error_table_offset fixed bin (18) uns unal; declare picture_code pic "------------9"; declare etep pointer; declare 1 error_table_entry aligned based (etep), 2 length fixed bin (9) unsigned unaligned, 2 message character (0 refer (error_table_entry.length)) unaligned; declare length builtin; declare pointer builtin; declare unspec builtin; declare n_args fixed bin; declare message_buffer char (512); declare work_buffer char (work_buffer_len) based (work_buffer_ptr); declare work_buffer_len fixed bin; declare work_buffer_ptr ptr; declare string_len fixed bin (21); declare tcode fixed bin (35); declare first_ioa_arg fixed bin; declare arg_list_ptr_ entry () returns (pointer); declare cu_$arg_count entry (fixed bin, fixed bin (35)); declare ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned, bit (1) aligned); declare bce_data$error_put_chars entry (ptr, ptr, fixed bin, fixed bin (35)) external variable; declare error_table_$ bit (36) aligned external static; %page; work_buffer_ptr = addr (message_buffer); work_buffer_len = length (message_buffer); first_ioa_arg = 2; goto join; com_err: entry (Code, Me); /* options (variable); for com_err_ support */ work_buffer_ptr = addr (message_buffer); work_buffer_len = length (message_buffer); string_len = length (rtrim (Me)); substr (work_buffer, 1, string_len) = substr (Me, 1, string_len); substr (work_buffer, string_len + 1, 2) = ": "; work_buffer_ptr = addcharno (work_buffer_ptr, string_len + 2); work_buffer_len = work_buffer_len - (string_len + 2); first_ioa_arg = 3; join: if Code ^= 0 then do; unspec (error_code) = unspec (Code); if error_code.pad_segno ^= "077777"b3 then do; substr (work_buffer, 1, 5) = "Code "; picture_code = Code; string_len = length (ltrim (picture_code)); substr (work_buffer, 6, string_len) = substr (picture_code, length (picture_code) - string_len + 1, string_len); work_buffer_ptr = addcharno (work_buffer_ptr, 5 + string_len); work_buffer_len = work_buffer_len - (5 + string_len); end; else do; etep = pointer (addr (error_table_$), error_code.error_table_offset); substr (work_buffer, 1, error_table_entry.length) = error_table_entry.message; work_buffer_ptr = addcharno (work_buffer_ptr, error_table_entry.length); work_buffer_len = work_buffer_len - (error_table_entry.length); end; substr (work_buffer, 1, 1) = " "; work_buffer_ptr = addcharno (work_buffer_ptr, 1); work_buffer_len = work_buffer_len - 1; end; call cu_$arg_count (n_args, tcode); if n_args >= first_ioa_arg then do; call ioa_$general_rs (arg_list_ptr_ (), first_ioa_arg, first_ioa_arg + 1, work_buffer, string_len, "0"b, "0"b); work_buffer_ptr = addcharno (work_buffer_ptr, string_len); work_buffer_len = work_buffer_len - string_len; end; substr (work_buffer, 1, 1) = " "; work_buffer_ptr = addcharno (work_buffer_ptr, 1); work_buffer_len = work_buffer_len - 1; work_buffer_ptr = addr (message_buffer); work_buffer_len = length (message_buffer) - work_buffer_len; call bce_data$error_put_chars (addr (bce_data$error_put_chars), addr (work_buffer), length (work_buffer), (0)); return; end bce_error;  bce_esd.pl1 11/11/89 1135.9rew 11/11/89 0839.1 21708 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(87-02-26,Farley), approve(87-04-15,MCR7661), audit(87-04-21,Fawcett), install(87-04-28,MR12.1-1028): Added check for fgbx.io_reconfig that is turned on whenever an I/O reconfiguration can cause memory to be corrupted. Thus no emergency shutdown should be attempted, because it would only propagate the corruption. END HISTORY COMMENTS */ bce_esd: proc (info_ptr); /* Routine to modify machine conditions so as to invoke esd. Written August 1983 by Keith Loepere. */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ dcl bce_continue entry (ptr); dcl com_err_ entry options (variable); dcl emergency_shutdown$ entry; dcl info_ptr ptr parameter; dcl 1 toehold$ aligned external like toe_hold; dcl (addr, bin, bit, codeptr, segno, string, wordno) builtin; %page; %include collection_1_phases; %page; %include flagbox; %page; %include toe_hold; fgbxp = addr (flagbox$); if ^fgbx.ssenb then do; call com_err_ (0, "esd", "Storage system not enabled. esd not performed."); return; end; if fgbx.io_reconfig then do; call com_err_ (0, "esd", "Emergency shutdown is prohibited due to possible memory corruption."); sys_info$collection_1_phase = BOOT_INITIALIZATION; toehold$.memory_state = At_bce__boot; return; end; mc_state_ptr = addr (toehold$.multics_state); mcp = addr (mc_state.mc_); scup = addr (mc.scu); scu.ppr.prr = "000"b; scu.ppr.psr = bit (bin (segno (codeptr (emergency_shutdown$)), 15), 15); scu.ppr.p = "1"b; string (scu.apu) = "0"b; scu.fault_cntr = "0"b; scu.ilc = bit (bin (wordno (codeptr (emergency_shutdown$)), 18), 18); string (scu.ir) = "0"b; scu.ir.bm = "1"b; mc_state.interrupt = "0"b; mc_state.cfg = "0"b; call bce_continue (info_ptr); /* won't return */ end;  bce_execute_command_.pl1 11/11/89 1135.9r w 11/11/89 0839.1 41193 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* bce_execute_command_ -- use map_over_requests_ to find the request desired. Call it appropriately. */ /* format: style2 */ /* Written by Benson Margulies or someone who programs like him. Modified the last possible day of 1983 to allow Multics requests within bce by Keith Loepere. */ bce_execute_command_: procedure (Info_ptr, Request, Arg_list_ptr, Code); declare Request char (*); declare Info_ptr pointer; /* to ss_info */ declare Arg_list_ptr pointer; /* from command_processor_ */ declare Code fixed bin (35); declare execute_entry entry (ptr) variable; declare 1 p_info aligned, /* passed to CHECK_ONE */ 2 request_name char (32) unaligned, 2 found entry (pointer); declare arg_count fixed bin; declare 1 entry_variable aligned, /* template thereof */ 2 code_ptr pointer, 2 env_ptr pointer; declare Global_RQ_data_ptr pointer; /* global to FOUND */ declare bce_map_over_requests_ entry (entry, ptr, ptr); declare cu_$af_arg_count_rel entry (fixed bin, fixed bin (35), ptr); declare cu_$generate_call entry (entry, ptr); declare error_table_$active_function fixed bin (35) ext static; declare error_table_$bad_command_name fixed bin (35) ext static; declare error_table_$not_act_fnc fixed bin (35) ext static; declare 1 bce_flags aligned based (addr (rq_data.flags)), 2 system_flags bit (15) unal, /* our own interpretation of rq_data.flags for bce */ 2 valid_at_early bit (1) unal, 2 valid_at_boot bit (1) unal, 2 valid_at_crash bit (1) unal; declare (addr, null, pointer, unspec) builtin; %page; Code = 0; ss_info_ptr = Info_ptr; ss_info.arg_list_ptr = Arg_list_ptr; p_info.request_name = Request; p_info.found = FOUND; call bce_map_over_requests_ (CHECK_ONE, addr (p_info), ss_info.request_table_ptr); /**** Get here if not found ****/ Code = error_table_$bad_command_name; return; CHECK_ONE: procedure (Request_data_ptr, Info_ptr); declare Request_data_ptr pointer; /* to ssu_ request table */ declare Info_ptr pointer; declare 1 info based (Info_ptr) aligned like p_info; /* passed structure providing command name */ declare nx fixed bin; /* name index */ rq_data_ptr = Request_data_ptr; if sys_info$collection_1_phase = BCE_CRASH_INITIALIZATION then if ^ (bce_flags.valid_at_boot | bce_flags.valid_at_crash) then return; else; else if sys_info$collection_1_phase = CRASH_INITIALIZATION then if ^ bce_flags.valid_at_crash then return; else; else if sys_info$collection_1_phase = EARLY_INITIALIZATION then if ^ bce_flags.valid_at_early then return; else; else if sys_info$collection_1_phase = BOOT_INITIALIZATION then if ^ bce_flags.valid_at_boot then return; else; request_name_list_ptr = pointer (rq_data_ptr, rq_data.namelist_loc); do nx = 1 to request_name_list.n_names; if request_name_list.name (nx) = info.request_name then call info.found (rq_data_ptr); /* never returns */ end; end CHECK_ONE; FOUND: procedure (Request_data_ptr); declare Request_data_ptr pointer; Global_RQ_data_ptr = Request_data_ptr; go to FOUND_LABEL; /* nonlocal up the wazzu */ end FOUND; FOUND_LABEL: rq_data_ptr = Global_RQ_data_ptr; call cu_$af_arg_count_rel (arg_count, Code, Arg_list_ptr); if Code = 0 then /* active function usage */ if ^ rq_data.allow_af then do; Code = error_table_$not_act_fnc; return; end; else; else if ^ rq_data.allow_command then do; Code = error_table_$active_function; return; end; Code = 0; entry_variable.code_ptr = pointer (rq_data_ptr, rq_data.code_loc); entry_variable.env_ptr = null (); unspec (execute_entry) = unspec (entry_variable); /* call routine with arg_list supplied depending on object type */ if rq_data.multics_request then call cu_$generate_call (execute_entry, ss_info.arg_list_ptr); else call execute_entry (ss_info_ptr); return; %include "_ssu_request_table"; %include "_ssu_request_data"; %include bce_subsystem_info_; %include collection_1_phases; end bce_execute_command_;  bce_fwload.pl1 11/11/89 1135.9r w 11/11/89 0839.1 108072 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ bce_fwload: proc (p_ss_info_ptr); /* bce routine to load, upon command, a given mpc. Keith Loepere, January 1984. */ /* modified October of 1984 to add -channel argument - Allen Ball. */ /* format: style4,initcol1,indattr,declareind8,dclind4,idind36,ifthenstmt,ifthen,^indproc,delnl,insnl */ dcl addr builtin; dcl arg char (arg_len) based (arg_ptr); dcl arg_count fixed bin; /* number of mpcs */ dcl arg_len fixed bin (21); dcl arg_num fixed bin; /* loop counter */ dcl arg_ptr ptr; dcl baseno builtin; dcl bin builtin; dcl character builtin; dcl code fixed bin (35); dcl com_err_ entry () options (variable); dcl config_$find entry (char (4) aligned, ptr); dcl config_$find_2 entry (char (4) aligned, char (4) aligned, 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 cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl dimension builtin; dcl divide builtin; dcl fw_modules (16) char (8); /* names of fw modules to load */ dcl fw_module_count fixed bin; /* number of modules */ dcl hc_load_mpc entry (char (8) aligned, ptr, fixed bin (18), char (*), fixed bin (35)); dcl hc_load_mpc$urc entry (char (8) aligned, (*) ptr, (*) fixed bin (18), char (*), fixed bin (35)); dcl increment fixed bin; dcl index builtin; dcl ioa_ entry () options (variable); dcl ltrim builtin; dcl max builtin; dcl me char (6) static options (constant) init ("fwload"); dcl mpc_chanid char (8) aligned; /* iom/channel name */ dcl mpc_name char (4) aligned; /* as in mspa */ dcl null builtin; dcl p_ss_info_ptr ptr parameter; dcl preferred_mpc_chanid char (8) aligned; dcl slt$ external; dcl slt_manager$get_seg_ptr entry (char (32) aligned) returns (ptr); dcl substr builtin; dcl translate builtin; %page; ss_info_ptr = p_ss_info_ptr; call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code); if code ^= 0 | arg_count < 1 then do; usage: call com_err_ (code, me, "Usage: fwload mpc_names {args}"); return; end; do arg_num = 1 repeat arg_num + increment while (arg_num <= arg_count); preferred_mpc_chanid = ""; increment = 1; call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, code, ss_info.arg_list_ptr); mpc_name = arg; if arg_num + 2 <= arg_count then do; call cu_$arg_ptr_rel (arg_num + 1, arg_ptr, arg_len, code, ss_info.arg_list_ptr); if substr (arg, 1, 1) = "-" then do; /* It must be a control argument. */ if arg = "-channel" | arg = "-chnl" then do; call cu_$arg_ptr_rel (arg_num + 2, arg_ptr, arg_len, code, ss_info.arg_list_ptr); if code = 0 then do; preferred_mpc_chanid = arg; increment = 3; end; else do; call ioa_ ("^a: A channel must be specified.", me); return; end; end; else do; call ioa_ ("^a: ^a is not a recognized option.", me, arg); return; end; end; end; if find_mpc (mpc_chanid, mpc_name, fw_modules, fw_module_count, mpc_cardp) then do; if preferred_mpc_chanid ^= "" then do; if validate_primary_channel (preferred_mpc_chanid, mpc_cardp) then call load_mpc (preferred_mpc_chanid, mpc_name, fw_modules, fw_module_count); else do; call ioa_ ("^a: Channel ^a is not a primary channel for ^a.", me, preferred_mpc_chanid, mpc_name); return; end; end; else call load_mpc (mpc_chanid, mpc_name, fw_modules, fw_module_count); end; else do; call ioa_ ("^a: ^a is not a valid mpc.", me, mpc_name); return; end; end; return; %page; find_mpc: proc (mpc_chanid, mpc_name, fw_modules, fw_module_count, p_mpc_cardp) returns (bit (1) aligned); /* search the config deck for an mpc so as to know what channel and module is needed - also find peripherals for urcs */ dcl code fixed bin (35); dcl fw_modules (16) char (8) parameter; dcl fw_module_count fixed bin parameter; dcl fw_module_num fixed bin; /* loop counter */ dcl mpc_chanid char (8) aligned parameter; /* iom/channel */ dcl mpc_name char (4) aligned parameter; /* as in mspa */ dcl mpc_type_letter char (1); /* code letter for mpc type, d t or u */ dcl overlay_name char (4); /* firmware module type to overlay */ dcl p_mpc_cardp ptr parameter; /* find the mpc */ mpc_cardp = null; call config_$find_2 (MPC_CARD_WORD, mpc_name, mpc_cardp); if mpc_cardp = null then go to mpc_error; p_mpc_cardp = mpc_cardp; call io_chnl_util$iom_to_name ((mpc_card.port (1).iom), (mpc_card.port (1).chan), mpc_chanid, code); if code ^= 0 then do; mpc_error: call com_err_ (0, me, "No such mpc ^a.", mpc_name); return ("0"b); end; /* find the firmware type */ fw_module_count = 1; if substr (mpc_name, 1, 3) = "msp" then mpc_type_letter = "d"; else if substr (mpc_name, 1, 3) = "mtp" then mpc_type_letter = "t"; else if substr (mpc_name, 1, 3) = "urp" then mpc_type_letter = "u"; else do; call com_err_ (0, me, "Unrecognizable mpc type for mpc ^a", mpc_name); return ("0"b); end; fw_modules (1) = mpc_type_letter || ltrim (character (mpc_card.model)); if mpc_type_letter ^= "u" then return ("1"b); /* non urcs have just the main firmware */ /* urc - we must find peripherals on it */ fw_module_count = 1 + mpc_card.port (1).nchan; do fw_module_num = 2 to fw_module_count; fw_modules (fw_module_num) = "none"; /* for now */ end; prph_cardp = null; call config_$find ("prph", prph_cardp); do while (prph_cardp ^= null); if (prph_card.iom = mpc_card.port (1).iom) & ((mpc_card.port (1).chan <= prph_card.chan) & (prph_card.chan < mpc_card.port (1).chan + mpc_card.port (1).nchan)) then do; /* prph on this mpc */ if substr (prph_card.name, 1, 3) = "prt" then overlay_name = "pr4"; else if substr (prph_card.name, 1, 3) = "rdr" then overlay_name = "crz"; else if substr (prph_card.name, 1, 3) = "pun" then overlay_name = "cpz"; else if substr (prph_card.name, 1, 3) = "ccu" then overlay_name = "crp"; else overlay_name = "none"; fw_module_num = prph_card.chan - mpc_card.port (1).chan + 2; if fw_modules (fw_module_num) ^= "ccu" then fw_modules (fw_module_num) = overlay_name; /* ccu over-rides crz crp */ end; call config_$find ("prph", prph_cardp); end; return ("1"b); end; %page; load_mpc: proc (mpc_chanid, mpc_name, fw_modules, fw_module_count); dcl controller_fwid char (32) aligned; /* name of firmware object */ dcl fw_module_count fixed bin parameter; dcl fw_modules (16) char (8) parameter; dcl fw_seg_lengths (16) fixed bin (18);/* argument to hc_load_mpc of firmware object lengths */ dcl fw_seg_num fixed bin; /* loop counter */ dcl fw_seg_ptrs (16) ptr; /* arg to hc_load_mpc */ dcl mpc_chanid char (8) aligned parameter; /* iom/channel */ dcl mpc_model fixed bin; /* decimal mpc type */ dcl mpc_name char (4) aligned parameter; /* as in mspa */ dcl mpc_overlay char (8); /* firmware code for overlay */ dcl mpc_type char (8); /* model in ascii, with model and type letter code */ dcl mpc_type_index fixed bin; /* loop counter */ dcl problem char (64); /* load failure message */ dcl var_fw_seg_lengths (fw_module_count) fixed bin (18) based (addr (fw_seg_lengths)); /* arrays so as to pass (*) dim to hc_load_mpc */ dcl var_fw_seg_ptrs (fw_module_count) ptr based (addr (fw_seg_ptrs)); /* find the real firmware objects */ do fw_seg_num = 1 to fw_module_count; if fw_seg_num = 1 then do; /* main firmware */ mpc_type = fw_modules (1); mpc_model = cv_dec_check_ (substr (mpc_type, 2), code); if code ^= 0 then go to bad_mpc; if substr (mpc_type, 1, 1) = "d" then do; do mpc_type_index = 1 to config_data_$mpc_msp_model_names.count while (mpc_model ^= config_data_$mpc_msp_model_names.names (mpc_type_index).model); end; if mpc_type_index > config_data_$mpc_msp_model_names.count then go to bad_mpc; controller_fwid = "fw." || config_data_$mpc_msp_model_names.names (mpc_type_index).fw_tag; end; else if substr (mpc_type, 1, 1) = "t" then do; do mpc_type_index = 1 to config_data_$mpc_mtp_model_names.count while (mpc_model ^= config_data_$mpc_mtp_model_names.names (mpc_type_index).model); end; if mpc_type_index > config_data_$mpc_mtp_model_names.count then go to bad_mpc; controller_fwid = "fw." || config_data_$mpc_mtp_model_names.names (mpc_type_index).fw_tag; end; else if substr (mpc_type, 1, 1) = "u" then do; do mpc_type_index = 1 to config_data_$mpc_urp_model_names.count while (mpc_model ^= config_data_$mpc_urp_model_names.names (mpc_type_index).model); end; if mpc_type_index > config_data_$mpc_urp_model_names.count then go to bad_mpc; controller_fwid = "fw." || config_data_$mpc_urp_model_names.names (mpc_type_index).fw_tag; end; else do; bad_mpc: call com_err_ (0, me, "Unrecognizable mpc type ^a for mpc ^a", mpc_type, mpc_name); return; end; end; else do; /* urc overlay */ mpc_overlay = fw_modules (fw_seg_num); if mpc_overlay = "none" then controller_fwid = "none"; else do; if mpc_overlay = "pr4" then controller_fwid = "fw.urcmpc.u400"; else if mpc_overlay = "crp" | mpc_overlay = "crz" | mpc_overlay = "cpz" then controller_fwid = "fw.urcmpc.ucrp"; else do; call com_err_ (0, me, "Unrecogniable overlay name ^a for mpc ^a", mpc_overlay, mpc_name); return; end; end; end; /* name found, find object */ if controller_fwid ^= "none" then do; fw_seg_ptrs (fw_seg_num) = slt_manager$get_seg_ptr (controller_fwid); if fw_seg_ptrs (fw_seg_num) = null then do; call com_err_ (0, me, "Firmware ^a not available for model ^a mpc.", controller_fwid, mpc_type); return; end; sltp = addr (slt$); sltep = addr (slt.seg (bin (baseno (fw_seg_ptrs (fw_seg_num)), 18))); fw_seg_lengths (fw_seg_num) = divide (slte_uns.bit_count, 36, 24, 0) - 1; end; else do; fw_seg_ptrs (fw_seg_num) = null; fw_seg_lengths (fw_seg_num) = 0; end; end; /* load it! */ if fw_module_count = 1 then call hc_load_mpc (mpc_chanid, fw_seg_ptrs (1), fw_seg_lengths (1), problem, code); else call hc_load_mpc$urc (mpc_chanid, var_fw_seg_ptrs, var_fw_seg_lengths, problem, code); if code ^= 0 then call com_err_ (code, me, "^a booting mpc ^a", problem, mpc_name); return; end; %page; validate_primary_channel: proc (p_mpc_chanid, p_mpc_cardp) returns (bit (1)); dcl channel fixed bin (8); dcl code fixed bin (35); dcl iom fixed bin (3); dcl mpc_chanid char (8) aligned; dcl mpc_port_index fixed bin; dcl p_mpc_chanid char (8) aligned parameter; dcl p_mpc_cardp ptr parameter; mpc_chanid = p_mpc_chanid; mpc_cardp = p_mpc_cardp; iom = index ("ABCD", translate (substr (mpc_chanid, 1, 1), "ABCD", "abcd")); channel = cv_dec_check_ (substr (mpc_chanid, 2), code); if code ^= 0 then return ("0"b); do mpc_port_index = 1 to dimension (mpc_card_array.port, 1); if (mpc_card_array.port (mpc_port_index).iom = iom) & (mpc_card_array.port (mpc_port_index).chan = channel) then return ("1"b); end; return ("0"b); end; %page; %include bce_subsystem_info_; %page; %include config_data_dcls; %page; %include config_mpc_card; %page; %include config_prph_card; %page; %include io_chnl_util_dcls; %page; %include slt; %page; %include slte; end;  bce_get_to_command_level.pl1 11/11/89 1135.9r w 11/11/89 0839.1 71874 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ bce_get_to_command_level: proc (request_table_ptr); /* Calls sets up appropriate ss_info structure for bootload Multics and calls bce_listen_. Also contains miscelaneous return to real_initializer code. Written sometime in 1983 by Keith Loepere. */ /* Modified September of 1984 by Allen Ball to check and see if the storage system is enabled before querying the operator. */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ dcl Boot_label label static; /* used for aborting command level (the method to continue initialization and therefore boot) */ dcl Info_ptr ptr parameter; dcl NL char (1) static options (constant) init (" "); 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 bce_data$console_put_chars entry (ptr, ptr, fixed bin, fixed bin (35)) ext variable; dcl bce_data$console_alert_put_chars entry (ptr, ptr, fixed bin, fixed bin (35)) ext variable; dcl bce_data$subsys_info_ptr ptr external; dcl bce_entry bit (1) aligned; /* bce as opposed to boot command */ dcl bce_listen_ entry (ptr, char (*)); dcl bce_query entry options (variable); dcl bce_query$yes_no entry options (variable); dcl clock_set bit (1) aligned; /* false => must call init_clocks */ dcl code 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 dimension builtin; dcl error_table_$bad_arg fixed bin (35) ext static; dcl force bit (1) aligned; /* user used -force */ dcl i fixed bin; /* loop var */ dcl init_clocks entry (bit (1) aligned); dcl ioa_ entry () options (variable); dcl ioa_$nnl entry () options (variable); dcl length builtin; dcl 1 my_ss_info aligned like ss_info; dcl request_abort_ condition; dcl request_table_ptr ptr parameter; dcl saved_max_seg_size fixed bin (18); /* saved value of sys_info$max_seg_size (we change it to bce buffer size) */ dcl string builtin; dcl sys_boot_info$at_bce_cl bit (1) aligned ext static; dcl 1 sys_boot_info$bce_intk_card aligned ext static like intk_card; dcl sys_boot_info$config_has_been_modified bit (1) aligned ext static; dcl sys_info$bce_max_seg_size fixed bin (18) ext static; dcl sys_info$max_seg_size fixed bin (18) ext static; dcl 1 toehold$ aligned external like toe_hold; dcl unspec builtin; dcl yes_no bit (1); saved_max_seg_size = sys_info$max_seg_size; sys_info$max_seg_size = sys_info$bce_max_seg_size;/* lie about size of pagable segs */ my_ss_info.request_table_ptr = request_table_ptr; Boot_label = BOOT; my_ss_info.name = "bce"; string (my_ss_info.flags) = "0"b; bce_data$subsys_info_ptr = addr (my_ss_info); fgbxp = addr (flagbox$); if fgbx.mess then do; if fgbx.alert then call bce_data$console_alert_put_chars (addr (bce_data$console_alert_put_chars), addr (fgbx.message), length (fgbx.message), code); else call bce_data$console_put_chars (addr (bce_data$console_put_chars), addr (fgbx.message), length (fgbx.message), code); call bce_data$console_put_chars (addr (bce_data$console_put_chars), addr (NL), length (NL), code); fgbx.mess = "0"b; end; sys_boot_info$at_bce_cl = "1"b; if fgbx.breakpoint then do; call ioa_ ("Entering probe."); call bce_listen_ (addr (my_ss_info), "probe"); end; else if fgbx.manual_crash then call bce_listen_ (addr (my_ss_info), ""); else call bce_listen_ (addr (my_ss_info), fgbx.return_to_bce_command); go to BOOT; reinitialize: entry (Info_ptr); clock_set = "1"b; force = "0"b; ss_info_ptr = Info_ptr; call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code); if code ^= 0 then do; call com_err_ (code, "reinitialize"); signal request_abort_; end; do i = 1 to arg_count; call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, ss_info.arg_list_ptr); if arg = "-force" | arg = "-fc" then force = "1"b; else if arg = "-time" | arg = "-tm" then clock_set = "0"b; else do; call com_err_ (error_table_$bad_arg, "reinitialize", "^a", arg); return; end; end; fgbxp = addr (flagbox$); if ^force then if sys_info$collection_1_phase = CRASH_INITIALIZATION then if fgbx.rtb.ssenb then do; call bce_query$yes_no (yes_no, "Memory contains a valid Multics image. Do you wish to destroy it? "); if ^yes_no then signal request_abort_; end; if ^clock_set then call init_clocks (clock_set); if ^clock_set then return; sys_info$collection_1_phase = EARLY_INITIALIZATION; /* makes next phase boot phase */ toehold$.memory_state = At_bce__early; go to Boot_label; boot: entry (Info_ptr); /* The command that leaves command level */ bce_entry = "0"b; go to boot_join; bce: entry (Info_ptr); /* continue booting bce */ bce_entry = "1"b; boot_join: ss_info_ptr = Info_ptr; clock_set = (sys_info$collection_1_phase ^= EARLY_INITIALIZATION); force = "0"b; intk_cardp = addr (sys_boot_info$bce_intk_card); unspec (intk_card) = "0"b; intk_card.word = INTK_CARD_WORD; intk_card.n_fields = 2; intk_card.field_type (1) = CONFIG_STRING_TYPE; intk_card.warm_or_cold = "warm"; /* for now */ intk_card.field_type (2) = CONFIG_DECIMAL_TYPE; intk_card.boot_drive = 0; do i = 1 to dimension (intk_card.parms, 1); unspec (intk_card.parms (i)) = EMPTY_FIELD; end; if ^bce_entry then do; call cu_$arg_count_rel (arg_count, ss_info.arg_list_ptr, code); if code ^= 0 then do; call com_err_ (code, "boot"); signal request_abort_; end; do i = 1 to arg_count; call cu_$arg_ptr_rel (i, arg_ptr, arg_len, code, ss_info.arg_list_ptr); if arg = "-force" | arg = "-fc" then force = "1"b; else if arg = "-cold" then intk_card.warm_or_cold = "cold"; else if arg = "-time" | arg = "-tm" then clock_set = "0"b; else do; intk_card.n_fields = intk_card.n_fields + 1; if intk_card.n_fields > 14 then do; call com_err_ (0, "boot", "Too many options."); return; end; intk_card.parms (intk_card.n_fields - 2) = arg; intk_card.field_type (intk_card.n_fields) = CONFIG_STRING_TYPE; end; end; if ^force then do; if intk_card.warm_or_cold = "cold" then do; call bce_query$yes_no (yes_no, "Do you really wish to boot cold and there by destroy the system hierarchy? "); if ^yes_no then signal request_abort_; end; if sys_boot_info$config_has_been_modified then do; call bce_query$yes_no (yes_no, "The config deck has been modified. Do you wish to boot service without reinitializing bce? "); if ^yes_no then signal request_abort_; end; end; end; if ^clock_set then call init_clocks (clock_set); if ^clock_set then return; goto Boot_label; /* actually performs the boot */ BOOT: sys_info$max_seg_size = saved_max_seg_size; sys_boot_info$at_bce_cl = "0"b; fgbxp = addr (flagbox$); unspec (fgbx.rtb) = "0"b; return; %page; %include bce_subsystem_info_; %page; %include collection_1_phases; %page; %include config_deck; %page; %include config_intk_card; %page; %include flagbox; %page; %include toe_hold; end;  bce_ioi_post.pl1 11/11/89 1135.9rew 11/11/89 0839.1 30663 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1986 * * * *********************************************************** */ /* format: style4,declareind10,dclind10,idind20,indattr,delnl,insnl,tree,ifthenstmt */ bce_ioi_post: proc (ioi_event_channel, ioi_message); /****^ HISTORY COMMENTS: 1) change(86-09-05,Farley), approve(86-07-18,MCR7439), audit(86-09-24,Fawcett), install(86-10-20,MR12.0-1189): Program to post an I/O complete for IOI at BCE. END HISTORY COMMENTS */ if sys_info$service_system /* shouldn't be here */ then call syserr (CRASH, "bce_ioi_post: System not at correct level to post I/O completion."); ioi_post_area_ptr = addr (bce_ioi_post_seg$); imp = addr (ioi_message); do bufx = 1 to ioi_post_area.number; if ioi_post_area.buffer (bufx).ev_chn = ioi_event_channel then do; io_post_buffer_ptr = addr (ioi_post_area.buffer (bufx)); if imess.level = "7"b3 then do; if io_post_buffer.state ^= WAITING_SPECIAL then goto next_post_buffer; io_post_buffer.message = ioi_message; io_post_buffer.state = SPECIAL_ARRIVED; end; else if io_post_buffer.state ^= IO_OUTSTANDING then goto next_post_buffer; else do; io_post_buffer.message = ioi_message; io_post_buffer.state = IO_COMPLETE; end; return; end; next_post_buffer: end; crash: if imess.level = "1"b3 then call syserr (ANNOUNCE, "bce_ioi_post: Unexpected System Fault.^/^14xioi_event_channel: ^24.3b^/^14xioi_message: ^24.3b", unspec (ioi_event_channel), unspec (ioi_message)); else if imess.level ^= "7"b3 /* ignore unwanted specials, but crash on others.. */ then call syserr (CRASH, "bce_ioi_post: Error posting I/O event.^/^14xioi_event_channel: ^24.3b^/^14xioi_message: ^24.3b", unspec (ioi_event_channel), unspec (ioi_message)); return; %page; dcl based_bin fixed bin based; dcl bufx fixed bin; dcl ioi_event_channel fixed bin (71) parameter; dcl ioi_message fixed bin (71) parameter; dcl sys_info$service_system bit (1) aligned external static; dcl syserr entry options (variable); %page; %include bce_ioi_post_area; %page; %include ioi_stat; %page; %include syserr_constants; %page; /* BEGIN MESSAGE DOCUMENTATION Message: bce_ioi_post: System not at correct level to post I/O completion. S: $crash T: $init M: The flag sys_info$service_system indicates that the system is up and should be posting I/O completions via pxss$io_wakeup, not this program. $err A: $notify Message: bce_ioi_post: Unexpected System Fault. ioi_event_channel: CCCCCCCCCCCC ioi_message: MMMMMMMMMMMM S: $crash T: $init M: $err A: $notify Message: bce_ioi_post: Error posting i/o completion. ioi_event_channel: CCCCCCCCCCCC ioi_message: MMMMMMMMMMMM S: $crash T: $init M: No posting buffer was found in an "I/O outstanding" state for the above event channel. $err A: $notify END MESSAGE DOCUMENTATION */ end bce_ioi_post;  bce_list_requests_.pl1 11/11/89 1135.9r w 11/11/89 0839.1 25830 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* bce_list_requests_.pl1 -- Benson Margulies for bce environment */ /* Modified the last possible day of 1983 by Keith Loepere for multics requests. */ /* format: style2 */ bce_list_requests_: procedure (Info_ptr); declare Info_ptr pointer; declare bce_map_over_requests_ entry (entry, ptr, ptr); declare ioa_ entry () options (variable); declare abort_label label static; declare sub_request_abort_ condition; declare (addr, null, pointer) builtin; call ioa_ ("List of requests:^/"); abort_label = abort; call bce_map_over_requests_ (PRINT, null (), Info_ptr -> ss_info.request_table_ptr); abort: return; PRINT: procedure (Request_data_ptr, Info_ptr); declare Request_data_ptr pointer; declare Info_ptr pointer; declare info_ptr pointer; declare info_length fixed bin (21); declare info_string char (info_length) based (info_ptr); declare NULL_STRING char (0) int static options (constant) init (""); declare nx fixed bin; declare 1 bce_flags aligned based (addr (rq_data.flags)), 2 system_flags bit (15) unal, 2 valid_at_early bit (1) unal, 2 valid_at_boot bit (1) unal, 2 valid_at_crash bit (1) unal; rq_data_ptr = Request_data_ptr; if rq_data.dont_list then return; if sys_info$collection_1_phase = BCE_CRASH_INITIALIZATION then if ^ (bce_flags.valid_at_boot | bce_flags.valid_at_crash) then return; else; else if sys_info$collection_1_phase = CRASH_INITIALIZATION then if ^ bce_flags.valid_at_crash then return; else; else if sys_info$collection_1_phase = EARLY_INITIALIZATION then if ^ bce_flags.valid_at_early then return; else; else if sys_info$collection_1_phase = BOOT_INITIALIZATION then if ^ bce_flags.valid_at_boot then return; else; request_name_list_ptr = pointer (rq_data_ptr, rq_data.namelist_loc); info_ptr = pointer (rq_data_ptr, rq_data.info_string.loc); info_length = rq_data.info_string.lth; if info_length = 0 then info_ptr = addr (NULL_STRING); on sub_request_abort_ go to abort_label; call ioa_ ("^a^21t^a", request_name_list.name (1), info_string); do nx = 2 to request_name_list.n_names; call ioa_ (" ^a", request_name_list.name (nx)); end; return; end PRINT; %include bce_subsystem_info_; %include collection_1_phases; %include "_ssu_request_table"; %include "_ssu_request_data"; end bce_list_requests_;  bce_listen_.pl1 11/11/89 1135.9r w 11/11/89 0839.1 23841 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* bce_listen_ -- listener for BCE command level and subsystems */ /* BIM '82*/ /* Modified 8/83 by K. Loepere for new bce switches */ /* Modified 9/83 by K. Loepere for initial command */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ bce_listen_: procedure (Info_ptr, initial_command); declare bce_data$get_line ext variable entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)); declare bce_execute_command_ entry (ptr, char (*), ptr, fixed bin (35)); declare bce_ready$nnl entry (char (*)); declare com_err_ entry options (variable); declare command_processor_$subsys_execute_line entry (char (*), ptr, entry, ptr, char (*), fixed bin (35)); declare error_table_$bad_command_name fixed bin (35) ext; declare wired_hardcore_data$abort_request bit (1) aligned external; declare code fixed bin (35); declare n_read fixed bin; declare request_line char (136); declare request_line_read char (n_read) based (addr (request_line)); declare Info_ptr pointer; declare initial_command char (*); declare request_abort_ condition; declare sub_request_abort_ condition; declare (addr, length, null, rtrim) builtin; %include bce_subsystem_info_; %page; ss_info_ptr = Info_ptr; ss_info.abort_label = new_command; request_line = initial_command; n_read = length (rtrim (request_line)); on request_abort_ go to new_command; on sub_request_abort_ go to new_command; do while ("1"b); if request_line_read ^= "" then do; call command_processor_$subsys_execute_line (ss_info.name, ss_info_ptr, bce_execute_command_, null (), request_line_read, code); if code ^= 0 then if code = error_table_$bad_command_name then call com_err_ (0, "bce", "Unrecognizable request. Type lr for a list of requests."); else if code = 100 then; else call com_err_ (code, "bce_listen_: "); end; new_command: wired_hardcore_data$abort_request = "0"b; /* everything running has finished */ call bce_ready$nnl (ss_info.name); call bce_data$get_line (addr (bce_data$get_line), addr (request_line), length (request_line), n_read, code); end; return; end;  bce_map_over_requests_.pl1 11/11/89 1135.9r w 11/11/89 0839.1 10809 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* format: style2 */ /* Routine for bce that runs (maps) a specified procedure over each entry of a bce ssu_-style request table. Written in the past by Benson Margulies. */ bce_map_over_requests_: procedure (Procedure, Info_ptr, Request_table_ptr); declare Procedure entry (pointer, pointer) variable parameter; declare Info_ptr pointer; declare Request_table_ptr pointer; declare rq_idx fixed bin; declare addr builtin; rqt_ptr = Request_table_ptr; do rq_idx = 1 to rqt.n_requests; rq_data_ptr = addr (rqt.requests (rq_idx)); call Procedure (rq_data_ptr, Info_ptr); end; return; %include "_ssu_request_table"; %include "_ssu_request_data"; end bce_map_over_requests_;  bce_query.pl1 11/11/89 1135.9r w 11/11/89 0839.1 32508 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* Question asking utility for bootload command environment */ /* This is like a VERY simple command_query_ */ /* BIM 10/82 */ /* Modified by Keith Loepere in 8/83 for new bce switches */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ /* declare bce_query entry options (variable) */ /* call bce_query (answer, cs, arg1, arg2, arg3, ...) */ /* Where: */ /* answer (Output) is a NONvarying string */ /* cs (Input) is the control string */ /* argN (Input) are the ioa args */ /* If only one argument is given, then this is equivalent to get_line */ /* The entry bce_query$get_line is a direct way of asking for that */ /* declare bce_query$yes_no entry options (variable) */ /* call bce_query$yes_no (yes_or_no, cs, arg1, ..., argN) */ /* declare bce_query$get_line entry (char (*)); */ /* call bce_query$get_line (response); */ bce_query: procedure (Answer) /* options (variable) */; declare arg_count_ entry returns (fixed bin); declare cu_$arg_list_ptr entry returns (pointer); declare ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned, bit (1) aligned); declare bce_data$error_put_chars ext entry (ptr, ptr, fixed bin, fixed bin (35)) variable; declare bce_data$get_line ext entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)) variable; declare Answer char (*); declare Yes_No bit (1); declare requery char (25) static options (constant) init ("Please answer yes or no: "); declare buffer char (256); declare used fixed bin (21); declare yes_no bit (1); declare just_get bit (1) aligned; declare n_read fixed bin; declare (substr, length, addr) builtin; declare arg_list_ptr pointer; %page; yes_no = "0"b; just_get = (arg_count_ () < 2); go to COMMON; get_line: entry (Answer); yes_no = "0"b; just_get = "1"b; go to COMMON; yes_no: entry (Yes_No); yes_no = "1"b; just_get = (arg_count_ () < 2); COMMON: arg_list_ptr = cu_$arg_list_ptr (); if ^just_get then do; buffer = ""; call ioa_$general_rs (arg_list_ptr, 2, 3, buffer, used, "0"b, "0"b); call bce_data$error_put_chars (addr (bce_data$error_put_chars), addr (buffer), (used), (0)); end; buffer = ""; /* wont hurt if ^yes_no */ if yes_no then do while (buffer = ""); call bce_data$get_line (addr (bce_data$get_line), addr (buffer), length (buffer), n_read, (0)); buffer = substr (buffer, 1, n_read - 1 /* strip NL*/); if buffer = "yes" | buffer = "y" then go to RETURN_YES; else if buffer = "no" | buffer = "n" then go to RETURN_NO; call bce_data$error_put_chars (addr (bce_data$error_put_chars), addr (requery), length (requery), (0)); buffer = ""; end; /* Here on only if ^yes_no */ Answer = ""; buffer = ""; call bce_data$get_line (addr (bce_data$get_line), addr (buffer), length (buffer), n_read, (0)); Answer = substr (buffer, 1, n_read - 1 /* strip NL */); return; RETURN_YES: Yes_No = "1"b; return; RETURN_NO: Yes_No = "0"b; return; end bce_query;  bce_request_table_.alm 11/11/89 1135.9r w 11/11/89 0837.1 96615 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1984 * " * * " *********************************************************** " HISTORY COMMENTS: " 1) change(85-09-09,Farley), approve(85-09-09,MCR6979), " audit(86-02-27,Coppola), install(86-03-21,MR12.0-1033): " added lock_mca, " unlock_mca requests. " 2) change(86-01-01,Farley), approve(86-07-18,MCR7439), " audit(86-08-18,Fawcett), install(86-10-20,MR12.0-1189): " Add save and restore requests. " 3) change(86-09-23,Fawcett), approve(86-09-23,MCR7533), " audit(86-10-21,Farley), install(86-10-22,MR12.0-1193): " Add copy_disk in the correct order. " END HISTORY COMMENTS name bce_request_table_ " ssu_-style request table of bce requests. " Written by one or more of Olin Sibert, Charlie Hornig, Benson Margulies " and Keith Loepere (last one to touch it). " Aug 1984 JAFalksen - removed date_time_after, time_after, date_time_valid " date_time_before, time_before, date_time_equal,time_equal " because they are no longer in equal_b " November of 1984, Allen Ball to add test_disk and display_disk_label. " January 1985: Keith Loepere: config_deck_edit_ smart enough to run at crash. include ssu_request_macros begin_table bce_request_table_ bool flags.valid_early,000004 "use some unused flags for us bool flags.valid_boot,000002 bool flags.valid_crash,000001 bool flags.valid_all,000007 bool flags.valid_non_crash,000006 request alert, bce_alert$bce_alert, (), (Write an alert message on the console.), flags.allow_command+flags.valid_all request bce, bce_get_to_command_level$bce, (), (Continue booting bce.), flags.allow_command+flags.valid_early request bce_state, bce_state$bce_state, (bces), (Return the current state of bce.), flags.allow_both+flags.valid_all request boot, bce_get_to_command_level$boot, (), (Boot Multics.), flags.allow_command+flags.valid_boot request bos, bce_bos$bce_bos, (), (Return to bos, if present.), flags.allow_command+flags.valid_all request config_edit, config_deck_edit_$config_deck_edit_, (config), (Enter the config deck editor.), flags.allow_command+flags.valid_all request continue, bce_continue$bce_continue, (go), (Restart the interrupted Multics image.), flags.allow_command+flags.valid_crash request copy_disk, bce_copy_disk$bce_copy_disk, (cd), (Copy one PV to another.), flags.allow_command+flags.valid_all request delete, bootload_fs_cmds_$delete, (dl), (Delete a bootload file.), flags.allow_command+flags.valid_all request die, bce_die$bce_die, (), (Abort bce.), flags.allow_command+flags.valid_all request display_disk_label, bce_display_disk_label$bce_display_disk_label, (ddl), (Find disk label and display, if readable.), flags.allow_command+flags.valid_all request dump, bce_dump$bce_dump, (), (Create a dump of Multics in the dump partition.), flags.allow_command+flags.valid_all request emergency_shutdown, bce_esd$bce_esd, (esd), (Perform an emergency shutdown of Multics.), flags.allow_command+flags.valid_crash request exec_com, bce_exec_com_$bce_exec_com_, (ec), (Execute a file of bootload Multics commands.), flags.allow_both+flags.valid_all request fwload, bce_fwload$bce_fwload, (fw), (Load firmware into an mpc.), flags.allow_command+flags.valid_boot+flags.valid_crash request get_flagbox, bce_get_flagbox$bce_get_flagbox, (gfb), (Get the value of a flagbox variable.), flags.allow_both+flags.valid_all request init_files, bootload_fs_cmds_$init, (), (Initialize the bootload file system.), flags.allow_command+flags.valid_all request list, bootload_fs_cmds_$list, (ls), (List bootload files.), flags.allow_command+flags.valid_all request list_requests, bce_list_requests_$bce_list_requests_, (lr), (List bootload requests.), flags.allow_command+flags.valid_all request lock_mca, bce_lock_mca$bce_lock_mca, (), (Disable MCA input through console.), flags.allow_command+flags.valid_boot+flags.valid_crash request print, bootload_fs_cmds_$print, (pr), (Print a bootload file.), flags.allow_command+flags.valid_all request probe, bce_probe$bce_probe, (pb), (Examine/modify the Multics image.), flags.allow_command+flags.valid_all request qedx, bootload_qedx$bootload_qedx, (qx), (Edit bootload text file.), flags.allow_command+flags.valid_all request reinitialize, bce_get_to_command_level$reinitialize, (reinit), (Re-perform Multics initialization.), flags.allow_command+flags.valid_crash+flags.valid_boot request rename, bootload_fs_cmds_$rename, (rn), (Rename a bootload file.), flags.allow_command+flags.valid_all request restore, bce_save$bce_restore, (), (Restore Physical Volumes from BCE Save Tapes.), flags.allow_command+flags.valid_boot request save, bce_save$bce_save, (), (Save Physical Volumes to BCE Save Tapes.), flags.allow_command+flags.valid_boot request set_flagbox, bce_set_flagbox$bce_set_flagbox, (sfb), (Set the value of a flagbox variable.), flags.allow_both+flags.valid_all request severity, bce_severity$bce_severity, (), (Returns the severity or completeness of a bce request.), flags.allow_both+flags.valid_all request shutdown_state, bce_shutdown_state$bce_shutdown_state, (sds), (Returns the shutdown state of the storage system.), flags.allow_both+flags.valid_all request test_disk, bce_test_disk$bce_test_disk, (td), (Test disk by reading and/or writing pages.), flags.allow_command+flags.valid_all request unlock_mca, bce_lock_mca$bce_unlock_mca, (), (Enable MCA input through console.), flags.allow_command+flags.valid_boot+flags.valid_crash request query,bce_query_af$bce_query_af,(),(),flags.allow_both+flags.dont_list+flags.valid_all request response,bce_response_af$bce_response_af,(),(),flags.allow_both+flags.dont_list+flags.valid_all multics_request after,(af),(),substr$after,flags.allow_both+flags.dont_list+flags.valid_all multics_request and,(),(),equal$and,flags.allow_both+flags.dont_list+flags.valid_all multics_request before,(be),(),substr$before,flags.allow_both+flags.dont_list+flags.valid_all multics_request bool,(),(),substr$bool,flags.allow_both+flags.dont_list+flags.valid_all multics_request ceil,(),(),plus$ceil,flags.allow_both+flags.dont_list+flags.valid_all multics_request collate,(),(),substr$collate,flags.allow_both+flags.dont_list+flags.valid_all multics_request collate9,(),(),substr$collate9,flags.allow_both+flags.dont_list+flags.valid_all multics_request copy_characters,(cpch),(),substr$copy_characters,flags.allow_both+flags.dont_list+flags.valid_all multics_request decat,(),(),substr$decat,flags.allow_both+flags.dont_list+flags.valid_all multics_request divide,(),(),plus$divide,flags.allow_both+flags.dont_list+flags.valid_all multics_request equal,(),(),equal$equal,flags.allow_both+flags.dont_list+flags.valid_all multics_request floor,(),(),plus$floor,flags.allow_both+flags.dont_list+flags.valid_all multics_request greater,(),(),equal$greater,flags.allow_both+flags.dont_list+flags.valid_all multics_request high,(),(),substr$high,flags.allow_both+flags.dont_list+flags.valid_all multics_request high9,(),(),substr$high9,flags.allow_both+flags.dont_list+flags.valid_all multics_request index,(),(),substr$index,flags.allow_both+flags.dont_list+flags.valid_all multics_request length,(ln),(),substr$length,flags.allow_both+flags.dont_list+flags.valid_all multics_request less,(),(),equal$less,flags.allow_both+flags.dont_list+flags.valid_all multics_request low,(),(),substr$low,flags.allow_both+flags.dont_list+flags.valid_all multics_request lower_case,(lowercase),(),substr$lower_case,flags.allow_both+flags.dont_list+flags.valid_all multics_request ltrim,(),(),substr$ltrim,flags.allow_both+flags.dont_list+flags.valid_all multics_request max,(),(),plus$max,flags.allow_both+flags.dont_list+flags.valid_all multics_request min,(),(),plus$min,flags.allow_both+flags.dont_list+flags.valid_all multics_request minus,(),(),plus$minus,flags.allow_both+flags.dont_list+flags.valid_all multics_request mod,(),(),plus$mod,flags.allow_both+flags.dont_list+flags.valid_all multics_request nequal,(),(),equal$nequal,flags.allow_both+flags.dont_list+flags.valid_all multics_request ngreater,(),(),equal$ngreater,flags.allow_both+flags.dont_list+flags.valid_all multics_request nless,(),(),equal$nless,flags.allow_both+flags.dont_list+flags.valid_all multics_request not,(),(),equal$not,flags.allow_both+flags.dont_list+flags.valid_all multics_request or,(),(),equal$or,flags.allow_both+flags.dont_list+flags.valid_all multics_request plus,(),(),plus$plus,flags.allow_both+flags.dont_list+flags.valid_all multics_request quotient,(),(),plus$quotient,flags.allow_both+flags.dont_list+flags.valid_all multics_request reverse,(rv),(),substr$reverse,flags.allow_both+flags.dont_list+flags.valid_all multics_request reverse_after,(rvaf),(),substr$reverse_after,flags.allow_both+flags.dont_list+flags.valid_all multics_request reverse_before,(rvbe),(),substr$reverse_before,flags.allow_both+flags.dont_list+flags.valid_all multics_request reverse_decat,(rvdecat),(),substr$reverse_decat,flags.allow_both+flags.dont_list+flags.valid_all multics_request reverse_index,(rvindex),(),substr$reverse_index,flags.allow_both+flags.dont_list+flags.valid_all multics_request reverse_search,(rvsrh),(),substr$reverse_search,flags.allow_both+flags.dont_list+flags.valid_all multics_request reverse_verify,(rvverify),(),substr$reverse_verify,flags.allow_both+flags.dont_list+flags.valid_all multics_request rtrim,(),(),substr$rtrim,flags.allow_both+flags.dont_list+flags.valid_all multics_request search,(srh),(),substr$search,flags.allow_both+flags.dont_list+flags.valid_all multics_request substr,(),(),substr$substr,flags.allow_both+flags.dont_list+flags.valid_all multics_request times,(),(),plus$times,flags.allow_both+flags.dont_list+flags.valid_all multics_request trunc,(),(),plus$trunc,flags.allow_both+flags.dont_list+flags.valid_all multics_request upper_case,(uppercase),(),substr$upper_case,flags.allow_both+flags.dont_list+flags.valid_all multics_request verify,(),(),substr$verify,flags.allow_both+flags.dont_list+flags.valid_all end_table bce_request_table_ end  bootload_disk_io.pl1 11/11/89 1135.9r w 11/11/89 0839.1 51381 /****^ *********************************************************** * * * 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-06-17,Farley), install(86-07-17,MR12.0-1097): Keith Loepere for async operation, support of bce_copy_disk. 2) change(86-05-20,Fawcett), approve(86-05-20,MCR7383), audit(86-06-17,Farley), install(86-07-17,MR12.0-1097): Changed to add support for MSU3380 and MUS3390 END HISTORY COMMENTS */ bootload_disk_io$read: proc (a_pvtx, a_record_num, a_n_records, a_buffer_ptr, a_code); /* Routine to use dctl to perform a disk read/write for bce performance. Written February 1985 by Keith Loepere. Modified March 1985 by Keith Loepere for async operation. */ /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */ /* Parameters */ dcl a_buffer_num fixed bin parameter;/* disk_post slot, actually */ dcl a_buffer_ptr ptr parameter; /* to wired memory area, must be at a page boundary */ dcl a_code fixed bin (35) parameter; dcl a_n_records fixed bin parameter;/* must be 1-4 */ dcl a_pvtx fixed bin parameter; dcl a_record_num fixed bin (18) parameter; /* Variables */ dcl async bit (1) aligned; dcl buffer_address fixed bin (26); dcl buffer_num fixed bin; dcl code fixed bin (35); dcl last_poll_time fixed bin (71) static; dcl n_sectors fixed bin; dcl old_mask bit (72) aligned; dcl pvtx fixed bin; dcl read_not_write bit (1) aligned; dcl record_num fixed bin (18); /* Entries */ dcl absadr entry (ptr, fixed bin (35)) returns (fixed bin (24)); dcl dctl$bootload_read entry (fixed bin, fixed bin (26), bit (18) aligned, fixed bin, fixed bin); dcl dctl$bootload_write entry (fixed bin, fixed bin (26), bit (18) aligned, fixed bin, fixed bin); dcl disk_control$disk_run entry; dcl pmut$set_mask entry (bit (72) aligned, bit (72) aligned); /* Constants */ dcl THIRTY_SEC fixed bin (35) init (30000000) static options(constant); /* External */ dcl error_table_$fsdisk_phydev_err fixed bin (35) ext static; dcl error_table_$not_done fixed bin (35) ext static; dcl scs$sys_level bit (72) aligned ext; /* Misc */ dcl (addr, bit, clock) builtin; %page; read_not_write = "1"b; buffer_num = 1; async = "0"b; go to join; bootload_disk_io$write: entry (a_pvtx, a_record_num, a_n_records, a_buffer_ptr, a_code); read_not_write = "0"b; buffer_num = 1; async = "0"b; go to join; bootload_disk_io$queue_read: entry (a_pvtx, a_record_num, a_n_records, a_buffer_ptr, a_buffer_num, a_code); read_not_write = "1"b; buffer_num = a_buffer_num; async = "1"b; go to join; bootload_disk_io$queue_write: entry (a_pvtx, a_record_num, a_n_records, a_buffer_ptr, a_buffer_num, a_code); read_not_write = "0"b; buffer_num = a_buffer_num; async = "1"b; join: /* get those args into wired storage! */ a_code = 0; pvtx = a_pvtx; pvt_arrayp = addr (pvt$array); pvtep = addr (pvt_array (pvtx)); record_num = a_record_num; n_sectors = sect_per_rec (pvte.device_type) * a_n_records; buffer_address = absadr (a_buffer_ptr, code); disk_post_area_ptr = addr (bootload_disk_post_seg$); if ^async then disk_post_area.number = buffer_num; disk_post_area.buffer_coreadd (buffer_num) = buffer_address; disk_post_area.disk_complete (buffer_num) = "0"b; disk_post_area.disk_error_code (buffer_num) = 0; /* wire down for dctl call */ call pmut$set_mask (scs$sys_level, old_mask); /* <+><+><+><+> */ if read_not_write then call dctl$bootload_read (pvtx, buffer_address, bit (record_num, 18), 0, n_sectors); else call dctl$bootload_write (pvtx, buffer_address, bit (record_num, 18), 0, n_sectors); call pmut$set_mask (old_mask, (""b)); /* <-><-><-><-> */ last_poll_time = clock; /* start running timeout from now */ if async then do; a_code = 0; return; end; /* wait for i/o */ do while (^disk_post_area.disk_complete (buffer_num)); if clock > last_poll_time + THIRTY_SEC then do; call pmut$set_mask (scs$sys_level, old_mask); /* <+><+><+><+> */ call disk_control$disk_run; /* poll disk for lost interrupt */ call pmut$set_mask (old_mask, (""b)); /* <-><-><-><-> */ last_poll_time = clock; end; end; code = disk_post_area.disk_error_code (buffer_num); if code ^= 0 then code = error_table_$fsdisk_phydev_err; disk_post_area.number = 0; a_code = code; return; %page; bootload_disk_io$test_done: entry (a_buffer_num, a_code); buffer_num = a_buffer_num; /* look for done */ disk_post_area_ptr = addr (bootload_disk_post_seg$); if ^disk_post_area.disk_complete (buffer_num) then if clock > last_poll_time + THIRTY_SEC then do; call pmut$set_mask (scs$sys_level, old_mask); /* <+><+><+><+> */ call disk_control$disk_run; /* poll disk for lost interrupt */ call pmut$set_mask (old_mask, (""b)); /* <-><-><-><-> */ last_poll_time = clock; end; if ^disk_post_area.disk_complete (buffer_num) then code = error_table_$not_done; else do; code = disk_post_area.disk_error_code (buffer_num); if code ^= 0 then code = error_table_$fsdisk_phydev_err; end; a_code = code; return; %page; %include bootload_post_area; %page; %include pvte; %page; %include fs_dev_types_sector; end;  init_bce.pl1 11/11/89 1135.9r w 11/11/89 0839.1 25965 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* INIT_BCE.PL1 -- initialize the bootload_command_environment */ /* BIM 8/82 */ /* Modified by Keith Loepere in 83 for exec_com, file_out support */ /* Modified by Keith Loepere in March 85 to set bce cp_data_. */ /* format: style4,indattr,ifthenstmt,ifthen,idind33,^indcomtxt */ init_bce: procedure; declare 1 AI aligned like area_info; declare fa1_ptr pointer; declare bce_data$console_alert_put_chars entry variable ext; declare bce_data$console_get_line entry variable ext; declare bce_data$console_put_chars entry variable ext; declare bce_data$error_put_chars entry variable ext; declare bce_data$exec_com_get_line entry variable ext; declare bce_data$free_area_ptr pointer ext; declare bce_data$get_line entry variable ext; declare bce_data$put_chars entry variable ext; declare dseg$ (0:4095) fixed bin (71) ext; declare free_area_1$ ext static bit (36) aligned; declare bce_console_io$get_line entry; declare bce_console_io$put_chars entry; declare bce_console_io$put_chars_alert entry; declare bce_exec_com_input entry; declare define_area_ entry (ptr, fixed bin (35)); declare sdw_util_$get_size entry (ptr, fixed bin (18)); declare null builtin; declare stackbaseptr builtin; %page; wired: entry; /* init all references to wired data */ unspec (AI) = ""b; AI.version = 1; AI.owner = ""; fa1_ptr = addr (free_area_1$); call sdw_util_$get_size (addr (dseg$ (bin (baseno (fa1_ptr)))), AI.size); AI.areap = fa1_ptr; AI.zero_on_free = "1"b; call define_area_ (addr (AI), (0)); bce_data$free_area_ptr, stackbaseptr () -> stack_header.user_free_ptr, stackbaseptr () -> stack_header.system_free_ptr = fa1_ptr; bce_data$console_get_line, bce_data$get_line = bce_console_io$get_line; bce_data$console_put_chars, bce_data$put_chars = bce_console_io$put_chars; bce_data$console_alert_put_chars = bce_console_io$put_chars_alert; bce_data$error_put_chars = bce_console_io$put_chars; return; paged: entry; /* references to paged data */ bce_data$exec_com_get_line = bce_exec_com_input; cp_data_$scratch_release_factor = 1; /* temporary segments in BCE are a scarce resource */ addr (cp_data_$permanent_scratch_segment_list) -> permanent_scratch_segment_list.n_scratch_segments = 1; return; %page; %include area_info; %page; %include cp_data_; %page; %include stack_header; end init_bce; 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