



		    uncp.pl1                        11/11/89  1109.4r w 11/11/89  0827.2      609102



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



/****^  HISTORY COMMENTS:
  1) change(88-06-09,Berno), approve(88-07-13,MCR7928),
     audit(88-06-09,Parisek), install(88-07-19,MR12.2-1061):
     Initially extracted from dn355.pl1, this module implements the
     Multics DSA UNCP multiplexer interface.
  2) change(89-04-03,Farley), approve(89-04-24,MECR0010),
     audit(89-04-04,Parisek), install(89-04-24,MR12.3-1031):
     Modified sub-mailbox management to allow holding of information in local
     storage after sub-mbx is freed during interrupt processing and to
     centeralize the assignment of the sub-mbxes.  Changed return_mbx/send_mbx
     subroutine to re-assign sub-mbx and copy local storage into sub-mbx when
     required.
  3) change(89-06-01,Farley), approve(89-06-01,MCR8109),
     audit(89-06-02,Parisek), install(89-06-01,MR12.3-1052):
     Offical installation of above changes..
                                                   END HISTORY COMMENTS */

/* format: style4,insnl,delnl,^ifthendo */
uncp:
     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


   THE FOLLOWING HISTORY COMMENTS APPLY TO THE FRENCH VERSION OF dn355.pl1
   (uncp.pl1).

   Adapted in January 1982 after version MR8.0 for the Datanet 7100
   Installed at level MR9.1 in July 1982.
   Correction of out_of_bounds after an ineffectgive read (J. Barre)
   Open a connection with 2 terminals to fully test
   Installed at level MR10.1 in June 1983
   Installed at level MR11.0 in August 1983
   * Padding (3) assigned fields missing in dn355_data.incl.pl1.
   Installed at level MR12.0 in January 1987

   Date of the last modification: 06/01/1987
*/

/*	TRACE TO DEBUG		*/

dcl  1 trace int static options (constant),
       2 load bit (1) unal init ("1"b),
       2 mailbox bit (1) unal init ("0"b),
       2 buffer_in bit (1) unal init ("0"b),
       2 buffer_out bit (1) unal init ("0"b);

dcl  max_special_name fixed bin int static options (constant) init (12);
dcl  special_name (12) bit (36) int static options (constant) init ("444665252362"b3,
						/* "MOVECS" bcd */
	"444665250000"b3,				/* "MOVE00" bcd */
	"444665250101"b3,				/* "MOVE11" bcd */
	"534521623145"b3,				/* "$NASIN" bcd */
	"534521624646"b3,				/* "$NASOO" bcd */
	"446443633145"b3,				/* "MULTIN" bcd */
	"446443634646"b3,				/* "MULTOO" bcd */
	"534346272020"b3,				/* "$LOG  " bcd */
	"434621242020"b3,				/* "LOAD  " bcd */
	"512226202020"b3,				/* "RBF   " bcd */
	"512226203145"b3,				/* "RBF IN" bcd */
	"512226204646"b3);				/* "RBF OO" bcd */

dcl  dial_name (12) char (8) int static options (constant) init ("d FTF  
", "d FTF  
", "d FTF  
", "d NASF 
", "d NASF 
", "Multics", "Multics", "d LOG  
", "d LOAD 
", "d RBF  
", "rbfdsa", "rbfdsa");

dcl  qorig fixed bin (24),
     da fixed bin (24);

dcl  sub_mbx_sent bit (1);				/* flag to indicate actual sub_mbx usage */
dcl  sub_mbx_no fixed bin;				/* sub mailbox index */
dcl  sub_mbx_array (8) bit (36) aligned based (subp);	/* bit overlay on mbx's */
dcl  1 local_sub_mbx aligned like sub_mbx;		/* local copy of sub_mbx */

dcl  (bufp, charp, qptr, other_pcbp) 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) 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 */
     nblocks fixed bin;				/* number of blocks allocated */

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 dn7100$interrupt */
dcl  input_count fixed bin;				/* count sent with accept_dir_input */
dcl  inchain bit (18);				/* pointer to head of newly-allocated input chain */

dcl  chan_lctep ptr;				/* pointer to subchannel's LCTE */
dcl  inchain_ptr ptr;				/* pointer to new input chain */
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  syserr_severity fixed bin (35);

dcl  SYSERR_announce fixed bin int static options (constant) init (0);
dcl  SYSERR_crash fixed bin int static options (constant) init (1);
dcl  SYSERR_beep fixed bin int static options (constant) init (3);
dcl  SYSERR_log fixed bin int static options (constant) init (4);
						/* These syserr constants are used in place of the
						   constants defined in syserr_constants.incl.pl1
						   because of the use of the "CRASH" constant
						   declared in mcs_interrupt_info.incl.pl1 which
						   is also declared as a constant in syserr_constants.incl.pl1. */

dcl  LOOP_LIMIT fixed bin int static options (constant) init (100000);
						/* used to wait for DIA to clear PCW */
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  INT_LEVEL_1 fixed bin int static options (constant) init (1);
dcl  INT_LEVEL_3 fixed bin int static options (constant) init (3);
dcl  INT_LEVEL_7 fixed bin int static options (constant) init (7);

dcl  BAUD_9600 fixed bin int static options (constant) init (9600);

dcl  MAX_FREE_BUFFERS fixed bin (35) int static options (constant) init (16000000000);

dcl  BPC_10 fixed bin int static options (constant) init (10);
dcl  BPC_8 fixed bin int static options (constant) init (8);/* bits per character */

dcl  MAX_CHANNEL_BUFFER fixed bin int static options (constant) init (128);

dcl  CMD_DATA_LEN_3 fixed bin int static options (constant) init (3);
						/* length of command_data in 6 bit chars */

dcl  MAX_MBX_REQ_CNT fixed bin (35) int static options (constant) init (262143);

dcl  EIGHT fixed bin int static options (constant) init (8);

dcl  CONNECTION_TYPE_1 bit (12) int static options (constant) init ("3145"b3);
dcl  CONNECTION_TYPE_2 bit (12) int static options (constant) init ("4646"b3);

dcl  timwb (0:6) bit (1) based (addr (timw)),		/* timw as a bit array */
     used_string bit (7) based (addr (datanet_mbx.mbx_used_flags.used (0)));
						/* mailbox used flags as a bit string */
						/* The 8th sub-mbx is not used */

dcl  (addr, substr, stac, stacq, string, ptr, rel, index, fixed, divide, bin, max, min, null, length, bit, unspec, hbound,
     lbound, size, verify) 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  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)),
     (
     uncp_boot_interrupt,
     uncp_boot_interrupt$system_fault
     ) entry (fixed bin),
     uncp_boot_interrupt$request_init 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 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 wrap_q_address aligned based (addr (sub_mbx.command_data (3))),
						/* overlay for rtx on wrapped queue */
       2 wrap_ptr bit (18) unal,
       2 wrap_cnt fixed bin (18) unsigned unal;

dcl  fault_name char (16);				/* 355 fault name */


dcl  cleanup condition;

%include tty_buf;

%include uncp_buf;

%include tty_buffer_block;

%include lct;
%include pcb;
%include dn355_data;

dcl  1 gateway_buf aligned based (blockp),
       2 cnt fixed bin (18) unsigned unaligned,
       2 pad bit (18) unaligned;

dcl  gateway_header bit (36) based (blockp);

dcl  buf_words (256) fixed bin based;

%include dn355_mailbox;

dcl  connect_to_slave_nowait init (76) fixed bin (8) init static options (constant);

%include mailbox_ops;

%include mcs_interrupt_info;

%include dn355_messages;

%include fnp_queue_entry;
%include channel_manager_dcls;
%include tty_space_man_dcls;

%include line_types;
%include baud_rates;

