



		    io_chnl_util.pl1                11/11/89  1140.2rew 11/11/89  0802.4       25497



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




/****^  HISTORY COMMENTS:
  1) change(85-11-27,Fawcett), approve(85-11-27,MCR6979),
     audit(85-12-11,CLJones), install(86-03-21,MR12.0-1033):
     Change support of 127 channels to 63, dipper support
                                                   END HISTORY COMMENTS */


/* format: style4,delnl,insnl,indattr,ifthen,dclind10 */
io_chnl_util:
     procedure;

/* Convert I/O channel names to old CONFIG card format */
/* Written by C. Hornig, March 1981. */
/* Fixed to work in wired environment, 10 July, 1981, W. Olin Sibert */
/* Canonicalize entry added by Chris Jones, January 1984 */

dcl	Iom		   fixed bin (3) parameter;
dcl	Channel		   fixed bin (7) parameter;
dcl	Name		   char (8) aligned parameter;
dcl	Code		   fixed bin (35) parameter;

dcl	digit		   fixed bin;
dcl	value		   fixed bin;

dcl	MAX_CHANNEL_NUMBER	   fixed bin static options (constant) init (63);

dcl	(character, index, length, ltrim, rtrim, substr, translate)
			   builtin;

io_chnl_util$canonicalize_chanid:
     entry (Name) returns (char (8) aligned);

	return (translate (Name, "ABCD", "abcd"));

io_chnl_util$iom_to_name:
     entry (Iom, Channel, Name, Code);

	Name = "";
	Code = 0;

	if (Iom < 1) | (Iom > 4) | (Channel < 0) | (Channel > MAX_CHANNEL_NUMBER) then do;
	     Code = 1;
	     return;
	end;

	Name = substr ("ABCD", Iom, 1) || ltrim (character (Channel));
	return;


io_chnl_util$name_to_iom:
     entry (Name, Iom, Channel, Code);

	Code, Iom, Channel = 0;

	Iom = index ("ABCD", translate (substr (Name, 1, 1), "ABCD", "abcd"));
	if Iom < 1 then
	     goto bad_name;

	if length (rtrim (Name)) < 2 then
	     goto bad_name;

/* This conversion must be done inline because there is no wired procedure
   for converting from character strings to binary, and this code is wired.
*/

	do digit = 2 to length (rtrim (Name));
	     value = index ("0123456789", substr (Name, digit, 1));
	     if value = 0 then
		goto bad_name;
	     Channel = 10 * Channel + (value - 1);
	end;

	if Channel > MAX_CHANNEL_NUMBER then
	     goto bad_name;

	return;

bad_name:
	Iom, Channel = 0;
	Code = 1;					/* An error */
	return;

     end io_chnl_util;




		    io_error.pl1                    11/11/89  1140.2r w 11/11/89  0802.5       14796



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


io_error:
     procedure;

/* Report errors for ALM I/O management. */
/* Written January 1981 by C. Hornig */

dcl  syserr entry options (variable);

bad_addr:
     entry;

	call syserr (1, "io_error: Illegal address value in call to io_manager.");
	return;

bad_chx:
     entry;

	call syserr (1, "io_error: Invalid channel index in call to io_manager.");

	return;

/* BEGIN MESSAGE DOCUMENTATION


   Message:
   io_error: Illegal address value in call to io_manager.

   S: $crash

   T: $run

   M: An address that was not in the required part of memory or was not
   aligned properly was passed in a call to io_manager.
   $err

   A: $recover
   $contact


   Message:
   io_error: Invalid channel index in call to io_manager.

   S: $crash

   T: $run

   M: A channel index which did not correspond to an assigned logical channel
   was passed to io_manager.
   $err

   A: $recover
   $contact

   END MESSAGE DOCUMENTATION */


     end io_error;




		    io_log_status_info.cds          11/11/89  1140.2rew 11/11/89  0802.5      104040



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



/* HISTORY COMMENTS:
  1) change(85-09-09,Farley), approve(85-09-09,MCR6979),
     audit(85-12-02,CLJones), install(86-03-21,MR12.0-1033):
     Support FIPS by
     changing tape 02/04 tp not log detail.
                                                   END HISTORY COMMENTS */

/* IO_LOG_STATUS_INFO - Database for determining what i/O status should be logged */
/* Based, generally, on ELAN PFS */
/* Written December 1979 by Larry Johnson */
/* Modified June 1983 by Rick Kovalcik to add hyperchannel */
/*
   Modifed October 1983 by Paul Farley to add "blank tape on write" to tape
   detail section.
   Modified FEB 1985 by Paul Farley to change tape 02/04 tp not log detail.
*/

io_log_status_info: proc;

/* Automatic */

dcl  cur_major fixed bin;
dcl  code fixed bin (35);
dcl 1 cds like cds_args automatic;

dcl 1 dummy_struct aligned,
    2 io_log_status_info fixed bin init (0);

/* Constants */

dcl  name char (18) int static options (constant) init ("io_log_status_info");

/* External */

dcl  com_err_ entry options (variable);
dcl  get_temp_segment_ entry (char (*), pointer, fixed bin (35));
dcl  release_temp_segment_ entry (char (*), pointer, fixed bin (35));
dcl  create_data_segment_ entry (ptr, fixed bin (35));

dcl  cleanup condition;


dcl (addr, bin, bit, currentsize, length, null, string, substr, verify) builtin;


	io_log_infop = null ();
	on cleanup call clean_up;

	call get_temp_segment_ (name, io_log_infop, code);
	if code ^= 0 then do;
	     call com_err_ (code, name, "Unable to get temp segment.");
	     return;
	end;

	call build_data;

/* Now create the data segment */

	cds.p (1) = io_log_infop;
	cds.len (1) = currentsize (io_log_info);
	cds.struct_name (1) = "dummy_struct";
	cds.p (2) = null;
	cds.len (2) = 0;
	cds.struct_name (2) = "";
	cds.seg_name = name;
	cds.num_exclude_names = 0;
	cds.exclude_array_ptr = null ();
	string (cds.switches) = "0"b;
	cds.have_text = "1"b;
	call create_data_segment_ (addr (cds), code);
	if code ^= 0 then call com_err_ (name, code);

done:	call clean_up;
	return;

build_data: proc;

/* Disk */

	     call set_device ("dsk");

	     call set_major (0000b);			/* Ready */
	     call log_detail ("000001");		/* 1 retry */
	     call log_detail ("000010");		/* 2 retries */
	     call log_detail ("000011");		/* 3 retries */
	     call log_detail ("010000");		/* EDAC correction */

	     call set_major (0001b);			/* Channel ready */

	     call set_major (0010b);			/* Attention */
	     call log_detail ("001000");		/* Dev inop */
	     call log_detail ("001101");		/* CA EN1 error */
	     call log_detail ("00001X");		/* Seek incomplete */
	     call log_detail ("001110");		/* CA alert */
	     call log_detail ("010000");		/* Device in standby */

	     call set_major (0011b);			/* Data alert */
	     call log_detail ("000010");		/* Transmission parity */
	     call log_detail ("000100");		/* Invalid seek address */
	     call log_detail ("0X1000");		/* Header verification error */
	     call log_detail ("X1X000");		/* Check character alert */
	     call log_detail ("1X0000");		/* Compare alert */

	     call set_major (0100b);			/* End of file */

	     call set_major (0101b);			/* Command reject */

	     call set_major (1010b);			/* Mpc device attention */
	     call log_detail ("001011");		/* CA unexpected interrupt */

	     call set_major (1011b);			/* Mpc device data alert */
	     call log_detail ("001110");		/* Edac parity */
	     call log_detail ("000010");		/* Inconsistent command */
	     call log_detail ("010011");		/* Search alert */
	     call log_detail ("000011");		/* Sumcheck error */
	     call log_detail ("010100");		/* Cyc code not 1 st */
	     call log_detail ("001001");		/* Error correction rquired */
	     call log_detail ("010110");		/* Sync byte not hex 19 */
	     call log_detail ("001010");		/* Edac error uncorrectable */
	     call log_detail ("010111");		/* Error, alt track */
	     call log_detail ("010001");		/* Sector size error */
	     call log_detail ("011001");		/* Edac correction (last ) */
	     call log_detail ("010010");		/* Non-std secotr size */
	     call log_detail ("011010");		/* Edac correction (last ) */

	     call set_major (1101b);			/* Mpc command reject */

/* Tape */

	     call set_device ("tap");

	     call set_major (0000b);			/* Ready */
	     call log_status ("001100");		/* Code alert */

	     call set_major (0010b);			/* Attention */
	     call log_status ("0XX10X");		/* Handler in standby */
	     call log_detail ("0X1X0X");		/* Dev fault */
	     call log_detail ("01XX00");		/* Blank tape on write */

	     call set_major (0011b);			/* Device data alert */
	     call log_detail ("XXXX11");		/* Bit detected on erase */
	     call log_detail ("XX1XXX");		/* Lateral parity alert */
	     call log_detail ("X1XXXX");		/* Longitudinal parity alert */
	     call log_detail ("001000");		/* Frame drop */

	     call set_major (0100b);			/* End of file */
	     call suppress_log ("001111");		/* Eof - 7trk */
	     call suppress_log ("010011");		/* Eof - 9trk */
	     call log_detail ("111111");		/* Data alert */

	     call set_major (1010b);			/* Mpc device attention */
	     call log_detail ("0011XX");		/* TCA malfunction */
	     call log_detail ("010000");		/* Device malfunction */

	     call set_major (1011b);			/* Mpc datra alert */
	     call log_detail ("001000");		/* Pe burst error */
	     call log_detail ("001001");		/* Preamble error */
	     call log_detail ("010000");		/* Multi track error */
	     call log_detail ("010001");		/* Skew error */
	     call log_detail ("010010");		/* Postamble error */
	     call log_detail ("010011");		/* Nrzi ccc err */
	     call log_detail ("100000");		/* Marginal condition */

