



		    channel_manager.pl1             11/11/89  1132.7r w 11/11/89  0824.9      134091



/****^  ***********************************************************
        *                                                         *
        * 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.      *
        *                                                         *
        *********************************************************** */


/* format: style4,delnl,insnl,^ifthendo */
channel_manager:
     procedure;

/*  This procedure accepts calls to perform various channel management
   functions.  Each such call is directed through a transfer vector
   to the appropriate module according to channel type and functional
   type.  The specified channel is locked before forwarding the call
   and unlocked upon return.
*/

/* Coded 7/31/78 by J. Stern */
/* Tracing added February 1980 */
/* Metering added April 1980 by C. Hornig */
/* Metering corrected October 1980 by Robert Coren to avoid double-counting of output characters */
/* copy_meters control added December 1980 by Robert Coren */
/* Modified 6 Apr 82, W. Olin Sibert, to add TIMER interrupt handling */

/* Parameters */

dcl  pm_devx fixed bin;
dcl  pm_info_ptr ptr;
dcl  pm_chain_ptr ptr;
dcl  pm_more_input_flag bit (1) aligned;
dcl  pm_control_type char (*);
dcl  pm_modes_change_list_ptr ptr;
dcl  pm_modes char (*);
dcl  pm_int_type fixed bin;
dcl  pm_int_data bit (72) aligned;
dcl  pm_code fixed bin (35);


/* Automatic */

dcl  queued_entry bit (1) aligned;
dcl  int_type fixed bin;
dcl  devx fixed bin;
dcl  subchan fixed bin;
dcl  locked bit (1) aligned;
dcl  minor_lctep ptr;
dcl  time_in fixed bin (71);


/* Based */

dcl  1 minor_lcte aligned like lcte based (minor_lctep);


/* Conditions */

dcl  cleanup condition;


/* Constants */

dcl  crash_system fixed bin int static options (constant) init (1);
dcl  int_type_names (17) char (16) aligned static options (constant)
	init ("dialup", "hangup", "crash", "send_output", "input_available", "accept_input", "input_rejected", "quit",
	"line_status", "dial_status", "wru_timeout", "space_available", "ack_echnego_init", "ack_echnego_stop", "timer",
	"user", "masked");

/* External static */

dcl  pds$process_id bit (36) ext;
dcl  pds$virtual_delta fixed bin (71) ext;


/* Builtins */

dcl  (addr, clock, null, pointer, rel, unspec) builtin;


/* Entries */

dcl  mcs_trace entry options (variable);
dcl  mcs_trace$buffer_chain entry (fixed bin, pointer);
dcl  tty_lock$lock_channel entry (fixed bin, fixed bin (35));
dcl  tty_lock$unlock_channel entry (fixed bin);
dcl  tty_lock$lock_channel_int entry (fixed bin, fixed bin, bit (72) aligned, bit (1) aligned);
dcl  tty_lock$unlock_channel_int entry (fixed bin);
dcl  tty_lock$queue_interrupt entry (fixed bin, fixed bin, bit (72) aligned, fixed bin);
dcl  syserr entry options (variable);
%page;
/* * * * * * * * * * READ * * * * * * * * * * */

read:
     entry (pm_devx, pm_chain_ptr, pm_more_input_flag, pm_code);

	call setup_major (subchan);

	if tty_buf.trace.enable
	then if tty_buf.trace.read
	     then call mcs_trace (pm_devx, "read");

	on cleanup call unlock_channel ();
	call lock_channel ();
	read_ev = make_entry (READ, (lcte.channel_type));
	call read_ev ((lcte.data_base_ptr), subchan, pm_chain_ptr, pm_more_input_flag, pm_code);
	if pm_code = 0
	then if pm_chain_ptr ^= null ()
	     then do blockp = pm_chain_ptr		/* walk chain to count bytes */
		     repeat (pointer (ttybp, buffer.next)) while (rel (blockp) ^= ""b);
		minor_lcte.meters.in_bytes = minor_lcte.meters.in_bytes + buffer.tally;
	     end;
	call unlock_channel ();

	if tty_buf.trace.enable
	then if tty_buf.trace.read
	     then do;
		call mcs_trace (pm_devx, "read: ^[code ^d ^;^s^]^[chain at ^p ^;^s^]^[more_input^]", (pm_code ^= 0),
		     pm_code, (pm_chain_ptr ^= null ()), pm_chain_ptr, pm_more_input_flag);
		if tty_buf.trace.data
		then call mcs_trace$buffer_chain (pm_devx, pm_chain_ptr);
	     end;

	call meter_call (minor_lcte.meters.in);
	return;

/* * * * * * * * * * WRITE * * * * * * * * * * */

write:
     entry (pm_devx, pm_chain_ptr, pm_code);

	call setup_major (subchan);

	if tty_buf.trace.enable
	then if tty_buf.trace.write
	     then do;
		call mcs_trace (pm_devx, "write: ^p:  ^d bytes ^[etc.^]", pm_chain_ptr, pm_chain_ptr -> buffer.tally,
		     (pm_chain_ptr -> buffer.next ^= 0));
		if tty_buf.trace.data
		then call mcs_trace$buffer_chain (pm_devx, pm_chain_ptr);
	     end;

	on cleanup call unlock_channel ();
	call lock_channel ();
	do blockp = pm_chain_ptr			/* walk chain to count bytes */
	     repeat (pointer (ttybp, buffer.next)) while (rel (blockp) ^= ""b);
	     minor_lcte.meters.out_bytes = minor_lcte.meters.out_bytes + buffer.tally;
	end;
	write_ev = make_entry (WRITE, (lcte.channel_type));
	call write_ev ((lcte.data_base_ptr), subchan, pm_chain_ptr, pm_code);

	if pm_chain_ptr ^= null ()			/* multiplexer didn't take it all */
	then do blockp = pm_chain_ptr			/* subtract out those it didn't take */
		repeat (pointer (ttybp, buffer.next)) while (rel (blockp) ^= ""b);
	     minor_lcte.meters.out_bytes = minor_lcte.meters.out_bytes - buffer.tally;
	end;

	call unlock_channel ();

	if tty_buf.trace.enable
	then if tty_buf.trace.write
	     then if (pm_chain_ptr ^= null ()) | (pm_code ^= 0)
		then call mcs_trace (pm_devx, "write: ^[code ^d ^;^s^]chain left at ^p", pm_code, pm_chain_ptr);

	call meter_call (minor_lcte.meters.out);
	return;

/* * * * * * * * * * CONTROL * * * * * * * * * */

control:
     entry (pm_devx, pm_control_type, pm_info_ptr, pm_code);

	call setup_major (subchan);

	if tty_buf.trace.enable
	then if tty_buf.trace.control
	     then call mcs_trace (pm_devx, "control: ^a ^p", pm_control_type, pm_info_ptr);

	on cleanup call unlock_channel ();
	call lock_channel ();
	control_ev = make_entry (CONTROL, (lcte.channel_type));
	call control_ev ((lcte.data_base_ptr), subchan, pm_control_type, pm_info_ptr, pm_code);
	call unlock_channel ();

	call meter_call (minor_lcte.meters.control);
	if pm_control_type = "copy_meters"		/* we have to do something about this */
	then minor_lcte.saved_meters_ptr -> saved_meters = minor_lcte.meters;

	else if pm_control_type = "get_meters"		/* this too */
	then call get_lc_meters;

	return;

/* * * * * * * * * * SET_MODES * * * * * * * * * * */

set_modes:
     entry (pm_devx, pm_modes_change_list_ptr, pm_code);

	call setup_major (subchan);

	if tty_buf.trace.enable
	then if tty_buf.trace.modes
	     then call mcs_trace (pm_devx, "set_modes: ^p", pm_modes_change_list_ptr);

	on cleanup call unlock_channel ();
	call lock_channel ();
	set_modes_ev = make_entry (SET_MODES, (lcte.channel_type));
	call set_modes_ev ((lcte.data_base_ptr), subchan, pm_modes_change_list_ptr, pm_code);
	call unlock_channel ();

	call meter_call (minor_lcte.meters.control);
	return;

/* * * * * * * * * * * CHECK_MODES * * * * * * * * * */

check_modes:
     entry (pm_devx, pm_modes_change_list_ptr, pm_code);

	call setup_major (subchan);

	if tty_buf.trace.enable
	then if tty_buf.trace.modes
	     then call mcs_trace (pm_devx, "check_modes: ^p", pm_modes_change_list_ptr);

	on cleanup call unlock_channel ();
	call lock_channel ();
	check_modes_ev = make_entry (CHECK_MODES, (lcte.channel_type));
	call check_modes_ev ((lcte.data_base_ptr), subchan, pm_modes_change_list_ptr, pm_code);
	call unlock_channel ();

	call meter_call (minor_lcte.meters.control);
	return;

/* * * * * * * * * * * GET_MODES * * * * * * * * * */

get_modes:
     entry (pm_devx, pm_modes, pm_code);

	call setup_major (subchan);

	if tty_buf.trace.enable
	then if tty_buf.trace.modes
	     then call mcs_trace (pm_devx, "get_modes");

	on cleanup call unlock_channel ();
	call lock_channel ();
	get_modes_ev = make_entry (GET_MODES, (lcte.channel_type));
	call get_modes_ev ((lcte.data_base_ptr), subchan, pm_modes, pm_code);
	call unlock_channel ();

	call meter_call (minor_lcte.meters.control);
	return;

/* * * * * * * * * * INTERRUPT * * * * * * * * * * */

interrupt:
     entry (pm_devx, pm_int_type, pm_int_data);

	queued_entry = "0"b;


interrupt_common:
	int_type = pm_int_type;

	call setup ();

	on cleanup call syserr (crash_system, "channel_manager: Cleanup while processing interrupt for devx ^d.", devx);
	if ^queued_entry
	then do;
	     call tty_lock$lock_channel_int (devx, int_type, pm_int_data, locked);
	     if ^locked
	     then do;
		if tty_buf.trace.enable
		then if tty_buf.trace.interrupt
		     then call mcs_trace (devx, "int: queued ^a ^24.3b", int_type_names (int_type), pm_int_data);
		return;				/* All finished: interrupt was queued for (locked) channel */
	     end;
	end;

	if tty_buf.trace.enable
	then if tty_buf.trace.interrupt
	     then do;
		call mcs_trace (devx, "int: proc ^[queued ^]^a ^24.3b", queued_entry, int_type_names (int_type),
		     pm_int_data);
		if int_type = ACCEPT_INPUT
		then if tty_buf.trace.data
		     then do;
			unspec (rtx_info) = pm_int_data;
			call mcs_trace$buffer_chain (devx, pointer (ttybp, rtx_info.chain_head));
		     end;
	     end;

	interrupt_ev = make_entry (INTERRUPT, (lcte.channel_type));
	call interrupt_ev ((lcte.data_base_ptr), int_type, pm_int_data);

	if ^queued_entry
	then call tty_lock$unlock_channel_int (devx);

	if /* case */ int_type = ACCEPT_INPUT
	then do;
	     unspec (rtx_info) = pm_int_data;
	     lcte.meters.in_bytes = lcte.meters.in_bytes + rtx_info.input_count;
	     call meter_interrupt (lcte.meters.in);
	end;
	else if int_type = SEND_OUTPUT
	then do;
	     call meter_interrupt (lcte.meters.out);
	end;
	else call meter_interrupt (lcte.meters.control);

	return;

/* * * * * * * * * * QUEUED_INTERRUPT * * * * * * * * * */

queued_interrupt:
     entry (pm_devx, pm_int_type, pm_int_data);		/* called with channel already locked */

	queued_entry = "1"b;
	go to interrupt_common;

/* * * * * * * * * * INTERRUPT_LATER * * * * * * * * * */

interrupt_later:
     entry (pm_devx, pm_int_type, pm_int_data);

/* This entry is used to queue an interrupt for a subchannel unconditionally; the interrupt
   is processed when it is time to unlock the major channel */

	int_type = pm_int_type;

	call setup ();

	if tty_buf.trace.enable
	then if tty_buf.trace.interrupt
	     then call mcs_trace (devx, "int: queued ^a ^24.3b", int_type_names (int_type), pm_int_data);

	on cleanup call syserr (crash_system, "channel_manager: Cleanup while queuing interrupt for devx ^d.", devx);

	call tty_lock$queue_interrupt ((lcte.major_channel_devx), int_type, pm_int_data, devx);
	return;

/* * * * * * * * * SETUP * * * * * * * * * */

setup:
     proc;

	locked = "0"b;
	ttybp = addr (tty_buf$);
	lctp = tty_buf.lct_ptr;

	time_in = clock () - pds$virtual_delta;

	devx = pm_devx;
	if devx < 1 | devx > lct.max_no_lctes
	then call syserr (crash_system, "channel_manager: Invalid devx specified.  ^o", devx);

	lctep = addr (lct.lcte_array (devx));

	cmtvp = addr (cmtv$cmtv);

     end setup;					/* setup */

/* * * * * * * * * * * SETUP_MAJOR * * * * * * * ** */

setup_major:
     proc (subchan);

dcl  subchan fixed bin;


	call setup ();
	minor_lctep = lctep;
	if lcte.lock ^= pds$process_id
	then call syserr (crash_system, "channel_manager: Channel not locked by process. (devx = ^o)", devx);
	subchan = lcte.subchannel;

	devx = lcte.major_channel_devx;
	lctep = addr (lct.lcte_array (devx));

     end setup_major;				/* setup_major */

/* * * * * * * * * * METER_CALL * * * * * * * * * */

meter_call:
     procedure (Meters);
dcl  1 Meters aligned like lcte.meters.in;

	Meters.calls = Meters.calls + 1;
	Meters.call_time = Meters.call_time + clock () - pds$virtual_delta - time_in;
	return;

/* * * * * * * * * * METER_INTERRUPT * * * * * * * * * */

meter_interrupt:
     entry (Meters);

	Meters.interrupts = Meters.interrupts + 1;
	Meters.interrupt_time = Meters.interrupt_time + clock () - pds$virtual_delta - time_in;
	return;
     end meter_call;

/* * * * * * * * * * GET_LC_METERS * * * * * * * * * * */

get_lc_meters:
     proc;

/* return logical channel meters in response to get_meters order */

dcl  lcmp ptr;
dcl  info_ptr ptr;

	info_ptr = pm_info_ptr;
	info_ptr -> get_comm_meters_info.parent_type = lcte.channel_type;
	lcmp = info_ptr -> get_comm_meters_info.logical_chan_ptr;
	lcmp -> logical_chan_meters.current_meters = minor_lcte.meters;
	lcmp -> logical_chan_meters.saved_meters = minor_lcte.saved_meters_ptr -> saved_meters;
	return;
     end get_lc_meters;

/* * * * * * * * * * MAKE_ENTRY * * * * * * * * * * */

make_entry:
     proc (entry_type, chan_type) returns (entry variable); /* kludges together an entry variable */

dcl  entry_type fixed bin;
dcl  chan_type fixed bin;

dcl  code_ptr ptr;
dcl  code_word fixed bin based (code_ptr);

dcl  new_entry entry variable;
dcl  1 entry_var aligned,
       2 code_ptr ptr,
       2 env_ptr ptr;


	code_ptr = addr (cmtv.entries (entry_type, cmtv.chan_type_index (chan_type)));
	if code_word = 0				/* undefined entry point */
	then new_entry = undefined_entry;
	else do;
	     entry_var.code_ptr = code_ptr;
	     entry_var.env_ptr = null;
	     unspec (new_entry) = unspec (entry_var);
	end;
	return (new_entry);
     end make_entry;				/* get_entry */

undefined_entry:
     procedure;					/* for bad cmtv pointers */
	return;
     end undefined_entry;

/* * * * * * * * * * * * LOCK_CHANNEL * * * * * * * * * */

lock_channel:
     proc;

dcl  code fixed bin (35);


	if lcte.special_lock			/* not for us to lock */
	then return;

	call tty_lock$lock_channel (devx, code);
	if code ^= 0
	then call syserr (crash_system, "channel_manager: Cannot lock channel for devx ^o (code = ^o)", devx, code);
	locked = "1"b;

     end lock_channel;				/* lock_channel */

/* * * * * * * * * * * UNLOCK_CHANNEL * * * * * * * * * * */

unlock_channel:
     proc;

	if locked
	then call tty_lock$unlock_channel (devx);
	locked = "0"b;

     end unlock_channel;				/* unlock_channel */

%include lct;

%include cmtv;

%include tty_buf;

%include mcs_interrupt_info;
%include tty_buffer_block;
%include get_comm_meters_info;

     end;						/* channel_manager_ */

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   channel_manager: Cleanup while processing interrupt for devx N.

   S:	$crash

   T:	$run

   M:	The cleanup condition was signalled while processing an
   interrupt for the channel with devx N.

   A:	$inform


   Message:
   channel_manager: Error while processing interrupt for devx N.  REASON

   S:	$crash

   T:	$run

   M:	An error occurred while processing an interrupt for the channel
   with devx N.  The specific kind of error is explained by REASON.

   END MESSAGE DOCUMENTATION */




		    cmtv.alm                        11/11/89  1132.7rew 11/11/89  0824.9       82323



" ***********************************************************
" *                                                         *
" * Copyright, (C) BULL HN Information Systems Inc., 1989   *
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1988                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" * Copyright (c) 1972 by Massachusetts Institute of        *
" * Technology and Honeywell Information Systems, Inc.      *
" *                                                         *
" ***********************************************************

" HISTORY COMMENTS:
"  1) change(88-06-15,Berno), approve(88-07-13,MCR7928),
"     audit(88-07-05,Parisek), install(88-07-19,MR12.2-1061):
"     Add transfers to the uncp multiplexer interface for the DSA gateway.
"  2) change(88-07-07,Beattie), approve(88-06-27,MCR7926),
"     audit(88-08-03,Brunelle), install(88-08-08,MR12.2-1082):
"     Add transfers for X.25 lap multiplexer.
"  3) change(89-03-20,Parisek), approve(89-06-01,MCR8110),
"     audit(89-10-09,Farley), install(89-10-25,MR12.3-1100):
"     Add transfers to protocol_mpx entries.
"                                                      END HISTORY COMMENTS

""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
"
"	cmtv --- channel manager transfer vector
"
"	This source segment defines a data base containing a transfer
"	vector used by the channel_manager and priv_channel_manager
"	procedures.  It has the following structure:
"
"
"	dcl 1 cmtv aligned based (addr (cmtv$)),
"	      2 no_channel_types fixed bin,
"	      2 pad fixed bin,
"	      2 chan_type_index (0:16) fixed bin,
"	      2 entries (no_entry_types, 0 refer (cmtv.no_channel_types)) bit (72);
"
"
"	Created 9/21/78 by J. Stern
""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""


	macro	prologue

	name	cmtv
	set	.cur_index,0
	set	.tty_index,0
	set	.fnp_index,0
	set	.user1_index,0
	set	.user2_index,0
	set	.user3_index,0
	set	.user4_index,0
	set	.user5_index,0
	set	.ibm3270_index,0
	set	.vip7760_index,0
	set	.sty_index,0
	set	.lap_index,0
	set	.x25_index,0
	set	.hasp_index,0
	set	.uncp_index,0
	set	.cxi_index,0
	set	.system1_index,0
	set	.protocol_index,0

	&end


	macro	epilogue

	use	.text.
	segdef	cmtv
cmtv:	null
	zero	0,.cur_index
	dec	0
	zero	0,.tty_index
	zero	0,.fnp_index
	zero	0,.user1_index
	zero	0,.user2_index
	zero	0,.user3_index
	zero	0,.user4_index
	zero	0,.user5_index
	zero	0,.ibm3270_index
	zero	0,.vip7760_index
	zero	0,.sty_index
	zero	0,.lap_index
	zero	0,.x25_index
	zero	0,.hasp_index
	zero	0,.uncp_index
	zero	0,.cxi_index
	zero	0,.system1_index
	zero	0,.protocol_index


	join	/text/.init_channel.
	join	/text/.terminate_channel.
	join	/text/.init_multiplexer.
	join	/text/.terminate_multiplexer.
	join	/text/.start.
	join	/text/.stop.
	join	/text/.shutdown.
	join	/text/.priv_control.
	join	/text/.hpriv_control.
	join	/text/.read.
	join	/text/.write.
	join	/text/.control.
	join	/text/.set_modes.
	join	/text/.check_modes.
	join	/text/.get_modes.
	join	/text/.interrupt.

	maclist	on
	end

	&end

" The following macros define valid entry type names:

	macro	init_channel
	&end
	macro	terminate_channel
	&end
	macro	init_multiplexer
	&end
	macro	terminate_multiplexer
	&end
	macro	start
	&end
	macro	stop
	&end
	macro	shutdown
	&end
	macro	priv_control
	&end
	macro	hpriv_control
	&end
	macro	read
	&end
	macro	write
	&end
	macro	control
	&end
	macro	set_modes
	&end
	macro	check_modes
	&end
	macro	get_modes
	&end
	macro	interrupt
	&end


" The following macros define valid channel type names:

	macro	tty
	&end
	macro	fnp
	&end
	macro	user1
	&end
	macro	user2
	&end
	macro	user3
	&end
	macro	user4
	&end
	macro	user5
	&end
	macro	ibm3270
	&end
	macro	vip7760
	&end
	macro	sty
	&end
	macro	lap
	&end
	macro	x25
	&end
	macro	hasp
	&end
	macro	uncp
	&end
	macro	cxi
	&end
	macro	system1
	&end
	macro	protocol
	&end

	macro	add_entry

	&1
	use	.&1.
	getlp
	tra	&2$&1
	set	.&1_incr,0

	&end


	macro	type

	&1
	set	.cur_index,.cur_index+1
	set	.&1_index,.cur_index

	set	.init_channel_incr,2
	set	.terminate_channel_incr,2
	set	.init_multiplexer_incr,2
	set	.terminate_multiplexer_incr,2
	set	.start_incr,2
	set	.stop_incr,2
	set	.shutdown_incr,2
	set	.priv_control_incr,2
	set	.hpriv_control_incr,2
	set	.read_incr,2
	set	.write_incr,2
	set	.control_incr,2
	set	.set_modes_incr,2
	set	.check_modes_incr,2
	set	.get_modes_incr,2
	set	.interrupt_incr,2

&R3&(	add_entry	&i,&2
&)

	use	.init_channel.
	bss	,.init_channel_incr
	use	.terminate_channel.
	bss	,.terminate_channel_incr
	use	.init_multiplexer.
	bss	,.init_multiplexer_incr
	use	.terminate_multiplexer.
	bss	,.terminate_multiplexer_incr
	use	.start.
	bss	,.start_incr
	use	.stop.
	bss	,.stop_incr
	use	.shutdown.
	bss	,.shutdown_incr
	use	.priv_control.
	bss	,.priv_control_incr
	use	.hpriv_control.
	bss	,.hpriv_control_incr
	use	.read.
	bss	,.read_incr
	use	.write.
	bss	,.write_incr
	use	.control.
	bss	,.control_incr
	use	.set_modes.
	bss	,.set_modes_incr
	use	.check_modes.
	bss	,.check_modes_incr
	use	.get_modes.
	bss	,.get_modes_incr
	use	.interrupt.
	bss	,.interrupt_incr

	&end

	maclist	off

" The transfer vector definition has the following syntax:
"
"
" <transfer_vector> := prologue <type_list> epilogue
" <type_list> := <type_stmt> | <type_stmt> <type_list>
" <type_stmt> := type <channel_type> , <global_seg_name> , <entry_list>
" <entry_list> := <entry> | <entry> , <entry_list>
" <entry> := <entry_type> | ( <entry_type> , <local_seg_name> )
" <channel_type> := tty | fnp | user1 | user2 | user3 | user4 | user5 | ibm3270
"		| vip7760 | sty | lap | x25 | hasp | uncp | cxi | system1
"	          | protocol
" <entry_type> := init_channel | terminate_channel | init_multiplexer | terminate_multiplexer |
		start | stop | shutdown | priv_control | hpriv_control | read | write |
		control | set_modes | check_modes | get_modes | interrupt
" <global_seg_name> := {the name of a procedure segment}
" <local_seg_name> := {the name of a procedure segment}
"
"
" Each "type" statement defines a channel type.
" It specifies the valid entry types for the channel type.
" It specifies the transfer vector target for each valid entry type.
" The transfer vector target for an entry type is an entrypoint
" in a procedure segment.
" The name of the entrypoint is always the name of the entry type.
" The segment name may optionally be specified by a local segment name.
" If no local segment name is given, then the global segment name is used.



	prologue

	type	tty,tty_index,
		init_channel,
		terminate_channel,
		(interrupt,tty_interrupt)

	type	fnp,fnp_multiplexer,
		init_multiplexer,
		terminate_multiplexer,
		start,
		stop,
		shutdown,
		priv_control,
		hpriv_control,
		read,
		write,
		control,
		set_modes,
		check_modes,
		get_modes

	type	vip7760,polled_vip_mpx,
		(init_multiplexer,priv_polled_vip_mpx),
		(terminate_multiplexer,priv_polled_vip_mpx),
		(start,priv_polled_vip_mpx),
		(stop,priv_polled_vip_mpx),
		(shutdown,priv_polled_vip_mpx),
		(hpriv_control,priv_polled_vip_mpx),
		(priv_control,priv_polled_vip_mpx),
		read,
		write,
		check_modes,
		set_modes,
		get_modes,
		control,
		interrupt

	type	ibm3270,ibm3270_mpx,
		(init_multiplexer,priv_ibm3270_mpx),
		(terminate_multiplexer,priv_ibm3270_mpx),
		(start,priv_ibm3270_mpx),
		(stop,priv_ibm3270_mpx),
		(shutdown,priv_ibm3270_mpx),
		(priv_control,priv_ibm3270_mpx),
		(hpriv_control,priv_ibm3270_mpx),
		control,
		read,
		check_modes,
		set_modes,
		get_modes,
		write,
		interrupt

          type      lap,lap_simplex,
                    init_multiplexer,terminate_multiplexer,
                    start,stop,shutdown,
                    hpriv_control,priv_control,control,
                    check_modes,set_modes,get_modes,
                    write,
                    interrupt

	type	x25,x25_mpx,
		(init_multiplexer,priv_x25_mpx),
		(terminate_multiplexer,priv_x25_mpx),
		(start,priv_x25_mpx),
		(stop,priv_x25_mpx),
		(shutdown,priv_x25_mpx),
		(hpriv_control,priv_x25_mpx),
		(priv_control,priv_x25_mpx),
		control,
		check_modes,set_modes,get_modes,
		write,
		interrupt

	type	sty,sty_mpx,
		init_multiplexer,terminate_multiplexer,
		start,stop,shutdown,
		read,write,control,
		get_modes,set_modes,check_modes

	type	hasp,hasp_mpx,
		(init_multiplexer,priv_hasp_mpx),
		(terminate_multiplexer,priv_hasp_mpx),
		(start,priv_hasp_mpx),
		(stop,priv_hasp_mpx),
		(shutdown,priv_hasp_mpx),
		(priv_control,priv_hasp_mpx),
		(hpriv_control,priv_hasp_mpx),
		read,write,interrupt,control,
		check_modes,set_modes,get_modes

	type	uncp,uncp_multiplexer,
		init_multiplexer,
		terminate_multiplexer,
		start,
		stop,
		shutdown,
		priv_control,
		hpriv_control,
		read,
		write,
		control,
		set_modes,
		check_modes,
		get_modes
                                          
	type	protocol,protocol_mpx,
		init_multiplexer,
		terminate_multiplexer,
		start,
		stop,
		shutdown,
		priv_control,
		hpriv_control,
		interrupt
	epilogue




		    dn355.pl1                       11/11/89  1132.7r w 11/11/89  0824.9      521658



/****^  ***********************************************************
        *                                                         *
        * 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.      *
        *                                                         *
        *********************************************************** */


/* format: style4,insnl,delnl,^ifthendo */
dn355:
     procedure;
	return;					/* should never be called here */

/* 	Date last modified and reason

   Written 10/08/74 by F. A. Canali for new tty dim
   Modified by Robert Coren and Mike Grady to fix bugs and add features
   Modified by Robert Coren 10/08/75 for multiple 355s
   Modified by J. Stern 04/22/77 to introduce WTCBs
   Modified by J. Stern 06/23/77 to behave correctly when no submailboxes available
   Modified by J. Stern 07/28/77 to use all 3 words of command data in submailbox
   Modified Jan.-Feb. 1978 to use variable-size output buffers and fix some bugs
   Modified 3/13/78 by Robert Coren to use clock builtin instead of clock_ and to get correct
   time at hangup_fnp_lines entry
   Modified August 1978 by Robert Coren for demultiplexing
   Modified November 8, 1978 by Robert Coren to introduce FNP-initiated mailboxes
   Modified July 2 1979 by B. Greenberg for negotiated echo.
   Modified March 1980 by Robert Coren to eliminate use of circular buffer.
   Modified April 1980 by Robert Coren to add metering information.
   Modified 1980 December by Art Beattie to ignore interrupts in invalid levels.  Also allowed command_data for
   send_wcd operations to be 216 bits long (6 * 36-bit word).  Corrected error message documentation.
   Modified December 1980 by Robert Coren to handle report_meters opcode
   Modified April 1981 by Chris Jones for io_manager conversion
   Modified September 1981 by Robert Coren to record character counts in LCTE meters and to force COLTS buffer size to maximum
   Modified February 1982 by C. Hornig for MR10 io_manager.
   Modified June 1982 by Robert Coren to process "line_masked" opcode.
   Modified 1984-07-28 BIM for dn355_boot_interrupt$system_fault.
   Modified 1984-07-30 BIM for paged mode IOM.
   Modified September 1984 by Robert Coren to use include file to define delay queue entries
*/

/****^  HISTORY COMMENTS:
  1) change(86-04-23,Coren), approve(86-04-23,MCR7300),
     audit(86-06-19,Beattie), install(86-07-08,MR12.0-1089):
     To handle 8-word echo-break tables.
  2) change(86-06-19,Kissel), approve(86-07-30,MCR7475), audit(86-09-04,Coren),
     install(86-10-09,MR12.0-1181):
     Changed to support the new tty event message format declared in
     net_event_message.incl.pl1 which replaces tty_event_message.incl.pl1.
  3) change(87-07-20,Farley), approve(88-02-24,MCR7791),
     audit(88-03-09,Beattie), install(88-03-15,MR12.2-1035):
     Changed no response loop to use a real time constant and retry the timeout
     or error one time along with reporting the problem.  If no response occurs
     after the retry then the FNP will be crashed.
                                                   END HISTORY COMMENTS */
%page;
interrupt:
     entry (x_dno, x_level, x_status);			/* entry from iom_manager */

dcl  x_dno fixed bin (35);				/* index from assignment time */
dcl  x_level fixed bin (3);				/* interrupt level */
dcl  x_status bit (36) aligned;			/* status after special or fault */

	if tc_data$system_shutdown ^= 0
	then return;				/* ignore 355's if shut down in progress */
	interrupt_entry = "1"b;

	call setup;
	level = x_level;				/* copy level to local stack */
	if datanet_info.trace
	then do;
	     if level ^= 3 | ^fnp_info.running
	     then syserr_severity = just_tell;
	     else syserr_severity = log;
	     call syserr (syserr_severity,
		"dn355: FNP ^a level ^d status ^w^[ running^]^[ bootloading^]^[ t_and_d_in_progress^]", fnp_name,
		level, x_status, fnp_info.running, fnp_info.bootloading, fnp_info.t_and_d_in_progress);
	end;
	if level ^= 3 & level ^= 7
	then do;					/* if not a good interrupt level */
	     call syserr (beeper, "dn355: FNP ^a invalid interrupt level ^o", fnp_name, level);
	     if fnp_info.bootloading
	     then if level = 1			/* system fault */
		then call dn355_boot_interrupt$system_fault (dno);
	     return;				/* lets hope its benign */
	end;

	if (^fnp_info.t_and_d_in_progress) & (^fnp_info.running) & (^fnp_info.bootloading)
	then return;				/* spurious interrupt */

	if ^stac (addr (lcte.lock), pds$processid)	/* somebody else has it */
	then do;

	     do while (^stac (addr (fnp_info.queue_lock), pds$processid));
	     end;

	     if level = 7
	     then fnp_info.level_7_pending = "1"b;
	     else fnp_info.level_3_pending = "1"b;

	     if stac (addr (lcte.lock), pds$processid)	/* in case it got unlocked meanwhile */
	     then call process_int_queue ("0"b);

	     else if ^stacq (fnp_info.queue_lock, "0"b, pds$processid)
	     then call syserr (crash_system, "dn355: inconsistent queue lock");
	end;

	else do;
	     call process_int (level);

	     do while (^stac (addr (fnp_info.queue_lock), pds$processid));
	     end;					/* check the queue to see if anything came in while we had the lock */

	     call process_int_queue ("0"b);
	end;

	return;

global_exit:					/* if abort out of an internal proc */
	if interrupt_entry
	then do;
	     if stacq (lcte.lock, "0"b, pds$processid)	/* make sure we undo anything we did */
	     then if lcte.notify_reqd
		then do;
		     lcte.notify_reqd = "0"b;
		     call pxss$notify (tty_ev);
		end;

	     lcte.locked_for_interrupt = "0"b;

	end;
	return;

/* entry to send a command to the FNP */
send_wcd:
     entry (a_fnpp, a_pcbp, opa, chrsa, data);

dcl  a_fnpp ptr,					/* parameters */
     a_pcbp ptr,
     opa fixed bin (8),
     data bit (*),
     chrsa fixed bin (8);				/* numeric */

dcl  tdata bit (8 * 36);				/* could be up to 8 words for set_echnego_break_table */
dcl  data_len fixed bin (8);

	pcbp = a_pcbp;
	go to send_join;

send_global_wcd:
     entry (a_fnpp, opa, chrsa, data);

	pcbp = null ();

send_join:
	interrupt_entry = "0"b;
	fnpp = a_fnpp;
	ttybp = addr (tty_buf$);			/* get ptr to tty buf */
	infop = addr (dn355_data$);			/* and dn 355 info */
	lctep = fnp_info.lcte_ptr;
	operation = opa;				/* and copy op to local stack */
	if ^fnp_info.running			/* can't talk to it if it's not listening */
	then return;

	no_response = "0"b;
	dno = fnp_info.fnp_number;
	mbxp = fnp_info.mbx_pt;			/* get pointer to mailbox */
	data_len = min (length (tdata), chrsa);		/* compute bit length of command data */
	if data_len > 0
	then tdata = substr (data, 1, data_len);
	else tdata = "0"b;

	i = index (used_string, "0"b);		/* find a free sub mbx */
	if i = 0					/* no submailbox */
	then do;
	     call make_q_entry (operation, data_len, tdata);
	     fnp_info.mbx_unavailable = fnp_info.mbx_unavailable + 1;
						/* form q entry element from data */
	end;

	else do;					/* we have a sub mbx, ship it off to the 355 */
	     subp = addr (datanet_mbx.dn355_sub_mbxes (i - 1));
						/* get sub mbx addr */
	     if pcbp ^= null ()
	     then do;
		string (sub_mbx.line_number) = string (pcb.line_number);
						/* move line number to sub mbx */
		devx = pcb.devx;
	     end;

	     else string (sub_mbx.line_number) = "0"b;	/* unless no pcb (global call) */

	     sub_mbx.op_code = operation;		/* set sub mbx op */
	     sub_mbx.cmd_data_len = divide (data_len, 6, 17, 0);
						/* set data length */
	     if operation = accept_direct_output	/* if output op */
	     then do;
		if ^pcb.flags.dialed		/* output without a dialup? */
		then call throw_away_output;		/* discard it */

		else call process_send_output (i - 1, "0"b);
	     end;

	     else if operation = set_echnego_break_table
	     then do;
		if pcb.flags.dialed
		then call send_echo_table (i - 1, tdata);
	     end;

	     else do;
		sub_mbx.io_cmd = wcd;		/* set write control data cmd */
		smbx_cmd_data_long = substr (tdata, 1, data_len);
						/* move command data to sub mbx */
		call send_mbx (i - 1);		/* ship the mbx off to the 355 */
		fnp_info.output_control_transactions = fnp_info.output_control_transactions + 1;
	     end;


	     if no_response
	     then call report_fnp_no_response;
	end;


	return;					/* return to caller */

process_interrupt_queue:
     entry (x_dno);

	interrupt_entry = "0"b;
	call setup;
	on cleanup call check_lock;
	masked = "1"b;				/* have to mask and wire while holding queue lock */
	call pmut$wire_and_mask (wire_arg, wire_ptr);

	do while (^stac (addr (fnp_info.queue_lock), pds$processid));
	end;
	queue_locked = "1"b;

	call process_int_queue ("1"b);
	return;

setup:
     proc;

	ttybp = addr (tty_buf$);			/* get addr of tty buffer segment */
	dno = x_dno;				/* copy 355 number to local stack */
	infop = addr (dn355_data$);			/* get address of 355 info segment */

	fnpp = addr (datanet_info.per_datanet (dno));
	fnp_name = fnp_info.fnp_tag;
	mbxp = fnp_info.mbx_pt;			/* get mailbox pointer */
	lctep = fnp_info.lcte_ptr;

	return;
     end setup;

process_int_queue:
     proc (caller_masked);

/* called with queue locked. Empties the queue, and must unlock it when done */

dcl  caller_masked bit (1);				/* indicates whether caller explicitly called pmut$wire_and_mask */

	do while (dequeue (level));
	     fnp_info.processed_from_q = fnp_info.processed_from_q + 1;
						/* meter */
	     if ^stacq (fnp_info.queue_lock, "0"b, pds$processid)
	     then call syserr (crash_system, "dn355: inconsistent queue lock");

	     queue_locked = "0"b;
	     if caller_masked
	     then call pmut$unwire_unmask (wire_arg, wire_ptr);
	     masked = "0"b;

	     call process_int (level);

	     if caller_masked
	     then do;				/* if we unmasked, we have to mask again */
		masked = "1"b;
		call pmut$wire_and_mask (wire_arg, wire_ptr);
	     end;

	     do while (^stac (addr (fnp_info.queue_lock), pds$processid));
	     end;
	     queue_locked = "1"b;
	end;

	lcte.locked_for_interrupt = "0"b;
	if ^stacq (lcte.lock, "0"b, pds$processid)
	then call syserr (crash_system, "dn355: LCTE lock ^^= processid");

	if ^stacq (fnp_info.queue_lock, "0"b, pds$processid)
	then call syserr (crash_system, "dn355: inconsistent queue lock");

	queue_locked = "0"b;
	if caller_masked
	then call pmut$unwire_unmask (wire_arg, wire_ptr);
	masked = "0"b;

	if lcte.notify_reqd
	then do;
	     lcte.notify_reqd = "0"b;
	     call pxss$notify (tty_ev);
	end;

	return;

dequeue:
	proc (a_level) returns (bit (1));

dcl  a_level fixed bin;

	     if fnp_info.level_3_pending
	     then do;
		fnp_info.level_3_pending = "0"b;
		a_level = 3;
		return ("1"b);
	     end;

	     else if fnp_info.level_7_pending
	     then do;
		fnp_info.level_7_pending = "0"b;
		a_level = 7;
		return ("1"b);
	     end;

	     else return ("0"b);

	end /* dequeue */;
     end /* process_int_queue */;

process_int:
     proc (a_level);

/* internal procedure to process an interrupt, either when it occurs or from the queue */

dcl  a_level fixed bin;

	level = a_level;

	lcte.locked_for_interrupt = "1"b;
	if level = 7
	then do;					/* emergency interrupt */

	     if fnp_info.t_and_d_in_progress
	     then do;
		if fnp_info.t_and_d_lev_7_occurred
		then return;
		fnp_info.t_and_d_lev_7_occurred = "1"b;
t_and_d_join:
		if fnp_info.t_and_d_notify_requested
		then do;
		     call pxss$notify (tty_ev);
		     fnp_info.t_and_d_notify_requested = "0"b;
		end;
		unspec (auto_net_event_message) = "0"b;
		auto_net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
		auto_net_event_message.network_type = MCS_NETWORK_TYPE;
		auto_net_event_message.handle = dno;
		auto_net_event_message.type = level;
		unspec (net_event_message_arg) = unspec (auto_net_event_message);
		call pxss$unique_ring_0_wakeup (fnp_info.boot_process_id, fnp_info.boot_ev_chan,
		     net_event_message_arg, 0);
		return;
	     end;

/* figure out reason for crash according to data in mailbox header */

	     fault_type = datanet_mbx.crash_data.fault_code;
	     if fault_type > hbound (dn355_messages$fault_names, 1) | fault_type < 0
	     then fault_name = "unknown fault";
	     else fault_name = dn355_messages$fault_names (fault_type);

	     call syserr (beeper, "dn355: emergency interrupt from FNP ^a: ^a", fnp_info.fnp_tag, fault_name);

	     if datanet_mbx.crash_data.ic ^= 0
	     then call syserr (just_tell, "FNP instruction counter = ^6o", datanet_mbx.crash_data.ic);

	     if fault_type = iom_channel_fault
	     then call syserr (just_tell, "channel ^o, fault status = ^6o", datanet_mbx.crash_data.fault_word,
		     datanet_mbx.crash_data.iom_fault_status);

	     else if fault_type = illegal_opcode
	     then if dn355_word.opcode = die_code	/* did 355 crash deliberately? */
		then do;
		     modulep = addr (dn355_messages$per_module);
		     module_num = fixed (dn355_word.modnum, 4);
		     if module_num > 0 & module_num <= hbound (dn355_modules.list_offset, 1)
			& dn355_word.crash_code > 0 & dn355_word.crash_code <= hbound (modulep -> message_offset, 1)
		     then do;
			reasonp = ptr (modulep, dn355_modules.list_offset (module_num));
			reasonp = ptr (reasonp, reasonp -> message_offset (dn355_word.crash_code));

			call syserr (just_tell, "^a: ^a", dn355_modules.name (module_num), dn355_reason.msg);
		     end;
		end;

	     call report_fnp_crash;			/* report it and hang up lines */
	     return;				/* done with this interrupt */
	end;

/* level must be 3, a normal everyday 355 interrupt */

	if fnp_info.bootloading			/* if this is bootload status */
	then do;
	     call dn355_boot_interrupt (dno);		/* let special routine figure it out */
	     return;
	end;

	if fnp_info.t_and_d_in_progress
	then do;
	     if fnp_info.t_and_d_lev_3_occurred
	     then return;
	     fnp_info.t_and_d_lev_3_occurred = "1"b;
	     go to t_and_d_join;
	end;

	if ^fnp_info.running			/* if this interrupt is premature, ignore it */
	then return;

	no_response = "0"b;				/* initially */

	if fnp_info.count > 0			/* had we had to wait for a free mbx? */
	then call process_q;

/* process any submailboxes which have been returned by the 355 */

	timw = ldac (addr (datanet_mbx.term_inpt_mpx_wd));/* get timw and clear */

	do i = 0 to 7;				/* loop over submailbox indicators */

	     if timwb (i) & ^no_response
	     then do;				/* if mailbox was returned by 355 then we have something to do */

		subp = addr (datanet_mbx.dn355_sub_mbxes (i));
						/* get pointer to sub mailbox */
		datanet_mbx.mbx_used_flags.used (i) = "0"b;
						/* clear submailbox used flag */
		datanet_mbx.num_in_use = datanet_mbx.num_in_use - 1;
		fnp_info.cumulative_mbx_in_use = fnp_info.cumulative_mbx_in_use + datanet_mbx.num_in_use;
		fnp_info.mbx_in_use_updated = fnp_info.mbx_in_use_updated + 1;

		if sub_mbx.io_cmd = wcd
		then do;
		     if sub_mbx.op_code = dump_mem | sub_mbx.op_code = patch_mem
		     then do;
			fnp_info.dump_patch_in_progress = "0"b;
			call pxss$notify (FNP_DUMP_PATCH_EVENT);
		     end;

		     else if sub_mbx.op_code = report_meters
		     then do;
			call get_line_number;
			if devx = -1
			then if fnp_info.get_meters_waiting
						/* fnp_multiplexer is waiting for global meters */
			     then do;
				fnp_info.get_meters_waiting = "0"b;
				call pxss$notify (FNP_METER_EVENT);
			     end;
			     else ;		/* copy_meters for whole FNP shouldn't arise */

			else if pcb.get_meters_waiting/* waiting for channel's meters */
			then do;
			     pcb.get_meters_waiting = "0"b;
			     call pxss$notify (FNP_METER_EVENT);
			end;

			else pcb.copied_meters_ready = "1"b;
						/* must be copy_meters, mark it so call side can copy them to unwired */
		     end;
		end;				/* just free submbx */

		else do;
		     call get_line_number;
		     if sub_mbx.io_cmd = wtx
		     then do;			/* check for write text */

			pcb.output_mbx_pending = "0"b;
			dcwlptr = addr (fnp_info.dcw_list_array_ptr -> dcw_list_array (i));
			chain_head_ptr = ptr (ttybp, bin (dcw_list (1).dcw_ptr, 18) - (tty_buf.absorig + dataoff));
			call tty_space_man$free_chain ((pcb.devx), OUTPUT, chain_head_ptr);
						/* and the output chain */

			if sub_mbx.command_data (1) ^= "0"b
						/* immediate send-output */
			then call process_send_output (i, "1"b);

		     end;



		     else do;
			call syserr (beeper, "dn355: unrecognized io command ^o from FNP ^a for line ^o",
			     sub_mbx.io_cmd, fnp_info.fnp_tag, bin (string (sub_mbx.line_number), 10));
						/* complain */
			call report_fnp_crash;	/* act as if FNP crashed */
			return;
		     end;
		end;
	     end;
	end;

	do i = 8 to 11;				/* now look at FNP-initiated mailboxes */
	     if timwb (i) & ^no_response
	     then do;
		subp = addr (datanet_mbx.fnp_sub_mbxes (i - 8));
		call get_line_number;

		if sub_mbx.io_cmd = rcd
		then do;				/* check for control stuff */

		     if (sub_mbx.op_code = accept_direct_input) | (sub_mbx.op_code = send_output)
			| (sub_mbx.op_code = input_in_mailbox)
		     then do;
			fnp_info.bleft_355 = fnp_sub_mbx.n_free_buffers - 4;
						/* get the buffer count from 355 */

			if fnp_info.bleft_355 < 0
			then			/* if above was too much correction */
			     fnp_info.bleft_355 = 0;	/* make it safe */


			if fnp_info.free_size > 16000000000
			then do;
			     fnp_info.free_size = 0;
			     fnp_info.free_count = 0;
			end;

			fnp_info.free_size = fnp_info.free_size + fnp_info.bleft_355;
			fnp_info.free_count = fnp_info.free_count + 1;
		     end;

		     if sub_mbx.op_code = accept_direct_input | sub_mbx.op_code = input_in_mailbox
		     then fnp_info.input_data_transactions = fnp_info.input_data_transactions + 1;
		     else fnp_info.input_control_transactions = fnp_info.input_control_transactions + 1;

		     if sub_mbx.op_code = accept_new_terminal
		     then do;			/* check for new terminal on line */


			pcb.line_type, dialup_info.line_type = bin (sub_mbx.command_data (1), 17);
			if sub_mbx.command_data (2)
			then pcb.baud_rate = baud_table (bin (sub_mbx.command_data (2), 17));

			do j = 1 to n_sync_line_types while (sync_line_type (j) ^= pcb.line_type);
			end;
			pcb.sync_line = (j <= n_sync_line_types);

			if ^pcb.sync_line		/* asynchronous */
			then bits_per_char = 10;
			else bits_per_char = 8;	/* assumption for synchronous lines */

			max_buf_chars =
			     divide (divide (pcb.baud_rate, bits_per_char, 17, 0), buf_per_second, 17, 0);
			pcb.max_buf_size = min (16 * divide (max_buf_chars + 67, 64, 17, 0), 128);
						/* round up to multiple of 16 words */
			if pcb.line_type = LINE_COLTS
			then pcb.max_buf_size = 128;	/* COLTS channel always gets big buffers */

			dialup_info.baud_rate = pcb.baud_rate;
			dialup_info.max_buf_size = pcb.max_buf_size;
			dialup_info.buffer_pad = 0;
			dialup_info.receive_mode_device = (dialup_info.line_type = LINE_ETX);
			dialup_info.pad = "0"b;
			pcb.dialed = "1"b;

			sub_mbx.op_code = terminal_accepted;
						/* inform 355 that term is ok */
			sub_mbx.cmd_data_len = 3;	/* we will put write buffer threshold in command data */
			if ^pcb.high_speed		/* less than 1200 baud */
			then addr (sub_mbx.command_data) -> unal_number = 2;
						/* set low write buffer threshold */
			else addr (sub_mbx.command_data) -> unal_number = 4;
						/* set high write buffer threshold */
			sub_mbx.io_cmd = wcd;
			call return_mbx (i);
			interrupt_info = unspec (dialup_info);
			call channel_manager$interrupt (devx, DIALUP, interrupt_info);

		     end;


		     else if sub_mbx.op_code = disconnected_line
		     then do;			/* see if line just hung up */
			pcb.dialed = "0"b;
			call throw_away_output;
			call channel_manager$interrupt (devx, HANGUP, ""b);
			call free_mbx (i);

		     end;

		     else if sub_mbx.op_code = wru_timeout
		     then do;			/* 355 couldn't get answerback */
			if pcb.dialed
			then call channel_manager$interrupt (devx, WRU_TIMEOUT, ""b);
			call free_mbx (i);
		     end;

		     else if sub_mbx.op_code = break_condition
		     then do;			/* check for break */

			if pcb.dialed
			then do;
			     if pcb.hndlquit
			     then call throw_away_output;
			     call channel_manager$interrupt (devx, QUIT, ""b);
			end;
			call free_mbx (i);
		     end;


		     else if sub_mbx.op_code = send_output
		     then do;			/* is this request for output? */

			call free_mbx (i);
			if pcb.dialed
			then call process_send_output (-1, "1"b);
						/* -1 indicates no current mailbox */
		     end;


		     else if sub_mbx.op_code = accept_direct_input
		     then do;			/* check for input from terminal */

			if pcb.dialed
			then call process_accept_input;

			else do;
			     sub_mbx.io_cmd = wcd;	/* we'll tell him to hang up */
			     sub_mbx.op_code = disconnect_this_line;
			     call return_mbx (i);
			end;
		     end;

		     else if sub_mbx.op_code = error_message
		     then do;			/* error message from 355 */
			offset = bin (error_msg.data (1), 18);
						/* get which error message this is */
			if offset > 0 & offset <= hbound (dn355_messages$error_messages, 1)
			then do;
			     offset = dn355_messages$error_messages (offset);
						/* offset of message */
			     reasonp = addr (dn355_messages$error_messages);
						/* get ptr */
			     reasonp = ptr (reasonp, offset);
						/* now we have message */
			     reason_msg = dn355_reason.msg;
			end;

			else reason_msg = "unrecognized error ^o ^o ^o";

			do ix = 1 to 3;
			     full_words (ix) = bin (error_msg.data (ix + 1), 18);
			end;
			call syserr (just_tell, "dn355: Message from FNP ^a: " || reason_msg, fnp_info.fnp_tag,
			     full_words);
			call free_mbx (i);
		     end;

		     else if sub_mbx.op_code = input_in_mailbox
		     then do;
			if pcb.dialed
			then call process_input_in_mbx;
			else do;
			     sub_mbx.io_cmd = wcd;	/* tell him to give up */
			     sub_mbx.op_code = disconnect_this_line;
			     call return_mbx (i);
			end;
		     end;

		     else if sub_mbx.op_code >= first_acu_op_code & sub_mbx.op_code <= last_acu_op_code
		     then do;			/* acu failure */
			interrupt_info = bit (bin (sub_mbx.op_code, 9));
			call channel_manager$interrupt (devx, DIAL_STATUS, interrupt_info);
			call free_mbx (i);
		     end;

		     else if sub_mbx.op_code = line_status
		     then do;			/* some status from fnp */
			interrupt_info = substr (unspec (sub_mbx.command_data), 1, 72);
			call channel_manager$interrupt (devx, LINE_STATUS, interrupt_info);
			call free_mbx (i);
		     end;

		     else if sub_mbx.op_code = ack_echnego_init
		     then do;
			call free_mbx (i);
			call channel_manager$interrupt (devx, ACKNOWLEDGE_ECHNEGO_INIT, "0"b);
		     end;

		     else if sub_mbx.op_code = ack_echnego_stop
		     then do;
			call free_mbx (i);
			call channel_manager$interrupt (devx, ACKNOWLEDGE_ECHNEGO_STOP, "0"b);
		     end;

		     else if sub_mbx.op_code = line_masked
		     then do;			/* see if channel was masked */
			pcb.dialed, pcb.listen = "0"b;
			call throw_away_output;
			call syserr (just_tell,
			     "dn355: FNP masked channel ^a.h^d^[0^;^]^d for excessive interrupts", fnp_info.fnp_tag,
			     binary (sub_mbx.line_number.la_no, 3), (binary (sub_mbx.line_number.slot_no, 6) < 10),
			     binary (sub_mbx.line_number.slot_no, 6));
			call channel_manager$interrupt (devx, MASKED, ""b);
			call free_mbx (i);

		     end;

		     else do;
			call syserr (beeper, "dn355: unrecognized op code ^o with rcd from FNP ^a for devx ^o",
			     sub_mbx.op_code, fnp_info.fnp_tag, devx);
						/* someone goofed */
			call report_fnp_crash;
			return;
		     end;
		end;



		else if sub_mbx.io_cmd = rtx
		then call process_rtx;		/* check for read text */

		else do;
		     call syserr (beeper, "dn355: unrecognized io command ^o from FNP ^a for line ^o", sub_mbx.io_cmd,
			fnp_info.fnp_tag, bin (string (sub_mbx.line_number), 10));
						/* complain */
		     call report_fnp_crash;		/* give up on this FNP */
		     return;
		end;
	     end;
	end;


	if ^no_response				/* assuming we believe FNP is still there */
	then if fnp_info.count > 0
	     then call process_q;


	if no_response				/* if someone discovered that the FNP was gone */
	then call report_fnp_no_response;

	return;
     end /* process_int */;

process_q:
     proc;

/* process the queue of mailbox operations that could not be performed
   because no mailboxes wre available
*/

	q_first = fnp_info.cur_ptr;
	q_count = fnp_info.count;
	i = 1;					/* preset while variable */

	do while (q_count > 0 & i > 0);
	     i = index (used_string, "0"b);
	     if i > 0				/* now we can have one */
	     then do;
		subp = addr (datanet_mbx.dn355_sub_mbxes (i - 1));
		qptr = ptr (ttybp, q_first);
		if q_entry.pcb_offset ^= "0"b		/* for a specific channel */
		then do;
		     pcbp = ptr (ttybp, q_entry.pcb_offset);
		     string (sub_mbx.line_number) = string (pcb.line_number);
		     devx = pcb.devx;
		end;
		else string (sub_mbx.line_number) = ""b;

		if q_entry.opcode = accept_direct_output
		then if pcb.dialed
		     then call process_send_output (i - 1, "0"b);
		     else ;

		else if q_entry.opcode = set_echnego_break_table
		then if pcb.dialed
		     then call send_echo_table (i - 1, q_entry.cmd_data);
		     else ;

		else do;
		     sub_mbx.io_cmd = wcd;
		     sub_mbx.op_code = q_entry.opcode;
		     sub_mbx.cmd_data_len = divide (q_entry.cmd_count, 6, 8, 0);
		     smbx_cmd_data_long = substr (q_entry.cmd_data, 1, q_entry.cmd_count);
		     call send_mbx (i - 1);
		     fnp_info.output_control_transactions = fnp_info.output_control_transactions + 1;
		end;

		if no_response			/* give up in this case */
		then go to update_q_ptrs;

		q_first = q_entry.next;		/* on to next queue entry */
		q_count = q_count - 1;
		call tty_space_man$free_space (size (q_entry), qptr);
	     end;

	     else fnp_info.mbx_unavailable = fnp_info.mbx_unavailable + 1;
	end;

update_q_ptrs:
	fnp_info.cur_ptr = q_first;
	fnp_info.count = q_count;
	if q_count = 0
	then fnp_info.last_ptr = 0;

	return;
     end /* process_q */;

/* internal subroutine to process send output */

process_send_output:
     proc (a_mbx_num, interrupt_entry);

dcl  a_mbx_num fixed bin;				/* -1 indicates mailbox not already allocated */
dcl  mbx_num fixed bin;
dcl  interrupt_entry bit (1) aligned;			/* indicates whether or not called on interrupt side */

	mbx_num = a_mbx_num;
	if pcb.end_frame | pcb.output_mbx_pending	/* if we're waiting for form-feed  or we got delayed */
	then do;
	     pcb.flags.send_output = "1"b;		/* we'll want output eventually */
	     return;				/* don't do anything else */
	end;

	if pcb.write_first = 0
	then do;
	     pcb.flags.send_output = "1"b;		/* if no output then just set flag */
	     call channel_manager$interrupt (devx, SEND_OUTPUT, ""b);
	end;

	else do;
	     if mbx_num = -1			/* caller didn't supply one */
	     then do;
		mbx_num = index (used_string, "0"b) - 1;/* find a free one */

		if mbx_num = -1			/* still? we didn't get one */
		then do;
		     call make_q_entry (accept_direct_output, 0, ""b);
		     fnp_info.mbx_unavailable = fnp_info.mbx_unavailable + 1;
		     return;			/* we'll catch it later */
		end;
		else do;
		     subp = addr (datanet_mbx.dn355_sub_mbxes (mbx_num));
		     string (sub_mbx.line_number) = string (pcb.line_number);
		end;
	     end;


	     pcb.flags.send_output = "0"b;		/* make sure flag clear */
	     dcwlptr = addr (fnp_info.dcw_list_array_ptr -> dcw_list_array (mbx_num));

	     sub_mbx.data_addr = bit (bin (bin (rel (dcwlptr), 18) + tty_buf.absorig, 18), 18);
	     output_limit =
		max (
		min (divide ((fnp_info.bleft_355 - tc_data$fnp_buffer_threshold) * 60, output_bpart, 17, 0),
		max_chain_len * 4 * (pcb.max_buf_size - 1)), 1);

	     output_chars = 0;			/* none so far */
	     continue = "1"b;
	     do j = 1 to max_chain_len while (pcb.write_first ^= 0 & output_chars < output_limit & continue);
						/* set up dcw list */
		dcw_list (j).dcw_ptr = bit (bin (pcb.write_first + dataoff + tty_buf.absorig, 18), 18);
						/* set dcw abs addr */
		blockp = ptr (ttybp, pcb.write_first);	/* get ptr to buffer */
		if buffer.tally = 0			/* we don't want this in a dcw */
		then call syserr (crash_system, "dn355: output buffer at ^o has zero tally", pcb.write_first);

		dcw_list (j).dcw_tally = bit (buffer.tally, 9);
						/* set dcw tally from buffer */
		dcw_list (j).pad = "0"b;		/* 355 depends on this */
		pcb.write_first = buffer.next;	/* now bump to next buffer */
		pcb.write_cnt = pcb.write_cnt - buffer.tally;
						/* decrement count of chars in chain */
		output_chars = output_chars + buffer.tally;
						/* keep count of characters sent */
		if buffer.flags.end_of_page		/* if this buffer fills a page/screen */
		then do;
		     pcb.flags.end_frame = "1"b;	/* remember it */
		     continue = "0"b;		/* terminate the loop */
		end;
	     end;

	     chain_len = max (j - 1, 1);		/* this is now the length of the chain */

	     sub_mbx.word_cnt = chain_len;		/* we have maximum length dcw list */
	     sub_mbx.op_code = accept_direct_output;	/* and do not have last buffer */
	     sub_mbx.command_data (1) = "0"b;		/* make sure it starts clean */
	     sub_mbx.io_cmd = wtx;			/* set write text io command */
	     pcb.output_mbx_pending = "1"b;
	     buffer.next = 0;			/* indicate end of active write block */
	     call send_mbx (mbx_num);			/* ship sub mbx off to 355 */
	     fnp_info.output_data_transactions = fnp_info.output_data_transactions + 1;
	     lcte.meters.out_bytes = lcte.meters.out_bytes + output_chars;
						/* meter */

	     if /* tree */ pcb.write_first = 0
	     then do;				/* see if we ran out of buffers */
		pcb.write_last = 0;			/* zero ptr to last */
		if interrupt_entry
		then call channel_manager$interrupt (devx, SEND_OUTPUT, ""b);
						/* wakeup the user */
	     end;
	     else if chain_len < max_chain_len & ^pcb.flags.end_frame
						/* must have stopped because there wasn't enough space */
		then fnp_info.fnp_space_restricted_output = fnp_info.fnp_space_restricted_output + 1;
	end;

	return;					/* and return to caller */
     end;

/* internal subroutine to process set_echnego_break_table operation */

/* Because the echo table is 8 words long, it won't fit in a sub_mbx, so we
   have to send the FNP the address so it can read the table. To avoid extra
   storage overhead, and the necessity of freeing storage when the operation
   completes, the table is put in the dcw_list area corresponding to the mailbox. */

send_echo_table:
     procedure (mbx_num, table_bits);

dcl  mbx_num fixed bin;
dcl  table_bits bit (8 * 36);

dcl  table_ptr pointer;
dcl  bits_to_send bit (8 * 36) based;

	if ^pcb.dialed
	then return;
	table_ptr = addr (fnp_info.dcw_list_array_ptr -> dcw_list_array (mbx_num));
	table_ptr -> bits_to_send = table_bits;
	sub_mbx.op_code = set_echnego_break_table;
	sub_mbx.io_cmd = wcd;
	sub_mbx.data_addr = bit (bin (bin (rel (table_ptr), 18) + tty_buf.absorig, 18), 18);
	sub_mbx.word_cnt = 8;

	call send_mbx (mbx_num);
	fnp_info.output_control_transactions = fnp_info.output_control_transactions + 1;
	return;
     end send_echo_table;

/* internal procedure to respond to accept_input mailbox */

process_accept_input:
     proc;

dcl  tally fixed bin;
dcl  buf_size fixed bin;
dcl  prev_blockp ptr;

	input_count = input_sub_mbx.n_chars;		/* get char count */
	j = divide (input_count + 3, 4, 17, 0);		/* compute number of words of circular buffer needed */

	if enough_input_space (j) & pcb.read_first = 0
	then do;
	     do k = 1 to input_sub_mbx.n_buffers;
		tally = input_sub_mbx.dcw (k).tally;
		buf_size = 16 * divide (tally + 67, 64, 17, 0);
						/* get next higher multiple of 16 words */
		call tty_space_man$get_buffer (devx, buf_size, INPUT, blockp);
		if blockp = null ()			/* couldn't get the space */
		then do;
		     if pcb.read_first ^= 0		/* if we started building a chain */
		     then call tty_space_man$free_chain (devx, INPUT, ptr (ttybp, pcb.read_first));
		     pcb.read_first = 0;
		     go to reject;
		end;

		if pcb.read_first = 0
		then pcb.read_first = bin (rel (blockp));
		else prev_blockp -> buffer.next = bin (rel (blockp));

		buffer.tally = tally;
		input_sub_mbx.dcw (k).abs_addr =
		     bit (bin (tty_buf.absorig + bin (rel (addr (buffer.chars))), 24), 24);
						/* point DCW at data portion of buffer */
		prev_blockp = blockp;
	     end;

	     pcb.read_last = bin (rel (blockp));

	     sub_mbx.op_code = input_accepted;		/* inform 355 that we will take input now */
	     sub_mbx.io_cmd = rtx;
	     call return_mbx (i);
	end;

	else do;
reject:
	     sub_mbx.io_cmd = wcd;
	     sub_mbx.op_code = reject_request_temp;	/* inform 355 that we can not accept input
						   at the present time */
	     call return_mbx (i);
	     fnp_info.input_reject_count = fnp_info.input_reject_count + 1;
	     call channel_manager$interrupt (devx, INPUT_REJECTED, ""b);
	end;

     end /* process_accept_input */;

/* internal proc to process rtx */
process_rtx:
     proc;

dcl  real_word_cnt fixed bin;
dcl  n_words fixed bin;
dcl  buf_size fixed bin;
dcl  source_ptr ptr;
dcl  target_ptr ptr;

	fnp_info.input_data_transactions = fnp_info.input_data_transactions + 1;
	real_word_cnt = input_sub_mbx.n_chars;
	lcte.meters.in_bytes = lcte.meters.in_bytes + real_word_cnt;
	rtx_info.break_char = substr (input_sub_mbx.command_data, 18, 1);
	call check_ff ("0"b);			/* see if input ends with a form feed */
	input_count = real_word_cnt;
	if input_count ^= 0				/* must have been a single FF that we discarded */
	then do;
	     rtx_info.output_in_fnp = substr (input_sub_mbx.command_data, 17, 1);
	     rtx_info.output_in_ring_0 = (pcb.write_first ^= 0);
	     rtx_info.input_count = input_count;
	     rtx_info.chain_head = bit (pcb.read_first, 18);
	     rtx_info.chain_tail = bit (pcb.read_last, 18);
	     interrupt_info = unspec (rtx_info);
	     call channel_manager$interrupt (devx, ACCEPT_INPUT, interrupt_info);
	end;

	else call tty_space_man$free_chain (devx, INPUT, ptr (ttybp, pcb.read_first));

	pcb.read_first, pcb.read_last = 0;

	call free_mbx (i);

	return;					/* and return to caller */

process_input_in_mbx:
     entry;

/* we will copy input directly from mailbox into one buffer (if possible) */

	numchars = fnp_sub_mbx.n_chars;
	rtx_info.break_char = substr (fnp_sub_mbx.command_data, 18, 1);
	call check_ff ("1"b);
	if numchars > 0
	then do;
	     n_words = divide (numchars + 3, 4, 17, 0);
	     if enough_input_space (n_words)
	     then do;
		buf_size = 16 * (divide (n_words + 17, 16, 17, 0));
						/* get next multiple of 16 words */
		call tty_space_man$get_buffer (devx, buf_size, INPUT, blockp);
		if blockp = null
		then go to not_enough_space;

		source_ptr = addr (fnp_sub_mbx.input_data);
		target_ptr = addr (buffer.chars);
		target_ptr -> chars = source_ptr -> chars;
		buffer.tally = numchars;
		rtx_info.output_in_fnp = substr (fnp_sub_mbx.command_data, 17, 1);
		rtx_info.output_in_ring_0 = (pcb.write_first ^= 0);
		rtx_info.input_count = numchars;
		rtx_info.chain_head, rtx_info.chain_tail = rel (blockp);
						/* only one buffer */
		lcte.meters.in_bytes = lcte.meters.in_bytes + numchars;
		interrupt_info = unspec (rtx_info);
		call channel_manager$interrupt (devx, ACCEPT_INPUT, interrupt_info);
		call free_mbx (i);
	     end;

	     else do;				/* space test failed */
not_enough_space:
		sub_mbx.io_cmd = wcd;		/* tell him we can't take it */
		sub_mbx.op_code = reject_request_temp;
		call return_mbx (i);
		call channel_manager$interrupt (devx, INPUT_REJECTED, ""b);
	     end;
	end;

	else call free_mbx (i);			/* nothing there except form_feed */
	return;

check_ff:
	proc (in_mbx);				/* internal procedure to check input for form-feed */

dcl  in_mbx bit (1);

	     rtx_info.formfeed_present = "0"b;		/* for now */
	     if pcb.sync_line			/* form feeds not interesting in this case */
	     then return;

	     if in_mbx
	     then do;
		bufp = addr (fnp_sub_mbx.input_data);
		chars_left = numchars;
	     end;

	     else do;
		blockp = ptr (ttybp, pcb.read_last);
		chars_left = buffer.tally;
		bufp = addr (buffer.chars);
	     end;

	     if substr (bufp -> input_chars, chars_left, 1) = form_feed
						/* yup, input ends with FF */
	     then rtx_info.formfeed_present = "1"b;
	     if pcb.flags.end_frame & rtx_info.break_char /* time to restart suspended output */
	     then do;
		if (chars_left <= 2)
		then if verify (substr (bufp -> input_chars, 1, chars_left), ff_cr_lf) = 0
		     then do;			/* this input is just to restart output, discard it */
			if in_mbx
			then numchars = 0;
			else real_word_cnt = 0;
		     end;
		pcb.flags.end_frame = "0"b;
		if pcb.flags.send_output		/* more output to ship */
		then if pcb.write_first ^= 0		/* it's waiting in tty_buf */
		     then call make_q_entry (accept_direct_output, 0, ""b);
						/* we'll get to it shortly */
		     else call channel_manager$interrupt (devx, SEND_OUTPUT, ""b);
	     end;

	end /* check_ff */;

     end /* process_rtx */;

/* internal proc to check if this channel can have input space */

enough_input_space:
     proc (count) returns (bit (1));

dcl  count fixed bin;

	lctp = tty_buf.lct_ptr;
	chan_lctep = addr (lct.lcte_array (devx));
	return (chan_lctep -> lcte.input_words + count <= divide (tty_buf.bleft, input_bpart, 17, 0));
     end /* enough_input_space */;


/* internal proc to put an element onto delay queue */

make_q_entry:
     proc (opc, cnt, databits);

dcl  (opc, cnt) fixed bin (8),			/* parameters */
     databits bit (8 * 36);

	call tty_space_man$get_space (size (q_entry), new_qp);
	if new_qp = null
	then do;
	     call syserr (crash_system, "dn355: unable to allocate block for delay queue");
	     return;
	end;

	new_qrel = bin (rel (new_qp));
	if fnp_info.cur_ptr = 0			/* nothing in the queue yet */
	then fnp_info.cur_ptr = new_qrel;
	else do;
	     qptr = ptr (ttybp, fnp_info.last_ptr);
	     q_entry.next = new_qrel;			/* make the preceding entry point to the new one */
	end;

	fnp_info.last_ptr = new_qrel;
	qptr = new_qp;
	fnp_info.count = fnp_info.count + 1;
	fnp_info.q_entries_made = fnp_info.q_entries_made + 1;

	q_entry.opcode = opc;			/* set q element op code */
	q_entry.cmd_count = cnt;			/* and command count */
	if pcbp ^= null ()
	then q_entry.pcb_offset = rel (pcbp);
	else q_entry.pcb_offset = "0"b;
	q_entry.next = 0;
	q_entry.cmd_data = databits;			/* move data to q element */
	return;					/* return to caller */
     end;

/* internal procedure to derive devx & PCB pointer from mailbox line number */

get_line_number:
     proc;

dcl  x fixed bin;

	if string (sub_mbx.line_number) = "0"b
	then do;					/* some type of global request */
	     do x = 1 to hbound (global_opcodes, 1) while (sub_mbx.op_code ^= global_opcodes (x));
	     end;					/* make sure it really is */
	     if x > hbound (global_opcodes, 1)
	     then do;				/* else can the FNP */
		call syserr (beeper, "dn355: line number of 0 with non-global opcode in submbx ^o, FNP ^a", i,
		     fnp_info.fnp_tag);
		call report_fnp_crash;
		go to global_exit;
	     end;

	     pcbp = null;
	     devx = -1;
	end;

	else do;
	     n_pcbs = fnp_info.no_of_channels;
	     if string (sub_mbx.line_number) = TANDD_LINE_NUMBER
						/* don't decode this, go straight to it */
	     then pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (fnp_info.tandd_pcbx));
	     else do;
		lano = sub_mbx.line_number.la_no;	/* get line adapter number for devx lookup */
		if sub_mbx.is_hsla
		then j = fnp_info.hsla_idx (fixed (lano));
		else j = fnp_info.lsla_idx (fixed (lano));
						/* get starting position */
		do j = j to n_pcbs;			/* loop thru devx table */
		     pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (j));
		     if string (pcb.line_number) = string (sub_mbx.line_number)
		     then go to match;		/* check for right slot */
		end;
		call syserr (beeper, "dn355: no slot number match for sub mbx ^o, FNP ^a", i, fnp_info.fnp_tag);
						/* bitch */
		call report_fnp_crash;
		go to global_exit;
	     end;

match:
	     devx = pcb.devx;			/* copy devx to automatic */

	end;
	return;

     end /* get_line_number */;


/* internal procedure to ship sub mbx off to 355 */
send_mbx:
return_mbx:
     proc (a_mbx_no);

dcl  a_mbx_no fixed bin;
dcl  mbx_no fixed bin;
dcl  pcw_error bit (1);
dcl  timeout_time fixed bin (71);
dcl  1 ima aligned like io_manager_arg;

	mbx_no = a_mbx_no;
	go to test_pcw;

free_mbx:
     entry (a_mbx_no);				/* this for those which haven't been rewritten */

	mbx_no = a_mbx_no + 4;			/* use different interrupt level for freeing */

test_pcw:
	if ^fnp_info.io_manager_assigned
	then do;
	     no_response = "1"b;			/* lie, but effectively */
	     return;
	end;

	no_response = "0"b;
	if datanet_mbx.dia_pcw.command ^= "0"b
	then do;					/* first a quick check to save time */
wait_for_response:
	     timeout_time = clock () + TWO_SECONDS;
	     do while ((clock () < timeout_time) & (datanet_mbx.dia_pcw.command ^= "0"b));
						/* loop until dia picks up last command */
	     end;
	     if datanet_mbx.dia_pcw.error | datanet_mbx.dia_pcw.command ^= "0"b
	     then do;
		if ^no_response
		then do;
		     pcw_error = datanet_mbx.dia_pcw.error;
		     no_response = "1"b;
		     datanet_mbx.dia_pcw.error = "0"b;
		     string (datanet_mbx.dia_pcw) = dn355_util$compute_parity (string (datanet_mbx.dia_pcw));
						/* recompute parity */
		     ima.chx = fnp_info.io_manager_chx;
		     ima.ptp = fnp_info.ptp;
		     call io_manager$connect_direct (ima);
						/* re-kick FNP */
		     call syserr (just_tell,
			"dn355: ^[Error^;Timeout^] sending mailbox interrupt to FNP ^a, will retry.", pcw_error,
			fnp_info.fnp_tag);
		     goto wait_for_response;
		end;
	     end;
	     else goto send_new_connect;
	end;
	else do;
send_new_connect:
	     no_response = "0"b;

	     if mbx_no < 8				/* one of ours */
	     then do;
		datanet_mbx.mbx_used_flags.used (mbx_no) = "1"b;
		datanet_mbx.num_in_use = datanet_mbx.num_in_use + 1;
		fnp_info.max_mbx_in_use = max (fnp_info.max_mbx_in_use, datanet_mbx.num_in_use);
		fnp_info.cumulative_mbx_in_use = fnp_info.cumulative_mbx_in_use + datanet_mbx.num_in_use;
		fnp_info.mbx_in_use_updated = fnp_info.mbx_in_use_updated + 1;
	     end;					/* set used flag */
	     string (datanet_mbx.dia_pcw) = initial_pcw;	/* initialize pcw */
	     datanet_mbx.dia_pcw.mbx_no = bit (fixed (mbx_no, 6), 6);
						/* set sub mbx number */

	     string (datanet_mbx.dia_pcw) = dn355_util$compute_parity (string (datanet_mbx.dia_pcw));
						/* set the parity bit; bit 22 */

	     ima.chx = fnp_info.io_manager_chx;
	     ima.ptp = fnp_info.ptp;
	     call io_manager$connect_direct (ima);	/* kick 355 */

	     return;				/* return to caller */
	end;
     end send_mbx;

/* entry and internal proc to hangup all lines on an FNP */

hangup_fnp_lines:
     entry (a_fnp_no);

dcl  a_fnp_no fixed bin;

	ttybp = addr (tty_buf$);
	infop = addr (dn355_data$);
	call hangup_fnp (a_fnp_no);
	return;


hangup_fnp:
     proc (fnp_no);

dcl  fnp_no fixed bin;

	fnpp = addr (datanet_info.per_datanet (fnp_no));
	n_pcbs = fnp_info.no_of_channels;
	do j = 1 to n_pcbs;
	     pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (j));
	     if pcb.dialed
	     then do;
		call throw_away_output;
		call channel_manager$interrupt ((pcb.devx), CRASH, ""b);
	     end;
	end;

	if fnp_info.count > 0			/* get rid of any outstanding delay queue entries */
	then do;
	     q_count = fnp_info.count;
	     q_first = fnp_info.cur_ptr;
	     do q_count = q_count to 0 by -1 while (q_first ^= 0);
		qptr = ptr (ttybp, q_first);		/* get real pointer to queue entry */
		q_first = qptr -> q_entry.next;	/* save pointer to next one */
		call tty_space_man$free_space (size (q_entry), qptr);
	     end;

	     fnp_info.count, fnp_info.cur_ptr, fnp_info.last_ptr = 0;
	end;

     end;



throw_away_output:
     proc;

/* throws away pending write chain on quit and hangup */

	if pcb.write_first ^= 0
	then do;
	     call tty_space_man$free_chain ((pcb.devx), OUTPUT, ptr (ttybp, pcb.write_first));
	     pcb.write_first, pcb.write_last, pcb.write_cnt = 0;

	end;

	pcb.end_frame = "0"b;

	return;
     end /* throw_away_output */;

/* internal procedure to report that DIA never set PCW to 0 */

report_fnp_no_response:
     proc;

	call syserr (beeper, "dn355: FNP ^a did not respond to mailbox interrupt", fnp_info.fnp_tag);
	call report_fnp_crash;			/* treat it like a crash */
	return;

     end /* report_fnp_no_response */;


/* internal procedure to tell initializer and clean up when FNP crashes */

report_fnp_crash:
     proc;

	fnp_info.running = "0"b;			/* it isn't any more */
	if fnp_info.dump_patch_in_progress		/* somebody's waiting for this */
	then call pxss$notify (FNP_DUMP_PATCH_EVENT);	/* don't let them wait forever */

	if ^fnp_info.bootloading			/* if we weren't still loading it */
	then					/* now report hangups for all lines that were dialed to it */
	     call hangup_fnp (dno);
	else fnp_info.bootloading = "0"b;

	auto_fnp_msg.state = FNP_DOWN;		/* tell the responsible process */
	auto_fnp_msg.fnp_no = dno;
	auto_fnp_msg.flags = "0"b;
	unspec (fnp_event_message) = unspec (auto_fnp_msg);
	call pxss$ring_0_wakeup (fnp_info.boot_process_id, fnp_info.boot_ev_chan, fnp_event_message, 0);

	return;

     end report_fnp_crash;
check_lock:
     proc;

/* the cleanup procedure -- makes sure we don't crawl out with lock set */

	if queue_locked
	then call syserr (crash_system, "dn355: attempted crawlout with FNP queue locked");

	else if masked
	then call pmut$unwire_unmask (wire_arg, wire_ptr);/* it's probably too late, but just in case */

	return;
     end check_lock;
%page;
/* Main program declarations */

dcl  (dcwlptr, bufp, qptr) ptr,			/* random pointers used */
     timw fixed bin (24),				/* local slot for mailbox timw */
     (level, dno, i, ix, q_first, q_count, chars_left, numchars, k, j, chain_len) fixed bin,
						/* random halfwords used */
     devx fixed bin,				/* index of current channel */
     operation fixed bin (8),				/* local slot for delay queue operation */
     lano bit (3) unal;				/* local slot for line number */
dcl  fnp_name char (1) aligned;			/* for syserr calls */

dcl  no_response bit (1) aligned;			/* set by send_mbx to indicate that DIA didn't respond */

dcl  interrupt_entry bit (1);				/* whether entered through dn355$interrupt */

dcl  input_count fixed bin;				/* count sent with accept_dir_input */

dcl  chan_lctep ptr;				/* pointer to subchannel's LCTE */
dcl  chain_head_ptr ptr;				/* pointer to output chain to be freed */
dcl  output_limit fixed bin;				/* maximum number of output chars to be sent at once */
dcl  output_chars fixed bin;				/* number of output chars sent so far */

dcl  bits_per_char fixed bin;
dcl  max_buf_chars fixed bin;				/* number of characters to go in largest buffer at this speed */

dcl  wire_arg fixed bin (71);
dcl  wire_ptr ptr;
dcl  masked bit (1);
dcl  queue_locked bit (1);
dcl  continue bit (1);				/* for premature termination of loops */

dcl  offset fixed bin;				/* offset of error message in dn355_messages */
dcl  syserr_severity fixed bin (35);

/* Codes used for syserr are declared here because syserr_constants.incl.pl1 cannot
   be used, owing to a naming conflict with mcs_interrupt_info.incl.pl1.
*/

dcl  (
     dataoff init (1),				/* offset in buffer of data */
     max_chain_len init (16),				/* maximum dcw chain length */
     just_tell init (0),				/* syserr message, no alarm */
     beeper init (3),				/* syserr ring beeper */
     log init (4),
     crash_system init (1)
     ) fixed bin int static options (constant);		/* argument to syserr */

dcl  FNP_DOWN fixed bin int static options (constant) init (2);

dcl  initial_pcw bit (36) int static init ("000000000000000000000000000000111001"b);
						/* initial dia pcw */
dcl  TANDD_LINE_NUMBER bit (10) int static options (constant) init ((10)"1"b);
						/* i.e., 1777 octal */
dcl  TWO_SECONDS fixed bin (71) int static options (constant) init (2000000);
						/* used to wait for DIA to clear PCW */

dcl  timwb (0:11) bit (1) based (addr (timw)),		/* timw as a bit array */
     used_string bit (8) based (addr (datanet_mbx.mbx_used_flags.used (0)));
						/* mailbox used flags as a bit string */

dcl  (addr, binary, substr, stac, stacq, string, ptr, rel, index, fixed, divide, bin, max, min, null, length, bit, unspec,
     hbound, size, verify, clock) builtin;		/* builtin functions used */

dcl  unal_number fixed bin (17) unal based,		/* handy way of referencing an unaligned number */
     chars char (numchars) based;			/* handy way of moving character strings */

dcl  input_chars char (chars_left) based;		/* for scanning entire input */

dcl  smbx_cmd_data_long bit (216) unaligned based (addr (sub_mbx.command_data));

dcl  tc_data$system_shutdown ext fixed bin;		/* external variables used */
dcl  tc_data$fnp_buffer_threshold ext static fixed bin;
dcl  pds$processid bit (36) aligned ext static;

dcl  ff_cr_lf char (3) int static options (constant) init ("
");

dcl  form_feed init ("") char (1) int static options (constant);

dcl  syserr entry options (variable),			/* external entries called */
     ldac entry (ptr) returns (fixed bin (24)),
     dn355_util$compute_parity entry (bit (36)) returns (bit (36)),
     (
     dn355_boot_interrupt,
     dn355_boot_interrupt$system_fault
     ) entry (fixed bin),
     pxss$ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)),
     pxss$unique_ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)),
     pxss$notify entry (fixed bin);

dcl  pmut$wire_and_mask entry (fixed bin (71), ptr);
dcl  pmut$unwire_unmask entry (fixed bin (71), ptr);
dcl  1 auto_net_event_message aligned like net_event_message;
dcl  1 auto_fnp_msg aligned like fnp_msg;
dcl  fnp_event_message fixed bin (71);

dcl  1 dcw_list (max_chain_len) aligned based (dcwlptr),	/* dcw list for output */
       2 dcw_ptr bit (18) unal,			/* pointer to buffer */
       2 pad bit (9) unal,				/* unused */
       2 dcw_tally bit (9) unal;			/* tally */

dcl  1 dcw_list_array (0:7) aligned based,
       2 dcw_list_template (max_chain_len) like dcw_list;

dcl  1 q_entry aligned like fnp_queue_entry based (qptr);

dcl  new_qp ptr;					/* temporary to newly-allocated block */
dcl  new_qrel fixed bin;

dcl  1 dn355_word unal based (addr (datanet_mbx.fault_word)),
						/* format of 355 crash word */
       2 modnum bit (4),				/* module number (1 - 8) */
       2 opcode fixed bin (4),
       2 crash_code fixed bin (8);			/* used to index list of messages */

dcl  fault_type fixed bin;				/* 355 fault code */
dcl  fault_name char (16);				/* 355 fault name */
dcl  module_num fixed bin;				/* 355 module number */

dcl  iom_channel_fault fixed bin int static init (9);
dcl  illegal_opcode fixed bin int static init (3);
dcl  die_code fixed bin int static init (9);

dcl  1 error_msg aligned based (addr (sub_mbx.command_data (1))),
						/* error message data */
       2 data (4) bit (18) unal;

dcl  full_words (3) fixed bin;

dcl  reason_msg char (64);

dcl  cleanup condition;
%page;
%include baud_rates;
%page;
%include channel_manager_dcls;
%page;
%include dn355_data;
%page;
%include dn355_mailbox;
%page;
%include dn355_messages;
%page;
%include fnp_mpx_msg_;
%page;
%include fnp_queue_entry;
%page;
%include io_manager_dcls;
%page;
%include lct;
%page;
%include line_types;
%page;
%include mailbox_ops;
%page;
%include mcs_interrupt_info;
%page;
%include net_event_message;
%page;
%include pcb;
%page;
%include tty_buf;
%page;
%include tty_buffer_block;
%page;
%include tty_space_man_dcls;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   dn355: FNP X invalid interrupt level N

   S:  $beep

   T:  $run

   M:  An FNP interrupt has been received from frontend X with an invalid
   interrupt level of octal value N and will be ignored.  If this message is
   displayed when a DN6670 is being powered up, this message can be ignored.
   If this message occurs under any other circumstances, there might be
   something wrong with the system's interface with the FNP and should be
   investigated by FE representatives.

   A:  $inform


   Message:
   dn355: emergency interrupt from FNP X: FAULT
   .br
   FNP instruction counter = IC
   .br
   channel CHN, fault status = FS
   .br
   FNP_MODULE: REASON_FOR_CRASH

   S:  $beep

   T:  $run

   M:  An emergency interrupt has been received from FNP X indicating
   it has crashed.  All lines dialed to FNP X will be hung up.  The
   crash was nominally caused by a fault of type FAULT.  Lines
   following the first line of the message appear only in certain cases
   and provide additional information about the nature of the crash.

   A:  The system will automatically attempt to reboot the crashed FNP.
   Subsequent messages will indicate the success or failure of this attempt.
   No action is required now, but action may be required if the
   automatic reboot fails.


   Message:
   dn355: no slot number match for sub mbx N, FNP X

   S:  $beeper

   T:  $run

   M:  An error has occurred processing submailbox N for FNP X.
   The submailbox indicates a line number for which no match could
   be found.

   A:  $inform


   Message:
   dn355: Message from FNP X: MESSAGE

   S:  $info

   T:  $run

   M:  An error has been detected by FNP X as explained by MESSAGE.

   A:  No action is required by the operator to deal with the error mentioned
   in the message.  Action may be required by appropriate personnel to correct
   the problem that caused the error and undo what the FNP may have done to
   continue operation.  This may require shutting down the FNP for repairs by
   Field Engineering and reboot of the FNP to restore full operation.


   Message:
   dn355: FNP masked channel NAME for excessive interrupts

   S:  $info

   T:  $run

   M:  The FNP has masked the channel whose name is NAME because it was
   generating interrupts faster than they could be handled.

   A: The interruptions can be caused by any number of problems.  This
   can be caused by the dataset leads changing too fast for the FNP
   software to handle properly; disconnecting or connecting FNP cables,
   powering off or on a hardwired terminal, a bad modem, etc.  It is
   also possible that the FNP channel hardware is defective.  Future
   attempts to use this channel may possibly crash the FNP.  CS
   representatives may need to be called to investigate.  An "attach"
   command will be necessary to put the channel back in service.


   Message:
   dn355: unrecognized op code OPCODE with rcd from FNP X for devx N

   S:  $beeper

   T:  $run

   M:  An invalid op code, OPCODE, has been received from FNP X for device
   index N in a mailbox containing an rcd (read control data) command.

   A:  $inform


   Message:
   dn355: unrecognized io command C from FNP X for line N

   S:  $beeper

   T:  $run

   M:  An invalid io command was received from FNP X for line N. C is the
   octal representation of the command.

   A:  $inform


   Message:
   dn355: output buffer at N has zero tally

   S:  $crash

   T:  $run

   M:  An output buffer with a zero tally has been found at offset N
   in the segment tty_buf.

   A:  $inform


   Message:
   dn355: unable to allocate block for delay queue

   S:  $crash

   T:  $run

   M: There was insufficient space left in tty_buf to allocate a block
   in which to build a delay queue.

   A:  $inform


   Message:
   dn355: FNP X did not respond to mailbox interrupt

   S:  $beep

   T:  $run

   M:  An attempt to interrupt FNP X was unsuccessful. The FNP is assumed
   to be down.

   A:  The system will automatically attempt to reboot the crashed FNP.
   Subsequent messages will indicate the success or failure of this attempt.
   No action is required now, but action may be required if the
   automatic reboot fails.


   Message:
   dn355: inconsistent queue lock

   S:  $crash

   T:  $run

   M:  A process attempted to unlock the interrupt queue lock without having it
   locked.

   A:  $inform


   Message:
   dn355: LCTE lock ^= processid

   S:     $crash

   T:     $run

   M:  The FNP channel lock did not contain the processid of the process
   attempting to unlock it.


   Message:
   dn355: attempted crawlout with FNP queue locked

   S:	$crash

   T:	$run

   M:	An attempt was made to crawl out while an FNP queue lock (a processor
   lock) was locked.

   A:	$inform


   Message:
   dn355: line number of 0 with non-global opcode in submbx N, FNP X

   S:  $beeper

   T:  $run

   M:  Mailbox N from FNP X contained a non-global opcode which requires a
   non-zero line number.


   Message:
   dn355: FNP X level L status S STATE

   S:   $info

   T:   $run

   M:   An interrupt at a level other than 3 (or possibly at level 3 if the
   FNP is not running) was received from FNP X. S is an octal representation
   of the status accompanying the interrupt. STATE indicates the current state
   of the FNP: running, bootloading, or in T&D. This message only appears if
   tracing is enabled for the specified FNP.

   A:   None required.


   Message:
   dn355: Error sending mailbox interrupt to FNP X, will retry.

   S:  $info

   T:  $run

   M:  An error has been detected in the transmission of a mailbox interrupt
   to the FNP.  The transmission will be retried once.

   A:  None required.


   Message:
   dn355: Timeout sending mailbox interrupt to FNP X, will retry.

   S:  $info

   T:  $run

   M:  The FNP did not respond within 2 seconds to the previously
   sent mailbox interrupt.  The transmission will be retried once.

   A:  None required.


   END MESSAGE DOCUMENTATION */


     end dn355;




		    dn355_boot_interrupt.pl1        11/11/89  1132.7r w 11/11/89  0824.9       79146



/****^  ***********************************************************
        *                                                         *
        * 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(86-06-05,GJohnson), approve(86-06-05,MCR7387),
     audit(86-06-10,Martinson), install(86-07-11,MR12.0-1091):
     Correct error message documentation.
                                                   END HISTORY COMMENTS */


/* format: style4,delnl,insnl,ifthenstmt,indnoniterend,indcomtxt */
dn355_boot_interrupt:
     proc (a_fnp_no);

/* This procedure is called by dn355 when it receives an interrupt from an FNP
   *  whose "bootloading" flag is on. This program interprets the bootload status
   *  and wakes up the process that initiated the bootload to inform it of the results
   *  of the bootload.
   *
   *  Written 5/19/76 by Robert S. Coren
   *  Modified 79 June 8 by Art Beattie to handle new config_messages.
   *  Modified 08/26/80 by Robert Coren to ignore spurious bootload interrupts.
   *  Modified 07/14/83 BIM to remove the $emergency entrypoint -- all
   *            its work is done elsewhere. Also assumed that all unwiring
   *            will be done by fnp_util$abort when called from
   *            user ring upon notification of boot failure.
   *  Modified 1984-07-27 BIM for system_fault entrypoint.
*/


/* PARAMETER */

dcl  a_fnp_no fixed bin;


/* AUTOMATIC */

dcl  fnp_no fixed bin;
dcl  astep ptr;
dcl  fnp_tag char (1);
dcl  igcode fixed bin (35);
dcl  stat_ptr ptr;
dcl  major fixed bin;
dcl  sub_stat fixed bin;
dcl  event_message fixed bin (71);			/* event message used to report result */
dcl  offset fixed bin;


/* ENTRIES */

dcl  syserr options (variable);
dcl  pxss$ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));

/* BASED */

dcl  fb fixed bin (35) based;

dcl  1 fnp_boot_status aligned based (stat_ptr),		/* structure of bootload status */
       2 real_status bit (1) unaligned,			/* must be "1"b in valid status */
       2 pad1 bit (2) unaligned,
       2 major_status bit (3) unaligned,
       2 pad2 bit (3) unaligned,
       2 substatus fixed bin (8) unal,			/* code set by 355, only interesting if major_status is 4 */
       2 channel_no fixed bin (17) unaligned;		/* channel no. of LSLA in case of config error */


/* INTERNAL STATIC CONSTANTS */

dcl  TELL fixed bin int static options (constant) init (0); /* code for syserr -- print on console only */
dcl  BOOTLOAD_OK fixed bin int static options (constant) init (0);
dcl  CHECKSUM_ERROR fixed bin int static options (constant) init (1);
dcl  READ_ERROR fixed bin int static options (constant) init (2);
dcl  GICB_ERROR fixed bin int static options (constant) init (3);
dcl  INIT_ERROR fixed bin int static options (constant) init (4);
dcl  UNWIRE_STATUS fixed bin int static options (constant) init (5);
dcl  MAX_STATUS fixed bin int static options (constant) init (5);

dcl  FNP_UP fixed bin int static options (constant) init (4);
dcl  FNP_DOWN fixed bin int static options (constant) init (2);


/* BUILTINS */

dcl  (addr, bin, hbound, max, ptr, substr) builtin;


/* INCLUDE FILES */

%include dn355_messages;

%include dn355_data;

%include dn355_mailbox;

%include fnp_mpx_msg_;



	fnp_no = a_fnp_no;
	infop = addr (dn355_data$);
	fnpp = addr (datanet_info.per_datanet (fnp_no));
	mbxp = fnp_info.mbx_pt;
	fnp_msg_ptr = addr (event_message);
	fnp_tag = fnp_info.fnp_tag;

	fnp_msg.fnp_no = fnp_no;

	stat_ptr = addr (datanet_mbx.crash_data);	/* this is where bootload status goes */

	if ^fnp_boot_status.real_status		/* bad news, status is not for real */
	then do;
	     call syserr (TELL, "Invalid bootload interrupt for FNP ^a, status ^w", fnp_tag, stat_ptr -> fb);
	     go to down;
	     end;

	major = bin (fnp_boot_status.major_status, 3);	/* get major status */
	/*** BOOTLOAD_OK now comes in for WIRED fnp's, since unwiring is done
	     by user ring in response to bootload completion, or on timeout. */

	if major < 0 | major > MAX_STATUS then do;
	     call syserr (TELL, "Unrecognized bootload status ^w for FNP ^a", stat_ptr -> fb, fnp_tag);
	     go to down;
	     end;

	if major = UNWIRE_STATUS then return;		/* this was just to tell us I/O was finished */

	offset = dn355_messages$boot_messages (major);	/* get message describing major status */
	reasonp = ptr (addr (dn355_messages$boot_messages), offset);
	call syserr (TELL, dn355_reason.msg, fnp_tag);

	if major = INIT_ERROR			/* more info in this case */
	then do;
	     sub_stat = max (0, fnp_boot_status.substatus);
	     if sub_stat > hbound (dn355_messages$config_messages, 1) then sub_stat = 0;

	     offset = dn355_messages$config_messages (sub_stat);
	     reasonp = ptr (addr (dn355_messages$config_messages), offset);
	     call syserr (TELL, dn355_reason.msg, fnp_boot_status.channel_no - 9, stat_ptr -> fb);
	     end;

	if major = BOOTLOAD_OK			/* good news */
	then do;
	     fnp_msg.state = FNP_UP;
	     fnp_info.running = "1"b;
	     end;

	else do;					/*  bad news */
down:
	     call syserr (TELL, "FNP ^a not loaded.", fnp_tag);
	     fnp_msg.state = FNP_DOWN;
	     end;

/* now tell process that started bootload */

	fnp_info.bootloading = "0"b;			/* done now */
	call pxss$ring_0_wakeup (fnp_info.boot_process_id, fnp_info.boot_ev_chan, event_message, igcode);

	return;

system_fault:
     entry (a_fnp_no);
	fnp_no = a_fnp_no;
	infop = addr (dn355_data$);
	fnpp = addr (datanet_info.per_datanet (fnp_no));
	mbxp = fnp_info.mbx_pt;
	fnp_msg_ptr = addr (event_message);
	fnp_tag = fnp_info.fnp_tag;

	fnp_msg.fnp_no = fnp_no;

	stat_ptr = addr (datanet_mbx.crash_data);	/* this is where bootload status goes */
	go to down;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   Invalid bootload interrupt for FNP X, status N

   S:	$info

   T:	When bootloading an FNP

   M:	The FNP responded to the bootload attempt with an interrupt, but the high-order
   bit of the reported status was not on. N is the reported status (in octal).

   A:	$inform


   Message:
   Unrecognized bootload status N for FNP X

   S:	$info

   T:	When bootloading an FNP

   M:	The status reported by an FNP in response to a bootload attempt was not one of the ones
   recognized. N is the reported status (in octal).

   A:	$inform


   Message:
   FNP X loaded successfully

   S:	$info

   T:	When bootloading an FNP

   M:	The FNP bootload has completed successfully.

   A:	This message is for informational purposes only.


   Message:
   checksum error in core image for FNP X

   S:	$info

   T:	When bootloading an FNP

   M:	The core image received for loading in the FNP had a checksum error.

   A:	Try to load the FNP again. If the error recurs, either the DIA hardware
   is failing, or the core image in the Multics hierarchy is damaged. In the
   latter case, the core image must be rebound.


   Message:
   error reading core image for FNP X

   S:	$info

   T:	When bootloading an FNP

   M:	An I/O error was detected by the FNP bootload program while attempting to read
   the core image into FNP memory. A hardware failure of either the DIA or the Multics IOM is indicated.

   A:	Try the FNP load again. If it fails again, consult Field Engineering.


   Message:
   configuration error reported by bootloading program for FNP X

   S:	$info

   T:	When bootloading an FNP

   M:	The FNP bootload program, gicb, found an inconsistency in the FNP configuration.

   A:	$inform


   Message:
   configuration error reported by FNP X: DETAILS

   S:	$info

   T:	When bootloading an FNP

   M:	The FNP initialization program detected an error or inconsistency in
   the FNP configuration.  DETAILS is a more specific description of the error.

   A:	If possible, correct the error, either by updating the CDT to reflect the
   actual configuration, or recabling the FNP. If the error cannot be corrected
   or is not understood, inform the systems programming staff.


   Message:
   FNP X not loaded.

   S:	$info

   T:	When bootloading an FNP

   M:	The attempted bootload was not successful. This message is always preceded by one of the
   above error messages.

   A:	This message is for informational purposes only.

   END MESSAGE DOCUMENTATION */

     end /* dn355_boot_interrupt */;




		    dn355_messages.alm              11/11/89  1132.7rew 11/11/89  0825.4       76734



" ***********************************************************
" *                                                         *
" * 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.      *
" *                                                         *
" ***********************************************************
	name	dn355_messages
	segdef	fault_names
	segdef	per_module
	segdef	error_messages
	segdef	boot_messages
	segdef	config_messages


"
"			a comment 'h' after a message means it may indicate
"			a hardware error

per_module:
	aci	'scheduler   '
	zero	0,sked_messages

	aci	'dia_man     '
	zero	0,dia_messages

	aci	'interpreter '
	zero	0,intp_messages

	aci	'utilities   '
	zero	0,util_messages

	aci	'lsla_man    '
	zero	0,lsla_messages

	aci	'hsla_man    '
	zero	0,hsla_messages

	aci	'console_man '
	zero	0,cons_messages

	aci	'trace       '
	zero	0,trac_messages

	aci	'init        '
	zero	0,init_messages



sked_messages:
	zero	0,sked_1
	zero	0,sked_2

dia_messages:
	zero	0,dia_1
	zero	0,dia_2
	zero	0,dia_3
	zero	0,dia_4
	zero	0,dia_5
	zero	0,dia_6
	zero	0,dia_7
	zero	0,dia_8
	zero	0,dia_9
	zero	0,dia_10
	zero	0,dia_11
	zero	0,dia_12
	zero	0,dia_13
	zero	0,dia_14
	zero	0,dia_15
	zero	0,dia_16
	zero	0,dia_17
	zero	0,dia_18
	zero	0,dia_19
	zero	0,dia_20
	zero	0,dia_21
	zero	0,dia_22


intp_messages:
	zero	0,intp_1
	zero	0,intp_2
	zero	0,intp_3
	zero	0,intp_4
	zero	0,intp_5
	zero	0,intp_6
	zero	0,intp_7
	zero	0,intp_8
	zero	0,intp_9
	zero	0,intp_10
	zero	0,intp_11
	zero	0,intp_12
	zero	0,intp_13
	zero	0,intp_14
	zero	0,intp_15
	zero	0,intp_16
	zero	0,intp_17
	zero	0,dia_10


util_messages:
	zero	0,util_1
	zero	0,util_2
	zero	0,util_3
	zero	0,util_4
	zero	0,util_5
	zero	0,util_6
	zero	0,intp_7
	zero	0,util_8
	zero	0,util_9
	zero	0,util_10
	zero	0,util_11
	zero	0,util_12
	zero	0,util_13
	zero	0,util_14


lsla_messages:
	zero	0,lsla_1
	zero	0,util_8
	zero	0,util_9
	zero	0,lsla_4
	zero	0,lsla_5
	zero	0,intp_6
	zero	0,intp_7
	zero	0,lsla_8
	zero	0,lsla_9
	zero	0,dia_10
	zero	0,lsla_11


hsla_messages:
	zero	0,hsla_1
	zero	0,hsla_2
	zero	0,hsla_3
	zero	0,hsla_4
	zero	0,hsla_5
	zero	0,hsla_6
	zero	0,hsla_7
	zero	0,hsla_8
	zero	0,dia_10
	zero	0,hsla_10
	zero	0,no_message
	zero	0,hsla_12
	zero	0,hsla_13


cons_messages:
	zero	0,no_message


trac_messages:
	zero	0,dia_10


init_messages:
	zero	0,dia_10
	zero	0,init_2
	zero	0,init_3
	zero	0,init_4
	zero	0,init_5
	zero	0,init_6
	zero	0,no_message
	zero	0,init_8
	zero	0,init_9
	zero	0,init_10
	zero	0,init_11
	zero	0,init_12
	zero	0,init_13
	zero	0,init_14
	zero	0,init_15


sked_1:	acc	'no buffers for delay queue'
sked_2:	acc	'attempt to run missing routine'


dia_1:	acc	'mailbox wraparound queue full'
dia_2:	acc	'unrecoverable i/o error'	h
dia_3:	acc	'more than 5 consecutive i/o errors'	h
dia_4:	acc	'invalid value for tcw'
dia_5:	acc	'mailbox queue count < 0'
dia_6:	acc	'invalid mailbox number in wraparound queue'
dia_7:	acc	'3 consecutive mailbox checksum errors'	h
dia_8:	acc	'op-code not valid for i/o command'
dia_9:	acc	'rcd processed with no queue entries'
dia_10:	acc	'buffer allocation failed'
dia_11:	acc	'last buffer in input chain lacks "last" flag'
dia_12:	acc	'tally for rtx too small'
dia_13:	acc	'tally for rtx too large'
dia_14:	acc	'attempt to lock already locked dia'
dia_15:	acc	'attempt to unlock already unlocked dia'
dia_16:	acc	'rtx in mailbox, next queue element not accept input'
dia_17:	acc	'unrecognized i/o command'
dia_18:	acc	'no dia configured'
dia_19:	acc	'accept input when no input chain'
dia_20:	acc	'attempt to chain to invalid output chain'
dia_21:	acc	'input buffer had zero tally'
dia_22:	acc	'no entry for line in tib list'


intp_1:	acc	'x1 = 0 at entry'
intp_2:	acc	't.cur = 0 at entry'
intp_3:	acc	'called when not at wait block'
intp_4:	acc	'type not of form 777xxx'
intp_5:	acc	'tried to execute status block'
intp_6:	acc	'unrecognized sub-op in dcw list'
intp_7:	acc	'outmsg not followed by output_end'
intp_8:	acc	'unrecognized op block'
intp_9:	acc	'started block check while check in progress'
intp_10:	acc	'compare block check without start block check'
intp_11:	acc	'unrecognized scan type'
intp_12:	acc	't.type <= 0'
intp_13:	acc	'error in use of calsub, retsub op blocks'
intp_14:	acc	'error in use of getext, retext op blocks'
intp_15:	acc	'error in scan control string'
intp_16:	acc	'invalid sub-op list to config op'
intp_17:	acc	'replay attempted with active output chain'


util_1:	acc	'buffer of size <= 0 requested'
util_2:	acc	'buffer of more than max size requested'
util_3:	acc	'tried to free buffer with address < .crbuf'
util_4:	acc	'tried to free space already free'
util_5:	acc	'address in block pointer too large'
util_6:	acc	'invalid interrupt vector'
util_8:	acc	'kybd/prtr addressing with control set'
util_9:	acc	'unrecognized type in output sub-op'
util_10:	acc	'could not allocate buffer for output'
util_11:	acc	't.olst -> buffer has forward pointer'
util_12:	acc	'free block size too large'
util_13:	acc	'attempt to append output to single-message chain'
util_14:	acc	'attempt to move data with an invalid address'


hsla_1:	acc	'attempt to modify loc < 1000(8)'
hsla_2:	acc	'config op is invalid for channel'
hsla_3:	acc	'read tally started with active input chain'
hsla_4:	acc	'receive transfer timing error'	h
hsla_5:	acc	'input tally runout'
hsla_6:	acc	'unable to find cct for modes requested'
hsla_7:	acc	'xmit transfer timing error'	h
hsla_8:	acc	'hdcw called with no dcw list'
hsla_10:	acc	'no sfcm addr for line'
hsla_12:	acc	'houtav called with bad chain'
hsla_13:	acc	'invalid hsla status'


lsla_1:	acc	'not in xmit mode after output sub-op'
lsla_4:	acc	'more than 10 successive re-sync attempts'
lsla_5:	acc	'send transfer timing error'	h
lsla_8:	acc	'unrecognized receive status'
lsla_9:	acc	'input icw status does not agree with flag'
lsla_11:	acc	'output icw status does not agree with flag'


no_message:
	acc	'unrecognized error code'



fault_names:
	aci	'none            '
	aci	'power on        '
	aci	'memory parity   '
	aci	'illegal opcode  '
	aci	'overflow        '
	aci	'store fault     '
	aci	'divide check    '
	aci	'illegal int     '
	aci	'extraneous int  '
	aci	'iom chan fault  '
	aci	'console abort   '


error_messages:
	zero	0,msg1
	zero	0,msg2
	zero	0,msg3
	zero	0,msg4
	zero	0,msg5
	zero	0,msg6
	zero	0,msg7
	zero	0,msg8
	zero	0,msg9
	zero	0,msg10

msg1:	acc	'FNP iom channel fault, channel ^o, fault status ^6w'	h
msg2:	acc	'dia i/o error, status ^6w ^6w'	h
msg3:	acc	'abnormal lsla status ^6w ^6w'	h
msg4:	acc	'excessive hsla interrupts, line ^o, attempting recovery'	h
msg5:	acc	'trouble synchronizing lsla ^o, some lines may not answer'	h
msg6:	acc	'runaway hsla subchannel, line ^o, masking subchannel'	h
msg7:	acc	'unrecognized error code'
msg8:	acc	'unrecognized error code'
msg9:	acc	'unrecognized error code'
msg10:	acc	'unrecognized error code'


boot_messages:
	zero	0,boot_ok
	zero	0,boot_checksum
	zero	0,boot_read_err
	zero	0,boot_gicb_err
	zero	0,boot_config_err

boot_ok:	acc	'FNP ^a loaded successfully'
boot_checksum:
	acc	'checksum error in core image for FNP ^a'
boot_read_err:
	acc	'error reading core image for FNP ^a'
boot_gicb_err:
	acc	'configuration error reported by bootloading program for FNP ^a'
boot_config_err:
	acc	'configuration error reported by FNP ^a:'


config_messages:
	zero	0,bad_init
	zero	0,bad_init
	zero	0,init_2
	zero	0,init_3
	zero	0,init_4
	zero	0,init_5
	zero	0,bad_init
	zero	0,bad_init
	zero	0,init_8
	zero	0,init_9
	zero	0,init_10
	zero	0,init_11
	zero	0,init_12
	zero	0,init_13
	zero	0,init_14
	zero	0,init_15

init_2:	acc	'timer channel not enabled'
init_3:	acc	'more than one dia configured'
init_4:	acc	'dia does not exist'
init_5:	acc	'dia did not respond'
init_6:	acc	'invalid baud rate specified'
init_8:	acc	'core image specifies more memory than physically present'
init_9:	acc	'lsla ^o illegal sync speed'
init_10:	acc	'lsla ^o failed ten times to init'
init_11:	acc	'lsla ^o speed not equal desired speed'
init_12:	acc	'timer switch incorrectly set'
init_13:	acc	'lsla ^o, actual config does not match CDT'
init_14:	acc	'pager is disabled or inoperative'
init_15:	acc	'unable to allocate trace buffer'
bad_init:	acc	'unrecognized config status ^s^w'

	end




		    dn355_util.alm                  11/11/89  1132.7rew 11/11/89  0825.4       12888



" ***********************************************************
" *                                                         *
" * 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.      *
" *                                                         *
" ***********************************************************

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"	dn355_util: stuff for dn355 best done in ALM.
"
"	compute_parity: compute odd parity on word supplied
"		 by caller (pcw) and set bit 22 in the word
"		 if necessary to make odd parity
"
"
"	Created for new tty DIM on 01/13/75 by Mike Grady.
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "

	name	dn355_util

" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "
"
"	COMPUTE_PARITY ENTRY
"
" " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " "


	segdef	compute_parity

compute_parity:
	lda	ap|2,*		get word to compute parity on
	gtb	0		calculate parity on it
	ana	1,dl		test for odd or even
	tnz	3,ic		odd
	lda	=o020000,dl	set parity bit (bit 22)
	orsa	ap|4,*		..
	short_return

	end




		    fnp_multiplexer.pl1             11/11/89  1132.7r w 11/11/89  0825.4      546093



/****^  ***********************************************************
        *                                                         *
        * 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.      *
        *                                                         *
        *********************************************************** */

/* format: style4,delnl,insnl,^ifthendo */
fnp_multiplexer:
     proc;

/* This is the called multiplexer module for FNP channels. It calls dn355
   *  to pass mailboxes on to the FNP. Important data structures are:
   *	fnp_info (in dn355_data) : info about the FNP as a whole
   *	pcb (physical channel block) : allocated in tty_buf. Contains per-channel info
   *
*/

/* Written 08/15/78 by Robert Coren */
/* Modified 04/11/79 by Robert Coren to handle all modes at once */
/* Modified 06/29/79 by Bernard Greenberg for FNP echo negotiation */
/* Modified 79 Aug 21 by Art Beattie to support 64K DN6670s. */
/* Modified various times in 1980 by Robert Coren to add metering */
/* Modified May 1981 by Robert Coren to keep get_meters order from using user-supplied
   pointer while FNP channel is locked */
/* Modified late summer 1981 by Robert Coren to handle tandd_attach order and COLTS channel */
/* Modified fall 1981 by Robert Coren to assign smaller buffer sizes */
/* Modified November 1981 by Robert Coren to fix bug whereby terminate_multiplexer
   didn't initialize ttybp */
/* Modified June 1982 by Robert Coren to correct precision of FNP addresses. */
/* Modified November 1983 by Robert Coren to make priv_control check the pointer set by get_fnp_meters */
/* Modified 83-12-16 BIM for io_manager calls */
/* Modified 84-05-18 BIM for correction to ioa_ strings */
/* Modified 1984-08-02 BIM for bug in shutdown_mpx handling of booting fnp */
/* Modified 1984-09-25 BIM for paged mode fnp load. (page table filling) */
/* Modified September 1984 by Robert Coren to free copied meters in
   terminate_multiplexer and to exit loop in send_global if FNP is down */
/* Modified November 1984 by Robert Coren to zero pad fields in copied meters
   so random junk from the FNP doesn't get left in tty_area */
/* Modified November 1984 by Robert Coren to use tty_area_manager to allocate and free saved meters */

/****^  HISTORY COMMENTS:
  1) change(86-04-23,Coren), approve(86-04-23,MCR7300),
     audit(86-06-19,Beattie), install(86-07-08,MR12.0-1089):
     To process 256-bit echo negotiation break tables.
  2) change(86-12-12,Beattie), approve(86-12-17,MECR0005),
     audit(86-12-12,Brunelle), install(86-12-17,MR12.0-1250):
     Declare an argument in call to fnp_util$free_page_table to accept the
     error code being returned. (phx20712)
  3) change(86-12-12,Beattie), approve(86-12-29,MCR7598),
     audit(87-01-07,Brunelle), install(87-01-12,MR12.0-1268):
     Declare an argument in call to fnp_util$free_page_table to accept the
     error code being returned. (phx20712)
                                                   END HISTORY COMMENTS */

%page;
/* PARAMETERS */

dcl  a_devx fixed bin;				/* devx of FNP channel */
dcl  a_init_info_ptr ptr;
dcl  a_fnpp ptr;
dcl  a_subchan fixed bin;
dcl  a_chainp ptr;
dcl  a_mi_flag bit (1) aligned;
dcl  a_code fixed bin (35);
dcl  a_output_ptr ptr;
dcl  a_order char (*);
dcl  a_data_ptr ptr;
dcl  a_mode_list_ptr ptr;
dcl  a_modes char (*);


/* AUTOMATIC */

dcl  code fixed bin (35);				/* standard system error code */
dcl  devx fixed bin;				/* of FNP channel */
dcl  my_chan_name char (1);
dcl  dno fixed bin;					/* FNP number */
dcl  pcb_space fixed bin;
dcl  space_needed fixed bin;
dcl  output_ptr ptr;				/* pointer to caller's output data */
dcl  chanx fixed bin;				/* index of PCB */
dcl  output_length fixed bin;				/* number of output characters */
dcl  sourcep ptr;
dcl  (i, j) fixed bin;
dcl  lastp ptr;					/* pointer to last buffer in already-exisitng chain */

dcl  order char (32);
dcl  data_ptr ptr;					/* pointer to order info structure */
dcl  set_write_status bit (1);
dcl  locked bit (1);
dcl  old_mask fixed bin (71);
dcl  mask_ptwp ptr;
dcl  queue_locked bit (1);
dcl  mylock bit (1);
dcl  opcode fixed bin (8);				/* mailbox opcode */
dcl  alter_type fixed bin (8);			/* alter parameters subop */
dcl  check bit (1);
dcl  mbx_data_len fixed bin;				/* in bits */
dcl  mbx_data bit (4 * 36) based (addr (mbx_data_long));
dcl  mbx_data_long bit (8 * 36);
dcl  alter_data bit (4 * 36) varying;
dcl  dumpin bit (1);
dcl  dumpout bit (1);
dcl  get_meters bit (1);
dcl  temp_saved_meters_ptr ptr;
dcl  meter_ptr ptr;
dcl  lcmp ptr;
dcl  fnp_meters_ptr ptr;
dcl  ret_meters_ptr ptr;
dcl  local_line_type fixed bin;
dcl  phone_no_len fixed bin;				/* in bits */
dcl  phone_digits (32) bit (6);
dcl  next_digit fixed bin (6) unsigned;			/* value of next dialout digit */
dcl  digit_pos fixed bin;				/* how far along we are in phone number */
dcl  opend bit (1);					/* whether or not output is pending */

dcl  modex fixed bin;
dcl  mode_name char (8);
dcl  mode_on bit (1);				/* mode to be turned on or off */
dcl  mode_set (36) bit (1);
dcl  hndlquit_set bit (1);
dcl  base_len fixed bin;
dcl  block_len fixed bin;
dcl  chars_per_buf fixed bin;
dcl  chars_per_sec fixed bin;

dcl  wire_arg fixed bin (71);
dcl  wire_ptr ptr;
dcl  hsla_flag bit (1);
dcl  old_flag bit (1);
dcl  pcb_space_ptr ptr;
dcl  prev_la_no fixed bin;
dcl  la_no fixed bin;
dcl  subchan fixed bin;
dcl  his_fnp_no fixed bin;				/* FNP number in supplied channel name */
dcl  pcbx fixed bin;
dcl  found bit (1);
dcl  past bit (1);
dcl  n_fnp_words fixed bin;
dcl  ignore bit (1);
dcl  name char (32);
dcl  temp_addr fixed bin;
dcl  fnp_dump_ptr ptr;
dcl  dump_patch_space fixed bin;			/* amount of space required by an fnp_(dump patch) order */
dcl  dump_patch_time fixed bin (71);			/* clock time when a dump or patch order was initiated */


dcl  1 dump_fnp_data aligned,				/* command data for dump_fnp & patch_fnp */
       2 abs_addr fixed bin (24),			/* absolute address of ring-zero buffer */
       2 fnp_addr fixed bin (18) unsigned unaligned,	/* address in FNP */
       2 fnp_len fixed bin (18) unsigned unaligned;	/* number of 18-bit words */

dcl  1 fnp_break_data aligned,			/* command data for fnp_break order */
       2 lineno fixed bin (17) unal,			/* line number, derived from tty name */
       2 fnp_addr fixed bin (18) unsigned unal,
       2 action fixed bin (17) unal,
       2 flags bit (18) unal;

dcl  1 echnego_break_table aligned,
       2 words (0:15) unaligned,
         3 bits bit (16) unaligned,
         3 pad bit (2) unaligned;

/* BASED */

dcl  based_fb_word fixed bin based;
dcl  based_bit1 bit (1) based;
dcl  based_bit2 bit (2) based;
dcl  based_bit18 bit (18) based;
dcl  based_bit72 bit (72) based;
dcl  based_bit108 bit (108) based;
dcl  based_echo_table_bits bit (WIRED_ECHO_BREAK_SIZE + 1) based;
dcl  fnp_data (n_fnp_words) bit (18) based;

dcl  phone_chars char (32) varying based;		/* phone number passed with dial_out order */

dcl  1 wr_stat aligned based,				/* for write_status */
       2 ev_chan fixed bin (71),
       2 output_pending bit (1);

dcl  1 rd_stat aligned based,				/* for read_status */
       2 ev_chan fixed bin (71),
       2 input_available bit (1);

dcl  1 dump_fnp_info based (data_ptr) aligned,		/* structure passed for dump_fnp and patch_fnp */
       2 fnp_address fixed bin (24),
       2 fnp_len fixed bin,				/* number of 18=bit words */
       2 bufp ptr,					/* pointer to caller's buffer */
       2 old_value_ptr ptr;				/* pointer to previous values (patch only) */

dcl  1 fnp_break_info aligned based (data_ptr),		/* structure passed on fnp_break order */
       2 chan_name char (6),				/* tty name, optional */
       2 fnp_addr fixed bin,				/* addr in fnp to set break */
       2 action fixed bin,				/* request type */
       2 flags bit (36);				/* special action flags */

dcl  1 echo_start_data aligned based (data_ptr),		/* Echo starting data */
       2 ctr fixed bin (35),				/* Synchronization counter */
       2 screenleft fixed bin (35);			/* Length left on screen */

/* BUILTINS & CONDITIONS */

dcl  (addr, addrel, bin, bit, clock, divide, hbound, length, null, ptr, rel, rtrim, size, stac, stacq, string, substr,
     unspec) builtin;

dcl  area condition;


/* ENTRIES */

dcl  pxss$notify entry (fixed bin);
dcl  dn355$send_wcd entry (ptr, ptr, fixed bin (8), fixed bin, bit (*));
dcl  dn355$send_global_wcd entry (ptr, fixed bin (8), fixed bin, bit (*));
dcl  dn355$hangup_fnp_lines entry (fixed bin);
dcl  dn355$process_interrupt_queue entry (fixed bin);
dcl  dn355$interrupt entry;
dcl  fnp_util$fill_page_table entry (fixed bin, fixed bin (35));
dcl  fnp_util$free_page_table entry (fixed bin, fixed bin (35));
dcl  fnp_util$unwire entry (fixed bin, fixed bin (35));
dcl  tty_lock$lock_lcte entry (ptr, fixed bin (35));
dcl  tty_area_manager$allocate entry (fixed bin, ptr);
dcl  tty_area_manager$free entry (fixed bin, ptr);
dcl  lock$lock_fast entry (pointer);
dcl  lock$unlock_fast entry (pointer);
dcl  syserr entry options (variable);
dcl  syserr$error_code entry options (variable);
dcl  parse_tty_name_ entry (char (*), fixed bin, bit (1), fixed bin, fixed bin);
dcl  parse_fnp_name_ entry (char (*), fixed bin);
dcl  pxss$addevent entry (fixed bin);
dcl  pxss$delevent entry (fixed bin);
dcl  pxss$wait entry;

/* EXTERNAL STATIC */

dcl  (
     error_table_$noalloc,
     error_table_$undefined_order_request,
     error_table_$bad_mode,
     error_table_$bad_channel,
     error_table_$buffer_big,
     error_table_$invalid_write,
     error_table_$dev_offset_out_of_bounds,
     error_table_$seglock,
     error_table_$mpx_down,
     error_table_$timeout,
     error_table_$unimplemented_version,
     error_table_$no_channel_meters,
     error_table_$resource_not_free,
     error_table_$io_assigned,
     error_table_$io_not_assigned,
     error_table_$io_not_configured,
     error_table_$io_not_available,
     error_table_$invalid_state
     ) ext static fixed bin (35);

dcl  pds$processid ext static bit (36) aligned;
dcl  pds$process_group_id ext static char (32) aligned;

/* INTERNAL STATIC */

/* The following are declared here because syserr_constants.incl.pl1 cannot
   be used, owing to a naming conflict with mcs_interrupt_info.incl.pl1.
*/

dcl  ANNOUNCE fixed bin internal static options (constant) init (0);
dcl  CRASH_SYSTEM fixed bin internal static options (constant) init (1);

dcl  DCW_LIST_SIZE fixed bin int static options (constant) init (16);
dcl  DUMP_PATCH_LIMIT fixed bin (35) int static options (constant) init (10000000);
						/* i.e., 10 seconds */

/* The following facts about the the lists of modes below are IMPORTANT.
   *  The modes which have corresponding alter_parameters subtypes are the same as the modes
   *  that are valid for asynchronous lines only, and no data is associated with the
   *  alter_parameters other than on/off, with the following exceptions:
   *	blk_xfer and iflow require additional data (buffer sizes)
   *	hndlquit is valid for any line, but is expressed by alter_parameters
   *
   *  Therefore, hndlquit is handled explicitly, and blk_xfer and iflow must come after those modes having alter_paramters
   *  subop types. Anyone modifying these lists should be aware of this circumstance.
*/

dcl  good_modes (1) char (8) int static options (constant)	/* modes recognized for all lines */
	init ("hndlquit");

dcl  async_only_modes (15) char (8) int static options (constant)
						/* modes recognized for async lines only */
	init ("crecho", "tabecho", "lfecho", "echoplex", "fulldpx", "replay", "polite", "breakall", "prefixnl",
	"no_outp", "8bit", "oddp", "oflow", "iflow", "blk_xfer");

dcl  IFLOW_INDEX fixed bin internal static options (constant) init (14);
dcl  BLK_XFER_INDEX fixed bin internal static options (constant) init (15);

dcl  full_dpx_modes (7) char (8) int static options (constant)
						/* modes requiring full duplex line type */
	init ("crecho", "tabecho", "lfecho", "echoplex", "fulldpx", "iflow", "oflow");

dcl  mode_alter_types (13) fixed bin (8) int static options (constant)
						/* alter_paramters subops corresponding to modes */
	init (8,					/* crecho */
	14,					/* tabecho */
	9,					/* lfecho */
	20,					/* echoplex */
	3,					/* fulldpx */
	23,					/* replay */
	24,					/* polite */
	27,					/* breakall */
	28,					/* prefixnl */
	33,					/* no_outp */
	32,					/* 8bit */
	31,					/* oddp */
	30);					/* oflow */

/* INCLUDE FILES */

%page;
%include tty_buf;
%page;
%include tty_buffer_block;
%page;
%include lct;
%page;
%include dn355_data;
%page;
%include pcb;
%page;
%include mailbox_ops;
%page;
%include tty_space_man_dcls;
%page;
%include line_types;
%page;
%include mux_init_info;
%page;
%include io_chnl_util_dcls;
%include mcs_modes_change_list;
%include flow_control_info;
%include channel_manager_dcls;
%include mcs_interrupt_info;
%include fnp_meters;
%include fnp_channel_meters;
%include get_comm_meters_info;
%include io_manager_dcls;
%include mcs_echo_neg_sys;

init_multiplexer:
     entry (a_devx, a_init_info_ptr, a_fnpp, a_code);

/* This entry is called to initialize data bases preparatory to loading an FNP
   *  In particular, it initializes the appropriate entry in fnp_info, and allocates
   *   and initializes PCBs
*/


	devx = a_devx;
	miip = a_init_info_ptr;
	mii_chan_count = mux_init_info.no_channels;
	pcb_space_ptr = null ();			/* make cleanup safe */
	infop = addr (dn355_data$);
	ttybp = addr (tty_buf$);
	lctp = tty_buf.lct_ptr;

	lcntp = lct.lcnt_ptr;			/* get channel name */
	if length (rtrim (lcnt.names (devx))) ^= 1
	then go to bad_channel;
	my_chan_name = rtrim (lcnt.names (devx));
	call parse_fnp_name_ (my_chan_name, dno);
	if dno < 0				/* unreasonable name */
	then do;
bad_channel:
	     a_code = error_table_$bad_channel;
	     go to init_exit;
	end;

	fnpp = addr (datanet_info.per_datanet (dno));
	call TRACE ("init_multiplexer");		/* only error trace if bad devx */

	if my_chan_name ^= fnp_info.fnp_tag
	then go to bad_channel;
	if ^tty_buf.fnp_config_flags (dno)
	then go to bad_channel;

	call lock$lock_fast (addr (datanet_info.configuration_lock));
						/* noone else can configure */
	fnp_info.lcte_ptr = addr (lct.lcte_array (devx));

	if fnp_info.t_and_d_in_progress		/* lcte will be invalid, but still */
	then do;
	     code = error_table_$io_not_available;
	     go to init_abort;
	end;

	call assign_channel (code);			/* under config lock */
	if code ^= 0
	then go to init_abort;			/* it may have been deconfigured while we were farting around */

	call fnp_util$fill_page_table ((fnp_info.fnp_number), code);
	if code ^= 0
	then go to init_abort;			/* IOI has problems? */

	do i = 0 to 2;				/* initialize line-number indexes */
	     fnp_info.hsla_idx (i) = -1;
	     fnp_info.lsla_idx (i) = -1;
	end;
	do i = 3 to 5;				/* 3 more for LSLAs */
	     fnp_info.lsla_idx (i) = -1;
	end;

	pcb_space = size (pcb) * mii_chan_count;	/* get enough space for an array of PCBs */
	space_needed = pcb_space + 8 * DCW_LIST_SIZE;
	call tty_space_man$get_space (space_needed, pcb_space_ptr);
	if pcb_space_ptr = null			/* this would be unfortunate */
	then do;
	     a_code = error_table_$noalloc;
	     go to init_abort;
	end;
	n_pcbs, fnp_info.no_of_channels = mii_chan_count;
	pcb_space_ptr -> pcb_array (*).saved_meters_ptr = null ();
						/* for cleanup */
	fnp_info.pcb_array_ptr = pcb_space_ptr;
	fnp_info.dcw_list_array_ptr = addrel (pcb_space_ptr, pcb_space);
	string (fnp_info.flags) = "0"b;
	prev_la_no = -1;				/* so test will work right the first time */
	old_flag = "1"b;				/* HSLA channels (if any) are always first */

/*
   * The following code assigns line numbers and sets the adapter indexes
   * It assumes that channels in mux_init_info are sorted in ascending order
*/

	do pcbx = 1 to n_pcbs;
	     pcbp = addr (pcb_space_ptr -> pcb_array (pcbx));
	     unspec (pcb) = "0"b;
	     pcb.saved_meters_ptr = null ();		/* for cleanup dept */
	     pcb.devx = mux_init_info.channels (pcbx).devx;
	     lctep = addr (lct.lcte_array (pcb.devx));
	     lcte.subchannel = pcbx;
	     name = mux_init_info.channels (pcbx).name;
	     call parse_tty_name_ (name, his_fnp_no, hsla_flag, la_no, subchan);
	     if his_fnp_no ^= dno
	     then do;
		code = error_table_$bad_channel;
		go to init_abort;
	     end;
	     if la_no = 7
	     then fnp_info.tandd_pcbx = pcbx;
	     else if (la_no ^= prev_la_no | hsla_flag ^= old_flag)
						/* first subchannel on this adapter */
	     then do;
		if hsla_flag
		then fnp_info.hsla_idx (la_no) = pcbx;
		else fnp_info.lsla_idx (la_no) = pcbx;
		prev_la_no = la_no;
		old_flag = hsla_flag;
	     end;

	     pcb.subchan = subchan;
	     pcb.is_hsla = hsla_flag;
	     pcb.la_no = bit (bin (la_no, 3), 3);
	     if hsla_flag
	     then pcb.slot_no = bit (bin (subchan, 6), 6);


/*	     * lsla slot number has to wait for baud rate supplied at bootload time */

	     on area
		begin;
		code = error_table_$noalloc;
		go to init_abort;
	     end;

	     call tty_area_manager$allocate (size (fnp_channel_meters), temp_saved_meters_ptr);
	     pcb.saved_meters_ptr = temp_saved_meters_ptr;
	end;

	call lock$unlock_fast (addr (datanet_info.configuration_lock));

	a_fnpp = fnpp;				/* pass this back */
	a_code = 0;
init_exit:
	return;

init_abort:
	call TRACE_ERROR ("init_multiplexer", code);
	call lock$unlock_fast (addr (datanet_info.configuration_lock));
	if pcb_space_ptr ^= null
	then do;
	     do pcbx = 1 to n_pcbs;
		pcbp = addr (pcb_space_ptr -> pcb_array (pcbx));
		if pcb.saved_meters_ptr ^= null ()
		then call tty_area_manager$free (size (fnp_channel_meters), (pcb.saved_meters_ptr));
	     end;
	     call tty_space_man$free_space (space_needed, pcb_space_ptr);
	end;
	a_code = code;
	return;

terminate_multiplexer:
     entry (a_fnpp, a_code);

/* This entry is called after FNP crash or shutdown in order to free PCBs */

	fnpp = a_fnpp;
	ttybp = addr (tty_buf$);
	infop = addr (dn355_data$);
	locked = "0"b;
	call TRACE ("terminate_multiplexer");
	call lock;
	if code ^= 0
	then go to terminate_return;

	if fnp_info.bootloading | fnp_info.wired | fnp_info.running
						/* bad time to terminate */
	then code = error_table_$invalid_state;

	else do;
	     do i = 1 to fnp_info.no_of_channels;
		pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (i));
		if pcb.write_first ^= 0
		then call tty_space_man$free_chain ((pcb.devx), OUTPUT, ptr (ttybp, pcb.write_first));
		if pcb.read_first ^= 0
		then call tty_space_man$free_chain ((pcb.devx), INPUT, ptr (ttybp, pcb.read_first));
		call tty_area_manager$free (size (fnp_channel_meters), (pcb.saved_meters_ptr));
		if pcb.copied_meters_offset ^= 0	/* free this if it's there */
		then do;
		     call tty_space_man$free_space (size (fnp_channel_meters), ptr (ttybp, pcb.copied_meters_offset));
		     pcb.copied_meters_offset = 0;
		end;
	     end;

	     string (fnp_info.flags) = "0"b;
	     call tty_space_man$free_space (size (pcb) * fnp_info.no_of_channels + 8 * DCW_LIST_SIZE,
		fnp_info.pcb_array_ptr);
	     fnp_info.pcb_array_ptr = null;
	     code = 0;
	end;

	if fnp_info.io_manager_assigned
	then call unassign_channel (code);		/* not deconfigured on us */
	call fnp_util$free_page_table ((fnp_info.fnp_number), (0));
						/* even if we lost the assignment ... */
	call unlock;

terminate_return:
	if code ^= 0
	then call TRACE_ERROR ("terminate_multiplexer", code);
	a_code = code;
	return;

start:
     entry (a_fnpp, a_code);

/* entry to enable an FNP by sending "accept_calls" order */

	fnpp = a_fnpp;
	infop = addr (dn355_data$);
	call TRACE ("start");
	chanx = 1;				/* this is irrelevant, but will make setup happy */
	call setup;
	if code = 0
	then do;
	     call dn355$send_global_wcd (fnpp, accept_calls, 18,
		bit (bin (bin (rel (addr (tty_buf.free_space)), 18) + tty_buf.absorig, 18), 18));
	     call unlock;				/* setup locked */
	end;
	if code ^= 0
	then call TRACE_ERROR ("start", code);
	a_code = code;
	return;


stop:
     entry (a_fnpp, a_code);

/* entry to disable an FNP from further dialups (by sending dont_accept_calls order) */

	fnpp = a_fnpp;
	infop = addr (dn355_data$);
	call TRACE ("stop");
	chanx = 1;				/* as for start entry */
	call setup;
	if code = 0
	then do;
	     call dn355$send_global_wcd (fnpp, dont_accept_calls, 0, ""b);
	     call unlock;				/* setup locked */
	end;
	if code ^= 0
	then call TRACE_ERROR ("stop", code);
	a_code = code;
	return;


shutdown:
     entry (a_fnpp, a_code);

/* This entry simulates an FNP crash; if the FNP is up, all lines will be hung up */

	infop = addr (dn355_data$);
	fnpp = a_fnpp;
	if fnpp = null ()
	then do;
	     if datanet_info.trace
	     then call syserr (ANNOUNCE, "fnp_multiplexer$shutdown: Called with null fnp_ptr");
	     go to shutdown_return;
	end;
	call TRACE ("shutdown");
	infop = addr (dn355_data$);

	if fnp_info.wired | fnp_info.bootloading	/* do the user ring a favor */
	then do;
	     if datanet_info.trace
	     then call syserr (ANNOUNCE, "fnp_multiplexer$shutdown: Called with FNP wired.");
	     call fnp_util$unwire ((fnp_info.fnp_number), code);
	     if code ^= 0
	     then call syserr$error_code (ANNOUNCE, code, "fnp_multiplexer$shutdown: Failed to unwire fnp.");
	end;

	locked = "0"b;
	if fnp_info.running				/* if it's up now */
	then do;
	     call lock;
	     call dn355$hangup_fnp_lines ((fnp_info.fnp_number));
	     fnp_info.running = "0"b;
	     call unlock;
	end;


shutdown_return:
	a_code = 0;
	return;


read:
     entry (a_fnpp, a_subchan, a_chainp, a_mi_flag, a_code);

/* this is a dummy entry, dn355 never holds input at interrupt time */

	a_chainp = null;
	a_mi_flag = "0"b;
	a_code = 0;
	return;


write:
     entry (a_fnpp, a_subchan, a_output_ptr, a_code);

	fnpp = a_fnpp;
	chanx = a_subchan;
	output_ptr = a_output_ptr;

	call setup;
	if code ^= 0
	then do;
	     a_code = code;
	     return;
	end;

/* figure out length of chain */

	blockp = output_ptr;
	output_length = buffer.tally;			/* to start with */

	do while (buffer.next ^= 0);
	     blockp = ptr (ttybp, buffer.next);
	     output_length = output_length + buffer.tally;
	end;

	if pcb.write_last ^= 0			/* existing write chain */
	then do;
	     lastp = ptr (ttybp, pcb.write_last);
	     lastp -> buffer.next = bin (rel (output_ptr));
	end;

	else pcb.write_first = bin (rel (output_ptr));

	pcb.write_last = bin (rel (blockp));		/* in any case */
	pcb.write_cnt = pcb.write_cnt + output_length;

	if pcb.send_output				/* if the FNP is ready for it */
	then call dn355$send_wcd (fnpp, pcbp, accept_direct_output, 0, ""b);

	code = 0;
write_exit:
	call unlock;
	if code = 0
	then a_output_ptr = null ();			/* so caller will know we took it all */
	a_code = code;
	return;

control:
     entry (a_fnpp, a_subchan, a_order, a_data_ptr, a_code);

	fnpp = a_fnpp;
	chanx = a_subchan;
	order = a_order;
	data_ptr = a_data_ptr;

	dumpin, dumpout, set_write_status, get_meters = "0"b;
						/* initialize local variables */
	opcode, alter_type = -1;
	check = "0"b;

	if order = "read_status"			/* there's never any at this level */
	then do;
	     data_ptr -> rd_stat.input_available = "0"b;
	     a_code = 0;
	     return;
	end;

	else if order = "hangup"
	then do;
	     mbx_data_len = 0;
	     mbx_data = ""b;
	     opcode = disconnect_this_line;
	end;

	else if order = "wru"
	then do;
	     alter_type = Wru;
	     alter_data = ""b;
	end;

	else if order = "interrupt"
	then do;
	     alter_type = Break;
	     alter_data = ""b;
	end;

	else if order = "start_xmit_hd" | order = "stop_xmit_hd"
	then do;
	     alter_type = Xmit_hold;
	     alter_data = "00000000"b || (order = "start_xmit_hd");
	end;

	else if order = "set_input_message_size"
	then do;
	     mbx_data = bit (bin (data_ptr -> based_fb_word, 18), 18);
	     opcode = sync_msg_size;
	end;

	else if order = "line_control"
	then do;
	     mbx_data_len = 72;
	     mbx_data = data_ptr -> based_bit72;
	     opcode = line_control;
	end;

	else if order = "set_framing_chars"
	then do;
	     mbx_data_len = 18;
	     mbx_data = data_ptr -> based_bit18;	/* two characters are packed in halfword */
	     opcode = set_framing_chars;
	end;

	else if order = "set_delay"
	then do;
	     mbx_data_len = 108;
	     mbx_data = data_ptr -> based_bit108;	/* 6 18-bit values */
	     opcode = set_delay_table;
	end;

	else if order = "abort"			/* i.e., resetread or resetwrite */
	then do;
	     dumpin = substr (data_ptr -> based_bit2, 2, 1);
						/* we'll simply save this info for later */
	     dumpout = substr (data_ptr -> based_bit2, 1, 1);
	end;

	else if order = "set_line_type"
	then do;
	     mbx_data_len = 18;
	     local_line_type = data_ptr -> based_fb_word;
	     if local_line_type <= 0 | local_line_type > max_line_type
	     then go to order_error;
	     check = "1"b;				/* we'll have to look at PCB (after locking) */
	     opcode = set_line_type;
	end;

	else if order = "dial_out"
	then do;					/* we have to convert digits (in char. form) to 6-bit BCD */
	     digit_pos = 0;
	     do i = 1 to length (data_ptr -> phone_chars);/* should never see "X" in phone number */
		next_digit = index ("0123456789XXX!", substr (data_ptr -> phone_chars, i, 1)) - 1;
						/* a value of 13 tells autocall unit to wait for a */
						/* dial tone before asking for another dialing digit */
		if next_digit >= 0
		then if next_digit < 10 | next_digit = 13
		     then do;			/* it's actually a digit */
			digit_pos = digit_pos + 1;
			phone_digits (digit_pos) = bit (next_digit, 6);
		     end;
	     end;

	     phone_no_len = 6 * digit_pos;
	     opcode = dial;
	     check = "1"b;				/* special stuff required here too */
	end;

	else if order = "listen"
	then do;
	     alter_type = Listen;
	     alter_data = "000000001"b;
	end;

	else if order = "write_status"
	then set_write_status = "1"b;

	else if order = "enter_receive"
	then do;
	     mbx_data_len = 0;
	     mbx_data = ""b;
	     opcode = enter_receive;
	end;
	else if order = "start_negotiated_echo"
	then do;
	     mbx_data_len = 36;
	     mbx_data =
		bit (fixed (data_ptr -> echo_start_data.ctr, 18), 18)
		|| bit (fixed (data_ptr -> echo_start_data.screenleft, 18), 18);
	     opcode = start_negotiated_echo;
	end;
	else if order = "set_echnego_break_table"
	then do;
	     mbx_data_len = length (unspec (echnego_break_table));
	     unspec (echnego_break_table) = ""b;	/* Get pads */
	     do i = 0 to hbound (echnego_break_table.words, 1);
		echnego_break_table.bits (i) = substr (data_ptr -> based_echo_table_bits, 1 + 16 * i, 16);
	     end;
	     mbx_data_long = unspec (echnego_break_table);
	     opcode = set_echnego_break_table;
	end;
	else if order = "init_echo_negotiation"
	then do;
	     mbx_data_len = 0;
	     mbx_data = ""b;
	     opcode = init_echo_negotiation;
	end;
	else if order = "stop_negotiated_echo"
	then do;
	     mbx_data_len = 0;
	     mbx_data = ""b;
	     opcode = stop_negotiated_echo;
	end;
	else if order = "input_flow_control_chars"
	then do;
	     mbx_data_len = 36;
	     if data_ptr -> input_flow_control_info.resume_seq.count = 0
						/* turning it all off */
	     then mbx_data = ""b;
	     else do;
		mbx_data =
		     unspec (substr (data_ptr -> input_flow_control_info.suspend_seq.chars, 1, 1))
		     || unspec (substr (data_ptr -> input_flow_control_info.resume_seq.chars, 1, 1))
		     || data_ptr -> input_flow_control_info.timeout;
		if data_ptr -> input_flow_control_info.suspend_seq.count = 0
		then substr (mbx_data, 1, 9) = "0"b;	/* don't send suspend char if there isn't one */
	     end;
	     opcode = input_fc_chars;
	end;
	else if order = "output_flow_control_chars"
	then do;
	     mbx_data_len = 36;
	     if data_ptr -> output_flow_control_info.suspend_or_etb_seq.count = 0
						/* no chars */
	     then mbx_data = "0"b;
	     else mbx_data =
		     unspec (substr (data_ptr -> output_flow_control_info.suspend_or_etb_seq.chars, 1, 1))
		     || unspec (substr (data_ptr -> output_flow_control_info.resume_or_ack_seq.chars, 1, 1))
		     || data_ptr -> output_flow_control_info.block_acknowledge;
	     opcode = output_fc_chars;
	end;

	else if order = "copy_meters"
	then do;
	     opcode = report_meters;
	     check = "1"b;
	end;

	else if order = "get_meters"
	then do;
	     ret_meters_ptr = data_ptr -> get_comm_meters_info.parent_ptr;
	     if ret_meters_ptr = null ()
	     then return;
	     else if ret_meters_ptr -> fnp_chan_meter_struc.version ^= FNP_CHANNEL_METERS_VERSION_1
	     then do;
		a_code = error_table_$unimplemented_version;
		return;
	     end;

	     else get_meters = "1"b;
	end;

	else if order = "tandd_attach"
	then do;					/* simulate a dialup without bothering the FNP (channel is hung up already) */
	     call setup;
	     if code ^= 0
	     then do;
		a_code = code;
		return;
	     end;

	     if pcb.listen | pcb.dialed		/* can't have this */
	     then do;
		call unlock;
		a_code = error_table_$resource_not_free;
		return;
	     end;

	     pcb.dialed = "1"b;
	     pcb.tandd_attached = "1"b;
	     unspec (dialup_info) = ""b;
	     dialup_info.baud_rate = 1200;		/* just so it's something */
	     dialup_info.line_type = LINE_ASCII;	/* make everyone's life easier */
	     dialup_info.max_buf_size = 16;		/* COLTS wants small buffers */
	     call channel_manager$interrupt ((pcb.devx), DIALUP, unspec (dialup_info));
	     call unlock;
	     a_code = 0;
	     return;
	end;

	else do;
order_error:
	     a_code = error_table_$undefined_order_request;
	     return;
	end;

	code = 0;
	call setup;
	if code ^= 0
	then do;
	     a_code = code;
	     return;
	end;

	if opcode = disconnect_this_line		/* hangup */
	then do;
	     pcb.listen, pcb.tandd_attached = "0"b;
	end;

	if opcode = start_negotiated_echo & (pcb.write_first ^= 0
						/* We have queued output */
	     | pcb.output_mbx_pending)
	then do;					/* The FNP has not take the mbx. */
						/* handler re-do it when he sees this. */
	     call unlock;
	     a_code = error_table_$invalid_write;
	     return;
	end;


	if alter_type ^= -1				/* alter_parameters required */
	then do;
	     if alter_type = Listen
	     then do;				/* need to tell it buffer size */
		alter_data = alter_data || fnp_buf_size ();
		pcb.listen = "1"b;
	     end;

	     mbx_data_len = length (alter_data) + 9;	/* 9 bits for subop type */
	     mbx_data = bit (bin (alter_type, 9), 9) || alter_data;
	     opcode = alter_parameters;
	end;

	if opcode ^= -1				/* we do have to send the FNP something */
	then do;
	     if check				/* anything special about it */
	     then do;
		if opcode = set_line_type		/* make sure this is OK */
		then if pcb.listen
		     then do;			/* it isn't */
			call unlock;
			go to order_error;
		     end;

		     else do;
			mbx_data = bit (bin (local_line_type, 18), 18);
			do i = 1 to n_sync_line_types while (local_line_type ^= sync_line_type (i));
			end;

			pcb.sync_line = (i <= n_sync_line_types);
		     end;

		else if opcode = dial		/* in this case we have to supply buffer size first */
		then do;				/* because no listen was done */
		     mbx_data_len = 36;
		     alter_data = bit (bin (Set_buffer_size, 9), 9) || "000000001"b;
		     mbx_data = alter_data || fnp_buf_size ();
		     call dn355$send_wcd (fnpp, pcbp, alter_parameters, mbx_data_len, mbx_data);

		     mbx_data_len = phone_no_len;
		     mbx_data_long = string (phone_digits);
		end;
		else if opcode = report_meters
		then do;
		     call tty_space_man$get_space (size (fnp_channel_meters), meter_ptr);
						/* get a buffer for the FNP meters */
		     if meter_ptr = null ()		/* couldn't get it */
		     then do;
			call unlock;
			a_code = error_table_$noalloc;
			return;
		     end;

		     pcb.copied_meters_offset = bin (rel (meter_ptr), 18);
		     mbx_data = bit (bin (tty_buf.absorig + pcb.copied_meters_offset, 18), 18);
		     mbx_data_len = 18;
		end;
	     end;

	     call dn355$send_wcd (fnpp, pcbp, opcode, mbx_data_len, mbx_data_long);
	end;

	else do;
	     if dumpin
	     then call dn355$send_wcd (fnpp, pcbp, alter_parameters, 9, bit (bin (Dumpinput, 9), 9));

	     if dumpout
	     then do;				/* first get rid of any ring 0 output */
		if pcb.write_first ^= 0
		then do;
		     call tty_space_man$free_chain ((pcb.devx), OUTPUT, ptr (ttybp, pcb.write_first));
		     pcb.write_first, pcb.write_last, pcb.write_cnt = 0;
		end;


		call dn355$send_wcd (fnpp, pcbp, alter_parameters, 9, bit (bin (Dumpoutput, 9), 9));

		if pcb.end_frame
		then do;
		     pcb.end_frame = "0"b;
		     if pcb.send_output
		     then call channel_manager$interrupt ((pcb.devx), SEND_OUTPUT, ""b);
		end;
	     end;

	     if set_write_status
	     then opend = (pcb.write_first ^= 0);	/* this has to be in automatic, return structure isn't wired */

	     if get_meters
	     then do;
		call get_fnp_meters ("0"b);
		call unlock;

		if code = 0
		then ret_meters_ptr -> fnp_chan_meter_struc.synchronous = pcb.sync_line;
		if fnp_meters_ptr ^= null ()
		then do;
		     if unspec (fnp_meters_ptr -> fnp_channel_meters) = "0"b
		     then code = error_table_$no_channel_meters;
		     else do;
			ret_meters_ptr -> fnp_chan_meter_struc.current_meters =
			     fnp_meters_ptr -> fnp_channel_meters;
			ret_meters_ptr -> fnp_chan_meter_struc.saved_meters =
			     pcb.saved_meters_ptr -> fnp_channel_meters;
		     end;

		     call tty_space_man$free_space (size (fnp_channel_meters), fnp_meters_ptr);
		end;
	     end;
	end;

	call unlock;
	if set_write_status
	then data_ptr -> wr_stat.output_pending = opend;
	a_code = code;

	return;

check_modes:
     entry (a_fnpp, a_subchan, a_mode_list_ptr, a_code);

/* this entry is used to determine if this multiplexer understands or accepts a given set of modes */

	fnpp = a_fnpp;
	chanx = a_subchan;
	mclp = a_mode_list_ptr;
	if mcl.version ^= mcl_version_2
	then do;
	     a_code = error_table_$unimplemented_version;
	     return;
	end;

	call setup;				/* now we need PCB pointer */
	if code ^= 0
	then do;
	     a_code = code;
	     return;
	end;

	do modex = 1 to mcl.n_entries;
	     mclep = addr (mcl.entries (modex));
	     mode_name = substr (mcle.mode_name, 1, 8);
	     mode_on = mcle.mode_switch;

	     do i = 1 to hbound (good_modes, 1) while (mode_name ^= good_modes (i));
	     end;

	     if i <= hbound (good_modes, 1)		/* tree */
						/* it's one of the ones we always recognize */
	     then mcle.mpx_mode = "1"b;
	     else do;
		do i = 1 to hbound (async_only_modes, 1) while (mode_name ^= async_only_modes (i));
		end;

		if i > hbound (async_only_modes, 1)	/* we've never heard of this one at all */
		then mcle.mpx_mode = "0"b;
		else do;
		     mcle.mpx_mode = ^pcb.sync_line;	/* this mode is meaningful for asynchronous lines only */

		     do i = 1 to hbound (full_dpx_modes, 1) while (mode_name ^= full_dpx_modes (i));
		     end;

		     if (mode_name = "no_outp" | mode_name = "8bit" | mode_name = "oddp") & mode_on
		     then if ^pcb.is_hsla
			then go to bad_mode;

		     if i <= hbound (full_dpx_modes, 1) /* if this was a mode requiring full duplex capability */
		     then if mode_on
			then if pcb.line_type ^= LINE_ASCII & pcb.line_type ^= LINE_ASYNC1
				& pcb.line_type ^= LINE_ASYNC2 & pcb.line_type ^= LINE_ASYNC3
			     then do;
bad_mode:
				if mcle.force
				then mcle.mpx_mode = "0"b;
				else do;
				     code = error_table_$bad_mode;
				     mcle.error = "1"b;
				end;
			     end;

		end;
	     end;
	end;

	call unlock;				/* setup locked */
	a_code = code;
	return;

set_modes:
     entry (a_fnpp, a_subchan, a_mode_list_ptr, a_code);

/* this entry sets a specified set of mode (probably by calling dn355$send_wcd) */

	fnpp = a_fnpp;
	chanx = a_subchan;
	mclp = a_mode_list_ptr;
	if mcl.version ^= mcl_version_2
	then do;
	     a_code = error_table_$unimplemented_version;
	     return;
	end;

	call setup;
	if code ^= 0
	then do;
	     a_code = code;
	     return;
	end;

	hndlquit_set = "0"b;
	string (mode_set) = "0"b;			/* nothing set yet */

	do modex = 1 to mcl.n_entries;
	     mclep = addr (mcl.entries (modex));
	     if mcle.mpx_mode			/* if this is one we're interested in */
	     then call process_mode (mcle.mode_name, mcle.mode_switch);
	end;

	if mcl.init
	then do;					/* if "init" we must turn off the ones that weren't mentioned */
	     if ^hndlquit_set
	     then call process_mode ("hndlquit", "0"b);

	     do modex = 1 to hbound (async_only_modes, 1);
		if ^mode_set (modex)
		then call process_mode (async_only_modes (modex), "0"b);
	     end;
	end;

	call unlock;
	a_code = code;
	return;



get_modes:
     entry (a_fnpp, a_subchan, a_modes, a_code);

/* this is a dummy, we don't keep records of modes at this level */

	a_modes = "";
	a_code = 0;
	return;

priv_control:
     entry (a_fnpp, a_order, a_data_ptr, a_code);

/* entry for privileged global orders */

	fnpp = a_fnpp;
	order = a_order;
	data_ptr = a_data_ptr;

	if order = "dump_fnp"
	then do;
	     call setup_fnp;
	     if code ^= 0
	     then do;
		a_code = code;
		return;
	     end;

	     locked = "0"b;
	     call send_global (dump_mem);
	     if code ^= 0
	     then go to end_dump_mem;

/* send_global will wait; come back here after notify */

	     n_fnp_words = dump_fnp_info.fnp_len;
	     dump_fnp_info.bufp -> fnp_data = fnp_dump_ptr -> fnp_data;

end_dump_mem:
	     if code ^= error_table_$timeout		/* else we have to abandon the buffer */
	     then call tty_space_man$free_space (dump_patch_space, fnp_dump_ptr);
						/* this was allocated by setup_fnp */
	     ignore = stacq (fnp_info.dump_patch_lock, "0"b, pds$processid);
	end;

	else if order = "get_meters"
	then do;
	     fnp_meterp = data_ptr -> get_comm_meters_info.subchan_ptr;
	     if fnp_meterp ^= null
	     then do;
		if fnp_meters.version ^= FNP_METERS_VERSION_2
		then code = error_table_$unimplemented_version;
		else do;
		     ttybp = addr (tty_buf$);		/* we'll need this */
		     call lock;
		     if code ^= 0
		     then do;
			a_code = code;
			return;
		     end;

		     call get_fnp_meters ("1"b);

		     if code = 0
		     then do;
			fnp_meters.n_channels = fnp_info.no_of_channels;
			fnp_meters.output_mbx_in_use_cum = fnp_info.cumulative_mbx_in_use;
			fnp_meters.output_mbx_updates = fnp_info.mbx_in_use_updated;
			fnp_meters.output_mbx_unavailable = fnp_info.mbx_unavailable;
			fnp_meters.max_output_mbx_in_use = fnp_info.max_mbx_in_use;
			fnp_meters.queue_entries_made = fnp_info.q_entries_made;
			fnp_meters.input_rejects = fnp_info.input_reject_count;
			fnp_meters.processed_from_q = fnp_info.processed_from_q;
			fnp_meters.fnp_channel_locked = fnp_info.fnp_channel_locked;
			fnp_meters.input_data_transactions = fnp_info.input_data_transactions;
			fnp_meters.output_data_transactions = fnp_info.output_data_transactions;
			fnp_meters.input_control_transactions = fnp_info.input_control_transactions;
			fnp_meters.output_control_transactions = fnp_info.output_control_transactions;
			fnp_meters.fnp_space_restricted_output = fnp_info.fnp_space_restricted_output;
			fnp_meters.fnp_mem_size = fnp_info.fnp_mem_size;
			begin;
declare  iom fixed bin (3);
declare  chan fixed bin (7);
			     call io_chnl_util$name_to_iom (fnp_info.io_chanid, iom, chan, (0));
			     fnp_meters.iom_number = iom;
			     fnp_meters.iom_chan_no = chan;
			end;

		     end;

		     call unlock;

		     if fnp_meters_ptr ^= null ()	/* let's make sure this is for real */
		     then do;
			data_ptr -> get_comm_meters_info.subchan_ptr -> fnp_meters.from_fnp =
			     fnp_meters_ptr -> fnp_global_meters;

			call tty_space_man$free_space (size (fnp_global_meters), fnp_meters_ptr);
		     end;

		     lctep = fnp_info.lcte_ptr;	/* since we don't call channel_manager, */
		     lcmp = data_ptr -> get_comm_meters_info.logical_chan_ptr;
						/* we have to copy logical channel data ourselves */
		     if lcmp ^= null ()
		     then do;
			lcmp -> logical_chan_meters.current_meters = lcte.meters;
			unspec (lcmp -> logical_chan_meters.saved_meters) = "0"b;
						/* no saved meters for an FNP */
		     end;
		end;
	     end;
	end;

	else code = error_table_$undefined_order_request;

	a_code = code;
	return;

hpriv_control:
     entry (a_fnpp, a_order, a_data_ptr, a_code);

/* entry for highly-privileged global orders */

	fnpp = a_fnpp;
	order = a_order;
	data_ptr = a_data_ptr;
	locked = "0"b;
	code = 0;

	if order = "patch_fnp"
	then do;
	     call setup_fnp;
	     if code ^= 0
	     then do;
		a_code = code;
		return;
	     end;
	     n_fnp_words = dump_fnp_data.fnp_len;
	     sourcep = dump_fnp_info.bufp;

	     fnp_dump_ptr -> fnp_data = sourcep -> fnp_data;
	     call syserr (ANNOUNCE, "fnp_multiplexer: patching FNP ^a for ^a:", fnp_info.fnp_tag, pds$process_group_id);
						/* tell operator about it */

	     temp_addr = dump_fnp_data.fnp_addr;
	     do i = 1 to dump_fnp_data.fnp_len;
		call syserr (ANNOUNCE, "^6w from ^6.3b to ^6.3b", temp_addr,
		     dump_fnp_info.old_value_ptr -> fnp_data (i), dump_fnp_info.bufp -> fnp_data (i));
		temp_addr = temp_addr + 1;
	     end;

	     call send_global (patch_mem);		/* send it off and wait */
	     if code ^= error_table_$timeout		/* else we have to abandon the buffer */
	     then call tty_space_man$free_space (dump_patch_space, fnp_dump_ptr);
						/* this was allocated by setup_fnp */
	     ignore = stacq (fnp_info.dump_patch_lock, "0"b, pds$processid);
	end;

	else if order = "fnp_break"
	then do;
	     call setup_fnp;
	     if code ^= 0
	     then do;
		a_code = code;
		return;
	     end;
	     fnp_break_data.action = fnp_break_info.action;
						/* copy info */
	     fnp_break_data.fnp_addr = fnp_break_info.fnp_addr;
	     fnp_break_data.flags = substr (fnp_break_info.flags, 1, 18);
	     name = fnp_break_info.chan_name;
	     if name = ""
	     then fnp_break_data.lineno = -1;		/* no line, i.e. any line */
	     else do;
		call name_to_pcb (name);
		if code ^= 0
		then do;
		     a_code = code;
		     return;
		end;
		fnp_break_data.lineno = bin (string (pcb.line_number));
	     end;

	     mbx_data = addr (fnp_break_data) -> based_bit72;
	     if ^locked
	     then call lock;
	     if code = 0
	     then do;
		call dn355$send_global_wcd (fnpp, fnp_break, 72, mbx_data);
		call unlock;
	     end;
	end;

	else if order = "enable_breakall_mode"
	then ;

	else if order = "disable_breakall_mode"
	then ;

	else code = error_table_$undefined_order_request;

hpriv_exit:
	a_code = code;
	return;

fnp_lock:
     entry (a_fnpp, a_code);				/* Non-wired lock entry */

	fnpp = a_fnpp;
	call lock;
	a_code = code;
	return;

fnp_unlock:
     entry (a_fnpp);

	fnpp = a_fnpp;
	mylock = "0"b;
	locked = "1"b;
	call unlock;
	return;

setup:
     proc;

/* initial setup for per-channel stuff */


	code = 0;					/* innocent until proven guilty */
	ttybp = addr (tty_buf$);
	infop = addr (dn355_data$);
	locked, queue_locked = "0"b;
	call lock;
	if code ^= 0
	then return;

	if fnp_info.running
	then pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (chanx));
	else do;
	     call unlock;
	     code = error_table_$mpx_down;
	     return;
	end;

	if pcb.copied_meters_ready			/* dn355 left them for us */
	then if ^lcte.locked_for_interrupt		/* make sure we're on call side */
	     then call save_copied_meters;

	return;
     end setup;



setup_fnp:
     proc;

dcl  (fnp_address, fnp_len) fixed bin (18);

/* this procedure is used instead of setup for privileged global orders */

	if fnpp = null ()
	then go to setup_fnp_down;
	code = 0;
	if fnp_info.mbx_pt = null ()			/* this one isn't configured */
	     | ^fnp_info.running			/* or it isn't up */
	then do;
setup_fnp_down:
	     code = error_table_$mpx_down;
	     return;
	end;

	ttybp = addr (tty_buf$);
	infop = addr (dn355_data$);

	if order = "fnp_break"
	then return;				/* done if break order */
	if fnp_info.dump_patch_disabled
	then do;
	     code = error_table_$timeout;
	     return;
	end;

	fnp_address = dump_fnp_info.fnp_address;
	fnp_len = dump_fnp_info.fnp_len;
	if order = "dump_fnp"
	then do;					/* check dump params */
	     if fnp_len <= 0 | fnp_len > 64
	     then do;
bad_fnp_len:
		code = error_table_$buffer_big;
		return;
	     end;
	end;
	else if order = "patch_fnp"
	then if fnp_len <= 0 | fnp_len > 32
	     then go to bad_fnp_len;

	if (fnp_address < 0) | ((fnp_address + fnp_len) > fnp_info.fnp_mem_size)
	then do;
	     code = error_table_$dev_offset_out_of_bounds;
	     return;
	end;

	if ^stac (addr (fnp_info.dump_patch_lock), pds$processid)
						/* lock the dump_patch function */
	then do;					/* if possible */
	     code = error_table_$seglock;
	     return;
	end;

	dump_patch_space = divide (fnp_len + 1, 2, 17, 0);
	call tty_space_man$get_space (dump_patch_space, fnp_dump_ptr);
	if fnp_dump_ptr = null			/* couldn't get the space */
	then do;
	     code = error_table_$noalloc;
	     ignore = stacq (fnp_info.dump_patch_lock, "0"b, pds$processid);
	     return;
	end;

	dump_patch_time = clock ();
	fnp_info.dump_patch_in_progress = "1"b;
	dump_fnp_data.abs_addr = bin (rel (fnp_dump_ptr)) + tty_buf.absorig;
						/* dump/patch is paged too ... */
	dump_fnp_data.fnp_addr = fnp_address;
	dump_fnp_data.fnp_len = fnp_len;
	return;

     end setup_fnp;

save_copied_meters:
     proc;

/* internal procedure called  to pick up copied meters left in tty_buf by FNP */

dcl  copied_meters_ptr ptr;

	if pcb.copied_meters_offset ^= 0		/* make sure it's legit */
	then do;
	     copied_meters_ptr = ptr (ttybp, pcb.copied_meters_offset);

/* zero out pad fields, which contain random junk (possibly input) from the FNP */

	     if pcb.sync_line
	     then copied_meters_ptr -> fnp_sync_meters.pad (*) = 0;
	     else copied_meters_ptr -> fnp_async_meters.pad (*) = 0;

	     pcb.saved_meters_ptr -> fnp_channel_meters = copied_meters_ptr -> fnp_channel_meters;
	     call tty_space_man$free_space (size (fnp_channel_meters), copied_meters_ptr);
						/* through with buffer now */
	     pcb.copied_meters_offset = 0;
	     pcb.copied_meters_ready = "0"b;
	end;

	return;
     end save_copied_meters;

process_mode:
     proc (mode_name, mode_on);

dcl  mode_name char (*);
dcl  mode_on bit (1);
dcl  mode_name_index fixed bin;

	alter_data = "00000000"b || mode_on;

	if mode_name = "hndlquit"
	then do;
	     alter_type = Hndlquit;
	     pcb.hndlquit = mode_on;
	     hndlquit_set = "1"b;
	end;

	else if ^pcb.sync_line			/* if we haven't already decided what to do */
	then do;
	     if mode_name = "blk_xfer" | mode_name = "iflow"
						/* special stuff here */
	     then do;
		if mode_name = "blk_xfer"
		then do;
		     mode_name_index = BLK_XFER_INDEX;
		     alter_type = Block_xfer;
		end;
		else do;
		     mode_name_index = IFLOW_INDEX;
		     alter_type = Input_flow_control;
		end;

		if mode_on
		then do;				/* we have to tell it buffer sizes */
		     chars_per_sec = divide (pcb.baud_rate, 10, 17, 0);
		     base_len, block_len = divide (chars_per_sec, buf_per_second, 17, 0);
						/* and 1/2 second thereafter */
		end;
		else do;
		     base_len = 56;
		     block_len = 0;
		end;

		alter_data = alter_data || bit (bin (base_len, 18), 18) || bit (bin (block_len, 18), 18);
		mode_set (mode_name_index) = "1"b;
	     end;

	     else do;
		do i = 1 to hbound (mode_alter_types, 1) while (mode_name ^= async_only_modes (i));
		end;				/* note that blk_xfer is the last async_mode */

		if i > hbound (mode_alter_types, 1)
		then code = error_table_$bad_mode;

		else do;
		     alter_type = mode_alter_types (i);
		     mode_set (i) = "1"b;		/* this one is set now */
		end;
	     end;
	end;

	if code = 0
	then do;
	     mbx_data = bit (bin (alter_type, 9), 9) || alter_data;
	     call dn355$send_wcd (fnpp, pcbp, alter_parameters, length (alter_data) + 9, mbx_data);
	end;
	return;
     end;

send_global:
     proc (opcode);

/* this procedure calls dn355$send_global_wcd for the dump_fnp and patch_fnp orders */

dcl  opcode fixed bin (8);

	call pxss$addevent (FNP_DUMP_PATCH_EVENT);	/* so we'll be able to wait */
	mbx_data = addr (dump_fnp_data) -> based_bit72;
	call lock;
	if code ^= 0
	then return;

	call dn355$send_global_wcd (fnpp, opcode, 72, mbx_data);
	call unlock;

	call pxss$wait;				/* mustn't do anything till it's done */

	do while (fnp_info.dump_patch_in_progress);	/* didn't complete yet */
	     if ^fnp_info.running			/* FNP crashed out from under us */
	     then do;
		code = error_table_$mpx_down;
		fnp_info.dump_patch_in_progress = "0"b; /* so we'll get out of loop */
	     end;

	     else if clock () - dump_patch_time > DUMP_PATCH_LIMIT
						/* time's up! */
	     then do;
		code = error_table_$timeout;		/* can this operation */
		fnp_info.dump_patch_disabled = "1"b;
		fnp_info.dump_patch_in_progress = "0"b;
		call syserr (ANNOUNCE, "fnp_multiplexer: ^[dump^;patch^]_fnp order to FNP ^a timed out.",
		     opcode = dump_mem, fnp_info.fnp_tag);
	     end;

	     else do;				/* must be someone else's notify */
		call pxss$addevent (FNP_DUMP_PATCH_EVENT);
		if fnp_info.dump_patch_in_progress	/* make sure it still hasn't happened */
		then call pxss$wait;
		else call pxss$delevent (FNP_DUMP_PATCH_EVENT);
						/* never mind, it's done */
	     end;

	end;

	return;					/* all right, we're done */

     end send_global;

get_fnp_meters:
     proc (global);

/* subroutine to issue request for meters from FNP and wait for them to arrive */

dcl  global bit (1) parameter;			/* indicates whether subchannel or whole FNP */
dcl  space_size fixed bin;
dcl  fnp_meter_wait_start fixed bin (71);

	if fnp_info.dump_patch_disabled
	then do;
	     code = error_table_$timeout;		/* don't even try */
	     fnp_meters_ptr = null ();		/* so caller won't try to free space */
	     return;
	end;

	if global
	then space_size = size (fnp_global_meters);
	else space_size = size (fnp_channel_meters);

	call tty_space_man$get_space (space_size, fnp_meters_ptr);
	if fnp_meters_ptr = null ()
	then do;
	     code = error_table_$noalloc;
	     return;
	end;

	mbx_data = bit (bin (tty_buf.absorig + bin (rel (fnp_meters_ptr)), 18), 18);
	call pxss$addevent (FNP_METER_EVENT);
	fnp_meter_wait_start = clock ();

	if global					/* it's for whole FNP */
	then do;
	     if fnp_info.get_meters_waiting
	     then do;
		code = error_table_$seglock;		/* can't have two going at once */
		return;
	     end;

	     fnp_info.get_meters_waiting = "1"b;
	     call dn355$send_global_wcd (fnpp, report_meters, 18, mbx_data);
	     pcbp = fnpp;				/* to avoid faults in loop test */
	end;

	else do;
	     pcb.get_meters_waiting = "1"b;
	     call dn355$send_wcd (fnpp, pcbp, report_meters, 18, mbx_data);
	end;

	call unlock;				/* while waiting */
	call pxss$wait;
	call lock;				/* while checking */

	do while ((global & fnp_info.get_meters_waiting) | (^global & pcb.get_meters_waiting));
	     if ^fnp_info.running
	     then do;
		code = error_table_$mpx_down;
		go to abort_get_meters;
	     end;

	     else if clock () - fnp_meter_wait_start > DUMP_PATCH_LIMIT
	     then do;
		code = error_table_$timeout;
		fnp_info.dump_patch_disabled = "1"b;
		call syserr (ANNOUNCE,
		     "fnp_multiplexer: get_meters order for FNP ^a^[^s^;, line ^o,^] timed out.", fnp_info.fnp_tag,
		     global, string (pcb.line_number));
abort_get_meters:
		if global
		then fnp_info.get_meters_waiting = "0"b;
		else pcb.get_meters_waiting = "0"b;
	     end;

	     else do;
		call unlock;			/* in case we wait some more */
		call pxss$addevent (FNP_METER_EVENT);
		if (global & fnp_info.get_meters_waiting) | (^global & pcb.get_meters_waiting)
						/* check if it happened since we checked */
		then call pxss$wait;
		else call pxss$delevent (FNP_METER_EVENT);
		call lock;
	     end;
	end;

	return;
     end get_fnp_meters;

name_to_pcb:
     proc (name);

dcl  name char (*);

	code = 0;
	call parse_tty_name_ (name, his_fnp_no, hsla_flag, la_no, subchan);
	call lock;
	if code ^= 0
	then return;

	if his_fnp_no ^= fnp_info.fnp_number
	then go to bad_device;

	if hsla_flag
	then pcbx = fnp_info.hsla_idx (la_no);
	else pcbx = fnp_info.lsla_idx (la_no);
	if pcbx = -1
	then go to bad_device;

	found, past = "0"b;
	do j = pcbx to fnp_info.no_of_channels while (^past & ^found);
	     pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (j));
	     if pcb.la_no ^= bit (bin (la_no, 3), 3)
	     then past = "1"b;
	     else if pcb.slot_no = bit (bin (subchan, 6), 6)
	     then found = "1"b;
	end;

	if ^found
	then do;
bad_device:
	     call unlock;
	     code = error_table_$bad_channel;
	     return;
	end;

	return;
     end name_to_pcb;

lock:
     proc;

/* subroutine to lock the mailbox lock (which incidentally protects PCBs too) */

	if fnpp = null ()
	then do;
	     code = error_table_$mpx_down;
	     return;
	end;

	code = 0;

	lctep = fnp_info.lcte_ptr;
	if lcte.lock = pds$processid			/* called as result of our own interrupt? */
	then if lcte.locked_for_interrupt
	     then mylock = "1"b;			/* remember not to unlock it */
	     else call syserr (CRASH_SYSTEM, "fnp_multiplexer: mylock error");
	else do;
	     mylock = "0"b;
	     call tty_lock$lock_lcte (lctep, code);
	     locked = (code = 0);
	end;
	return;
     end lock;



unlock:
     proc;

/* subroutine to release mailbox lock and process queued interrupts */

	if locked
	then if ^mylock
	     then do;

		call dn355$process_interrupt_queue ((fnp_info.fnp_number));
		locked = "0"b;			/* it unlocks the channel lock when it's done */

	     end;
	return;

     end unlock;


fnp_buf_size:
     proc returns (bit (18));

/* internal procedure returns correct buffer size for FNP to use, based on baud rate
   *  and synchronous/asynchronous
*/

	do i = 1 to n_sync_line_types while (pcb.line_type ^= sync_line_type (i));
	end;

	if i <= n_sync_line_types
	then do;
	     pcb.sync_line = "1"b;
	     chars_per_buf = divide (divide (pcb.baud_rate, 8, 17, 0), buf_per_second, 17, 0);
	end;

	else do;
	     pcb.sync_line = "0"b;
	     chars_per_buf = 56;			/* always minimum for asynchronous */
	end;

	return (bit (bin (chars_per_buf, 18), 18));
     end fnp_buf_size;


/**** Wired entrypoints to talk to io_manager for both fnp_multiplexer
      and the fnp_util TandD code. These should be called under
      the FNP lcte lock. */

declare  a_fnp_no fixed bin;
declare  fnp_no fixed bin;

assign:
     entry (a_fnp_no, a_code);

	infop = addr (dn355_data$);
	call TRACE ("assign");
	fnp_no = a_fnp_no;
	fnpp = addr (datanet_info.per_datanet (fnp_no));
	call assign_channel (code);
	a_code = code;
	return;


unassign:
     entry (a_fnp_no, a_code);

	fnp_no = a_fnp_no;
	infop = addr (dn355_data$);
	call TRACE ("unassign");
	fnpp = addr (datanet_info.per_datanet (fnp_no));

	call unassign_channel (code);
	a_code = code;
	return;


assign_channel:
     procedure (code);
declare  code fixed bin (35);

	code = 0;
	if ^fnp_info.available
	then do;
	     code = error_table_$io_not_configured;	/* "not available" */
	     go to assign_channel_return;
	end;

	if fnp_info.io_manager_assigned
	then do;
	     code = error_table_$io_assigned;
	     go to assign_channel_return;
	end;

	call io_manager$assign (fnp_info.io_manager_chx, fnp_info.io_chanid, dn355$interrupt, (fnp_info.fnp_number),
	     (null ()), code);
	fnp_info.io_manager_assigned = (code = 0);
assign_channel_return:
	if datanet_info.trace | datanet_info.debug_stop
	then call syserr (ANNOUNCE, "fnp_multiplexer$assign_channel: Assignment of FNP ^a ^[succeeded^;failed^].",
		fnp_info.fnp_tag, (code = 0));
	if code ^= 0
	then call TRACE_ERROR ("assign_channel", code);
	return;
     end assign_channel;

unassign_channel:
     procedure (code);
declare  code fixed bin (35);


	if ^fnp_info.io_manager_assigned
	then do;
	     code = error_table_$io_not_assigned;
	     go to unassign_return;
	end;
	call io_manager$unassign (fnp_info.io_manager_chx, code);
	if code = 0
	then fnp_info.io_manager_assigned = "0"b;
unassign_return:
	if datanet_info.trace | datanet_info.debug_stop
	then call syserr$error_code (ANNOUNCE, code,
		"fnp_multiplexer$unassign_channel: Unassignment of FNP ^a ^[failed^;succeeded^].", fnp_info.fnp_tag,
		(code ^= 0));
	if code ^= 0
	then call TRACE_ERROR ("unassign_channel", code);
	return;
     end unassign_channel;

TRACE:
     procedure (Entry);

declare  Entry char (32);

	if datanet_info.trace
	then call syserr (ANNOUNCE, "fnp_multiplexer$^a: Tracing call.", Entry);
	return;



TRACE_ERROR:
     entry (Entry, Code);

declare  Code fixed bin (35);

	if datanet_info.trace | datanet_info.debug_stop
	then call syserr$error_code (ANNOUNCE, Code, "fnp_multiplexer$^a: Tracing error.", Entry);
	if datanet_info.debug_stop
	then call syserr (CRASH_SYSTEM, "fnp_multiplexer: debugging stop (type go to continue).");
	return;
     end TRACE;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   fnp_multiplexer: patching FNP X for USER:
   ADDR from XXX to YYY

   S:	$info

   T:	$run

   M:	The memory of FNP X is being patched by the privileged
   user whose user_id is USER. ADDR is the absolute location in FNP memory that is being
   patched (in octal); XXX and YYY are the old and new values of the location
   respectively (also in octal).
   The second line may be repeated (with different values) if more than one word
   is being patched.

   A:	This information is for logging purposes.


   Message:
   fnp_multiplexer: mylock error

   S:	$crash

   T:	$run

   M:	An attempt has been made to lock an FNP channel lock to a process
   that already has it locked.

   A:	$inform


   Message:
   fnp_multiplexer: NAME order to FNP X timed out.

   S:	$info

   T:	$run

   M:	NAME is "get_meters", "dump_fnp", or "patch_fnp". The named order to
   FNP X failed to complete within 10 seconds. The buffer space associated
   with the order has been abandoned, and get_meters, dump, and patch orders
   to that FNP are disabled until the FNP is reloaded.

   A:	$inform


   Message:
   fnp_multiplexer: get_meters order for FNP X, line N, timed out.

   S:     $info

   T:     $run

   M:     A get_meters order for line N of FNP X failed to complete within 10
   seconds. The buffer space associated with the order has been abandoned, and
   get_meters, dump, and patch orders to that FNP are disabled until the FNP
   is reloaded.


   Message:
   fnp_multiplexer$shutdown: Failed to unwire fnp. ERROR.

   S:	$info

   T:	$run

   M:	An attempt to unwire the pages used for I/O to an FNP failed at FNP
   shutdown. ERROR contains the message derived from a standard system error
   code.

   A:	$inform


   Message:
   fnp_multiplexer$shutdown: Called with null fnp_ptr

   S:	$info

   T:	$run

   M:	A call was made to the shutdown entry with a null pointer to
   fnp_info. This message only appears if tracing is enabled for the specified
   FNP. 

   A:	$inform


   Message:
   fnp_multiplexer$shutdown: Called with FNP wired.

   S:	$info

   T:	$run

   M:	A call was made to the shutdown entry while the pages for I/O for an
   FNP were still wired.
   This message only appears if tracing is enabled for the specified FNP.

   A:	none required.


   Message:
   fnp_multiplexer$assign_channel: Assignment of FNP X {succeeded | failed}.

   S:	$info

   T:	$run

   M:	Indicates the result of a call to io_manager$assign for FNP X.
   This message only appears if tracing is enabled for the specified FNP.

   A:	none required.


   Message:
   fnp_multiplexer$unassign_channel: Unassignment of FNP X {succeeded | failed}.

   S:	$info

   T:	$run

   M:	Indicates the result of a call to io_manager$unassign for FNP X.
   This message only appears if tracing is enabled for the specified FNP.

   A:	none required.


   Message:
   fnp_multiplexer$ENTRY: Tracing call.

   S:	$info

   T:	$run

   M:	A call was made to the ENTRY entry.
   This message only appears if tracing is enabled for the specified FNP.

   A:	none required.


   Message:
   fnp_multiplexer$ENTRY: Tracing error. ERROR.

   S:	$info

   T:	$run

   M:	The error code represented by ERROR was encountered by ENTRY.
   This message only appears if tracing is enabled for the specified FNP.

   A:	none required.


   Message:
   fnp_multiplexer: debugging stop (type go to continue).

   S:	$crash

   T:	$run

   M:	An error has been encountered in setting up an FNP, and debugging
   mode is turned on.

   A:	Use BCE commands to analyze the condition, if necessary; type "go"
   to resume system operation.

   END MESSAGE DOCUMENTATION */



     end fnp_multiplexer;




		    fnp_util.pl1                    11/11/89  1132.7r w 11/11/89  0825.4      398187



/****^  ***********************************************************
        *                                                         *
        * 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(86-06-05,GJohnson), approve(86-06-05,MCR7387),
     audit(86-06-10,Martinson), install(86-07-11,MR12.0-1091):
     Correct error message documentation.
                                                   END HISTORY COMMENTS */


/* format: style4,delnl,insnl,^ifthendo */
fnp_util:
     procedure;

/* This procedure contains entries called through hphcs_ used to load and dump an
   *  FNP. The "wire" entry is used to wire the segment containing the core image so that
   *  DIA I/O will be possible; the "load" entry initiates the bootload I/O; the
   *  "release" entry releases the aste of the coreimage.
   *  The "fdump" entry dumps all of FNP memory into a segment supplied
   *  by the caller.
   *
   *  Written 5/19/76 by Robert S. Coren
   *  Modified 10/28/76 by Robert S. Coren to save version number and report core image name
   *  Modified 04/15/77 by Robert S. Coren to correct bug in queue buffer freeing
   *  Modified 9/27/78 by J. Stern for multiplexing changes
   *  Modified 79 May 14 by Art Beattie to get memory size and FNP type from caller for fdump entry.
   *  Modified April 1981 by Chris Jones for io_manager conversion
   *  Modified February 1982 by C. Hornig for MR10 io_manager.
   *  Modified 830714 BIM to remove the release entrypoint. abort is suffcient.
   *  Modified 83-12-20 BIM for reconfiguration.
   *  Modified 84-05-18 BIM for better maintenance of io_manager_assigned bit.
   *  Modified 1984-08-02 BIM for code return from load.
   *  Modified 1984-07-26 BIM for paged I/O on loads.
   *  Modified 1985-01-29, BIM: fix dump_mpx to leave chn unassigned.
   *  Modified 1985-03-12, E. Swenson to fix unitialized timeout flag to 
   *     prevent spurious timeout errors.
*/


/* PARAMETERS */

dcl  a_devx fixed bin;				/* ioam release param */
dcl  a_fnp_no fixed bin;
dcl  a_fnp_mem_size fixed bin;			/* FNP memory size in 1024 18-bit words */
dcl  a_fnp_type fixed bin;
dcl  a_ptr ptr;
dcl  a_load_info_ptr ptr;
dcl  a_count fixed bin;				/* number of words to wire */
dcl  a_code fixed bin (35);				/* OUTPUT */
dcl  a_ev_chan fixed bin (71);
dcl  a_absadr fixed bin (24);				/* OUTPUT from wire and info, INPUT to load */
dcl  a_version char (4);				/* INPUT MCS version number */
dcl  a_image_name char (168);				/* INPUT core image name */
dcl  norm_int_cell fixed bin;				/* OUTPUT */
dcl  emergency_int_cell fixed bin;			/* OUTPUT */
dcl  a_ints bit (2) aligned;				/* OUTPUT rcvd interrupts */
dcl  a_level fixed bin (3);				/* INPUT level on which to interrupt fnp */
dcl  a_fnp_addr fixed bin (15);			/* INPUT data address in fnp */

/* AUTOMATIC */

dcl  auto_absadr fixed bin (24);
dcl  dia_timeout bit (1) aligned;
dcl  fnp_no fixed bin;
dcl  fnp_mem_size fixed bin;
dcl  fnp_type fixed bin;
dcl  fnp_addr fixed bin (15);
dcl  chanid char (8) aligned;
dcl  opcode bit (6) aligned;
dcl  temp_fnp_name char (32);
dcl  fnp_size fixed bin;
dcl  segptr ptr;
dcl  nwords fixed bin;
dcl  code fixed bin (35);
dcl  iom_channel_number fixed bin (7);
dcl  devx fixed bin;
dcl  i fixed bin;
dcl  data_ptr ptr;
dcl  offset fixed bin;
dcl  fnp_tally fixed bin;
dcl  start_time fixed bin (71);
dcl  version char (4);
dcl  cur_la_no bit (3);
dcl  cur_slot_no fixed bin (6);
dcl  load_info_ptr ptr;
dcl  locked bit (1) aligned init ("0"b);
dcl  config_locked bit (1) aligned init ("0"b);

declare  message fixed bin (71);
declare  1 auto_fnp_msg aligned like fnp_msg;

/* BUILTINS */

dcl  (addr, addrel, baseno, bit, clock, fixed, min, null, ptr, string, substr) builtin;


/* ENTRIES */

dcl  config_$find_2 entry (character (4) aligned, character (4) aligned, pointer);
dcl  fnp_multiplexer$assign entry (fixed binary, fixed binary (35));
dcl  fnp_multiplexer$unassign entry (fixed binary, fixed binary (35));
dcl  fnp_multiplexer$fnp_lock entry (pointer, fixed binary (35));
dcl  fnp_multiplexer$fnp_unlock entry (pointer);
dcl  get_fnp_name_ entry (fixed bin) returns (char (32));
dcl  grab_aste$grab_aste_io entry (ptr, fixed bin, fixed bin (35)) returns (ptr);
dcl  grab_aste$release_io entry (ptr);
dcl  ioam_$assign entry (fixed bin, entry, fixed bin (35));
dcl  ioam_$unassign entry (fixed bin, fixed bin (35));
dcl  priv_channel_manager$get_devx entry (char (*), fixed bin, fixed bin (35));
dcl  dn355_util$compute_parity entry (bit (36)) returns (bit (36));
dcl  absadr entry (ptr, fixed bin (35)) returns (fixed bin (24));
dcl  ioi_page_table$get entry (fixed binary (19), fixed binary, fixed binary (35));
dcl  ioi_page_table$fill entry (fixed binary, pointer, fixed binary (35));
dcl  ioi_page_table$ptx_to_ptp entry (fixed binary) returns (pointer);
dcl  ioi_page_table$put entry (fixed binary, fixed binary (35));
dcl  pxss$notify entry (fixed bin);
dcl  pxss$addevent entry (fixed bin);
dcl  pxss$delevent entry (fixed bin);
dcl  pxss$wait entry;
dcl  pxss$ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
dcl  get_ptrs_$given_segno entry (fixed bin) returns (ptr);
dcl  dn355$interrupt entry;
dcl  syserr entry options (variable);
dcl  syserr$error_code entry options (variable);
dcl  lock$wait entry (ptr, char (4) aligned, fixed bin (35));
dcl  lock$lock_fast entry (pointer);
dcl  lock$unlock_fast entry (pointer);
dcl  lock$unlock entry (ptr, char (4) aligned);
dcl  (
     pc_abs$wire_abs,
     pc_abs$wire_abs_contig
     ) entry (ptr, fixed bin, fixed bin, fixed bin (35));
dcl  pc_abs$unwire_abs entry (ptr, fixed bin, fixed bin);

/* EXTERNAL STATIC */

dcl  (
     error_table_$io_no_permission,
     error_table_$invalid_state,
     error_table_$bad_mpx_load_data,
     error_table_$no_io_interrupt,
     error_table_$rqover,
     error_table_$bad_segment,
     error_table_$noalloc,
     error_table_$action_not_performed,
     error_table_$io_configured,
     error_table_$io_not_configured,
     error_table_$io_assigned,
     error_table_$io_not_assigned,
     error_table_$io_not_defined
     ) fixed bin (35) ext static;

dcl  pds$processid bit (36) ext static;
dcl  pds$process_group_id char (32) ext static;
dcl  tc_data$initializer_id bit (36) aligned external static;
dcl  tty_buf$fnp_config_flags (1:8) bit (1) unaligned external static;
dcl  tty_buf$lct_ptr pointer external static;
dcl  sst$astsize fixed bin external;
dcl  sys_info$page_size fixed bin external;
dcl  sys_info$seg_size_256K fixed bin (19) external;

/* INTERNAL STATIC */

dcl  (
     FNP_DOWN init (2)
     ) fixed bin int static options (constant);

dcl  fdump_seg_event char (4) aligned init ("fnpd") static options (constant);
dcl  cleanup condition;
dcl  record_quota_overflow condition;


/* BASED */

dcl  tally_words (fnp_tally) bit (36) aligned based;

dcl  1 dump_355_control aligned based (data_ptr),		/* word used to supply 355 address and tally for fdump */
       2 address_mode bit (3) unaligned,		/* always 36-bit addressing ("001"b) */
       2 fnp_address bit (15) unaligned,
       2 tally fixed bin (17) unaligned;

dcl  1 dump_6670_control aligned based (data_ptr),	/* word used to supply DN6670 address and tally for fdump */
       2 fnp_address fixed bin (18) unsigned unaligned,
       2 unpaged bit (1) unaligned,
       2 mbz bit (5) unaligned,
       2 tally fixed bin (12) unsigned unaligned;

dcl  1 load_info aligned based (load_info_ptr),		/* used to assign baud rates and line types at bootload time */
       2 no_entries fixed bin,
       2 entries (0 refer (load_info.no_entries)),
         3 devx fixed bin,
         3 baud_rate fixed bin,
         3 line_type fixed bin;



wire:
     entry (a_fnp_no, a_ptr, a_absadr, a_count, a_code);

/* entry called to wire a_count words for segment at a_ptr */
/* This does not require lock protection. If we miss a deconfig, tough */

	fnp_no = a_fnp_no;				/* copy args */
	segptr = a_ptr;
	nwords = a_count;

	call validate_fnp_ret ("wire");
	call validate_assigned_ret ("wire");

	if fnp_info.wired				/* Someone did it already? */
	then do;
	     a_code = 0;				/* be gracious */
	     if datanet_info.trace
	     then call syserr (ANNOUNCE, "fnp_util$wire: FNP ^a already wired.", fnp_info.fnp_tag);
						/* but note for debugging */
	     return;
	end;

	astep = grab_aste$grab_aste_io (segptr, nwords, code);
						/* make segment stay active */

	if code ^= 0
	then go to wire_error_return;

	fnp_info.astep = astep;
	fnp_info.n_pages_wired = divide (nwords + sys_info$page_size - 1, sys_info$page_size, 17, 0);

	call pc_abs$wire_abs (astep, 0, fnp_info.n_pages_wired, code);
						/* no contig -- we will use a page table! */
	if code ^= 0
	then do;
	     call grab_aste$release_io (astep);		/* couldn't wire, so let aste go */
	     go to wire_error_return;
	end;
	call fill_bootload_page_table;		/* sets the variable absadr */
	if datanet_info.trace
	then call syserr (ANNOUNCE, "fnp_util$wire: seg: ^p n_pages: ^d astep ^p", segptr, fnp_info.n_pages_wired,
		astep);

	a_absadr = auto_absadr;			/* relative to page table its 0 */
	fnp_info.wired = "1"b;

wire_error_return:
	if code ^= 0 & (datanet_info.trace | datanet_info.debug_stop)
	then do;
	     call syserr$error_code (ANNOUNCE, code, "fnp_util$wire: failed.");
	     call STOP_CHECK ("wire");
	end;
	a_code = code;
	return;


load:
     entry (a_fnp_no, a_absadr, a_ev_chan, a_version, a_image_name, a_fnp_mem_size, a_load_info_ptr, a_code);

/* entry to initiate bootload I/O for loading an FNP */
/* This cannot lock until it has the dump seg wired */

	fnp_no = a_fnp_no;
	fnp_mem_size = a_fnp_mem_size;
	auto_absadr = a_absadr;
	call validate_fnp_ret ("load");
	call validate_assigned_ret ("load");

	if datanet_info.trace
	then call syserr (ANNOUNCE, "fnp_util$load: FNP ^d ADDR ^o", fnp_no, auto_absadr);

	if fnp_info.bootloading
	then do;					/* we can't do it while it's already happening */
	     code = error_table_$invalid_state;
	     call syserr (ANNOUNCE, "fnp_util$load: FNP load already in progress for FNP ^a.", fnp_info.fnp_tag);
	     go to load_return;
	end;

	if ^fnp_info.wired
	then do;
	     code = error_table_$invalid_state;
	     if datanet_info.trace
	     then call syserr (ANNOUNCE, "fnp_util$load: FNP ^a not wired.", fnp_info.fnp_tag);
	     go to load_return;
	end;

	if fnp_info.running
	then do;
	     code = error_table_$invalid_state;
	     if datanet_info.trace
	     then call syserr (ANNOUNCE, "fnp_util$load: FNP ^a is running.", fnp_info.fnp_tag);
	     go to load_return;
	end;

	if fnp_info.t_and_d_in_progress
	then do;
	     code = error_table_$invalid_state;
	     if datanet_info.trace
	     then call syserr (ANNOUNCE, "fnp_util$load: FNP ^a is running T&D.", fnp_info.fnp_tag);
	     go to load_return;
	end;

/* process the load_info data */

	load_info_ptr = a_load_info_ptr;
	if load_info.no_entries ^= fnp_info.no_of_channels
	then do;
	     code = error_table_$bad_mpx_load_data;
	     go to load_return;
	end;

	cur_la_no = "7"b3;				/* no current line adaptor */
	n_pcbs = load_info.no_entries;
	do i = 1 to load_info.no_entries;		/* get baud rates to store in pcbs */
	     pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (i));
	     if load_info (i).devx ^= pcb.devx		/* load_info does not match pcb_array */
	     then do;
		code = error_table_$bad_mpx_load_data;
		go to load_return;
	     end;
	     pcb.baud_rate = load_info (i).baud_rate;
	     pcb.line_type = load_info (i).line_type;

	     if ^pcb.is_hsla			/* this pcb is for an lsla subchannel */
	     then do;				/* must figure out its slot number */
		if pcb.la_no ^= cur_la_no		/* starting a new line adaptor */
		then do;
		     cur_la_no = pcb.la_no;
		     cur_slot_no = 1;
		end;

		pcb.slot_no = bit (cur_slot_no, 6);
		if pcb.baud_rate <= 110
		then cur_slot_no = cur_slot_no + 1;	/* this subchan uses 1 time slot */
		else if pcb.baud_rate <= 150
		then cur_slot_no = cur_slot_no + 2;	/* this subchan uses 2 time slots */
		else cur_slot_no = cur_slot_no + 3;	/* this subchan uses 3 time slots */
	     end;
	end;

/* it's okay to try to load */

	call lock_fnp;
	if ^fnp_info.io_manager_assigned		/* lost race with deconfig */
	then do;					/* or even T&D */
	     call unlock_fnp;
	     code = error_table_$io_not_assigned;	/* perhaps deconfigured, but ... */
	     go to load_return;
	end;
	version = a_version;
	call syserr (ANNOUNCE, "Loading FNP ^a, ^a ^a", fnp_info.fnp_tag, a_image_name, version);

	fnp_info.boot_ev_chan = a_ev_chan;
	fnp_info.boot_process_id = pds$processid;
	fnp_info.version = version;
	fnp_info.fnp_mem_size = fnp_mem_size * 1024;
	fnp_info.bootloading = "1"b;
	datanet_mbx.mailbox_requests = 0;		/* clear fields in mbx for this load */
	datanet_mbx.term_inpt_mpx_wd = "0"b;
	datanet_mbx.last_mbx_req_count = 0;
	string (datanet_mbx.mbx_used_flags) = "0"b;

	datanet_mbx.crash_data.fault_code = 0;
	datanet_mbx.crash_data.ic = 0;
	datanet_mbx.crash_data.iom_fault_status = 0;
	datanet_mbx.crash_data.fault_word = 0;

	auto_absadr = sys_info$page_size * FIRST_BOOTLOAD_PAGEX;

	call mask_dia;				/* Mask the IOM channel  to initialize it */
	call connect_to_dia_paged (auto_absadr, 0, "72"b3, dia_timeout);
						/* 72 (8), bootload command */

	if dia_timeout
	then code = error_table_$no_io_interrupt;
	else code = 0;				/* all is well so far */
	call unlock_fnp;				/* however, deconfigure has a problem if bootloading is on! */

load_return:
	if code ^= 0 & (datanet_info.trace | datanet_info.debug_stop)
	then do;
	     call syserr$error_code (ANNOUNCE, code, "fnp_util$load: Error loading FNP ^a.", fnp_info.fnp_tag);
	     call STOP_CHECK ("load");
	end;
	a_code = code;
	return;


info:
     entry (a_fnp_no, a_absadr, norm_int_cell, emergency_int_cell, a_code);

/* entry called to return address of mailbox area and FNP interrupt cells */

	fnp_no = a_fnp_no;
	call validate_fnp_ret ("info");

	a_absadr = absadr (fnp_info.mbx_pt, code);
	if code = 0
	then do;					/* provided everything's ok */
	     norm_int_cell = 3;			/* customary assignments */
	     emergency_int_cell = 7;
	end;

	a_code = code;
	return;

fill_page_table:
     entry (a_fnp_no, a_code);

	fnp_no = a_fnp_no;
	call validate_fnp_ret ("fill_page_table");
	call validate_assigned_ret ("fill_page_table");
	if fnp_info.ptx ^= -1 | fnp_info.ptp ^= null ()
	then do;
	     call syserr (ANNOUNCE, "fnp_util$fill_page_table: page table already assigned for FNP ^a.",
		fnp_info.fnp_tag);
	     call STOP_CHECK ("fill_page_table");
	end;
	call get_page_table (code);
	if code ^= 0 & (datanet_info.trace | datanet_info.debug_stop)
	then do;
	     call syserr$error_code (ANNOUNCE, code, "fnp_util$fill_page_table: ioi_page_table$get failed for FNP ^a.",
		fnp_info.fnp_tag);
	     call STOP_CHECK ("fill_page_table");
	end;
	a_code = code;
	return;

free_page_table:
     entry (a_fnp_no, a_code);

	fnp_no = a_fnp_no;
	call validate_fnp_ret ("free_page_table");
	if fnp_info.ptx = -1
	then do;
	     call syserr (ANNOUNCE, "fnp_util$free_page_table: no page table assigned for FNP ^a.", fnp_info.fnp_tag);
	     go to ret_bad_code;
	end;
	call ioi_page_table$put (fnp_info.ptx, code);
	fnp_info.ptx = -1;
	fnp_info.ptp = null ();
	a_code = code;
	return;


unwire:
     entry (a_fnp_no, a_code);

/* entry called to abort bootload or cleanup from successful bootload */
/* no locking for same reason as wire */

	fnp_no = a_fnp_no;
	call validate_fnp_ret ("unwire");

/* Don't demand assigned so that loads aborted by deconfig can unwire */

	call internal_unwire;
	fnp_info.bootloading = "0"b;

	if code ^= 0 & (datanet_info.trace | datanet_info.debug_stop)
	then do;
	     call syserr$error_code (ANNOUNCE, code, "fnp_util$unwire: Unwire failed for FNP ^a.", fnp_info.fnp_tag);
	     call STOP_CHECK ("unwire");
	end;
	a_code = code;
	return;


/* RECONFIGURATION ENTRYPOINTS */

/* Configure -- add a FNP to the available collection for assignment */

configure:
     entry (a_fnp_no, a_code);

	fnp_no = a_fnp_no;
	call validate_fnp_ret ("configure");
	call lock_fnp;
	if fnp_info.available
	then do;
	     code = error_table_$io_configured;
	     if datanet_info.trace | datanet_info.debug_stop
	     then call syserr (ANNOUNCE, "fnp_util$configure: FNP ^a already configured.", fnp_info.fnp_tag);
	     call STOP_CHECK ("configure");
	     go to configure_return;
	end;
	fnp_info.available = "1"b;
	fnp_info.io_manager_assigned = "0"b;		/* clean up */
	fnp_info.flags = "0"b;			/* state information */
configure_return:
	call unlock_fnp;
	if code = 0
	then do;
	     call config_$find_2 ("prph", "fnp" || fnp_info.fnp_tag, prph_fnp_cardp);
	     prph_fnp_card.state = "on";
	     call syserr (ANNOUNCE, "fnp_util: FNP ^a added to configuration^[ by ^a^].", fnp_info.fnp_tag,
		pds$processid ^= tc_data$initializer_id, pds$process_group_id);
	end;
	a_code = code;
	return;

/**** Deconfigure -- remove from configuration.
      This entrypoint causes a FNP crash for the selected FNP.
*/

deconfigure:
     entry (a_fnp_no, a_code);

	fnp_no = a_fnp_no;
	call validate_fnp_ret ("deconfigure");
	call lock_fnp;

	if ^fnp_info.available
	then do;
	     code = error_table_$io_not_configured;
	     go to deconfigure_return;
	end;

	fnp_info.available = "0"b;			/* throttle init_multiplexer */

	if ^fnp_info.io_manager_assigned
	then go to deconfigure_return;

	/*** here is the interesting part. What we do depends on who is active */

	if fnp_info.t_and_d_in_progress
	then do;
	     call unlock_fnp;			/* must lock in correct order */
	     call release_t_and_d;			/* unassigns channel */
	     go to deconfigure_return_unlocked;
	end;
	else do;
	     call mask_dia;				/* stop it from writing to us or sending stuff */
	     call fnp_multiplexer$unassign (fnp_no, (0)); /* has to succeed, we are under lock */
	     /*** turns off io_manager_assigned for us, nailing io_manager callers */
	     auto_fnp_msg.fnp_no = fnp_info.fnp_number;
	     auto_fnp_msg.state = FNP_DOWN;
	     auto_fnp_msg.flags = "0"b;
	     auto_fnp_msg.deconfigured = "1"b;
	     unspec (message) = unspec (auto_fnp_msg);
	     call pxss$ring_0_wakeup (fnp_info.boot_process_id, fnp_info.boot_ev_chan, message, (0));
	end;

	/*** all callers of io_manager must hold LCTE lock and check io_manager_assigned */

deconfigure_return:
	call unlock_fnp;
deconfigure_return_unlocked:
	if code = 0
	then do;
	     call config_$find_2 ("prph", "fnp" || fnp_info.fnp_tag, prph_fnp_cardp);
	     prph_fnp_card.state = "off";
	     call syserr (ANNOUNCE, "fnp_util: FNP ^a deleted from configuration^[ by ^a^].", fnp_info.fnp_tag,
		pds$processid ^= tc_data$initializer_id, pds$process_group_id);
	end;
	a_code = code;
	return;




fdump:
     entry (a_fnp_no, a_fnp_type, a_fnp_mem_size, a_ptr, a_code);

/* entry to read in contents of FNP core for fdump_fnp_.  It is passed a pointer
   *  to the segment in which the dump is supposed to be put.  The one-page fnp_dump_seg
   *  is wired down, and FNP core is read into it in chunks.
*/

/* Like load, locking must follow wiring of fnp dump seg */

	fnp_no = a_fnp_no;
	fnp_type = a_fnp_type;
	fnp_mem_size = a_fnp_mem_size;
	segptr = a_ptr;

	call validate_fnp_ret ("fdump");

	if fnp_info.running | fnp_info.bootloading | fnp_info.t_and_d_in_progress
	then do;
	     code = error_table_$invalid_state;		/* nope */
	     go to ret_bad_code;
	end;

	fnp_dump_ptr = addr (fnp_dump_seg$);
	on cleanup
	     begin;
	     if fnp_dump_seg.lock = pds$processid
	     then call lock$unlock (addr (fnp_dump_seg.lock), fdump_seg_event);
	end;
	call lock$wait (addr (fnp_dump_seg.lock), fdump_seg_event, code);
	if code ^= 0
	then go to ret_bad_code;

	call wire_dump_seg;
	if code ^= 0
	then go to unlock_dump_seg;

	fnp_dump_seg.flags = "0"b;			/* aggregately */
	call assign_interrupt (dump_interrupt, code);	/* we will handle DIA interrupts for this */
	if code ^= 0				/* checks to make sure we haven't been forcible unassigned */
	then go to unwire_buffer;

	data_ptr = addr (fnp_dump_seg.data);
	if fnp_type = DN6670
	then dump_6670_control.unpaged = "1"b;		/* absolute 36-bit addressing for DIA */
	else dump_355_control.address_mode = "001"b;	/* 36-bit addressing for DIA */
	fnp_size = fnp_mem_size * 512;		/* size of FNP core in 36-bit words */

/* before we start, set up handler for record-quota overflow */

	on record_quota_overflow
	     begin;
	     code = error_table_$rqover;
	     go to restore_interrupts;
	end;

/* loop reading chunks of FNP memory */

	fnp_addr = 0;
	do offset = 0 to fnp_size by 1021;		/* 3 words less than a page */
	     fnp_tally = min (1021, fnp_size - offset);
	     call setup_dump_ctl_word;
	     call fdump_seg_io ("fdump", "75"b3, code);	/*  test data xfer */
	     if code ^= 0
	     then go to restore_interrupts;

/* Now copy the data into the permanent seg */

	     ptr (segptr, offset) -> tally_words = addr (fnp_dump_seg.data (2)) -> tally_words;
						/* word 0 and 1 are control words */
	end;

restore_interrupts:
	call unassign_interrupt;
unwire_buffer:
	call unwire_dump_seg;			/* and unwire buffer */
unlock_dump_seg:
	call lock$unlock (addr (fnp_dump_seg.lock), fdump_seg_event);
ret_bad_code:
	a_code = code;
	return;


fdump_seg_io:
     proc (caller, a_diaop, code);

dcl  caller char (32);
dcl  a_diaop bit (6) aligned;
dcl  code fixed bin (35);

	start_time = clock ();
	if datanet_info.trace
	then call syserr (ANNOUNCE, "fnp_util$fdump_seg_io: ^2.3b for ^a.", a_diaop, caller);
	call lock_fnp;				/* must be locked to connect */
	if ^fnp_info.io_manager_assigned
	then do;
	     call unlock_fnp;
	     code = error_table_$io_not_assigned;
	     return;
	end;

	fnp_dump_seg.fdump = "1"b;			/* so notify can be done */
	call pxss$addevent (tty_ev);
	call connect_to_dia (auto_absadr, 0, a_diaop, dia_timeout);
	call unlock_fnp;
	if ^dia_timeout
	then do;
	     call pxss$wait;			/* wait for interrupt */
	     if datanet_info.trace
	     then call syserr (ANNOUNCE, "fnp_util (fdump_seg_io): returned from first wait.");
	end;
	else do;
	     call pxss$delevent (tty_ev);
	     if datanet_info.trace
	     then call syserr (ANNOUNCE, "fnp_util (fdump_seg_io): DIA timeout.");
	     code = error_table_$no_io_interrupt;
	     return;
	end;

	do while (fnp_dump_seg.fdump);		/* when we get notify, make sure it's the right one */
	     if clock () - start_time > 5 * 1000 * 1000	/* if it's been more than 5 seconds */
	     then do;				/* punt */
		if datanet_info.trace
		then call syserr (ANNOUNCE, "fnp_util (fdump_seg_io): FNP timeout.");
		code = error_table_$no_io_interrupt;
		return;
	     end;

	     call pxss$addevent (tty_ev);
	     if fnp_info.t_and_d_in_progress
	     then if fnp_info.t_and_d_lev_3_occurred | fnp_info.t_and_d_lev_7_occurred
		then do;
		     code = 0;
		     return;
		end;
	     if fnp_dump_seg.fdump			/* it wasn't */
	     then call pxss$wait;			/* wait some more */
	     else call pxss$delevent (tty_ev);		/* otherwise we needn't have added event */
	end;
	code = 0;
     end fdump_seg_io;

dump_interrupt:
     entry (a_fnp_no, a_level, a_dummy);

/* this is our temporary FNP interrupt handler while doing fdump i/o */

dcl  a_dummy bit (36) aligned parameter;

	fnp_dump_ptr = addr (fnp_dump_seg$);
	infop = addr (dn355_data$);
	if datanet_info.trace
	then call syserr (ANNOUNCE,
		"fnp_util (dump_interrupt): Interrupt for FNP ^d level ^d. fnp_dump_seg.fdump = ""^b""b", a_fnp_no,
		a_level, fnp_dump_seg.fdump);
	if fnp_dump_seg.fdump			/* if we're really interested in this one */
	then do;
	     fnp_dump_seg.fdump = "0"b;		/* so we'll recognize notify */
	     call pxss$notify (tty_ev);
	end;
	return;

fnp_tandd_setup:
     entry (a_fnp_no, a_ev_chan, a_code);

	fnp_no = a_fnp_no;
	call validate_fnp_ret ("fnp_tandd_setup");

/* Must set up lcte ptr first if not done already, or lock
   won't work.  Chicken/egg problem notwithstanding, this will
   work, because other guy doing same thing. */

	temp_fnp_name = get_fnp_name_ (fnp_no);
	if fnp_info.lcte_ptr = null
	then do;
	     call priv_channel_manager$get_devx (temp_fnp_name, devx, code);
	     if code ^= 0
	     then go to ret_bad_code;
	     fnp_info.lcte_ptr = addr (tty_buf$lct_ptr -> lct.lcte_array (devx));
	end;

	call lock_fnp;

	if fnp_info.bootloading | fnp_info.running | fnp_info.t_and_d_in_progress
	then do;
	     code = error_table_$invalid_state;
	     go to tandd_setup_loses_unlock;
	end;

	call fnp_multiplexer$assign (fnp_no, code);
	if code ^= 0
	then do;
	     call syserr$error_code (ANNOUNCE, code, "fnp_util: channel assignment failed for FNP ^a.",
		fnp_info.fnp_tag);
	     go to tandd_setup_loses_unlock;
	end;

	call ioam_$assign ((fnp_info.io_manager_chx), fnp_tandd_release_handler, code);
	if code ^= 0
	then do;
	     call syserr$error_code (ANNOUNCE, code, "fnp_util: ioam_$assign failed for FNP ^a.", fnp_info.fnp_tag);
	     go to tandd_setup_loses_unlock;
	end;
	fnp_info.boot_process_id = pds$processid;
	fnp_info.t_and_d_lev_3_occurred, fnp_info.t_and_d_lev_7_occurred = "0"b;
	call syserr (ANNOUNCE, "fnp_util: assigned FNP ^a to ^a for T & D.", temp_fnp_name, pds$process_group_id);
	fnp_info.t_and_d_in_progress = "1"b;

tandd_setup_loses_unlock:
	if code = 0
	then fnp_info.boot_ev_chan = a_ev_chan;
	call unlock_fnp;
	a_code = code;
	return;

fnp_tandd_release_handler:
     entry (a_devx, a_code);

	devx = a_devx;
	infop = addr (dn355_data$);
	fnp_dump_ptr = addr (fnp_dump_seg$);
	on cleanup
	     begin;
	     if fnp_dump_seg.lock = pds$processid
	     then call lock$unlock (addr (fnp_dump_seg.lock), fdump_seg_event);
	end;
	do fnp_no = 1 to datanet_info.no_of_355s;
	     fnpp = addr (datanet_info.per_datanet (fnp_no));
	     if devx = fnp_info.io_manager_chx
	     then if fnp_info.t_and_d_in_progress
		then call release_t_and_d;
	end;
	return;

/**** T and D does not have to worry about force deconfiguration,
      since it is completely released at deconfigure time.
      Validate_fnp_tandd_ret will generate an error code if
      deconfiguration has stolen the FNP. */


fnp_tandd_detach:
     entry (a_fnp_no, a_code);
	fnp_no = a_fnp_no;

	call validate_fnp_tandd_ret ("fnp_tandd_detach");
	call lock_fnp;
	call validate_assigned_ret ("fnp_tandd_detach");

	call mask_dia;

	fnp_info.boot_process_id = "000000000000"b3;
	fnp_info.t_and_d_in_progress = "0"b;
	fnp_info.t_and_d_lev_3_occurred, fnp_info.t_and_d_lev_7_occurred = "0"b;
	call ioam_$unassign ((fnp_info.io_manager_chx), (0));
	call fnp_multiplexer$unassign (fnp_no, code);
	if code ^= 0
	then call syserr$error_code (ANNOUNCE, code, "fnp_util: io channel unassignment failed for FNP ^a.",
		fnp_info.fnp_tag);
	call syserr (ANNOUNCE, "fnp_util: releasing FNP ^a from ^a", fnp_info.fnp_id.fnp_tag, pds$process_group_id);
	call unlock_fnp;
	a_code = 0;
	return;

fnp_tandd_mask:
     entry (a_fnp_no, a_code);
	fnp_no = a_fnp_no;
	call validate_fnp_tandd_ret ("fnp_tandd_mask");
	call lock_fnp;
	call validate_assigned_ret ("fnp_tandd_mask");

	call mask_dia;
	call unlock_fnp;
	a_code = 0;
	return;

fnp_tandd_send_int:
     entry (a_fnp_no, a_level, a_code);
	fnp_no = a_fnp_no;
	call validate_fnp_tandd_ret ("fnp_tandd_send_int");
	call lock_fnp;
	call validate_assigned_ret ("fnp_tandd_send_int");

	fnp_info.t_and_d_lev_3_occurred, fnp_info.t_and_d_lev_7_occurred = "0"b;
	call connect_to_dia (0, a_level, "71"b3, dia_timeout);
	call unlock_fnp;
	if dia_timeout
	then a_code = error_table_$no_io_interrupt;
	a_code = 0;
	return;

fnp_tandd_get_ints:
     entry (a_fnp_no, a_ints, a_code);
	fnp_no = a_fnp_no;
	call validate_fnp_tandd_ret ("fnp_tandd_get_ints");
	call lock_fnp;
	call validate_assigned_ret ("fnp_tandd_get_ints");
	a_ints = fnp_info.t_and_d_lev_3_occurred || fnp_info.t_and_d_lev_7_occurred;
	fnp_info.t_and_d_lev_3_occurred, fnp_info.t_and_d_lev_7_occurred = "0"b;
	call unlock_fnp;
	a_code = 0;
	return;

fnp_tandd_read:
     entry (a_fnp_no, a_ptr, a_count, a_fnp_addr, a_fnp_type, a_code);
	opcode = "75"b3;
	go to fnp_t_and_d_rw_merge;

fnp_tandd_write:
     entry (a_fnp_no, a_ptr, a_count, a_fnp_addr, a_fnp_type, a_code);
	opcode = "76"b3;
fnp_t_and_d_rw_merge:
/**** To avoid LONG delays in deconfiguration, this does not lock
      the LCTE lock except around the connects themselves. */
	fnp_no = a_fnp_no;
	segptr = a_ptr;
	nwords = a_count;
	fnp_type = a_fnp_type;
	fnp_addr = a_fnp_addr;
	fnp_dump_ptr = addr (fnp_dump_seg$);
	call validate_fnp_tandd_ret ("fnp_tandd_rw");

	on cleanup
	     begin;
	     if fnp_dump_seg.lock = pds$processid
	     then call lock$unlock (addr (fnp_dump_seg.lock), fdump_seg_event);
	end;

	data_ptr = addr (fnp_dump_seg.data);

	call lock$wait (addr (fnp_dump_seg.lock), fdump_seg_event, code);
	if code ^= 0
	then go to ret_bad_code;
	if fnp_type = DN6670
	then dump_6670_control.unpaged = "1"b;
	else dump_355_control.address_mode = "1"b3;
	offset = 0;
	do while (nwords > 0);
	     fnp_tally = min (308, nwords);
	     nwords = nwords - fnp_tally;
	     call setup_dump_ctl_word;
	     if opcode = "76"b3			/* WRITE */
	     then addr (fnp_dump_seg.data (2)) -> tally_words = addrel (segptr, offset) -> tally_words;
	     call wire_dump_seg;
	     if code ^= 0
	     then go to unlock_dump_seg;
	     fnp_info.t_and_d_lev_3_occurred, fnp_info.t_and_d_lev_7_occurred = "0"b;
	     fnp_info.t_and_d_notify_requested = "1"b;

	     call fdump_seg_io ("fnp_tandd_rw", opcode, code);

	     fnp_info.t_and_d_lev_3_occurred, fnp_info.t_and_d_lev_7_occurred = "0"b;
	     call unwire_dump_seg;
	     if code ^= 0
	     then go to unlock_dump_seg;
	     if opcode = "75"b3			/* READ */
	     then addrel (segptr, offset) -> tally_words = addr (fnp_dump_seg.data (2)) -> tally_words;

	     offset = offset + fnp_tally;
	end;
	code = 0;
	go to unlock_dump_seg;


validate_assigned_ret:
     procedure (caller);

declare  caller char (32);

	if ^fnp_info.io_manager_assigned
	then do;
	     code = error_table_$io_not_assigned;
	     if datanet_info.trace | datanet_info.debug_stop
	     then call syserr$error_code (ANNOUNCE, code,
		     "fnp_util$validate_assigned_ret (^a): IO manager assignment lacking.", caller);
	     call STOP_CHECK ("validate_assigned_ret");
	     call unlock_fnp;
	     go to ret_bad_code;
	end;
	return;
     end validate_assigned_ret;


validate_fnp_ret:
     procedure (caller);

declare  caller char (32);

/* internal procedure to ensure that FNP number is reasonable */

	infop = addr (dn355_data$);

	if fnp_no <= 0 | fnp_no > max_no_355s
	then do;
	     code = error_table_$io_not_defined;
ERROR:
	     if datanet_info.trace | datanet_info.debug_stop
	     then call syserr$error_code (ANNOUNCE, code, "fnp_util$^a: Invalid call for FNP ^d.", caller, fnp_no);
	     call STOP_CHECK (caller);
	     go to ret_bad_code;
	end;

	if ^tty_buf$fnp_config_flags (fnp_no)
	then do;
	     fnpp = null;
	     code = error_table_$io_not_defined;
	     go to ERROR;
	end;

	code = 0;
	fnpp = addr (datanet_info.per_datanet (fnp_no));
	mbxp = fnp_info.mbx_pt;
	if datanet_info.trace
	then call syserr (ANNOUNCE, "fnp_util$^a: Tracing call for fnp ^a.", caller, fnp_info.fnp_tag);

	return;

     end validate_fnp_ret;



validate_fnp_tandd_ret:
     proc (caller);

declare  caller char (32);

	call validate_fnp_ret (caller);
	if ^fnp_info.t_and_d_in_progress
	then code = error_table_$invalid_state;
	else if fnp_info.boot_process_id ^= pds$processid
	then code = error_table_$io_no_permission;
	if code ^= 0
	then do;
	     if (datanet_info.trace | datanet_info.debug_stop)
	     then call syserr$error_code (ANNOUNCE, code, "fnp_util$^a: Invalid call.", caller);
	     go to ret_bad_code;
	end;
	return;					/* validate_fnp_ret did trace */
     end validate_fnp_tandd_ret;

setup_dump_ctl_word:
     proc;

	if fnp_type = DN6670
	then do;
	     dump_6670_control.fnp_address = fnp_addr + 2 * offset;
	     dump_6670_control.tally = fnp_tally;
	end;
	else do;
	     dump_355_control.fnp_address = bit (fixed (fnp_addr + 2 * offset, 15), 15);
	     dump_355_control.tally = fnp_tally;
	end;
     end;

wire_dump_seg:
     proc;

	astep = get_ptrs_$given_segno (fixed (baseno (fnp_dump_ptr), 17));
	call pc_abs$wire_abs_contig (astep, 0, 1, code);	/* wire a page */
	if code = 0
	then auto_absadr = absadr (addr (fnp_dump_seg.data), code);
						/* fdump_seg_io needs this */
     end;

unwire_dump_seg:
     proc;

	astep = get_ptrs_$given_segno (fixed (baseno (fnp_dump_ptr), 17));
	call pc_abs$unwire_abs (astep, 0, 1);
	return;
     end unwire_dump_seg;


assign_interrupt:
     proc (handler, code);

/* internal procedure to set handler for IOM interrupt to our proc. */

dcl  handler entry;

dcl  iom_code fixed bin (35);
dcl  code fixed bin (35);

	call lock_fnp;				/* discourage reconfiguration */
	if ^fnp_info.io_manager_assigned		/* already deconfigured?  */
	then if ^fnp_info.available			/* already deconfigured! */
	     then do;
		code = error_table_$io_not_configured;
		return;
	     end;

/**** It may already be unassigned, as in dump of down MPX */

	if fnp_info.io_manager_assigned
	then do;
	     call io_manager$unassign (fnp_info.io_manager_chx, code);
	     if code ^= 0
	     then call syserr$error_code (CRASH, code, "fnp_util: Could not unassign FNP ^a at reassign_interrupt.",
		     fnp_info.fnp_tag);
	     fnp_info.io_manager_assigned = "0"b;
	end;					/* now make new assignment */

	call io_manager$assign (fnp_info.io_manager_chx, fnp_info.io_chanid, handler, (fnp_no), (null ()), iom_code);
	call unlock_fnp;
	if code = 0				/* if there wasn't anything more interesting to report */
	then do;
	     code = iom_code;			/* then report this */
	     fnp_info.io_manager_assigned = "1"b;
	end;

	return;

     end assign_interrupt;

unassign_interrupt:
     procedure;

	call io_manager$unassign (fnp_info.io_manager_chx, (0));
	fnp_info.io_manager_assigned = "0"b;
	return;
     end unassign_interrupt;



connect_to_dia:
     proc (address, level, cmd, timeout);

/* internal procedure to do DIA i/o */

dcl  old_pcw bit (36) aligned;
dcl  timeout bit (1) aligned;
dcl  address fixed bin (24);
dcl  level fixed bin (3);
dcl  cmd bit (6) aligned;
dcl  1 ima aligned like io_manager_arg;
dcl  paged bit (1) aligned;
dcl  1 a_dia_pcw aligned based (mbxp),			/* better declaration than the one used when MCS is running */
       2 address fixed bin (18) unsigned unaligned,
       2 error bit (1) unaligned,
       2 pad1 bit (3) unaligned,
       2 parity bit (1) unaligned,
       2 pad2 bit (1) unaligned,
       2 pad3 bit (3) unaligned,			/* if we used address extension this would be important */
       2 interrupt_level fixed bin (3) unsigned unaligned,
       2 command bit (6) unaligned;

	paged = "0"b;
	go to common;

connect_to_dia_paged:
     entry (address, level, cmd, timeout);

	paged = "1"b;

common:
	unspec (a_dia_pcw) = ""b;
	if address > sys_info$seg_size_256K
	then call syserr (CRASH, "fnp_util (connect_to_dia): address > 256K");
	a_dia_pcw.address = address;
	a_dia_pcw.interrupt_level = level;
	a_dia_pcw.command = cmd;
	if datanet_info.trace | datanet_info.debug_stop
	then call syserr (ANNOUNCE, "fnp_util (connect): ^[ paged PTP ^p^;^s^] PCW ^w", paged, fnp_info.ptp,
		unspec (datanet_mbx.dia_pcw));
	if datanet_info.debug_stop
	then do;
	     call syserr (ANNOUNCE, "fnp_util: stop before connect.");
	     call syserr (CRASH, "  ptp: ^p astep: ^p", fnp_info.ptp, fnp_info.astep);
	end;

/* parity on pcw REQUIRED */

	string (datanet_mbx.dia_pcw) = dn355_util$compute_parity (string (datanet_mbx.dia_pcw));

	ima.chx = fnp_info.io_manager_chx;
	if paged
	then ima.ptp = fnp_info.ptp;
	else ima.ptp = null ();
	old_pcw = unspec (a_dia_pcw);
	call io_manager$connect_direct (ima);
	do i = 1 to 100000 while (unspec (a_dia_pcw) = old_pcw);
	end;
	if a_dia_pcw.error | old_pcw = unspec (a_dia_pcw)
	then do;
	     call syserr (ANNOUNCE,
		"fnp_util (connect_to_dia): DIA mailbox PCW ^[error^;timeout^] for channel ^a, FNP ^a. PCW was ^w.",
		a_dia_pcw.error, fnp_info.io_chanid, fnp_info.fnp_tag, old_pcw);
	     timeout = "1"b;
	end;
	else timeout = "0"b;
	return;
     end connect_to_dia;


mask_dia:
     procedure;
	call io_manager$mask (fnp_info.io_manager_chx);	/* mask the channel to initialize it */
     end mask_dia;

internal_unwire:
     procedure;

declare  px fixed bin;

/* internal procedure to undo work of wire entry */

	if fnpp = null
	then return;
	if ^fnp_info.wired
	then return;

	ioptp = fnp_info.ptp;
	if ioptp ^= null ()
	then do px = FIRST_BOOTLOAD_PAGEX to FIRST_BOOTLOAD_PAGEX + fnp_info.n_pages_wired;
	     unspec (page_table.ptw (px)) = ""b;	/* as of next connect, no more references */
	end;

	astep = fnp_info.astep;
	call pc_abs$unwire_abs (astep, 0, fnp_info.n_pages_wired);
	call grab_aste$release_io (astep);
	fnp_info.wired = "0"b;
	return;

     end internal_unwire;

release_t_and_d:
     procedure;

declare  unlock_dump_seg bit (1) aligned;

	call lock$wait (addr (fnp_dump_seg.lock), fdump_seg_event, code);
						/* wait for finish */
	unlock_dump_seg = (code = 0);			/* if user held lock for other reason, leave it locked ? */
	call syserr (0, "fnp_util: force detaching FNP ^a from process ^w.", fnp_info.fnp_id.fnp_tag,
	     fnp_info.boot_process_id);
	call lock_fnp;				/* hold the LCTE lock (or the config lock) */
	fnp_info.boot_process_id = "000000000000"b3;
	fnp_info.boot_ev_chan = 0;
	fnp_info.t_and_d_in_progress = "0"b;
	fnp_info.t_and_d_lev_3_occurred, fnp_info.t_and_d_lev_7_occurred = "0"b;
	call fnp_multiplexer$unassign (fnp_no, code);
	if code ^= 0
	then call syserr$error_code (ANNOUNCE, code, "fnp_util: io channel unassignment failed for FNP ^a.",
		fnp_info.fnp_tag);
	call unlock_fnp;
	if unlock_dump_seg
	then call lock$unlock (addr (fnp_dump_seg.lock), fdump_seg_event);
	return;
     end release_t_and_d;


lock_fnp:
     procedure;

declare  code fixed bin (35);

	if locked | config_locked
	then call syserr (CRASH, "fnp_util: lock_fnp called with lock locked.");
	locked, config_locked = "0"b;

	call lock$lock_fast (addr (datanet_info.configuration_lock));
	config_locked = "1"b;			/* LCTE cannot get initialized after this point */
	if fnp_info.lcte_ptr = null ()
	then return;				/* that is the whole story */
	else if ^fnp_info.lcte_ptr -> lcte.initialized	/* no mpx in the house */
	then return;				/* and the config lock locks out T&D I/O */

	/*** here, there is a multiplexer, so we have to lock against it */

	call fnp_multiplexer$fnp_lock (fnpp, code);
	if code = 0
	then do;
	     locked = "1"b;				/* lcte was initialized, and we now own it */
	     call lock$unlock_fast (addr (datanet_info.configuration_lock));
						/* if init_multiplexer finds the LCTE initialized, it aborts */
						/* so all we are protecting against is ourselves */
	     config_locked = "0"b;
	end;
	return;

unlock_fnp:
     entry;

	if locked
	then call fnp_multiplexer$fnp_unlock (fnpp);
	locked = "0"b;
	if config_locked
	then call lock$unlock_fast (addr (datanet_info.configuration_lock));
	config_locked = "0"b;
	return;
     end lock_fnp;


STOP_CHECK:
     procedure (Tracer);
declare  Tracer char (*);

	if datanet_info.debug_stop
	then call syserr (CRASH, "fnp_util$^a: Debugging stop (type go to continue).", Tracer);
	return;
     end STOP_CHECK;


get_page_table:
     procedure (code);

declare  pagex fixed bin;
declare  px fixed bin;
declare  1 seg_pt (0:255) aligned like l68_core_ptw based (ptp);
declare  ptp pointer;
declare  code fixed bin (35);

	io_page_table_size = 256;			/* always, for datanet */
	call ioi_page_table$get (io_page_table_size * sys_info$page_size, fnp_info.ptx, code);
						/* Direct channel has no bounds check so we need all 256 */
	if code ^= 0
	then return;
	fnp_info.ptp, ioptp = ioi_page_table$ptx_to_ptp (fnp_info.ptx);

	unspec (page_table) = ""b;

/**** leave page zero invalid */

/**** First, dn355_mailbox */

	do px = 1 to 3;
	     io_ptwp = addr (page_table.ptw (px));
	     io_ptw.address = px;			/* absolute page number */
	     io_ptw.write = "1"b;
	     io_ptw.valid = "1"b;
	end;

/**** Now, tty_buf */

	astep = get_ptrs_$given_segno (segno (addr (tty_buf$)));
	pagex = FIRST_TTY_BUF_PAGEX;
	ptp = addwordno (astep, sst$astsize);
	do px = 0 to bin (aste.csl, 9) - 1;		/* no null pages here */
	     io_ptwp = addr (page_table.ptw (pagex));
	     io_ptw.address = seg_pt (px).frame;
	     io_ptw.write = "1"b;
	     io_ptw.valid = "1"b;
	     pagex = pagex + 1;
	end;					/* tty_buf is now described to the channel */
	return;

fill_bootload_page_table:
     entry;					/* fill in io ptws for bootload segment */

/**** astep is already set to the bootload image aste */

	pagex = FIRST_BOOTLOAD_PAGEX;
	ptp = addwordno (astep, sst$astsize);
	auto_absadr = pagex * sys_info$page_size;
	ioptp = fnp_info.ptp;

	do px = 0 to fnp_info.n_pages_wired - 1;
	     io_ptwp = addr (page_table.ptw (pagex));
	     io_ptw.address = seg_pt (px).frame;
	     io_ptw.write = "0"b;
	     io_ptw.valid = "1"b;
	     pagex = pagex + 1;
	end;

	if datanet_info.trace
	then do px = 0 to 255;
	     if unspec (page_table.ptw (px)) ^= ""b
	     then call syserr (ANNOUNCE, "     ^4o ^w", px, unspec (page_table.ptw (px)));
	end;

	return;

     end get_page_table;


/* format: off */

/* INCLUDE FILES */
%page; %include aste;
%page; %include config_prph_fnp_card;
%page; %include dn355_mailbox;
%page; %include lct;
%page; %include dn355_data;
%page; %include pcb;
%page; %include fnp_dump_seg;
%page; %include fnp_types;
%page; %include io_manager_dcls;
%page; %include io_page_tables;
%page; %include io_chnl_util_dcls;
%page; %include "ptw.l68";
       declare ptp pointer;
%page; %include syserr_constants;
%page; %include tty_buf;
%include fnp_mpx_msg_;




/* BEGIN MESSAGE DOCUMENTATION

   Message:
   Loading FNP X, CORE_IMAGE VERSION

   S:  $info

   T:  Answering service initialization and each subsequent FNP
   bootload.

   M:  Loading of FNP X has begun with a core image named CORE_IMAGE
   (normally "mcs") of version number VERSION.

   A:  $ignore


   Message:
   fnp_util$wire: FNP T already wired (trace)


   Message:
   fnp_util$wire: failed. REASON (trace)


   Message:
   fnp_util$load: FNP load already in progress for FNP T.


   Message:
   fnp_util$load: FNP T not wired.


   Message:
   fnp_util$load: FNP T is running. (trace)


   Message:
   fnp_util$load: FNP T is running T&D.


   Message:
   fnp_util$load: Error loading FNP T. REASON (trace)


   Message:
   fnp_util$unwire: Unwire failed for FNP T. REASON


   Message:
   fnp_util$configure: FNP T already configured.


   Message:
   fnp_util: FNP T added to configuration^[ by NAME^].


   Message:
   FNP T deleted from configuration^[ by ^a^].


   Message:
   fnp_util$fdump_seg_io: IO_OP for CALLER (trace)


   Message:
   fnp_util: channel assignment failed for FNP ^T REASON. (tandd)


   Message:
   fnp_util: ioam_$assign failed for FNP T. REASON (tandd)


   Message:
   fnp_util: assigned FNP T to NAME for T & D.


   Message:
   fnp_util: io channel unassignment failed for FNP T. (tandd)


   Message: 
   fnp_util: releasing FNP T from NAME (tandd)


   Message:
   fnp_util$validate_assigned_ret (CALLER): IO manager assignment lacking. (trace)


   Message:
   fnp_util$ENTRY: Invalid call for FNP INDEX. (not in cdeck)


   Message:
   fnp_util$ENTRY: Tracing call for fnp T.


   Message:
   fnp_util$ENTRY: Invalid call. (trace)


   Message:
   fnp_util: Could not unassign FNP T at reassign_interrupt. 


   Message:
   fnp_util: force detaching FNP T from process PID.


   Message:
   fnp_util: io channel unassignment failed for FNP T. (tandd)


   Message:
   fnp_util: lock_fnp called with lock locked.


   Message:
   fnp_util$ENTRY: Debugging stop (type go to continue).

   END MESSAGE DOCUMENTATION */


     end fnp_util;




		    mcs_timer.pl1                   11/11/89  1132.7r w 11/11/89  0825.4      159777



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */
/* format: style4,delnl,insnl,ifthenstmt,indnoniterend */
mcs_timer:
     procedure ();

MAIN_RETURN:					/* This is the only way out of this program. Everything */
	return;					/* does a non-local goto to here */

/* *	MCS_TIMER -- Ring zero MCS timer manager
   *
   *	This procedure implements timers for ring zero MCS. When a timer comes due,
   *	a TIMER interrupt is delivered to the lucky channel. For all the frankly
   *	fascinating details, see MTB-xxx.
   *
   *	Written 24 March 1982, W. Olin Sibert, for the ASEA Hyperchannel project.
   *	Modification history:
   *	24 Mar 82, WOS: Initial coding, for the ASEA Hyperchannel project.
   *	30 May 82, WOS: Added subchan_idx parameters, changed timer_id to bit (36).
   *	October 1982, CAH: Redesigned to use an hproc.
*/

declare  P_devx fixed bin parameter;			/* Channel number */
declare  P_subchan_idx fixed bin parameter;		/* Index of subchannel timer belongs to */
declare  P_time fixed bin (71) parameter;		/* Time for timer to come due */
declare  P_timer_id bit (36) aligned parameter;		/* Timer ID caller uses to tell timers apart */

declare  devx fixed bin;				/* Local copies of parameters */
declare  subchan_idx fixed bin;
declare  time fixed bin (71);
declare  timer_id bit (36) aligned;

declare  wire_mask fixed bin (71);			/* pmut$wire_and_mask info */
declare  wire_ptr pointer;
declare  start_time fixed bin (71);			/* Time mcs_timer was entered, for metering */

declare  timer_found bit (1) aligned;			/* Whether locate_timer found this sort of timer anywhere */
declare  timer_was_queued bit (1) aligned;		/* Whether the located timer was in the interrupt queue */
declare  channel_locked bit (1) aligned;		/* we managed to lock channel */

declare  pds$processid bit (36) aligned external static;

declare  channel_manager$queued_interrupt entry (fixed bin, fixed bin, bit (72) aligned);
declare  privileged_mode_ut$wire_and_mask entry (fixed bin (71), pointer);
declare  privileged_mode_ut$unwire_unmask entry (fixed bin (71), pointer);
declare  pxss$unique_ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
declare  syserr entry options (variable);
declare  tty_lock$check_for_interrupt entry (fixed bin, fixed bin, bit (72) aligned) returns (bit (1) aligned);
declare  tty_lock$dequeue_one_interrupt entry (fixed bin, fixed bin, bit (72) aligned);
declare  tty_lock$dequeue_all_interrupts entry (fixed bin, fixed bin);
declare  tty_lock$lock_channel_int entry (fixed bin, fixed bin, bit (72) aligned, bit (1) aligned);
declare  tty_lock$unlock_channel_int entry (fixed bin);

declare  (addr, clock, null, pointer, rel, size, stacq, unspec) builtin;

/* format: on */
%page;
mcs_timer$set:
     entry (P_devx, P_subchan_idx, P_time, P_timer_id);

	devx = P_devx;
	time = P_time;
	call get_id_and_subchan ();

	call setup_channel ();

	call locate_timer ();

	if timer_found then call timer_error ("Duplicate timer ID. Cannot set");

	call allocate_timer_block ();			/* Get space for the new timer */

	call fill_timer_block ();			/* and fill it in */

	call thread_timer_block ();			/* Add it to the lists */

	call finished (tty_buf.timer_call_time, tty_buf.timer_set_calls);
						/* All done */
	call unlock_timer_lock ();
	goto MAIN_RETURN;				/* Depart */
%page;
mcs_timer$change:
     entry (P_devx, P_subchan_idx, P_time, P_timer_id);

	devx = P_devx;
	time = P_time;
	call get_id_and_subchan ();

	call setup_channel ();

	call locate_timer ();

	if ^timer_found then call timer_error ("Timer not found. Cannot change");

	if timer_was_queued then do;
	     call tty_lock$dequeue_one_interrupt (devx, TIMER, unspec (timer_info));
						/* If it came from the interrupt queue, must get a new */
	     call allocate_timer_block ();		/* timer block. Otherwise, we can just re-use the old one */
	     end;
	else call unthread_timer_block ();

	call fill_timer_block ();

	call thread_timer_block ();

	call finished (tty_buf.timer_call_time, tty_buf.timer_change_calls);

	call unlock_timer_lock ();

	goto MAIN_RETURN;				/* Depart */
%page;
mcs_timer$reset:
     entry (P_devx, P_subchan_idx, P_timer_id);

	devx = P_devx;
	call get_id_and_subchan ();

	call setup_channel ();

	call locate_timer ();

	if ^timer_found then call timer_error ("Timer not found. Cannot reset");

	if timer_was_queued
	then call tty_lock$dequeue_one_interrupt (devx, TIMER, unspec (timer_info));
	else do;					/* Remove from the lists and free */
	     call unthread_timer_block ();
	     call free_timer_block ();
	     end;

	call finished (tty_buf.timer_call_time, tty_buf.timer_reset_calls);

	call unlock_timer_lock ();

	goto MAIN_RETURN;				/* Depart */
%page;
mcs_timer$reset_all:
     entry (P_devx);

	devx = P_devx;
	call setup_channel ();

	call tty_lock$dequeue_all_interrupts (devx, TIMER);
						/* Get the urgent ones first */

	do while (lcte.timer_offset ^= ""b);		/* Keep flushing from the front of the queue */
	     timer_ptr = pointer (ttybp, lcte.timer_offset);
	     call unthread_timer_block ();
	     call free_timer_block ();
	end;

	call finished (tty_buf.timer_call_time, tty_buf.timer_reset_calls);
						/* There. That was easy, wasn't it? */

	call unlock_timer_lock ();

	goto MAIN_RETURN;				/* Depart */
%page;
mcs_timer$verify_lock:
     entry ();

	ttybp = addr (tty_buf$);			/* We can't call setup_global, since this entry doesn't */
						/* follow the usual conventions about locking */
	if (tty_buf.timer_lock = pds$processid)
	then call syserr (CRASH, "mcs_timer: Crawlout with MCS timer lock locked.");

	return;					/* not likely, but better than falling through */
%page;
/* This is called by mcs_timer_daemon to do the work */

mcs_timer$poll:
     entry () returns (fixed bin (71));

	call setup_global ();

POLLING_LOOP:
	if tty_buf.next_timer_offset = ""b then do;	/* No more left */
	     call finished (tty_buf.timer_polling_time, tty_buf.timer_poll_calls);
	     call unlock_timer_lock ();
	     return (0);
	     end;

	timer_ptr = pointer (ttybp, tty_buf.next_timer_offset);
						/* Find the first one to deliver */
	time = timer.time;				/* Copy data from the timer */
	timer_id = timer.data;			/* since we are about to free it */
	devx = timer.devx;
	subchan_idx = timer.subchan_idx;

	if (time > clock ()) then do;			/* No more left */
	     call finished (tty_buf.timer_polling_time, tty_buf.timer_poll_calls);
	     call unlock_timer_lock ();
	     return (time);
	     end;

	call unthread_timer_block ();

	call free_timer_block ();

	timer_info.id = timer_id;
	timer_info.subchan_idx = subchan_idx;

	call tty_lock$lock_channel_int (devx, TIMER, unspec (timer_info), channel_locked);
	if channel_locked then do;
	     call unlock_timer_lock ();
	     call channel_manager$queued_interrupt (devx, TIMER, unspec (timer_info));
	     call tty_lock$unlock_channel_int (devx);
	     call lock_timer_lock ();
	     end;

	goto POLLING_LOOP;
%page;
locate_timer:
     procedure ();

/* This procedure finds the requested timer for a channel, given the timer ID,
   and sets the global variables to indicate its whereabouts. */

	timer_found = tty_lock$check_for_interrupt (devx, TIMER, unspec (timer_info));
	if timer_found then do;			/* There's one waiting for you when you get home */
	     timer_ptr = null ();			/* for good measure */
	     timer_was_queued = "1"b;			/* indicate where found */
	     return;
	     end;

	timer_was_queued = "0"b;
	timer_found = "1"b;

	do timer_ptr = pointer (ttybp, lcte.timer_offset) repeat (pointer (ttybp, timer.next_for_lcte))
	     while (rel (timer_ptr) ^= ""b);

	     if (timer.data = timer_id)
	     then if (timer.subchan_idx = subchan_idx) then return;
						/* Jackpot */

	end;

	timer_found = "0"b;
	timer_ptr = null ();			/* Again, for good measure */

	return;
     end locate_timer;
%page;
allocate_timer_block:
     procedure ();

/* Procedure to get space for a timer block, and abort if it can't */

	call tty_space_man$get_space (size (timer), timer_ptr);
	if (timer_ptr = null ()) then call timer_error ("Cannot get space to set");

	return;
     end allocate_timer_block;



free_timer_block:
     procedure ();

/* Procedure to return space used by a timer block */

	call tty_space_man$free_space (size (timer), timer_ptr);

	return;
     end free_timer_block;



fill_timer_block:
     procedure ();

/* Procedure to fill in a timer block from the global variables */

	unspec (timer) = ""b;
	timer.devx = devx;
	timer.subchan_idx = subchan_idx;
	timer.data = timer_id;
	timer.time = time;

	return;
     end fill_timer_block;
%page;
thread_timer_block:
     procedure ();

/* Procedure to thread in the current timer block onto the global timer queue and the queue for the lcte */
/* Also updates the global variables in tty_buf */

declare  soonest_timer_ptr pointer;
declare  next_timer_ptr pointer;
declare  prev_timer_ptr pointer;
declare  found_it bit (1) aligned;


	lctep = addr (lct.lcte_array (timer.devx));	/* Who this one belongs to */

	if (tty_buf.next_timer_offset ^= ""b) then do;	/* Set soonest_timer_ptr to mean we need to update */
	     soonest_timer_ptr = pointer (ttybp, tty_buf.next_timer_offset);

	     if (soonest_timer_ptr -> timer.time >= timer.time)
	     then soonest_timer_ptr = timer_ptr;	/* New one is soonest in the list */
	     else soonest_timer_ptr = null ();		/* Otherwise, leave it alone */
	     end;
	else soonest_timer_ptr = timer_ptr;		/* There were none before, so this must be it */

	prev_timer_ptr = pointer (ttybp, 0);		/* Prepare to rethread */
	next_timer_ptr = pointer (ttybp, tty_buf.next_timer_offset);

	found_it = "0"b;
	do while ((rel (next_timer_ptr) ^= ""b) & (^found_it));
						/* Look for a place to thread it in */
	     if (next_timer_ptr -> timer.time > timer.time)
	     then found_it = "1"b;
	     else do;
		prev_timer_ptr = next_timer_ptr;
		next_timer_ptr = pointer (ttybp, next_timer_ptr -> timer.next_timer);
		end;
	end;

	if rel (prev_timer_ptr) ^= ""b then prev_timer_ptr -> timer.next_timer = rel (timer_ptr);
						/* Splice it in, if we can */
	if rel (next_timer_ptr) ^= ""b then next_timer_ptr -> timer.prev_timer = rel (timer_ptr);

	timer.next_timer = rel (next_timer_ptr);
	timer.prev_timer = rel (prev_timer_ptr);

	next_timer_ptr = pointer (ttybp, lcte.timer_offset);

	timer.prev_for_lcte = ""b;			/* Thread in at the beginning of the LCTE list */
	timer.next_for_lcte = rel (next_timer_ptr);

	if (rel (next_timer_ptr) ^= ""b) then next_timer_ptr -> timer.prev_for_lcte = rel (timer_ptr);

	lcte.timer_offset = rel (timer_ptr);

	if (soonest_timer_ptr ^= null ()) then do;	/* Must update "next time" */
	     tty_buf.next_timer_offset = rel (soonest_timer_ptr);
	     call pxss$unique_ring_0_wakeup (tty_buf.timer_process, tty_buf.timer_ev_chn, 0, (0));
	     end;

	tty_buf.timer_count = tty_buf.timer_count + 1;

	return;
     end thread_timer_block;
%page;
unthread_timer_block:
     procedure ();

/* Procedure to unthread the current timer block from the global timer queue and the lcte queue */
/* Also updates the global variables in tty_buf, changing the next timer info if necessary */

declare  soonest_timer_ptr pointer;			/* For updating tty_buf */
declare  next_timer_ptr pointer;
declare  prev_timer_ptr pointer;


	prev_timer_ptr = pointer (ttybp, timer.prev_timer);
						/* First, unthread it from the global list */
	next_timer_ptr = pointer (ttybp, timer.next_timer);

	if (rel (timer_ptr) = tty_buf.next_timer_offset)
	then soonest_timer_ptr = next_timer_ptr;	/* If we're removing the first one, update */
	else soonest_timer_ptr = null ();		/* If not skip this step */

	if (timer.next_timer ^= ""b) then next_timer_ptr -> timer.prev_timer = timer.prev_timer;

	if (timer.prev_timer ^= ""b) then prev_timer_ptr -> timer.next_timer = timer.next_timer;

	tty_buf.timer_count = tty_buf.timer_count - 1;

	if soonest_timer_ptr ^= null () then do;	/* This means the one we unthreaded was the first */
	     tty_buf.next_timer_offset = rel (soonest_timer_ptr);
	     end;					/* "That's longer than anybody's ever been gone before!" */

	lctep = addr (lct.lcte_array (timer.devx));	/* Who this one belongs to */

	prev_timer_ptr = pointer (ttybp, timer.prev_for_lcte);
						/* Next, unthread it from the list for the LCTE */
	next_timer_ptr = pointer (ttybp, timer.next_for_lcte);

	if (timer.next_for_lcte ^= ""b) then next_timer_ptr -> timer.prev_for_lcte = timer.prev_for_lcte;

	if (timer.prev_for_lcte ^= ""b) then prev_timer_ptr -> timer.next_for_lcte = timer.next_for_lcte;

	if (rel (timer_ptr) = lcte.timer_offset) then lcte.timer_offset = rel (next_timer_ptr);

	return;
     end unthread_timer_block;
%page;
setup_global:
     procedure ();

/* Set up for any kind of mcs_timer operation. Sets global variables, wires and masks,
   and locks the timer lock */

	ttybp = addr (tty_buf$);
	lctp = tty_buf.lct_ptr;
	lctep = null ();

	start_time = clock ();

	call lock_timer_lock ();

	return;
     end setup_global;



setup_channel:
     procedure ();

/* This procedure performs additional setup up for an operation on a particular
   channel, and checks that it is locked by the correct process. */

	call setup_global ();

	lctep = addr (lct.lcte_array (devx));

	if (lcte.lock ^= pds$processid)
	then call syserr (CRASH, "mcs_timer: Channel not locked by this process. Devx = ^d.", devx);

	return;
     end setup_channel;




get_id_and_subchan:
     procedure ();

	timer_id = P_timer_id;
	subchan_idx = P_subchan_idx;

	timer_info.id = timer_id;
	timer_info.subchan_idx = subchan_idx;

	return;
     end get_id_and_subchan;
%page;
timer_error:
     procedure (P_message);

declare  P_message char (*) parameter;


	call syserr (tty_buf.recoverable_error_severity, "mcs_timer: ^a timer ^w for devx(subchan) ^d(^d)", P_message,
	     timer_id, devx, subchan_idx);

	call finished ((0), tty_buf.timer_error_calls);	/* Don't meter calls that don't complete */

	call unlock_timer_lock ();

	goto MAIN_RETURN;				/* Depart */

     end timer_error;



finished:
     procedure (P_time_meter, P_count);

declare  P_time_meter fixed bin (71) parameter;
declare  P_count fixed bin (35) parameter;


	P_time_meter = P_time_meter + (clock () - start_time);
	if (P_count < 34359738367)
	then					/* Avoid overflows. That number is 2**35-1 */
	     P_count = P_count + 1;
	return;
     end finished;
%page;
lock_timer_lock:
     procedure ();

declare  spin_start_time fixed bin (71);


	if (tty_buf.timer_lock = pds$processid)
	then call syserr (CRASH, "mcs_timer: Timer lock already locked to this process.");

	call privileged_mode_ut$wire_and_mask (wire_mask, wire_ptr);

	if ^(stacq (tty_buf.timer_lock, pds$processid, ""b)) then do;

	     spin_start_time = clock ();		/* Didn't lock at first attempt */
	     tty_buf.timer_lock_wait_count = tty_buf.timer_lock_wait_count + 1;

	     do while (^stacq (tty_buf.timer_lock, pds$processid, ""b));
	     end;

	     tty_buf.timer_lock_wait_time = tty_buf.timer_lock_wait_time + (clock () - spin_start_time);
	     end;

	tty_buf.timer_lock_count = tty_buf.timer_lock_count + 1;

	return;
     end lock_timer_lock;



unlock_timer_lock:
     procedure ();

	if ^(stacq (tty_buf.timer_lock, "0"b, pds$processid))
	then call syserr (CRASH, "mcs_timer: Timer lock not locked by this process.");

	call privileged_mode_ut$unwire_unmask (wire_mask, wire_ptr);

	return;
     end unlock_timer_lock;
%page;
%include mcs_timer_data;
%include tty_buf;
%include lct;
%include mcs_interrupt_info;
%include tty_space_man_dcls;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   mcs_timer: Timer lock already locked to this process.

   S:	$crash

   T:	$run

   M:	A process that had the MCS timer lock locked tried to lock it again.

   A:	$inform


   Message:
   mcs_timer: Timer lock not locked by this process.

   S:	$crash

   T:	$run

   M:	A process called to unlock the MCS timer lock, but did not have it locked.

   A:	$inform


   Message:
   mcs_timer: Channel not locked by this process. Devx = DDDD.

   S:	$crash

   T:	$run

   M:	A process called to perform an MCS timer operation, but the channel it
   specified (devx DDDD) was not locked by the calling process.
   by the calling process.

   A:	$inform


   Message:
   mcs_timer: Timer not found. Cannot OOOOO timer NNN for devx(subchan) DDD(SSS).

   S:	$log

   T:	$run

   M:	An attempt was made to perform operation OOOOO (reset or change) on
   an MCS timer when no timer or queued timer interrupt with the specified ID
   could be found for the requesting channel. The call is ignored.

   A:	$inform


   Message:
   mcs_timer: Duplicate timer ID. Cannot set timer NNN for devx(subchan) DDD(SSS).

   S:	$log

   T:	$run

   M:	An attempt was made to set an MCS timer with the specified timer ID,
   but the channel already had an outstanding timer or queued timer interrupt
   with that ID. The call is ignored.

   A:	$inform


   Message:
   mcs_timer: Cannot get space to set timer NNN for devx(subchan) DDD(SSS).

   S:	$log

   T:	$run

   M:	An attempt was made to set an MCS timer with the specified timer ID,
   but it was not possible to allocate the necessary space in tty_buf to hold
   timer data block. The call is ignored.

   A:	$inform


   END MESSAGE DOCUMENTATION */

     end mcs_timer;




		    mcs_trace.pl1                   11/11/89  1132.7r w 11/11/89  0825.4       32445



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        *********************************************************** */
/* format: style3,linecom,ifthenstmt,ifthendo,ifthen,^indnoniterdo,indnoniterend,indcomtxt,^inditerdo,indend,idind30 */
mcs_trace:
     procedure (Devx);

/* Routine for tracing events in ring 0 MCS. */
/* Written by C. Hornig, September 1979. */

dcl	Devx			fixed bin parameter;
dcl	Chainp			pointer parameter;

%include mcs_trace_data;

dcl	formline_			entry (fixed bin, fixed bin, pointer, fixed bin (21), fixed bin);

dcl	initialized		bit aligned internal static init ("0"b);
dcl	mapc			character (512) aligned internal static init ("");

dcl	(my_idx, next_idx)		fixed bin (35) aligned;
dcl	(bsize, i)		fixed bin;

dcl	bwords			(256) bit (36) aligned based (blockp);

dcl	(addr, binary, bit, clock, length, pointer, stacq)
				builtin;

/* * * * * * * * * * * * * * * * * * * */

	call setup;
	call get_entry;
	call formline_ (2, 3, addr (trace_entry.message), length (trace_entry.message), 1);
return_to_caller:
	return;

/* * * * * * * * * * BUFFER_CHAIN * * * * * * * * * */

buffer_chain:
     entry (Devx, Chainp);

	call setup;
	do blockp = Chainp repeat (pointer (ttybp, buffer.next)) while (rel (blockp) ^= ""b);
	     bsize = 16 * (1 + buffer.size_code);
	     call fill_in (" ^d words at ^6.3b; ^d chars; flags: ^[eop,^]^[conv,^]^[break^]", bsize, rel (blockp),
		buffer.tally, buffer.flags.end_of_page, buffer.flags.converted, buffer.flags.break);
	     do i = 1 by 2 to bsize;
		if (bwords (i) | bwords (i + 1)) ^= ""b then
		     call fill_in (" ^2d: ^w ^w ^8a", (i - 1) * 4, bwords (i), bwords (i + 1),
			translate (substr (string (buffer.chars), i * 4 - 7, 8), mapc));
		end;
	     end;
	return;

/* * * * * * * * * * INIT * * * * * * * * * */

setup:
     procedure;
	ttybp = addr (tty_buf$);
	if ^initialized then do;
	     mapc = copy (".", 32) || substr (collate9 (), 33, 95) || copy (".", 385);
	     initialized = "1"b;
	     end;
	if ^tty_buf.trace.enable then goto return_to_caller;
	if tty_buf.trace.data_offset = ""b then goto return_to_caller;
	trace_array_ptr = pointer (ttybp, tty_buf.trace.data_offset);
	if trace_array.num_entries = 0 then goto return_to_caller;
	lctep = addr (tty_buf.lct_ptr -> lct.lcte_array (Devx));
	if lcte.flags.trace = (tty_buf.trace.default_mode & ^lcte.flags.trace_force) then goto return_to_caller;
     end setup;

/* * * * * * * * * * GET_ENTRY * * * * * * * * * */

get_entry:
     procedure;
snarf_trace_entry:
	my_idx = binary (trace_array.idx);		/* idx is where our message will go */
	next_idx = my_idx + 1;
	if next_idx > trace_array.num_entries then next_idx = 1;
						/* where next entry will go */
	if ^stacq (trace_array.idx, unspec (next_idx), unspec (my_idx)) then goto snarf_trace_entry;
						/* now grab the entry */
	trace_entry_ptr = addr (trace_array.entry (my_idx));
	trace_entry.time = clock ();
	trace_entry.devx = Devx;
     end get_entry;

/* * * * * * * * * * FILL_IN * * * * * * * * * */

fill_in:
     procedure options (variable, non_quick);
	call get_entry;
	call formline_ (1, 2, addr (trace_entry.message), length (trace_entry.message), 1);
     end fill_in;

%include tty_buf;
%include lct;
%include tty_buffer_block;

     end;




		    tty_interrupt.pl1               11/11/89  1132.7r w 11/11/89  0825.4      310941



/****^  ***********************************************************
        *                                                         *
        * 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.      *
        *                                                         *
        *********************************************************** */

/* format: style4,delnl,insnl,^ifthendo */
tty_interrupt:
     proc (a_wtcbp, a_type, a_info);

/* DESCRIPTION:
   interrupt handler for logical terminal channels.
*/

/* HISTORY:
   Written by Robert Coren, 08/01/78.
   Modified:
   01/20/79 by Bernard Greenberg:  Negotiated interrupt-time echo.
   03/01/79 by J. Stern:  for wakeup table processing.
   06/29/79 by Bernard Greenberg:  FNP (multiplexer)-negotiated echo.
   04/01/81 by Robert Coren:  bugs fixed and references to dialedt removed.
   05/01/81 by J. Bongiovanni:  for response time metering.
   06/01/82 by Robert Coren:  to add handling of MASKED interrupt type.
   11/01/82 by Robert Coren:  to save error code returned by channel_manager$write
   and to trust returned pointer even if code ^= 0.
   04/01/84 by Robert Coren:  to fix bug caused by setting mark flag in a buffer
   that might have been freed.
   07/20/84 by R. Michael Tague:  Changed the calling sequence of pxss$wakeup_int
   so that the IPS signal is specified by a bit mask instead of the
   signal name.
   09/20/84 by Robert Coren:  to fix echoing bug that arose if FNP appended
   characters after it stopped echoing, and to reset all the WTCB
   flags that have to be reset on hangup.
   12/10/84 by Robert Coren:  to ignore line_status interrupts if
   wtcb.line_status_disabled is "1"b, and to clear it on hangup.

/****^  HISTORY COMMENTS:
  1) change(86-06-19,Kissel), approve(86-07-30,MCR7475), audit(86-08-04,Coren),
     install(86-10-09,MR12.0-1181):
     Changed to support the new tty event message format declared in
     net_event_message.incl.pl1 which replaces tty_event_message.incl.pl1.
  2) change(87-07-17,LJAdams), approve(87-08-07,MCR7750),
     audit(87-08-07,Fawcett), install(87-08-11,MR12.1-1079):
     wtcb.mark_set was being set to "0"b at all times.  Changed this so that it
     will be set to "0"b only if quits are enabled. (phx20905)
  3) change(88-01-15,Farley), approve(88-02-22,MCR7843),
     audit(88-02-22,Beattie), install(88-03-01,MR12.2-1029):
     Added a check to ACCEPT_INPUT for ceasing echo neg when there is no more
     horiz_room_left.
  4) change(88-06-20,Berno), approve(88-07-13,MCR7928),
     audit(88-06-20,Parisek), install(88-07-19,MR12.2-1061):
     Added code to implement the UNCP multiplexer (DSA gateway) interface.
     Set the wtcb.send_turn flag & check the wtcb.receive_mode_device flag.
                                                   END HISTORY COMMENTS */


/* PARAMETERS */

dcl  a_wtcbp ptr;
dcl  a_type fixed bin;
dcl  a_info bit (72) aligned;


/* AUTOMATIC */

dcl  i fixed bin;
dcl  int_type fixed bin;
dcl  devx fixed bin;
dcl  charx fixed bin;
dcl  echbufp ptr;
dcl  this_char char (1) unaligned;
dcl  echo_tally fixed bin (9);
dcl  sync_ctr_tally fixed bin;
dcl  inchain fixed bin (18);
dcl  code fixed bin (35);
dcl  next_offset fixed bin;
dcl  last_offset fixed bin;
dcl  new_headp ptr;
dcl  old_tailp ptr;
dcl  new_first_tally fixed bin;
dcl  old_last_tally fixed bin;
dcl  max_tally fixed bin;
dcl  filled bit (1);
dcl  source_ptr ptr;
dcl  target_ptr ptr;
dcl  start_time fixed bin (71);
dcl  echnego_from_mux_flag bit (1);
dcl  echnego_scan_start fixed bin;
dcl  r0_did_echo bit (1);
dcl  uncp_flag bit (1);				/* designate UNCP mpx */
dcl  1 echo_start_data,
       2 ctr fixed bin (35),
       2 screenleft fixed bin (35);

/* BASED */

dcl  new_chars char (new_first_tally) based;


/* BUILTINS */

dcl  (addr, bin, clock, divide, hbound, max, min, null,
      ptr, unspec, rank, rel, size, string, substr) builtin;


/* ENTRIES */

dcl  meter_response_time entry (bit (36) aligned, fixed bin);
dcl  pxss$ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
dcl  pxss$unique_ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
dcl  pxss$ips_wakeup_int entry (bit (36) aligned, bit (35) aligned);
dcl  syserr entry options (variable);


/* EXTERNAL STATIC */

dcl  error_table_$noalloc fixed bin (35) ext static;
dcl  error_table_$invalid_write fixed bin (35) ext static;
dcl  sys_info$quit_mask bit (35) aligned ext static;

/* INTERNAL STATIC */

dcl  CRASH_SYSTEM fixed bin int static options (constant) init (1);

dcl  line_delimiter_octal (16) bit (9) int static options (constant)
	init ("012"b3, (2) (1)"055"b3, "012"b3, (3) (1)"003"b3, (5) (1)"012"b3, (3) (1)"003"b3, "012"b3);
dcl  line_delimiter (16) char (1) based (addr (line_delimiter_octal));

dcl  no_write_code fixed bin (35) internal static;
dcl  noalloc_code fixed bin (35) internal static;		/* copy of code to be used at interrupt time */

%include wtcb;
%include mcs_interrupt_info;
%include tty_buf;
%include tty_buffer_block;
%include net_event_message;
%include tty_space_man_dcls;
%include channel_manager_dcls;
%include line_types;
%include mcs_echo_neg_sys;
%include lct;
%include set_wakeup_table_info;
%include response_transitions;
%include multiplexer_types;

interrupt:
     entry;					/* the only entry into this program */

	wtcbp = a_wtcbp;
	int_type = a_type;
	interrupt_info = a_info;
	devx = wtcb.devx;
	ttybp = addr (tty_buf$);

	uncp_flag = is_parent_mpx (UNCP_MPX);
	
	if int_type = DIALUP
	then do;
	     unspec (dialup_info) = interrupt_info;
	     if wtcb.dialing
	     then do;				/* if we asked 355 to dial */
		wtcb.dial_status_valid = "1"b;	/* status code is now valid */
		wtcb.dial_status_code = 0;		/* success */
	     end;


	     wtcb.line_type = dialup_info.line_type;
	     wtcb.baud_rate = dialup_info.baud_rate;
	     wtcb.max_buf_size = dialup_info.max_buf_size;
	     wtcb.buffer_pad = dialup_info.buffer_pad;
	     wtcb.line_delimiter = line_delimiter (wtcb.line_type);
	     wtcb.receive_mode_device = dialup_info.receive_mode_device;

	     if uncp_flag then wtcb.send_turn = "0"b;	/* Add for the Datanet 7100. */

	     do i = 1 to n_sync_line_types while (sync_line_type (i) ^= wtcb.line_type);
	     end;
	     wtcb.sync_line = (i <= n_sync_line_types);

	     wtcb.flags.dialed = "1"b;		/* indicate dialed */
	     wtcb.uproc = wtcb.hproc;			/* make boss process the user until we get real one */

	     unspec (net_event_message) = "0"b;
	     net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
	     net_event_message.network_type = MCS_NETWORK_TYPE;
	     net_event_message.handle = devx;
	     net_event_message.type = MCS_DIALUP_MSG;
	     call pxss$ring_0_wakeup (wtcb.hproc, wtcb.hevent, net_event_message_arg, 0);
						/* wakeup the answering service */
	end;

	else if int_type = HANGUP
	then do;
	     unspec (net_event_message) = "0"b;
	     net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
	     net_event_message.network_type = MCS_NETWORK_TYPE;
	     net_event_message.handle = devx;
	     net_event_message.type = MCS_HANGUP_MSG;
	     call pxss$ring_0_wakeup (wtcb.hproc, wtcb.hevent, net_event_message_arg, (0));
						/* notify Initializer */

	     call kill_line;			/* wipe out our record of the channel */
	end;

	else if int_type = CRASH			/* we don't have to tell anyone */
	then call kill_line;			/* except ourselves */

	else if int_type = SEND_OUTPUT
	then do;
	     wtcb.send_output = "1"b;			/* send_next_page will undo this if necessary */
	     if wtcb.write_first ^= 0			/* we have more output waiting */
	     then call send_next_page;
	     else if wtcb.negotiating_echo
	     then do;				/* Do we need to get start_echo ctl order thru? */

		echo_datap = ptr (ttybp, wtcb.echdp);
		if echo_data.echo_start_pending_sndopt
		then call start_negotiated_echo;	/* This happens when multiplexer couldn't honor previous start_negotiated_echo */
						/* because it had output pending. */
	     end;

	     if wtcb.write_first = 0			/* no write chain left */
	     then if wtcb.wflag			/* user is waiting to be told when output is done */
		then do;
		     unspec (net_event_message) = "0"b;
		     net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
		     net_event_message.network_type = MCS_NETWORK_TYPE;
		     net_event_message.handle = devx;
		     net_event_message.type = MCS_WRITE_MSG;
		     call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, (0));
		     wtcb.wflag = "0"b;
		end;
	end;

	else if int_type = INPUT_AVAILABLE		/* they've got input for us, but they won't say where */
	then do;
	     wtcb.input_available = "1"b;
	     if wtcb.rflag				/* the process wants it */
	     then do;
		unspec (net_event_message) = "0"b;
		net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
		net_event_message.network_type = MCS_NETWORK_TYPE;
		net_event_message.handle = devx;
		net_event_message.type = MCS_READ_MSG;
		call meter_response_time (wtcb.uproc, TTY_WAKEUP);
		call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, (0));
		wtcb.rflag = "0"b;
	     end;
	end;

	else if int_type = ACCEPT_INPUT		/* they're handing us input */
	then do;
	     unspec (rtx_info) = interrupt_info;
	     if rtx_info.formfeed_present		/* this is end_of_page response */
	     then do;
		if ^rtx_info.output_in_ring_0 & wtcb.write_first = 0
						/* if tty_write is up-to-date */
		then wtcb.actline = 0;
	     end;

	     inchain = bin (rtx_info.chain_head);
	     if inchain = 0
	     then return;

	     sync_ctr_tally = 0;			/* Set for echo sync */
	     r0_did_echo = "0"b;			/* Set for resync hack. */

	     last_offset = bin (rtx_info.chain_tail);	/* initialize end_of_chain pointer */

	     if wtcb.negotiating_echo
	     then do;				/* In echnego state */
		start_time = clock ();		/* count time spent doing this */
		tty_buf.echo_neg_interrupts = tty_buf.echo_neg_interrupts + 1;
						/* METER */
		echo_datap = ptr (ttybp, wtcb.echdp);	/* Develop table ptr */
		echbufp = null ();			/* No echo buffer yet */
		echnego_from_mux_flag = "0"b;
		if wtcb.write_last = 0
		then old_tailp = null;		/* Set for combining */
		else do;
		     old_tailp = ptr (ttybp, wtcb.write_last);
		     old_last_tally = old_tailp -> buffer.tally;
		     if old_last_tally ^< max_buffer_tally (old_tailp -> buffer.size_code) - wtcb.buffer_pad
		     then old_tailp = null;
		end;


		do blockp = ptr (ttybp, rtx_info.chain_head) repeat (ptr (ttybp, buffer.next)) while (rel (blockp));

		     echnego_scan_start = 0;

		     if echo_data.mux_will_echnego	/* Mux knows how to echo negotiate */
			& buffer.next = 0		/* This is end of chain */
			& ^rtx_info.break_char	/* Mux echoed all these characters */
						/* Except maybe the last few */
			& buffer.tally > 0
		     then do;

/* it's possible that the multiplexer (in particular, the FNP) appended a few more
   characters after it stopped echoing. This code assumes that there will be no
   more than 4 such, and that the multiplexer echoed exactly the characters up to
   but not including the first non-echoable character. */

			do echnego_scan_start = max (0, buffer.tally - 4) to buffer.tally - 1
			     while (echoable (buffer.chars (echnego_scan_start)));
			end;
			if echnego_scan_start > echo_data.horiz_room_left
						/* stopped because it ran out of line */
			then echnego_scan_start = echo_data.horiz_room_left;

			echo_data.horiz_room_left = echo_data.horiz_room_left - echnego_scan_start;
			echo_data.chars_echoed = echo_data.chars_echoed + echnego_scan_start;
			sync_ctr_tally = sync_ctr_tally - echnego_scan_start;
						/* Will go negative */
			tty_buf.echo_neg_mux_chars = tty_buf.echo_neg_mux_chars + echnego_scan_start;
						/* METER */
			rtx_info.break_char = "1"b;
			echnego_from_mux_flag = "1"b;
			if echo_data.horiz_room_left ^> 0
			then go to negotiated_echo_ceases;
		     end;

/* Mux echoed _n_o_n_e of them; see if we can echo them. */

		     do charx = echnego_scan_start to buffer.tally - 1;
						/* Scan buffer */
			this_char = buffer.chars (charx);
			if ^echoable (this_char)
			then go to negotiated_echo_ceases;


/* This character is echoable */

			if echo_data.horiz_room_left ^> 0
			then go to negotiated_echo_ceases;
			if echnego_from_mux_flag
			then do;
			     echo_data.chars_echoed = echo_data.chars_echoed + 1;
			     tty_buf.echo_neg_mux_chars = tty_buf.echo_neg_mux_chars + 1;
						/* METER */
			     sync_ctr_tally = sync_ctr_tally - 1;
			end;
			else if old_tailp ^= null
			then do;			/* Try to combine buffers */
			     r0_did_echo = "1"b;
			     old_tailp -> buffer.chars (old_last_tally) = this_char;
			     echo_data.chars_echoed = echo_data.chars_echoed + 1;
			     tty_buf.echo_neg_r0_chars = tty_buf.echo_neg_r0_chars + 1;
			     old_last_tally, old_tailp -> buffer.tally = old_last_tally + 1;
			     if old_last_tally ^< max_buffer_tally (old_tailp -> buffer.size_code) - wtcb.buffer_pad
			     then old_tailp = null;
			end;
			else do;

			     if echbufp = null
			     then do;

				r0_did_echo = "1"b;
				lctp = tty_buf.lct_ptr;
						/* we're going to check if the guy's got too much space already */
				lctep = addr (lct.lcte_array (devx));
				lctep = addr (lct.lcte_array (lcte.physical_channel_devx));
				if lcte.output_words >= divide (tty_buf.bleft, output_bpart, 17, 0)
						/* he does */
				then go to negotiated_echo_ceases;
						/* so stop for now */

				call tty_space_man$get_buffer (devx, 16, OUTPUT, echbufp);
				if echbufp = null
				then go to negotiated_echo_ceases;
						/* No more room */
				echo_tally = 0;
			     end;
			     echbufp -> buffer.chars (echo_tally) = this_char;
						/* Insert it */
			     echo_tally = echo_tally + 1;
						/* chars is 0-indexed */

			     if echo_tally >= max_buffer_tally (echbufp -> buffer.size_code) - wtcb.buffer_pad
			     then call ship_echo_buffer;
			end;
			echo_data.horiz_room_left = echo_data.horiz_room_left - 1;
		     end;				/* End of input buffer */
		end;				/* End of input chain */
		rtx_info.break_char = "0"b;		/* NO break! */
		go to negotiated_echo_continues;


negotiated_echo_ceases:				/* Some break condition or lossage has been hit. */
		echo_data.echo_start_pending_sndopt = "0"b;
						/* DONT start mux up. */
		wtcb.negotiating_echo = "0"b;		/* Turn off echoing */
negotiated_echo_continues:
		if echbufp ^= null
		then call ship_echo_buffer;
		tty_buf.echo_neg_time = tty_buf.echo_neg_time + clock () - start_time;
	     end;

	     if wtcb.echdp ^= "000000"b3
	     then do;				/* May need to count synchronization */
		echo_datap = ptr (ttybp, wtcb.echdp);
		if echo_data.synchronized
		then do;
		     if sync_ctr_tally < 0
		     then echo_data.sync_ctr = 0;	/* mux-Echoed chars reinit */
		     do blockp = ptr (ttybp, rtx_info.chain_head) repeat (ptr (ttybp, buffer.next))
			while (rel (blockp));

			sync_ctr_tally = sync_ctr_tally + buffer.tally;
		     end;				/* MUX-echoed characters have been predecremented out */
		     echo_data.sync_ctr = echo_data.sync_ctr + sync_ctr_tally;
		     if r0_did_echo & wtcb.write_first = 0
		     then do;			/* Keep output in order
						   with respect to r0 */
			tty_buf.echo_neg_mux_nonecho = tty_buf.echo_neg_mux_nonecho + 1;
			if wtcb.negotiating_echo
			then call start_negotiated_echo;
						/* Mux lost race, retry. */
		     end;
		end;
	     end;

	     if uncp_flag then
		if wtcb.receive_mode_device		/* Modification for the Datanet 7100 */
		then wtcb.wake_tbl = "0"b;		/* If UNCP then do not optimize with qedx */

	     if wtcb.wake_tbl & ^wtcb.allow_wakeup
	     then call scan_iw_char;			/* look for input wakeup char */

	     if wtcb.mark_set
	     then do;				/* indicate that input is first after mark set */
		blockp = ptr (ttybp, inchain);	/* point to first buffer */
		buffer.mark = "1"b;
		wtcb.mark_set = "0"b;		/* we've taken care of it now */
	     end;

	     if wtcb.fblock = 0
	     then do;				/* no existing blocks */
		wtcb.fblock = inchain;		/* set offset to first block */
		wtcb.fchar = 0;			/* and offset to first char */
	     end;
	     else do;
		old_tailp = ptr (ttybp, wtcb.lblock);
		next_offset = bin (rtx_info.chain_head);
		if ^old_tailp -> buffer.converted	/* don't combine new input with preconverted */
		then do;
		     old_last_tally = old_tailp -> buffer.tally;

		     max_tally = max_buffer_tally (old_tailp -> buffer.size_code);
						/* number of characters this buffer will hold */
		     filled = "0"b;
		     do while ((next_offset ^= 0) & ^filled);
						/* put as much as possible of input into last old buffer */
			new_headp = ptr (ttybp, next_offset);
			new_first_tally = new_headp -> buffer.tally;

			if (old_last_tally + new_first_tally <= max_tally) & ^new_headp -> buffer.mark
						/* if it will fit (but don't mixed marked input with unmarked) */
			then do;
			     source_ptr = addr (new_headp -> buffer.chars (0));
			     target_ptr = addr (old_tailp -> buffer.chars (old_last_tally));
			     target_ptr -> new_chars = source_ptr -> new_chars;
			     old_last_tally = old_last_tally + new_first_tally;
			     next_offset = new_headp -> buffer.next;
						/* move on to next buffer */
			     call tty_space_man$free_buffer (devx, INPUT, new_headp);
						/* through with this one */
			end;

			else filled = "1"b;		/* no more room in last old buffer */
		     end;

		     old_tailp -> buffer.tally = old_last_tally;
		end;
		old_tailp -> buffer.next = next_offset;
		if next_offset = 0
		then last_offset = 0;		/* took care of entire new chain */

	     end;

	     if last_offset ^= 0
	     then wtcb.lblock = last_offset;

	     if wtcb.wake_tbl & ^wtcb.allow_wakeup
	     then call check_iw_limit;		/* see if too much input has accumulated */

	     if rtx_info.break_char & ^rtx_info.output_in_ring_0
						/* newline or form feed */
	     then do;
		if ^rtx_info.output_in_fnp		/* if there's no output going on */
		then wtcb.actcol, wtcb.white_col = 0;	/* make sure next one starts at left margin */

		if wtcb.flags.count_lines & ^wtcb.breakall
						/* counting lines */
		then wtcb.actline = wtcb.actline + 1;	/* count this one */
	     end;
	     if (rtx_info.break_char | wtcb.wru)	/* if there was a break char or this is answerback */
		& wtcb.rflag
	     then do;				/* and the user wants a wakeup then */
		if wtcb.wake_tbl & ^wtcb.allow_wakeup
		then if wtcb.prompt_len > 0
		     then call send_prompt;
		     else ;
		else do;
		     unspec (net_event_message) = "0"b;
		     net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
		     net_event_message.network_type = MCS_NETWORK_TYPE;
		     net_event_message.handle = devx;
		     net_event_message.type = MCS_READ_MSG;
		     call meter_response_time (wtcb.uproc, TTY_WAKEUP);
		     call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, 0);
						/* wakeup the user */
		     wtcb.rflag = "0"b;		/* we've taken care of this now */
		end;
	     end;
	end;

	else if int_type = INPUT_REJECTED		/* we couldn't take more input for this guy */
	then do;
	     if wtcb.fblock ^= 0			/* if he's sitting on any */
	     then do;
		unspec (net_event_message) = "0"b;
		net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
		net_event_message.network_type = MCS_NETWORK_TYPE;
		net_event_message.handle = devx;
		net_event_message.type = MCS_READ_MSG;	/* poke him */
		if wtcb.rflag			/* he hasn't been poked already */
		then do;
		     call meter_response_time (wtcb.uproc, TTY_WAKEUP);
		     call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, (0));
		     wtcb.rflag = "0"b;
		end;

		else call pxss$unique_ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, (0));
	     end;
	end;

	else if int_type = QUIT
	then do;
	     if wtcb.flags.hndlquit
	     then do;
		if wtcb.negotiating_echo
		then do;
		     echo_datap = ptr (ttybp, wtcb.echdp);
		     echo_data.echo_start_pending_sndopt, echo_data.synchronized, wtcb.negotiating_echo = "0"b;
		end;
		if wtcb.fblock ^= 0			/* free read chain also */
		then do;
		     call tty_space_man$free_chain (devx, INPUT, ptr (ttybp, wtcb.fblock));
		     wtcb.fblock, wtcb.lblock = 0;
		end;

		if wtcb.write_first ^= 0
		then do;
		     call tty_space_man$free_chain (devx, OUTPUT, ptr (ttybp, wtcb.write_first));
		     wtcb.write_first, wtcb.write_last, wtcb.write_cnt = 0;
		end;

		wtcb.white_col = 0;
		wtcb.actcol = 0;
	     end;

	     unspec (net_event_message) = "0"b;
	     net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
	     net_event_message.network_type = MCS_NETWORK_TYPE;
	     net_event_message.handle = devx;

	     if wtcb.wflag | wtcb.rflag		/* if process was blocked on output or input */
	     then do;
		if wtcb.wflag
		then net_event_message.type = MCS_WRITE_MSG;
						/* set message type accordingly */
		else net_event_message.type = MCS_READ_MSG;
		call meter_response_time (wtcb.uproc, TTY_WAKEUP);
		call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, 0);
						/* wakeup the user */
		wtcb.wflag, wtcb.rflag = "0"b;
	     end;

	     if wtcb.flags.qenable
	     then do;				/* if quit is enabled */
		net_event_message.type = MCS_QUIT_MSG;	/* we will wake up the user so he knows what gives */
		call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, 0);

		call pxss$ips_wakeup_int (wtcb.uproc, sys_info$quit_mask);
						/* signal user process */
		wtcb.flags.qflag = "1"b;		/* set "quit received" flag */
		wtcb.mark_set = "0"b;
	     end;

	     if wtcb.count_lines
	     then if wtcb.flags.scroll
		then wtcb.actline = 0;		/* count quit as input for scrolling purposes */
		else wtcb.actline = wtcb.actline + 1;	/* else count the newline */

	     wtcb.end_frame = "0"b;

	     tty_buf.nquits = tty_buf.nquits + 1;	/* bump quit count */

	end;

	else if int_type = LINE_STATUS
	then do;
	     if ^wtcb.line_status_disabled
	     then if wtcb.uproc ^= "0"b
		then do;
		     wtcb.line_status = interrupt_info;
		     wtcb.line_status_present = "1"b;
		     unspec (net_event_message) = "0"b;
		     net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
		     net_event_message.network_type = MCS_NETWORK_TYPE;
		     net_event_message.handle = devx;
		     net_event_message.type = MCS_LINE_STATUS_MSG;
		     call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, 0);
		end;

	     return;

	end;

	else if int_type = DIAL_STATUS
	then do;
	     if wtcb.dialing
	     then do;
		wtcb.dial_status_valid = "1"b;	/* we have dial out status */
		wtcb.dial_status_code = bin (substr (interrupt_info, 1, 8), 8);
		unspec (net_event_message) = "0"b;
		net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
		net_event_message.network_type = MCS_NETWORK_TYPE;
		net_event_message.handle = devx;
		net_event_message.type = MCS_DIALOUT_MSG;
		call pxss$ring_0_wakeup (wtcb.hproc, wtcb.hevent, net_event_message_arg, 0);
						/* wakeup the user */
						/* user will use dial_status ordercall */
	     end;
	end;

	else if int_type = WRU_TIMEOUT		/* no response to answerback */
	then do;
	     if wtcb.flags.dialed
	     then do;				/* it had better be dialed */
		wtcb.rflag = "0"b;			/* read no longer pending */
		unspec (net_event_message) = "0"b;
		net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
		net_event_message.network_type = MCS_NETWORK_TYPE;
		net_event_message.handle = devx;
		net_event_message.type = MCS_READ_MSG;
		call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, 0);
						/* wakeup the user */
	     end;
	end;

	else if int_type = SPACE_AVAILABLE		/* we were waiting for space */
	then if wtcb.write_first ^= 0			/* we've got more output */
	     then call send_next_page;
	     else do;
		unspec (net_event_message) = "0"b;
		net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
		net_event_message.network_type = MCS_NETWORK_TYPE;
		net_event_message.handle = devx;
		net_event_message.type = MCS_UNSPECIFIED_MSG;
		call pxss$unique_ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, (0));
	     end;					/* unique because we don't want to pile these up */

	else if int_type = ACKNOWLEDGE_ECHNEGO_INIT
	then do;
	     echo_datap = ptr (ttybp, wtcb.echdp);
	     if echo_datap ^= ttybp
	     then do;
		echo_data.awaiting_start_sync = "0"b;
		echo_data.synchronized = "1"b;
		echo_data.sync_ctr = 0;
	     end;
	end;
	else if int_type = ACKNOWLEDGE_ECHNEGO_STOP
	then do;
	     echo_datap = ptr (ttybp, wtcb.echdp);
	     wtcb.negotiating_echo = "0"b;
	     if echo_datap ^= ttybp
	     then do;
		echo_data.awaiting_stop_sync = "0"b;
		echo_data.echo_start_pending_sndopt = "0"b;
		unspec (net_event_message) = "0"b;
		net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
		net_event_message.network_type = MCS_NETWORK_TYPE;
		net_event_message.handle = devx;
		net_event_message.type = MCS_UNSPECIFIED_MSG;
		call pxss$unique_ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, (0));
	     end;
	end;

	else if int_type = MASKED
	then do;
	     unspec (net_event_message) = "0"b;
	     net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
	     net_event_message.network_type = MCS_NETWORK_TYPE;
	     net_event_message.handle = devx;
	     net_event_message.type = MCS_MASKED_MSG;
	     call pxss$ring_0_wakeup (wtcb.hproc, wtcb.hevent, net_event_message_arg, 0);
	     call kill_line;
	     wtcb.masked = "1"b;
	end;

	else
bad_int:
	     call syserr (CRASH_SYSTEM, "tty_interrupt: unrecognized interrupt type (^d) for devx ^d", int_type, devx);

	return;

/* internal procedure to send pending output */

send_next_page:
     proc;

dcl  headp ptr;
dcl  next_head fixed bin;

	if wtcb.send_output
	then do;
	     headp, blockp = ptr (ttybp, wtcb.write_first);

	     do while (^buffer.end_of_page & buffer.next ^= 0);
						/* find last buffer of current page */
		if buffer.mark			/* this page contains the mark */
		then wtcb.mark_set = "1"b;
		blockp = ptr (ttybp, buffer.next);
	     end;

	     if buffer.mark				/* check last buffer too */
	     then wtcb.mark_set = "1"b;
	     next_head = buffer.next;
	     buffer.next = 0;			/* break chain here */
	     wtcb.end_frame = buffer.end_of_page;

	     call channel_manager$write (devx, headp, code);
	     if code = noalloc_code
	     then do;
		call tty_space_man$needs_space (devx);
		code = 0;				/* don't treat like other error codes */
	     end;


	     if headp ^= null			/* didn't take it all */
	     then do;
		if code = 0
		then do;
		     blockp = headp;
		     do while (buffer.next ^= 0);
			if buffer.mark		/* we didn't send the marked buffer yet */
			then wtcb.mark_set = "0"b;
			blockp = ptr (ttybp, buffer.next);
		     end;

		     if buffer.mark			/* have to check last one */
		     then wtcb.mark_set = "0"b;
		     buffer.next = next_head;		/* found the end of the returned chain, reconnect it */
		     if next_head = 0		/* if we weren't hanging on to one */
		     then wtcb.write_last = bin (rel (blockp));
						/* this is the end */
		     next_head = bin (rel (headp));	/* this is now head of the chain */
		end;

		else do;
		     call tty_space_man$free_chain (devx, OUTPUT, headp);
						/* all output to be discarded */
		     wtcb.mark_set = "0"b;		/* can't trust anything */
		     wtcb.error_code = code;		/* save this for callers */
		     unspec (net_event_message) = "0"b;
		     net_event_message.version = NET_EVENT_MESSAGE_VERSION_1;
		     net_event_message.network_type = MCS_NETWORK_TYPE;
		     net_event_message.handle = devx;
		     net_event_message.type = MCS_UNSPECIFIED_MSG;
						/* poke the process to make sure it finds out eventually */
		     call pxss$unique_ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, (0));
		end;
	     end;

	     wtcb.write_first = next_head;
	     if wtcb.write_first = 0
	     then wtcb.write_last = 0;		/* this must be true */
	     else if code ^= 0			/* in this case we'll throw away all output anyway */
	     then do;
		call tty_space_man$free_chain (devx, OUTPUT, ptr (ttybp, wtcb.write_first));
		wtcb.write_first, wtcb.write_last = 0;
	     end;
	     wtcb.send_output = "0"b;
	end;

	return;
     end /* send_next_page */;

/* internal procedure to set wtcb to "hung up" state */

kill_line:
     proc;

dcl  sync_flag bit (1);
dcl  masked_flag bit (1);

	if wtcb.fblock ^= 0				/* if there's a read chain, free it */
	then call tty_space_man$free_chain (devx, INPUT, ptr (ttybp, wtcb.fblock));

	if wtcb.write_first ^= 0			/* likewise for write chain */
	then call tty_space_man$free_chain (devx, OUTPUT, ptr (ttybp, wtcb.write_first));

/* save those flags that need to be preserved */

	masked_flag = wtcb.flags.masked;
	sync_flag = wtcb.flags.sync_line;
	string (wtcb.flags) = ""b;			/* clear them all, then restore saved values */
	string (wtcb.more_flags) = ""b;
	wtcb.flags.masked = masked_flag;
	wtcb.flags.sync_line = sync_flag;

	wtcb.uproc = ""b;
	wtcb.white_col, wtcb.fblock, wtcb.lblock = 0;
	wtcb.fchar, wtcb.actline, wtcb.actcol, wtcb.nramsgs = 0;
	wtcb.write_first, wtcb.write_last = 0;
	wtcb.prompt_len = 0;
	wtcb.error_code = 0;

	if wtcb.echdp ^= ""b
	then do;
	     call tty_space_man$free_space (size (echo_data), ptr (ttybp, wtcb.echdp));
	     wtcb.echdp = ""b;
	end;
	if wtcb.waketp ^= ""b
	then do;
	     call tty_space_man$free_space (size (wakeup_table), ptr (ttybp, wtcb.waketp));
	     wtcb.waketp = ""b;
	end;

     end /* kill_line */;

echoable:
     procedure (test_char) returns (bit (1) aligned);

/* function that indicates whether a given character can be echoed by anyone other than the application */

dcl  test_char char (1);
dcl  char_pos fixed bin (9);

	char_pos = rank (test_char);
	if char_pos > hbound (echo_data.break, 1)	/* it's not in the table at all */
	then return ("0"b);

/* if it is, it is echoable iff its corresponding bit is off */

	else return (^echo_data.break (char_pos));
     end echoable;

ship_echo_buffer:
     proc;

/* Proc called to ship out echo buffer for negotiated echo */

dcl  loc_echbufp ptr;
dcl  loc_lastp ptr;

	echbufp -> buffer.tally = echo_tally;
	loc_echbufp = echbufp;
	code = 0;

	if wtcb.write_first ^= 0			/* already an output chain */
	then do;
	     loc_lastp = ptr (ttybp, wtcb.write_last);
	     wtcb.write_last,			/* just append this stuff to it */
		loc_lastp -> buffer.next = bin (rel (loc_echbufp));
	     loc_echbufp = null;
	end;

	else if ^wtcb.send_output			/* shouldn't send it now */
	then do;
	     wtcb.write_first, wtcb.write_last = bin (rel (loc_echbufp));
	     loc_echbufp = null;
	end;

	else do;
	     wtcb.send_output = "0"b;
	     call channel_manager$write (devx, loc_echbufp, code);
	end;

	if loc_echbufp = null & code = 0
	then do;					/* Won */
	     echo_data.chars_echoed = echo_data.chars_echoed + echo_tally;
	     tty_buf.echo_neg_r0_chars = tty_buf.echo_neg_r0_chars + echo_tally;
						/* METER */
	end;
	else do;
	     code = 1;				/* Cause echo stop */
	     call tty_space_man$free_buffer (devx, OUTPUT, echbufp);
	end;
	echbufp = null;
	if code ^= 0
	then go to negotiated_echo_ceases;		/* Stop the rolling ball. */

     end ship_echo_buffer;

/* Subroutine to scan input chain for input wakeup chars */

scan_iw_char:
     proc;

dcl  charx fixed bin;
dcl  i fixed bin;

	wakeup_tablep = ptr (ttybp, wtcb.waketp);
	do blockp = ptr (ttybp, rtx_info.chain_head) repeat (ptr (ttybp, buffer.next)) while (rel (blockp));
	     do charx = 0 to buffer.tally - 1;
		i = bin (unspec (buffer.chars (charx)));
		if i <= 127
		then if wakeup_table.wake_map (i)	/* found a wakeup char */
		     then do;
			wtcb.allow_wakeup = "1"b;
			return;
		     end;
	     end;
	end;

     end;



/* Subroutine to check if buffered input exceeds limit for wake_tbl mode */

check_iw_limit:
     proc;

	lctp = tty_buf.lct_ptr;
	lctep = addr (lct.lcte_array (devx));
	lctep = addr (lct.lcte_array (lcte.physical_channel_devx));
	if lcte.input_words > min (128, divide (tty_buf.bleft, 4, 17, 0))
	then wtcb.allow_wakeup = "1"b;

     end;

/* Subroutine to write a prompt message */

send_prompt:
     proc;

dcl  bufp ptr;


	call tty_space_man$get_buffer (devx, 16, OUTPUT, bufp);
	if bufp = null
	then return;

	substr (string (bufp -> buffer.chars), 1, wtcb.prompt_len) = substr (wtcb.prompt, 1, wtcb.prompt_len);
	bufp -> buffer.tally = wtcb.prompt_len;
	if wtcb.write_first = 0			/* thread prompt buffer onto write chain */
	then wtcb.write_first = bin (rel (bufp));
	else ptr (ttybp, wtcb.write_last) -> buffer.next = bin (rel (bufp));
	wtcb.write_last = bin (rel (bufp));

	call send_next_page;			/* ship it out */

     end;

set_static:
     entry;

/* entry called once per bootload to copy error codes into internal static */

	noalloc_code = error_table_$noalloc;
	no_write_code = error_table_$invalid_write;
	return;

start_negotiated_echo:
     proc;					/* echdp had better be set. */
	echo_start_data.ctr = echo_data.sync_ctr;
	echo_start_data.screenleft = echo_data.horiz_room_left;
	call channel_manager$control (devx, "start_negotiated_echo", addr (echo_start_data), code);
	if code = 0
	then echo_data.echo_start_pending_sndopt = "0"b;
	else if code = no_write_code
	then echo_data.echo_start_pending_sndopt = "1"b;
	tty_buf.echo_neg_sndopt_restarts = tty_buf.echo_neg_sndopt_restarts + 1;
						/* METER */
     end;

is_parent_mpx:					/* Check for match of channel's parent mpx type and input mpx type */
     proc (parent_mpx_type) returns (bit (1));

dcl parent_mpx_type fixed bin;
dcl temp_lctep ptr;
     
          lctp = tty_buf.lct_ptr;
	lctep = addr (lct.lcte_array (devx));
	if lcte.major_channel_devx ^= 0 then do;
	     temp_lctep = addr (lct.lcte_array (lcte.major_channel_devx));
	     if temp_lctep->lcte.channel_type = parent_mpx_type then return ("1"b);
	end;
	else if lcte.channel_type = parent_mpx_type then return ("1"b);
	return ("0"b);
     end is_parent_mpx;
     

/* BEGIN MESSAGE DOCUMENTATION


   Message:
   tty_interrupt: unrecognized interrupt type (N) for devx D

   S:	$crash

   T:	$run

   M:	An unrecognized interrupt type has been reported for the nonmultiplexed
   channel whose device index is D.

   A:	$inform


   END MESSAGE DOCUMENTATION */

     end /* tty_interrupt */;




		    tty_lock.pl1                    11/11/89  1132.7rew 11/11/89  0825.4      154782



/****^  ***********************************************************
        *                                                         *
        * 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.      *
        *                                                         *
        *********************************************************** */


/* format: style4,delnl,insnl,^ifthendo */
tty_lock:
     proc;

/* This procedure locks and unlocks channel locks.  Locking
   performed at interrupt time differs from ordinary locking
   in two ways:

   1.  At interrupt time, one cannot wait for a channel that
   is locked to be unlocked.  Therefore, failure to lock immediately
   at interrupt time results in the interrupt operation being
   queued (i.e., postponed) for later execution.  Queued
   interrupts for a channel are processed the next time the
   channel is unlocked.

   2.  Ordinarily, it is considered an error when a process
   attempts to lock a channel that it has already locked.
   However, if the channel was previously locked for an
   interrupt operation, then subsequent attempts by the same
   process to lock and unlock for non-interrupt operations are
   simply ignored.  This permits an interrupt handler executing
   on behalf of some subchannel to perform an operation on its
   major channel even though the major channel was previously
   locked for the same interrupt.
*/

/* Recoded by J. Stern 8/8/78 */
/* lock_lcte entry added 12/12/79 by Robert Coren */
/* Modified 6 Apr 82, W. Olin Sibert: check_for_interrupt, dequeue_interrupt entries added for mcs_timer */
/* Modified 83-12-19 BIM to add pm_code to lock_lcte, which can set it! */
/* Modified September 1984 by Robert Coren to make dequeue_*_interrupt entries
   avoid calling tty_space_man$free_space while holding the queue lock  */
/* Modified March 1985 by EJ Sharpe to return bit from $verify */

/* Parameters */

dcl  pm_lctep ptr;
dcl  pm_devx fixed bin;
dcl  pm_subchan_devx fixed bin;
dcl  pm_int_type fixed bin;
dcl  pm_int_data bit (72) aligned;
dcl  pm_locked bit (1) aligned;
dcl  pm_code fixed bin (35);


/* Automatic */

dcl  devx fixed bin;
dcl  subchan_devx fixed bin;
dcl  tried bit (1) aligned;
dcl  locked bit (1) aligned;
dcl  i fixed bin;
dcl  wire_arg fixed bin (71);
dcl  wire_ptr ptr;
dcl  qep ptr;
dcl  qtp ptr;
dcl  (prev_qep, next_qep) ptr;
dcl  (first_free_qep, last_free_qep) ptr;
dcl  dequeue_all bit (1) aligned;
dcl  int_type fixed bin;
dcl  int_data bit (72) aligned;
dcl  start_wait_time fixed bin (71);
dcl  wait_time fixed bin (35);
dcl  unlocked_something bit (1) aligned;

/* Based */

dcl  1 queue_entry aligned based (qep),
       2 next_entry bit (18) unal,
       2 subchan_devx fixed bin (18) unsigned unal,
       2 int_type fixed bin,
       2 int_data bit (72);


/* External static */

dcl  pds$process_id bit (36) ext;
dcl  pds$process_group_id char (32) aligned ext;
dcl  error_table_$io_no_permission fixed bin (35) ext;


/* Builtins */

dcl  (addr, clock, max, null, stac, stacq, size, rel, pointer, ptr) builtin;


/* Entries */

dcl  pxss$addevent entry (fixed bin);
dcl  pxss$delevent entry (fixed bin);
dcl  pxss$notify entry (fixed bin);
dcl  pxss$wait entry;
dcl  syserr entry options (variable);
dcl  pmut$wire_and_mask entry (fixed bin (71), ptr);
dcl  pmut$unwire_unmask entry (fixed bin (71), ptr);
dcl  mcs_timer$verify_lock entry ();
%page;
lock_lcte:
     entry (pm_lctep, pm_code);			/* locks a channel before a non-interrupt operation given an LCTE pointer */

	ttybp = addr (tty_buf$);
	lctp = tty_buf.lct_ptr;
	lctep = pm_lctep;
	go to lock_it;


lock_channel:
     entry (pm_devx, pm_code);			/* locks a channel before a non-interrupt operation */

	pm_code = 0;
	call setup ();
	if ^lcte.entry_in_use | lcte.special_lock
	then go to no_permission;
lock_it:
	tty_buf.tty_lock_calls = tty_buf.tty_lock_calls + 1;
	if lcte.lock = pds$process_id			/* we've already locked this channel */
	then if lcte.locked_for_interrupt		/* ok, don't lock it again */
	     then return;
	     else call syserr (SYSERR_CRASH_SYSTEM, "tty_lock: attempt to lock channel already locked by same process.")
		     ;

	locked = "0"b;
	tried = "0"b;
	do while (^locked);
	     if stac (addr (lcte.lock), pds$process_id)
	     then locked = "1"b;			/* we locked it */
	     else do;				/* must wait for lock to be unlocked */
		if ^tried
		then do;
		     tty_buf.found_channel_locked = tty_buf.found_channel_locked + 1;
		     start_wait_time = clock ();
		     tried = "1"b;
		end;

		call pxss$addevent (tty_ev);		/* get ready to wait for this event */
		lcte.notify_reqd = "1"b;		/* ask to be notified when lock is unlocked */
		if stac (addr (lcte.lock), pds$process_id)
						/* try once more to lock) it */
		then do;				/* got it, no need to wait */
		     call pxss$delevent (tty_ev);
		     locked = "1"b;
		end;
		else call pxss$wait ();
	     end;
	end;

	if tried
	then do;					/* if we had to wait, meter */
	     wait_time = clock () - start_wait_time;
	     tty_buf.total_wait_time = tty_buf.total_wait_time + wait_time;
	     tty_buf.max_wait_time = max (tty_buf.max_wait_time, wait_time);
	end;

	if lcte.initialized
	then return;

	call unlock ();				/* don't keep uninitialized channel locked */

no_permission:
	pm_code = error_table_$io_no_permission;

	return;
%page;
lock_channel_int:
     entry (pm_devx, pm_int_type, pm_int_data, pm_locked);	/* locks a channel before an interrupt operation */


	int_type = pm_int_type;
	int_data = pm_int_data;
	subchan_devx = 0;
	pm_locked = "0"b;
	call setup ();
	tty_buf.tty_lock_calls = tty_buf.tty_lock_calls + 1;
	if ^lcte.entry_in_use
	then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock: attempt to lock unused channel for interrupt.");

	call lock_queue;
	if ^stac (addr (lcte.lock), pds$process_id)
	then do;					/* cannot set lock, must queue the interrupt */
	     call enqueue;
	     call unlock_queue;
	     return;
	end;
	call unlock_queue;

	if ^lcte.initialized
	then do;					/* ignore interrupts for uninitialized channels */
	     call unlock ();
	     return;
	end;

	lcte.locked_for_interrupt = "1"b;
	pm_locked = "1"b;
	return;
%page;
queue_interrupt:
     entry (pm_devx, pm_int_type, pm_int_data, pm_subchan_devx);

/* This entry adds an entry to the queue for a major channel on behalf of one of
   its subchannels. it is used by channel_manager$interrupt_later
*/

	int_type = pm_int_type;
	int_data = pm_int_data;
	subchan_devx = pm_subchan_devx;
	call setup ();

	call lock_queue;
	call enqueue;
	call unlock_queue;
	return;
%page;
unlock_channel:
     entry (pm_devx);				/* unlocks a channel after a non-interrupt operation */

	call setup ();

	if lcte.lock = pds$process_id			/* we have channel locked as expected */
	then if lcte.locked_for_interrupt		/* but we don't really want to unlock it now */
	     then return;

	call unlock ();

	return;



unlock_channel_int:
     entry (pm_devx);				/* unlocks a channel after an interrupt operation */

	call setup ();

	lcte.locked_for_interrupt = "0"b;
	call unlock ();
	return;
%page;
flush_queue:
     entry (pm_devx);				/* deletes all queue entries for a given channel */

	call setup ();

	do while (dequeue ());
	end;
	return;



cleanup_locks:
     entry;					/* called only by terminate_proc */

	call CLEANUP_LOCKS;
	return;


verify:
     entry () returns (bit (1) aligned);

	call CLEANUP_LOCKS;
	return (unlocked_something);


CLEANUP_LOCKS:			/* internal procedure for $cleanup_locks and $verify entrypoints */
     procedure ();

	unlocked_something = "0"b;
	ttybp = addr (tty_buf$);
	if tty_buf.slock = pds$process_id
	then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock$verify: attempted crawlout with tty_buf lock set.");

	lctp = tty_buf.lct_ptr;
	if lctp = null ()
	then return;				/* MCS not started yet, never mind */
	if lct.queue_lock = pds$process_id
	then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock$verify: attempted crawlout with queue lock set.");

	call mcs_timer$verify_lock ();		/* will crash system if timer lock locked */

	do i = 1 to lct.max_no_lctes;
	     lctep = addr (lcte_array (i));
	     if lcte.entry_in_use
	     then if lcte.lock = pds$process_id
		then if lcte.special_lock
		     then call syserr (SYSERR_CRASH_SYSTEM,
			     "tty_lock$verify: attempted crawlout with special channel lock set.");
		     else do;
			devx = i;
			call force_unlock;		/* clear the lock so next caller won't hang */
			unlocked_something = "1"b;
		     end;
	end;

	return;

     end CLEANUP_LOCKS;
%page;
check_for_interrupt:
     entry (pm_devx, pm_int_type, pm_int_data) returns (bit (1) aligned);

	int_type = pm_int_type;
	int_data = pm_int_data;
	call setup ();

	call lock_queue ();

	do qep = pointer (ttybp, lcte.queue_head) repeat (pointer (ttybp, queue_entry.next_entry))
	     while (rel (qep) ^= ""b);

	     if (queue_entry.int_type = int_type) & (queue_entry.int_data = int_data)
	     then do;
		call unlock_queue ();
		return ("1"b);			/* You're our boy */
	     end;
	end;

	call unlock_queue ();

	return ("0"b);				/* None found */
%page;
dequeue_one_interrupt:
     entry (pm_devx, pm_int_type, pm_int_data);

	dequeue_all = "0"b;
	int_data = pm_int_data;
	goto dequeue_common;


dequeue_all_interrupts:
     entry (pm_devx, pm_int_type);

	dequeue_all = "1"b;


dequeue_common:
	int_type = pm_int_type;
	call setup ();

	call lock_queue ();

/* it's not safe to call tty_space_man with the queue lock locked, because it can
   generate "space_available" interrupts; so we'll keep a list of entries to free
   and free them all after we've unthreaded them and released the lock.
*/

	prev_qep, first_free_qep = pointer (ttybp, 0);
	do qep = pointer (ttybp, lcte.queue_head) repeat (next_qep) while (rel (qep) ^= ""b);
	     next_qep = pointer (ttybp, queue_entry.next_entry);

	     if (queue_entry.int_type = int_type) & (dequeue_all | (queue_entry.int_data = int_data))
	     then do;
		if (lcte.queue_head = rel (qep))
		then lcte.queue_head = queue_entry.next_entry;

		if (lcte.queue_tail = rel (qep))
		then lcte.queue_tail = rel (prev_qep);

		if (rel (prev_qep) ^= ""b)
		then prev_qep -> queue_entry.next_entry = queue_entry.next_entry;

/* put this one on the "to be freed" list */

		queue_entry.next_entry = ""b;
		if rel (first_free_qep) = ""b
		then first_free_qep, last_free_qep = qep;
		else do;
		     last_free_qep -> queue_entry.next_entry = rel (qep);
		     last_free_qep = qep;
		end;
	     end;
	     else prev_qep = qep;
	end;					/* Of loop through queue entries */

	call unlock_queue ();

/* now go through the free list (if any) and free the entries on it */

	do qep = first_free_qep repeat (next_qep) while (rel (qep) ^= ""b);
	     next_qep = pointer (ttybp, queue_entry.next_entry);
	     call tty_space_man$free_space (size (queue_entry), qep);
	end;

	return;
%page;
setup:
     proc;

	ttybp = addr (tty_buf$);
	lctp = tty_buf.lct_ptr;
	devx = pm_devx;
	lctep = addr (lct.lcte_array (devx));
	return;
     end setup;



unlock:
     proc;

/* process all entries in the channel queue before unlocking */
/* last call to dequeue will unlock the channel lock */

	do while (dequeue ());
	     lcte.locked_for_interrupt = "1"b;		/* make queued interrupt look real */
	     if subchan_devx ^= 0			/* this is really for a subchannel */
	     then call channel_manager$interrupt (subchan_devx, int_type, int_data);
	     else call channel_manager$queued_interrupt (devx, int_type, int_data);
	     lcte.locked_for_interrupt = "0"b;
	end;

	if lcte.notify_reqd				/* someone is waiting for this lock */
	then do;					/* let everyone know it's available */
	     lcte.notify_reqd = "0"b;
	     call pxss$notify (tty_ev);
	end;

     end;						/* unlock */



force_unlock:
     procedure;

/* lock is to be forced because process is crawling out. Send notify if necessary,
   but flush queued interrupts rather than attempting to process them.
*/

	call syserr (SYSERR_LOG_OR_PRINT, "tty_lock: forcing unlock of channel ^a from ^a",
	     lct.lcnt_ptr -> lcnt.names (devx), pds$process_group_id);

	lcte.locked_for_interrupt = "0"b;
	do while (dequeue ());			/* this flushes the queue and unlocks the channel when it's done */
	end;

	if lcte.notify_reqd
	then do;
	     lcte.notify_reqd = "0"b;
	     call pxss$notify (tty_ev);
	end;

	return;
     end force_unlock;
%page;
lock_queue:
     proc;

	call pmut$wire_and_mask (wire_arg, wire_ptr);

	do while (^stac (addr (lct.queue_lock), pds$process_id));
	end;

     end;						/* lock_queue */



unlock_queue:
     proc;

	if ^stacq (lct.queue_lock, "0"b, pds$process_id)
	then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock: attempt to unlock queue not locked by same process.");

	call pmut$unwire_unmask (wire_arg, wire_ptr);

     end;						/* unlock_queue */
%page;
enqueue:
     proc;					/* adds queue entry to head of channel queue */


	if ^lcte.initialized			/* don't queue anything for an uninitialized channel */
	then return;

	call tty_space_man$get_space (size (queue_entry), qep);
	if qep = null
	then do;
	     call syserr (SYSERR_PRINT_WITH_ALARM, "tty_lock: Cannot get space for queue entry. (devx = ^d)", devx);
	     return;
	end;

	queue_entry.int_type = int_type;
	queue_entry.int_data = int_data;
	queue_entry.subchan_devx = subchan_devx;
	if lcte.queue_tail = "0"b			/* queue is empty */
	then lcte.queue_tail, lcte.queue_head = rel (qep);/* new entry is both first and last */
	else do;
	     qtp = ptr (ttybp, lcte.queue_tail);	/* get ptr to last entry */
	     qtp -> queue_entry.next_entry = rel (qep);	/* put new entry after it */
	     lcte.queue_tail = rel (qep);		/* new entry is now the last */
	end;
	queue_entry.next_entry = "0"b;		/* nothing follows last entry */
	tty_buf.n_queued_interrupts = tty_buf.n_queued_interrupts + 1;

     end;



dequeue:
     proc returns (bit (1));				/* removes entry from head of channel queue */

	call lock_queue ();
	if lcte.queue_head = "0"b			/* queue is empty */
	then do;
	     qep = null;
	     if ^stacq (lcte.lock, "0"b, pds$process_id)
	     then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock: attempt to unlock channel not locked by same process.");
	end;

	else do;
	     qep = ptr (ttybp, lcte.queue_head);	/* get ptr to first queue entry */
	     lcte.queue_head = queue_entry.next_entry;	/* next entry is now first */
	     if lcte.queue_head = "0"b		/* there was no next entry */
	     then lcte.queue_tail = "0"b;
	end;
	call unlock_queue ();

	if qep = null
	then return ("0"b);				/* indicate empty queue */
	else do;
	     int_type = queue_entry.int_type;
	     int_data = queue_entry.int_data;
	     subchan_devx = queue_entry.subchan_devx;
	     call tty_space_man$free_space (size (queue_entry), qep);
	     return ("1"b);
	end;

     end;
%page;
%include lct;
%include tty_buf;
%include tty_space_man_dcls;
%include channel_manager_dcls;
%include syserr_constants;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   tty_lock: attempt to lock channel already locked by same process.

   S:	$crash

   T:	$run

   M:	A locking error was detected when a process tried to lock a
   channel that it had already locked.

   A:	$inform


   Message:
   tty_lock: attempt to lock unused channel for interrupt.

   S:	$crash

   T:	$run

   M:	A locking error was detected when an interrupt handler
   tried to lock an ununsed channel.

   A:	$inform


   Message:
   tty_lock: attempt to unlock channel not locked by same process.

   S:	$crash

   T:	$run

   M:	A locking error was detected when a process tried to unlock
   a channel that was either not locked or locked by another process.

   A:	$inform


   Message:
   tty_lock$verify: attempted crawlout with tty_buf lock set.

   S:	$crash

   T:	$run

   M:	There was an attempt to crawl out while the tty_buf lock used
   by tty_space_man was locked.

   A:	$inform


   Message:
   tty_lock$verify: attempted crawlout with special channel lock set.

   S:	$crash

   T:	$run

   M:	There was an attempt to crawl out while a channel lock that
   is also a processor lock was locked.

   A:	$inform

   Message:
   tty_lock$verify: attempted crawlout with queue lock set.

   S:	$crash

   T:	$run

   M:	There was an attempt to crawl out while the tty queue
   lock was locked.

   A:	$inform

   Message:
   tty_lock: Cannot get space for queue entry. (devx = N)

   S:	$beep

   T:	$run

   M:	An attempt to queue an interrupt for the channel with devx N
   failed due to lack of space.  The interrupt was lost which may cause
   loss of data or improper channel operation.

   A:	$inform


   Message:
   tty_lock: attempt to unlock queue not locked by same process.

   S:	$crash

   T:	$run

   M:	A locking error was detected when a process tried to unlock
   the global queue lock which was either not locked or was locked by another
   process.

   END MESSAGE DOCUMENTATION */

     end tty_lock;




		    tty_space_man.pl1               11/11/89  1132.7r w 11/11/89  0825.4      173385



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

/* TTY_SPACE_MAN: Entries for managing the ring-0 tty buffer */
/* Written January 1978 by Larry Johnson to replace tty_free */
/* Modified 8/25/78 by J. Stern for multiplexing changes */
/* Modified March 1981 by Robert Coren to add get_perm_space entry */
/* Modified April 1981 by Robert Coren to add switch_chain entry */
/* Modified May 19, 1982 by Robert Coren to fix argument-copying bug in switch_chain entry */

/* format: style4,delnl,insnl,^ifthendo */

tty_space_man:
     proc;

/* Parameters */

dcl  arg_devx fixed bin;				/* Index of lcte */
dcl  arg_from_devx fixed bin;
dcl  arg_to_devx fixed bin;
dcl  arg_size fixed bin;				/* Size of buffer request */
dcl  arg_output_flag bit (1);				/* On for output buffers */
dcl  arg_from_type bit (1);				/* On if switching from output */
dcl  arg_to_type bit (1);				/* On if switching to output */
dcl  arg_blockp ptr;				/* Pointer to a buffer */
dcl  arg_count fixed bin;				/* Length of a buffer chain */

/* Automatic */

dcl  output_flag bit (1);				/* Copy of arg_output_flag argument */
dcl  perm bit (1);					/* on for get_perm_space entry */
dcl  buffer_size fixed bin;
dcl  count fixed bin;
dcl  word_count fixed bin;
dcl  i fixed bin;
dcl  prev_blockp ptr;
dcl  first_blockp ptr;
dcl  devx fixed bin;				/* Copy of arg_devx */
dcl  from_devx fixed bin;
dcl  to_devx fixed bin;
dcl  from_type bit (1);
dcl  to_type bit (1);
dcl  total_freed fixed bin;				/* Amount of space freed during call */
dcl  wire_mask fixed bin (71);			/* For pmut$wire calls */
dcl  wire_ptr ptr;					/* This too */
dcl  enter_time fixed bin (71);			/* clock time at entry (for metering) */

/* External */

dcl  pds$processid bit (36) external;

dcl  caller entry returns (ptr);
dcl  mcs_trace entry options (variable);
dcl  pmut$wire_and_mask entry (fixed bin (71), ptr);
dcl  pmut$unwire_unmask entry (fixed bin (71), ptr);
dcl  pxss$unique_ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
dcl  syserr entry options (variable);

/* Internal static */

dcl  RESERVED_SPACE internal static options (constant) init (256);

/* Builtins */

dcl  (addr, addrel, baseno, bin, bit, clock, divide, mod, null, ptr, rel, stac, stacq, unspec) builtin;

/* Entry to get a single buffer */

get_buffer:
     entry (arg_devx, arg_size, arg_output_flag, arg_blockp);

	devx = arg_devx;
	buffer_size = arg_size;
	output_flag = arg_output_flag;
	call setup;
	tty_buf.alloc_calls = tty_buf.alloc_calls + 1;

	call buffer_getter (buffer_size);		/* Allocate the buffer */
	if blockp ^= null
	then call update_lcte (buffer_size);		/* Fix wtcb if it worked */
	call clean_up;
	arg_blockp = blockp;
	tty_buf.alloc_time = tty_buf.alloc_time + clock () - enter_time;
	return;

/* Entry to get a chain of buffers */

get_chain:
     entry (arg_devx, arg_size, arg_count, arg_output_flag, arg_blockp);

	devx = arg_devx;
	buffer_size = arg_size;
	count = arg_count;
	output_flag = arg_output_flag;
	call setup;
	tty_buf.alloc_calls = tty_buf.alloc_calls + 1;

	first_blockp, prev_blockp = null;
	do i = 1 to count;				/* Allocate number requested */
	     call buffer_getter (buffer_size);
	     if blockp = null
	     then go to get_chain_failed;		/* Ran out of room */
	     if i = 1
	     then first_blockp = blockp;		/* Remember pointer to first block */
	     else prev_blockp -> buffer.next = bin (rel (blockp));
						/* And thread the rest */
	     prev_blockp = blockp;
	end;
	call update_lcte (count * buffer_size);		/* Charge to device */
	call clean_up;
	arg_blockp = first_blockp;			/* Return pointer to first in chain */
	tty_buf.alloc_time = tty_buf.alloc_time + clock () - enter_time;
	return;

get_chain_failed:					/* Not enough buffers */
	blockp = first_blockp;
	if blockp ^= null
	then call chain_freer;			/* Release partial chain */
	call clean_up;
	arg_blockp = null;
	tty_buf.alloc_time = tty_buf.alloc_time + clock () - enter_time;
	return;

/* Entry to free a single buffer */

free_buffer:
     entry (arg_devx, arg_output_flag, arg_blockp);

	devx = arg_devx;
	output_flag = arg_output_flag;
	blockp = arg_blockp;
	call setup;
	tty_buf.free_calls = tty_buf.free_calls + 1;

	call buffer_freer;				/* This does the work */
	call update_lcte (-total_freed);
	call clean_up;
	arg_blockp = null;
	tty_buf.free_time = tty_buf.free_time + clock () - enter_time;
	return;

/* Entry to free a buffer chain */

free_chain:
     entry (arg_devx, arg_output_flag, arg_blockp);

	devx = arg_devx;
	output_flag = arg_output_flag;
	blockp = arg_blockp;
	call setup;
	tty_buf.free_calls = tty_buf.free_calls + 1;

	call chain_freer;				/* This does the work */
	call update_lcte (-total_freed);
	call clean_up;
	arg_blockp = null;
	tty_buf.free_time = tty_buf.free_time + clock () - enter_time;
	return;

/* Entry to get space of arbitrary size */

get_space:
     entry (arg_size, arg_blockp);

	perm = "0"b;
	go to get_space_join;

/* Entry to get permanent space of arbitrary size (used to allocate LCT); point
   is to not count it against buffer pool for metering */
get_perm_space:
     entry (arg_size, arg_blockp);

	perm = "1"b;
get_space_join:
	buffer_size = arg_size + mod (arg_size, 2);
	call setup;
	tty_buf.alloc_calls = tty_buf.alloc_calls + 1;

	blockp = space_getter (buffer_size);
	call clean_up;
	arg_blockp = blockp;
	tty_buf.alloc_time = tty_buf.alloc_time + clock () - enter_time;
	if ^perm
	then call update_control (buffer_size);
	return;

/* Entry to free space of arbitrary size */

free_space:
     entry (arg_size, arg_blockp);

	buffer_size = arg_size + mod (arg_size, 2);	/* Make it even */
	blockp = arg_blockp;
	call setup;
	tty_buf.free_calls = tty_buf.free_calls + 1;

	call space_freer (blockp, buffer_size);
	call clean_up;
	arg_blockp = null;
	tty_buf.free_time = tty_buf.free_time + clock () - enter_time;
	call update_control (-buffer_size);
	return;



/* This entry is called when a process needs an interrupt when buffer space becomes available */

needs_space:
     entry (arg_devx);

	devx = arg_devx;
	call setup;

	lctep = addr (lct.lcte_array (devx));
	lcte.space_needed = "1"b;			/* Remember this process needs an interrupt */
	tty_buf.space_needed = "1"b;			/* Remember that at least one process needs an interrupt */
	tty_buf.space_needed_calls = tty_buf.space_needed_calls + 1;
						/* Leave some evidence */
	call clean_up;
	return;

/* Entry to update metering information if a multiplexer changes a chain from input to
   output (or vice versa) and/or from one channel to another */

switch_chain:
     entry (arg_from_devx, arg_to_devx, arg_from_type, arg_to_type, arg_blockp);

	from_devx = arg_from_devx;
	to_devx = arg_to_devx;
	from_type = arg_from_type;
	to_type = arg_to_type;
	blockp = arg_blockp;
	call setup;
	word_count = 0;
	do while (blockp ^= null ());			/* ascertain the length of the chain */
	     word_count = word_count + 16 * (buffer.size_code + 1);
	     if buffer.next = 0
	     then blockp = null ();
	     else blockp = ptr (ttybp, buffer.next);
	end;

	devx = from_devx;				/* take it away from old one */
	output_flag = from_type;
	call update_lcte (-word_count);
	devx = to_devx;				/* and give it to new one */
	output_flag = to_type;
	call update_lcte (word_count);
	call clean_up;

	if tty_buf.trace.enable
	then if tty_buf.trace.space_man
	     then call mcs_trace (from_devx, "switch_chain: ^d words to devx ^o by ^p", word_count, to_devx, caller ());

	return;

/* Procedure to allocate one buffer */

buffer_getter:
     proc (n);

dcl  n fixed bin;					/* The size */

	if tty_buf.bleft <= RESERVED_SPACE		/* always save some for critical functions */
	then blockp = null;
	else do;
	     blockp = space_getter (n);		/* Get the space */
	     if blockp = null
	     then return;				/* Error */
	     buffer.size_code = divide (n, 16, 17, 0) - 1;
	end;

	if tty_buf.trace.enable
	then if tty_buf.trace.space_man
	     then call mcs_trace (devx, "get_buffer: ^d words at ^p by ^p", n, blockp, caller ());

	return;
     end buffer_getter;

/* Procedure to free a single buffer pointed to by blockp */

buffer_freer:
     proc;

dcl  n fixed bin;

	n = 16 * (buffer.size_code + 1);

	if tty_buf.trace.enable
	then if tty_buf.trace.space_man
	     then call mcs_trace (devx, "free_buffer: ^d words at ^p by ^p", n, blockp, caller ());

	call space_freer (blockp, n);
	total_freed = total_freed + n;
	return;

     end buffer_freer;

/* Procedure to free a buffer chain */

chain_freer:
     proc;

dcl  next_rel bit (18);

	if tty_buf.trace.enable
	then if tty_buf.trace.space_man
	     then call mcs_trace (devx, "free_chain: at ^p by ^p", blockp, caller ());

	next_rel = rel (blockp);			/* Start non-zero */
	do while (next_rel);			/* Loop to end of chain */
	     next_rel = bit (bin (buffer.next, 18), 18);	/* Hold foward pointer */
	     call buffer_freer;
	     blockp = ptr (ttybp, next_rel);
	end;
	blockp = null;
	return;

     end chain_freer;

/* Procedure to find a block of any size. It is extracted from the smallest free block which can hold it */

space_getter:
     proc (n) returns (ptr);

dcl  n fixed bin;					/* The size in words */

dcl  best_blockp ptr init (null);			/* Ptr to smallest free block large enough for request */
dcl  best_block_size fixed bin init (0);		/* Size of that block */
dcl  prev_best_blockp ptr init (null);			/* Block before best_blockp -> free_block */
dcl  prev_blockp ptr init (null);			/* Block before current block during scan */
dcl  next_rel bit (18);				/* For updating threading */
dcl  p ptr;
dcl  free_space (n) bit (36) aligned based (free_blockp);	/* The space finially allocated */
dcl  nsteps fixed bin init (0);			/* Number of steps in free chain */

	do free_blockp = ptr (ttybp, tty_buf.free) repeat (ptr (ttybp, free_block.next)) while (rel (free_blockp));
						/* Check each free block */
	     nsteps = nsteps + 1;
	     if free_block.size = n
	     then do;				/* Found block just right */
		next_rel = free_block.next;		/* Will unthread whole block */
		go to fit_found;
	     end;
	     if free_block.size > n
	     then do;				/* This block is large enough */
		if (best_block_size = 0) | (free_block.size < best_block_size)
		then do;				/* If either the first block, or a better one */
		     best_blockp = free_blockp;	/* Remember this block */
		     best_block_size = free_block.size;
		     prev_best_blockp = prev_blockp;	/* Remember preceding block */
		end;
	     end;
	     prev_blockp = free_blockp;
	end;

	if best_block_size = 0
	then do;					/* No space large enough */
	     tty_buf.alloc_failures = tty_buf.alloc_failures + 1;
	     return (null);
	end;

	free_blockp = best_blockp;			/* Block to use */
	prev_blockp = prev_best_blockp;
	p = addrel (free_blockp, n);			/* Get pointer to new free block */
	next_rel = rel (p);
	p -> free_block.next = free_block.next;
	p -> free_block.size = free_block.size - n;
fit_found:
	if prev_blockp = null
	then tty_buf.free = next_rel;			/* Have unthreaded from head */
	else prev_blockp -> free_block.next = next_rel;	/* Unthreaded from middle */

	unspec (free_space) = "0"b;			/* Clear the buffer */
	tty_buf.bleft = tty_buf.bleft - n;		/* Total free space */
	if tty_buf.minimum_free_space = 0 | tty_buf.bleft < tty_buf.minimum_free_space
	then tty_buf.minimum_free_space = tty_buf.bleft;	/* metering */
	tty_buf.total_alloc_steps = tty_buf.total_alloc_steps + nsteps;
	return (free_blockp);			/* Return the answer */

     end space_getter;

/* Procedure to free space of arbitrary size */

space_freer:
     proc (p, n);

dcl  p ptr;					/* Address of block to free */
dcl  n fixed bin;					/* Word count */
dcl  (prev_blockp, next_blockp) ptr;
dcl  next_rel fixed bin (18);

	if (baseno (p) ^= baseno (ttybp)) | (rel (p) < tty_buf.borig)
	then call err (3);
	free_blockp = p;
	free_block.size = n;			/* Initialize free block */
	free_block.next = "0"b;
	prev_blockp = null;
	do free_blockp = ptr (ttybp, tty_buf.free) repeat (ptr (ttybp, free_block.next)) while (rel (free_blockp));
						/* Find spot in chain before this block */
	     if rel (p) < rel (free_blockp)
	     then go to found_hole;			/* Block goes before here */
	     else if rel (p) = rel (free_blockp)
	     then call err (4);
	     prev_blockp = free_blockp;
	end;

/* Block goes at end */

	free_blockp = p;
	go to chain_back;

/* Found hole in middle for this block */

found_hole:
	next_blockp = free_blockp;
	free_blockp = p;
	next_rel = bin (rel (free_blockp)) + free_block.size;
						/* Word after current block */
	if next_rel > bin (rel (next_blockp))
	then call err (4);				/* Overlap */
	else if next_rel = bin (rel (next_blockp))
	then do;					/* Can combine with next */
	     free_block.next = next_blockp -> free_block.next;
	     free_block.size = free_block.size + next_blockp -> free_block.size;
	end;
	else free_block.next = rel (next_blockp);	/* Point current at next */

/* Chain back to preceding block  */

chain_back:
	if prev_blockp = null
	then tty_buf.free = rel (free_blockp);		/* This is first block */
	else do;
	     next_rel = bin (rel (prev_blockp)) + prev_blockp -> free_block.size;
						/* Word after previous block */
	     if next_rel > bin (rel (free_blockp))
	     then call err (4);			/* Overlap */
	     else if next_rel = bin (rel (free_blockp))
	     then do;				/* Can combine */
		prev_blockp -> free_block.next = free_block.next;
		prev_blockp -> free_block.size = prev_blockp -> free_block.size + free_block.size;
	     end;
	     else prev_blockp -> free_block.next = rel (free_blockp);
						/* Make previous point at this one */
	end;

	tty_buf.bleft = tty_buf.bleft + n;
	if tty_buf.space_needed
	then					/* Somebody needs space */
	     if tty_buf.bleft >= abs_buf_limit
	     then call interrupt_waiting_procs;
	return;

     end space_freer;

/* Initialize by doing required masking and locking */

setup:
     proc;

	ttybp = addr (tty_buf$);
	lctp = tty_buf.lct_ptr;
	call pmut$wire_and_mask (wire_mask, wire_ptr);
	enter_time = clock ();
	call lock;
	total_freed = 0;
	return;

     end setup;

/* Procedures that manage the tty_buffer lock word */

lock:
     proc;

dcl  start_time fixed bin (71);

	if tty_buf.slock = pds$processid
	then call err (1);				/* Already locked to this process */
	if ^stac (addr (tty_buf.slock), pds$processid)
	then do;					/* Didn't lock at first attempt */
	     start_time = clock ();			/* Record time we started to loop */
	     tty_buf.space_lock_wait_count = tty_buf.space_lock_wait_count + 1;
	     do while (^stac (addr (tty_buf.slock), pds$processid));
	     end;
	     tty_buf.space_lock_wait_time = tty_buf.space_lock_wait_time + clock () - start_time;
	end;
	tty_buf.space_lock_count = tty_buf.space_lock_count + 1;
	return;

unlock:
     entry;

	if ^stacq (tty_buf.slock, "0"b, pds$processid)
	then call err (2);
	return;

     end lock;

/* Unwire and unlock and unmask as required */

clean_up:
     proc;

	call unlock;
	call pmut$unwire_unmask (wire_mask, wire_ptr);
	return;

     end clean_up;

/* Procedure to update a channels space usage counts */

update_lcte:
     proc (n);

dcl  n fixed bin;					/* The increment (+ or -) */
dcl  pc_devx fixed bin;

	if devx < 1 | devx > lct.max_no_lctes
	then return;
	lctep = addr (lct.lcte_array (devx));
	pc_devx = lcte.physical_channel_devx;
	lctep = addr (lct.lcte_array (pc_devx));
	if output_flag
	then do;
	     lcte.output_words = lcte.output_words + n;
	     tty_buf.current_output_space = tty_buf.current_output_space + n;
	     tty_buf.cumulative_output_space = tty_buf.cumulative_output_space + tty_buf.current_output_space;
	     tty_buf.output_space_updates = tty_buf.output_space_updates + 1;
	end;

	else do;
	     lcte.input_words = lcte.input_words + n;
	     tty_buf.current_input_space = tty_buf.current_input_space + n;
	     tty_buf.cumulative_input_space = tty_buf.cumulative_input_space + tty_buf.current_input_space;
	     tty_buf.input_space_updates = tty_buf.input_space_updates + 1;
	end;
	return;

     end update_lcte;


/* Procedure to update control space usage counts (for metering) */

update_control:
     proc (n);

dcl  n fixed bin;					/* The increment (+ or -) */

	tty_buf.current_control_space = tty_buf.current_control_space + n;
	tty_buf.cumulative_control_space = tty_buf.cumulative_control_space + tty_buf.current_control_space;
	tty_buf.control_space_updates = tty_buf.control_space_updates + 1;
     end update_control;

/* Send an interrupt to all processes who are waiting for space to become free */

interrupt_waiting_procs:
     proc;

dcl  i fixed bin;

	do i = 1 to lct.max_no_lctes;
	     lctep = addr (lct.lcte_array (i));
	     if lcte.initialized
	     then					/* this is a live lcte */
		if lcte.space_needed
		then do;
		     lcte.space_needed = "0"b;
		     call unlock;
		     call channel_manager$interrupt (i, SPACE_AVAILABLE, ""b);
		     call lock;
		end;
	end;

	do i = 1 to lct.max_no_lctes;			/* Be sure no bits were set during our unlocks */
	     lctep = addr (lct.lcte_array (i));
	     if lcte.initialized
	     then if lcte.space_needed
		then return;			/* Leave global flag set */
	end;

	tty_buf.space_needed = "0"b;			/* All bits are truly off */
	return;

     end interrupt_waiting_procs;



/* Crash the system on error in tty_buf */

err:
     proc (n);

dcl  n fixed bin;

call_syserr:
	call syserr (1,
	     "tty_space_man: ^[Lock already locked to process^;Lock not locked to process^;Adress not in buffer pool^;Tried to free space already free^]."
	     , n);
	go to call_syserr;

     end err;

%include tty_buf;

%include tty_buffer_block;

%include lct;

%include channel_manager_dcls;

%include mcs_interrupt_info;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   tty_space_man: Lock already locked to process.

   S:	$crash

   T:	$run

   M:	A process that had the global tty_buf lock locked attempted to lock
   it again.

   A:	$inform


   Message:
   tty_space_man: Lock not locked to process.

   S:	$crash

   T:	$run

   M:	A process attempted to unlock the global tty_buf lock when that process
   did not have it locked.

   A:	$inform


   Message:
   tty_space_man: Address not in buffer pool.

   S:	$crash

   T:	$run

   M:	An attempt was made to free space at an address not included in the free
   space pool of tty_buf.

   A:	$inform


   Message:
   tty_space_man: Tried to free space already free.

   S:	$crash

   T:	$run

   M:	An attempt was made to free space in tty_buf that was included in or
   overlapped space that was already free.

   A:	$inform

   END MESSAGE DOCUMENTATION */

     end tty_space_man;






		    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