%include net_event_message;
%page;
%include fnp_mpx_msg_;
%include io_manager_dcls;
%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 ^= INT_LEVEL_3 | ^fnp_info.running
	     then syserr_severity = SYSERR_announce;
	     else syserr_severity = SYSERR_log;
	     call syserr (syserr_severity,
		"uncp: 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 ^= INT_LEVEL_3 & level ^= INT_LEVEL_7
	then do;					/* if not a good interrupt level */
	     call syserr (SYSERR_beep, "uncp: FNP ^a invalid interrupt level ^o", fnp_name, level);
	     if fnp_info.bootloading
	     then if level = INT_LEVEL_1		/* system fault */
		then call uncp_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 = INT_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 (SYSERR_crash, "uncp: 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 (*),					/* allow use of 6 words in sub_mbx */
     chrsa fixed bin (8);				/* numeric */

dcl  tdata bit (8 * 36);
dcl  data_len fixed bin (8);

	pcbp = a_pcbp;
	go to send_join;

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

	pcbp = null ();
	fnpp = a_fnpp;
	if opa = dial
	then do;
	     do ix = 1 to max_special_name while (special_name (ix) ^= substr (data, 1, 36));
	     end;
	     if ix <= max_special_name
	     then fnp_info.active_bit (ix) = substr (data, 37, 1);
	     return;
	end;

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 */
	uncpbp = datanet_info.uncp_bufp;		/* get ptr to uncp buf */
	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 */
	     (^fnp_info.bootloading | operation ^= init_complete)
	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;

	if pcbp ^= null
	then if operation = disconnect_this_line
	     then if pcb.dialed = "0"b
		then return;

	if operation = accept_direct_output
	then if pcb.dumpout
	     then do;
		call throw_away_output;
		pcb.dumpout = "0"b;
	     end;

	if operation = enter_receive
	then do;
	     if pcb.connection_type = "10"b
	     then return;

	     ix = pcb.baud_rate;
	     if ix ^= BAUD_9600
	     then do;
		pcb.turn = "1"b;
		call send_dial;
		return;
	     end;

	     if pcb.write_last ^= 0
	     then do;
		blockp = ptr (ttybp, pcb.write_last);
		buffer.turn = "1"b;
		return;
	     end;
	     else do;
		pcb.enter_receive_pending = "1"b;
		if pcb.end_frame | ^pcb.send_output
		then return;
		else operation = accept_direct_output;
	     end;

	end;

	call assign_sub_mbx (sub_mbx_no, subp);		/* find a free sub mbx */
	if sub_mbx_no = -1				/* 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 */
	     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 (sub_mbx_no, "0"b);
	     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 (sub_mbx_no);		/* ship the mbx off to the 355 */
		fnp_info.output_control_transactions = fnp_info.output_control_transactions + 1;
	     end;

	     if ^sub_mbx_sent
	     then call release_sub_mbx (sub_mbx_no);

	     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 0f 355 info segment  */
	uncpbp = datanet_info.uncp_bufp;		/*   initialise l adresse du segment uncp_buf   */

	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;
	n_pcbs = fnp_info.no_of_channels;		/* set number of channel control blocks to number of channels */

	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 (SYSERR_crash, "uncp: 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 (SYSERR_crash, "uncp: LCTE lock ^^= processid");

	if ^stacq (fnp_info.queue_lock, "0"b, pds$processid)
	then call syserr (SYSERR_crash, "uncp: 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 = INT_LEVEL_3;
		return ("1"b);
	     end;

	     else if fnp_info.level_7_pending
	     then do;
		fnp_info.level_7_pending = "0"b;
		a_level = INT_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 = INT_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;

	     fault_name = "STOPPING DATANET";
	     call syserr (SYSERR_beep, "uncp: emergency interrupt from FNP ^a: ^a", fnp_info.fnp_tag, fault_name);
	     timw = ldac (addr (datanet_mbx.term_inpt_mpx_wd));
	     if fnp_info.running
	     then call purge_write_texte;


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

	if unspec (datanet_mbx.mailbox_requests) = "777777000000"b3
	then do;					/* DSA requesting init */
	     datanet_mbx.mailbox_requests = datanet_mbx.mailbox_requests + 1;

	     if trace.load
	     then call syserr (SYSERR_log, "uncp: request_init");

	     timw = ldac (addr (datanet_mbx.term_inpt_mpx_wd));
	     if fnp_info.running
	     then call purge_write_texte;
	     call uncp_boot_interrupt$request_init (dno);
	     fnp_info.uncp_pcbx1, fnp_info.uncp_pcbx2 = 0;
	     return;
	end;

	if fnp_info.bootloading			/* if this is bootload status */
	then do;
	     timw = ldac (addr (datanet_mbx.term_inpt_mpx_wd));
	     if timwb (0)
	     then do;				/* 1st mailbox for WCD_init_complete */
		subp = addr (datanet_mbx.dn355_sub_mbxes (0));
		datanet_mbx.mbx_used_flags.used (0) = "0"b;
						/* free the mailbox */
		datanet_mbx.num_in_use = datanet_mbx.num_in_use - 1;
		if (sub_mbx.io_cmd = wcd) & (sub_mbx.op_code = init_complete)
		then do;

		     if trace.load
		     then call syserr (SYSERR_log, "uncp: WCD init_complete acknowledgement");

		     call uncp_boot_interrupt (dno);	/* let special routine figure it out */
		     fnp_info.uncp_pcbx1, fnp_info.uncp_pcbx2 = 0;
		end;
	     end;
	     return;				/* Don't analyze the mailbox */
	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 used_string ^= (7)"1"b
	then call spend_submailboxes;			/* if some free mailboxes */

/* process any submailboxes which have been returned by the 355 */

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


/* mailbox number 0 & number  15 are reserved to init and abort */

	do i = lbound (timwb, 1) to hbound (timwb, 1);	/* loop over submailbox indicators */

	     if timwb (i) & ^no_response
	     then do;				/* if mailbox was returned by 355 then we have something to do */
		sub_mbx_no = i;
		unspec (local_sub_mbx) = unspec (datanet_mbx.dn355_sub_mbxes (sub_mbx_no));
		subp = addr (local_sub_mbx);
		if trace.mailbox
		then call syserr (SYSERR_log, "uncp: mbx received # ^o ^2( ^/ ^4( ^w ^) ^)", sub_mbx_no,
			sub_mbx_array);
		datanet_mbx.mbx_used_flags.used (sub_mbx_no) = "0"b;
						/* clear submailbox used flag */
		sub_mbx_no = -1;			/* indicate use of local copy */

		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;


		call get_line_number;

/* WRITE COMMAND DATA		*/

		if sub_mbx.io_cmd = wcd
		then do;
		     if (devx ^= -1) & (sub_mbx.op_code = disconnect_this_line)
		     then do;
			if pcb.dialed
			then do;
			     call throw_away_output;
			     if pcb.connection_type ^= "01"b
			     then call channel_manager$interrupt (devx, HANGUP, ""b);
disconnect_other_line:
			     if (pcb.connection_type ^= "00"b) & (pcb.uncp_pcbx ^= 0)
			     then do;
				other_pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (pcb.uncp_pcbx));
				if other_pcbp -> pcb.dialed
				then do;
				     string (sub_mbx.line_number) = string (other_pcbp -> pcb.line_number);
				     call return_mbx (sub_mbx_no);
				end;
			     end;
			end;
			pcb.dialed = "0"b;
			pcb.baud_rate = 0;
		     end;

		     if (devx ^= -1) & (sub_mbx.op_code = disconnect_accepted)
		     then do;
			sub_mbx.op_code = disconnect_this_line;
			goto disconnect_other_line;
		     end;


		end;				/* just free submbx */

		else do;

/*        WRITE TEXTE			*/

		     if sub_mbx.io_cmd = wtx
		     then do;			/* check for write text */
			pcb.output_mbx_pending = "0"b;
			if pcb.connection_type = "10"b
			then pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (pcb.uncp_pcbx));
			if sub_mbx.command_data (3) ^= "0"b
			then do;
			     da = bin (sub_mbx.data_addr, 18) - tty_buf.absorig;
						/* get offset in tty buf   */
			     blockp = ptr (ttybp, da);/* set ptr to buffer */
			     gateway_header = sub_mbx.command_data (3);


			     call tty_space_man$free_chain ((pcb.devx), OUTPUT, blockp);
						/* and the output chain */



			end;
		     end;

/*        READ CONTROL DATA		*/

		     else 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)
			then do;


			     fnp_info.bleft_355 = 0;	/* make it safe */

			     if fnp_info.free_size > MAX_FREE_BUFFERS
			     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
			then fnp_info.input_data_transactions = fnp_info.input_data_transactions + 1;
			else fnp_info.input_control_transactions = fnp_info.input_control_transactions + 1;



/*	ACCEPT NEW TERMINAL		*/

			if sub_mbx.op_code = accept_new_terminal
			then do;			/* check for new terminal on line */
			     if devx = -1
			     then do;
				sub_mbx.io_cmd = wcd;
				sub_mbx.op_code = terminal_rejected;
				sub_mbx.cmd_data_len = 0;
				call return_mbx (sub_mbx_no);
			     end;
			     else do;


				pcb.line_type = LINE_ASCII;
				pcb.send_lf = "0"b;



				pcb.baud_rate = BAUD_9600;
						/* highest speed for UNCP */

				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 = BPC_10;
				else bits_per_char = BPC_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 = MAX_CHANNEL_BUFFER;
						/* COLTS channel always gets big buffers */
				pcb.dialed, pcb.enter_receive_pending, pcb.turn, pcb.dumpout, pcb.send_output =
				     "0"b;
				pcb.connection_type = "00"b;

				sub_mbx.op_code = terminal_accepted;
						/* inform 355 that term is ok */
				sub_mbx.cmd_data_len = 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 (sub_mbx_no);
			     end;
			end;

/*	DISCONNECTED LINE		*/

			else if sub_mbx.op_code = disconnected_line
			then do;			/* see if line just hung up */
			     if pcb.dialed
			     then do;
				call throw_away_output;
				if pcb.connection_type ^= "01"b
				then call channel_manager$interrupt (devx, HANGUP, ""b);
			     end;
			     pcb.dialed = "0"b;
			     sub_mbx.io_cmd = wcd;
			     sub_mbx.op_code = disconnect_accepted;
			     call return_mbx (sub_mbx_no);
			end;

/*	BREAK CONDITION		*/

			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);
				pcb.turn = "1"b;
			     end;
			     sub_mbx.io_cmd = wcd;
			     sub_mbx.op_code = break_acknowledged;
			     sub_mbx.cmd_data_len = 0;
			     call return_mbx (sub_mbx_no);
			     call make_q_entry (accept_direct_output, 0, ""b);
						/* BREAK sends the turn */
			end;

/*	SEND OUTPUT		*/

			else if sub_mbx.op_code = send_output
			then do;			/* is this request for output? */
			     if pcb.dialed
			     then do;
				if pcb.connection_type = "10"b
				then pcb.turn = "1"b;
				call process_send_output (sub_mbx_no, "1"b);
			     end;

			end;

/*	ACCEPT DIRECT INPUT		*/

			else if sub_mbx.op_code = accept_direct_input
			then do;			/* check for input from terminal */
			     if pcb.dialed
			     then call process_accept_input;
			end;