/* Printer */

	     call set_device ("prt");

	     call set_major (0010b);			/* Attention */
	     call log_detail ("000000");		/* Power fault */
	     call log_detail ("XXXX1X");		/* Stopped */
	     call log_detail ("XXX1XX");		/* VFU/VFC alert */
	     call log_detail ("XX1XXX");		/* Check alert */

	     call set_major (0011b);			/* Data alert */
	     call log_detail ("000000");		/* Image buffer alert */
	     call log_detail ("0XX01X");		/* Alert before printing start */
	     call log_detail ("XXX10X");		/* Alert after printing started */
	     call log_detail ("XX1XXX");		/* Warning */
	     call log_detail ("X1XXXX");		/* Motion alert */

	     call set_major (0101b);			/* Command reject */
	     call suppress_log ("100000");		/* Top page echo */

/* Reader */

	     call set_device ("rdr");

	     call set_major (0010b);			/* Attention */
	     call log_detail ("000000");		/* Off line */
	     call log_detail ("XX1XXX");		/* Feed alert */
	     call log_detail ("X1XXXX");		/* Jam */
	     call log_detail ("1X0XXX");		/* Read alert */

	     call set_major (0011b);			/* Data alert */
	     call log_detail ("000X10");		/* Validaty alert */
	     call log_detail ("0001X0");		/* Dual read */

/* Punch */

	     call set_device ("pun");
	     call set_major (0010b);			/* Attention */
	     call log_detail ("000000");		/* Off line */
	     call log_detail ("0X1XXX");		/* Feed alert */
	     call log_detail ("X1XXXX");		/* Jam */

	   	call set_device ("hch");		/* hyperchannel */

		call set_major (0001b);		/* Busy */
		call set_major (0011b);		/* Data Alert */
		call set_major (0100b);		/* EOF */
		call set_major (0101b);		/* Interstruction Reject */
		call suppress_log ("100000");		/* 40 - in use ? */
		call set_major (1011b);		/* Adapter Alert */
		call suppress_log ("001000");		/* 10 - timeout */

	     return;

	end build_data;

set_device: proc (arg_device);

dcl  arg_device char (*);

dcl  i fixed bin;

	     if length (arg_device) ^= 3 then do;
		call com_err_ (0, name, "Invalid device name: ^a", arg_device);
		go to done;
	     end;
	     do i = 1 to io_log_info.ndev;
		logp = addr (io_log_info.log_entry (i));
		if log.dev_name = arg_device then do;
		     call com_err_ (0, name, "Duplicated device name: ^a", arg_device);
		     go to done;
		end;
	     end;

	     io_log_info.ndev = io_log_info.ndev + 1;
	     logp = addr (io_log_info.log_entry (io_log_info.ndev));
	     log.dev_name = arg_device;
	     log.status (*, *) = "1"b;		/* Log all status */
	     log.status (0, *) = "0"b;		/* Except ready */
	     log.detail (*, *) = "0"b;

	     return;

	end set_device;


set_major: proc (arg_major);

dcl  arg_major fixed bin;

	     if arg_major < 0 | arg_major > 15 then do;
		call com_err_ (0, name, "Invalid major status level: ^d", arg_major);
		go to done;
	     end;
	     cur_major = arg_major;

	     return;

	end set_major;

suppress_log: proc (arg_status);

dcl  arg_status char (*);

	     call off (arg_status, log.status);

	     return;

	end suppress_log;

log_detail: proc (arg_status);

dcl  arg_status char (*);

	     call on (arg_status, log.detail);
	     call on (arg_status, log.status);

	     return;

	end log_detail;


log_status: proc (arg_status);

dcl  arg_status char (6);

	     call on (arg_status, log.status);

	     return;

	end log_status;

/* Routines that minipulate the tables */

on:	proc (arg_status, arg_table);

dcl  arg_status char (*);
dcl  arg_table (*, *) bit (1) unal;

	     call set (arg_status, arg_table, "1"b);
	     return;

	end on;

off:	proc (arg_status, arg_table);

dcl  arg_status char (*);
dcl  arg_table (*, *) bit (1) unal;

	     call set (arg_status, arg_table, "0"b);
	     return;

	end off;

set:	proc (arg_status, arg_table, arg_state);

dcl  arg_status char (*);
dcl  arg_table (*, *) bit (1) unal;
dcl  arg_state bit (1);

dcl (i, j, k) fixed bin;
dcl  x_count fixed bin;
dcl  basic_mask bit (6);
dcl  work_mask bit (6);
dcl  n_x_states fixed bin;
dcl  x_bits bit (6);

	     if length (arg_status) ^= 6 then do;
bad_status:	call com_err_ (0, name, "Invalid status mask: ^a", arg_status);
		go to done;
	     end;
	     if verify (arg_status, "01X") ^= 0 then go to bad_status;

	     basic_mask = "0"b;
	     x_count = 0;
	     do i = 1 to 6;
		if substr (arg_status, i, 1) = "1" then
		     substr (basic_mask, i, 1) = "1"b;
		else if substr (arg_status, i, 1) = "X" then
		     x_count = x_count + 1;
	     end;

	     if x_count = 0 then do;			/* Easy case */
		arg_table (cur_major, bin (basic_mask)) = arg_state;
		return;
	     end;

	     n_x_states = 2 ** x_count;
	     do i = 1 to n_x_states;
		work_mask = basic_mask;
		x_bits = bit (bin (i - 1, 6), 6);
		k = 7 - x_count;
		do j = 1 to 6;
		     if substr (arg_status, j, 1) = "X" then do;
			substr (work_mask, j, 1) = substr (x_bits, k, 1);
			k = k + 1;
		     end;
		end;
		arg_table (cur_major, bin (work_mask)) = arg_state;
	     end;

	     return;

	end set;

clean_up:	proc;

	     if io_log_infop ^= null () then call release_temp_segment_ (name, io_log_infop, code);
	     return;

	end clean_up;

%include io_log_status_info;

%include cds_args;

     end io_log_status_info;





		    ioi_masked.pl1                  11/11/89  1140.2r w 11/11/89  0800.0      323262



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1983 *
        *                                                         *
        *********************************************************** */

/* format: style4,delnl,insnl,indattr,ifthen,dclind10 */

ioi_masked:
     procedure;

/* This program contains all of IOI that must be run while wired and masked. */
/* Finished March 1983 by Chris Jones, from what Charlie Hornig left me. */
/* Changed once or twice since then by Chris Jones */
/* Changed December 1983 by Chris Jones to handle timeout on device which cannot be identified by dental records */
/* Modified 27 February 1984 by Chris Jones to initialize idp in reset_device. */
/* Modified August 1984 by Chris Jones to ensure dtep is initialized from all paths to getwork_channel_proc */
/* Modified 1984-08-10 BIM for direct channel support */
/* Modified Nov. 2 1984 By Paul Farley to correct a bug where dtep was not
   getting initialized. Also to only get detailed status if the command
   opcode is ^= "0"b. */
/* Modified 121784 by Paul Farley to only call ioi_wire$unwire if the
   workspace_astep is non-null. */
/* Modified February 1985 by Chris Jones to add $online_device_count */
/* Modified 042585 by Paul Farley to put last bad status (and detailed status)
   in the dte for priv attachments, but still not log the error. */
/* Modified July 1985 by Paul Farley to reset dte.detailed_status before
   processing current status. */

/****^  HISTORY COMMENTS:
  1) change(85-06-24,Farley), approve(86-03-08,MCR6979),
     audit(86-03-07,CLJones), install(86-03-21,MR12.0-1033):
     Changed the mask_channel proc to have iom_connect set the PGE & ^PTP
     flags in the second word of the PCW for the execution of the reset-status
     IDCW, after doing the MASK.  This will cause an IOM system-fault if the
     channel tries to do a data-transfer.
  2) change(85-09-09,Farley), approve(85-09-09,MCR6979),
     audit(86-03-07,CLJones), install(86-03-21,MR12.0-1033):
     Support FIPS and IMU.
  3) change(85-11-06,Farley), approve(86-04-01,MCR7332),
     audit(86-04-02,Fawcett), install(86-04-07,MR12.0-1036):
     Changed mask_channel to leave channel masked if it times out on the first
     unmask connect.
  4) change(86-03-04,CLJones), approve(86-07-30,MCR7461),
     audit(86-07-31,Coren), install(86-08-19,MR12.0-1120):
     Always zero unused fields in auto_istat and message; don't call
     io_manager$get_status for direct channels, but do deliver status for
     direct channels.
  5) change(86-09-17,Farley), approve(86-07-18,MCR7439),
     audit(86-10-08,Fawcett), install(86-10-20,MR12.0-1189):
     Changed to execute in the BCE environment.
  6) change(86-11-17,Farley), approve(86-11-20,MECR0002),
     audit(86-11-19,Fawcett), install(86-11-20,MR12.0-1222):
     Changed timer code to not operate on unassigned devices (dte.process_id =
     ""b).
  7) change(86-12-19,Farley), approve(86-12-19,MCR7587),
     audit(86-12-19,Fawcett), install(87-01-05,MR12.0-1253):
     Formal installation to close out above MECR0002.
                                                   END HISTORY COMMENTS */

