



		    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