/*	CONNECT TO SLAVE		*/
/*	CONNECT TO SLAVE WITH NO WAIT	*/
			else if (sub_mbx.op_code = connect_to_slave) | (sub_mbx.op_code = connect_to_slave_nowait)
			then do;
			     pcb.extra_nl, pcb.lfecho = "0"b;
			     do ix = 1 to max_special_name while (special_name (ix) ^= sub_mbx.command_data (1));
			     end;
			     if ix <= max_special_name
			     then do;
				if (dial_name (ix) = "Multics") | (dial_name (ix) = "rbfdsa")
				then fnp_info.active_bit (ix) = "1"b;

				if ^fnp_info.active_bit (ix)
				then do;
				     sub_mbx.io_cmd = wcd;
				     sub_mbx.op_code = disconnect_this_line;
				     call return_mbx (sub_mbx_no);
				     goto no_dialup;
				end;
			     end;

			     if ix > max_special_name
			     then do;
				ix = BAUD_9600;
				pcb.turn, pcb.extra_nl, pcb.lfecho = "1"b;
			     end;
			     else do;
				pcb.baud_rate = ix;
				if index (special_name (ix), CONNECTION_TYPE_1) ^= 0
				then pcb.connection_type = "01"b;
				if index (special_name (ix), CONNECTION_TYPE_2) ^= 0
				then pcb.connection_type = "10"b;
			     end;

			     pcb.dialed = "1"b;

			     if pcb.connection_type = "01"b
			     then do;
				pcb.uncp_pcbx = 0;
				if fnp_info.uncp_pcbx1 = 0
				then do;
				     fnp_info.uncp_pcbx1 = j;
				     sub_mbx.op_code = enter_receive;
				     call return_mbx (sub_mbx_no);
				end;
				else if fnp_info.uncp_pcbx2 = 0
				then fnp_info.uncp_pcbx2 = j;
				goto no_dialup;
			     end;

			     if pcb.connection_type = "10"b
			     then do;
				if fnp_info.uncp_pcbx1 = 0
				then do;
				     call syserr (SYSERR_announce,
					"uncp: Connection on output only not awaited. (dial '^a')",
					dial_name (ix));
				     goto no_dialup;
				end;
				else do;
				     other_pcbp =
					addr (fnp_info.pcb_array_ptr -> pcb_array (fnp_info.uncp_pcbx1));
				     other_pcbp -> pcb.uncp_pcbx = j;
				     pcb.uncp_pcbx = fnp_info.uncp_pcbx1;
				     pcb.turn = "1"b;
				     if dial_name (ix) = "Multics"
				     then other_pcbp -> pcb.extra_nl = "1"b;

				     if (dial_name (ix) = "Multics") | (dial_name (ix) = "rbfdsa")
				     then other_pcbp -> pcb.baud_rate, pcb.baud_rate = BAUD_9600;


				     fnp_info.uncp_pcbx1 = 0;
				     if fnp_info.uncp_pcbx2 ^= 0
				     then do;
					other_pcbp =
					     addr (fnp_info.pcb_array_ptr -> pcb_array (fnp_info.uncp_pcbx2));
					fnp_info.uncp_pcbx1 = fnp_info.uncp_pcbx2;
					fnp_info.uncp_pcbx2 = 0;
					string (sub_mbx.line_number) = string (other_pcbp -> pcb.line_number);
					sub_mbx.op_code = enter_receive;
					call return_mbx (sub_mbx_no);
					j = fnp_info.hsla_idx (0);
					do j = j to fnp_info.no_of_channels while (fnp_info.uncp_pcbx2 = 0);
					     other_pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (j));
					     if other_pcbp -> pcb.dialed
						& (other_pcbp -> pcb.connection_type = "01"b)
						& (other_pcbp -> pcb.uncp_pcbx = 0)
					     then if (fnp_info.uncp_pcbx1 ^= j)
						then fnp_info.uncp_pcbx2 = j;
					end;
				     end;
				end;
			     end;

			     dialup_info.line_type = LINE_ASCII;
			     dialup_info.receive_mode_device = "0"b;
			     if pcb.connection_type = "00"b
			     then dialup_info.receive_mode_device = "1"b;
			     dialup_info.baud_rate = ix;
			     dialup_info.max_buf_size = pcb.max_buf_size;
			     dialup_info.buffer_pad = 0;
			     dialup_info.pad = "0"b;
			     interrupt_info = unspec (dialup_info);
			     call channel_manager$interrupt (devx, DIALUP, interrupt_info);
			     call process_send_output (sub_mbx_no, "1"b);
no_dialup:
			end;

			else if devx ^= -1
			then call syserr (SYSERR_announce,
				"uncp: unrecognized op code ^o with rcd from FNP ^a for devx ^o", sub_mbx.op_code,
				substr ("abcdefgh", dno, 1), devx);
						/* someone goofed */

		     end;

/*        READ TEXTE			*/

		     else if sub_mbx.io_cmd = rtx
		     then do;
			call process_rtx;		/* check for read text */
			if pcb.connection_type = "01"b
			then do;
			     sub_mbx.op_code = enter_receive;
			     call return_mbx (sub_mbx_no);
			end;
		     end;
		     else call syserr (SYSERR_beep, "uncp: unrecognized io command ^o from FNP ^a for line ^o",
			     sub_mbx.io_cmd, substr ("abcdefgh", dno, 1), bin (string (sub_mbx.line_number), 10));
						/* complain */
		end;


	     end;
	end;

/* use spend_submailboxes    */


	if ^no_response & used_string ^= (7)"1"b
	then					/* see if we freed some submailboxes */
	     call spend_submailboxes;




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

/* Supprimer le label exit avec deverrouillage de lcte.lock   */

	return;					/* return to iom_manager */
     end /* process_int  */;

/* An internal procedure to perform interrupt-time tasks that consume submailboxes.
   First check for queued up work. Then attend to FNP mailbox requests. */

spend_submailboxes:
     proc;

	if fnp_info.count ^= 0
	then call process_q;			/* were we waiting for a free mbx */


	do while (datanet_mbx.mailbox_requests ^= datanet_mbx.last_mbx_req_count);
						/* try to service mailbox requests */
	     call assign_sub_mbx (sub_mbx_no, subp);	/* find a free sub mbx */
	     if sub_mbx_no = -1
	     then return;				/* none available, will try again at next interrupt. */
	     sub_mbx.io_cmd = rcd;			/* set rcd in sub mailbox. */
	     call send_mbx (sub_mbx_no);		/* now ship submailbox off uncp. */
	     datanet_mbx.last_mbx_req_count = datanet_mbx.last_mbx_req_count + 1;
	     if datanet_mbx.last_mbx_req_count > MAX_MBX_REQ_CNT
	     then datanet_mbx.last_mbx_req_count = 0;
	     if ^sub_mbx_sent
	     then call release_sub_mbx (sub_mbx_no);
	end;
     end /* spend_submailboxes */;

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;
	sub_mbx_no = 0;				/* preset mbx# for do while */

	do while (q_count > 0 & sub_mbx_no >= 0);
	     call assign_sub_mbx (sub_mbx_no, subp);	/* find a free sub mbx */
	     if sub_mbx_no >= 0			/* now we can have one */
	     then do;
		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 (sub_mbx_no, "0"b);
		     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 (sub_mbx_no);
		     fnp_info.output_control_transactions = fnp_info.output_control_transactions + 1;
		end;

		if no_response			/* give up in this case */
		then goto 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);
		if ^sub_mbx_sent
		then call release_sub_mbx (sub_mbx_no);
	     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 */;

send_dial:
     proc;
	pcb.send_output = "1"b;
	devx = pcb.devx;

	if pcb.write_last ^= 0
	then do;
	     blockp = ptr (ttybp, pcb.write_last);
	     if buffer.turn
	     then pcb.turn = "1"b;
	     call throw_away_output;
	end;

	if pcb.turn = "1"b
	then do;
	     call tty_space_man$get_chain (devx, 16, 1, INPUT, inchain_ptr);
	     if inchain_ptr = null
	     then do;
		call syserr (SYSERR_announce, "uncp: special_dial, Failure of buffer to make '^a'", dial_name (ix));
		call channel_manager$interrupt (devx, QUIT, ""b);
		return;
	     end;
	     inchain = rel (inchain_ptr);
	     blockp = inchain_ptr;
	     numchars = EIGHT;
	     bufp = addr (dial_name (ix));
	     charp = addr (buffer.chars);
	     charp -> chars = bufp -> chars;
	     buffer.tally = numchars;
	     rtx_info.break_char = "1"b;
	     rtx_info.output_in_fnp = "0"b;
	     rtx_info.output_in_ring_0 = "0"b;
	     rtx_info.input_count = EIGHT;
	     rtx_info.chain_head = inchain;
	     rtx_info.chain_tail = rel (blockp);
	     interrupt_info = unspec (rtx_info);
	     call channel_manager$interrupt (devx, ACCEPT_INPUT, interrupt_info);
	     pcb.baud_rate = BAUD_9600;
	     pcb.dumpout = "1"b;
	end;
	call channel_manager$interrupt (devx, SEND_OUTPUT, ""b);
	return;

     end send_dial;

/* 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 */
	then do;
	     pcb.flags.send_output = "1"b;		/* we'll want output eventually */
	     if pcb.turn = "1"b
	     then call channel_manager$interrupt (devx, SEND_OUTPUT, ""b);
						/* For the Quit problem */
	     return;				/* don't do anything else */
	end;

	if pcb.enter_receive_pending | pcb.send_lf
	then do;
	     sub_mbx.op_code = enter_receive;
	     call send_mbx (mbx_num);
	     return;
	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;
	     ix = pcb.baud_rate;
	     if ix ^= BAUD_9600
	     then do;
		call send_dial;
		return;
	     end;

	     if pcb.turn = "0"b
	     then return;				/* Don't emit without the turn ON */

	     if mbx_num = -1			/* caller didn't supply one */
	     then do;
		call assign_sub_mbx (mbx_num, subp);	/* find a free sub mbx */
		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;
		     string (sub_mbx.line_number) = string (pcb.line_number);
		end;
	     end;


	     pcb.flags.send_output = "0"b;		/* make sure flag clear */


/*						no DCW with UNCP  */

	     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 (SYSERR_crash, "uncp: output buffer at ^o has zero tally", pcb.write_first);

/*						no DCW with UNCP    */


	     pcb.write_first = buffer.next;		/* now bump to next buffer */
	     pcb.write_cnt = pcb.write_cnt - buffer.tally;/* decrement count of chars in chain */


	     if buffer.flags.end_of_page		/* if this buffer fills a page/screen */
	     then pcb.flags.end_frame = "1"b;		/* remember it */


	     if pcb.write_first ^= 0
	     then buffer.flags.turn = "0"b;		/* Give up turn if terminating  */


	     sub_mbx.op_code = accept_direct_output;
	     if buffer.flags.turn
	     then pcb.flags.end_frame = "0"b;
	     if buffer.flags.turn | buffer.flags.end_of_page
	     then do;
		sub_mbx.op_code = accept_last_output;
		pcb.turn = "0"b;
	     end;

	     sub_mbx.command_data (1) = "0"b;		/* make sure it starts clean */
	     sub_mbx.data_addr = bit (bin (bin (rel (blockp), 18) + tty_buf.absorig, 18), 18);
	     j = bin (buffer.tally, 18);
	     sub_mbx.word_cnt = 1 + divide (j + 3, 4, 18, 0);
	     buffer.next = 0;			/* indicate end of active write block */
	     sub_mbx.command_data (3) = gateway_header;	/* save buffer header in command_data (3) */
	     gateway_buf.cnt = j;
	     gateway_buf.pad = "0"b;
	     sub_mbx.io_cmd = wtx;			/* set write text io command */

	     if trace.buffer_out
	     then call syserr (SYSERR_log, "uncp: buffer = ^v( ^w ^) ", sub_mbx.word_cnt, blockp -> buf_words);

	     if pcb.connection_type = "01"b & sub_mbx.op_code = accept_direct_output
	     then string (sub_mbx.line_number) =
		     string (addr (fnp_info.pcb_array_ptr -> pcb_array (pcb.uncp_pcbx)) -> pcb.line_number);
	     pcb.output_mbx_pending = "1"b;
	     call send_mbx (mbx_num);			/* ship sub mbx off to 355 */
	     fnp_info.output_data_transactions = fnp_info.output_data_transactions + 1;
						/* meter */
	     if 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;
	end;

	return;					/* and return to caller */
     end;