dcl	p_ctep		   ptr parameter;		/* (I) pointer to a channel table entry */
dcl	p_dtep		   ptr parameter;		/* (I) pointer to a device table entry */
dcl	p_cterp		   fixed bin (35) parameter;	/* (I) offset of the channel table entry on interrupts */
dcl	p_level		   fixed bin (3) parameter;	/* (I) interrupt level */
dcl	p_status		   bit (36) aligned parameter;/* (I) word of fault status or special status */
dcl	p_subsystem_name	   char (*) parameter;	/* (I) name of subsystem we're interested in */

dcl	1 auto_istat	   like istat aligned;
dcl	broadcast		   bit (1) aligned;
dcl	count		   fixed bin;
dcl	done		   bit (1) aligned;
dcl	ctx		   fixed bin;
dcl	dtx		   fixed bin;
dcl	gtx		   fixed bin;
dcl	1 ima		   aligned like io_manager_arg;
dcl	level		   fixed bin (3);
dcl	message		   fixed bin (71);
dcl	status		   bit (36) aligned;
dcl	1 status_entry	   aligned like io_status_entry;
dcl	wm_mask		   fixed bin (71);
dcl	wm_ptwp		   ptr;

dcl	ioi_abs_seg$	   external;
dcl	pds$process_id	   bit (36) aligned external static;
dcl	sys_info$service_system
			   bit (1) aligned external static;

dcl	absadr		   entry (ptr, fixed bin (35)) returns (fixed bin (26));
dcl	bce_ioi_post	   entry (fixed bin (71), fixed bin (71));
dcl	ioi_wire$unwire	   entry (ptr);
dcl	pmut$swap_sdw	   entry (ptr, ptr);
dcl	pmut$unwire_unmask	   entry (fixed bin (71), ptr);
dcl	pmut$wire_and_mask	   entry (fixed bin (71), ptr);
dcl	pxss$io_wakeup	   entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
dcl	pxss$notify	   entry (bit (36) aligned);
dcl	syserr		   entry options (variable);
dcl	syserr$binary	   entry options (variable);

dcl	FIFTEEN_SECONDS	   fixed bin (71) static options (constant) init (15000000);
dcl	MAX_LOG_STATUS_COUNT   fixed bin (17) static options (constant) init (63);
dcl	ME		   char (32) static options (constant) init ("ioi_masked");
dcl	ONE_MINUTE	   fixed bin (71) static options (constant) init (60000000);

dcl	(addr, addrel, bin, bit, clock, hbound, lbound, length, null, ptr, rel, size, stac, stacq, string, substr,
	unspec)		   builtin;

/**** getwork_device ****/

/* This entry finds an available an unconnected channel for a given device.  If no channels are available, the
   count of pending connects in the group table entry is incremented.  If a channel is found, it is connected.
   This entry can be called while unmasked.  It masks and unmasks itself. */

getwork_device:
     entry (p_dtep);

	dtep = p_dtep;
	idp = addr (ioi_data$);
	gtep = ptr (idp, dte.gtep);

	call mask;				/* mask interrupts */
	call lock_gte;

	gte.pending_connects = gte.pending_connects + 1;

	if dte.direct & dte.active			/* we can always send another */
	then do;
	     ctep = ptr (idp, dte.cur_ctep);
	     call connect;
	     gte.pending_connects = gte.pending_connects - 1;
	     call unlock_gte;
	     call unmask;
	     return;
	end;

	/*** Here is its indirect or not pre-bound. */

	dte.active = "1"b;

	if ^dte.suspended then
	     do ctep = ptr (idp, gte.ctep) repeat ptr (idp, cte.next_ctep) while (rel (ctep));
	     if cte.ioi_use & ^cte.deleting & ^cte.deleted & ^cte.connected & ^cte.quiescing
		& (dte.channel_required = "" | (dte.channel_required = cte.chanid)) then do;
						/* found a channel we can use */
		call connect;
		gte.pending_connects = gte.pending_connects - 1;
		call unlock_gte;
		call unmask;
		return;
	     end;
	end;

	call unlock_gte;
	call unmask;
	return;

/**** getwork_channel ****/
/* This entry is analogous to getwork_device, but looks for work for a channel to do. */

getwork_channel:
     entry (p_ctep);

	ctep = p_ctep;
	idp = addr (ioi_data$);
	gtep = ptr (idp, cte.gtep);

	call mask;				/* mask interrupts */
	call lock_gte;
	dtep = null ();
	call getwork_channel_proc;
	call unlock_gte;
	call unmask;
	return;

/**** reset_device ****/

reset_device:
     entry (p_dtep);

	idp = addr (ioi_data$);
	dtep = p_dtep;
	gtep = ptr (dtep, dte.gtep);
	call mask;
	call lock_gte;
	if dte.connected then do;
	     ctep = ptr (dtep, dte.cur_ctep);
	     call mask_channel;
	end;
	else if dte.active then do;
	     gte.pending_connects = gte.pending_connects - 1;
	     dte.active = "0"b;
	end;
	call unlock_gte;
	call unmask;
	return;

/**** timer ****/

/* This entry is called by pxss.  It checks running channels to see if they've been running too long.  If so, it masks
   them and restarts them on new I/Os.  It also checks to see if workspaces should be unwired. */

timer:
     entry;

	idp = addr (ioi_data$);
	if ^ioi_data.setup then
	     return;
	do ctx = 1 to ioi_data.nct;
	     ctep = addr (ioi_data.ct (ctx));
	     gtep = ptr (idp, cte.gtep);
	     call lock_gte;
	     if cte.ioi_use & ^cte.direct then
		if cte.connected & (cte.time_limit ^= 0) & (clock () > cte.time_limit) then do;
		     if cte.cur_dtep = ""b then do;
			dtep = null ();
			call syserr (ANNOUNCE, "^a$timer: Timeout on channel ^a (no device).", ME, cte.chanid);
		     end;
		     else do;
			dtep = ptr (ctep, cte.cur_dtep);
			call syserr (ANNOUNCE, "^a$timer: Timeout on channel ^a (device ^a^[_^[0^]^d^]).", ME,
			     cte.chanid, gte.name, gte.mplex, bin (dte.device) < 10, bin (dte.device));
		     end;
		     call mask_channel;		/* stop the channel from touching memory any more */
		     call setup_timeout_status;	/* for delivery to the user */
		     call getwork_channel_proc;
		     call deliver_status;
		     if dtep ^= null () then
			call wakeup_user;
		end;
	     call unlock_gte;
	end;
	do dtx = 1 to ioi_data.ndt;
	     dtep = addr (ioi_data.dt (dtx));
	     if dte.in_use & ^dte.direct & dte.process_id ^= ""b then do;
						/* if IOI is managing this device and it is assigned... */
		gtep = ptr (dtep, dte.gtep);
		call lock_gte;
		if clock () > dte.last_log_time + ONE_MINUTE then
		     call flush_status_proc;
		call unlock_gte;

/**** Lock the device by hand.  If we fail, don't even think about unwiring. ****/
		if stac (addr (dte.lock.pid), pds$process_id) then do;
		     if ^dte.active & dte.workspace_wired & (clock () > dte.unwire_time) then do;
			if dte.workspace_astep ^= null () then
			     call ioi_wire$unwire (dtep);
			else do;
			     call syserr (ANNOUNCE,
				"^a$timer: Attempt to unwire NULL workspace. (device ^a^[_^[0^]^d^]).", ME,
				gte.name, gte.mplex, bin (dte.device) < 10, bin (dte.device));
			     dte.workspace_wired = "0"b;
			end;
		     end;

/**** This code is stolen from lock$unlock_fast.  If idle procs get block_lock_counts, it could be removed. ****/


		     do while (^stacq (dte.lock.pid, "000000000000"b3, pds$process_id));
		     end;

		     if dte.lock.notify_sw then do;
			dte.lock.notify_sw = "0"b;
			call pxss$notify (dte.lock.event);
		     end;

		end;
	     end;
	end;
	return;

/**** interrupt ****/
/* This is the interrupt handler for all IOI controlled devices.  It handles waking up the user, logging errors,
   reconnecting channels which have terminated, and in general, does the right things. */

