lap_simplex.pl1                 11/11/89  1130.5rew 11/11/89  0857.2      246582



/****^  **************************************************************
        *                                                            *
        * Copyright, (C) Honeywell Bull Inc., 1988                   *
        *                                                            *
        * Copyright, (C) Massachusetts Institute of Technology, 1983 *
        *                                                            *
        ************************************************************** */

/* format: style4,delnl,insnl,ifthenstmt,indnoniterend */

lap_simplex:
     procedure;

/*
   This procedure is the trivial multiplexer which is used to gain direct access to the
   FNP LAP implementation for use by the ARPAnet HDH interface. It contains both the
   wired and nonwired entrypoints, since it's so small.
*/

/*
   Coded December 1978 by J. Stern
   Modified 7/31/79 by B.Westcott to support lap instead.
   Modified November 1979 by C. Hornig for installation.
   Modified August 1981 by C. Hornig to add metering.
   Modified May 1982 by D. W. Cousins for deletion of HOST level2 mpx.
   Modified January 1983 by W. Olin Sibert to create lap_simplex (again!)
   Modified 6/23/83 by Jis to wire itself down when first invoked
   Modified Nov 1986 by T. Beecher to correctly adjust buffer.tally for
   insertion of L2_HEADER_PAD, to handle "frame-size" error @ line-status
   interrupt, and to remove local copies of error_table codes.
   Note:  the lap_cmdr_status structure was copied from x25_mpx.pl1.
*/

/****^  HISTORY COMMENTS:
  1) change(88-07-07,Beattie), approve(88-06-27,MCR7926),
     audit(88-07-22,Brunelle), install(88-08-08,MR12.2-1082):
     Prepared for installation.
                                                   END HISTORY COMMENTS */

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

lap_simplex$interrupt:
     entry (P_lap_data_ptr, P_int_type, P_int_data);

	lap_data_ptr = P_lap_data_ptr;
	int_type = P_int_type;
	int_data = P_int_data;

	if (int_type < lbound (INTERRUPT, 1)) | (int_type > hbound (INTERRUPT, 1)) then do;
BAD_INTERRUPT:
	     call syserr (Log_message, "lap_simplex(^a): Unexpected interrupt ^d ^.3b received.", lap_data.name,
		int_type, int_data);
	     return;
	     end;
	else goto INTERRUPT (int_type);


INTERRUPT (1):					/* DIALUP - major channel has dialed up */
	if (lap_data.state ^= LAP_LISTENING) then goto BAD_INTERRUPT;
	unspec (lap_data.dialup_info) = int_data;	/* Remember it, and send it on */
	lap_data.sc_dialup_info = lap_data.dialup_info;	/* Construct new version */
	lap_data.sc_dialup_info.buffer_pad = L2_HEADER_PAD;
	lap_data.sc_dialup_info.line_type = LINE_ASCII;

	call pxss$ring_0_wakeup (lap_data.load_process_id, lap_data.load_event_channel, MPX_UP, ignore_code);
	lap_data.state = LAP_ACTIVE;			/* Tell the Initializer we're here */
	return;


INTERRUPT (2):					/* HANGUP - major channel has hung up */
	call crash (int_type);
	return;


INTERRUPT (3):					/* CRASH - parent multiplexer has died */
	call crash (int_type);
	return;


INTERRUPT (4):					/* SEND_OUTPUT - it's safe to write next output frame now */
	lap_data.flags.send_output = "1"b;
	call channel_manager$interrupt (lap_data.subchannel, SEND_OUTPUT, (""b));
	return;


INTERRUPT (5):					/* INPUT_AVAILABLE */
	goto BAD_INTERRUPT;


INTERRUPT (6):					/* ACCEPT INPUT - process an input frame */
	unspec (rtx_info) = int_data;
	blockp = pointer (lap_data_ptr, rtx_info.chain_head);
	real_buffer_lth = buffer.tally - L2_HEADER_PAD;

	if ((lap_data.state < LAP_ACTIVE) | (real_buffer_lth <= 0)) then do;
	     call tty_space_man$free_chain (lap_data.devx, INPUT, blockp);
	     goto BAD_INTERRUPT;			/* Packet either too small or arrived at a bad time */
	     end;

	call tty_space_man$switch_chain (lap_data.devx, lap_data.subchannel, INPUT, INPUT, blockp);
						/* Be sure to switch BEFORE shrinking.... */
	begin;					/* Shift the characters over to eliminate the LAP */
dcl  old_string char (real_buffer_lth) automatic;		/* header bytes */
dcl  new_string char (real_buffer_lth) defined (buffer.chars);
	     old_string = substr (string (buffer.chars), L2_HEADER_PAD + 1, real_buffer_lth);
	     new_string = old_string;
	end;

	buffer.tally = buffer.tally - L2_HEADER_PAD;
	rtx_info.input_count = rtx_info.input_count - L2_HEADER_PAD;

	blockp = pointer (blockp, rtx_info.chain_tail);	/* Set the sentinel bit in the last char (just like */
	begin;					/* the one we get when writing) */
dcl  last_char char (1) unaligned defined (buffer.chars (buffer.tally - 1));
	     unspec (last_char) = unspec (last_char) | "400"b3;
	end;

	call channel_manager$interrupt (lap_data.subchannel, ACCEPT_INPUT, unspec (rtx_info));
	return;					/* Otherwise, just send it on */


INTERRUPT (7):					/* INPUT REJECTED - ignore */
INTERRUPT (8):					/* QUIT - ignore */
	return;


INTERRUPT (9):					/* LINE_STATUS - LAP link has gone down */
	unspec (lap_down_status) = int_data;

	if lap_down_status.status_type = 1
	then call syserr (Log_message,
		"lap_simplex(^a): Failure, Link state: ^a, Current action: ^a, in ^a, Primary state: ^a, Secondary state: ^a",
		lap_data.name, FRAME_STATE_ARRAY (lap_down_status.main_state),
		FRAME_FUNCTION_CODE (lap_down_status.last_function_process),
		FRAME_SUB_STATE_ARRAY (lap_down_status.which_state_process),
		FRAME_SUB_STATE_ARRAY (lap_down_status.primary_sub_state),
		FRAME_SUB_STATE_ARRAY (lap_down_status.secondary_sub_state));

	else if lap_cmdr_status.cmdr_status = 3
	then call syserr (Log_message,
		"lap_simplex(^a): Link disconnected due to mis-matched frame sizes. CMDR/FRMR frame: ^( ^.4b^).",
		lap_data.name, lap_cmdr_status.cmdr_bytes.byte (*));

	else goto BAD_INTERRUPT;			/* We don't know this status. */

	return;					/* FNP will send hangup itself. */


INTERRUPT (10):					/* DIAL STATUS - ignore */
INTERRUPT (11):					/* WRU TIMEOUT - ignore */
	goto BAD_INTERRUPT;


INTERRUPT (12):					/* SPACE AVAILABLE - some buffer space was freed that we need */
	call channel_manager$interrupt (lap_data.subchannel, SEND_OUTPUT, ""b);
	return;					/* If we didn't ask, ignore it */


INTERRUPT (13):					/* ACKNOWLEDGE_ECHNEGO_INIT */
INTERRUPT (14):					/* ACKNOWLEDGE_ECHNEGO_STOP */
	return;					/* Ignore both of these */


INTERRUPT (15):					/* TIMER */
INTERRUPT (16):					/* USER_INTERRUPT */
	goto BAD_INTERRUPT;


INTERRUPT (17):					/* MASKED - treat like HANGUP but use different wakeup message */
	call pxss$ring_0_wakeup (lap_data.load_process_id, lap_data.load_event_channel, MPX_MASKED, code);
	call crash (MASKED);
	lap_data.state = LAP_HUNGUP;
	return;
%page;
/* * * * * * * * * * * WRITE * * * * * * * * * * */

lap_simplex$write:
     entry (P_lap_data_ptr, P_subchan_idx, P_chain_ptr, P_code);

	call setup ();

	code = 0;
	chain_ptr = P_chain_ptr;
	next_block = binary (rel (chain_ptr), 18);

	do while ((next_block ^= 0) & lap_data.send_output);
	     blockp = pointer (chain_ptr, next_block);

/*
   The following statement generates miserable code, in that it invokes the pessimal search operator.
   Clearly, it could be optimized, and, indeed, it turns out that search (XXX, collate) is thusly
   optimized, so it's probably not even that hard to fix.
*/

	     frame_end = search (substr (string (buffer.chars), 1, buffer.tally), substr (collate9 (), 257, 256));

	     if frame_end = 0 then do;		/* Buffer contains the middle of a frame */
		next_block = buffer.next;		/* Just add it on and try the next buffer */
		call add_buffer_to_frame ();		/* in the chain */
		end;

	     else if frame_end = buffer.tally then do;	/* Buffer ends a frame. Add it on, try to write */
		next_block = buffer.next;		/* it out, and go on to the next buffer */
		lap_data.frame_ready = "1"b;
		call add_buffer_to_frame ();
		end;

	     else do;				/* Frame ends in the middle of a buffer. */
		call split_buffer ();
		lap_data.frame_ready = "1"b;		/* Guaranteed to be ready after splitting */
		call add_buffer_to_frame ();		/* This adds on only the old half */
		end;

	     if lap_data.frame_ready then call write_frame ();
	end;

WRITE_FINISHES:
	if (next_block = 0)
	then P_chain_ptr = null ();
	else P_chain_ptr = pointer (chain_ptr, next_block);

	if lap_data.send_output then call channel_manager$interrupt (lap_data.subchannel, SEND_OUTPUT, ""b);

	P_code = code;
	return;
%page;
/* * * * * * * * * * * ADD_BUFFER_TO_FRAME * * * * * * * * * * */

add_buffer_to_frame:
     procedure ();

	if (buffer.tally + lap_data.frame_size) > lap_data.max_frame_size then do;
	     call syserr (Log_message, "lap_simplex(^a): Attempt to write overlength frame.", lap_data.name);
	     call crash (HANGUP);
	     call free_pending_frame ();
	     end;

	lap_data.frame_size = lap_data.frame_size + buffer.tally;
	buffer.next = 0;				/* Break the chain before adding on */
	string (buffer.flags) = ""b;

	if (lap_data.frame_start ^= null ())
	then					/* Add it to the end if there's something there */
	     lap_data.frame_end -> buffer.next = binary (rel (blockp), 18);
	else lap_data.frame_start = blockp;		/* Otherwise, remember the first */

	lap_data.frame_end = blockp;			/* And always remember the end */

	return;
     end add_buffer_to_frame;
%page;
/* * * * * * * * * * SPLIT_BUFFER * * * * * * * * * * */

split_buffer:
     procedure ();

dcl  leftover_chars fixed bin;
dcl  new_buf_size fixed bin;
dcl  new_bufp pointer;

/*
   This procedure is invoked when a frame terminator is found in the middle of a buffer. It splits
   the buffer in two, copies the extra characters into the new one, shrinks the old one, and
   adjusts next_block so that the new one will be the next one considered.
*/

	leftover_chars = buffer.tally - frame_end;

	new_buf_size = 16 * (1 + divide ((leftover_chars + 7), 64, 17, 0));
	call tty_space_man$get_buffer (lap_data.subchannel, new_buf_size, OUTPUT, new_bufp);
	if (new_bufp = null ()) then do;		/* If this fails, it means we return the buffer we split */
	     call tty_space_man$needs_space (lap_data.devx);
						/* to our caller, and let him ship it back to us some */
	     lap_data.send_output = "0"b;		/* other time. It gets shipped back because, at this */
	     goto WRITE_FINISHES;			/* point, next_block still indicates the buffer being */
	     end;					/* considered for splitting. */

	substr (string (new_bufp -> buffer.chars), 1, leftover_chars) =
	     substr (string (buffer.chars), frame_end + 1, leftover_chars);
	new_bufp -> buffer.next = buffer.next;
	new_bufp -> buffer.tally = leftover_chars;
	string (new_bufp -> buffer.flags) = ""b;

	next_block = binary (rel (new_bufp), 18);	/* Now, the new buffer will be the one we look at next */

	buffer.tally = buffer.tally - leftover_chars;	/* Shrink the old one, and return */

	return;
     end split_buffer;
%page;
/* * * * * * * * * * WRITE_FRAME * * * * * * * * * * */

write_frame:
     procedure ();

dcl  bufp pointer;
dcl  bufl fixed bin;


	lap_data.frame_end -> buffer.break = "1"b;	/* Since this IS the end */

	bufp = lap_data.frame_start;			/* Shift first buffer right to make room for the */
	bufl = bufp -> buffer.tally;			/* LAP header */

	begin;					/* copy the characters over, avoiding overlap */
dcl  old_string char (bufl) automatic;
dcl  new_string char (bufl) defined (bufp -> buffer.chars (L2_HEADER_PAD));
	     old_string = substr (string (bufp -> buffer.chars), 1, bufl);
	     new_string = old_string;
	end;

	bufp -> buffer.tally = bufp -> buffer.tally + L2_HEADER_PAD;
						/* Update the tally to say that the  */
						/* header is there */

	call tty_space_man$switch_chain (lap_data.subchannel, lap_data.devx, OUTPUT, OUTPUT, lap_data.frame_start);

	call channel_manager$write (lap_data.devx, lap_data.frame_start, code);
	if (code ^= 0) then do;
	     call syserr$error_code (Log_message, code, "lap_simplex(^a): Error from write of ^d chars.", lap_data.name,
		lap_data.frame_size);
	     call free_pending_frame ();
	     call channel_manager$control (lap_data.devx, "hangup", null (), ignore_code);
	     return;
	     end;

	if (lap_data.frame_start ^= null ()) & (lap_data.frame_start ^= bufp) then do;
	     call syserr (Log_message, "lap_simplex(^a): Write failed to take whole frame, discarding rest.",
		lap_data.name);
	     call free_pending_frame ();
	     return;
	     end;

	if (lap_data.frame_start = null ()) then do;
	     lap_data.frame_end = null ();
	     lap_data.frame_size = 0;
	     lap_data.frame_ready = "0"b;
	     lap_data.send_output = "1"b;		/* Try it over again */
	     end;
	else lap_data.send_output = "0"b;		/* Didn't take the frame, so wait */

	return;
     end write_frame;
%page;
/* * * * * * * * * * * CONTROL * * * * * * * * * * */

lap_simplex$control:
     entry (P_lap_data_ptr, P_subchan_idx, P_order, P_info_ptr, P_code);

	call setup ();

	order = P_order;
	info_ptr = P_info_ptr;
	code = 0;

	if (order = "hangup") then do;
	     if (lap_data.state = LAP_HUNGUP)
	     then code = error_table_$invalid_state;
	     else call channel_manager$control (lap_data.devx, "hangup", null (), code);
	     end;

	else if (order = "listen") then do;
	     if (lap_data.state ^= LAP_ACTIVE)
	     then code = error_table_$invalid_state;
	     else do;
		call channel_manager$interrupt (lap_data.subchannel, DIALUP, unspec (lap_data.sc_dialup_info));
		call channel_manager$interrupt (lap_data.subchannel, SEND_OUTPUT, ""b);
		end;
	     end;

	else if (order = "abort") then do;
	     if (info_ptr = null ())
	     then code = error_table_$null_info_ptr;
	     else call free_pending_frame ();
	     end;

	else if (order = "write_status") then do;
	     if (info_ptr = null ())
	     then code = error_table_$null_info_ptr;
	     else do;
		if (lap_data.frame_size ^= 0)
		then info_ptr -> tty_write_status_info.output_pending = "1"b;
		else call channel_manager$control (lap_data.devx, "write_status", info_ptr, code);
		end;
	     end;

	else if (order = "wru") then do;
	     if (lap_data.state ^= LAP_ACTIVE)
	     then code = error_table_$invalid_state;
	     else call channel_manager$interrupt (lap_data.subchannel, WRU_TIMEOUT, ""b);
	     end;

	else code = error_table_$undefined_order_request;

	P_code = code;
	return;
%page;
/* * * * * * * * * * * CHECK_MODES * * * * * * * * * */

lap_simplex$check_modes:
     entry (P_lap_data_ptr, P_subchan_idx, P_mcl_info_ptr, P_code);

	call do_modes ("0"b);
	return;

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

lap_simplex$set_modes:
     entry (P_lap_data_ptr, P_subchan_idx, P_mcl_info_ptr, P_code);

	call do_modes ("1"b);
	return;

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

lap_simplex$get_modes:
     entry (P_lap_data_ptr, P_subchan_idx, P_modes, P_code);

	call setup ();
	P_code = 0;
	P_modes = "";
	return;
%page;
/* * * * * * * * * * * DO_MODES * * * * * * * * * * */

do_modes:
     procedure (P_set_sw);