/* internal procedure to respond to accept_input mailbox */

process_accept_input:
     proc;

	input_count = fixed (substr (sub_mbx.command_data (1), 1, 18), 18) + 4;
						/* get char count */

	j = divide (input_count + 3, 4, 17, 0);		/* compute number of words of circular buffer needed */

	do while (^stac (addr (uncp_buf.cq_lock), pds$processid));
						/* lock the circular queue lock */
	end;

	k = uncp_buf.cq_max_size - uncp_buf.cq_next;
	if j <= uncp_buf.cq_free			/* if there's space in the queue */
	then if enough_input_space (j)		/* and buffers to spare */
	     then do;
		if j > k
		then if j <= uncp_buf.cq_free - k
		     then uncp_buf.cq_next = 0;
		     else go to reject;

		qorig = tty_buf.absorig + fixed (rel (addr (uncp_buf.circular_queue (0))));
						/* get abs origin of circular buffer */

		uncp_buf.cq_free = uncp_buf.cq_free - j;/* decrement count of free wds in circ buf */

		if uncp_buf.circular_queue_size > MAX_FREE_BUFFERS
		then do;				/* getting too big */
		     uncp_buf.circular_queue_size = 0;	/* reset */
		     uncp_buf.queue_ave_cnt = 0;
		end;
		uncp_buf.circular_queue_size = uncp_buf.circular_queue_size +
						/* update the ave size */
		     (uncp_buf.cq_max_size - uncp_buf.cq_free);
						/* with current size */
		uncp_buf.queue_ave_cnt = uncp_buf.queue_ave_cnt + 1;
						/* bump q count */

		uncp_buf.circular_queue (uncp_buf.cq_next) = 0;
		sub_mbx.data_addr = bit (bin (qorig + uncp_buf.cq_next, 18), 18);
						/* leave abs buffer addr for 355 */
		uncp_buf.cq_next = uncp_buf.cq_next + j;/* compute new cb free area offset */

		wrap_ptr = "0"b;			/* clear wrap around ptr in sub mbx */
		wrap_cnt = 0;			/* and count in sub mbx */

		if uncp_buf.cq_next > uncp_buf.cq_max_size
		then do;				/* we have wrap around */
		     wrap_ptr = bit (bin (qorig, 18), 18);
						/* leave wrap around pointer in sub mbx */
		     uncp_buf.cq_next = uncp_buf.cq_next - uncp_buf.cq_max_size;
						/* adjust free buffer offset */
		     wrap_cnt = input_count - 4 * (j - uncp_buf.cq_next);
						/* leave wrap count in sub mbx */
		     sub_mbx.word_cnt = input_count - wrap_cnt;
						/* and adjust word count */
		end;



		else sub_mbx.word_cnt = j;		/* words count */

		if uncp_buf.cq_next = uncp_buf.cq_max_size
		then uncp_buf.cq_next = 0;		/* exactly end of cb */


		if trace.buffer_in
		then call syserr (SYSERR_log, "uncp$process_accept_input: cq_next = ^w , cq_free = ^w , count = ^w ",
			uncp_buf.cq_next, uncp_buf.cq_free, j);

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

	     else go to reject;

	else do;
	     uncp_buf.queue_full_cnt = uncp_buf.queue_full_cnt + 1;
						/* bump q full count */
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 (sub_mbx_no);
	     fnp_info.input_reject_count = fnp_info.input_reject_count + 1;
	     call channel_manager$interrupt (devx, INPUT_REJECTED, ""b);
	end;

	if ^stacq (uncp_buf.cq_lock, "0"b, pds$processid)
	then call syserr (SYSERR_crash, "uncp: inconsistent circular queue lock.");

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

dcl  (real_word_cnt, real_wrap_cnt) fixed bin;
dcl  chars_to_move fixed bin;
dcl  left_in_buffer fixed bin;
dcl  char_array (0:numchars) char (1) unaligned based;

	sub_mbx.command_data (3) = "0"b;

	bufp = ptr (ttybp, bin (sub_mbx.data_addr, 24) - tty_buf.absorig);
	real_word_cnt = bufp -> unal_number;
	if real_word_cnt = 0
	then goto update_free;

	real_wrap_cnt = wrap_cnt;
	lcte.meters.in_bytes = lcte.meters.in_bytes + real_word_cnt;

	rtx_info.break_char = "1"b;
	call check_ff ("0"b);			/* see if input ends with a form feed */
	input_count = real_word_cnt + real_wrap_cnt;
	if input_count ^= 0				/* must have been a single FF that we discarded */
	then do;

	     rtx_info.output_in_fnp = "0"b;
	     rtx_info.output_in_ring_0 = (pcb.write_first ^= 0);
	     rtx_info.input_count = input_count;
	     if input_count > (tty_buf.bleft - abs_buf_limit) * 4
						/* not now though */
	     then go to no_input_space;

	     nblocks = divide (input_count + bsizec - 1, bsizec, 17, 0);
						/* figure out how many we'll need */
	     call tty_space_man$get_chain (devx, 16, nblocks, INPUT, inchain_ptr);
	     if inchain_ptr = null
	     then do;
no_input_space:
		call syserr (SYSERR_announce,
		     "uncp: Unable to allocate input buffers for line ^o, input has been lost",
		     string (pcb.line_number));
		call channel_manager$interrupt (devx, QUIT, ""b);
						/* get the word to him somehow */
		go to update_free;
	     end;
	     inchain = rel (inchain_ptr);

	     bufp = ptr (ttybp, bin (sub_mbx.data_addr, 24) - tty_buf.absorig + 1);
						/* get ptr to input buf */

	     if trace.buffer_in
	     then call syserr (SYSERR_log, "uncp: compte = ^w , buffer recu :  ^v( ^w ^) ", input_count,
		     divide (input_count + 3, 4, 17, 0), bufp -> buf_words);

	     chars_left = real_word_cnt + real_wrap_cnt;
	     blockp = inchain_ptr;			/* pointer to first buffer */
	     charp = addr (buffer.chars);
	     chars_to_move = real_word_cnt;		/* up to end of circular buffer */
	     left_in_buffer = bsizec;			/* initially */

	     do while (chars_left > 0);
		numchars = min (left_in_buffer, chars_to_move);
		charp -> chars = bufp -> chars;	/* chars is declared char (numchars) */
		chars_left = chars_left - numchars;
		chars_to_move = chars_to_move - numchars;
		buffer.tally = buffer.tally + numchars;

		if chars_left > 0			/* there are more to do */
		then do;
		     if chars_to_move <= 0		/* used up first set */
		     then if real_wrap_cnt > 0	/* are there any more? */
			then do;
			     bufp = addr (uncp_buf.circular_queue (0));
			     chars_to_move = real_wrap_cnt;
			end;
			else ;

		     else bufp = addr (bufp -> char_array (numchars));

		     if buffer.tally = bsizec		/* buffer is full */
		     then do;
			blockp = ptr (ttybp, buffer.next);
						/* so move to next */
			charp = addr (buffer.chars);
			left_in_buffer = bsizec;
		     end;

		     else do;
			charp = addr (charp -> char_array (numchars));
			left_in_buffer = left_in_buffer - numchars;
		     end;
		end;
	     end;

	     rtx_info.chain_head = inchain;
	     rtx_info.chain_tail = rel (blockp);
	     interrupt_info = unspec (rtx_info);
	     call channel_manager$interrupt (devx, ACCEPT_INPUT, interrupt_info);
	     pcb.turn = "1"b;
	     if pcb.lfecho
	     then pcb.send_lf = "1"b;
	end;

/* the following statement must generate an ASQ instruction or there will be a locking problem */


update_free:
	uncp_buf.cq_free = uncp_buf.cq_free + sub_mbx.word_cnt;

	call make_q_entry (accept_direct_output, 0, ""b);

	return;					/* and return to caller */

check_ff:
	proc (in_mbx);				/* internal procedure to check input for form-feed */

dcl  in_mbx bit (1);
dcl  wrapped bit (1);

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



	     if wrap_ptr = "0"b
	     then do;
		bufp = ptr (ttybp, bin (sub_mbx.data_addr, 24) - tty_buf.absorig + 1);
		chars_left = real_word_cnt;
	     end;


	     if pcb.extra_nl
	     then substr (bufp -> input_chars, chars_left, 1) = "
";

	     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) & ^wrapped
		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;
		pcb.turn = "1"b;
		if pcb.enter_receive_pending
		then call make_q_entry (accept_direct_output, 0, "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 (SYSERR_crash, "uncp: unable to allocate block for delay queue");
	     return;
	end;

	if opc = accept_direct_output
	then pcb.flags.send_output = "0"b;		/* Correction for the untimely disconnects */
	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;

	pcbp = null;
	devx = -1;

	if string (sub_mbx.line_number) ^= "0"b
	then do;
	     sub_mbx.line_number.is_hsla = "1"b;	/* with uncp every line is high speed */
	     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 fnp_info.no_of_channels;	/* 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;
	     if (sub_mbx.io_cmd = rcd) & (sub_mbx.op_code = accept_new_terminal)
	     then do;
		devx = -1;
		return;
	     end;
	     else if sub_mbx.io_cmd ^= wcd
	     then do;
		call syserr (SYSERR_beep, "uncp$interrupt: no slot number match for sub mbx ^o, FNP ^a", i,
		     substr ("abcdefgh", dno, 1));	/* bitch */
		sub_mbx.io_cmd = 0;			/* To force an error */
	     end;
	     return;
match:
	     devx = pcb.devx;			/* copy devx to automatic */
	     if pcb.connection_type = "01"b
	     then do;
		other_pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (pcb.uncp_pcbx));
		devx = other_pcbp -> pcb.devx;
	     end;
	end;
	return;

     end /* get_line_number */;


/* internal procedure to locate and assign a free sub mailbox */

assign_sub_mbx:
     proc (a_sub_mbx_no, a_subp);

dcl  a_sub_mbx_no fixed bin;
dcl  a_subp ptr;
dcl  sub_mbx_num fixed bin;

	sub_mbx_num = index (used_string, "0"b) - 1;
	if sub_mbx_num = -1
	then do;					/* none available */
	     a_sub_mbx_no = -1;
	     a_subp = null ();
	     return;
	end;

	datanet_mbx.mbx_used_flags.used (sub_mbx_num) = "1"b;
						/* set used flag */
	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;
	unspec (datanet_mbx.dn355_sub_mbxes (sub_mbx_num)) = "0"b;
	sub_mbx_sent = "0"b;
	a_sub_mbx_no = sub_mbx_num;
	a_subp = addr (datanet_mbx.dn355_sub_mbxes (sub_mbx_num));
	return;
     end assign_sub_mbx;