interrupt:
     entry (p_cterp, p_level, p_status);

	idp = addr (ioi_data$);
	ctep = ptr (idp, p_cterp);			/* point to cte of interrupting channel */
	gtep = ptr (idp, cte.gtep);			/* and its gte */
	level = p_level;
	status = p_status;

	if level = IO_SPECIAL_INTERRUPT_LEVEL then do;	/* special status, not necessarily in response to I/O */
	     io_special_status_ptr = addr (status);	/* base the proper structure */
	     imp = addr (message);			/* build the message for any wakeups we send */
	     string (imess) = ""b;
	     imess.st = "1"b;
	     imess.level = bit (level, 3);
	     imess.status = status;

	     broadcast =				/* tell everyone on this group if... */
		^io_special_status.t | ^gte.mplex	/* it's invalid (?) or not multiplexed */
		| (substr (io_special_status.byte2, 1, 1) & (io_special_status.device = "00"b3));
						/* or it's a controller interrupt */
	     do gtx = 1 to ioi_data.ngt;
		gtep = addr (ioi_data.gt (gtx));
		if special_could_come_from_channel (gtep, ctep) then do;
		     begin;

dcl	done		   bit (1) aligned;

			call lock_gte;
			done = "0"b;		/* so loop will loop */
			do dtep = ptr (idp, gte.dtep) repeat ptr (idp, dte.next_dtep) while (^done);
			     if (dte.process_id ^= ""b) & (broadcast | (dte.device = io_special_status.device))
			     then do;
				dte.special_status = status;
				dte.special_interrupt = "1"b;
				call wakeup_user;
			     end;
			     done = (dte.next_dtep = gte.dtep);
			end;
			call unlock_gte;
		     end;
		end;
	     end;
	end;
	else do;					/* system fault, terminate, or marker */
	     call lock_gte;
	     if cte.direct then
		unspec (status_entry) = ""b;
	     else call io_manager$get_status (cte.chx, addr (status_entry));
	     if cte.toss_status | (cte.cur_dtep = ""b) then do;
		cte.toss_status = "0"b;		/* ignore this interrupt */
		cte.connected = "0"b;
		dtep = null ();
		call getwork_channel_proc;
		call unlock_gte;
		goto DISMISS_INTERRUPT;
	     end;

	     dtep = ptr (idp, cte.cur_dtep);		/* let's talk about the correct device */
	     if ^dte.active then do;
		call syserr (CRASH,
		     "^a$interrupt: Interrupt for inactive device (device ^a^[_^[0^]^d^]).^/Type go to continue.", ME,
		     gte.name, gte.mplex, bin (dte.device) < 10, bin (dte.device));
		call unbind;
		call getwork_channel_proc;
		call unlock_gte;
		goto DISMISS_INTERRUPT;
	     end;
	     if dte.reading_detailed_status then
		call restore_previous_status;		/* leave the "reading" flag set for log_status later */

	     if level = IO_SYSTEM_FAULT_INTERRUPT_LEVEL then
		call setup_fault_status;
	     else do;				/* normal status */
		if ^dte.direct then do;		/* for direct channels, expect no status and trust level number */
		     if ^status_entry.t then do;
			ioi_data.spurious_interrupts = ioi_data.spurious_interrupts + 1;
			call unlock_gte;
			goto DISMISS_INTERRUPT;
		     end;
		     if ^status_entry.word1.marker then
			level = IO_TERMINATE_INTERRUPT_LEVEL;
		end;
		call setup_normal_status;
	     end;

	     call log_status_if_appropriate;
	     if dte.reading_detailed_status then do;
		call unlock_gte;
		goto DISMISS_INTERRUPT;		/* we'll pick this up later */
	     end;

	     if ^auto_istat.run then do;		/* channel terminated, get more work */
		call unbind;
		call getwork_channel_proc;
	     end;
	     else if dte.timeout ^= 0 then
		cte.time_limit = clock () + dte.timeout;/* restart the clock */

	     call deliver_status;
	     call wakeup_user;
	     call unlock_gte;
	end;

	goto DISMISS_INTERRUPT;
DISMISS_INTERRUPT:
	return;

/* Entry to set a channel up for quiescing.  If the channel is not currently connected, this call is a no-op.
   If the channel is connected, the quiescing bit is turned on.  It's up to interrupt side to notice and turn it off. */

quiesce_channel:
     entry (p_ctep);

	ctep = p_ctep;
	gtep = ptr (ctep, cte.gtep);
	call mask;
	call lock_gte;

	if cte.connected then
	     cte.quiescing = "1"b;

	call unlock_gte;
	call unmask;
	return;

/* Entry to flush any status accumulated so far. */

flush_status:
     entry (p_dtep);

	dtep = p_dtep;
	gtep = ptr (dtep, dte.gtep);
	call mask;
	call lock_gte;
	call flush_status_proc;
	call unlock_gte;
	call unmask;
	return;

/* Entry to count the number of non-deleted devices on a given subsystem.  It doesn't count controllers
   and returns -1 if it can't find the subsystem. */

online_device_count:
     entry (p_subsystem_name) returns (fixed bin);

	idp = addr (ioi_data$);
	do gtx = lbound (ioi_data.gt, 1) to hbound (ioi_data.gt, 1);
	     gtep = addr (ioi_data.gt (gtx));
	     if gte.name = p_subsystem_name then do;
		done = "0"b;
		count = 0;
		call mask;
		call lock_gte;
		do dtep = ptr (gtep, gte.dtep) repeat ptr (dtep, dte.next_dtep) while (^done);
		     if ^dte.deleted & dte.device ^= "00"b3 then
			count = count + 1;
		     done = dte.next_dtep = gte.dtep;
		end;
		call unlock_gte;
		call unmask;
		return (count);
	     end;
	end;
	return (-1);

/* Procedure which issues a connect for the device pointed to by dtep on the channel pointed to by ctep. */

connect:
     proc;

	ima.chx = cte.chx;
	ima.bound = dte.bound;
	ima.ptp = dte.ptp;
	ima.listx = dte.listx;
	ima.pcw = dte.pcw;
	cte.time_limit = 0;				/* in case polling goes off */

	if ^gte.psia then do;
	     if cte.direct then
		call io_manager$connect_direct (ima);
	     else call io_manager$connect (ima);
	end;
	else do;
	     ima.listp, ima.dcw_pair_ptr = addr (dte.idcw);
	     call io_manager$workspace_tdcw (ima);
	     call io_manager$connect_abs (ima);
	end;

	cte.cur_dtep = rel (dtep);
	dte.cur_ctep = rel (ctep);
	cte.connected, dte.connected = "1"b;
	if dte.timeout ^= 0 then
	     cte.time_limit = clock () + dte.timeout;

	pcwp = addr (dte.pcw);
	if pcw.mask then do;			/* if this PCW masked the channel... */
	     call mask_channel;
	     call setup_timeout_status;
	     call deliver_status;
	     call wakeup_user;
	end;

     end connect;

/* Procedure which finds work for a channel do. */

getwork_channel_proc:
     proc;

	if cte.quiescing then do;
	     cte.quiescing = "0"b;
	     return;
	end;

	if cte.deleting then do;			/* someone wants to know when this channel is free */
	     call pxss$notify (unspec (IO_CHANNEL_LOCK_TEMPLATE) || rel (ctep));
	     return;
	end;
	if cte.connected | ^cte.ioi_use | gte.suspend_devices then
	     return;				/* this channel shouldn't be used */

	gte.dtep = ptr (gtep, gte.dtep) -> dte.next_dtep; /* rotate circular list */
	if gte.pending_connects > 0 then do;
	     begin;

dcl	done		   bit (1) aligned;
dcl	saved_dtep	   ptr;

		done = "0"b;
		saved_dtep = dtep;
		do dtep = ptr (gtep, gte.dtep) repeat ptr (dtep, dte.next_dtep) while (^done);
		     if dte.active & ^dte.connected & ^dte.suspended then do;
			gte.pending_connects = gte.pending_connects - 1;
			call connect;
			done = "1"b;
		     end;
		     else done = dte.next_dtep = gte.dtep;
		end;
		dtep = saved_dtep;
	     end;
	end;

     end getwork_channel_proc;

/* Procedure to stop the current activity on a channel. */

mask_channel:
     proc;

	call io_manager$get_status (cte.chx, addr (status_entry));
	if dtep ^= null () then
	     call unbind;
	call io_manager$mask (cte.chx);
	if ^gte.mplex then do;
	     if dtep ^= null () then
		if dte.direct then
		     call ioi_wire$unwire (dtep);	/* unwire this instant */
	     return;				/* we don't have to unmask if channel not shared */
	end;

/* The dtep will be null if this is the second time through the code for
   this channel. The first time through a call is made to "unbind" which
   sets cte.cur_dtep to zero. The second time through the timer entry it
   will set dtep to null because cte.cur_dtep is zero. */

	if dtep = null () then do;			/* we've already tried to unmask */
	     cte.connected = "0"b;			/* free channel */
	     cte.toss_status = "0"b;
	     call syserr (ANNOUNCE, "^a: Channel ^a not responding, will remain masked.", ME, cte.chanid);
	     return;
	end;

	ima.chx = cte.chx;

/* Set pcw to a unique string that iom_connect will recognize. iom_connect
   will use the default pcw, but turn ON the PGE and turn OFF the PTP flags
   in the second word of the pcw. This will cause a system-fault if the
   channel trys to do a data transfer. */

	ima.pcw = "000000777777"b3;			/* set unique string */
	ima.ptp = null ();
	ima.listp = addr (ioi_data.rss_idcw);
	call io_manager$connect_abs (ima);
	cte.time_limit = cte.time_limit + ONE_MINUTE;
	cte.toss_status = "1"b;
	cte.connected = "1"b;

     end mask_channel;