dcl  P_set_sw bit (1) aligned parameter;
dcl  mode_error fixed bin (35);


	call setup ();
	mclp = P_mcl_info_ptr;

	if mcl.version ^= mcl_version_2 then do;
	     P_code = error_table_$unimplemented_version;
	     return;
	     end;

	mode_error = 0;				/* The only modes we implement are rawo and rawi, and they */
						/* must always be turned on */
	do mode_idx = 1 to mcl.n_entries;
	     mclep = addr (mcl.entries (mode_idx));
	     if (mcle.mode_name = "rawo") | (mcle.mode_name = "rawi") then do;
		if ^P_set_sw then mcle.mpx_mode = "1"b;
		else if (mcle.mode_switch = "0"b) then do;
						/* They can only be turned on */
		     mode_error = error_table_$bad_mode;
		     mcle.error = "1"b;
		     end;
		end;

	     else if P_set_sw
	     then if (mcle.mpx_mode & ^mcle.force) then do;
		     mode_error = error_table_$bad_mode;
		     mcle.error = "1"b;
		     end;

		else mcle.mpx_mode = "0"b;
	end;

	P_code = mode_error;
	return;
     end do_modes;
%page;
/* * * * * * * * * * SETUP_SUBCHAN * * * * * * * * * */

setup:
     procedure ();

	lap_data_ptr = P_lap_data_ptr;
	if (P_subchan_idx ^= 1) then do;
	     call syserr (Write_with_alarm, "lap_simplex(^a): Invalid subchannel index ^d", lap_data.name, P_subchan_idx);
	     P_code = error_table_$bad_arg;
	     goto SETUP_RETURNS_FOR_ERROR;
	     end;

	return;
     end setup;

SETUP_RETURNS_FOR_ERROR:
	return;					/* from lap_simplex */


/* * * * * * * * * * CRASH * * * * * * * * * */

crash:
     procedure (P_type);

dcl  P_type fixed bin parameter;


	call free_pending_frame ();

	call channel_manager$interrupt (lap_data.subchannel, P_type, ""b);

	if (P_type ^= CRASH)
	then					/* Unless he's already obviously aware, */
	     call pxss$ring_0_wakeup (lap_data.load_process_id, lap_data.load_event_channel, MPX_DOWN, code);
						/* we'd better let daddy know we've been bad */
	lap_data.state = LAP_HUNGUP;

	return;
     end crash;

/* * * * * * * * * * FREE_PENDING_FRAME * * * * * * * * * */

free_pending_frame:
     procedure ();

	if (lap_data.frame_start = null ()) then return;

	call tty_space_man$free_chain (lap_data.devx, OUTPUT, lap_data.frame_start);

	lap_data.frame_start = null ();
	lap_data.frame_end = null ();
	lap_data.frame_size = 0;
	lap_data.frame_ready = "0"b;

	return;
     end free_pending_frame;
%page;
/*
   All the "unwired" entries are below; they share no important code with the operational
   parts of the multiplexer, only declarations, and are here for packaging reasons only.
*/

/* * * * * * * * * * INIT_MULTIPLEXER * * * * * * * * * */

/* Entry to allocate and initialize the multiplexer data base for a given major channel */

lap_simplex$init_multiplexer:
     entry (P_devx, P_miip, P_lap_data_ptr, P_code);

	devx = P_devx;
	miip = P_miip;
	P_lap_data_ptr = null ();

	if ^init_sw then do;
	     call wire_proc$wire_me;			/* Chomp on the memories */
	     init_sw = "1"b;
	     end;

	lap_data_ptr = null ();
	on cleanup
	     begin;
	     if lap_data_ptr ^= null () then call tty_space_man$free_space (size (lap_data), lap_data_ptr);
	end;

	call tty_space_man$get_space (size (lap_data), lap_data_ptr);
	if lap_data_ptr = null () then do;		/* allocate space for multiplexer data base */
	     P_code = error_table_$noalloc;
	     return;
	     end;

	lap_data.name = reverse (after (reverse (mux_init_info.channels (1).name), "."));
	lap_data.devx = devx;
	lap_data.subchannel = mux_init_info.channels (1).devx;
	lap_data.state = LAP_HUNGUP;
	lap_data.frame_start = null ();
	lap_data.frame_end = null ();

	lctp = tty_buf$lct_ptr;
	lctep = addr (lct.lcte_array (lap_data.subchannel));
	lcte.subchannel = 1;

	P_lap_data_ptr = lap_data_ptr;
	P_code = 0;
	return;
%page;
/* * * * * * * * * * TERMINATE_MULTIPLEXER * * * * * * * * * */

/* Entry to discard the multiplexer data base for a given major channel */

lap_simplex$terminate_multiplexer:
     entry (P_lap_data_ptr, P_code);

	lap_data_ptr = P_lap_data_ptr;
	call tty_space_man$free_space (currentsize (lap_data), lap_data_ptr);

	P_lap_data_ptr = null ();
	P_code = 0;
	return;

/* * * * * * * * * START * * * * * * * * * */

/* Entry to allow dialups on multiplexer subchannels */

lap_simplex$start:
     entry (P_lap_data_ptr, P_code);

	lap_data_ptr = P_lap_data_ptr;
	lap_data.simplex_started = "1"b;
	P_code = 0;
	return;

/* * * * * * * * * * STOP * * * * * * * * * */

/* Entry to forbid dialups on multiplexer subchannels */

lap_simplex$stop:
     entry (P_lap_data_ptr, P_code);

	lap_data_ptr = P_lap_data_ptr;
	lap_data.simplex_started = "0"b;
	P_code = 0;
	return;

/* * * * * * * * * * SHUTDOWN * * * * * * * * * */

/*
   Entry to shut down the multiplexer (equivalent to a crash)
   instead of just hangup. It should be a disconnect order and
   then a deactivate order for any state greater than listening
*/

lap_simplex$shutdown:
     entry (P_lap_data_ptr, P_code);

	lap_data_ptr = P_lap_data_ptr;
	if (lap_data.state > LAP_HUNGUP) then call channel_manager$control (lap_data.devx, "hangup", null (), code);
	return;

/* * * * * * * * * PRIV_CONTROL * * * * * * * * * * */

/* Entry to perform privileged control orders */

lap_simplex$priv_control:
     entry (P_lap_data_ptr, P_order, P_info_ptr, P_code);

	lap_data_ptr = P_lap_data_ptr;
	order = P_order;
	P_code = 0;

	if /* case */ order = "copy_meters" then do;
	     call channel_manager$control (lap_data.devx, order, P_info_ptr, P_code);
	     end;

	else if order = "get_meters" then do;
	     call channel_manager$control (lap_data.devx, order, P_info_ptr, P_code);
	     end;

	else P_code = error_table_$undefined_order_request;

	return;

/* * * * * * * * * * HPRIV_CONTROL * * * * * * * * * */

/* Entry to perform highly privileged control orders */

lap_simplex$hpriv_control:
     entry (P_lap_data_ptr, P_order, P_info_ptr, P_code);

	lap_data_ptr = P_lap_data_ptr;
	order = P_order;
	code = 0;

	if /* case */ order = "load_mpx" then do;	/* bootload the multiplexed device */
	     lap_load_info_ptr = P_info_ptr;		/* save load info */

	     if lap_load_info.version ^= LAP_LOAD_INFO_VERSION_1 then do;
		P_code = error_table_$unimplemented_version;
		return;
		end;

	     if lap_data.state > LAP_HUNGUP then do;	/* one at a time please */
		P_code = error_table_$action_not_performed;
		return;
		end;

	     string (lap_data.flags) = ""b;
	     lap_data.load_process_id = lap_load_info.process_id;
	     lap_data.load_event_channel = lap_load_info.event_channel;
	     lap_data.activate_order = lap_load_info.activate_order;

	     lap_data.activate_order.pad = ""b;		/* Just in case */
	     lap_data.activate_order.command = ACTIVATE_COMMAND;

	     lap_data.max_frame_size = divide (lap_data.activate_order.frame_size + 7, 8, 17, 0);

	     call channel_manager$control (lap_data.devx, "line_control", addr (lap_data.activate_order), code);
	     if code ^= 0 then do;
		P_code = code;
		return;
		end;

	     call channel_manager$control (lap_data.devx, "listen", null (), code);
	     if code ^= 0 then do;
		P_code = code;
		return;
		end;

	     lap_data.state = LAP_LISTENING;
	     end;

	else code = error_table_$undefined_order_request;

	P_code = code;
	return;
%page;
dcl  P_devx fixed bin parameter;			/* device (LCT) index */
dcl  P_info_ptr pointer parameter;			/* ptr to control order info structure */
dcl  P_miip pointer parameter;			/* ptr to mux_init_info structure */
dcl  P_order char (*) parameter;			/* control order name */
dcl  P_lap_data_ptr pointer parameter;			/* ptr to lap_data (lap multiplexer data base) */
dcl  P_subchan_idx fixed bin parameter;			/* Subchannel index (should always be 1) */
dcl  P_int_type fixed bin parameter;
dcl  P_int_data bit (72) aligned parameter;
dcl  P_chain_ptr pointer parameter;
dcl  P_mcl_info_ptr pointer parameter;			/* Mode change list and modes */
dcl  P_modes char (*) parameter;
dcl  P_code fixed bin (35) parameter;			/* error code */

dcl  code fixed bin (35);
dcl  ignore_code fixed bin (35);
dcl  devx fixed bin;
dcl  info_ptr pointer;
dcl  order char (32);
dcl  int_type fixed bin;
dcl  int_data bit (72) aligned;
dcl  chain_ptr pointer;
dcl  next_block fixed bin (18);
dcl  frame_end fixed bin;
dcl  real_buffer_lth fixed bin;
dcl  mode_idx fixed bin;

dcl  1 lap_down_status aligned like lap_line_status_info automatic;

dcl  1 lap_cmdr_status aligned based (addr (int_data)),
       2 cmdr_status uns fixed bin (18) unaligned,	/* constant 3 */
       2 cmdr_bytes (3) unaligned,			/* I-frame at fault */
         3 pad bit (1) unaligned,			/* N(s) & N(r) */
         3 byte bit (8) unaligned,			/* flags w,x,y,z */
       2 pad bit (27) unaligned;

dcl  init_sw bit (1) aligned static init ("0"b);		/* Whether proc has been wired */

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

dcl  error_table_$action_not_performed fixed bin (35) external static;
dcl  error_table_$bad_arg fixed bin (35) external static;
dcl  error_table_$bad_mode fixed bin (35) external static;
dcl  error_table_$invalid_state fixed bin (35) external static;
dcl  error_table_$noalloc fixed bin (35) external static;
dcl  error_table_$null_info_ptr fixed bin (35) external static;
dcl  error_table_$undefined_order_request fixed bin (35) external static;
dcl  error_table_$unimplemented_version fixed bin (35) external static;

dcl  tty_buf$lct_ptr pointer external static;

dcl  MPX_UP fixed bin (71) static options (constant) init (1);
dcl  MPX_DOWN fixed bin (71) static options (constant) init (2);
dcl  MPX_MASKED fixed bin (71) static options (constant) init (3);

dcl  cleanup condition;

dcl  (addr, after, binary, collate9, currentsize, divide, hbound, lbound, pointer, null, rel, reverse, search, size,
     string, substr, unspec) builtin;
%page;
%include lap_simplex_data;
%page;
%include lap_line_info;
%page;
%include mux_init_info;
%page;
%include lct;
%page;
%include channel_manager_dcls;
%page;
%include tty_space_man_dcls;
%page;
%include mcs_modes_change_list;
%page;
%include mode_string_info;
%page;
%include tty_buffer_block;
%page;
%include mcs_interrupt_info;
%page;
%include line_types;
%page;
%include tty_read_status_info;
%page;
%include syserr_codes;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   lap_simplex(CHN): Unexpected interrupt TYPE DATA received.

   S: $log

   T: $run

   M: An unexpected MCM interrupt was processed.

   A: $notify

   Message:
   lap_simplex(CHN): Failure, Link state: STATE, Current Action: FUNCTION, in ESTATE, Primary state: PSTATE, Secondary state: SSTATE.

   S: $log

   T: $run

   M: Normal request to crash the line when the link has been disconnected by
   the FNP.  STATE is the main state of the link. FUNCTION is the last
   function the link processed. The ESTATE is the execution state of the
   last function. PSTATE and SSTATE are the link up substate.

   A: $notify

   Message:
   lap_simplex(CHN): Link disconnected due to mis-matched frame sizes. CMDR/FRMR frame: FRAME.

   S: $log

   T: $run

   M: The FNP has received a command reject (LAPB) or frame reject (LAP) which
   specified a reason of "wide frame" on channel CHN.  The actual level 2
   command is FRAME.  This means the frame received by the other end was too
   long.  Instead of looping continuously trying to send this frame, the link
   will be disconnected.  The maximum frame size in the Multics TTF for this
   link should be checked against the size expected by the other end of the
   link, and corrected.

   A: $notify

   Message:
   lap_simplex(CHN): Attempt to write overlength frame.

   S: $log

   T: $run

   M: An attempt was made to add a buffer to a frame which didn't have room
   for it.  The connection will be crashed.

   A: $notify

   Message:
   x25_mpx(CHN): Error from write of XXX chars. ERROR

   S: $log

   T: $run

   M: The ERROR occurred writing XXX characters to the LAP channel.
   The LAP channel will be disconnected.

   A: $notify

   Message:
   lap_simplex(CHN): Write failed to take whole frame, discarding rest.

   S: $log

   T: $run

   M: A attempt to write a whole frame failed, only a part of it was taken.
   An attempt will be made to continue.

   A: $notify

   Message:
   lap_simplex(CHN): Invalid subchannel index XXX

   S: $alarm

   T: $run

   M: Some call which attempted to write, process a control order or process
   a modes operation specified a subchannel other than 1.

   A: $notify

   END MESSAGE DOCUMENTATION */

     end lap_simplex;




		    x25_mpx.pl1                     11/11/89  1130.5r w 11/11/89  0857.7      795555



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



/****^  HISTORY COMMENTS:
  1) change(89-03-20,Parisek), approve(89-06-01,MCR8110),
     audit(89-10-09,Farley), install(89-10-25,MR12.3-1100):
     Add support of protocol mpx.
                                                   END HISTORY COMMENTS */


/* format: style4,delnl,insnl,ifthenstmt,indnoniterend */
x25_mpx:
     procedure;

/* This procedure contains the non-privileged entries of the x25
   multiplexer.  These entries can be invoked at interrupt time
   and therefore must be wired.

   Coded December 1978 by J. Stern
   Modified July, 1979 by B.Westcott to support x25 level 3 protocol
   Rewritten April 1980 by C. Hornig for installation
   Problem with stop_mpx fixed October 1980 by C. Hornig
   Modified to fix interrupts and trap bad packet format, October 1981, by C. Hornig.
   Modified for flexible channel definitions, January 1982, by C. Hornig.
   Modified to delete the HOST level 2 mpx, May 1982, by D. W. Cousins.
   Modified to handle MASKED interrupt, August 1982, by Robert Coren.
   Modified for MR10.1 improvements, January 1983, by C. Hornig
   Modified for TELENET certification, and to cause the multiplexer rather than
   the system to crash when tty_buf is full, February 1983, by R.J.C. Kissel.
   Modified to fix a bug in handling data and flow control packets in DTE_RESET_REQUEST
   state, March 1983, by R.J.C. Kissel.
   Modified to correct a bug which only allows 11 chars of address for an x29 call request, June 1983, by R.J.C. Kissel.
   Modified by Jis for Telenet parameter negotiation corrections. 6/23/83
   Modified by Jis to allow reverse charging connect request per physical connection. August 1983.
   Modified to bring some rationality to PAD parameter setting and to fix a problem with QUIT on TELENET,
   August 1983, by R.J.C. Kissel.
   Modified to handle the new line status from the FNP which means frame sizes are mis-matched,
   April 1984, by R.J.C. Kissel (x25 error list #13).
   Modified to discard output data on RESET CONFIRM, October 1984, by R.J.C. Kissel (x25 error list #12).
   Modified to make a consistency check on P(r), October 1984, by R.J.C. Kissel (x25 error list #11).
   Modified October 1984 by R.J.C. Kissel to use the value of the idle timer in the TTF for breakall mode.
   Modified October 1984 by R.J.C. Kissel to not send empty packets for write_status, if we haven't heard from the last one (x25 error list #14).
   Modified December 1984 by R.J.C. Kissel to make discarding ouput on RESET CONFIRM really work.
   Modified January 1985 by R.J.C. Kissel to send line status on reset, and to fix clearing on idle VC.
   Modified April 1985 by R.J.C. Kissel to handle multiple crash/hangup interrupts in interrupt 2, 3, and 17. (x25 error list #15).
*/

/* Parameters */

dcl  x25_chain_ptr ptr parameter;			/* ptr to write chain (input) */
dcl  x25_code fixed bin (35) parameter;			/* error code (output) */
dcl  x25_infop ptr parameter;				/* ptr to control order info structure (input) */
dcl  x25_int_data bit (72) aligned parameter;		/* interrupt data (input) */
dcl  x25_int_type fixed bin parameter;			/* interrupt type (input) */
dcl  x25_modes char (*) parameter;			/* mode string (output) */
dcl  x25_order char (*) parameter;			/* control order name (input) */
dcl  X25_data_ptr ptr parameter;			/* ptr to multiplexer data base (input) */
dcl  x25_mclp ptr parameter;				/* ptr to modes change list */
dcl  X25_scx fixed bin parameter;			/* subchannel number (input) */