%skip (3);
/* internal procedure to release a sub mailbox when it wasn't really needed */

release_sub_mbx:
     proc (a_sub_mbx_no);

dcl  a_sub_mbx_no fixed bin;

	if a_sub_mbx_no < 0 | a_sub_mbx_no > 6
	then return;				/* not a valid mbx# */
	datanet_mbx.mbx_used_flags.used (a_sub_mbx_no) = "0"b;
						/* reset used flag */
						/* and decrement counters */
	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;
	datanet_mbx.num_in_use = datanet_mbx.num_in_use - 1;
	return;
     end release_sub_mbx;


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

dcl  a_mbx_no fixed bin;
dcl  mbx_no fixed bin;
dcl  counter fixed bin;
dcl  output_data_ptr ptr;
dcl  output_data (3) bit (36) aligned based (output_data_ptr);
dcl  1 ima aligned like io_manager_arg;

	mbx_no = a_mbx_no;
	if mbx_no = -1				/* caller running with local copy */
	then do;
	     call assign_sub_mbx (mbx_no, subp);	/* find a free sub mbx */
	     if mbx_no = -1				/* OUCH! Should have had one! */
	     then do;
		call syserr (SYSERR_crash, "uncp: unable to re-assign fnp sub-mailbox.");
		return;
	     end;
	     unspec (sub_mbx) = unspec (local_sub_mbx);	/* copy in local info */
	     a_mbx_no = mbx_no;
	end;

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

	do counter = 1 to LOOP_LIMIT while (datanet_mbx.dia_pcw.command ^= "0"b);
						/* loop until dia picks up last command */
	end;
	if counter > LOOP_LIMIT			/* it never did */
	then no_response = "1"b;

	else do;
	     no_response = "0"b;

	     if (mbx_no >= 0) & (mbx_no <= 6)
	     then do;
		sub_mbx.dn355_no = substr (bit (fnp_info.fnp_number), 7);
		if sub_mbx.op_code = enter_receive
		then do;
		     sub_mbx.io_cmd = wtx;
		     output_data_ptr = fnp_info.dcw_list_array_ptr;
		     output_data (*) = ""b;

		     sub_mbx.command_data (1) = "0"b;
		     sub_mbx.command_data (2) = "0"b;
		     sub_mbx.command_data (3) = "0"b;
		     if pcb.send_lf
		     then do;
			sub_mbx.op_code = accept_direct_output;
			unspec (output_data (2)) = "000001000000"b3;
			unspec (output_data (3)) = "012000000000"b3;
			sub_mbx.word_cnt = 2;
			sub_mbx.data_addr =
			     bit (bin (tty_buf.absorig + fixed (rel (addr (output_data (2)))), 18), 18);
			pcb.send_lf = "0"b;
		     end;
		     else do;
			sub_mbx.op_code = accept_last_output;
			output_data (1) = "0"b;
			sub_mbx.word_cnt = 1;
			sub_mbx.data_addr =
			     bit (bin (tty_buf.absorig + fixed (rel (addr (output_data (1)))), 18), 18);
			pcb.enter_receive_pending, pcb.turn = "0"b;
		     end;
		     call get_line_number;
		     pcb.output_mbx_pending = "1"b;
		end;

		if sub_mbx.op_code = accept_last_output
		then do;
		     call get_line_number;
		     if pcb.connection_type = "10"b
		     then do;
			pcb.turn = "1"b;
			sub_mbx.op_code = accept_direct_output;
		     end;
		end;

		if (sub_mbx.io_cmd = rtx) | (sub_mbx.io_cmd = wtx)
		then sub_mbx.pad3 = (15)"0"b3 || "777"b3;
	     end;

	     sub_mbx.line_number.is_hsla = "0"b;	/*  for the line_number into uncp */

	     if trace.mailbox
	     then call syserr (SYSERR_log, "uncp$send_mbx: # ^o ^2( ^/ ^4( ^w ^) ^)", mbx_no, sub_mbx_array);

	     string (datanet_mbx.dia_pcw) = initial_pcw;	/* initialize pcw */
	     datanet_mbx.dia_pcw.mbx_no = bit (fixed (mbx_no + 1, 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 */
	     sub_mbx_sent = "1"b;			/* show actual use of mbx */

	     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;

	infop = addr (dn355_data$);
	ttybp = addr (tty_buf$);
	uncpbp = datanet_info.uncp_bufp;
	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));
	do j = 1 to fnp_info.no_of_channels;
	     pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (j));
	     if pcb.dialed
	     then do;
		call throw_away_output;
		if pcb.connection_type ^= "10"b
		then 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 (SYSERR_beep, "uncp: 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;

purge_write_texte:
     proc;
	do i = 0 to 6;
	     if timwb (i)
	     then do;
		subp = addr (datanet_mbx.dn355_sub_mbxes (i));
		call get_line_number;
		if sub_mbx.io_cmd = wtx
		then do;
		     if pcb.output_mbx_pending & sub_mbx.command_data (3) ^= "0"b
		     then do;
			da = bin (sub_mbx.data_addr, 18) - tty_buf.absorig;
			blockp = ptr (ttybp, da);	/* set ptr to buffer */
			if pcb.connection_type = "10"b
			then pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (pcb.uncp_pcbx));
			gateway_header = sub_mbx.command_data (3);
			call tty_space_man$free_chain ((pcb.devx), OUTPUT, blockp);
		     end;
		end;
		if sub_mbx.io_cmd = rtx
		then if sub_mbx.word_cnt ^= 0
		     then do;
			uncp_buf.cq_free = uncp_buf.cq_free + sub_mbx.word_cnt;
			sub_mbx.word_cnt = 0;
		     end;
		datanet_mbx.mbx_used_flags.used (i) = "0"b;
		datanet_mbx.num_in_use = datanet_mbx.num_in_use - 1;
	     end;
	end;
	return;
     end;						/* purge_write_texte */

check_lock:
     proc;

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

	if queue_locked
	then call syserr (SYSERR_crash, "uncp: 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;

/* Begin message documentation invisible

   *  This documentation lacks the standard token heading but rather uses
   *  lowercase and the keyword invisible so that the messages documented
   *  below will not be included in the standard error message documentation
   *  shipment.

   Message:
   uncp: invalid interrupt level N

   S:  $beep

   T:  $run

   M:  An FNP interrupt has been received 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:
   uncp: 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:
   uncp$interrupt: 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:
   uncp: 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:
   uncp$interrupt: 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:
   uncp$interrupt: unrecognized io command from FNP X for line N

   S:  $beeper

   T:  $run

   M:  An invalid io command was received from FNP X for line N.

   A:  $inform


   Message:
   uncp: 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:
   uncp: 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:
   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:
   uncp: inconsistent queue lock

   S:  $crash

   T:  $run

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

   A:  $inform


   Message:
   uncp: 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:
   uncp: 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:
   uncp$interrupt: 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:
   uncp: unable to re-assign fnp sub-mailbox.

   S:	$crash

   T:	$run

   M:	During interrupt processing the sub-mailbox from the FNP is
   copied to local storage and the sub-mbx freed.  As part of handling the
   interrupt a need to return information to the FNP was found.  However the
   sub-mbx could not be re-assigned.
   $err

   A:	$inform
   $recover

   End message documentation invisible */


     end uncp;




		    uncp_boot_interrupt.pl1         11/11/89  1109.4r w 11/11/89  0827.2       66366



/****^  ***********************************************************
        *                                                         *
        * 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-14,Berno), approve(88-07-13,MCR7928),
     audit(88-06-14,Parisek), install(88-07-19,MR12.2-1061):
     Created to implement the DSA uncp multiplexer gateway interface.
                                                   END HISTORY COMMENTS */

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

/* This procedure is called by uncp 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.


   *  THE FOLLOWING HISTORY COMMENTS REFER TO THE CHANGES ASSOCIATED WITH
   *  THE uncp MULTIPLEXER INTERFACE FOR THE DSA GATEWAY.  EXTRACTED FROM
   *  dn355_boot_interrupt.pl1.

   *  Reported in February 1982 the modifications for the DN7100.fd.
   *  Reported the ????mises???? of MR10.1 in June 1983.
   *  Reported in August 1985 the modifications for MR11.0.
   *  Reported in January 1987 - MR12.0.
   *  Modified in MR12.0 by JLB to clean things up.


   Date of the last modification 06/22/87.
*/


/* PARAMETER */

dcl  a_fnp_no fixed bin;


/* AUTOMATIC */

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


/* 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  1 ev_msg based (addr (event_message)),
       2 fnp_number fixed bin (17) unal,
       2 fnp_state fixed bin (17) unal,
       2 pad bit (36);

dcl  ev_msg_char char (8) based (addr (event_message));	/* ajouter pour dn 7100   */

/* INTERNAL STATIC CONSTANTS */

dcl  READ_ERROR fixed bin int static options (constant) init (2);
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 builtin;


/* INCLUDE FILES */

%include dn355_messages;

%include dn355_data;

%include dn355_mailbox;

%include sys_log_constants;

	fnp_no = a_fnp_no;
	infop = addr (dn355_data$);
	fnpp = addr (datanet_info.per_datanet (fnp_no));
	fnp_tag = fnp_info.fnp_tag;
	ev_msg.fnp_number = fnp_no;

	call syserr (SL_LOG_SILENT, "uncp_boot_interrupt: FNP ^a started.", fnp_tag);

	ev_msg.fnp_state = FNP_UP;
	fnp_info.running = "1"b;

/* 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;

request_init:
     entry (a_fnp_no);

/*  This entry is called if request-init comes from the UNCP
   after a UNCP load completed.
*/

	fnp_no = a_fnp_no;
	infop = addr (dn355_data$);

	ev_msg_char = "inituncp";
	call pxss$ring_0_wakeup (datanet_info.per_datanet (fnp_no).boot_process_id,
	     datanet_info.per_datanet (fnp_no).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));
	call syserr (SL_LOG_SILENT, "uncp_boot_interrupt: FNP ^a System Fault Interrupt Level 1.", fnp_tag);

	mbxp = fnp_info.mbx_pt;

	fnp_tag = fnp_info.fnp_tag;

	ev_msg.fnp_number = fnp_no;

	stat_ptr = addr (datanet_mbx.crash_data);	/* this is where bootload status goes */
	call syserr (SL_LOG_SILENT, "uncp_boot_interrupt: FNP ^a not loaded.", fnp_tag);
	ev_msg.fnp_state = FNP_DOWN;
	return;