/* Procedure to remove the binding between a channel and a device. */

unbind:
     proc;

	cte.cur_dtep, dte.cur_ctep = ""b;
	cte.connected, dte.connected, dte.active = ""b;
	dte.unwire_time = clock () + FIFTEEN_SECONDS;

     end unbind;

/* This routine saves away parts of the status so we can read detailed status using the same IDCW, status entry, etc.
   It's restored when we've read the detailed status. */

save_status:
     proc;

	cte.saved_status.word1 = unspec (status_entry.word1);
	cte.saved_status.word2 = unspec (status_entry.word2);
	cte.saved_status.word4 = unspec (status_entry.word4);
	cte.saved_status.next_lpw_offset = bit (bin (auto_istat.offset + 1, 18), 18);
	cte.saved_status.command = addr (dte.idcw) -> idcw.command;

     end save_status;

/* The following routine is called when we have had to read the detailed status.  It restores the saved status
   (i.e. the status that caused us to decide to read the detailed status). */

restore_previous_status:
     proc;

	level = IO_TERMINATE_INTERRUPT_LEVEL;
	unspec (status_entry.word1) = cte.saved_status.word1;
	unspec (status_entry.word2) = cte.saved_status.word2;
	unspec (status_entry.word4) = cte.saved_status.word4;
	status_entry.next_lpw_offset = cte.saved_status.next_lpw_offset;
	addr (dte.idcw) -> idcw.command = cte.saved_status.command;
	status_entry.workspace = "1"b;

     end restore_previous_status;

/* Procedures to setup the auto_istat entry on our stack for delivery to the user. */

setup_normal_status:
     proc;

	unspec (auto_istat) = ""b;
	auto_istat.er = ((unspec (status_entry.word1) & IO_STATUS_ERROR_MASK) ^= ""b);
	auto_istat.iom_stat = unspec (status_entry.word1) || unspec (status_entry.word4);
	goto setup_status_interrupt_join;

setup_fault_status:
     entry;

	unspec (auto_istat) = ""b;
	auto_istat.er = "1"b;
	auto_istat.iom_stat = status;

setup_status_interrupt_join:
	auto_istat.run = (level = IO_MARKER_INTERRUPT_LEVEL) | cte.direct;
	auto_istat.time_out = "0"b;
	auto_istat.level = level;
	goto setup_status_common;

setup_timeout_status:
     entry;

	unspec (auto_istat) = ""b;
	auto_istat.er, auto_istat.time_out = "1"b;
	auto_istat.level = IO_TERMINATE_INTERRUPT_LEVEL;	/* since the $'#((&% T&Ds expect this... */

setup_status_common:
	if ^cte.direct then do;			/* no dcws here */
	     if status_entry.workspace then
		auto_istat.offset = bin (status_entry.next_lpw_offset, 18) - 1;
	     else if dtep ^= null () then
		auto_istat.offset = dte.idcw_listx;
	     auto_istat.lpw = unspec (status_entry.word2);
	end;
	auto_istat.absaddr = 0;

	imp = addr (message);			/* set up the message for wakeups */
	unspec (imess) = ""b;
	imess.completion = auto_istat.completion;
	imess.st = "1"b;				/* be sure this bit is on (it's set separately in istat) */
	imess.level = bit (auto_istat.level, 3);
	imess.offset = bit (auto_istat.offset, 18);
	imess.status = substr (auto_istat.iom_stat, 1, length (imess.status));
						/* only the first 36 bits, actually */

     end setup_normal_status;

/* Routine to put the status in the user's workspace. */

deliver_status:
     proc;

dcl	ioi_abs_seg_ptr	   ptr;
dcl	workspace_sdw_ptr	   ptr;

	if dtep = null () then
	     return;
	if dte.status_entries = 0 then
	     return;

	ioi_abs_seg_ptr = addr (ioi_abs_seg$);
	workspace_sdw_ptr = addr (dte.workspace_sdw);
	call pmut$swap_sdw (ioi_abs_seg_ptr, workspace_sdw_ptr);
						/* since we may not own the workspace, get our own pointer */
	ptr (ioi_abs_seg_ptr, dte.status_offset + size (istat) * dte.status_entry_idx) -> istat = auto_istat;
	ptr (ioi_abs_seg_ptr, dte.status_offset + size (istat) * dte.status_entry_idx) -> istat.st = "1"b;
	dte.status_entry_idx = dte.status_entry_idx + 1;
	if dte.status_entry_idx = dte.status_entries then
	     dte.status_entry_idx = 0;

     end deliver_status;

/* Routine to send the user a wakeup, informing of the arrival of status */

wakeup_user:
     proc;

	if sys_info$service_system then
	     call pxss$io_wakeup (dte.process_id, dte.ev_chn, message, (0));
	else call bce_ioi_post (dte.ev_chn, message);

     end wakeup_user;

/* A routine which lives up to its name. */

log_status_if_appropriate:
     proc;

dcl	log_detail	   bit (1) aligned;
dcl	major		   fixed bin (4);
dcl	sub		   fixed bin (6);

dcl	detailed_status_in_status_entry
			   bit (36) aligned based (addr (status_entry.detailed_status));
dcl	status_entry_array	   (16) bit (36) aligned based (addr (status_entry));
dcl	1 second_status_word   aligned like io_status_entry.word4 based (addrel (addr (auto_istat.iom_stat), 1));

/**** First, figure out whether it's appropriate.  (If not, our job is easy). ****/

	if dte.reading_detailed_status then do;		/* we already decided to log this, so do it */
	     dte.detailed_status_valid = "1"b;
	     call log_this_status;
	     dte.reading_detailed_status = "0"b;
	     return;
	end;

	unspec (dte.detailed_status (*)) = ""b;		/* reset */

	if level = IO_SPECIAL_INTERRUPT_LEVEL then
	     return;				/* don't log specials */
	if level ^= IO_SYSTEM_FAULT_INTERRUPT_LEVEL then do;
						/* we're going to log any system faults, check the rest */
	     if gte.io_log_info_index = 0 then do;	/* if no table, use heuristic */
		if ^auto_istat.er then
		     return;			/* not an error, don't log */
		log_detail = "0"b;
	     end;
	     else do;				/* we have a table to guide us on which statuses to log */
		io_log_infop = addr (io_log_status_info$io_log_status_info);
		logp = addr (io_log_info.log_entry (gte.io_log_info_index));
		major = bin (status_entry.major);
		sub = bin (status_entry.sub);
		if ^log.status (major, sub) then
		     return;			/* no one is interested in this status */
		log_detail = log.detail (major, sub);
	     end;
	end;
	else log_detail = "0"b;			/* no detailed status for system faults */

	if dte.priv then do;			/* save status in dte for priv attachments, but don't log */
	     unspec (dte.log_status) = ""b;		/* clear everything */
	     dte.log_status_cnt = "0"b;
	     dte.log_status.level = auto_istat.level;
	     dte.log_status.time_out = auto_istat.time_out;
	     dte.log_status.type = second_status_word.action_code;
	     dte.log_status.command = addr (dte.idcw) -> idcw.command;
	     dte.log_status.channel = rel (ctep);
	     dte.log_status.status = substr (auto_istat.iom_stat, 1, length (dte.log_status.status));
						/* takes only high 36 bits */
	     if log_detail & detailed_status_in_status_entry ^= "000000000000"b3 then do;
		dte.detailed_status = status_entry.detailed_status;
		dte.detailed_status_valid = "1"b;
	     end;
	     dte.log_detailed_status = dte.detailed_status;
	     dte.last_log_time = clock ();
	     return;
	end;

/**** If we've gotten this far, we want to log the status.  The log_detail flag says whether we want to log detailed
      status as well.  If we do, we may have to perform some magic at this point to reconnect to read the detailed
      status (if the detailed status was stored as part of the status store, we're in better shape). ****/

	if log_detail & detailed_status_in_status_entry ^= "000000000000"b3 then do;
	     dte.detailed_status = status_entry.detailed_status;
	     dte.detailed_status_valid = "1"b;
	     call log_this_status;
	     return;
	end;

	if log_detail then do;			/* must get the detailed status */
	     if gte.detailed_status_cmd = "0"b then do;	/* Not able to get it, complain that it was not available. */
		call syserr (LOG,
		     "^a: No Ext. Stat. with ^o/^o status on chnl ^a (^a^[_^[0^]^d^]).^4(^/^10x^w ^w ^w ^w^)", ME,
		     major, sub, cte.chanid, gte.name, gte.mplex, bin (dte.device) < 10, bin (dte.device),
		     status_entry_array);
		call log_this_status;
		return;
	     end;
	     call save_status;

/* Now build dcw list to read detailed status */

	     dte.idcw, dte.tdcw = "0"b;
	     idcwp = addr (dte.idcw);
	     dcwp = addr (dte.tdcw);
	     idcw.command = gte.detailed_status_cmd;	/* Read detailed status */
	     idcw.device = dte.device;
	     idcw.code = "111"b;
	     idcw.count = "01"b3;

	     dcw.address = absaddr_18 (addr (dte.detailed_status));
	     dcw.tally = "0006"b3;

	     dte.detailed_status_valid = "0"b;
	     unspec (dte.detailed_status) = "0"b;