/* Automatic */

dcl  (endp, prev_blockp, chain_ptr, leftover_chain_ptr) ptr;
dcl  (called_dte_addr_length, calling_dte_addr_length) unsigned fixed bin (4);
dcl  (facility_disp, user_data_disp, facility_length, user_data_length) fixed bin;
dcl  temp_ps unsigned fixed bin (7);
dcl  lcx uns fixed bin (12);
dcl  scx fixed bin;
dcl  code fixed bin (35);
dcl  (i, j) fixed bin;
dcl  infop ptr;
dcl  int_data bit (72) aligned;
dcl  int_type fixed bin;
dcl  (hdr_size, nchars) fixed bin (21);
dcl  mode_found bit (1) aligned;
dcl  order char (32) aligned;
dcl  addr_string char (30) aligned;
dcl  set_entry bit (1) aligned;
dcl  pr_error bit (1) unaligned;
dcl  protocol_mpx bit (1) unaligned;
dcl  Call_data char (16);				/* variable conversion of the call data - */
						/* Based */

dcl  1 write_status_info aligned based (infop),
       2 ev_chan fixed bin (71),
       2 output_pending bit (1);

dcl  dial_out_info aligned varying char (24) based (infop);
dcl  1 reason_of_hangup aligned based (infop) like NDIS_IND_REASON;
dcl  1 N_I_i aligned based (addr (buffer.chars)) like NCON_IND_info;
dcl  1 ifci aligned like input_flow_control_info based (infop);
dcl  1 ofci aligned like output_flow_control_info based (infop);
dcl  1 ftd aligned like foreign_terminal_data based (infop);

dcl  1 lap_down_status aligned based (addr (x25_int_data)),
       2 link_down_status uns fixed bin (18) unaligned,	/* 1 */
       2 last_function_process fixed bin (17) unaligned,	/* coded function */
       2 which_state_process uns fixed bin (9) unaligned,	/* process state */
       2 main_state uns fixed bin (9) unaligned,		/* current frame level state */
       2 primary_sub_state uns fixed bin (9) unaligned,	/* sub link up state */
       2 secondary_sub_state uns fixed bin (9) unaligned;

dcl  1 lap_cmdr_status aligned based (addr (x25_int_data)),
       2 cmdr_status uns fixed bin (18) unaligned,	/* constant 3 */
       2 cmdr_bytes (3) unaligned,			/* I-frame at fault */
         3 pad bit (1) unaligned,			/* N(s) & N(r) */
         3 byte bit (8) unaligned,			/* flags w,x,y,z */
       2 pad bit (27) unaligned;

dcl  1 x25_pkt aligned based (blockp),
       2 buffer_header bit (36),
       2 l2_pad char (2 /* L2_HEADER_PAD */) unal,
       2 l3_header unal,
         3 pad1 bit (1) unal,
         3 q bit (1) unal,				/* data qualifier */
         3 d bit (1) unal,				/* significance of P(R) across net */
         3 format bit (2) unal,			/* general format identifier */
         3 lcgn bit (4) unal,				/* Logical Channel Group Number */
         3 pad2 bit (1) unal,
         3 lcn bit (8) unal,				/* Logical Channel Number */
       2 l3_fc bit (0) unal,				/* start of flow-control data */
       2 pad3 bit (1) unal,
       2 type bit (8) unal,				/* packet type */
       2 no_fc_data (56) bit (9) unal;

dcl  l3_call_data char (user_data_length) based (addr (x25_pkt.no_fc_data (user_data_disp)));

dcl  l3_facilities char (facility_length) based (addr (x25_pkt.no_fc_data (facility_disp + 1)));
dcl  1 m8_fc_data unal based (addr (x25_pkt.l3_fc)),	/* flow-control data for mod-8 */
       2 pad bit (1),
       2 pr uns fixed bin (3),			/* P(R) */
       2 m bit (1),					/* More Data */
       2 ps uns fixed bin (3),			/* P(S) */
       2 data_sw bit (1),
       2 user_data bit (0);

dcl  1 m128_fc_data unal based (addr (x25_pkt.l3_fc)),
       2 pad1 bit (1),
       2 ps uns fixed bin (7),
       2 data_sw bit (1),
       2 pad2 bit (1),
       2 pr uns fixed bin (7),
       2 m bit (1),
       2 user_data bit (0);

dcl  l4_data_ptr ptr;
dcl  l4_data (56) bit (9) unal based (l4_data_ptr);

dcl  based_area area based;

/* Constants */

dcl  L2_HEADER_PAD fixed bin static options (constant) init (2);
dcl  TIMEOUT fixed bin (71) static options (constant) init (1000000);
dcl  T20 fixed bin (71) static options (constant) init (180000000);
dcl  MPX_UP fixed bin (71) static options (constant) init (1);
dcl  MPX_DOWN fixed bin (71) static options (constant) init (2);
dcl  MPX_MASKED fixed bin (71) static options (constant) init (3);
dcl  DEFAULT_BAUD fixed bin internal static options (constant) init (1200);
dcl  (
     MODE_RAWI init (1),
     MODE_ECHOPLEX init (2),
     MODE_BREAKALL init (3),
     MODE_IFLOW init (4),
     MODE_OFLOW init (5),
     MODE_HNDLQUIT init (6),
     MODE_LFECHO init (7),
     MODE_POLITE init (8),
     MODE_8BIT init (9)
     ) fixed bin static options (constant);
dcl  mode_names (11) char (8) aligned static options (constant)
	init ("rawi", "echoplex", "breakall", "iflow", "oflow", "hndlquit", "lfecho", "polite", "8bit", "oddp",
	"no_outp");

dcl  CALLRQ bit (8) unal static options (constant) init ("0b"b4);
						/* call request or call indication (DCE) */
dcl  CALLAC bit (8) unal static options (constant) init ("0f"b4);
						/* call accept or call connected (DCE) */
dcl  CLRRQ bit (8) unal static options (constant) init ("13"b4);
						/* clear request or clear indication */
dcl  CLRCN bit (8) unal static options (constant) init ("17"b4);
						/* clear-confirm (DCE) */
dcl  RSRTRQ bit (8) unal static options (constant) init ("fb"b4);
						/* restart request or restart indication (DCE) */
dcl  RSRTCN bit (8) unal static options (constant) init ("ff"b4);
						/* restart confirm (DCE) */
dcl  DIAG bit (8) unal static options (constant) init ("f1"b4);
						/* diagnostic */
dcl  RESTRQ bit (8) unal static options (constant) init ("1b"b4);
						/* reset request or reset indication (DCE) */
dcl  RESTCN bit (8) unal static options (constant) init ("1f"b4);
						/* reset confirm (DCE) */
dcl  SNITRQ bit (8) unal static options (constant) init ("23"b4);
						/* interrupt request or interrupt indication (DCE) */
dcl  SNITCN bit (8) unal static options (constant) init ("27"b4);
						/* interrupt confirm (DCE) */
dcl  SNRR bit (8) unal static options (constant) init ("01"b4);
						/* receiver ready (DCE) */
dcl  SNRNR bit (8) unal static options (constant) init ("05"b4);
						/* receiver not ready (DCE) */
dcl  SNREJ bit (8) unal static options (constant) init ("09"b4);
dcl  SNMASK bit (8) unal static options (constant) init ("0f"b4);
						/* mask for sequence control packets */