/* Begin message documentation invisible

   This message documentation is considered "invisible" and does NOT have the
   normal uppercase type so that it will not get inserted into the released
   to customer message documentation, as this module only implements the 
   uncp DSA gateway interface and is not a product for distribution.


   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 invisible */

     end /* uncp_boot_interrupt */;




		    uncp_multiplexer.pl1            11/11/89  1109.4r w 11/11/89  0827.2      559638



/****^  ***********************************************************
        *                                                         *
        * 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-10,Berno), approve(88-07-13,MCR7928),
     audit(88-06-10,Parisek), install(88-07-19,MR12.2-1061):
     Add support of the uncp multiplexer interface for DSA login protocol.
  2) change(89-02-24,Parisek), approved(89-02-24,MECR0008),
     audit(89-02-28,Farley), install(89-02-28,MR12.3-1016):	
     Reinitialize the uncp_buf data when performing a load on the UNCP FNP.
                                                   END HISTORY COMMENTS */

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

/* This is the called multiplexer module for FNP channels. It calls uncp
   *  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. */
 
/* THE FOLLOWING HISTORY COMMENTS REFER TO THE CONVERSION TO THE UNCP
   MULTIPLEXER SOFTWARE FOR DSA CONNECTIONS.  fnp_multiplexer.pl1 WAS THE
   TEMPLATE FOR THIS PROGRAM.  */

/* Reported in February 1982 modifications for the connection of the DN7100
   - Added the orders: load, dump, dial
   - Added the hpriv_control for management of the fnp_info.active_bit
     for dials.
   - Eliminate all the ineffective orders for the DN7100.

   - Correction of a Multics crash. In the process mode for "breakall"
     it must initialize alter_type. (31 March 1983).

   Report in this module the improvments for MR10.1 in June 1983
   Installed for MR11 in August 1985.
   Installed for MR12.0 in January 1987.

   Date of the last modification: 07/01/87.
*/


/* 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  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_bit2 bit (2) based;
/*dcl  based_bit18 bit (18) based;*/
dcl  based_bit72 bit (72) based;
/*dcl  based_bit108 bit (108) 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, lbound, hbound, length, null,
     ptr, rel, rtrim, size, /*stac, stacq,*/ string, substr, unspec) builtin;

dcl  area condition;


/* ENTRIES */

/*dcl  pxss$notify entry (fixed bin);*/
dcl  uncp$send_wcd entry (ptr, ptr, fixed bin (8), fixed bin, bit (*));
dcl  uncp$send_global_wcd entry (ptr, fixed bin (8), fixed bin, bit (*));
dcl  uncp$hangup_fnp_lines entry (fixed bin);
dcl  uncp$process_interrupt_queue entry (fixed bin);

dcl  uncp$interrupt entry;
dcl  uncp_util$fill_page_table entry (fixed bin, fixed bin (35));
dcl  uncp_util$free_page_table entry (fixed bin);
/*dcl  uncp_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;*/
dcl  uncp_util$abort entry (fixed bin, fixed bin (35));
dcl  uncp_util$load entry (fixed bin, ptr, fixed bin (35));
dcl  uncp_util$fdump entry (fixed bin, fixed bin, fixed bin, ptr, fixed bin (35));

/* 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_$fnp_down,
/*     error_table_$timeout,*/
     error_table_$unimplemented_version,
/*     error_table_$no_channel_meters,
     error_table_$resource_not_free,*/
     error_table_$action_not_performed,
     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;*/
/*dcl  tty_area$ external static fixed bin;*/

/* 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  UNCP_CQ_SIZE fixed bin int static options (constant) init (2000);
/*dcl  DUMP_PATCH_LIMIT fixed bin (35) int static options (constant) init (10000000);*/
						/* i.e., 10 seconds */
dcl  DCW_LIST_SIZE fixed bin int static options (constant) init (16);
dcl  PCB_SIZE_INCR fixed bin int static options (constant) init (8);
dcl  LA_7 fixed bin int static options (constant) init (7);
dcl  TWO_WORD_LTH fixed bin int static options (constant) init (18);
dcl  BASE_LTH fixed bin int static options (constant) init (56);
dcl  CHAR_72 fixed bin int static options (constant) init (72);

/* 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;
%include uncp_buf;

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, 
   *  uncp_buf, 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$);
	uncpbp = datanet_info.uncp_bufp;		/* UNCP's circular queue */
	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 */
	if uncpbp ^= null then do;
	     unspec (uncp_buf) = ""b;			/* start by zeroing out everything */
 	     uncp_buf.cq_max_size = UNCP_CQ_SIZE;
 	     uncp_buf.cq_free = uncp_buf.cq_max_size;	/* Start of the free space */
 	     uncp_buf.cq_hbound = uncp_buf.cq_max_size - 1;
 						/* The circular queue is a table (0:cq_max_size - 1) */
	end;

	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 uncp_util$fill_page_table ((fnp_info.fnp_number), code);
	if code ^= 0
	then go to init_abort;			/* IOI has problems? */

	do i = lbound (fnp_info.hsla_idx, 1) to hbound (fnp_info.hsla_idx, 1);
						/* initialize line-number indexes for HSLA */
	     fnp_info.hsla_idx (i) = -1;
	end;
	do i = lbound (fnp_info.lsla_idx, 1) to hbound (fnp_info.lsla_idx, 1);
						/* now 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 + PCB_SIZE_INCR * 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 ();

	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 = LA_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 + PCB_SIZE_INCR * 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 uncp_util$free_page_table ((fnp_info.fnp_number));
						/* 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));  */
/*   Le Datanet n aime plus les a-call.
   call uncp$send_global_wcd (fnpp, accept_calls, 0, ""b);
*/
	     call unlock;				/* setup locked and masked */
	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 call unlock;				/* setup masked and locked */

	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, "uncp_multiplexer$shutdown: Called with null fnp_ptr");
	     go to shutdown_return;
	end;
	call TRACE ("shutdown");
	infop = addr (dn355_data$);


/* ****************************************************************************************

   if fnp_info.bootloading | fnp_info.wired	[* stop any pending load *]
   then call uncp_util$abort ((fnp_info.fnp_number));
   else do;
   ************************************************************************* */

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

/*	end;  dn 7100     */

shutdown_return:
	a_code = 0;
	return;


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

/* this is a dummy entry, uncp 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 uncp$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;


/*   supprimer pour le dn7100     *****************************************************************


   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 = TWO_WORD_LTH;
   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 = TWELVE_WORD_LTH;
   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 = TWO_WORD_LTH;
	     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 < REAL_DIGITS | next_digit = SPECIAL_DIGIT
   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 = PHONENO_LTH_X * 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 7;
   echnego_break_table.bits (i) = substr (data_ptr -> based_bit128, 1 + 16 * i, 16);
   end;
   mbx_data = 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 = BAUD_1200;		** just so it's something **
   dialup_info.line_type = LINE_ASCII;	** make everyone's life easier **
   dialup_info.max_buf_size = DIAL_BUF;		** 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 ();  pour le dn 7100      */

		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);
			opcode = alter_parameters;
		     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;
	     if opcode ^= alter_parameters
	     then call uncp$send_wcd (fnpp, pcbp, opcode, mbx_data_len, mbx_data);
	end;

	else do;

/*	     if dumpin
   then call uncp$send_wcd (fnpp, pcbp, alter_parameters, 9, bit (bin (Dumpinput, 9), 9)); pour le dn 7100  */

	     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 uncp$send_wcd (fnpp, pcbp, alter_parameters, 9, bit (bin (Dumpoutput, 9), 9));   pour le dn 7100     */


		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 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;

   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 uncp$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;


/*  Supprimer pour DN_7100 *****************************************************


   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_1
   then code = error_table_$unimplemented_version;
   else do;
   ttybp = addr (tty_buf$);		** we'll need this **
   call lock;
   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;
   fnp_meters.iom_number = fnp_info.iom_number;
   fnp_meters.iom_chan_no = fnp_info.iom_chan_no;
   end;

   call unlock;
   if unspec (fnp_meters_ptr -> fnp_global_meters) = "0"b
   then code = error_table_$no_channel_meters;
   else 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);

   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;

   *********************************************************************** */


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

dcl  1 arg_dump aligned based (data_ptr),
       2 seg_ptr ptr,
       2 uncp_no fixed bin,
       2 uncp_type fixed bin,
       2 uncp_mem_size fixed bin;

	fnpp = a_fnpp;

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


	if order = "load"
	then call uncp_util$load ((fnp_info.fnp_number), data_ptr, code);

	else if order = "dump"
	then call uncp_util$fdump (arg_dump.uncp_no, arg_dump.uncp_type, arg_dump.uncp_mem_size, arg_dump.seg_ptr, code);

	else if order = "abort"
	then call uncp_util$abort ((fnp_info.fnp_number), code);

	else if order = "dial"
	then do;
	     call lock;
	     if code ^= 0
	     then go to hpriv_exit;
	     mbx_data = data_ptr -> based_bit72;
	     call uncp$send_global_wcd (fnpp, dial, CHAR_72, mbx_data);
	     call unlock;
	     code = 0;
	end;



/*      Supprimer pour le DN_7100 *******************************************

   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 (LOG_AND_PRINT, "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 (LOG_AND_PRINT, "^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_$fnp_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;

/*   Supprimer pour l Datanet 7100.   *****************************************

   setup_fnp:
   proc;

   dcl  (fnp_address, fnp_len) fixed bin;

   [* 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_$fnp_down;
   return;
   end;

   ttybp = addr (tty_buf$);

   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_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 mode_name = "breakall"
	then do;
	     alter_type = Breakall;
	     pcb.extra_nl = ^mode_on;
	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 = BASE_LTH;
		     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;

/*   ajouter pour le Datanet 7100       */

	     if alter_type = Lfecho
	     then pcb.lfecho = mode_on;

	     if alter_type = Fullduplex & mode_on = "0"b
	     then code = error_table_$action_not_performed;

/*   fin  d insertion        */

/*	     call uncp$send_wcd (fnpp, pcbp, alter_parameters, length (alter_data) + 9, mbx_data);    */
	end;
	return;
     end;

/*     Supprimer pour le Datanet 7100   *************************************************


   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 uncp$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 code = error_table_$fnp_down;

   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 (LOG_AND_PRINT, "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 *]
   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_$fnp_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 (LOG_AND_PRINT,
   "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;
   ******************************************************************* */