/* connect to do actual I/O */

	     ima.chx = cte.chx;
	     ima.pcw = ""b;
	     ima.ptp = null ();
	     ima.listp = addr (dte.idcw);
	     call io_manager$connect_abs (ima);
	     if dte.timeout ^= 0 then			/* reset clock */
		cte.time_limit = clock () + dte.timeout;
	     dte.reading_detailed_status = "1"b;
	     return;
	end;

	call log_this_status;
	return;

absaddr_18:
	proc (p) returns (bit (18));

dcl	p		   ptr;

dcl	absaddr		   fixed bin (26);
dcl	code		   fixed bin (35);

	     absaddr = absadr (p, code);
	     if code ^= 0 then
		call syserr (CRASH, "^a$interrupt: absadr failed.", ME);
	     return (bit (bin (absaddr, 18), 18));

	end absaddr_18;

log_this_status:
	proc;

/**** Here is where the status is actually logged.  Status is accumulated, and if it is identical to the previous
      status, a count is bumped.  If the count reaches its max, or a different status comes along, the accumulated
      status is written to the syserr log. ****/

dcl	1 test_status	   like dte.log_status;

	     unspec (test_status) = ""b;		/* clear everything */
	     test_status.level = auto_istat.level;
	     test_status.time_out = auto_istat.time_out;
	     test_status.channel = rel (ctep);
	     test_status.status = substr (auto_istat.iom_stat, 1, length (test_status.status));
						/* takes only high 36 bits */
	     if auto_istat.level ^= IO_SPECIAL_INTERRUPT_LEVEL then do;
		test_status.type = second_status_word.action_code;
		test_status.command = addr (dte.idcw) -> idcw.command;
	     end;
	     test_status.count = dte.log_status.count;	/* for equality comparision */
/**** See if this status matches a previous one. ****/
	     if (dte.log_status_cnt & (unspec (test_status) = unspec (dte.log_status))
		& (unspec (dte.detailed_status) = unspec (dte.log_detailed_status))) then do;
						/* it matches */
		dte.log_status.count = dte.log_status.count + 1;
		if dte.log_status.count = MAX_LOG_STATUS_COUNT then
		     call flush_status_proc;
	     end;
	     else do;				/* doesn't match */
		call flush_status_proc;
		dte.log_status = test_status;
		dte.log_status.count = 0;		/* print_syserr_msg_ expects actual count - 1 */
		dte.log_status_cnt = "1"b;
		dte.log_detailed_status = dte.detailed_status;
	     end;

	end log_this_status;

     end log_status_if_appropriate;

/* Routine to flush the status accumulated so far. */

flush_status_proc:
     proc;

dcl	1 auto_io_msg	   aligned like io_msg;
dcl	msg_length	   fixed bin;
dcl	msg_type		   fixed bin;

	if ^dte.log_status_cnt then
	     return;				/* nothing to log */

	io_msgp = addr (auto_io_msg);
	io_msg.level = bit (dte.log_status.level);
	io_msg.device = dte.device;
	io_msg.time_out = dte.log_status.time_out;
	io_msg.type = dte.log_status.type;
	io_msg.command = dte.log_status.command;
	io_msg.count = bit (dte.log_status.count);
	io_msg.channel = ptr (dtep, dte.log_status.channel) -> cte.chanid;
	io_msg.status = dte.log_status.status;
	io_msg.devname = ptr (dtep, dte.gtep) -> gte.name;
	if unspec (dte.log_detailed_status) ^= ""b then do;
	     io_msg.detailed_status = substr (unspec (dte.log_detailed_status), 1, length (io_msg.detailed_status));
	     msg_type = SB_io_err_detail;
	     msg_length = SBL_io_err_detail;
	end;
	else do;
	     msg_type = SB_io_err;
	     msg_length = SBL_io_err;
	end;

	call syserr$binary (JUST_LOG, io_msgp, msg_type, msg_length, "^a$interrupt: ^[I/O error^;Special^].", ME,
	     bin (io_msg.level) ^= IO_SPECIAL_INTERRUPT_LEVEL);
	dte.last_log_time = clock ();
	dte.log_status_cnt = "0"b;

     end flush_status_proc;

special_could_come_from_channel:
     proc (gtp, ctp) returns (bit (1) aligned);

dcl	ctp		   ptr parameter;
dcl	gtp		   ptr parameter;

dcl	tctp		   ptr;

	do tctp = ptr (gtp, gtp -> gte.ctep) repeat ptr (tctp, tctp -> cte.next_ctep) while (rel (tctp) ^= ""b);
	     if tctp -> cte.base_ctep = ctp -> cte.base_ctep then
		return ("1"b);
	end;
	return ("0"b);

     end special_could_come_from_channel;

/* Routines which handle the masking and unmasking of interrupts, and the locking and unlocking of the gte. */

mask:
     proc;

	call pmut$wire_and_mask (wm_mask, wm_ptwp);

     end mask;

unmask:
     proc;

	call pmut$unwire_unmask (wm_mask, wm_ptwp);

     end unmask;

lock_gte:
     proc;

	if gte.lock = pds$process_id then
	     call syserr (CRASH, "^a: Mylock error on subsystem ^a.", ME, gte.name);

	do while (^stac (addr (gte.lock), pds$process_id));
						/* seize the loop lock */
	end;

     end lock_gte;

unlock_gte:
     proc;

	if ^stacq (gte.lock, ""b, pds$process_id) then
	     call syserr (CRASH, "^a: Lock for subsystem ^a not locked to process ^w.", ME, gte.name, pds$process_id);

     end unlock_gte;

%include ioi_data;
%page;
%include io_manager_dcls;
%page;
%include interrupt_levels;
%page;
%include ioi_stat;
%page;
%include io_status_entry;
%page;
%include io_special_status;
%page;
%include io_log_status_info;
%page;
%include iom_pcw;
%include iom_dcw;
%page;
%include io_syserr_msg;
%page;
%include syserr_binary_def;
%page;
%include syserr_constants;
%page;
/*	BEGIN MESSAGE DOCUMENTATION


   Message:
   ioi_masked$interrupt: I/O error.

   S:	$log

   T:	$run

   M:	An error, or accumulation of like errors, has occured.  All
   needed information is contained in the binary portion of the entry.

   A:	$ignore

   Message:
   ioi_masked$interrupt: Interrupt for inactive device (device DEVID).
   Type go to continue.

   S:	$crash

   T:	$run

   M:	An interrupt has been received over a channel for which the
   device is not marked "active".  This could indicate an error in the I/O
   hardware or in the setting/checking of the device active flag.

   A:	Typing "go" at BCE will cause Multics to be reentered and
   ioi_masked to dismiss this error and properly cleanup.

   Message:
   ioi_masked$interrupt: Special.

   S:	$log

   T:	$run

   M:	A special interrupt, or accumulation of special interrupts, has
   occured.  All needed information is contained in the binary portion of the
   entry.

   A:	$ignore

   Message:
   ioi_masked$interrupt: absadr failed.

   S:	$crash

   T:	$run

   M:	A call to the absadr function returned a non-zero error code,
   indicating that the absolute address of the workspace could not be obtained.
   Since the workspace is wired, this error should never have occurred.

   A:	$inform
   $recover

   Message:
   ioi_masked$timer: Attempt to unwire NULL workspace. (device DEVID).

   S:	$info

   T:	$run

   M:	Device entry flag and time stamp indicated that its workspace
   required unwiring.  However the pointer to the ASTE for the workspace was
   null.
   $err

   A:	$inform
   $recover

   Message:
   ioi_masked: Channel CHANID not responding, will remain masked.

   S:	$info

   T:	$run

   M:	The time limit has expired waiting for status from a previous
   unmask connect (reset-status idcw). It is apparent that the channel is
   inoperative. No further attempt will be made to re-open the channel.

   A:	Contact your Customer Service Account Representative if the
   errors persist.

   Message:
   ioi_masked$timer: Timeout on channel CHANID (device DEVID).

   S:	$info

   T:	$run

   M:	The time limit has expired waiting for status from CHANID for a
   previous connect.  The channel will be masked "OFF", then unmasked if
   multiple devices exist (i.e. tapes and disks) so that special interrupts
   can be received.

   A:	Contact your Customer Service Account Representative if the
   errors persist.

   Message:
   ioi_masked$timer: Timeout on channel CHANID (no device).

   S:	$info

   T:	$run

   M:	The time limit has expired waiting for status from CHANID for
   the connect to unmask the channel.  The channel will be masked "OFF", then
   then unmask will be tried again.

   A:	Contact your Customer Service Account Representative if the
   errors persist.

   Message:
   ioi_masked: Lock for subsystem SUBSYSTEM not locked to process OOOOOO.

   S:	$crash

   T:	$run

   M:	An unlock of the subsystem lock was attempted, but is was not
   locked by this process.
   $err

   A:	$inform
   $recover

   Message:
   ioi_masked: Mylock error on subsystem SUBSYSTEM.

   S:	$crash

   T:	$run

   M:	An lock of the subsystem lock was attempted, but is was already
   locked by this process.
   $err

   A:	$inform
   $recover

   Message:
   ioi_masked: No Ext. Stat. with MAJOR/SUB status on chnl CHANID (DEVID).

   S:	$log

   T:	$run

   M:	An error status has occured that requires detailed status.  This
   CHANID should have supplied this with the status, but did not.  This
   CHANID is also not capable of requesting the detailed status.  An octal
   dump of the status_entry area will be displayed along with the error
   message.

   A:	$ignore

   END MESSAGE DOCUMENTATION */

     end ioi_masked;




		    ioi_page_table.pl1              11/11/89  1140.2rew 11/11/89  0802.5      119070



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1983 *
        *                                                         *
        *********************************************************** */