dcl  NL char (1) static options (constant) init ("
");						/* new-line character */
dcl  CR_LF_FF char (3) int static options (constant) init ("
");						/* CR, LF, FF */

/* Internal static */

dcl  et_action_not_performed fixed bin (35) static;
dcl  et_bad_arg fixed bin (35) static;
dcl  et_bad_mode fixed bin (35) static;
dcl  et_invalid_state fixed bin (35) static;
dcl  et_noalloc fixed bin (35) static;
dcl  et_resource_unavailable fixed bin (35) static;
dcl  et_undefined_order_request fixed bin (35) static;
dcl  et_unimplemented_version fixed bin (35) static;

/* External static */

dcl  error_table_$action_not_performed fixed bin (35) ext static;
dcl  error_table_$bad_arg fixed bin (35) ext static;
dcl  error_table_$bad_mode fixed bin (35) ext static;
dcl  error_table_$invalid_state fixed bin (35) ext static;
dcl  error_table_$noalloc fixed bin (35) ext static;
dcl  error_table_$resource_unavailable fixed bin (35) ext static;
dcl  error_table_$undefined_order_request fixed bin (35) ext static;
dcl  error_table_$unimplemented_version fixed bin (35) ext static;

dcl  x25_mpx_data$trans_no_parity char (256) aligned external;
dcl  x25_mpx_data$trans_no_parity_lfecho char (256) aligned external;
dcl  x25_mpx_data$trans_parity_lfecho char (256) aligned external;
dcl  x25_mpx_data$eight_bit char (512) aligned external;
dcl  based_trans_table char (512) aligned based;

/* Builtins */

dcl  (addr, after, before, binary, bit, clock, dimension, divide, hbound, lbound, length, min, mod, null, pointer, rel,
     rtrim, size, string, substr, unspec, verify) builtin;
						/* Entries */

dcl  mrl_ entry (ptr, fixed bin (21), ptr, fixed bin (21));
dcl  mvt_ entry (ptr, ptr, fixed bin (21), char (512) aligned);
dcl  pxss$ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
dcl  syserr entry options (variable);
dcl  wire_proc$wire_me entry;
%page;
/* * * * * * * * * * CONTROL * * * * * * * * * */

control:
     entry (X25_data_ptr, X25_scx, x25_order, x25_infop, x25_code);

	call setup_subchan;
	order = x25_order;
	infop = x25_infop;
	pinfop = infop;
	x25_code = 0;

	protocol_mpx = get_protocol_sc ();
	
	if xlcep = null ()				/* do we have a connection? */
	then if /* case */ order = "listen" then do;	/* no */
		xsce.state = SC_LISTENING;		/* listen for subchan to dial up */
		end;

	     else if order = "dial_out" then do;	/* initiate connection? */
		if x25_data.lc_ptr = null () then do;
		     x25_code = et_invalid_state;
		     return;
		     end;
		do lcx = x25_data.n_lc by -1 to 1 + x25_data.n_pvc while (x25_lces.lc (lcx).state ^= READY);
						/* search for a free subchannel */
		end;
		if lcx < 1 then do;
		     x25_code = et_resource_unavailable;
		     return;
		     end;
		xlcep = addr (x25_lces.lc (lcx));
		xlce.flags.originate = "1"b;		/* we made this call */

		if (^protocol_mpx & length (dial_out_info) > 0) then do;
		     xlce.call_data = after (dial_out_info, ":");
		     xlce.baud_rate = x25_data.dialup_info.baud_rate;
		     xlce.flags.originate = "1"b;	/* we made this call */
		     xlce.flags.collect_call = x25_data.flags.out_calls_collect;

		     if substr (before (dial_out_info, ":"), 1, 4) = "x29," then do;
						/* This is an X.29 call. */
			xlce.his_address = substr (before (dial_out_info, ":"), 5);
			xlce.flags.iti_call = "1"b;
			end;

		     else if substr (before (dial_out_info, ":"), 1, 1) = "*" then do;
						/* This is an X.29 call. */
			xlce.his_address = substr (before (dial_out_info, ":"), 2);
			xlce.flags.iti_call = "1"b;
			end;

		     else do;			/* Not an X.29 call. */
			xlce.his_address = before (dial_out_info, ":");
			xlce.flags.iti_call = "0"b;
			call get_buffer (16);
			end;
		     end;

/* if protocol_mpx is ON then length of dial_out_info will be zero since the
   first word in NCON_REQ_info is zero and dial_out_info is a varying string
   based on infop, which also points to NCON_REQ_info. */

		else if (length (dial_out_info) = 0) then do;
						/* protocol_mpx is ON */
						/* Call not  X29 (NCON_REQ) */
						/* use the NCON_REQ_info overlay */
		     xlce.baud_rate = DEFAULT_BAUD;
		     xlce.call_data = NCON_REQ_info.data;
						/* xlce.call_data not to contain all of the data. */
		     xlce.his_address = NCON_REQ_info.to_address;
		     xlce.flags.iti_call = "0"b;
		     xsce.trans_table_ptr = null ();
		     call get_buffer (32);		/* Get a buffer of size 32 to "Accommodate the large ISO calls" */
		     end;
		if xlce.flags.iti_call then do;
		     xlce.iti_params (13) = 4;	/* build a call request packet */
		     call get_buffer (16);
		     end;

		call make_header (lcx, "0"b);
		x25_pkt.type = CALLRQ;
		if ^x25_data.flags.no_d then x25_pkt.l3_header.d = "1"b;
		calling_dte_addr_length = length (x25_data.my_address);
		called_dte_addr_length = length (xlce.his_address);
		x25_pkt.no_fc_data (1) = "0"b || bit (calling_dte_addr_length) || bit (called_dte_addr_length);
		facility_disp = 2 + divide (called_dte_addr_length + calling_dte_addr_length + 1, 2, 17, 0);

		addr_string = xlce.his_address || x25_data.my_address;
		do i = 2 to facility_disp - 1;	/* convert to BCD */
		     x25_pkt.no_fc_data (i) =
			"0"b || substr (unspec (substr (addr_string, 2 * i - 3, 1)), 6, 4)
			|| substr (unspec (substr (addr_string, 2 * i - 2, 1)), 6, 4);
		end;

/* Set the "reverse charging" facility according to the value of collect= in the TTF */
/* facilities "by default", correct below if necessary... */
		x25_pkt.no_fc_data (facility_disp) = "002"b3;
		x25_pkt.no_fc_data (facility_disp + 1) = "001"b3;
		if protocol_mpx then do;
		     facility_length = 2;
		     if xlce.collect_call
		     then l3_facilities = "

";	/* taxation on demand */
		     else l3_facilities = "
";	/* taxation on caller ("demander" or "applicant") */
		     user_data_disp = facility_disp + 3;
		     facility_length = length (NCON_REQ_info.facilities);
		     if facility_length ^= 0 then do;
			x25_pkt.no_fc_data (facility_disp) = substr (unspec (facility_length), 27, 9);
			l3_facilities = NCON_REQ_info.facilities;
			user_data_disp = facility_disp + facility_length + 1;
			end;
		     user_data_length = length (NCON_REQ_info.data);
		     l3_call_data = NCON_REQ_info.data;
		     end;
		else do;
		     if xlce.collect_call
		     then x25_pkt.no_fc_data (facility_disp + 2) = "001"b3;
		     else x25_pkt.no_fc_data (facility_disp + 2) = "000"b3;
		     user_data_disp = facility_disp + 3;
		     user_data_length = length (xlce.call_data) + 4;
		     unspec (substr (l3_call_data, 1, 4)) = ""b3;
		     if xlce.flags.iti_call then unspec (substr (l3_call_data, 1, 1)) = "001"b3;
		     substr (l3_call_data, 5) = xlce.call_data;
		     end;

		buffer.tally = 2 + user_data_disp + user_data_length + L2_HEADER_PAD;
		call write_pkt;
		call send_output;

		xsce.state = SC_DIALING;
		xsce.lcx = lcx;
		xlce.scx = scx;
		call state_change (DTE_WAITING);
		end;

	     else if order = "hangup" then do;		/* cancel a previous listen */
		call reset_xsce;
		end;

	     else if (protocol_mpx & order = "get_network_infos") then do;
						/* retrieve network infos */
		network_infos.network_address = x25_data.my_address;
		network_infos.max_packet_size = x25_lces.lc (1).max_packet_size;
		end;
	     else x25_code = et_undefined_order_request;	/* only these are valid if not dialed */
%page;
	else if /* case */ order = "hangup" then do;	/* pull the plug on this subchan */
	     if xlce.flags.iti_call & ^xlce.flags.originate then do;
		call get_buffer (16);		/* this is PAD, ask nicely */
		call make_header (lcx, "1"b);		/* by making an invitation to clear */
		l4_data (1) = "001"b3;
		buffer.tally = hdr_size + 1 + L2_HEADER_PAD;
		call write_data_pkt;
		end;

	     else if (protocol_mpx & infop ^= null ()) then call clear_call ((reason_of_hangup.diag));
	     else call clear_call (0);		/* send a clear request */
	     end;

	else if (protocol_mpx & (order = "connect_response")) then do;
						/* primitive ISO NCONNECT RESPONSE */
	     if xlce.state ^= CONRESP_WAITING | xsce.state ^= SC_DIALING
	     then x25_code = et_invalid_state;
	     else do;
		call reset_timer;
		call send_NCON_RESP;
		xsce.state = SC_DIALING;
		xlce.state = FLOW_CONTROL_READY;
		xsce.flags.output_ready = "1"b;
		call channel_manager$interrupt (xsce.devx, SEND_OUTPUT, ""b);
		x25_code = 0;
		end;
	     end;

	else if order = "wru" then do;
	     if ^xsce.flags.wru_done then do;
		call tty_space_man$get_buffer (xsce.devx, 16, INPUT, blockp);
		if blockp ^= null () then do;
		     buffer.next = 0;
		     string (buffer.flags) = ""b;
		     buffer.flags.break = "1"b;
		     string (buffer.chars) = "X.25:" || xlce.his_address || NL;
		     buffer.tally = length (rtrim (string (buffer.chars)));

		     rtx_info.input_chain.chain_head, rtx_info.input_chain.chain_tail = rel (blockp);
		     rtx_info.input_count = 16;
		     string (rtx_info.flags) = ""b;
		     rtx_info.flags.break_char = "1"b;

		     call channel_manager$interrupt (xsce.devx, ACCEPT_INPUT, unspec (rtx_info));
		     xsce.flags.wru_done = "1"b;
		     end;
		end;
	     end;

	else if order = "abort" then ;		/* this is too tough */

	else if order = "write_status" then do;
	     write_status_info.output_pending = (xlce.next_send_seq ^= xlce.next_ack_seq);
	     if write_status_info.output_pending & ^xlce.flags.write_status_sync_sent then call send_sync;
						/* watch out for open windows */
	     end;

	else if order = "interrupt" then do;
	     if xlce.flags.int_issued then return;	/* only one interrupt at a time */
	     call get_buffer (16);
	     call make_header (lcx, "0"b);
	     x25_pkt.type = SNITRQ;
	     x25_pkt.no_fc_data (1) = ""b;
	     buffer.tally = 4 + L2_HEADER_PAD;		/* length of packet = 4 */
	     call write_pkt;
	     call send_output;
	     xlce.flags.int_issued = "1"b;		/* show interrupt request issued */

	     if xlce.flags.iti_call & (xlce.iti_params (7) = 21) then do;
		call get_buffer (16);
		call make_header (lcx, "1"b);
		l4_data (1) = "003"b3;
		l4_data (2) = "010"b3;
		l4_data (3) = "001"b3;
		buffer.tally = hdr_size + 3 + L2_HEADER_PAD;
		call write_data_pkt;
		xlce.iti_params (8) = 1;
		end;
	     end;

	else if order = "input_flow_control_chars" then do;
	     if (ifci.suspend_seq.count ^= 1) | (ifci.resume_seq.count ^= 1)
		| (substr (ifci.suspend_seq.chars, 1, 1) ^= "" /* XOFF */)
		| (substr (ifci.resume_seq.chars, 1, 1) ^= "" /* XON */)
	     then x25_code = et_bad_arg;
	     end;

	else if order = "output_flow_control_chars" then do;
	     if string (ofci.flags) ^= ""b
		& ((^ofci.flags.suspend_resume) | (ofci.suspend_or_etb_seq.count > 1)
		| (ofci.resume_or_ack_seq.count > 1)
		| (substr (ofci.suspend_or_etb_seq.chars, 1, 1) ^= "" /* XOFF */)
		| (substr (ofci.resume_or_ack_seq.chars, 1, 1) ^= "" /* XON */))
	     then x25_code = et_bad_arg;
	     end;

	else if order = "set_framing_chars" then ;	/* we could play with forwarding conditions */

	else if xlce.flags.iti_call & xlce.flags.originate & (order = "get_foreign_terminal_data") then do;
	     if ftd.version ^= FOREIGN_TERMINAL_DATA_VERSION_1 then do;
		x25_code = et_unimplemented_version;
		return;
		end;
	     number_of_modes = 7;
	     allocate mode_string_info in (ftd.area_ptr -> based_area) set (mode_string_info_ptr);
	     mode_string_info.version = mode_string_info_version_2;
	     do i = 1 to number_of_modes;
		mode_string_info.modes (i).version = mode_value_version_3;
		mode_string_info.modes (i).mode_name = mode_names (i);
		mode_string_info.modes (i).flags.boolean_valuep = "1"b;
	     end;
	     mode_string_info.modes (MODE_RAWI).boolean_value = (xlce.iti_params (1) = 0);
	     mode_string_info.modes (MODE_ECHOPLEX).boolean_value = (xlce.iti_params (2) ^= 0);
	     mode_string_info.modes (MODE_BREAKALL).boolean_value = (xlce.iti_params (4) ^= 0);
	     mode_string_info.modes (MODE_IFLOW).boolean_value = (xlce.iti_params (5) ^= 0);
	     mode_string_info.modes (MODE_OFLOW).boolean_value = (xlce.iti_params (12) ^= 0);
	     mode_string_info.modes (MODE_HNDLQUIT).boolean_value = (xlce.iti_params (7) = 21);
	     mode_string_info.modes (MODE_LFECHO).boolean_value = (xlce.iti_params (13) ^= 0);

	     ftd.mode_string_info_ptr = mode_string_info_ptr;
	     xsce.flags.need_ftd = "1"b;
	     end;

	else x25_code = et_undefined_order_request;

	return;
%page;
/* * * * * * * * * * CHECK_MODES * * * * * * * * * */

check_modes:
     entry (X25_data_ptr, X25_scx, x25_mclp, x25_code);

	set_entry = "0"b;
	goto modes_common;

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

set_modes:
     entry (X25_data_ptr, X25_scx, x25_mclp, x25_code);

	set_entry = "1"b;
modes_common:
	call setup_subchan;
	if xlcep = null () then do;
	     x25_code = et_invalid_state;
	     return;
	     end;
	x25_code = 0;
	mclp = x25_mclp;

	if mcl.version ^= mcl_version_2 then do;
	     x25_code = et_unimplemented_version;
	     return;
	     end;

	if set_entry then do;
	     if mcl.init then do;
		string (xsce.mode) = ""b;
		end;
	     end;

	do i = 1 to mcl.n_entries;
	     mclep = addr (mcl.entries (i));
	     mode_found = "0"b;
	     do j = 1 to dimension (mode_names, 1);
		if mcle.mode_name = mode_names (j) then do;
		     mode_found = "1"b;
		     if set_entry
		     then if mcle.mpx_mode
			then xsce.mode (j) = mcle.mode_switch;
			else ;
		     else mcle.mpx_mode = "1"b;
		     end;
	     end;

	     if ^mode_found
	     then if set_entry
		then if mcle.mpx_mode & ^mcle.force then do;
						/* this is a mode we want to set */
			mcle.error = "1"b;
			x25_code = et_bad_mode;
			end;
		     else ;
		else mcle.mpx_mode = "0"b;
	end;

	if set_entry then do;			/* Set the modes. */

/* Get the right translation table. */

	     if xsce.mode (MODE_8BIT) then do;
		if xsce.mode (MODE_LFECHO)
		then xsce.trans_table_ptr = addr (x25_mpx_data$trans_parity_lfecho);
		else xsce.trans_table_ptr = null ();
		end;

	     else if xsce.mode (MODE_LFECHO) then xsce.trans_table_ptr = addr (x25_mpx_data$trans_no_parity_lfecho);

	     else xsce.trans_table_ptr = addr (x25_mpx_data$trans_no_parity);

/* See if we are doing X.29, and who is the PAD. */
/* format: comcol71 */

	     if xlce.flags.iti_call & ^xlce.flags.originate then do;/* X.29 and he is the PAD, so set parameters. */
		call get_buffer (16);
		call make_header (lcx, "1"b);
		l4_data (1) = "002"b3;
		nchars = 1;

/* Set the following parameters for all network types. */

		call add_iti_mode (MODE_RAWI, 1, 0, 1);	          /* PAD recall with a character, 0 = none, 1 = ^P */
		call add_iti_mode (MODE_ECHOPLEX, 2, 1, 0);	/* PAD echo, 0 = off, 1 = on */
		call add_iti_mode (MODE_BREAKALL, 3, 0, 2);	/* PAD data forwarding, 0 = none, 2 = CR. */
		call add_iti_mode (MODE_BREAKALL, 4, (x25_data.breakall_idle_timer), 0);
							/* PAD idle timer, 1/20 seconds. */
		call add_iti_mode (MODE_IFLOW, 5, 1, 0);	/* PAD input XON/XOFF mode. */
		call add_iti_mode (MODE_HNDLQUIT, 7, 21, 1); /* PAD break handling, 21 = normal, 1 = interrupt only. */
		call add_iti_mode (MODE_OFLOW, 12, 1, 0);	/* PAD output XON/XOFF mode. */
		call add_iti_mode (MODE_LFECHO, 13, 4, 0);	/* PAD LF echoing, 4 = echo LF to terminal, 0 = none. */

		call add_iti_param (10, 0);		          /* Turn off PAD line folding. */
		call add_iti_param (15, 0);		          /* Turn off PAD editing. */

/* Now do the network specific parameter settings. */

		if x25_data.net_type = "datapac" then do;
		     call add_iti_param (0, 0);		/* CCITT National marker. */
		     call add_iti_mode (MODE_POLITE, 125, 30, 0);
		     call add_iti_mode (MODE_LFECHO, 126, 4, 0);
		     end;

		else if x25_data.net_type = "telenet" then do;
		     call add_iti_param (0, 33);		/* Telenet National marker. */
		     call add_iti_mode (MODE_LFECHO, 1, 4, 0);	/* Telenet LF echoing. */
		     end;

		else if x25_data.net_type = "tymnet" then ;	/* Nothing special for now. */

		else ;					/* Unspecified network type, nothing special for now. */

		buffer.tally = hdr_size + nchars + L2_HEADER_PAD;
		call write_data_pkt;
		end;					/* X.29 and he is the PAD, so set parameters. */
	     end;						/* Set the modes. */

/* format: comcol61 */

	return;

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

get_modes:
     entry (X25_data_ptr, X25_scx, x25_modes, x25_code);

	x25_code = 0;
	x25_modes = "";
	return;
%page;
/* * * * * * * * * * WRITE * * * * * * * * * */

write:
     entry (X25_data_ptr, X25_scx, x25_chain_ptr, x25_code);

	call setup_subchan;
	if xlcep = null () then do;
	     x25_code = et_invalid_state;
	     return;
	     end;
	x25_code = 0;

	protocol_mpx = get_protocol_sc ();
	
	xsce.flags.output_ready = "0"b;

	if xlce.flags.iti_break then return;		/* so we won't take any of the new one */

	do chain_ptr = x25_chain_ptr repeat (leftover_chain_ptr)
	     while ((chain_ptr ^= null ()) & ^xsce.flags.end_of_page);
	     nchars = 0;
	     prev_blockp = null ();
	     do blockp = chain_ptr repeat (pointer (blockp, buffer.next));
		nchars = nchars + buffer.tally;
		call mvt_ (addr (buffer.chars), addr (buffer.chars), (buffer.tally), x25_mpx_data$eight_bit);
		if (nchars > xlce.max_packet_size) | (buffer.next = 0) | buffer.flags.end_of_page | buffer.flags.break
		then goto end_chain;
		string (buffer.flags) = ""b;
		prev_blockp = blockp;
	     end;

/****
      The assumption is made at this point that xlce.max_packet_size is larger
      than the buffer size.  If it weren't, then the above loop would have exited
      before setting prev_blockp, and the system will crash with a reference
      through a null pointer below.  This situation should never arise since
      as_x25_mpx_ checks that the packet size is larger than the minimum
      buffer size.  If the system crashes, someone has failed abysmally.
****/

end_chain:
	     if nchars > xlce.max_packet_size then do;	/* can take only part of the chain */
		prev_blockp -> buffer.next = 0;	/* break chain here */
		leftover_chain_ptr = blockp;		/* we'll give back the rest */
		endp = prev_blockp;			/* we want this to point to last block */
		end;

	     else do;
		endp = blockp;
		if buffer.next = 0
		then leftover_chain_ptr = null ();
		else do;
		     leftover_chain_ptr = pointer (blockp, buffer.next);
		     buffer.next = 0;
		     end;
		end;

/* Construct a standard X25 data frame consisting of:
   (1) level 2 header pad (if any)
   (2) level 3 header
   (3) text message

   The write chain we were given constitutes the body of the text
   message. */

	     xsce.flags.end_of_page = endp -> buffer.flags.end_of_page;

	     blockp = chain_ptr;			/* now build the header */
	     if x25_data.seq_mod = 8 then do;
		hdr_size = 3;
		l4_data_ptr = addr (m8_fc_data.user_data);
		end;
	     else do;
		hdr_size = 4;
		l4_data_ptr = addr (m128_fc_data.user_data);
		end;
	     call mrl_ (addr (buffer.chars), (buffer.tally), l4_data_ptr, (buffer.tally));
	     buffer.tally = buffer.tally + hdr_size + L2_HEADER_PAD;
						/* make room for header */
	     call make_header (lcx, "0"b);
	     x25_pkt.type = "00"b4;

/*
   if ^(endp -> buffer.break | endp -> buffer.end_of_page)
   then if x25_data.seq_mod = 8
   then m8_fc_data.m = "1"b;
   else m128_fc_data.m = "1"b;
*/
	     if protocol_mpx then do;
		if ^xlce.flags.iti_call & ^endp -> buffer.flags.break
		then if x25_data.seq_mod = 8
		     then m8_fc_data.m = "1"b;
		     else m128_fc_data.m = "1"b;
		end;

	     call tty_space_man$switch_chain (xsce.devx, x25_data.devx, OUTPUT, OUTPUT, blockp);
	     string (endp -> buffer.flags) = ""b;
	     call write_data_pkt;
	end;

	call solicit_output;			/* if we took it all, get more */
	x25_chain_ptr = chain_ptr;
	x25_code = 0;
	return;
%page;
/* * * * * * * * * * * INTERRUPT * * * * * * * * * * */

interrupt:
     entry (X25_data_ptr, x25_int_type, x25_int_data);

	x25_data_ptr = X25_data_ptr;
	int_type = x25_int_type;
	int_data = x25_int_data;
	xscep, xlcep = null ();

	if (int_type < lbound (INTERRUPT, 1)) | (int_type > hbound (INTERRUPT, 1))
	then goto bad_interrupt;
	else goto INTERRUPT (int_type);


INTERRUPT (1):					/* DIALUP - major channel has dialed up */
	if x25_data.state ^= X25_LISTENING then goto bad_interrupt;
	unspec (x25_data.dialup_info) = int_data;
	if ^x25_data.flags.bypass_restart then call restart (0);
	return;


INTERRUPT (2):					/* HANGUP - major channel has hung up */
	call pxss$ring_0_wakeup (x25_data.load_proc_id, x25_data.load_ev_chan, MPX_DOWN, code);

	if x25_data.state ^= X25_HUNGUP then do;
	     call crash_subchannels;
	     call x25_hangup;
	     end;

	return;

INTERRUPT (3):					/* CRASH - parent multiplexer has died */
	if x25_data.state ^= X25_HUNGUP then do;
	     call crash_subchannels;
	     call x25_hangup;
	     end;

	return;

INTERRUPT (9):					/* LINE STATUS - process fnp status message */
/****
      Currently, for the two cases of line status (1 or 3), the FNP has sent the
      line status, and then deactivated itself.  This causes it to stop listening
      to the link, and also to send us a hangup interrupt.  This is done to solve
      a race condition with the previous implementation:

      1) FNP sends line status and goes back to listen to the link
      2) we send deactivate order
      3) FNP stops listening to the line and sends us a hangup order
      4) we crash the multiplexer.

      If the link comes up between 1 and 2, the FNP sends us a dialup interrupt
      which we ignore, and then at deactivate time the FNP does not tell the
      other side that he is disconnecting.  This creates problems which are
      solved by the current scheme.
****/
	if lap_down_status.link_down_status = 1
	then call syserr (Log_message,
		"x25_mpx(^a): Failure, Link state: ^d, Current action: ^d, in ^d, Primary state: ^d, Secondary state: ^d",
		x25_data.name, lap_down_status.main_state, lap_down_status.last_function_process,
		lap_down_status.which_state_process, lap_down_status.primary_sub_state,
		lap_down_status.secondary_sub_state);

	else if lap_cmdr_status.cmdr_status = 3
	then call syserr (Log_message,
		"x25_mpx(^a): Link disconnected due to mis-matched frame sizes. CMDR/FRMR frame: ^( ^.4b^).",
		x25_data.name, lap_cmdr_status.cmdr_bytes.byte (*));

	else goto bad_interrupt;			/* We don't know this status. */

	return;					/* FNP will send hangup itself. */


INTERRUPT (4):					/* SEND OUTPUT - it's safe to write next output frame now */
	x25_data.flags.send_output = "1"b;

	if (x25_data.long_packet_head ^= 0) & (x25_data.write_head = null ()) then do;
	     scx = x25_data.long_packet_head;
	     xscep = addr (x25_data.sc (scx));
	     lcx = xsce.lcx;
	     xlcep = addr (x25_lces.lc (lcx));
	     x25_data.long_packet_head = xsce.long_packet_next_scx;
	     if x25_data.long_packet_head = 0 then x25_data.long_packet_tail = 0;
	     xsce.flags.long_packet_pending = "0"b;
	     call send_data_packets;
	     end;

	call send_output;
	return;


INTERRUPT (5):					/* INPUT_AVAILABLE */
INTERRUPT (10):					/* DIAL STATUS - ignore */
INTERRUPT (11):					/* WRU TIMEOUT - ignore */
bad_interrupt:
	call syserr (Log_message, "x25_mpx(^a): Unexpected interrupt ^d ^.3b received.", x25_data.name, int_type,
	     int_data);

INTERRUPT (7):					/* INPUT REJECTED - ignore */
INTERRUPT (8):					/* QUIT - ignore */
INTERRUPT (12):					/* SPACE AVAILABLE - some buffer space was freed that we need */
INTERRUPT (13):					/* ACKNOWLEDGE_ECHNEGO_INIT */
INTERRUPT (14):					/* ACKNOWLEDGE_ECHNEGO_STOP */
INTERRUPT (16):					/* USER_INTERRUPT */
	return;

INTERRUPT (17):					/* MASKED - treat like HANGUP but use different wakeup message */
	call pxss$ring_0_wakeup (x25_data.load_proc_id, x25_data.load_ev_chan, MPX_MASKED, code);

	if x25_data.state ^= X25_HUNGUP then do;
	     call crash_subchannels;
	     x25_data.state = X25_HUNGUP;
	     end;

	return;

INTERRUPT (15):					/* TIMER */
	unspec (timer_info) = int_data;
	lcx = timer_info.subchan_idx;

	if lcx = 0 then do;
	     if (x25_data.state = X25_RESTARTING) & (clock () > x25_data.restart_time + T20) then do;
		call restart (52);
		end;
	     return;
	     end;

	xlcep = addr (x25_lces.lc (lcx));
	xlce.flags.timer_set = "0"b;
	scx = xlce.scx;
	xscep = addr (x25_data.sc (scx));
	protocol_mpx = get_protocol_sc ();
	
	if xlce.state = FLOW_CONTROL_READY then do;
	     call send_rr;
	     return;
	     end;

	if clock () > xlce.state_time + T20 then do;
	     call syserr (Log_message, "x25_mpx(^a/^d): Time out in state ^d.", x25_data.name, lcx, xlce.state);
	     if xlce.state = DTE_WAITING then do;
		call clear_call (49);
		return;
		end;
	     else if xlce.state = DTE_RESET_REQUEST then do;
		call clear_call (51);
		return;
		end;
	     else if xlce.state = DTE_CLEAR_REQUEST then do;
		call clear_call (50);
		return;
		end;
	     else if protocol_mpx & (xlce.state = CONRESP_WAITING) then do;
		call clear_call (48);
		return;
		end;
	     end;

	return;
%page;
INTERRUPT (6):					/* ACCEPT INPUT - process an input frame */
	unspec (rtx_info) = int_data;
	chain_ptr, blockp = pointer (x25_data_ptr, rtx_info.chain_head);
	endp = pointer (x25_data_ptr, rtx_info.chain_tail);

	if buffer.tally < L2_HEADER_PAD + 3 then do;	/* too short? */
	     call syserr (Log_message, "x25_mpx(^a): Packet too short.", x25_data.name);
	     call dump_pkt;
	     call send_diag (38);
	     goto done_in_pkt;
	     end;

	if x25_pkt.l3_header.format ^= x25_data.gfid then do;
						/* do we understand it? */
	     call syserr (Log_message, "x25_mpx(^a): Unrecognized general format ID ^b^b^2b.", x25_data.name,
		x25_pkt.l3_header.q, x25_pkt.l3_header.d, x25_pkt.l3_header.format);
	     call dump_pkt;
	     call send_diag (40);
	     goto done_in_pkt;
	     end;

	lcx = binary (x25_pkt.l3_header.lcgn || x25_pkt.l3_header.lcn, 12);

/* Check for invalid logical channel. If channels start at zero then maximum is (n_lc - 1). */

	if lcx > x25_data.n_lc then do;
	     call syserr (Log_message, "x25_mpx(^a): Invalid channel number ^d.", x25_data.name, lcx);
	     call dump_pkt;
	     call send_diag (36);
	     goto done_in_pkt;
	     end;
%page;
	protocol_mpx = "0"b;
	if x25_data.state = X25_ACTIVE then do;
	     if lcx = 0 then do;

/* Restart Request */

		if x25_pkt.type = RSRTRQ then do;
		     call crash_subchannels;
		     call free_in_pkt;
		     call get_buffer (16);
		     call make_header (0, "0"b);
		     x25_pkt.type = RSRTCN;
		     buffer.tally = 3 + L2_HEADER_PAD;
		     call write_pkt;
		     call send_output;
		     goto done_in_pkt;
		     end;

/* Restart Confirmation */

		if x25_pkt.type = RSRTCN then do;
		     call free_in_pkt;
		     call restart (16);
		     goto done_in_pkt;
		     end;

/* Diagnostic */

		if x25_pkt.type = DIAG then do;
		     call syserr (Log_message, "x25_mpx(^a): Diagnostic type ^d.", x25_data.name,
			binary (x25_pkt.no_fc_data (1), 8));
		     call dump_pkt;
		     goto done_in_pkt;
		     end;

		call syserr (Log_message, "x25_mpx(^a): Invalid packet type ^.4b on LC 0.", x25_data.name,
		     x25_pkt.type);
		call dump_pkt;
		goto done_in_pkt;
		end;
%page;
/* now examine packets for other logical channels */

	     xlcep = addr (x25_lces.lc (lcx));
	     scx = xlce.scx;
	     if scx > 0 then do;
		xscep = addr (x25_data.sc (scx));
		protocol_mpx = get_protocol_sc ();

		if protocol_mpx
		     then if x25_data.packet_trace_sw then call log_packet ("0"b);
%page;
/* Data packet */

		if substr (x25_pkt.type, 8, 1) = "0"b then do;
						/* if data packet */
		     if xlce.state ^= FLOW_CONTROL_READY then do;
			call handle_data_or_fc_error;
			goto done_in_pkt;
			end;


		     call proc_pr (pr_error);		/* update output window */
		     if pr_error then goto done_in_pkt;

		     if x25_data.seq_mod = 8		/* extract packet seq number */
		     then do;
			temp_ps = m8_fc_data.ps;
			hdr_size = 3;
			l4_data_ptr = addr (m8_fc_data.user_data);
			rtx_info.break_char, endp -> buffer.flags.break = ^m8_fc_data.m;
			end;
		     else do;
			temp_ps = m128_fc_data.ps;
			hdr_size = 4;
			l4_data_ptr = addr (m128_fc_data.user_data);
			rtx_info.break_char, endp -> buffer.flags.break = ^m128_fc_data.m;
			end;

		     if temp_ps ^= xlce.next_recv_seq then do;
						/* if P(S) bad - not equal to V(R) */
			call syserr (Log_message, "x25_mpx(^a): Sequence error P(S)=^d V(R)=^d.", xsce.name,
			     temp_ps, xlce.next_recv_seq);
			call dump_pkt;
			call reset_lc (1);
			goto done_in_pkt;
			end;			/* invalid P(S) */

		     xlce.next_recv_seq = mod (xlce.next_recv_seq + 1, x25_data.seq_mod);
						/* V(R) = V(R) +1 */
		     if x25_pkt.l3_header.d
		     then xlce.force_ack_time = 0;	/* force immediate acknowledgement */
		     else xlce.force_ack_time = clock () + TIMEOUT;
						/* acknowledge within 1 sec */

		     if x25_pkt.l3_header.q then do;	/* if Q bit set */
			if ^xlce.flags.iti_call then do;
						/* if this is not an ITI call */
			     int_data = substr (string (l4_data), 1, 72);
			     call channel_manager$interrupt (xsce.devx, LINE_STATUS, int_data);
			     end;
			else do;
			     i = binary (l4_data (1), 8);
						/* get the X.29 command */
			     if i > hbound (iti, 1) then do;
				call syserr (Log_message, "x25_mpx(^a): Invalid X.29 command ^d.", xsce.name, i);
				call dump_pkt;
				call get_buffer (16);
				call make_header (lcx, "1"b);
				l4_data (1) = "005"b3;
				l4_data (2) = "001"b3;
				l4_data (3) = bit (binary (i, 9));
				buffer.tally = hdr_size + 3 + L2_HEADER_PAD;
				call write_data_pkt;
				goto done_data_pkt;
				end;
			     else goto iti (i);

iti (0):						/* parameter indication */
			     do i = 2 by 2 to buffer.tally - hdr_size - L2_HEADER_PAD;
				if l4_data (i) = "00000000"b then goto done_data_pkt;

/*			     if substr (l4_data (i), 2, 1)
   then call syserr (Log_message_or_discard, "x25_mpx(^a): Unable to set X.29 parameter ^d to ^d.",
   xsce.name, binary (substr (l4_data (i), 3, 7), 7),
   binary (l4_data (i + 1), 8));
*/

				if xlce.flags.iti_break & (l4_data (i) = "000001000"b)
						/* & this is resume indication */
				     & (l4_data (i + 1) = "000000000"b) then do;
				     call free_in_pkt;
				     call confirm_interrupt;
				     xlce.flags.iti_break = "0"b;
				     end;
			     end;
			     goto done_data_pkt;

iti (1):						/* invitation to clear */
			     call free_in_pkt;
			     call clear_call (0);
			     goto done_in_pkt;

iti (2):						/* set parameters */
			     call set_x29 ("1"b, "0"b);
			     goto done_data_pkt;

iti (3):						/* indication of break */
			     if xlce.flags.iti_break then do;
				call channel_manager$interrupt (xsce.devx, QUIT, ""b);
				call free_in_pkt;
				call get_buffer (16);
				call make_header (lcx, "1"b);
				substr (string (l4_data), 1, 3 * 9) = "006010000"b3;
				buffer.tally = hdr_size + 3 + L2_HEADER_PAD;
						/* buffer length = 6 */
				call write_data_pkt;
				xsce.flags.end_of_page = "0"b;
				end;
			     goto done_data_pkt;

iti (4):						/* read parameters */
			     call set_x29 ("0"b, "1"b);
			     goto done_data_pkt;

iti (5):						/* error */
			     call syserr (Log_message, "x25_mpx(^a): X.29 ERROR ^d/^d", xsce.name,
				binary (l4_data (2), 9), binary (l4_data (3), 9));
			     goto done_data_pkt;

iti (6):						/* set and read parameters */
			     call set_x29 ("1"b, "1"b);
			     goto done_data_pkt;
			     end;
			goto done_data_pkt;
			end;

/* regular data packet received */

		     if xlce.flags.iti_break then goto done_data_pkt;

		     nchars = buffer.tally - hdr_size - L2_HEADER_PAD;
		     if nchars <= 0 then goto done_data_pkt;
						/* ignore empty packets */

		     substr (string (buffer.chars), 1, nchars) =
			substr (string (buffer.chars), hdr_size + L2_HEADER_PAD + 1, nchars);
		     buffer.tally = nchars;		/* delete the header */

		     rtx_info.output_in_ring_0 = (xsce.write_head ^= null ());
		     rtx_info.output_in_fnp = (xlce.next_send_seq ^= xlce.next_ack_seq);
		     rtx_info.input_count = rtx_info.input_count - hdr_size - L2_HEADER_PAD;

		     if xsce.trans_table_ptr ^= null () then do;
			do blockp = chain_ptr repeat (pointer (blockp, buffer.next)) while (rel (blockp) ^= ""b);
						/* walk chain for lfecho mode */
			     call mvt_ (addr (buffer.chars), addr (buffer.chars), (buffer.tally),
				xsce.trans_table_ptr -> based_trans_table);
			end;
			blockp = chain_ptr;
			end;

		     if xsce.flags.end_of_page & rtx_info.break_char then do;
			xsce.flags.end_of_page = "0"b;/* not any more */

			if (buffer.tally <= 2) & (buffer.next = 0)
			     & (verify (substr (string (buffer.chars), 1, buffer.tally), CR_LF_FF) = 0)
			then goto done_data_pkt;	/* no real input */
			end;

		     blockp = null ();		/* show buffer given away */
		     call tty_space_man$switch_chain (x25_data.devx, xsce.devx, INPUT, INPUT, chain_ptr);
		     call channel_manager$interrupt (xsce.devx, ACCEPT_INPUT, unspec (rtx_info));
		     goto done_data_pkt;
		     end;				/* regular data packet */
%page;
/* if RR packet */

		if (x25_pkt.type & SNMASK) = SNRR then do;
						/* if RR packet */
		     if xlce.state ^= FLOW_CONTROL_READY then do;
			call handle_data_or_fc_error;
			goto done_in_pkt;
			end;

		     call proc_pr (pr_error);		/* update output window */
		     if pr_error then goto done_in_pkt;

		     xlce.flags.rnr_received = "0"b;
		     call free_in_pkt;
		     call send_data_packets;
		     call send_output;
		     call solicit_output;
		     goto done_in_pkt;
		     end;

/* RNR packet */

		if (x25_pkt.type & SNMASK) = SNRNR then do;
						/* or if RNR packet */
		     if xlce.state ^= FLOW_CONTROL_READY then do;
			call handle_data_or_fc_error;
			goto done_in_pkt;
			end;

		     call proc_pr (pr_error);		/* extract p(r) */
		     if pr_error then goto done_in_pkt;

		     xlce.flags.rnr_received = "1"b;
		     call free_in_pkt;
		     goto done_in_pkt;
		     end;

/* REJ packet */

		if (x25_pkt.type & SNMASK) = SNREJ then do;
		     if xlce.state ^= FLOW_CONTROL_READY then do;
			call handle_data_or_fc_error;
			goto done_in_pkt;
			end;

		     call proc_pr (pr_error);
		     if pr_error then goto done_in_pkt; /* Take the first error we find. */

		     call syserr (Log_message, "x25_mpx(^a): Received REJ packet.", xsce.name);
		     call dump_pkt;
		     call reset_lc (37);
		     goto done_in_pkt;
		     end;
%page;
/* Call request packet */

		if x25_pkt.type = CALLRQ then do;	/* call request packet */
		     if xlce.state = FLOW_CONTROL_READY | xlce.state = DTE_RESET_REQUEST then do;
			call syserr (Log_message, "x25_mpx(^a): Call Request in state ^d.", xsce.name, xlce.state);
			call dump_pkt;
			call clear_call (23);
			end;

		     else call free_in_pkt;

		     goto done_in_pkt;
		     end;

/* Call accepted packet */

		if x25_pkt.type = CALLAC then do;	/* if call accepted */
		     if xlce.state = DTE_WAITING then do;
			if protocol_mpx & ^xlce.iti_call then do;
						/* if ISO... */
			     call set_up_dialup_info;
			     call channel_manager$interrupt (xsce.devx, USER_INTERRUPT, unspec (dialup_info));
			     xsce.state = SC_DIALED;
			     xlce.state = FLOW_CONTROL_READY;
			     call reset_timer;
			     xsce.flags.output_ready = "1"b;
			     call channel_manager$interrupt (xsce.devx, SEND_OUTPUT, ""b);
			     end;
			else call signal_dialup;
			call free_in_pkt;
			goto done_in_pkt;
			end;

		     call syserr (Log_message, "x25_mpx(^a): Call Confirm in state ^d.", xsce.name, xlce.state);
		     call dump_pkt;
		     call clear_call (16);
		     goto done_in_pkt;
		     end;				/* call accepted packet */

/* Clear indication packet */

		if x25_pkt.type = CLRRQ then do;	/* if clear indication packet */
		     if protocol_mpx & (x25_pkt.no_fc_data (1) ^= ""b)
			| ^protocol_mpx & ((x25_pkt.no_fc_data (1) ^= ""b) | (x25_pkt.no_fc_data (2) ^= ""b))
		     then call syserr (Log_message_or_discard, "x25_mpx(^a): Clear Indication ^d/^d.", xsce.name,
			     binary (x25_pkt.no_fc_data (1), 8), binary (x25_pkt.no_fc_data (2), 8));
		     if protocol_mpx then do;
			disconnect_info.cause = x25_pkt.no_fc_data (1);
			disconnect_info.diag = x25_pkt.no_fc_data (2);
			end;
		     call free_in_pkt;
		     if xlce.state ^= DTE_CLEAR_REQUEST then call clear_confirm;
		     call proc_clear;
		     goto done_in_pkt;
		     end;				/* CLRRQ packet */

/* clear confirmation packet */

		if x25_pkt.type = CLRCN then do;	/* if clear confirmation packet */
		     if xlce.state ^= DTE_CLEAR_REQUEST then do;
			call syserr (Log_message, "x25_mpx(^a): Clear Confirm in state ^d.", xsce.name, xlce.state);
			call dump_pkt;
			call clear_call (16);
			end;

		     else do;
			call proc_clear;
			call free_in_pkt;
			end;

		     goto done_in_pkt;
		     end;				/* CLRCN packet */
%page;
/* DTE logical channel input */

		if xlce.state = DTE_CLEAR_REQUEST then do;
		     call free_in_pkt;		/* if clear request issued, ignore data packets */
		     goto done_in_pkt;
		     end;

		if xlce.state = DTE_WAITING | (protocol_mpx & (xlce.state = CONRESP_WAITING)) then do;
		     call syserr (Log_message, "x25_mpx(^a): Data packet received in state ^d.", xsce.name,
			xlce.state);
		     call dump_pkt;
		     call clear_call (16);
		     goto done_in_pkt;
		     end;

/* reset indication packet */

		if x25_pkt.type = RESTRQ then do;	/* if reset indication packet */
		     if xlce.state ^= DTE_RESET_REQUEST then do;
						/* if reset request issued */
			call syserr (Log_message, "x25_mpx(^a): Reset received ^d/^d", xsce.name,
			     binary (x25_pkt.no_fc_data (1), 8), binary (x25_pkt.no_fc_data (2), 8));
			call dump_pkt;
			call get_buffer (16);
			call make_header (lcx, "0"b);
			x25_pkt.type = RESTCN;
			buffer.tally = 3 + L2_HEADER_PAD;
			call write_pkt;
			call send_output;
			end;
		     else call free_in_pkt;

		     call proc_reset_lc;
		     goto done_in_pkt;
		     end;				/* reset indication servicing */

/* reset confirmation packet */

		if x25_pkt.type = RESTCN then do;	/* if reset confirmation packet */
		     if xlce.state = DTE_RESET_REQUEST	/* if DTE reset request was issued */
		     then do;
			call proc_reset_lc;		/* then this acks it */
			call free_in_pkt;
			end;
		     else do;
			call syserr (Log_message, "x25_mpx(^a): Reset Confirm in state ^d.", xsce.name, xlce.state);
			call dump_pkt;
			call reset_lc (16);		/* otherwise a protocol error has occurred */
			end;
		     goto done_in_pkt;
		     end;				/* reset confirmation servicing */
%page;
/* check flow-control state */

		if xlce.state ^= FLOW_CONTROL_READY then do;
		     call free_in_pkt;
		     goto done_in_pkt;
		     end;

/* Interrupt Packet */

		if x25_pkt.type = SNITRQ then do;	/* if interrupt packet */
		     call free_in_pkt;
		     if xlce.iti_call & xsce.mode (MODE_HNDLQUIT)
						/* if ITI call */
		     then do;
			xlce.flags.iti_break = "1"b;	/* show break service in progress */
			end;
		     else do;
			call channel_manager$interrupt (xsce.devx, QUIT, ""b);
						/* notify higher level of interrupt */
			call confirm_interrupt;
			xsce.flags.end_of_page = "0"b;
			end;
		     goto done_in_pkt;
		     end;				/* interrupt packet servicing */

/* interrupt confirnation received */

		if x25_pkt.type = SNITCN then do;	/* if interrupt confrimation received */
		     if ^xlce.flags.int_issued then do; /* if we have not issued an interrupt request */
			call syserr (Log_message, "x25_mpx(^a): Unexpected Interrupt Confirm.", xsce.name);
			call dump_pkt;
			call reset_lc (43);
			end;
		     else do;
			xlce.flags.int_issued = "0"b; /* show confirmation received */
			call free_in_pkt;
			end;
		     goto done_in_pkt;
		     end;				/* interrupt confirmation servicing */

		call syserr (Log_message, "x25_mpx(^a): Unexpected packet type ^.4b", xsce.name, x25_pkt.type);
		call dump_pkt;
		call reset_lc (32);
		goto done_in_pkt;
		end;
%page;
/* Come here if there is no connection for the packet */

	     else do;				/* incoming call packet */

/* Call Indication */

		if x25_pkt.type = CALLRQ then do;
		     if xlce.state ^= READY then do;	/* if DTE ready */
			call syserr (Log_message, "x25_mpx(^a/^d): Call Request in state ^d.", x25_data.name, lcx,
			     xlce.state);
			call dump_pkt;
			call clear_call (16);
			goto done_in_pkt;
			end;

		     calling_dte_addr_length = binary (substr (x25_pkt.no_fc_data (1), 2, 4), 4);
		     called_dte_addr_length = binary (substr (x25_pkt.no_fc_data (1), 6, 4), 4);
		     facility_disp = 2 + divide (1 + calling_dte_addr_length + called_dte_addr_length, 2, 6, 0);
		     facility_length = binary (substr (x25_pkt.no_fc_data (facility_disp), 4, 6), 6);

		     do i = 2 to facility_disp - 1;	/* convert addresses */
			unspec (substr (addr_string, 2 * i - 3, 1)) =
			     "00011"b || substr (x25_pkt.no_fc_data (i), 2, 4);
			unspec (substr (addr_string, 2 * i - 2, 1)) =
			     "00011"b || substr (x25_pkt.no_fc_data (i), 6, 4);
		     end;
		     xlce.his_address = substr (addr_string, 1 + called_dte_addr_length, calling_dte_addr_length);

		     user_data_disp = facility_disp + facility_length + 1;
		     user_data_length = buffer.tally - 2 - user_data_disp - L2_HEADER_PAD;
		     if protocol_mpx then do;
			xlce.baud_rate = DEFAULT_BAUD;
			xlce.call_data = "";
			if user_data_length >= 4 & x25_pkt.no_fc_data (user_data_disp) = "000000001"b then do;
						/*  --- X29 call --- */
			     xlce.flags.iti_call = "1"b;
			     if user_data_length > 4 then do;
						/* There is some complementary data */
				Call_data = substr (l3_call_data, 5);
				call mvt_ (addr (Call_data), addr (Call_data),
						/* suppresion of the eighth bit (parity) of call data */
				     user_data_length - 4, (x25_mpx_data$trans_no_parity));
				xlce.call_data = substr (Call_data, 1, user_data_length - 4);
				end;
			     scx = find_sc (xlce.call_data);
			     if scx = 0 then scx = find_sc ("");
			     if (scx = 0) | ^x25_data.flags.mpx_started then do;
				call syserr (Log_message, "x25_mpx(^a/^d): No listening channels. , scx=^d",
				     x25_data.name, lcx, scx);
				call dump_pkt;
				call clear_call (64);
				goto done_in_pkt;
				end;

			     call check_facilities ();
			     xscep = addr (x25_data.sc (scx));
			     xsce.lcx = lcx;
			     xlce.scx = scx;
			     call free_in_pkt;
			     call send_NCON_RESP;
			     call signal_dialup;
			     goto done_in_pkt;
			     end;			/* X29 call */
			else do;			/* non X29 call */
			     if ^x25_data.flags.mpx_started then do;
						/* no protocol channel */
				call syserr (Log_message, "x25_mpx(^a/^d): No listening ISO_channels.",
				     x25_data.name, lcx);
				call dump_pkt;
				call clear_call (64);
				goto done_in_pkt;
				end;
			     xscep = addr (x25_data.sc (scx));
						/* One has a channel, one signals the connection... */
			     xsce.lcx = lcx;
			     xlce.scx = scx;
			     xlce.call_data = l3_call_data;
			     xsce.trans_table_ptr = null ();
			     NCON_IND_info.his_address = xlce.his_address;
			     NCON_IND_info.our_address = x25_data.my_address;
			     NCON_IND_info.data = l3_call_data;
			     NCON_IND_info.facilities = l3_facilities;
			     call set_up_dialup_info;
			     unspec (NCON_IND_info.dial_info) = unspec (dialup_info);
			     call free_in_pkt;
			     call get_buffer (32);
			     call tty_space_man$switch_chain (x25_data.devx, xsce.devx, OUTPUT, INPUT, blockp);
			     unspec (DIALUP_info) = "0"b;
			     DIALUP_info.info_relp = rel (blockp);
			     N_I_i = NCON_IND_info;
			     buffer.next = 0;
			     string (buffer.flags) = ""b;
			     buffer.tally = size (NCON_IND_info) * 4;
			     xsce.state = SC_DIALING;
			     call state_change (CONRESP_WAITING);
			     call channel_manager$interrupt (xsce.devx, DIALUP, unspec (DIALUP_info));
			     goto done_in_pkt;
			     end;
			end;
		     else do;
			xlce.baud_rate = x25_data.dialup_info.baud_rate;
			if user_data_length >= 4 then do;
			     xlce.call_data = substr (l3_call_data, 5);
			     if x25_pkt.no_fc_data (user_data_disp) = "000000001"b then do;
				xlce.flags.iti_call = "1"b;
				end;
			     end;
			else xlce.call_data = "";

			scx = find_sc (xlce.call_data);
						/* find appropriate server */
			if scx = 0 then scx = find_sc ("");
						/* or null server by default */
			if (scx = 0) | ^x25_data.flags.mpx_started then do;
			     call syserr (Log_message, "x25_mpx(^a/^d): No listening channels.", x25_data.name, lcx)
				;
			     call dump_pkt;
			     call clear_call (64);
			     goto done_in_pkt;
			     end;

			xscep = addr (x25_data.sc (scx));
			xsce.lcx = lcx;
			xlce.scx = scx;
			call free_in_pkt;
			call get_buffer (16);
			call make_header (lcx, "0"b);
			x25_pkt.type = CALLAC;
			buffer.tally = 3 + L2_HEADER_PAD;
			call write_pkt;
			call send_output;
			call signal_dialup;
			goto done_in_pkt;
			end;
		     end;				/* Call request packet */

/* Clear Indication */

		if x25_pkt.type = CLRRQ then do;
		     call syserr (Log_message_or_discard, "x25_mpx(^a/^d): Clear Indication ^d/^d on idle VC.",
			x25_data.name, lcx, binary (x25_pkt.no_fc_data (1), 8), binary (x25_pkt.no_fc_data (2), 8));
		     call dump_pkt;
		     if xlce.state ^= DTE_CLEAR_REQUEST then call clear_confirm;
		     call reset_xlce;		/* xsce already reset since this is an idle VC. */
		     goto done_in_pkt;
		     end;

/* Clear Confirm */

		if x25_pkt.type = CLRCN then do;
		     if xlce.state = DTE_CLEAR_REQUEST then do;
			call reset_xlce;
			call free_in_pkt;
			goto done_in_pkt;
			end;

		     else do;
			call syserr (Log_message_or_discard,
			     "x25_mpx(^a/^d): Clear Confirm in state ^d on idle VC.", x25_data.name, lcx,
			     xlce.state);
			call free_in_pkt;
			call clear_call (20);
			goto done_in_pkt;
			end;
		     end;				/* CLRCN packet */

/* Anything else */

		call syserr (Log_message, "x25_mpx(^a/^d); Unexpected packet type ^.4b on idle VC.", x25_data.name,
		     lcx, x25_pkt.type);
		call dump_pkt;
		call clear_call (20);
		goto done_in_pkt;
		end;
	     end;
%page;
/* Waiting for restart */

	else if x25_data.state = X25_RESTARTING then do;
	     if ((x25_pkt.type = RSRTRQ) | (x25_pkt.type = RSRTCN)) & (lcx = 0) then do;
		call mcs_timer$reset (x25_data.devx, 0, ""b);
		x25_data.state = X25_ACTIVE;
		call pxss$ring_0_wakeup (x25_data.load_proc_id, x25_data.load_ev_chan, MPX_UP, code);
		end;
	     call free_in_pkt;
	     goto done_in_pkt;
	     end;

/* Link not up yet */

	else do;
	     call free_in_pkt;
	     goto done_in_pkt;
	     end;
%page;
done_in_pkt:
	return;


done_data_pkt:					/* might have to send a RR */
	if blockp ^= null () then call free_in_pkt;
	if xlce.state = FLOW_CONTROL_READY then do;
	     call send_data_packets;
	     call send_output;
	     call solicit_output;
	     call send_rr;
	     end;
	return;


/* * * * * * * * * * ADD_ITI_MODE * * * * * * * * * */

add_iti_mode:
     procedure (Mode, Id, True, False);

dcl  Mode fixed bin parameter;
dcl  (Id, True, False) uns fixed bin (9) parameter;

	if xsce.mode (Mode)
	then call add_iti_param (Id, True);
	else call add_iti_param (Id, False);
	return;
     end add_iti_mode;

/* * * * * * * * * * ADD_ITI_PARAM * * * * * * * * * */

add_iti_param:
     procedure (Id, Value);

dcl  (Id, Value) uns fixed bin (9) parameter;

	nchars = nchars + 2;
	l4_data (nchars - 1) = bit (Id);
	l4_data (nchars) = bit (Value);
	return;
     end add_iti_param;

/* * * * * * * * * CLEAR_CALL * * * * * * * * */

clear_call:
     procedure (Cause);

dcl  Cause uns fixed bin (9) parameter;

	call get_buffer (16);
	call make_header (lcx, "0"b);
	x25_pkt.type = CLRRQ;
	x25_pkt.no_fc_data (2) = bit (Cause);
	buffer.tally = 5 + L2_HEADER_PAD;
	call write_pkt;
	call send_output;
	call state_change (DTE_CLEAR_REQUEST);
	return;
     end clear_call;

/* * * * * * * * * CLEAR_CONFIRM * * * * * * * * * */

clear_confirm:
     procedure;

	call get_buffer (16);
	call make_header (lcx, "0"b);
	x25_pkt.type = CLRCN;
	buffer.tally = 3 + L2_HEADER_PAD;
	call write_pkt;
	call send_output;
	return;
     end clear_confirm;

/* * * * * * * * * * CONFIRM_INTERRUPT * * * * * * * * * */

confirm_interrupt:
     procedure;

	call get_buffer (16);
	call make_header (lcx, "0"b);
	x25_pkt.type = SNITCN;
	buffer.tally = 3 + L2_HEADER_PAD;		/* length of buffer = 3 */
	call write_pkt;
	call send_output;
	return;
     end confirm_interrupt;

/* * * * * * * * * * CRASH_SUBCHANNELS * * * * * * * * * * */

crash_subchannels:
     procedure;

	do lcx = 1 to x25_data.n_lc;
	     xlcep = addr (x25_lces.lc (lcx));
	     call reset_xlce;
	end;
	do scx = 1 to x25_data.n_sc;
	     xscep = addr (x25_data.sc (scx));
	     call reset_xsce;
	end;
	return;
     end crash_subchannels;

/* * * * * * * * * * DUMP_PKT * * * * * * * * */

dump_pkt:
     procedure;

dcl  1 dump_buf (buffer.tally) unaligned based (addr (buffer.chars)),
       2 pad bit (1),
       2 byte bit (8);

	call syserr (Log_message_or_discard, "x25_mpx(^a):^( ^.4b^)", x25_data.name, dump_buf.byte (*));
	call free_in_pkt;
	return;
     end dump_pkt;

/* * * * * * * * * * FIND_SC * * * * * * * * * */

find_sc:
     procedure (Call_data) returns (fixed bin);

dcl  Call_data varying char (16) parameter;
dcl  scx fixed bin;

	do scx = 1 to x25_data.n_sc;
	     if (x25_data.sc (scx).state = SC_LISTENING) & (x25_data.sc (scx).service = Call_data) then return (scx);
	end;
	return (0);
     end find_sc;

/* * * * * * * * * FREE_IN_PKT * * * * * * * * * */

free_in_pkt:
     procedure;

	call tty_space_man$free_chain (x25_data.devx, INPUT, blockp);
	blockp = null ();
	return;
     end free_in_pkt;

/* * * * * * * * * * FREE_WRITE_CHAIN * * * * * * * * * */

free_write_chain:
     procedure;

	if xsce.write_head ^= null () then do;
	     call tty_space_man$free_chain (xsce.devx, OUTPUT, xsce.write_head);
	     xsce.write_head, xsce.write_tail = null ();
	     xsce.flags.end_of_page = "0"b;		/* Fix the flags since we just threw */
	     xsce.flags.long_packet_pending = "0"b;	/* away what they applied to. */
	     end;
	return;
     end free_write_chain;

/* * * * * * * * * * FREE_X25_DATA_CHAIN * * * * * * * * * */

free_x25_data_chain:
     procedure;

	if x25_data.write_head ^= null () then do;
	     call tty_space_man$free_chain (x25_data.devx, OUTPUT, x25_data.write_head);
	     x25_data.write_head, x25_data.write_tail = null ();
	     end;
	return;
     end free_x25_data_chain;

/* * * * * * * * * * GET_BUFFER * * * * * * * * * */

get_buffer:
     procedure (Size);

dcl  Size fixed bin parameter;

	call tty_space_man$get_buffer (x25_data.devx, Size, OUTPUT, blockp);
	endp = blockp;
	if blockp = null () then do;			/* Big trouble, crash the multiplexer. */
	     call free_x25_data_chain ();		/* Get rid of pending output. */
	     call syserr (Log_message, "x25_mpx(^a): No buffers available", x25_data.name);
	     call channel_manager$control (x25_data.devx, "hangup", null (), code);
						/* Crash ourself. */
	     goto done_in_pkt;			/* Non-local goto because callers can't handle blockp = null. */
	     end;
	return;
     end get_buffer;

/* * * * * * * * * HANDLE_DATA_OR_FC_ERROR * * * * * * * * * */

handle_data_or_fc_error:
     procedure;

	if xlce.state = DTE_CLEAR_REQUEST | xlce.state = DTE_RESET_REQUEST
	then call free_in_pkt;			/* Just discard. */
	else do;					/* Clear the lc with the right diagnostic. */
	     call syserr (Log_message, "x25_mpx(^a): Data or flow control packet received in state ^d.", xsce.name,
		xlce.state);
	     call dump_pkt;
	     if xlce.state = READY
	     then call clear_call (20);
	     else call clear_call (21);		/* Must be DTE_WAITING state. */
	     end;
     end handle_data_or_fc_error;

/* * * * * * * * * * MAKE_HEADER * * * * * * * * * */

make_header:
     procedure (Lcn, Q);
dcl  Lcn uns fixed bin (12) parm;
dcl  Q bit aligned parm;

	string (x25_pkt.l3_header) = ""b;
	x25_pkt.l3_header.q = Q;
	x25_pkt.l3_header.format = x25_data.gfid;
	x25_pkt.l3_header.lcgn = substr (bit (Lcn), 1, 4);
	x25_pkt.l3_header.lcn = substr (bit (Lcn), 5, 8);
	if xlcep = null () then do;
	     l4_data_ptr = null ();
	     hdr_size = 0;
	     end;
	else if x25_data.seq_mod = 8 then do;
	     l4_data_ptr = addr (m8_fc_data.user_data);
	     hdr_size = 3;
	     end;
	else do;
	     l4_data_ptr = addr (m128_fc_data.user_data);
	     hdr_size = 4;
	     end;
	return;
     end make_header;

/* * * * * * * * * PROC_CLEAR * * * * * * * * * */

proc_clear:
     procedure;

	call reset_xlce;
	call reset_xsce;
	return;
     end proc_clear;

/* * * * * * * * * * PROC_PR * * * * * * * * * */

proc_pr:
     procedure (error_flag);

dcl  error_flag bit (1) unaligned parameter;
dcl  temp_pr unsigned fixed bin (7);

	error_flag = "0"b;

	xlce.flags.write_status_sync_sent = "0"b;	/* Well, he said something. */

	if x25_data.seq_mod = 8
	then temp_pr = m8_fc_data.pr;
	else temp_pr = m128_fc_data.pr;

/*
   Check that next_ack_seq <= temp_pr <= next_send_seq, in clock order.
   That is, that the packet sequence number that he says he received is
   between the last sequence number he says he received, and the next
   sequence number we will send out (clockwise).
*/

	if (xlce.next_ack_seq <= temp_pr & temp_pr <= xlce.next_send_seq)
	     | (xlce.next_send_seq <= xlce.next_ack_seq & xlce.next_ack_seq <= temp_pr)
	     | (temp_pr <= xlce.next_send_seq & xlce.next_send_seq <= xlce.next_ack_seq)
	then xlce.next_ack_seq = temp_pr;

	else do;					/* Log the error. */
	     error_flag = "1"b;
	     call syserr (Log_message,
		"x25_mpx(^a): Sequence error:  P(R) (= ^d) is not between previous P(R) (= ^d) and V(S) (= ^d).",
		xsce.name, temp_pr, xlce.next_ack_seq, xlce.next_send_seq);
	     call dump_pkt;
	     call reset_lc (2);
	     end;					/* Log the error. */

	return;
     end proc_pr;

/* * * * * * * * * * PROC_RESET_LC * * * * * * * * * */

proc_reset_lc:
     procedure;

	call reset_seq_nos;
	call free_write_chain ();			/* discard possible pending output. */
	xlce.state = FLOW_CONTROL_READY;
	call reset_timer;

/* Reset our state flags since we are going back to our initial state. */

	xlce.flags.iti_break = "0"b;
	xlce.flags.int_issued = "0"b;
	xlce.flags.rnr_received = "0"b;
	xlce.flags.write_status_sync_sent = "0"b;

/* Now let the user know something happened, and make sure he can send output again. */

	call channel_manager$interrupt (xsce.devx, LINE_STATUS, "1"b);
						/* the value does not really matter. */
	call solicit_output ();

	return;
     end proc_reset_lc;

/* * * * * * * * * * RESET_LC * * * * * * * * * */

reset_lc:
     procedure (Cause);

dcl  Cause uns fixed bin (9) parameter;

	call get_buffer (16);
	call make_header (lcx, "0"b);
	x25_pkt.type = RESTRQ;
	x25_pkt.no_fc_data (2) = bit (Cause);
	buffer.tally = 5 + L2_HEADER_PAD;
	call write_pkt;
	call send_output;
	call state_change (DTE_RESET_REQUEST);

	xlce.flags.iti_break, xlce.flags.int_issued, xlce.flags.rnr_received, xlce.flags.write_status_sync_sent = "0"b;
	return;
     end reset_lc;

/* * * * * * * * * * RESET_SEQ_NOS * * *  * * * * * * */

reset_seq_nos:
     procedure;

	xlce.next_recv_seq, xlce.next_send_seq, xlce.last_recv_seq, xlce.next_ack_seq = 0;
	return;
     end reset_seq_nos;

/* * * * * * * * * * RESET_TIMER * * * * * * * * * */

reset_timer:
     procedure;

	if xlce.flags.timer_set then do;
	     call mcs_timer$reset (x25_data.devx, (lcx), ""b);
	     xlce.flags.timer_set = "0"b;
	     end;
	return;
     end reset_timer;

/* * * * * * * * * * * RESET_XLCE * * * * * * * * * * */

reset_xlce:
     procedure;

	call reset_seq_nos;
	call reset_timer;
	string (xlce.flags) = ""b;
	xlce.iti_params (*) = 0;

	if lcx <= x25_data.n_pvc then do;
	     xlce.state = FLOW_CONTROL_READY;
	     end;
	else do;
	     xlce.state = READY;
	     xlce.scx = 0;
	     end;
	return;
     end reset_xlce;

/* * * * * * * * * RESET_XSCE * * * * * * * * * */

reset_xsce:
     procedure;

	call free_write_chain;
	string (xsce.mode) = ""b;
	string (xsce.flags) = ""b;
	if /* case */ xsce.state = SC_DIALING then do;
	     if protocol_mpx
	     then call channel_manager$interrupt (xsce.devx, DIAL_STATUS,
		     "122"b3 || (27)"0"b || unspec (disconnect_info));
	     else call channel_manager$interrupt (xsce.devx, DIAL_STATUS, "122"b3);
	     end;
	else if xsce.state > SC_HUNGUP then do;
	     if protocol_mpx then do;
		if x25_data.state = X25_ACTIVE
		then call channel_manager$interrupt (xsce.devx, HANGUP, (36)"0"b || unspec (disconnect_info));
		else call channel_manager$interrupt (xsce.devx, CRASH, (36)"0"b || unspec (disconnect_info));
		end;
	     else do;
		if x25_data.state = X25_ACTIVE
		then call channel_manager$interrupt (xsce.devx, HANGUP, ""b);
		else call channel_manager$interrupt (xsce.devx, CRASH, ""b);
		end;
	     end;
	xsce.state = SC_HUNGUP;
	xsce.lcx = 0;
	return;
     end reset_xsce;

/* * * * * * * * * * RESTART * * * * * * * * * */

restart:
     procedure (Cause);

dcl  Cause uns fixed bin (9) parameter;

	call get_buffer (16);
	call make_header (0, "0"b);
	x25_pkt.type = RSRTRQ;			/* restart request packet */
	x25_pkt.no_fc_data (2) = bit (Cause);
	buffer.tally = 5 + L2_HEADER_PAD;		/* length of restart packet = 4 */
	call write_pkt;
	call send_output;
	x25_data.state = X25_RESTARTING;
	x25_data.restart_time = clock ();
	call mcs_timer$set (x25_data.devx, 0, x25_data.restart_time + T20, ""b);
	return;
     end restart;

/* * * * * * * * * * SEND_DATA_PACKETS * * * * * * * * * */

send_data_packets:
     procedure;

dcl  pkt_size fixed bin;

	if xsce.flags.long_packet_pending | xlce.flags.rnr_received then return;

	do while ((mod (xlce.next_send_seq - xlce.next_ack_seq, x25_data.seq_mod) < xlce.max_window_size)
	     & (xsce.write_head ^= null ()));

	     blockp = xsce.write_head;
	     pkt_size = buffer.tally;
	     do endp = blockp repeat pointer (endp, endp -> buffer.next) while (^endp -> buffer.flags.break);
		pkt_size = pkt_size + buffer.tally;
	     end;

	     if (pkt_size >= x25_data.long_packet_size)
		& (^x25_data.flags.send_output | (x25_data.write_head ^= null ())) then do;
		xsce.flags.long_packet_pending = "1"b;	/* thread into the long packet list */
		xsce.long_packet_next_scx = 0;
		if x25_data.long_packet_head = 0
		then x25_data.long_packet_head = scx;
		else x25_data.sc (x25_data.long_packet_tail).long_packet_next_scx = scx;
		x25_data.long_packet_tail = scx;
		return;
		end;

	     if endp -> buffer.next = 0
	     then xsce.write_head, xsce.write_tail = null ();
	     else xsce.write_head = pointer (endp, endp -> buffer.next);
	     endp -> buffer.next = 0;

	     if x25_data.seq_mod = 8 then do;
		m8_fc_data.ps = xlce.next_send_seq;
		m8_fc_data.pr = xlce.next_recv_seq;
		end;
	     else do;
		m128_fc_data.ps = xlce.next_send_seq;
		m128_fc_data.pr = xlce.next_recv_seq;
		end;

	     call write_pkt;

	     xlce.next_send_seq = mod (xlce.next_send_seq + 1, x25_data.seq_mod);
	     xlce.last_recv_seq = xlce.next_recv_seq;	/* increment V(S) */
	end;
	return;
     end send_data_packets;

/* * * * * * * * * SEND_DIAG * * * * * * * * * */

send_diag:
     procedure (Cause);

dcl  Cause uns fixed bin (9) parameter;

	call get_buffer (16);
	call make_header (0, "0"b);
	x25_pkt.type = DIAG;
	x25_pkt.no_fc_data (1) = bit (Cause);
	buffer.tally = 4 + L2_HEADER_PAD;
	call write_pkt;
	call send_output;
	return;
     end send_diag;

/* * * * * * * * * * SEND_OUTPUT * * * * * * * * * *  */

send_output:
     procedure;

	if x25_data.flags.send_output & (x25_data.write_head ^= null ()) then do;
	     x25_data.flags.send_output = "0"b;
	     call channel_manager$write (x25_data.devx, x25_data.write_head, code);
	     if code ^= 0 then do;
		call syserr (Log_message, "x25_mpx(^a): Error ^w from write.", x25_data.name, code);
		call channel_manager$control (x25_data.devx, "hangup", null (), code);
		end;
	     if x25_data.write_head = null () then x25_data.write_tail = null ();
	     end;
	return;
     end send_output;

/* * * * * * * * * SEND_RR * * * * * * * * * */

send_rr:
     procedure;

dcl  packets_out fixed bin (7);

	ttybp = addr (tty_buf$);
	lctep = addr (tty_buf.lct_ptr -> lct.lcte_array (xsce.devx));
	packets_out = mod (xlce.next_recv_seq - xlce.last_recv_seq, x25_data.seq_mod);

	if (3 * lcte.input_words) < tty_buf.bleft
	then if (clock () > xlce.force_ack_time) | (packets_out >= xlce.max_window_size) | xlce.flags.rnr_sent then do;
		call get_buffer (16);
		call make_header (lcx, "0"b);
		x25_pkt.type = SNRR;
		if x25_data.seq_mod = 8
		then m8_fc_data.pr = xlce.next_recv_seq;
		else m128_fc_data.pr = xlce.next_recv_seq;
		buffer.tally = hdr_size + L2_HEADER_PAD;
		call write_pkt;
		call send_output;
		xlce.last_recv_seq = xlce.next_recv_seq;
		call reset_timer;
		xlce.flags.rnr_sent = "0"b;
		end;
	     else if packets_out = 0 then ;
	     else call set_timer (TIMEOUT);

	else do;
	     if ^xlce.flags.rnr_sent then do;
		call get_buffer (16);
		call make_header (lcx, "0"b);
		x25_pkt.type = SNRNR;
		if x25_data.seq_mod = 8
		then m8_fc_data.pr = xlce.next_recv_seq;
		else m128_fc_data.pr = xlce.next_recv_seq;
		buffer.tally = hdr_size + L2_HEADER_PAD;
		call write_pkt;
		call send_output;
		xlce.last_recv_seq = xlce.next_recv_seq;
		xlce.flags.rnr_sent = "1"b;
		end;
	     call set_timer (TIMEOUT);
	     end;

	return;
     end send_rr;

/* * * * * * * * * * SEND_SYNC * * * * * * * * * */

send_sync:
     procedure;

	if (^x25_data.flags.no_d | ((x25_data.net_type = "tymnet") & (xsce.write_head = null ())))
	     & ^xlce.flags.rnr_received then do;
	     call get_buffer (16);			/* write an empty packet */
	     call make_header (lcx, "0"b);
	     if ^x25_data.flags.no_d then x25_pkt.l3_header.d = "1"b;
	     buffer.tally = hdr_size + L2_HEADER_PAD;
	     call write_data_pkt;
	     xlce.flags.write_status_sync_sent = "1"b;	/* We sent one, don't do it again until we hear something. */
	     end;
	return;
     end send_sync;

/* * * * * * * * * * SET_TIMER * * * * * * * * * */

set_timer:
     procedure (Time);

dcl  Time fixed bin (71) parameter;

	if ^xlce.flags.timer_set then do;
	     call mcs_timer$set (x25_data.devx, (lcx), clock () + Time, ""b);
	     xlce.flags.timer_set = "1"b;
	     end;
	return;
     end set_timer;

/* * * * * * * * * SET_X29 * * * * * * * * * */

set_x29:
     procedure (Set, Write);

dcl  (Set, Write) bit (1) aligned parameter;
dcl  write bit (1) aligned;
dcl  (i, p) fixed bin;

	write = Write;
	if Set then do;
	     do i = 2 by 2 to buffer.tally - hdr_size - L2_HEADER_PAD;
		p = binary (substr (l4_data (i), 3, 7), 7);
		if (p < lbound (xlce.iti_params, 1)) | (p > hbound (xlce.iti_params, 1)) then do;
		     write = "1"b;
		     substr (l4_data (i), 2, 1) = "1"b;
		     end;
		else xlce.iti_params (p) = binary (l4_data (i + 1), 8);
	     end;
	     if xsce.flags.need_ftd then do;
		call channel_manager$interrupt (xsce.devx, LINE_STATUS, ""b);
		xsce.flags.need_ftd = "0"b;
		end;
	     end;

	if write then do;

/* In case there is no parameter list following the request it ought to point you to the parameters. */

	     if protocol_mpx then do;
		if buffer.tally < hdr_size + L2_HEADER_PAD + 2 then do;
		     call free_in_pkt;		/* free the buffer that arrived */
		     call get_buffer (16);		/* allocate a larger buffer. */
		     call make_header (lcx, "1"b);
		     l4_data (1) = "000"b3;
		     do i = 1 to lbound (xlce.iti_params, 1) - 1;
						/* not precise arguments */
			l4_data (2 * i) = substr (unspec (i), 27, 9);
			l4_data (2 * i + 1) = "000"b3;
		     end;
		     do i = lbound (xlce.iti_params, 1) to hbound (xlce.iti_params, 1);
			l4_data (2 * i) = substr (unspec (i), 27, 9);
			l4_data (2 * i + 1) = bit (xlce.iti_params (i));
		     end;
		     buffer.tally = hdr_size + L2_HEADER_PAD + 2 * hbound (xlce.iti_params, 1) + 1;
		     call write_data_pkt;
		     return;
		     end;
		end;
	     l4_data (1) = "000"b3;
	     do i = 2 by 2 to buffer.tally - hdr_size - L2_HEADER_PAD;
		p = binary (substr (l4_data (i), 3, 7), 7);
		if (p >= lbound (xlce.iti_params, 1)) & (p <= hbound (xlce.iti_params, 1))
		then l4_data (i + 1) = bit (xlce.iti_params (p));
	     end;
	     call tty_space_man$switch_chain (x25_data.devx, x25_data.devx, INPUT, OUTPUT, chain_ptr);
	     call write_data_pkt;
	     end;
	return;
     end set_x29;

/* * * * * * * * * * SETUP_SUBCHAN * * * * * * * * * */

setup_subchan:
     procedure;

	x25_data_ptr = X25_data_ptr;
	scx = X25_scx;
	xscep = addr (x25_data.sc (scx));
	lcx = xsce.lcx;
	if lcx = 0
	then xlcep = null ();
	else xlcep = addr (x25_lces.lc (xsce.lcx));
	return;
     end setup_subchan;

/* * * * * * * * * * SIGNAL_DIALUP * * * * * * * * * */

signal_dialup:
     procedure;

	dialup_info = x25_data.dialup_info;
	dialup_info.line_type = LINE_ASCII;		/* we simulate ASCII lines */
	dialup_info.baud_rate = xlce.baud_rate;
	if x25_data.seq_mod = 8
	then dialup_info.buffer_pad = dialup_info.buffer_pad + 3 + L2_HEADER_PAD;
						/* 3 bytes in L3 header */
	else dialup_info.buffer_pad = dialup_info.buffer_pad + 4 + L2_HEADER_PAD;
						/* 4 bytes in L3 header */
	dialup_info.max_buf_size = min (dialup_info.max_buf_size, divide (xlce.max_packet_size, 4, 9, 0));
	call channel_manager$interrupt (xsce.devx, DIALUP, unspec (dialup_info));
	xsce.state = SC_DIALED;
	xlce.state = FLOW_CONTROL_READY;
	call reset_timer;
	xsce.flags.output_ready = "1"b;
	call channel_manager$interrupt (xsce.devx, SEND_OUTPUT, ""b);
	return;
     end signal_dialup;

/* * * * * * * * * * SOLICIT_OUTPUT * * * * * * * * * */

solicit_output:
     procedure;

	if ^xsce.flags.output_ready & ^xsce.flags.end_of_page & ^xlce.flags.iti_break & (xsce.write_head = null ())
	then do;
	     xsce.flags.output_ready = "1"b;
	     call channel_manager$interrupt (xsce.devx, SEND_OUTPUT, ""b);
	     end;
	return;
     end solicit_output;

/* * * * * * * * * * STATE_CHANGE * * * * * * * * */

state_change:
     procedure (State);

dcl  State fixed bin;

	xlce.state = State;
	xlce.state_time = clock ();
	call reset_timer;
	call set_timer (T20);
	return;
     end state_change;

/* * * * * * * * * * WRITE_DATA_PACKET * * * * * * * * * */

write_data_pkt:
     procedure;

	endp -> buffer.flags.break = "1"b;

	if xsce.write_head = null () then do;
	     xsce.write_head = blockp;
	     xsce.write_tail = endp;
	     blockp, endp = null ();
	     call send_data_packets;
	     call send_output;
	     end;
	else do;
	     xsce.write_tail -> buffer.next = binary (rel (blockp), 18);
	     xsce.write_tail = endp;
	     blockp, endp = null ();
	     end;
	return;
     end write_data_pkt;

/* * * * * * * * * * WRITE_PKT * * * * * * * * * */

write_pkt:
     procedure;

	endp -> buffer.flags.break = "1"b;
	unspec (substr (endp -> buffer.chars (endp -> buffer.tally - 1), 1)) =
	     unspec (substr (endp -> buffer.chars (endp -> buffer.tally - 1), 1)) | "400"b3;

	if protocol_mpx
	then if x25_data.packet_trace_sw then call log_packet ("1"b);
						/* Log output packet before threading it in? */
	if x25_data.write_head = null ()
	then x25_data.write_head = blockp;
	else x25_data.write_tail -> buffer.next = binary (rel (blockp), 18);
	x25_data.write_tail = endp;
	blockp, endp = null ();
	return;
     end write_pkt;

/* * * * * * * * * X25_HANGUP * * * * * * * * */

x25_hangup:
     procedure;

dcl  size builtin;

	call mcs_timer$reset_all (x25_data.devx);
	call free_x25_data_chain ();			/* We might have some buffers left. */

	if x25_data.lc_ptr ^= null () then do;
	     call tty_space_man$free_space (size (x25_lces), x25_data.lc_ptr);
	     x25_data.lc_ptr = null ();
	     end;
	x25_data.state = X25_HUNGUP;
	return;
     end x25_hangup;

log_packet:
     procedure (Write_sw);

dcl  Write_sw bit (1) parameter;
dcl  1 log_buf (buffer.tally) unaligned based (addr (buffer.chars)),
       2 pad bit (1),
       2 byte bit (8);
dcl  n_octets fixed bin;				/* Dump this many. */
						/* If regular data packet, then do not dump the data. */
	if substr (x25_pkt.type, 8, 1) = "0"b & ^x25_pkt.l3_header.q
	then n_octets = 5;				/* L2 + L3 header. */
	else n_octets = buffer.tally;			/* The works. */
	call syserr (Log_message_or_discard, "x25_mpx(^a): Packet ^[out^;in^]:^v( ^.4b^)", x25_data.name, Write_sw,
	     n_octets, log_buf.byte (*));
	return;
     end log_packet;

send_NCON_RESP:
     proc;					/* envoi d'une confirmation d'appel */
	call get_buffer (16);
	call make_header (lcx, "0"b);
	x25_pkt.type = CALLAC;
	buffer.tally = 3 + L2_HEADER_PAD;
	call write_pkt;
	call send_output;

     end send_NCON_RESP;

check_facilities:
     proc;

/* Procedure to analyze the facilities field after verifying */
/* if there is a request for taxation on demand. */

dcl  i fixed bin;
dcl  1 facilities (facility_length) unal based (addr (l3_facilities)),
       2 pad bit (1) unal,				/* overlap of the facility code field" */
       2 par_length fixed bin (2) uns unal,		/* length of the "facility parameter" field. */
       2 code fixed bin (6) uns unal;			/* facility code proper */

	xlce.flags.collect_call = "0"b;
	i = 1;
	do while (i <= facility_length);
	     if facilities.code (i) = 1
	     then					/* code taxation on demand (request) */
		if facilities.code (i + 1) = 1 then xlce.flags.collect_call = "1"b;
						/* test the corresponding parameter field */
	     if facilities.par_length (i) = 3		/* calculate to pass on the following field */
	     then					/* partial case : 1 octet suported for length of the parameter field */
		i = i + facilities.code (i + 1) + 2;	/* assume length always < 64 */
	     else i = i + facilities.par_length (i) + 2;
	end;

     end check_facilities;

get_protocol_sc:
     proc returns (bit (1));				/* search for a channel of the protocol type. */

	ttybp = addr (tty_buf$);
          lctep = addr (tty_buf.lct_ptr -> lct.lcte_array (xsce.devx));
	if (lcte.channel_type = PROTOCOL_MPX) then return ("1"b);
	return ("0"b);

     end get_protocol_sc;

set_up_dialup_info:
     proc;

	dialup_info = x25_data.dialup_info;
	dialup_info.line_type = LINE_ASYNC1;
	if x25_data.seq_mod = 8
	then dialup_info.buffer_pad = x25_data.dialup_info.buffer_pad + 3 + L2_HEADER_PAD;
						/* 3 bytes in L3 header */
	else dialup_info.buffer_pad = x25_data.dialup_info.buffer_pad + 4 + L2_HEADER_PAD;
						/* 4 bytes in L3 header */
	dialup_info.max_buf_size = min (dialup_info.max_buf_size, divide (xlce.max_packet_size, 4, 9, 0));

     end set_up_dialup_info;

%page;

/* Special entry to perform per system (rather than per channel)
   initialization (called by priv_x25_mpx) */

system_init:
     entry;

/* copy error codes to wired linkage for reference at interrupt time */

	et_undefined_order_request = error_table_$undefined_order_request;
	et_noalloc = error_table_$noalloc;
	et_action_not_performed = error_table_$action_not_performed;
	et_bad_arg = error_table_$bad_arg;
	et_bad_mode = error_table_$bad_mode;
	et_invalid_state = error_table_$invalid_state;
	et_resource_unavailable = error_table_$resource_unavailable;
	et_unimplemented_version = error_table_$unimplemented_version;

	call wire_proc$wire_me;			/* eat up some memory */
	return;
%page;
%include x25_data;
%include protocol_infos;
%include flow_control_info;
%include foreign_terminal_data;
%include lct;
%include line_types;
%include mcs_modes_change_list;
%include mode_string_info;
%include tty_buf;
%include tty_buffer_block;
%include channel_manager_dcls;
%include mcs_timer_dcls;
%include tty_space_man_dcls;
%include multiplexer_types;

/* Use this include file to avoid a conflict with mcs_interrupt_info.incl.pl1 */

%include syserr_codes;
%page;
/* BEGIN MESSAGE DOCUMENTATION

   Message:
   x25_mpx(CHN): Unexpected interrupt TYPE DATA received.

   S: $log

   T: $run

   M: An unexpected MCM interrupt was processed.

   A: $notify


   Message:
   x25_mpx(CHN): Failure, Link state: STATE, Current Action: FUNCTION, in ESTATE, Primary state: PSTATE, Secondary state: SSTATE.

   S: $log

   T: $run

   M: Normal request to crash the line when the link has been disconnected by the FNP.
   STATE is the main state of the link. FUNCTION is the last function the link processed. The ESTATE is the execution state of the
   last function. PSTATE and SSTATE are the link up substate.

   A: $notify


   Message:
   x25_mpx(CHN): Link disconnected due to mis-matched frame sizes. CMDR/FRMR frame: FRAME.

   S: $log

   T: $run

   M: The FNP has received a command reject (LAPB) or frame reject (LAP) which
   specified a reason of "wide frame" on channel CHN.  The actual level 2
   command is FRAME.  This means the frame received by the other end was too
   long.  Instead of looping continuously trying to send this frame, the link
   will be disconnected.  The maximum frame size in the Multics TTF for this
   link should be checked against the size expected by the other end of the
   link, and corrected.

   A: $notify


   Message:
   x25_mpx(CHN/LC): Time out in state STATE.

   S: $log

   T: $run

   M: The network did not respond to a call, reset, or clear request.
   The call will be cleared.

   A: $notify


   Message:
   x25_mpx(CHN): Packet too short.

   S: $log

   T: $run

   M: A packet less then 3 characters long was received.

   A: $notify


   Message:
   x25_mpx(CHN): Unrecognized general format ID GFID.

   S: $log

   T: $run

   M: A packet with a bad format ID was received. The packet will be ignored.

   A: $notify


   Message:
   x25_mpx(CHN): Diagnostic type TYPE.

   S: $log

   T: $run

   M: A diagnostic packet of type TYPE was received. Normal processing continues.

   A: $notify


   Message:
   x25_mpx(CHN): Invalid packet type TYPE on LC 0.

   S: $log

   T: $run

   M: An invalid packet of type TYPE was received on logical channel zero.
   The packet will be ignored.

   A: $notify


   Message:
   x25_mpx(CHN): Unexpected packet type TYPE.

   S: $log

   T: $run

   M: An unexpected packet has been received.
   The packet is ignored.

   A: $notify


   Message:
   x25_mpx(CHN): Unexpected packet type TYPE on idle VC.

   S: $log

   T: $run

   M: An unexpected packet has been received on an idle channel.
   The channel is cleared.

   A: $notify


   Message:
   x25_mpx(CHN): Invalid channel number LCN.

   S: $log

   T: $run

   M: An X.25 packet with an invalid logical channel group number or logical
   channel number has been received.
   The packet is ignored.

   A: $notify


   Message:
   x25_mpx(CHN): Reset received CAUSE/DIAGNOSTIC.

   S: $log

   T: $run

   M: A RESET REQUEST packet has been received.

   A: $ignore


   Message:
   x25_mpx(CHN/LC): Call Request in state STATE.

   S: $log

   T: $run

   M: An unexpected Call Request has been received. The call is cleared.


   Message:
   x25_mpx(CHN/LC): No listening channels.

   S: $log

   T: $run

   M: There were no listening channels available for a network call.
   The call is refused.

   A: $notify


   Message:
   x25_mpx(CHN/LC): Clear Indication CAUSE/DIAGNOSTIC in idle VC.

   S: $log

   T: $run

   M: A Clear Indication has been received on a channel with no call
   in progress. A Clear Confirm is returned.

   A: $ignore


   Message:
   x25_mpx(CHN): Reset Confirm in state STATE.

   S: $log

   T: $run

   M: An unexpected Reset Confirm packet has been received.
   The call is reset.

   A: $notify


   Message:
   x25_mpx(CHN): Clear Confirm in state STATE.

   S: $log

   T: $run

   M: An unexpected Clear Confirm packet has been received.
   The call is cleared.

   A: $notify


   Message:
   x25_mpx(CHN): Data packet received in state STATE.

   S: $log

   T: $run

   M: An unexpected data packet was received.
   The call is cleared.

   A: $notify


   Message:
   x25_mpx(CHN): Unexpected Interrupt Confirm.

   S: $log

   T: $run

   M: An unexpected Interrupt Confirm packet has been received.
   The call is reset.

   A: $notify


   Message:
   x25_mpx(CHN): Sequence error P(S) = N, V(R) = N.

   S: $log

   T: $run

   M: An X.25 packet was received with an incorrect value for P(S).
   The logical channel is reset.

   A: $notify


   Message:
   x25_mpx(CHN): Sequence error:  P(R) (= N) is not between previous P(R) (= N) and V(S) (= N).

   S: $log

   T: $run

   M: An X.25 packet was received with an incorrect value for P(R).
   The logical channel is reset.

   A: $notify


   Message:
   x25_mpx(CHN): Invalid X.29 command CMD.

   S: $log

   T: $run

   M: An invalid X.29 command was received.
   An error indication is returned to the sender.

   A: $notify


   Message:
   x25_mpx(CHN): X.29 ERROR CODE/REASON.

   S: $log

   T: $run

   M: An X.29 ERROR packet with error code CODE and reason REASON was received.
   The packet is ignored.

   A: $notify


   Message:
   x25_mpx(CHN): Received REJ packet.

   S: $log

   T: $run

   M: An X.25 REJ packet was received. Multics does not support this feature.
   The virtual circuit is reset.

   A: $notify


   Message:
   x25_mpx(CHN): Clear Indication CAUSE/DIAGNOSTIC.

   S: $log

   T: $run

   M: A Clear Indication with non-zero cause or diagnostic fields has been received.
   The call is cleared.

   A: $ignore


   Message:
   x25_mpx(CHN): Call Confirm in state STATE.

   S: $log

   T: $run

   M: An unexpected Call Confirm packet was received. The call is cleared.

   A: $notify


   Message:
   x25_mpx(CHN): No buffers available.

   S: $log

   T: $run

   M: x25_mpx was unable to allocate a buffer for a protocol packet.
   This indicates a severe space problem in tty_buf.  The multiplexer will
   sends itself a "hangup" order after freeing any space it has for protocol
   packets in tty_buf.  If this multiplexer is not the cause of the problem
   then the system is likely to crash soon.

   A: $notify


   Message:
   x25_mpx(CHN): Error CODE from write.

   S: $log

   T: $run

   M: An error occurred writing to the LAP channel.
   The LAP channel will be disconnected.

   A: $notify

   Message:
   x25_mpx(CHN): Packet INOUT: PACKET

   S: $log

   T: $run

   M: A packet has been received or sent and is logged. This occurs when the
   packet tracing facility is turned on. INOUT is the direction and PACKET
   is the packet octets dumped in hexadecimal.

   A: $ignore

   END MESSAGE DOCUMENTATION */

     end x25_mpx;




		    x25_mpx_data.cds                11/11/89  1130.5rew 11/11/89  0852.4       21141



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

/* format: style4,delnl,insnl,ifthenstmt,indnoniterend */
x25_mpx_data:
     procedure;

/* translation tables for X.25 multiplexer */
/* Written by C. Hornig, March 1981 */

dcl  mvt_$make_translation_table entry (char (*), char (*), char (512) aligned);

dcl  code fixed bin (35);
dcl  tt char (512) aligned;
dcl  1 cdsa aligned like cds_args;

dcl  com_err_ entry options (variable);
dcl  create_data_segment_ entry (ptr, fixed bin (35));

dcl  1 x25_mpx_data aligned,
       2 eight_bit char (512),
       2 trans_no_parity char (256),
       2 trans_no_parity_lfecho char (256),
       2 trans_parity_lfecho char (256);

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

	call mvt_$make_translation_table (substr (collate9 (), 1, 256), substr (collate9 (), 257, 256),
	     x25_mpx_data.eight_bit);

	call mvt_$make_translation_table (substr (collate9 (), 1, 128), substr (collate9 (), 129, 128), tt);
	x25_mpx_data.trans_no_parity = substr (tt, 1, 256);

	call mvt_$make_translation_table (byte (10) || substr (collate9 (), 1, 13) || byte (10)
	     || substr (collate9 (), 15, 114), byte (13) || substr (collate9 (), 129, 128), tt);
	x25_mpx_data.trans_no_parity_lfecho = substr (tt, 1, 256);

	call mvt_$make_translation_table (byte (10), byte (13), tt);
	x25_mpx_data.trans_parity_lfecho = substr (tt, 1, 256);

	unspec (cdsa) = ""b;
	cdsa.sections (1).p = addr (x25_mpx_data);
	cdsa.sections (1).len = size (x25_mpx_data);
	cdsa.sections (1).struct_name = "x25_mpx_data";

	cdsa.seg_name = "x25_mpx_data";
	cdsa.switches.have_text = "1"b;

	call create_data_segment_ (addr (cdsa), code);
	if code ^= 0 then call com_err_ (code, "x25_mpx_data");
	return;
%page;
%include cds_args;

     end x25_mpx_data;







		    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