/* Supprimer pour le datanet 7100. ******************************************************************

   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_$fnp_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, "uncp_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 uncp$process_interrupt_queue ((fnp_info.fnp_number));
		locked = "0"b;			/* it unlocks the channel lock when it's done */

	     end;
	return;

     end unlock;

/*   Supprimer pour le Datanet 7100. ***********************************************

   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 = BASE_LTH;			[* 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, uncp$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, "uncp_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,
		"uncp_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, "uncp_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, "uncp_multiplexer$^a: Tracing error.", Entry);
	if datanet_info.debug_stop
	then call syserr (CRASH_SYSTEM, "uncp_multiplexer: debugging stop (type go to continue).");
	return;
     end TRACE;

/* Begin message documentation invisible

   This message doc is classed "invisible" so it will not be added to the
   message documentation distribution for a software release.  The DSA login
   code will not be shipped.

				
   Message:
   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:
   uncp_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:
   uncp_multiplexer: lock ^= processid

   S:	$crash

   T:	$run

   M:	An attempt has been made to unlock an FNP channel lock when it was
   locked to some other process.

   A:	$inform

   Message:
   uncp_multiplexer: attempted crawlout with FNP channel lock set

   S:	$crash

   T:	$run

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

   A:	$inform

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

   S:	$info

   T:	$run

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

   A:	$inform

   End message documentation invisible */



     end uncp_multiplexer;




		    uncp_util.pl1                   11/11/89  1109.4r w 11/11/89  0827.2      401103



/****^  ***********************************************************
        *                                                         *
        * 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-13,Berno), approve(88-07-13,MCR7928),
     audit(88-06-13,Parisek), install(88-07-19,MR12.2-1061):
     Created to implement the uncp multiplexer interface.
                                                   END HISTORY COMMENTS */

/* format: style4,delnl,insnl,^ifthendo */
uncp_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.

   *  THE FOLLOWING HISTORY COMMENTS REFER TO UNCP IMPLEMENTATION, AS THIS
   *  WAS ORIGINALLY A COPY OF dn355_util.

   *  Modified in September 1985 for MR11.
   *  Modified in December 1986 for DSA-compact. fd
   *  Modified in January 1987 for MR12.0
   *  Modified in June and July 1987

   *  Date of the last modification  07/07/87.
*/


/* PARAMETERS */

/* Added the DN7100   */
dcl  a_data_ptr ptr;
dcl  cent fixed bin (15) unsigned init (1);		/* DN7100 address modulo 128 */
dcl  un fixed bin (12) unsigned init (1);		/* Transfer of a word */
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_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  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  fnp_no fixed bin;
dcl  fnp_mem_size fixed bin;
dcl  fnp_type fixed bin;
dcl  fnp_addr fixed bin (15);
dcl  opcode bit (6) aligned;
dcl  temp_fnp_name char (32);
dcl  segptr ptr;
dcl  nwords fixed bin;
dcl  code fixed bin (35);
dcl  devx fixed bin;
dcl  abs_addr_string bit (24);			/* representation of absolute address as bit string */
dcl  i fixed bin;
dcl  abs_address fixed bin (26);
dcl  data_ptr ptr;
dcl  offset fixed bin;
dcl  fnp_tally fixed bin;
dcl  start_time fixed bin (71);
dcl  version char (4);
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;

/* Ajoute pour le DN 7100  */


/* BUILTINS */

dcl  (addr, addrel, addwordno, baseno, bin, bit, clock, divide, fixed, min,
     null, segno, string, substr, unspec) builtin;


/* ENTRIES */

dcl  config_$find_2 entry (character (4) aligned, character (4) aligned, pointer);
dcl  uncp_multiplexer$assign entry (fixed binary, fixed binary (35));
dcl  uncp_multiplexer$unassign entry (fixed binary, fixed binary (35));
dcl  uncp_multiplexer$fnp_lock entry (pointer, fixed binary (35));
dcl  uncp_multiplexer$fnp_unlock entry (pointer);
dcl  get_fnp_name_ entry (fixed bin) returns (char (32));
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$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  uncp$interrupt entry;
dcl  uncp$send_global_wcd entry (ptr, fixed bin (8), fixed bin, bit (*) aligned);
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_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_$io_configured,
     error_table_$io_not_configured,
     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;


/* INTERNAL STATIC */

dcl  (
     FNP_DOWN init (2)
     ) fixed bin int static options (constant);
dcl  SIZE_1024 fixed bin int static options (constant) init (1024);
dcl  NORM_CELL fixed bin int static options (constant) init (3);
dcl  EMER_CELL fixed bin int static options (constant) init (7);
dcl  SECONDS_30 fixed bin (35) int static options (constant) init (30000000);
dcl  MIN_TALLY fixed bin int static options (constant) init (308);
dcl  BIT_75 bit (6) int static options (constant) init ("75"b3);
dcl  BIT_76 bit (6) int static options (constant) init ("76"b3);
dcl  SIZE_256 fixed bin int static options (constant) init (256);
dcl  LOW_MBX_PTW fixed bin int static options (constant) init (1);
dcl  HIGH_MBX_PTW fixed bin int static options (constant) init (3);
dcl  fdump_seg_event char (4) aligned init ("fnpd") static options (constant);
dcl  cleanup 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 ev_chan fixed bin (71),
       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,
       2 version char (4),				/* version number of the DNS software */
       2 pointeur_image_dns ptr,			/* pointer to the beginning of the segment   */
       2 image fixed bin (24),			/* memory size */
       2 etape fixed bin;				/* Stages of loading */
						/* 1 - It is assumed that the Datanet is already loaded */
						/* 2 - It loads the Datanet from Multics */
				                    /* 3 - Loading the Datanet from diskette */

/* Added for the DN7100 */
dcl  1 d7100 aligned based (data_ptr),			/* To give the address and size for clearing of the DN7100. */
       2 pcw,
         3 adr_mode bit (3) unaligned init ("001"b),
         3 fnp_address fixed bin (15) unsigned unaligned,	/* DN7100 address to clear */
         3 poids_fort bit (1) unaligned init ("1"b),	/* 1 = strong points (cad X 2**7 ) */
         3 pad3 bit (5) unaligned init ("00000"b),
         3 tally fixed bin (12) unsigned unaligned,	/* Dimension of the zone to clear */
       2 working_location (7) fixed bin (35) unaligned,
       2 verrou_mot,
         3 pad bit (35) unaligned,
         3 verrou bit (1) unaligned,
       2 control_information unaligned,
         3 pad1 bit (1) unaligned,
         3 administrative_header bit (4) unaligned,
         3 node_type_ofresponder bit (4) unaligned,
         3 pad2 bit (1) unaligned,
         3 software_level_of_responder bit (8) unaligned,
         3 node_ID_of_responder bit (18) unaligned,
         3 Time_of_response bit (36) unaligned,
         3 Node_ID_of_originator bit (18) unaligned,
         3 pad3 bit (1) unaligned,
         3 Origin_type bit (8) unaligned,
         3 pad4 bit (1) unaligned,
         3 Specific_origin bit (8) unaligned,
         3 pad5 bit (1) unaligned,
         3 RFU bit (8) unaligned,
         3 pad6 bit (1) unaligned,
         3 Type bit (8) unaligned,
         3 pad7 bit (1) unaligned,
         3 Class bit (8) unaligned,
         3 pad8 bit (1) unaligned,
         3 Code bit (8) unaligned,
         3 pad8b bit (2) unaligned,
         3 Length_of_commmand bit (16) unaligned,
         3 pad9 bit (1) unaligned,
         3 Format_of_response bit (8) unaligned,
         3 pad10 bit (1) unaligned,
         3 Importance_level bit (8) unaligned,
         3 Length_of_response bit (18) unaligned,
         3 S2_link_ident bit (18) unaligned;

/* This structure is used by the commands RIM, SIM. */
/*
dcl  1 command_parameters aligned based (commandp),
       2 S2_link_identification bit (36) unaligned,
       2 Argument bit (18) unaligned,
       2 command_error unaligned,
         3 mode_4 bit (18) unaligned,
         3 error_code bit (18) unaligned;
*/
/* This structure is used by the command START NODE  */
/*
dcl  1 cmd_parameters aligned based (commandp),
       2 S2_link_identification bit (36) unaligned,
       2 Starting_address bit (36) unaligned,
       2 Option_string_length bit (18) unaligned,
       2 Option_string char (2) init ("GO") unaligned,
       2 cmd_error unaligned,
         3 mode_4 bit (18) unaligned,
         3 error_code bit (18) unaligned;

dcl  commandp pointer;

dcl  1 format_32 based,
       2 rien bit (4) unaligned,
       2 bit8_32 (4) bit (8) unaligned;

dcl  1 format_36 based,
       2 bit9 (4),
         3 bit0 bit (1) unaligned,
         3 bit8_36 bit (8) unaligned;
*/

load:
     entry (a_fnp_no, a_data_ptr, a_code);		/* For the DN7100 */



/* entry to initiate bootload I/O for loading an FNP */

	fnp_no = a_fnp_no;
	load_info_ptr = a_data_ptr;
	call validate_fnp_ret ("load");
	call validate_assigned_ret ("load");

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

	call assign_interrupt (uncp$interrupt, code);

	if fnp_info.bootloading
	then do;					/* we can't do it while it's already happening */
	     code = error_table_$invalid_state;
	     call syserr (ANNOUNCE, "uncp_util$load: FNP load already in progress for FNP ^a.", 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, "uncp_util$load: FNP ^a is running.", fnp_info.fnp_tag);
	     go to load_return;
	end;


/* process the load_info data */

	if load_info.no_entries ^= fnp_info.no_of_channels
	then do;

	     a_code = error_table_$bad_mpx_load_data;
	     go to load_return;
	end;
	
	n_pcbs = fnp_info.no_of_channels;

	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;
		a_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;


	end;

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

	version = "    ";

	fnp_info.boot_ev_chan = load_info.ev_chan;
	fnp_info.boot_process_id = pds$processid;
	fnp_info.version = version;
	fnp_info.fnp_mem_size = fnp_mem_size * SIZE_1024;
	fnp_info.bootloading = "1"b;

	datanet_mbx.dia_pcw.command = ""b;		/* last command */
	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;


	ttybp = addr (tty_buf$);
	fnp_dump_ptr = addr (fnp_dump_seg$);


deux_ten:					
send_wcd:

	call uncp$send_global_wcd (fnpp, init_complete, 0, ""b);

