mca_init_.pl1 11/11/89 1104.4r w 11/11/89 0810.0 27540 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-09-11,Fawcett), approve(85-09-11,MCR6979), audit(86-01-17,CLJones), install(86-03-21,MR12.0-1033): Created to control the MCA in the IMU. END HISTORY COMMENTS */ /* format: style4 */ /* Created Nov 1984 by R. A. Fawcett */ /* Modified May 1985 by P. K Farley to call admin_gate_$ocdcm_reconfigure to lock MCA input through the console. */ mca_init_: proc (a_mca_index, a_code); dcl a_mca_index fixed bin (3) parm; dcl a_code fixed bin (35) parm; dcl code fixed bin (35); dcl i fixed bin; dcl mca_index fixed bin; dcl rings (3) fixed bin (3); dcl hcs_$append_branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin (3), char (*), fixed bin (1), fixed bin (1), fixed bin (24), fixed bin (35)); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl admin_gate_$ocdcm_reconfigure entry (char (4), fixed bin, fixed bin (35)); dcl (null, substr) builtin; dcl error_table_$bad_arg fixed bin (35) ext static; mca_index = a_mca_index; if mca_index < 1 | mca_index > 4 then do; a_code = error_table_$bad_arg; return; end; /* does the data_segment exists */ call hcs_$initiate (SYSTEM_DIR, DATA_SEG, "", 0, 0, mca_data_seg_ptr, code); if mca_data_seg_ptr = null () then do; /* Ok then create the data segment with the rings of 1,1,1 and rw *.* " */ rings (*) = 1; call hcs_$append_branchx (SYSTEM_DIR, DATA_SEG, 10, rings, "*.*.*", 0, 0, 0, code); if code ^= 0 then do; a_code = code; return; end; call hcs_$initiate (SYSTEM_DIR, DATA_SEG, "", 0, 0, mca_data_seg_ptr, code); if mca_data_seg_ptr = null () then do; a_code = code; return; end; /* New segment init the data that will be needed */ mca_data_seg.version = MCA_data_version_1; /* Set correct version */ do i = 1 to 4; mca_data_seg.array (i).state = MCA_NOT_CONFIGURED; mca_data_seg.array (i).lock = "0"b; mca_data_seg.array (i).name = substr ("abcd", i, 1); mca_data_seg.array (i).imu_number = i; end; /* Lock MCA input through the console. NOTE: Because we don't know which Console is the "Master" mca console, we will attempt to lock every configured console. */ call admin_gate_$ocdcm_reconfigure ("", LOCK_MCA_INPUT, code); end; /* mark this MCA free */ mca_data_seg.array (mca_index).state = MCA_FREE; a_code = 0; return; %page; %include mca_data; %page; %include opc_reconfig_options; end mca_init_;  rcp_init.pl1 11/11/89 1104.4r w 11/11/89 0806.8 257652 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1983 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-09-09,Farley), approve(85-09-09,MCR6979), audit(86-01-17,CLJones), install(86-03-21,MR12.0-1033): Add IMU & MCA support also add no_protect and opr_int_available. 2) change(88-03-12,Beattie), approve(88-05-31,MCR7864), audit(88-05-13,Brunelle), install(88-05-31,MR12.2-1046): Changed BEEP to ANNOUNCE for error messages during tape handler survey. END HISTORY COMMENTS */ /* format: style4,delnl,insnl,ifthenstmt,indnoniterend */ rcp_init: procedure; /* This is a system initialization procedure. It initializes the * RCP data base, rcp_data. This procedure must be called sometime * after ioi_init is called. * * Created on 09/11/74 by Bill Silver. * Changed on 03/24/76 by Bill Silver for NSS I/O disks. * Modified on 01/20/77 by Noel I. Morris for multiple tape controllers. * Modified on 03/05/77 by Bernard S. Greenberg for static "AC/DC" disks. * Modified on 09/19/77 by R.J.C. Kissel to increase default workspace sizes. * Modified on 04/28/78 by Michael R. Jordan for preloaded volumes and reservation software. * Modified on 01/29/79 by Michael R. Jordan for MSS0500 subsystem. * Modified 1/80 by Michael R. Jordan for MSU0501 subsystem. * Modified April, 1981, Chris Jones, for io_manager conversion, etc. * Modified 7/81 by M.R. Jordan to change to console model numbers and add CSU6601 support. * Modified 5/82 by E. N. Kittlitz to increase URC device max-timeout for EURC. * Modified February 1982 by C. Hornig to move to ring 1. * Modified 09/20/82 by Chris Jones to increase tape drive max timeout so data security erase can finish, and * to increase default workspace size for tapes from 3 to 6 pages. * Modified 830927 for multiple console cards... -E. A. Ranzenbach * Modified 840415 to call IOI during automatic device deletion... C. L. Jones * Modified 841024 to set state according to io_config_data... M. M. Pozzo * Modifed 841213 to add IMU/MCA support.. Paul Farley * Modifed 850213 to add no_protect and opr_int_available code.. Paul Farley */ /* AUTOMATIC DATA */ dcl 1 drive_name, /* Used to generate tape and disk drive names. */ 2 dtype char (5), 2 number pic "99"; dcl 1 prph_mca_card like prph_card; /* Fake out a prph card for the MCA used for IMUs */ dcl last_ptrs (8) ptr; /* Ptr to last device entry for each device type. */ dcl qualifiers (4) fixed bin; /* Device qualifiers. */ dcl device_len fixed bin; /* Number of bits in a device entry. */ dcl device_name char (8); /* Unique physical device name. */ dcl dtypex fixed bin; /* Device type index. */ dcl drive_num fixed bin; /* Tape and disk drive numbers. */ dcl ecode fixed bin (35); /* Standard error_table_ code. */ dcl (i, j) fixed bin; /* Work indexes. */ dcl model fixed bin; /* Model field from prph card. */ dcl modelx fixed bin; /* MODELX from fs_dev_types */ dcl num_channels fixed bin; /* Number of channels for each device. */ dcl num_drives fixed bin; /* Number of disk devices for RCP to control. */ dcl num_qualifiers fixed bin; /* Number of device qualifiers. */ dcl pairx fixed bin; /* PRPH DSKx card pair index. */ dcl prph_name char (3); /* Prph card device type name. */ dcl pvtx fixed bin; dcl rcs_size fixed bin; /* Total size of RCS. */ dcl reservable_flag bit (1); /* ON => device reservable to system processes. */ dcl save_dtypex fixed bin; /* Temporary to save device type index. */ dcl starting_time fixed bin (71); /* Time metering started. */ dcl fips bit (1); /* used to see if we are FIPS or not */ /* INTERNAL STATIC DATA */ dcl special_dtypex fixed bin /* Device type index for special devices. */ static options (constant) init (7); dcl ws_maxs (8) fixed bin /* IOI workspace limits in pages. */ static options (constant) init (6, 2, 1, 1, 1, 1, 1, 1); dcl ws_pmaxs (8) fixed bin /* Privileged IOI workspace limits. */ static options (constant) init (44, 44, 44, 44, 44, 44, 44, 44); dcl to_maxs (8) fixed bin /* IOI time-out limits in seconds. */ static options (constant) init (420, 1, 180, 60, 60, 60, 240, 240); dcl histo_times (8, 3) fixed bin /* Time intervals in minutes. */ static options (constant) init (2, 5, 30, /* TAPE */ 2, 5, 30, /* DISK */ 2, 5, 30, /* CONSOLE */ 5, 30, 120, /* PRINTER */ 5, 20, 60, /* PUNCH */ 5, 20, 60, /* READER */ 2, 5, 30, /* SPECIAL */ 2, 5, 30); /* MCA */ dcl prph_names (8) char (3) /* Device type names on prph cards. */ static options (constant) init ("tap", "dsk", "opc", "prt", "pun", "rdr", "spc", "mca"); dcl sys_directory char (32) /* Directory used to define a system process. */ static options (constant) init (">system_library_1"); dcl sys_acs char (32) /* Entry name used to define a system process. */ static options (constant) init ("rcp_sys_"); dcl acs_directory char (32) /* Directory containing device ACSs. */ static options (constant) init (">system_control_1>rcp"); dcl rb (3) fixed bin (6) /* Ring brackets for rcp_data */ static options (constant) init (1, 1, 1); /* EXTERNAL ENTRIES CALLED */ dcl (addr, divide, hbound, null, ptr, rel, rtrim, size, string, substr, fixed, clock) builtin; dcl sys_info$max_seg_size fixed bin (35) external; dcl admin_gate_$ioi_delete_device entry (char (*), fixed bin (35)); dcl config_$find entry (char (4) aligned, ptr); dcl config_$find_2 entry (char (4) aligned, char (4) aligned, ptr); dcl get_max_authorization_ entry () returns (bit (72) aligned); dcl hcs_$append_branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin (6), char (*), fixed bin, fixed bin, fixed bin, fixed bin (35)); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); dcl hphcs_$syserr entry options (variable); dcl hphcs_$syserr_error_code entry options (variable); dcl initializer_gate_$ss_io_reconfigure entry (fixed bin, bit (1) aligned, fixed bin (35)); dcl rcp_tape_survey_ entry (char (*), fixed bin, bit (1) aligned, bit (1) aligned, (4) fixed bin (35), fixed bin (35)); dcl resource_info_$limits entry (char (*), fixed bin, fixed bin, fixed bin, fixed bin (35)); dcl system_privilege_$reclassify_sys_seg entry (char (*), char (*), bit (72) aligned, fixed bin (35)); dcl mca_init_ entry (fixed bin (3), fixed bin (35)); /* BASED DATA */ dcl based_device bit (device_len) based (device_ptr) aligned; %page; /* Begin rcp_init. */ pvtp = addr (pvt$); pvt_arrayp = addr (pvt.array); /* Get pointer to io_config_data device table */ io_config_data_ptr = addr (io_config_data$); io_config_device_table_ptr = ptr (io_config_data_ptr, device_table_offset); call hcs_$append_branchx (sys_directory, "rcp_data", RW_ACCESS_BIN, rb, "*.*.*", 0, 0, 0, ecode); if ecode ^= 0 then goto MAKE_RCPD; call hcs_$initiate (sys_directory, "rcp_data", "", 0, 1, rcpd_ptr, ecode); if rcpd_ptr = null () then go to MAKE_RCPD; call system_privilege_$reclassify_sys_seg (sys_directory, "rcp_data", get_max_authorization_ (), ecode); if ecode ^= 0 then goto RECLASSIFY_RCPD; starting_time = clock (); /* Same starting time for both segments. */ /* Initialize the header info in RCPD. */ lock_info_ptr = addr (rcpd.lock_info); /* Initialize lock metering data. */ call INIT_LOCK_INFO; rcpd.tot_dtypes = hbound (device_types, 1); rcpd.unload_sleep_time = 1000000; /* Sleep for at most 1 sec. */ do dtypex = 1 to hbound (device_types, 1); /* Set up data for each device type. */ dtype_ptr = addr (rcpd.dtype (dtypex)); /* Get pointer to device type entry. */ dtype.device_type = device_types (dtypex); /* Set up device type. */ do i = 1 to 3; /* Set up device type histogram data in seconds. */ dtype.histo_times (i) = histo_times (dtypex, i) * 60; end; last_ptrs (dtypex) = null (); end; /* Look at each prph card in the configuration deck. */ prph_cardp = null (); /* Start with first prph card. */ do while ("1"b); call config_$find (PRPH_CARD_WORD, prph_cardp); /* Get next prph card. */ if prph_cardp = null () /* Have we processed all prph cards? */ then goto END_OF_CARDS; /* Yes. */ call PROCESS_PRPH_CARD; /* Process this one prph card. */ end; END_OF_CARDS: /* All prph cards processed OK. */ /* Look at each iom card in the configuration deck, for IMUs. Fake a prph card for mca incase we find an IMU */ prph_mca_card.word = PRPH_CARD_WORD; prph_mca_card.chan = 3; prph_mca_card.model = 0; prph_cardp = addr (prph_mca_card); iom_cardp = null (); call config_$find (IOM_CARD_WORD, iom_cardp); /* Start with first iom card. */ do while (iom_cardp ^= null ()); if iom_card.model = "imu" | iom_card.model = "iioc" then do; /* Found an IMU so set up the data segment and process the fake prph card */ call mca_init_ (iom_card.tag, ecode); if ecode ^= 0 then goto INIT_MCA_ERROR; prph_mca_card.iom = iom_card.tag; prph_mca_card.name = "mca" || substr ("abcd", iom_card.tag, 1); call PROCESS_PRPH_CARD; end; call config_$find (IOM_CARD_WORD, iom_cardp);/* Get next iom card. */ end; do dtypex = 1 to hbound (device_types, 1); /* Set max concurrent limits. */ dtype_ptr = addr (rcpd.dtype (dtypex)); /* Get pointer to device type entry. */ if dtype.max_concurrent = 0 /* Unspecified => limit = num of devices of this type. */ then dtype.max_concurrent = dtype.num_devices; end; /* Now that we know the number of devices that use volumes we can * initialize the array of volume entries. */ do i = 1 to rcpd.last_volume; /* Initialize each volume entry. */ volume_ptr = addr (rcpd.volume (i)); volume.volume_name = " "; volume.group_id = ""; volume.reserved_by = ""; volume.state_time = starting_time; end; rcpd.tot_volumes = divide ((sys_info$max_seg_size - fixed (rel (addr (rcpd.volume (1))), 18)), size (volume), 18, 0); /* Now initialize the RCP communications segment, rcp_com_seg. * We must set up the list of free request entries. */ call hcs_$append_branchx (sys_directory, "rcp_com_seg", RW_ACCESS_BIN, rb, "*.*.*", 0, 0, 0, ecode); if ecode ^= 0 then goto MAKE_RCS; call hcs_$initiate (sys_directory, "rcp_com_seg", "", 0, 1, rcs_ptr, ecode); if rcs_ptr = null () then goto MAKE_RCS; call system_privilege_$reclassify_sys_seg (sys_directory, "rcp_com_seg", get_max_authorization_ (), ecode); if ecode ^= 0 then goto RECLASSIFY_RCS; lock_info_ptr = addr (rcs.lock_info); /* Initialize lock metering data. */ call INIT_LOCK_INFO; do i = 1 to hbound (device_types, 1); /* Save IOI device type limits in RCS. */ rcs.ws_maxs (i) = ws_maxs (i) * 1024; rcs.ws_pmaxs (i) = ws_pmaxs (i) * 1024; rcs.to_maxs (i) = to_maxs (i) * 1000000; end; rcs.sys_directory = sys_directory; /* Fill in access control directory and entry names. */ rcs.sys_acs = sys_acs; rcs.acs_directory = acs_directory; rcs_size = sys_info$max_seg_size; rcs.max_entries = divide ((rcs_size - size (rcs)), size (rcse), 17, 0); rcs.num_entries = rcpd.tot_devices * 2; /* Start with 2 entries per device. */ rcs.first_free_off = rel (addr (rcs.entry (1))); do i = 1 to rcs.num_entries; /* Initialize each entry to be free. */ rcse_ptr = addr (rcs.entry (i)); /* Get pointer to entry. */ rcse.state_time = clock (); /* Time entry initialized. */ rcse.free_off = rel (addr (rcs.entry (i + 1))); end; addr (rcs.entry (rcs.num_entries)) -> rcse.free_off = "0"b; call hcs_$terminate_noname (rcpd_ptr, ecode); call hcs_$terminate_noname (rcs_ptr, ecode); return; /* All device types initialized OK. */ MAKE_RCPD: call hphcs_$syserr_error_code (CRASH, ecode, "rcp_init: Trying to create rcp_data"); RECLASSIFY_RCPD: call hphcs_$syserr_error_code (CRASH, ecode, "rcp_init: Trying to reclassify rcp_data"); MAKE_RCS: call hphcs_$syserr_error_code (CRASH, ecode, "rcp_init: Trying to create rcp_com_seg"); RECLASSIFY_RCS: call hphcs_$syserr_error_code (CRASH, ecode, "rcp_init: Trying to reclassify rcp_com_seg"); INIT_MCA_ERROR: call hphcs_$syserr_error_code (CRASH, ecode, "rcp_init: Trying to init mca_data."); %page; PROCESS_PRPH_CARD: procedure; /* We will take the name from the prph card and see if it matches one of * the device types we know. If it does we will go to a routine that * knows how to process that device type. If it does not belong to a type * of device that we know then we will ignore it. */ prph_name = substr (prph_card.name, 1, 3); /* Get device type name. */ do dtypex = 1 to hbound (device_types, 1); /* Check all device type names. */ if prph_name = prph_names (dtypex) /* Do we know this device type? */ then goto PRPH_CARD_OK; end; dtypex = special_dtypex; /* Treat unknown as special device. */ PRPH_CARD_OK: /* This is a device type that we know about. */ dtype_ptr = addr (rcpd.dtype (dtypex)); /* Pointer to device type info. */ device_name = prph_card.name; /* Device type is prph card name. */ reservable_flag = "0"b; /* Assume device is not reservable. */ model = prph_card.model; /* Set up default qualifiers. */ num_channels = 1; /* Assume only one channel. */ num_qualifiers = dtype_num_qualifiers (dtypex); fips = IS_FIPS_DEVICE (); goto DTYPE (dtypex); /* Process prph card depending upon device type. */ DTYPE (1): /* TAPE */ call INIT_TAPES; /* Special case tapes. */ return; DTYPE (2): /* DISK */ call INIT_DISKS; /* Special case disks. */ return; DTYPE (3): /* CONSOLE */ prph_opc_cardp = prph_cardp; device_name = prph_opc_card.name; model = prph_opc_card.model; call INIT_DEVICE (); return; DTYPE (4): /* PRINTER */ prph_prt_cardp = prph_cardp; qualifiers (1) = prph_prt_card.train; /* Print train type. */ qualifiers (2) = prph_prt_card.line_length; call INIT_DEVICE; /* Set up device entry. */ return; DTYPE (5): /* PUNCH */ DTYPE (6): /* READER */ DTYPE (7): /* SPECIAL */ DTYPE (8): /* MCA */ call INIT_DEVICE; /* These device types processed the same way. */ return; /* Just set up the device entry. */ end PROCESS_PRPH_CARD; %page; INIT_TAPES: procedure; /* This procedure will process the "tapX" prph card. All tapX drives wlll * be defined from this one card. In addition, the special type device * "tapX_00" will be defined, unless its a FIPS, then tapX is the special. */ prph_tap_cardp = prph_cardp; call resource_info_$limits ("tape_drive", dtype.max_concurrent, (0), (0), ecode); if dtype.max_concurrent < 0 then dtype.max_concurrent = 0; if fips then device_name = substr (device_name, 1, 4); /* FIPS controllers don't have a "_00" */ else device_name = substr (device_name, 1, 4) || "_00"; /* but non-FIPS do */ call INIT_SPECIAL; /* Set up special tape pseudo device. */ drive_name.dtype = substr (device_name, 1, 4) || "_"; /* Now set up the real tape drives. */ if fips then drive_num = -1; /* FIPS devices start at zero */ else drive_num = 0; do pairx = 1 to hbound (prph_tap_card.group, 1); num_drives = prph_tap_card.group (pairx).ndrives; model = prph_tap_card.group (pairx).model; if model = -1 then return; if num_drives = -1 then goto NO_NDRIVES; do j = 1 to num_drives; drive_num = drive_num + 1; if model ^= 0 then do; call INIT_TAPE; rcpd.last_volume = rcpd.last_volume + 1; end; end; end; return; NO_NDRIVES: call hphcs_$syserr (ANNOUNCE, "rcp_init: ndrives not specified with last model number for PRPH ^a. Assuming 0.", prph_tap_card.name); end INIT_TAPES; %page; INIT_TAPE: procedure; dcl tape_found bit (1) aligned; /* This procedure is called to initialize one tape drive */ drive_name.number = drive_num; /* Use picture conversion. */ device_name = string (drive_name); reservable_flag = "1"b; call INIT_DEVICE; call rcp_tape_survey_ (substr (device_name, 1, 4), drive_num, (fips), tape_found, device.qualifiers, ecode); if ecode ^= 0 then call hphcs_$syserr_error_code (ANNOUNCE, ecode, "rcp_init: Error surveying ^a.", device_name); if ((^tape_found) | (DEVICE_DELETED (device_name))) then do; call hphcs_$syserr (ANNOUNCE, "rcp_init: ^a deleted.", device_name); call admin_gate_$ioi_delete_device (device_name, (0)); device.state = 2; /* DELETED */ end; return; end INIT_TAPE; %page; INIT_DISKS: procedure; /* This procedure will create rcp_data entries for all controllers * and drives in the system, usurp from the storage system all those * specified on an applicable UDSK card, and delete all the others, * pendant dynamic RCP/SS reconfiguration. */ dcl i fixed bin; prph_dsk_cardp = prph_cardp; udsk_cardp = null (); call config_$find_2 ("udsk", prph_dsk_card.name, udsk_cardp); drive_name.dtype = prph_dsk_card.name || "_"; /* Set up disk device name. */ drive_name.number = 0; /* "dskX_00" */ if fips then device_name = prph_dsk_card.name; else device_name = string (drive_name); model = 0; /* Model number not used for special devices. */ call INIT_SPECIAL; /* Init "dskX_00" or dskX as a special device. */ /* unless its FIPS, then dskX is special */ if fips then drive_num = -1; else drive_num = 0; do pairx = 1 to hbound (prph_dsk_card.group, 1); /* Process each set up drive pairs. */ num_drives = prph_dsk_card.group (pairx).ndrives; model = prph_dsk_card.group (pairx).model; if model = -1 /* (-1) => no drive pair specified. */ then return; /* All done for this subsystem. */ if num_drives = -1 /* (-1) => no ndrives specified. */ then goto NO_NDRIVES; modelx = 0; do i = 2 to hbound (MODEL, 1) while (modelx = 0); /* skip bulk */ if model = MODEL (i) then do; modelx = MODELX (i); model = MODELN (modelx); end; end; if model ^= 0 then do; do j = 1 to num_drives; drive_num = drive_num + 1; drive_name.number = drive_num; device_name = string (drive_name); call INIT_DEVICE; device.flags.not_removable_media = ^media_removable (modelx); if fips then device.flags.no_protect = "1"b; device.flags.opr_int_available = MPC_WITH_OI (prph_dsk_card.iom, prph_dsk_card.chan); if (DEVICE_DELETED (device_name)) then device.state = 2; else device.state = 3; /* STORAGE SYSTEM */ if udsk_cardp ^= null () then call process_udsk; end; rcpd.last_volume = rcpd.last_volume + num_drives; end; else drive_num = drive_num + num_drives; end; return; NO_NDRIVES: call hphcs_$syserr (ANNOUNCE, "rcp_init: ndrives not specified with last model number for PRPH ^a. Assuming 0.", prph_dsk_card.name); return; %page; process_udsk: procedure; dcl ux fixed bin; do ux = 1 to hbound (udsk_card.group, 1); if (udsk_card.group (ux).drive ^= -1) & (udsk_card.group (ux).drive <= drive_num) & ((udsk_card.group (ux).drive + udsk_card.group (ux).ndrives - 1) >= drive_num) then do; do pvtx = 1 to pvt.max_n_entries; pvtep = addr (pvt_array (pvtx)); if (pvte.devname = prph_dsk_card.name) & (pvte.logical_area_number = drive_num) then do; if pvte.used | pvte.permanent then do; call hphcs_$syserr (CRASH, "rcp_init: ^a cannot be used for user I/O.", device_name); return; end; call initializer_gate_$ss_io_reconfigure (pvtx, "0"b, ecode); if (DEVICE_DELETED (device_name)) then device.state = 2; else device.state = 0; /* FREE */ return; end; end; end; end; return; end process_udsk; end INIT_DISKS; %page; INIT_SPECIAL: procedure; /* This procedure is called to set up a special type device for * the tape or disk controller. */ save_dtypex = dtypex; /* Save real device type index. */ dtypex = special_dtypex; /* Get device type index for special devices. */ dtype_ptr = addr (rcpd.dtype (dtypex)); /* Pointer to special device info. */ num_qualifiers = 0; /* No characteristics known about special devices. */ call INIT_DEVICE; /* Define a device. */ dtypex = save_dtypex; /* Restore original information. */ dtype_ptr = addr (rcpd.dtype (dtypex)); /* Reset device type pointer */ num_qualifiers = dtype_num_qualifiers (dtypex); end INIT_SPECIAL; %page; INIT_DEVICE: procedure; /* This procedure is called to initialize a device entry. * It is called for each type of device. Those fields that are * only valid when the device is assigned or attached are not * initialized. */ do i = 1 to rcpd.tot_devices; /* Test all devices defined so far. */ device_ptr = addr (rcpd.device (i)); if device.device_name = device_name then goto DUPLICATE_DEVICE; end; rcpd.tot_devices = rcpd.tot_devices + 1; /* One new device added to list. */ device_ptr = addr (rcpd.device (rcpd.tot_devices)); if dtype.num_devices = 0 /* Is this the first device of this type? */ then dtype.first_off = rel (device_ptr); else last_ptrs (dtypex) -> device.next_off = rel (device_ptr); last_ptrs (dtypex) = device_ptr; /* Save pointer to this entry. */ dtype.num_devices = dtype.num_devices + 1; device_len = size (device) * 36; /* Get number of bits in device entry. */ based_device = "0"b; /* Zero device entry before initializing. */ device.device_name = device_name; /* Fill in entry. */ device.volume_name = " "; /* No volume now mounted. */ device.dtypex = dtypex; device.model = model; /* Save qualifying characteristics. */ device.num_qualifiers = num_qualifiers; do i = 1 to num_qualifiers; device.qualifiers (i) = qualifiers (i); end; device.state_time = clock (); /* Time device initialized. */ if (DEVICE_DELETED (device_name)) then device.state = 2; device.iom_num = prph_card.iom; device.chan_num = prph_card.chan; device.num_channels = num_channels; device.flags.reservable = reservable_flag; device.flags.fips = fips; device.group_id = " "; /* So no name. */ device.reservation_id = 0; /* No reservation. */ device.reserved_by = ""; /* Dito. */ device.acs_name = rtrim (device_name) || ".acs"; /* Generate ACS name */ return; DUPLICATE_DEVICE: call hphcs_$syserr (CRASH, "rcp_init: Device ^a defined more than once", device_name); end INIT_DEVICE; %page; INIT_LOCK_INFO: procedure; /* This procedure is called to initialize the lock metering data. */ lock_info.lock = "0"b; /* Lock unlocked. */ lock_info.num_locks, /* Never has been locked. */ lock_info.num_lock_waits = 0; lock_info.tot_lock_time, lock_info.tot_wait_time = 0; lock_info.starting_time = starting_time; end INIT_LOCK_INFO; %page; DEVICE_DELETED: procedure (a_name) returns (bit (1)); /* local vars */ dcl a_name char (*); dcl (found, deleted) bit (1) init ("0"b); dcl i fixed bin; do i = 1 to device_table.n_devices while (^found); if device_entry (i).name = a_name then found = "1"b; end; if ^device_entry (i - 1).flags.configured then deleted = "1"b; return (deleted); end DEVICE_DELETED; %page; IS_FIPS_DEVICE: proc () returns (bit (1)); /* This proc will look up the model in config_data_ for the dtypex checking for device_0_valid */ dcl i fixed bin; dcl groupx fixed bin; goto is_fips (dtypex); is_fips (1): /* TAPE */ prph_tap_cardp = prph_cardp; do groupx = 1 to hbound (prph_tap_card.group, 1); model = prph_tap_card.group (groupx).model; if model ^= 0 then do; do i = 1 to config_data_$tape_drive_model_names.count; if config_data_$tape_drive_model_names.names (i).model = model then return (config_data_$tape_drive_model_names.names (i).device_0_valid); end; return ("0"b); end; end; return ("0"b); is_fips (2): /* DISK */ prph_dsk_cardp = prph_cardp; do groupx = 1 to hbound (prph_dsk_card.group, 1); model = prph_dsk_card.group (groupx).model; if model ^= 0 then do; do i = 1 to config_data_$disk_drive_model_names.count; if config_data_$disk_drive_model_names.names (i).model = model then return (config_data_$disk_drive_model_names.names (i).device_0_valid); end; return ("0"b); end; end; return ("0"b); is_fips (3): is_fips (4): is_fips (5): is_fips (6): is_fips (7): is_fips (8): return ("0"b); end IS_FIPS_DEVICE; %page; MPC_WITH_OI: proc (a_iom, a_chan) returns (bit (1)); /* If there is a mpc card for this device and it is not a DAU (MSP800) then we say it has an "Operator Interrupt" switch. */ dcl a_iom fixed bin (3) parameter; dcl a_chan fixed bin (8) parameter; dcl i fixed bin; mpc_cardp = null (); do while ("1"b); call config_$find (MPC_CARD_WORD, mpc_cardp); if mpc_cardp = null () then return ("0"b); do i = 1 to hbound (mpc_card.port, 1) while (mpc_card.port (i).iom ^= -1); if (a_iom = mpc_card.port (i).iom) & (a_chan >= mpc_card.port (i).chan) & (a_chan < mpc_card.port (i).chan + mpc_card.port (i).nchan) then do; if mpc_card.model = 800 then return ("0"b); else return ("1"b); end; end; end; return ("0"b); end MPC_WITH_OI; %page; %include access_mode_values; %include io_config_data; %include config_deck; %include config_data_dcls; %include config_iom_card; %include config_prph_card; %include config_mpc_card; %include config_prph_opc_card; %include config_prph_prt_card; %include config_prph_tap_card; %include config_prph_dsk_card; %include config_udsk_card; %include fs_dev_types; %include pvt; %include pvte; %include rcp_data; %include rcp_com_seg; %include rcp_device_types; %include syserr_constants; %page; /* BEGIN MESSAGE DOCUMENTATION Message: rcp_init: Trying to create rcp_data ERRORMESSAGE S: $crash T: $init M: $err A: $recover Message: rcp_init: Trying to reclassify rcp_data ERRORMESSAGE S: $crash T: $init M: $err A: $recover Message: rcp_init: Trying to create rcp_com_seg ERRORMESSAGE S: $crash T: $init M: $err A: $recover Message: rcp_init: Trying to reclassify rcp_com_seg ERRORMESSAGE S: $crash T: $init M: $err A: $recover Message: rcp_init: Trying to init mca_data. ERRORMESSAGE S: $crash T: $init M: $err A: $recover Message: rcp_init: ndrives not specified with last model number for PRPH DDDD. Assuming 0. S: $info T: $init M: Detected a MODEL value at the end of PRPH card PPPP. Each MODEL value should paired with an NDRIVE value. The last model value will be assigned zero devices. It is possible that there is another error elsewhere on this card to have caused this message. A: $inform Message: rcp_init: Error surveying DDDD. ERRORMESSAGE S: $info T: $init M: Attempted to access device DDDD but could not due to ERRORMESSAGE. A: $inform Message: rcp_init: DDDD deleted. S: $info T: $init M: Device DDDD could not be found or accessed and it will be deleted. A: $inform Message: rcp_init: DDDD cannot be used for user I/O. S: $crash T: $init M: An attempt was made to configure a device for user I/O which is being used by the system for system storage. A: $recover Message: rcp_init: Device DEVICE defined more than once S: $crash T: $init M: The configuration deck defines the device DEVICE more than once. A: Perform an emergency shutdown, and correct the configuration deck. $recover END MESSAGE DOCUMENTATION */ end rcp_init;  system_startup_.pl1 11/11/89 1104.4r 11/11/89 0810.0 351792 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1983 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387), audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056): Correct error message documentation. 2) change(87-02-25,Farley), approve(87-04-15,MCR7659), audit(87-04-21,Fawcett), install(87-04-28,MR12.1-1028): Corrected to call disk_table_$init before calling disk_table_$accept_rlv. END HISTORY COMMENTS */ /* format: style2,indcomtxt */ /**** This procedure is the process overseer for the Multics initializer process. The initializer starts out in ring 1. Only a small set of commands are permitted primarily to allow a reload to take place. Once the reload is complete the standard process overseer for the initializer, "system_control_", is invoked in ring 4. Modified 1985-04-02, BIM: don't print error message if disk_table_$accept_rlv fails, because it prints plenty of messages. Don't run automatic salvage_dirs if root is not complete. Modified 85-03-27 by E. Swenson to add support for emergency listener. Modified 84-10-30 by EJ Sharpe to remove hvr_ declarations Modified 84-08-08 by EJ Sharpe to remove the volume registration commands: (add del change list)_volume_registration. Modified 84-02-02 BIM for amendments. Modified 831107 BIM to salvage crucial directories Modified August 1983 K. Loepere to change references to bce. Modified August 1983 K. Loepere to delete salv and force_pd_abandon commands. Modified 830529 BIM for error handler bugfixes. Modified May 1982 by E. N. Kittlitz to log config deck Modified March 1982 by J. Bongiovanni to rename >lv.root on NOLV Modified June 1981 by C. Hornig to flush bulk store. Modified April 1981 by Benson I. Margulies for IOX Modified April 1979 by B. Greenberg for NOLV/NODT boot card hacks. Modified Feb 1977 by D. Vinograd to add command for volume reloader. Modified Oct 75 for Nss by TVV Modified 750423 by T. Casey to add reload_system_release and reload_notrim, and delete update. Modified 741218 by PG to turn on soos, dir, and ipc privileges. "update" request added by RE Mullen Aug 1973 Originally coded by R. J. Feiertag on March 25, 1971 */ system_startup_: procedure (); dcl code fixed bin (35); dcl (i, j) fixed bin; dcl SC1 char (168) init (">system_control_1") internal static; /* one wdir is as good as an other */ dcl ME character (32) init ("system_startup_") internal static options (constant); dcl test_dir char (*) parameter; dcl l fixed bin (21); /* length of input command */ dcl 1 local_status_branch aligned like status_branch; dcl 1 local_salv_args aligned like salv_args; dcl vcommand character (80) varying; dcl entry_var entry variable options (variable); /* arg to caller */ dcl nosc_parameter bit (1) aligned; dcl buffer char (120) unaligned; /* Typewriter input buffer */ dcl IOX_up bit (1) aligned init ("0"b); dcl disk_table_ok bit (1) aligned; dcl init bit (1) internal static init ("0"b); /* have we been initialized */ dcl rings (3) fixed bin (3) int static init (7, 7, 7); dcl debug bit (1) internal static init ("0"b); dcl level fixed bin int static init (0); dcl active_all_rings_data$initializer_tty ext char (32), /* id of initializer console */ active_all_rings_data$initializer_dim ext char (32), active_all_rings_data$system_id ext char (32); dcl error_table_$long_record fixed bin (35) ext static; dcl ( system_privilege_$soos_priv_on, system_privilege_$dir_priv_on, system_privilege_$ring1_priv_on, system_privilege_$ipc_priv_on ) entry (fixed bin (35)); dcl get_system_free_area_ entry returns (ptr); dcl (get_temp_segments_, release_temp_segments_) entry (character (*), (*) pointer, fixed binary (35)); dcl hcs_$quota_read entry (char (*), fixed bin (18), fixed bin (71), bit (36) aligned, bit (36), fixed bin (1), fixed bin (18), fixed bin (35)); dcl hcs_$status_ entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); dcl hcs_$history_regs_set entry (bit (1) aligned); dcl hphcs_$salv_directory entry (ptr, char (*) var, ptr, fixed bin, fixed bin (35)); dcl sct_manager_$set entry (fixed bin, entry, fixed bin (35)); dcl timer_manager_$alarm_interrupt entry; dcl timer_manager_$cpu_time_interrupt entry; dcl call_outer_ring_ entry (pointer, char (*), char (*), fixed bin (3), fixed bin (35)); dcl disk_table_$accept entry options (variable); dcl disk_table_$general_mhv entry (fixed bin (35)); dcl disk_table_$mount_hvol entry options (variable); dcl disk_table_$list entry options (variable); dcl iload entry options (variable); dcl iload$system_release entry options (variable); dcl disk_table_$remove entry options (variable); dcl disk_table_$demount_hvol entry options (variable); dcl disk_table_$reregister entry options (variable); dcl salv_caller$packsalv entry options (variable); dcl salv_caller$rbld_disk entry options (variable); dcl disk_table_$initialize_disk entry options (variable); dcl reload_volume entry options (variable); dcl end_reload_volume entry options (variable); dcl display_volume_log entry options (variable); dcl disk_table_$io_ss_reconfig entry options (variable); dcl recover_volume_log entry options (variable); dcl date_time_$format entry (char (*), fixed bin (71), char (*), char (*)) returns (char (250) varying); dcl ioa_ entry options (variable); dcl ioa_$nnl entry options (variable); dcl ioa_$rsnnl entry options (variable); dcl com_err_ entry options (variable); dcl com_err_$suppress_name entry options (variable); dcl condition_ entry (char (*), entry); dcl iox_$init_standard_iocbs entry; dcl disk_table_$accept_rlv entry (fixed bin (35)); dcl disk_table_$init entry (fixed bin (35)); dcl get_group_id_ entry returns (char (32)); dcl hcs_$append_branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin (3), char (*), fixed bin, fixed bin, fixed bin, fixed bin (35)); dcl hcs_$chname_file entry (char (*), char (*), char (*), char (*), fixed bin (35)); dcl hcs_$fs_search_set_wdir entry (char (*), fixed bin (35)); dcl hphcs_$call_bce entry; dcl hphcs_$shutdown entry; dcl hphcs_$syserr entry options (variable); dcl hphcs_$syserr_error_code entry options (variable); dcl hphcs_$syserr_binary entry options (variable); dcl rcp_init entry; dcl rcp_reconfigure_$delete_device entry (char (*), fixed bin (35)); dcl rcp_reconfigure_$add_device entry (char (*), fixed bin (35)); dcl timer_manager_$sleep entry (fixed bin (71), bit (2)); dcl unique_chars_ entry (bit (*)) returns (char (15)); dcl (addr, after, before, clock, codeptr, currentsize, divide, hbound, length, ltrim, max, min, null, pointer, rtrim, size, substr, sum, unspec) builtin; dcl stringsize condition; %page; /* Program */ call condition_ ("any_other", error); /* find_condition_info_ aint on the tape */ call sct_manager_$set (cput_sct_index, timer_manager_$cpu_time_interrupt, code); call sct_manager_$set (alrm_sct_index, timer_manager_$alarm_interrupt, code); call system_privilege_$soos_priv_on (code); /* Turn on scodeurity-out-of-service privilege */ call system_privilege_$dir_priv_on (code); /* Turn on directory privileges */ call system_privilege_$ring1_priv_on (code); /* turn on ring 1 privileges */ call system_privilege_$ipc_priv_on (code); /* Turn on ipc privileges */ /* code indicates if on previously, ignore */ call hcs_$history_regs_set ("1"b); /* save hregs */ code = 0; if init then go to read_command; /* if restart, skip initialization */ call rcp_init; call iox_$init_standard_iocbs; call iox_$attach_ptr (iox_$user_io, active_all_rings_data$initializer_dim || " " || active_all_rings_data$initializer_tty, codeptr (system_startup_), code); if code ^= 0 then call die (); call iox_$open (iox_$user_io, Stream_input_output, ""b, code); if code ^= 0 then call die (); test_entry: entry (); IOX_up = "1"b; /* Obtain the first operator command from the BOOT command arguments */ call get_config_size (); call log_configuration (); vcommand = ""; nosc_parameter = "0"b; do i = 1 to config_n_cards while (vcommand = ""); if cards (i).word = INTK_CARD_WORD then do; intk_cardp = addr (config_deck.cards (i)); do j = 1 to hbound (intk_card_array.parms, 1); if intk_card.parms (j) = "nodt" then call root_rename ("disk_table"); else if intk_card.parms (j) = "nolv" then call nolv_request; else if intk_card.parms (j) = "nosc" then nosc_parameter = "1"b; else vcommand = vcommand || intk_card.parms (j) || " "; end; end; end; code = 0; call disk_table_$init (code); /* Turn on the ring 1 storage system */ if code = 0 then disk_table_ok = "1"b; else disk_table_ok = "0"b; pvtp = addr (pvt$); if pvt.rlv_needs_salv & ^pvt.rpvs_requested /* suppress for rpvs */ then do; call disk_table_$accept_rlv (code); if code = 0 then call salvage_dirs; /* for speed. */ else call com_err_ (0, ME, "The root logical volume is not complete. ""boot rlvs"" level 2 directory salvage aborted.") ; end; call hcs_$append_branchx (">", "system_control_1", 01011b, rings, get_group_id_ (), 1, 0, (0), (0)); call hcs_$fs_search_set_wdir (SC1, (0)); /* set default value */ call ioa_ ("Multics ^a - ^a", active_all_rings_data$system_id, date_time_$format ("date_time", clock (), "", "")); init = "1"b; /* initialization is complete */ if disk_table_ok then do; /* If disk table looks OK */ if vcommand ^= "" then call exec (rtrim (vcommand)); /* do command ONLY if all is cool */ end; goto read_command; /* Command processor loop */ read_command_entry: entry (); call condition_ ("any_other", error); /* set it for this frame */ goto read_command; read_command_return: return; read_command: do while ("1"b); call ioa_$nnl ("^[Level ^d; ^]Command: ", level ^= 0, level); /* Prompt for command. */ call iox_$get_line (iox_$user_io, addr (buffer), length (buffer), l, code); if code = error_table_$long_record then call com_err_ (code, ME, "Input line too long for command buffer."); else if code ^= 0 then do; call hphcs_$syserr_error_code (CRASH, code, "^a: Could not read command line.", ME); call hphcs_$call_bce; /* I MEANT THAT 1 */ end; else do; l = l - 1; /* throw away new line */ call exec (substr (buffer, 1, l)); end; end; %page; exec: proc (buf); /* This procedure is nonquick, it has a dependent string declaration */ dcl buf character (*); dcl work_string character (length (buf)) varying; dcl command character (32); dcl arg (0:20) char (32); dcl an fixed bin; arg (*) = ""; an = -1; /* no args unless we see more */ work_string = buf; do while (work_string ^= ""); work_string = ltrim (work_string); /* leading blanks go away */ an = an + 1; if an > hbound (arg, 1) then do; call ioa_ ("Too many arguments supplied. ^d is the maximum.", hbound (arg, 1)); return; end; on stringsize begin; call ioa_ ("Token longer than 32 characters: ^a.", before (work_string, " ")); go to exec_return; end; (stringsize): arg (an) = before (work_string, " "); revert stringsize; work_string = after (work_string, " "); end; if an = -1 then exec_return: return; command = arg (0); do i = 1 to hbound (command_abbrev, 1) while (command ^= command_abbrev (i)); end; if i > hbound (command_abbrev, 1) then do; do i = 1 to hbound (command_list, 1) while (command ^= command_list (i)); end; if i > hbound (command_list, 1) then do; call ioa_ ("^a: ^a is not a legal command. Type help for a list of commands.", ME, command); return; end; end; command = command_list (i); /* Expand abbrev */ do j = 1 to hbound (check_commands, 1); if check_commands (j) = command & ^(nosc_parameter & command = "standard") /* special case "boot stan nosc" */ then do; code = 0; call disk_table_$accept_rlv (code);/* prints error messages */ if code ^= 0 then go to read_command; end; end; go to handle (i); handle (1): /* "add_vol" command */ entry_var = disk_table_$accept; call caller (); return; handle (2): /* "bce" command */ call hphcs_$call_bce; return; handle (3): /* "list_disks" command */ entry_var = disk_table_$list; call caller (); return; handle (4): /* "multics" command */ call shutdown_iox; /* this is in ring 1, so it is not crucial */ call call_out ("multics_entry"); return; handle (5): /* "reload" command */ code = 0; call disk_table_$general_mhv (code); if code ^= 0 then do; call com_err_ (0, ME, "Will not reload"); return; end; entry_var = iload; call caller (); return; handle (6): /* "del_lv" command */ entry_var = disk_table_$demount_hvol; call caller (); return; handle (7): /* "reload_system_release" command */ entry_var = iload$system_release; call caller (); return; handle (8): /* "del_vol" command */ entry_var = disk_table_$remove; call caller (); return; handle (9): /* "shutdown" command */ call hphcs_$shutdown; return; handle (10): /* "standard" command */ call shutdown_iox; call call_out ("system_control_"); /* call standard process overseer */ return; handle (11): /* "reregister" command */ entry_var = disk_table_$reregister; call caller (); return; handle (12): /* "startup" command */ call shutdown_iox; call call_out ("startup_entry"); /* call standard process overseer */ return; handle (13): /* "salvage_vol" command */ entry_var = salv_caller$packsalv; call caller (); return; handle (14): /* "init_vol" command */ entry_var = disk_table_$initialize_disk; call caller (); return; handle (15): /* "add_lv" command */ entry_var = disk_table_$mount_hvol; call caller (); return; handle (16): /* "help" command */ do i = 1 to hbound (command_list, 1); if command_abbrev (i) ^= "" then call ioa_ ("^a (^a)", command_list (i), command_abbrev (i)); else call ioa_ ("^a", command_list (i)); end; call ioa_ (""); return; handle (17): /* "addd" command */ call rcp_reconfigure_$add_device (arg (1), code); return; handle (18): /* "deld" command */ call rcp_reconfigure_$delete_device (arg (1), code); return; handle (19): /* rebuild_disk command */ entry_var = salv_caller$rbld_disk; call caller (); return; handle (20): /* reload_volume command */ entry_var = reload_volume; call caller (); return; handle (21): /* end_reload_volume command */ entry_var = end_reload_volume; call caller (); return; handle (22): /* recover_volume_log command */ entry_var = recover_volume_log; call caller (); return; handle (23): /* debug command */ debug = "1"b; return; handle (24): /* release command */ if level > 0 then do; level = level - 1; goto read_command_return; end; else do; call ioa_ ("At top of stack"); return; end; handle (25): /* display_volume_log command */ entry_var = display_volume_log; call caller (); return; handle (26): /* set_drive_usage command */ entry_var = disk_table_$io_ss_reconfig; call caller (); return; handle (27): /* salvage_dirs command */ entry_var = salvage_dirs; call caller (); return; dcl command_list (27) char (32) static options (constant) init ("add_vol", "bce", "list_disks", "multics", "reload", "del_lv", "reload_system_release", "del_vol", "shutdown", "standard", "reregister", "startup", "salvage_vol", "init_vol", "add_lv", "help", "adddev", "deldev", "rebuild_disk", "reload_volume", "end_reload_volume", "recover_volume_log", "debug", "release", "display_volume_log", "set_drive_usage", "salvage_dirs"); dcl command_abbrev (27) char (4) static options (constant) init ("av", "", "ld", "mult", "", "dlv", "", "dv", "shut", "stan", "", "star", "sv", "", "alv", "", "addd", "deld", "", "", "", "", "", "", "", "sdu", ""); dcl check_commands (6) char (32) static options (constant) init ("multics", "reload", "reload_system_release", "standard", "startup", "salvage_dirs"); /* These require a complete RLV */ %page; caller: proc (); if arg (20) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5), arg (6), arg (7), arg (8), arg (9), arg (10), arg (11), arg (12), arg (13), arg (14), arg (15), arg (16), arg (17), arg (18), arg (19), arg (20)); else if arg (19) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5), arg (6), arg (7), arg (8), arg (9), arg (10), arg (11), arg (12), arg (13), arg (14), arg (15), arg (16), arg (17), arg (18), arg (19)); else if arg (18) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5), arg (6), arg (7), arg (8), arg (9), arg (10), arg (11), arg (12), arg (13), arg (14), arg (15), arg (16), arg (17), arg (18)); else if arg (17) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5), arg (6), arg (7), arg (8), arg (9), arg (10), arg (11), arg (12), arg (13), arg (14), arg (15), arg (16), arg (17)); else if arg (16) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5), arg (6), arg (7), arg (8), arg (9), arg (10), arg (11), arg (12), arg (13), arg (14), arg (15), arg (16)); else if arg (15) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5), arg (6), arg (7), arg (8), arg (9), arg (10), arg (11), arg (12), arg (13), arg (14), arg (15)); else if arg (14) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5), arg (6), arg (7), arg (8), arg (9), arg (10), arg (11), arg (12), arg (13), arg (14)); else if arg (13) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5), arg (6), arg (7), arg (8), arg (9), arg (10), arg (11), arg (12), arg (13)); else if arg (12) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5), arg (6), arg (7), arg (8), arg (9), arg (10), arg (11), arg (12)); else if arg (11) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5), arg (6), arg (7), arg (8), arg (9), arg (10), arg (11)); else if arg (10) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5), arg (6), arg (7), arg (8), arg (9), arg (10)); else if arg (9) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5), arg (6), arg (7), arg (8), arg (9)); else if arg (8) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5), arg (6), arg (7), arg (8)); else if arg (7) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5), arg (6), arg (7)); else if arg (6) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5), arg (6)); else if arg (5) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4), arg (5)); else if arg (4) ^= "" then call entry_var (arg (1), arg (2), arg (3), arg (4)); else if arg (3) ^= "" then call entry_var (arg (1), arg (2), arg (3)); else if arg (2) ^= "" then call entry_var (arg (1), arg (2)); else if arg (1) ^= "" then call entry_var (arg (1)); else call entry_var (); end caller; end exec; %page; /* Internal procedure to do the NOLV work. This involves renameing >lv.root to a uniquely named thing, and removing all other names from it. */ nolv_request: proc; dcl namex fixed bin; dcl LV_ROOT_ENT char (7) int static options (constant) init ("lv.root"); status_area_ptr = get_system_free_area_ (); status_ptr = addr (local_status_branch); call hcs_$status_ (">", LV_ROOT_ENT, 0, status_ptr, status_area_ptr, code); if code ^= 0 then call com_err_ (code, ME, "Cannot remove names from >^a", LV_ROOT_ENT); else do; do namex = 1 to status_branch.nnames; if status_entry_names (namex) ^= LV_ROOT_ENT then do; call hcs_$chname_file (">", LV_ROOT_ENT, (status_entry_names (namex)), "", code); if code ^= 0 then call com_err_ (code, ME, "Removing name ^a from >^a", status_entry_names (namex), LV_ROOT_ENT); end; end; free status_branch; end; call root_rename (LV_ROOT_ENT); call root_rename ("lv"); return; end nolv_request; %page; root_rename: proc (a_segname); dcl a_segname char (*); dcl new_ename char (32); new_ename = rtrim (a_segname) || "." || unique_chars_ (""b); call hcs_$chname_file (">", a_segname, a_segname, new_ename, code); if code = 0 then call ioa_ ("system_startup_: Renamed >^a to >^a.", a_segname, new_ename); end root_rename; %page; /* This internal procedure handles all signalled errors */ error: proc (mcptr, name, wcptr, iptr); dcl mcptr ptr, /* pointer to machine conditions */ name char (*), /* name of condition */ wcptr ptr, /* pointer to wall crossing conditions */ iptr ptr; /* points to misc information */ dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl 1 auto_fault_msg aligned like fault_msg; dcl error_name char (32); dcl message char (100); dcl i_message char (100) aligned; %include condition_info_header; %include sub_error_info; dcl in_error_handler bit (1) aligned internal static init ("0"b); /* detect recursive errors */ if in_error_handler then begin; declare dead_ptr pointer; declare death_value fixed bin; declare based_deadly based fixed bin; declare baseptr builtin; call hphcs_$syserr (CRASH, "^a: Recursive error condition.", ME); /* trust NOTHING */ call hphcs_$call_bce (); dead_ptr = baseptr (-2); /* take attempt to terminate initializer process if hphcs is broken. */ death_value = dead_ptr -> based_deadly; end; in_error_handler = "1"b; error_name = name; if iptr ^= null () /* Software Information */ then do; condition_info_header_ptr = iptr; if condition_info_header.quiet_restart then RETURN_FROM_ERROR: do; in_error_handler = "0"b; return; end; if name = "sub_error_" then do; sub_error_info_ptr = iptr; error_name = sub_error_info.name; end; message = ""; call ioa_$rsnnl ("Error: ^a condition", message, (0), error_name); call PRINT (message); if condition_info_header.status_code ^= 0 then call convert_status_code_ (condition_info_header.status_code, "", i_message); else i_message = ""; message = i_message; if condition_info_header.info_string ^= "" then call PRINT_V (condition_info_header.info_string); if message ^= "" then call PRINT (message); if condition_info_header.action_flags.default_restart then go to RETURN_FROM_ERROR; end; else if mcptr = null () then call hphcs_$syserr (BEEP, "^a: unclaimed ^a condition.", ME, name); else do; mcp = mcptr; unspec (auto_fault_msg.mach_cond) = unspec (mc); unspec (auto_fault_msg.hist_reg) = ""b; /* we cant get */ call hphcs_$syserr_binary (LOG, addr (auto_fault_msg), SB_hw_fault, SBL_hw_fault, "^a:", ME); call hphcs_$syserr_error_code (BEEP, mcptr -> mc.errcode, "^a: unclaimed ^a condition.", ME, name); call hphcs_$syserr (ANNOUNCE, "^5xPointer Registers:"); do i = 0 to 7; call hphcs_$syserr (ANNOUNCE, "^-pr^d:^-^p", i, mc.prs (i)); end; call hphcs_$syserr (ANNOUNCE, "^5x Registers:"); call hphcs_$syserr (ANNOUNCE, "^-x0: ^.3b x1: ^.3b x2: ^.3b x3: ^.3b^/^-x4: ^.3b x5: ^.3b x6: ^.3b x7: ^.3b", mc.x (0), mc.x (1), mc.x (2), mc.x (3), mc.x (4), mc.x (5), mc.x (6), mc.x (7)); call hphcs_$syserr (ANNOUNCE, "^-a: ^.3b q: ^.3b e:^.3b", mc.a, mc.q, mc.e); call hphcs_$syserr (ANNOUNCE, "^-timer: ^.3b ralr: ^.3b", mc.t, mc.ralr); call hphcs_$syserr (ANNOUNCE, "^5xSCU Data:^2(^/^w ^w ^w ^w^)", mc.scu); end; if ^IOX_up then do; call hphcs_$syserr ("^a: Cannot do IO, crashing."); call hphcs_$call_bce; end; if debug then do; level = level + 1; in_error_handler = "0"b; call read_command_entry; /* save the stack */ end; if init then do; in_error_handler = "0"b; go to read_command; /* Try again */ end; call hphcs_$syserr (CRASH, "^a: Error condition while initializing ring 1 environment.", ME); call hphcs_$call_bce; PRINT: procedure (a_message); declare a_message char (*); if IOX_up then call ioa_ ("^a: ^a", ME, a_message); else call hphcs_$syserr (BEEP, "^a: ^a", ME, a_message); return; PRINT_V: entry (a_v_message); declare a_v_message char (*) varying; if IOX_up then call ioa_ ("^a: ^a", ME, a_v_message); else call hphcs_$syserr (ANNOUNCE, "^a: ^a", ME, a_v_message); return; end PRINT; end error; /* This internal procedures terminates the process */ die: proc; call hphcs_$syserr_error_code (CRASH, code, "^a: error on initializer io streams", ME); call hphcs_$call_bce; end die; shutdown_iox: procedure; /* leaving i/o switches around in ring 1 is not necessarily fatal. So we do not crash in here, but leave it to system_control_ to crash from ring 4 for if something cannot be tolerated. */ declare iox_$n_standard_iocbs external fixed bin; declare standard_iocb_ptrs (iox_$n_standard_iocbs) pointer based (iocb_ptrs_ptr); declare iox_$standard_iocb_ptrs bit (36) aligned external static; declare iocb_ptrs_ptr pointer; IOX_up = "0"b; iocb_ptrs_ptr = addr (iox_$standard_iocb_ptrs); do i = 1 to iox_$n_standard_iocbs; call iox_$close (standard_iocb_ptrs (i), (0)); call iox_$detach_iocb (standard_iocb_ptrs (i), (0)); end; end shutdown_iox; %page; test: entry (test_dir); SC1 = test_dir; return; %page; get_config_size: proc (); /* * This procedure sets n_cards and max_cards appropriately, by examining * the information in the config_deck segment. */ dcl idx fixed bin; dcl linkage_error condition; config_max_cards = divide (4096 - 1, size (config_card), 17, 0); on linkage_error begin; call hphcs_$syserr (CRASH, "^a: The config_deck segment is missing.", ME); call hphcs_$call_bce; end; configp = addr (config_deck$); /* Make addressable */ revert linkage_error; try_config_again: if config_deck.cards (1).word = ZERO_CARD_WORD then do; /* It's empty already */ call hphcs_$syserr (CRASH, "^a: The config deck is empty.", ME); call hphcs_$call_bce; go to try_config_again; /* perhaps fixed up in bce */ end; do idx = 1 to config_max_cards; /* Otherwise, look for the first free card */ if config_deck.cards (idx).word = FREE_CARD_WORD then goto FOUND_FREE_CARD; end; FOUND_FREE_CARD: config_n_cards = idx - 1; /* Last card used is one before the free one */ return; /* All done */ end get_config_size; %page; call_out: procedure (system_control_entrypoint); declare system_control_entrypoint character (*); call call_outer_ring_ (codeptr (system_startup_), "system_control_", system_control_entrypoint, (/* ring */ 4), code); call hphcs_$syserr_error_code (CRASH, code, "^a: Could not call out to system_control_$^a.", ME, system_control_entrypoint); call hphcs_$call_bce; end call_out; %page; log_configuration: proc; /* log the config deck */ dcl GROUP_SIZE fixed bin (17) init (16) static options (constant); dcl cards_in_group fixed bin; /* 16, or the (smaller) remainder of cards in the deck */ dcl card_index fixed bin; /* which config card */ dcl n_groups fixed bin; /* number of chunk calls required */ dcl 1 card_group (cards_in_group) like config_card aligned based (addr (config_deck.cards (card_index))); n_groups = divide (config_n_cards + GROUP_SIZE - 1, GROUP_SIZE, 17, 0); do card_index = 1 to config_n_cards by GROUP_SIZE; cards_in_group = min (config_n_cards - card_index + 1, GROUP_SIZE); call hphcs_$syserr_binary (LOG, addr (card_group), SB_config_deck, currentsize (card_group), "Config deck, part ^d of ^d", divide (card_index, GROUP_SIZE, 17, 0) + 1, n_groups); call timer_manager_$sleep (1000, "10"b); /* goof off for 1ms and let hproc run */ end; end log_configuration; %page; salvage_dirs: procedure; declare dir_path char (168); declare starx fixed bin; declare hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35)); call hcs_$star_ (">", "*", star_BRANCHES_ONLY, get_system_free_area_ (), star_entry_count, star_entry_ptr, star_names_ptr, code); /* Dont bother with foo.** */ if code ^= 0 then do; call com_err_ (code, ME, "Could not list the root."); return; end; do starx = 1 to star_entry_count; if star_entries (starx).type = star_DIRECTORY then do; dir_path = ">" || star_names (star_entries (starx).nindex); if dir_path ^= ">system_library_1" & dir_path ^= ">process_dir_dir" then do; call salvage_dir (dir_path); call ensure_quota$$first_pass (dir_path); end; end; end; call ensure_quota (">system_control_dir"); call ensure_quota (">"); return; end salvage_dirs; %page; salvage_dir: procedure (dir_pathname); declare dir_pathname character (*); declare a_time fixed bin (71); declare s_temps (2) ptr; declare salv_message char (2000) varying; call get_temp_segments_ (ME, s_temps, code); local_salv_args.temp1_ptr = s_temps (1); local_salv_args.temp2_ptr = s_temps (2); a_time = clock (); local_salv_args.salv_time = substr (unspec (a_time), 21, 36); local_salv_args.options = ""b; local_salv_args.correct_oosw, local_salv_args.delete_connection_failure = "1"b; local_salv_args.check_vtoce = mountedp (dir_pathname, ""); /* Gross, but effective */ local_salv_args.branch_ptr = null (); local_salv_args.current_length = 0; local_salv_args.pathname = dir_pathname; salv_message = ""; call ioa_ ("Salvaging ^a.", dir_pathname); call hphcs_$salv_directory (addr (local_salv_args), salv_message, null (), (0), code); call com_err_$suppress_name (code, ME, "^[Salvager reported^/^a.^]", salv_message ^= "", salv_message); call release_temp_segments_ (ME, s_temps, code); return; end salvage_dir; %page; ensure_quota: procedure (dir_pathname); declare dir_pathname char (*); declare first_pass bit (1) aligned; dcl hphcs_$correct_qused entry (char (*), fixed bin (34), fixed bin (34), fixed bin (34), fixed bin (34), bit (1) aligned, fixed bin (35)); declare hphcs_$quota_set external entry (char (*), fixed bin (18), fixed bin (35)); declare (old_seg_used, old_dir_used, new_seg_used, new_dir_used) fixed bin (34); declare did_something bit (1) aligned; declare code fixed bin (35); declare Qalloc fixed bin (18); declare trp fixed bin (71); declare tup bit (36) aligned; declare terminal_sw fixed bin (1); declare Qused fixed bin (18); declare sons_lvid bit (36); first_pass = "0"b; go to Common; ensure_quota$$first_pass: entry (dir_pathname); first_pass = "1"b; Common: call hphcs_$correct_qused (dir_pathname, old_seg_used, old_dir_used, new_seg_used, new_dir_used, did_something, code); if did_something then do; if code ^= 0 then call com_err_ (code, ME, "While fixing quota for ^a.", dir_pathname); if old_seg_used ^= new_seg_used then call ioa_ ("^a: Segment quota used changed from ^d to ^d.", dir_pathname, old_seg_used, new_seg_used); if old_dir_used ^= new_dir_used then call ioa_ ("^a: Directory quota used changed from ^d to ^d.", dir_pathname, old_dir_used, new_dir_used); end; else call com_err_ (code, ME, "Warning: Could not validate/correct quota on ^a.", dir_pathname); if first_pass then return; call hcs_$quota_read (dir_pathname, Qalloc, trp, tup, sons_lvid, terminal_sw, Qused, code); if code ^= 0 then do; call com_err_ (code, ME, "Could not read quota for ^a.", dir_pathname); return; end; if terminal_sw = 0 then return; /* parent has been bothered */ if (Qalloc - Qused) > 1000 then return; call hphcs_$quota_set (dir_pathname, Qused + 1000, code); if code ^= 0 then call com_err_ (code, ME, "Could not set quota for ^a, which has only ^d record available.", dir_pathname, Qalloc - Qused); else call ioa_ ("^a: Forcing quota for ^a from ^d to ^d. Run a quota salvage.", ME, dir_pathname, Qalloc, Qalloc + 1000); return; end ensure_quota; %page; mountedp: procedure (dir, entryname) returns (bit (1) aligned); declare (dir, entryname) char (*); declare 1 sb aligned like status_branch; declare hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); declare hcs_$lv_attached entry (bit (36) aligned) returns (fixed bin (35)); call hcs_$status_long (dir, entryname, (0), addr (sb), null (), code); if code ^= 0 then return ("0"b); return (hcs_$lv_attached ((sb.lvid)) = 0); end mountedp; /* format: off */ %page; %include config_intk_card; %page; %include config_deck; %page; %include static_handlers; %page; %include iox_entries; %page; %include iox_modes; %page; %include mc; %page; %include salv_args; %page; %include star_structures; %page; %include status_structures; %page; %include syserr_binary_def; %page; %include syserr_fault_msg; %page; %include syserr_constants; %page; %include pvt; /* BEGIN MESSAGE DOCUMENTATION Message: Command: S: $info T: $init M: The Initializer types this message whenever it is waiting for a ring 1 command. A: Type the desired command. The normal command to type when bringing the system up is startup. Message: Multics SYSID: DATE TIME S: $info T: $init M: This is the first message that will be typed when the system is started up. It indicates that the Initializer process is ready to go. The system ID on the tape is SYSID. A: Check the date and time to ensure both are correct. If the clock reading is wrong, shut down and correct the clock. Message: system_startup_: XYZ is not a legal command. Type help for a list of commands. S: $info T: $init M: The operator has issued a command to the ring 1 environment that cannot be executed. No action was taken on the illegal command. A: If the command is misspelled, retype it correctly. If the command is intended for the ring 4 Answering Service, type "standard" first to leave the ring 1 environment and then retype the desired command. Message: system_startup_: unclaimed COND .br (machine conditions in octal) S: $beep T: $init M: Some error condition has occurred unexpectedly inside the ring 1 environment. Diagnostic information is typed after this line. The system should return to Initializer command level, still in ring 1, and be able to continue running. A: $inform Message: system_startup_: The root logical volume is not complete. "boot rlvs" level 2 directory salvage aborted. S: $info T: $init M: One or more physical volumes of the Root Logical Volume (RLV) registered in the volume registration database are not specified on the root config card, and are therefore not mounted. Level 2 directory salvage cannot take place with an incomplete RLV. A: Mount the missing packs with the add_vol command, and then use the salvage_dirs command. Message: system_startup_: Will not reload S: $info T: Response to operator reload command. M: One or more volumes cannot be mounted. Reloading cannot proceed. The system returns to ring 1 command level. A: Correct the problem and try again. Message: system_startup_: The config_deck segment is missing. S: $crash T: $init M: $crashes The segment config_deck is missing. This error should not occur, because earlier steps in initialization depend upon the config deck. A: $recover Use another boot tape, or check that the hardware is operating correctly. Message: system_startup_: The config deck is empty. S: $crash T: $init M: $crashes The system will return to bce. This error should not occur, because earlier steps in initialization depend upon the config deck. If it does, however, type GO after putting a config deck in place. A: $recover Use another boot tape, or check that the hardware is operating correctly. Message: system_startup_: error on initializer io streams S: $crash T: $init M: $crashes The system will return to bce. A: $recover Try another boot tape and check that the hardware is running correctly. Message: system_startup_: Recursive error condition. S: $crash T: $init M: $crashes The system will return to bce. A: $recover Boot another system, and examine the dump. Message: system_startup_: unclaimed {condition-name} condition. S: $beep T: $init M: An error has occurred while executing in the ring 1 Initializer environment. The system returns to ring 1 command level. For some errors machine conditions are displayed in subsequent messages. A: $inform Message: system_startup_ Renamed >XXXXX to >XXXXX.!BBB..... S: $info T: $init M: The segment >disk_table or the directory >lv (as specified by XXXXX in the message) was renamed in response to the "nodt" or "nolv" option on the bce "boot" command line. A: $ignore END MESSAGE DOCUMENTATION */ end system_startup_; 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