/* format: style4,delnl,insnl,indattr,ifthen,dclind10 */

ioi_page_table:
     proc;

/* I/O page table manipulation */
/* Written April 1983 by Chris Jones for IOI rewrite */
/* Modified 1984-10 by Chris Jones to correctly handle big page tables */
/* Modified 1984-10-25 BIM to wire additional pages. */


/****^  HISTORY COMMENTS:
  1) change(86-09-05,Farley), approve(86-07-18,MCR7439),
     audit(86-09-24,Fawcett), install(86-10-20,MR12.0-1189):
     Changed to execute in the BCE environment.
  2) change(88-04-28,GDixon), approve(88-08-08,MCR7964),
     audit(88-08-01,Lippard), install(88-08-16,MR12.2-1085):
      A) Correct error in function $ptx_to_ptp which caused a return
         statement with no argument to be executed. (hardcore 856, phx19472)
                                                   END HISTORY COMMENTS */


/* This program manages the io_page_table_seg.  Said segment consists of a 256 word header followed by 252 page tables of
   64 words each (i.e. each such page table can describe a segment which is up to 64 pages long).  Page tables are
   constrained by hardware to start on a 0 mod 64 word boundary.  If it is necessary to describe a segment larger than 64
   pages, four consecutive page tables are combined to become a 256 word page table (enough for any conceivable
   application).  Although hardware will allow such a page table to reside on a 0 mod 64 word boundary, we enforce a 0
   mod 256 word boundary to free us from complications of page tables crossing page boundaries.  The page table segment
   is constrained to be no larger than 16 pages, it is abs_wired, and is initialized to be one page long (It grows as
   necessary). Except at BCE it is only 1 fixed page.

   Entries are provided to get a page table of a certain size, to put it back when done, and to fill it in to describe a
   given segment.  Getting and putting are done under a lock, filling is not. */

dcl	p_astep		   ptr parameter;		/* (I) pointer to the ASTE of a seg for which we fill a pt */
dcl	p_code		   fixed bin (35) parameter;	/* (O) status code */
dcl	p_ptx		   fixed bin parameter;	/* (I/O) pointer to a page table */
dcl	p_size		   fixed bin (19) parameter;	/* (I) size of segment page table is to describe */

dcl	code		   fixed bin (35);
dcl	locked		   bit (1) aligned;
dcl	not_at_BCE	   bit (1) aligned;
dcl	page		   fixed bin;
dcl	ptp		   ptr;
dcl	ptx		   fixed bin;
dcl	size		   fixed bin (19);

dcl	list_head		   fixed bin (9) unsigned unaligned based (free_listp);
dcl	free_listp	   ptr;

dcl	get_ptrs_$given_segno  entry (fixed bin (15), ptr);
dcl	lock$lock_fast	   entry (ptr);
dcl	lock$unlock_fast	   entry (ptr);
dcl	pc_abs$wire_abs	   entry (ptr, fixed bin (9), fixed bin (9), fixed bin (35));
dcl	syserr		   entry options (variable);

dcl	error_table_$bad_index fixed bin (35) ext static;
dcl	error_table_$no_io_page_tables
			   fixed bin (35) ext static;
dcl	sst$astsize	   fixed bin external static;
dcl	sys_info$initialization_state
			   fixed bin external static;

dcl	(addr, addrel, bin, hbound, lbound, min, mod, null, ptr, segno, unspec)
			   builtin;

dcl	ME		   char (32) static init ("ioi_page_table");

get:
     entry (p_size, p_ptx, p_code);

	size = p_size;
	p_code = 0;
	call setup;
	call lock_pts;				/* lock the I/O page table segment to us */
RETRY_GET:
	if size > SMALL_PT_SIZE then
	     ptx = io_page_tables.free_256_ptx;
	else ptx = io_page_tables.free_64_ptx;
	if ptx = 0 then do;
	     call grow_seg (code);
	     call quit_if_error;
	     goto RETRY_GET;
	end;

	call remove_pt (ptx);
	call unlock_pts;
	p_ptx = ptx;
	return;

put:
     entry (p_ptx, p_code);

	ptx = p_ptx;
	p_code = 0;
	call setup;
	if ^verify_ptx() then
	     call quit (error_table_$bad_index);
	call lock_pts;
	call return_pt (ptx);
	call unlock_pts;
	return;

/**** Entry to return a pointer to a page table given its ptx ****/

ptx_to_ptp:
     entry (p_ptx) returns (ptr);

	ptx = p_ptx;
	call setup;
	if ^verify_ptx() then
	     return (null);
	else return (ptr (io_page_table_seg_ptr, 64 * (ptx - 1)));

/**** Entry to fill in a page table given an astep   We fill in the smaller of the max size of the page table or
      the segment.  It is possible for a workspace to be larger than the amount which is wired, but IOI will restrict
      references to the workspace to the wired portion at connect time.  Obviously this entry should be called with the
      segment already wired or the page table we fill in will be useless in a short while. ****/

fill:
     entry (p_ptx, p_astep, p_code);

	ptx = p_ptx;
	astep = p_astep;
	p_code = 0;
	call setup;
	if ^verify_ptx() then
	     call quit (error_table_$bad_index);
	ioptp = addrel (io_page_table_seg_ptr, (ptx - 1) * 64);
	if io_page_tables.pt_info (ptx).size = PT_64_SIZE then
	     io_page_table_size = 64;
	else io_page_table_size = 256;
	unspec (page_table) = ""b;			/* turns off all valid bits */
	ptp = addrel (astep, sst$astsize);		/* point to the page table just past the ASTE */
	do page = 0 to min (io_page_table_size, bin (aste.csl)) - 1;
	     if addrel (ptp, page) -> l68_core_ptw.wired then do;
		page_table (page).address = addrel (ptp, page) -> l68_core_ptw.frame;
		page_table (page).write, page_table (page).valid = "1"b;
	     end;
	end;
	return;

/* Entry to initialize the data base. */

init:
     entry;

	call setup;
	if not_at_BCE then do;
	     call get_ptrs_$given_segno (segno (io_page_table_seg_ptr), astep);
	     call pc_abs$wire_abs (astep, 0, 1, code);	/* wire the first page. */
	     if code ^= 0 then
		call syserr (CRASH, "^a: Unable to wire first page of io_page_table_seg.", ME);
	end;

	unspec (io_page_tables) = ""b;		/* start with a clean slate */
	io_page_tables.lock.event = unspec (IO_PAGE_TABLE_LOCK_EVENT);
	io_page_tables.n_pages_wired = 1;		/* the header says we have only one page (we hope!) */
	do ptx = lbound (io_page_tables.pt_info, 1) to PTS_PER_PAGE;
	     io_page_tables.pt_info (ptx).size = PT_64_SIZE;
	     io_page_tables.pt_info (ptx).in_use = "1"b;	/* so we can free it */
	     call return_pt (ptx);
	end;
	return;

remove_pt:
     proc (ptx);

dcl	ptx		   fixed bin parameter;

	if io_page_tables.pt_info (ptx).in_use then
	     call syserr (CRASH, "^a: I/O page table on free list marked as in use.", ME);
	if io_page_tables.pt_info (ptx).size = PT_64_SIZE then
	     free_listp = addr (io_page_tables.free_64_ptx);
	else free_listp = addr (io_page_tables.free_256_ptx);
	io_page_tables.pt_info (ptx).in_use = "1"b;
	list_head = io_page_tables.pt_info (ptx).next_pt;

     end remove_pt;

return_pt:
     proc (ptx);

dcl	ptx		   fixed bin parameter;

	if ^io_page_tables.pt_info (ptx).in_use then
	     call syserr (CRASH, "^a: I/O page table to be freed marked as not in use.", ME);
	if io_page_tables.pt_info (ptx).size = PT_64_SIZE then
	     free_listp = addr (io_page_tables.free_64_ptx);
	else free_listp = addr (io_page_tables.free_256_ptx);
	io_page_tables.pt_info (ptx).in_use = "0"b;
	io_page_tables.pt_info (ptx).next_pt = list_head;
	list_head = ptx;

     end return_pt;

/* Routine to grow the segment if needed.  If the maximum number of pages are not wired, another one is wired.  Then the
   new page is carved into identical page tables.  If there are no 64 word page tables left, the new page becomes 64 word
   page tables.  If there are 64 word page tables available, the new page becomes 256 word page tables.  If there are
   neither, 64 word page tables are created.  If this was the wrong thing to do, we will be called again, and at that
   time we'll create 256 word page tables.

   If the segment is at its max size and there are no 64 word page tables available, a 256 word page table is divided
   into 4 64 word page tables.  If there are 64 word page tables available but no 256 word page tables, we try to combine
   a group of 4 64 word page tables into one 256 word page table.  If all of this fails, we give up and return an error,
   which is passed back to our caller.  Processes which are sufficiently annoyed at this behavior on our part, and which
   are sufficiently privileged, may crash the system at that time. */