/* Sortie normale meme si l init_complete n a pas ete effective  */

	code = 0;					/* all is well so far */
	go to fin;


unwire_load_buffer:
	call unwire_dump_seg;
restore_load_interrupt:
	call assign_interrupt (uncp$interrupt, code);	/* let uncp take over interrupts again */

unlock_load_seg:
	call lock$unlock (addr (fnp_dump_seg.lock), fdump_seg_event);
ret_bad_load_code:
fin:
	a_code = code;
	return;

load_return:
	if code ^= 0 & (datanet_info.trace | datanet_info.debug_stop)
	then do;
	     call syserr$error_code (ANNOUNCE, code, "uncp_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 = NORM_CELL;		/* customary assignments */
	     emergency_int_cell = EMER_CELL;
	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, "uncp_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, "uncp_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, "uncp_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;


/* RECONFIGURATION ENTRYPOINTS */

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

/* This procedure is NOT REFERENCED by uncp software, but rather calls 
   fnp_util$configure. */

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, "uncp_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, "uncp_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.
*/

/* This procedure is NOT REFERENCED by uncp software, but rather calls 
   fnp_util$deconfigure. */

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 uncp_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, "uncp_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;

abort:
     entry (a_fnp_no, a_code);

/* entry called to abort bootload */
	fnp_no = a_fnp_no;
	call validate_fnp_ret ("abort");
	fnp_info.bootloading, fnp_info.running = "0"b;
	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.
   *
   *  This entry had to be greatly modified for the clearing of the Datanet 7100.
   *  Called by the initializer command "dump_mpx" through uncp_multiplexer$hpriv_control
      froma "dump" control order passed through hphcs_$tty_order -> priv_channel_manager -> cmtv.
      This entry is currently NON-OPERATIONAL.

*/

	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");


	ttybp = addr (tty_buf$);
	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;
	go to ret_bad_code;
/*
	call lock$wait (addr (fnp_dump_seg.lock), fdump_seg_event, code);
	if code ^= 0
	then go to ret_bad_code;
	call assign_interrupt (dump_interrupt, code);	/* we will handle DIA interrupts for this *
	if code ^= 0
	then go to unlock_dump_seg;

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

	data_ptr = addr (fnp_dump_seg.data);



	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 unwire_buffer;
	end;


/* Subroutine to quiet the mmpo which we leave to clear the memory by blocks.
   We have three minutes for the job.

	call init_mmpo;
	if a_code ^= 0
	then go to unwire_buffer;


/* loop reading chunks of FNP memory *
/* Go read blocks of 768 Multics words ( 512+256 ) *

/* Address of the 7100 modulo 256.    *
	fnp_info.running = "0"b;			/* It is no longer in running state *
	fnp_addr, offset = 0;
	fnp_tally = 768;
	do while (fnp_tally > 0);
	     call setup_dump_ctl_word;
	     call fdump_seg_io ("75"b3);		/*  test data xfer *
	     if code ^= 0
	     then go to unwire_buffer;

/* 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 *
	     offset = offset + 768;
	     fnp_tally = min (768, fnp_size - offset);
	end;

/* Ajouter pour le DN 7100 ************************ *

/*  The MMPO has to safeguard the first 100 words of memory in high memory
    (address of the end of memory - 400).  It must then replace this zone in
     its place *

	offset = fnp_size - 512;			/* start of the saved zone *
	segpt1 = ptr (segptr, offset);
	segptr = a_ptr;				/* start of the segment *
	fnp_tally = SIZE_128;			/* cad 100 words hex of 16 bits expressed in L68 36 bit decimal words *
	segptr -> tally_words = segpt1 -> tally_words;	/* Yo!  It's done *

unwire_buffer:
	call unwire_dump_seg;			/* and unwire buffer *

restore_interrupt:
	call assign_interrupt (uncp$interrupt, code);
*/


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 (a_diaop);

dcl  a_diaop bit (6) aligned;

	start_time = clock ();
	fnp_dump_seg.fdump = "1"b;			/* so notify can be done */
	call pxss$addevent (tty_ev);
	call connect_to_dia (a_diaop);
	call pxss$wait;				/* wait for interrupt */

	do while (fnp_dump_seg.fdump);		/* when we get notify, make sure it's the right one */
	     if clock () - start_time > SECONDS_30	/* if it's been more than 30 seconds */
	     then do;				/* punt */
		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,
		"uncp_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;





/* This procedure is NOT REFERENCED by uncp software, but rather calls 
   fnp_util$fnp_tandd_setup. */

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 uncp_multiplexer$assign (fnp_no, code);
	if code ^= 0
	then do;
	     call syserr$error_code (ANNOUNCE, code, "uncp_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, "uncp_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, "uncp_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;

/* This procedure is NOT REFERENCED by uncp software, but rather calls 
   fnp_util$fnp_tandd_release_handler. */

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


/* This procedure is NOT REFERENCED by uncp software, but rather calls 
   fnp_util$fnp_tandd_detach. */

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 uncp_multiplexer$unassign (fnp_no, code);
	if code ^= 0
	then call syserr$error_code (ANNOUNCE, code, "uncp_util: io channel unassignment failed for FNP ^a.",
		fnp_info.fnp_tag);
	call syserr (ANNOUNCE, "uncp_util: releasing FNP ^a from ^a", fnp_info.fnp_id.fnp_tag, pds$process_group_id);
	call unlock_fnp;
	a_code = 0;
	return;

/* This procedure is NOT REFERENCED by uncp software, but rather calls 
   fnp_util$fnp_tandd_mask. */

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;

/* This procedure is NOT REFERENCED by uncp software, but rather calls 
   fnp_util$fnp_tandd_send_int. */

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 ("71"b3);
	call unlock_fnp;

	a_code = 0;
	return;

/* This procedure is NOT REFERENCED by uncp software, but rather calls 
   fnp_util$fnp_tandd_get_ints. */

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;

/* This procedure is NOT REFERENCED by uncp software, but rather calls 
   fnp_util$fnp_tandd_read. */

fnp_tandd_read:
     entry (a_fnp_no, a_ptr, a_count, a_fnp_addr, a_fnp_type, a_code);
	opcode = BIT_75;
	go to fnp_t_and_d_rw_merge;

/* This procedure is NOT REFERENCED by uncp software, but rather calls 
   fnp_util$fnp_tandd_write. */

fnp_tandd_write:
     entry (a_fnp_no, a_ptr, a_count, a_fnp_addr, a_fnp_type, a_code);
	opcode = BIT_76;
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 (MIN_TALLY, nwords);
	     nwords = nwords - fnp_tally;
	     call setup_dump_ctl_word;
	     if opcode = BIT_76			/* 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 (opcode);

	     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 = BIT_75			/* 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,
		     "uncp_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, "uncp_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, "uncp_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, "uncp_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;

	d7100.pcw.fnp_address = divide (2 * offset, SIZE_256, 14, 0);
						/* The DN7100 address is modulo 256 */
	d7100.pcw.tally = fixed (fnp_tally, 11);	/* Tally in L68 words */

     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 abs_address = absadr (fnp_dump_ptr, code);
	if code = 0
	then abs_addr_string = bit (fixed (abs_address + 2, 24), 24);
						/* 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, "uncp_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 (cmd);

/* internal procedure to do DIA i/o */

dcl  cmd bit (6) aligned;
dcl  1 ima aligned like io_manager_arg;

	datanet_mbx.dia_pcw.zero = substr (abs_addr_string, 7, 18);
						/* lower 18 bits of 6180 address */
	datanet_mbx.dia_pcw.mbx_no = substr (abs_addr_string, 1, 6);
						/* rest of it goes here */
	datanet_mbx.dia_pcw.command = cmd;

/* parity on pcw (probably not necessary) */

	string (datanet_mbx.dia_pcw) = dn355_util$compute_parity (string (datanet_mbx.dia_pcw));

	ima.chx = fnp_info.io_manager_chx;
	ima.ptp = null ();
	call io_manager$connect_direct (ima);

	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, "uncp_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 uncp_multiplexer$unassign (fnp_no, code);
	if code ^= 0
	then call syserr$error_code (ANNOUNCE, code, "uncp_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, "uncp_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 uncp_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 uncp_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, "uncp_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 = 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 = LOW_MBX_PTW to HIGH_MBX_PTW;
	     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, "uncp_util: ptw at ^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 mailbox_ops;
%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 invisible

   This message documentation is designated "invisible" and not in the normal
   format so it will not be assigned to the released set of message
   documentation.  This software is not to be released for customer use.

   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:
   uncp_util$wire: FNP T already wired (trace)


   Message:
   uncp_util$wire: failed. REASON (trace)


   Message:
   uncp_util$load: FNP load already in progress for FNP T.


   Message:
   uncp_util$load: FNP T not wired.


   Message:
   uncp_util$load: FNP T is running. (trace)


   Message:
   uncp_util$load: FNP T is running T&D.


   Message:
   uncp_util$load: Error loading FNP T. REASON (trace)


   Message:
   uncp_util$unwire: Unwire failed for FNP T. REASON


   Message:
   uncp_util$configure: FNP T already configured.


   Message:
   uncp_util: FNP T added to configuration^[ by NAME^].


   Message:
   FNP T deleted from configuration^[ by ^a^].


   Message:
   uncp_util$fdump_seg_io: IO_OP for CALLER (trace)


   Message:
   uncp_util: channel assignment failed for FNP ^T REASON. (tandd)


   Message:
   uncp_util: ioam_$assign failed for FNP T. REASON (tandd)


   Message:
   uncp_util: assigned FNP T to NAME for T & D.



   Message:
   uncp_util: io channel unassignment failed for FNP T. (tandd)


   Message: 
   uncp_util: releasing FNP T from NAME (tandd)


   Message:
   uncp_util$validate_assigned_ret (CALLER): IO manager assignment lacking. (trace)


   Message:
   uncp_util$ENTRY: Invalid call for FNP INDEX. (not in cdeck)


   Message:
   uncp_util$ENTRY: Tracing call for fnp T.


   Message:
   uncp_util$ENTRY: Invalid call. (trace)


   Message:
   uncp_util: Could not unassign FNP T at reassign_interrupt. 


   Message:
   uncp_util: force detaching FNP T from process PID.


   Message:
   uncp_util: io channel unassignment failed for FNP T. (tandd)


   Message:
   uncp_util: lock_fnp called with lock locked.


   Message:
   uncp_util$ENTRY: Debugging stop (type go to continue).

   End message documentation invisible */


     end uncp_util;




		    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