grow_seg:
     proc (code);

dcl	code		   fixed bin (35) parameter;

dcl	astep		   ptr;
dcl	ptx		   fixed bin;

	code = 0;
	if io_page_tables.n_pages_wired < MAX_IO_PAGE_TABLE_SEG_PAGES & not_at_BCE then do;
	     call get_ptrs_$given_segno (segno (io_page_table_seg_ptr), astep);
	     call pc_abs$wire_abs (astep, (io_page_tables.n_pages_wired), 1, code);
	     if code ^= 0 then
		return;

	     if io_page_tables.free_64_ptx = 0 then do;
		do ptx = PTS_PER_PAGE * io_page_tables.n_pages_wired + 1
		     to PTS_PER_PAGE * io_page_tables.n_pages_wired + PTS_PER_PAGE;
		     io_page_tables.pt_info (ptx).size = PT_64_SIZE;
		     io_page_tables.pt_info (ptx).in_use = "1"b;
						/* so return will work */
		     call return_pt (ptx);
		end;
	     end;
	     else do;
		do ptx = PTS_PER_PAGE * io_page_tables.n_pages_wired + 1
		     to PTS_PER_PAGE * io_page_tables.n_pages_wired + PTS_PER_PAGE;
		     io_page_tables.pt_info (ptx).size = PT_256_SIZE;
		     io_page_tables.pt_info (ptx).in_use = "1"b;
		     if mod (ptx, 4) = 1 then		/* only return every 4th pt */
			call return_pt (ptx);
		end;
	     end;

	     io_page_tables.n_pages_wired = io_page_tables.n_pages_wired + 1;
	end;
	else do;					/* hard part, must shuffle pt's */
	     if (io_page_tables.free_64_ptx = 0) & (io_page_tables.free_256_ptx = 0) then do;
		call syserr (LOG, "^a: Out of I/O page table memory.", ME);
		code = error_table_$no_io_page_tables;
		return;
	     end;
	     if io_page_tables.free_64_ptx = 0 then do;	/* not too hard, split a 256 page table */
		ptx = io_page_tables.free_256_ptx;
		call remove_pt (ptx);
		do ptx = ptx to ptx + 3;
		     io_page_tables.pt_info (ptx).size = PT_64_SIZE;
		     call return_pt (ptx);
		end;
	     end;
	     else do;				/* harder, must find four consecutive free pt's */
		do ptx = io_page_tables.free_64_ptx repeat io_page_tables.pt_info (ptx).next_pt while (ptx ^= 0);
		     if mod (ptx, 4) = 1 then do;	/* could be a candidate */
			if ^io_page_tables.pt_info (ptx).in_use & ^io_page_tables.pt_info (ptx + 1).in_use
			     & ^io_page_tables.pt_info (ptx + 2).in_use & ^io_page_tables.pt_info (ptx + 3).in_use
			then do;			/* found a group, make it into a 256 word table */
			     io_page_tables.pt_info.size (ptx), io_page_tables.pt_info.size (ptx + 1),
				io_page_tables.pt_info.size (ptx + 2), io_page_tables.pt_info.size (ptx + 3) =
				PT_256_SIZE;
			     io_page_tables.pt_info (ptx).in_use, io_page_tables.pt_info.in_use (ptx + 1),
				io_page_tables.pt_info.in_use (ptx + 2), io_page_tables.pt_info.in_use (ptx + 3) =
				"1"b;
			     call return_pt (ptx);	/* put it on the 256 word list */
			     io_page_tables.free_64_ptx = 0;
						/* we're going to put them all back in now */
			     do ptx = lbound (io_page_tables.pt_info, 1)
				to io_page_tables.n_pages_wired * PTS_PER_PAGE;
				if (io_page_tables.pt_info (ptx).size = PT_64_SIZE)
				     & ^io_page_tables.pt_info (ptx).in_use then do;
				     io_page_tables.pt_info (ptx).in_use = "1"b;
				     call return_pt (ptx);
				end;
			     end;
			     return;
			end;
		     end;
		end;
		code = error_table_$no_io_page_tables;
	     end;
	end;

     end grow_seg;

lock_pts:
     proc;

	if not_at_BCE then
	     call lock$lock_fast (addr (io_page_tables.lock));
	locked = "1"b;

     end lock_pts;

unlock_pts:
     proc;

	if not_at_BCE then
	     call lock$unlock_fast (addr (io_page_tables.lock));
	locked = "0"b;

     end unlock_pts;

setup:
     proc;
dcl	bce_io_page_table$	   external;

	locked = "0"b;				/* initialize */
	if sys_info$initialization_state > 1 then do;	/* out of collection 1 processing */
	     io_page_table_seg_ptr = addr (io_page_table_seg$);
	     not_at_BCE = "1"b;
	end;
	else do;					/* at BCE */
	     io_page_table_seg_ptr = addr (bce_io_page_table$);
	     not_at_BCE = "0"b;
	end;

     end setup;

verify_ptx:
     proc returns (bit(1) aligned);

	if (ptx < lbound (io_page_tables.pt_info, 1)) | (ptx > hbound (io_page_tables.pt_info, 1)) then
	     return ("0"b);
	else return ("1"b);

     end verify_ptx;

quit_if_error:
     proc;

	if code ^= 0 then
	     call quit (code);

     end quit_if_error;

quit:
     proc (code);

dcl	code		   fixed bin (35) parameter;

	if locked then
	     call unlock_pts;
	p_code = code;
	goto RETURN;

     end quit;

RETURN:
	return;

%include hc_fast_lock;
%include io_page_tables;
%page;
%include aste;
%page;
%include system_types;
/* so cref will point us here for DPS88M */
%page;
%include "ptw.l68";
/**** %page;
      %include "ptw.adp"; ****/
%page;
%include syserr_constants;

     end ioi_page_table;




		    ioi_wire.pl1                    11/11/89  1140.2rew 11/11/89  0802.5       26343



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1983 *
        *                                                         *
        *********************************************************** */

/* format: style4,delnl,insnl,indattr,ifthen,dclind10 */

ioi_wire:
     procedure;

/* IOI buffer wiring and unwiring routines */
/* Finished August 1982 by Chris Jones from what Charlie Hornig left me */
/* Modified 1984-08-09 BIM for dia support */


/****^  HISTORY COMMENTS:
  1) change(86-03-03,Farley), approve(86-07-18,MCR7439),
     audit(86-08-18,Fawcett), install(86-10-20,MR12.0-1189):
     Changed to execute in the BCE environment.
                                                   END HISTORY COMMENTS */


dcl	p_dtep		   ptr parameter;		/* (I) pointer to a device table entry */

dcl	sys_info$service_system
			   bit (1) aligned external static;

dcl	ioi_page_table$fill	   entry (fixed bin, ptr, fixed bin (35));

dcl	pc_abs$wire_abs	   entry (ptr, fixed bin (9), fixed bin (9), fixed bin (35));
dcl	pc_abs$wire_abs_contig entry (ptr, fixed bin (9), fixed bin (9), fixed bin (35));
dcl	pc_abs$unwire_abs	   entry (ptr, fixed bin (9), fixed bin (9));
dcl	code		   fixed bin (35);
dcl	np		   fixed bin (9);

dcl	(divide)		   builtin;

/* This entry is called to wire the caller's IOI workspace.
   it will be wired in memory connected to the
   bootload SCU and a page table will be built to point to it. */
wire:
     entry (p_dtep);

	dtep = p_dtep;
	if dte.workspace_wired then
	     return;

	np = divide (dte.bound + 1023, 1024, 9, 0);	/* number of pages to wire */
	if sys_info$service_system then
	     call pc_abs$wire_abs (dte.workspace_astep, 0, np, code);
	else call pc_abs$wire_abs_contig (dte.workspace_astep, 0, np, code);
	if code ^= 0 then do;
error:						/* syserr here? */
	     return;
	end;

	call ioi_page_table$fill (dte.ptx, dte.workspace_astep, code);
	if code ^= 0 then
	     goto error;

	dte.workspace_wired = "1"b;
	return;

/* This entry is called to unwire the user's workspace.  For performance reasons, the workspace is left wired
   for a while after the I/O completes in it (since another I/O will most likely start soon, and wiring and
   unwiring is expensive).  Thus, this entry is called by the check_timeout routine when it determines that
   the workspace has been idle  long enough. */
unwire:
     entry (p_dtep);

	dtep = p_dtep;
	if ^dte.workspace_wired then
	     return;

	np = divide (dte.bound + 1023, 1024, 9, 0);	/* number of pages to unwire */
	call pc_abs$unwire_abs (dte.workspace_astep, 0, np);
	dte.workspace_wired = "0"b;
	return;

%include ioi_data;

     end ioi_wire;




		    trace.pl1                       11/11/89  1140.2r w 11/11/89  0802.5        7245



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


system_trace:
trace:
     procedure options (variable);

/* Supervisor tracing procedure. */

	return;

     end trace;






		    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
