



		    priv_hasp_mpx.pl1               11/11/89  1106.7rew 11/11/89  0804.9      157824



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


/* HASP multiplexer:  This multiplexer processes most of the HASP RJE protocol in either host or workstation mode.
   This multiplexer expects data from the user ring to be already compressed and converted to EBCDIC.
   This procedure implements the privileged entries of the multiplexer; it will not be invoked at interrupt time
   and needn't be wired.
   */

/* Created:  October 1979 by G. Palter */
/* Modified: December 1980 by G. Palter as part of "loopback bug" fix */
/* Modified: 24 July 1981 by G. Palter to implement SIGNON processing and metering */
/* Modified: 28 December 1981 by G. Palter to zero saved meters space after allocating (not a zero-on-free area) */
/* Modified: November 1984 by Robert Coren to use tty_area_manager entries to allocate and free saved meters */

priv_hasp_mpx:
     procedure ();

	return;					/* not an entry */


/* Parameters */

dcl  P_hmd_ptr pointer parameter;			/* -> multiplexer data for this channel */
dcl  P_code fixed binary (35) parameter;		/* status code */

dcl  P_devx fixed binary parameter;			/* init_multiplexer:  LCT index of the major channel */
dcl  P_miip pointer parameter;			/* init_multiplexer:  -> multiplexer initialization data */

dcl  P_info_ptr pointer parameter;			/* priv_control, hpriv_control:  -> data for control order */
dcl  P_order character (*) parameter;			/* priv_control, hpriv_control:  control order to execute */


/* Remaining declarations */


dcl  code fixed binary (35);

dcl  devx fixed binary;				/* local copies */

dcl  info_ptr pointer;
dcl  order character (32);

dcl  subchannel_name character (32);			/* name of sub-channel being examined sans multiplexer part */
dcl  start_subchannel_name_idx fixed binary;		/* idx of first character in name specific to sub-channel */

dcl (found_console,					/* ON => operator's console found in the sub-channels */
     (found_readers,				/* ON => indicated card reader found */
      found_printers, found_punches) dimension (8))
	bit (1) aligned;

dcl (device_type, device_number) fixed binary;		/* device type and number for this sub-channel */

dcl  rcb_char character (1) unaligned;			/* RCB character for the current sub-channel */
dcl 1 rcb unaligned based (addr (rcb_char)) like hasp_rcb_byte;

dcl  idx fixed binary;

dcl  initialized bit (1) aligned static initial ("0"b);	/* system wide constant:  ON => multiplexer wired and ready */

dcl  NUL character (1) static options (constant) initial ("");   /* EBCDIC NUL character ("000"b3) */

dcl  pds$processid bit (36) aligned external;

dcl (error_table_$action_not_performed, error_table_$bad_channel, error_table_$bad_mpx_load_data,
     error_table_$bigarg, error_table_$noalloc, error_table_$null_info_ptr, error_table_$undefined_order_request,
     error_table_$unimplemented_version)
	fixed binary (35) external;

dcl (area, cleanup) condition;

dcl  tty_area_manager$allocate entry (fixed bin, ptr);
dcl  tty_area_manager$free entry (fixed bin, ptr);
dcl  hasp_mpx$crash entry (pointer);
dcl  hasp_mpx$dialup entry (pointer, fixed binary);
dcl  hasp_mpx$system_initialize entry ();

dcl (addr, binary, clock, currentsize, length, mod, null, rtrim, size, substr, verify) builtin;
%page;
/* Allocate and initialize the multiplexer database for a given major channel */

init_multiplexer:
     entry (P_devx, P_miip, P_hmd_ptr, P_code);

	devx = P_devx;
	miip = P_miip;
	P_hmd_ptr = null ();			/* in case of failure */

	ttybp = addr (tty_buf$);
	lctp = tty_buf.lct_ptr;
	lcntp = lct.lcnt_ptr;
	hmd_ptr = null ();

	hmd_n_subchannels = mux_init_info.no_channels;	/* to compute size (hmd) */
	     if hmd_n_subchannels > 17 then do;		/* console, 8 readers, 8 printers/punches */
		P_code = error_table_$bigarg;
		return;
	     end;

	call tty_space_man$get_space (size (hmd), hmd_ptr);    /* make space for the multiplexer database */
	     if hmd_ptr = null () then do;		/* no room */
INITIALIZE_FAILS_NOALLOC:
		P_code = error_table_$noalloc;
		return;
	     end;

	hmd.saved_meters_ptr,			/* for cleanup/area handlers */
	     hmd.subchannels(*).saved_meters_ptr = null ();

	hmd.n_subchannels = hmd_n_subchannels;

	on condition (cleanup)
	     call release_mpx_storage ();

	on condition (area)				/* can't allocate metering structures */
	     begin;
		call release_mpx_storage ();
		go to INITIALIZE_FAILS_NOALLOC;
	     end;

	hmd.name = lcnt.names (devx);
	hmd.devx = devx;

	hmd.state = HMD_DOWN;			/* the multiplexer isn't up yet */

	call tty_area_manager$allocate (size (hasp_mpx_meters), hmd.saved_meters_ptr);
	hmd.saved_meters_ptr -> hasp_mpx_meters = 0;


/* Initialize data for the individual sub-channels */

	start_subchannel_name_idx = length (rtrim (hmd.name)) + 2;

	found_console = "0"b;
	found_readers (*),
	     found_printers (*),
	     found_punches (*) = ""b;

	do idx = 1 to hmd.n_subchannels;

	     subchannel_name = substr (mux_init_info.name (idx), start_subchannel_name_idx);

	     call parse_subchannel_name ();		/* sets device_type & device_number */

	     hste_ptr = addr (hmd.subchannels (idx));

	     hste.name = subchannel_name;
	     hste.subchannel_idx = idx;		/* needed in output processing */
	     hste.device_type = device_type;
	     hste.devx = mux_init_info.devx (idx);

	     lctep = addr (lct.lcte_array (hste.devx));	/* place sub-channel index inot LCT for channel_manager */
	     lcte.subchannel = idx;

	     if (hste.device_type = HASP_CONSOLE) then	/* remember the console:  it is special */
		hmd.console_hste_idx = idx;
	     
	     if (hste.device_type = HASP_PUNCH) then
		hste.device_wab_idx = 9 - device_number;     /* for punch, wait-a-bits are backwards */
	     else hste.device_wab_idx = device_number;

	     rcb_char = NUL;			/* create the template RCB character */
	     rcb.not_eob = "1"b;

	     if (hste.device_type = HASP_CONSOLE)
	     then do;				/* for console:  always stream 1, type is set on the fly */
		rcb.stream = 1;
		rcb.type = 0;
	     end;

	     else do;				/* other devices */
		rcb.stream = mod (device_number, 8);	/* streams are number 1 ... 0 */
		if (hste.device_type = HASP_READER) then
		     rcb.type = HASP_RCB_TYPE_READER_INPUT;
		else if (hste.device_type = HASP_PRINTER) then
		     rcb.type = HASP_RCB_TYPE_PRINT_OUTPUT;
		else if (hste.device_type = HASP_PUNCH) then
		     rcb.type = HASP_RCB_TYPE_PUNCH_OUTPUT;
		else go to BAD_CHANNEL;		/* shouldn't get here, but ... */
	     end;

	     hste.rcb = rcb_char;			/* RCB for this device has now been determined */

	     call tty_area_manager$allocate (size (hasp_subchannel_meters), hste.saved_meters_ptr);
	     hste.saved_meters_ptr -> hasp_subchannel_meters = 0;
	end;

	if ^found_console then go to BAD_CHANNEL;	/* no operator's console supplied for this multiplexer */


	if ^initialized then do;
	     call hasp_mpx$system_initialize ();
	     initialized = "1"b;
	end;

	P_hmd_ptr = hmd_ptr;
	P_code = 0;				/* success */

	return;


/* Transfer here when an error is found in the definition of one or more sub-channels */

BAD_CHANNEL:
	call release_mpx_storage ();

	P_code = error_table_$bad_channel;
	return;
%page;
/* Perform a privileged control operation on the multiplexer */

priv_control:
     entry (P_hmd_ptr, P_order, P_info_ptr, P_code);

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


	if (order = "copy_meters")
	then do;

/* Copy the current multiplexer meters for use with the -since_dialup option to channel_comm_meters */

	     hmd.time_meters_copied = clock ();		/* needed to compute idle percentage */
	     hmd.saved_meters_ptr -> hasp_mpx_meters = hmd.meters;
	     call channel_manager$control (hmd.devx, order, info_ptr, code);
	end;


	else if (order = "get_meters")
	then do;

/* Return the current and saved multiplexer metering data */

	     if (info_ptr = null ()) then		/* must have an info structure */
		code = error_table_$null_info_ptr;

	     else if info_ptr -> get_comm_meters_info.version ^= GET_COMM_METERS_INFO_VERSION_1 then
		code = error_table_$unimplemented_version;

	     else do;
		hmmd_ptr = info_ptr -> get_comm_meters_info.subchan_ptr;
		if hmmd_ptr ^= null () then		/* caller wants our meters */
		     if hasp_mpx_meters_data.version ^= HASP_MPX_METERS_DATA_VERSION_1 then
			code = error_table_$unimplemented_version;
		     else do;
			hasp_mpx_meters_data.time_mpx_booted = hmd.time_mpx_booted;
			hasp_mpx_meters_data.time_meters_copied = hmd.time_meters_copied;
			hasp_mpx_meters_data.idle_interval = hmd.transmit_timeout;
			hasp_mpx_meters_data.current_meters = hmd.meters;
			hasp_mpx_meters_data.saved_meters = hmd.saved_meters_ptr -> hasp_mpx_meters;
			call channel_manager$control (hmd.devx, order, info_ptr, code);
		     end;
	     end;
	end;

	else code = error_table_$undefined_order_request;

	P_code = code;

	return;
%page;
/* Perform a highly privileged control operation on the multiplexer */

hpriv_control:
     entry (P_hmd_ptr, P_order, P_info_ptr, P_code);

	hmd_ptr = P_hmd_ptr;
	order = P_order;
	code = 0;

	if (order = "load_mpx")
	then do;

/* Bootload the multiplexer:  copy the load data (includes configuration information), determine the direction of each
   sub-channel, validate that the load data is for this channel, and listen on the major channel for a dialup */

	     if (P_info_ptr = null ()) then
		code = error_table_$null_info_ptr;

	     else if (hmd.state ^= HMD_DOWN) then	/* can't already be booting or booted */
		code = error_table_$action_not_performed;

	     else do;
		hld_ptr = P_info_ptr;

		if hasp_load_data.n_subchannels ^= hmd.n_subchannels then
BAD_LOAD_DATA:	     code = error_table_$bad_mpx_load_data;

		else do;				/* correct number of subchannels */
		     hmd.configuration_data = hasp_load_data.configuration_data;

		     hmd.loader_process_id = pds$processid;
		     hmd.loader_event_channel = hasp_load_data.event_channel;

		     hmd.send_output,		/* these flags are valid during life of a bootload */
			hmd.flags.input_available = "0"b;

		     hmd.output_chain_ptr,
			hmd.input.first_bufferp, hmd.input.last_bufferp,
			hmd.loopback.first_bufferp, hmd.loopback.last_bufferp,
			hmd.output_block.first_bufferp, hmd.output_block.last_bufferp,
			hmd.signon_data_ptr, hmd.minor_state_stack, hmd.loopback_block_chain_stack = null ();

		     hmd.output_block.subchannel_idx, hmd.output_block.tally = 0;

		     hmd.subchannels_for_output = 0;	/* empty the queue */
		     hmd.meters = 0;		/* can't possibly have any metering data */

		     do idx = 1 to hmd.n_subchannels;
			hste_ptr = addr (hmd.subchannels (idx));
			hste.meters = 0;		/* starting fresh */

			if hasp_load_data.subchannels(idx).devx ^= hste.devx then
			     go to BAD_LOAD_DATA;	/* not the right set of sub-channels */

			if (hste.device_type = HASP_CONSOLE) then
			     hste.direction = HSTE_INPUT_OUTPUT;
			else if (hmd.type = HASP_HOST) then
			     if (hste.device_type = HASP_READER) then
				hste.direction = HSTE_INPUT_ONLY;
			     else hste.direction = HSTE_OUTPUT_ONLY;
			else if (hmd.type = HASP_WORKSTATION) then
			     if (hste.device_type = HASP_READER) then
				hste.direction = HSTE_OUTPUT_ONLY;
			     else hste.direction = HSTE_INPUT_ONLY;
			else go to BAD_LOAD_DATA;	/* multiplexer type is wrong(?) */
		     end;

		     call channel_manager$control (hmd.devx, "listen", null (), code);

		     if code = 0 then		/* have successfully started to load it */
			hmd.state = HMD_LOADING;
		end;
	     end;
	end;

	else code = error_table_$undefined_order_request; /* only "load_mpx" is supported now */


	P_code = code;
	return;
%page;
/* Permit dialups on a multiplexer's sub-channels */

start:
     entry (P_hmd_ptr, P_code);

	hmd_ptr = P_hmd_ptr;

	if hmd.state < HMD_LOADED then		/* device must be loaded or already started */
	     P_code = error_table_$action_not_performed;

	else do;
	     P_code = 0;				/* always succeeds */
	     hmd.state = HMD_STARTED;
	     hmd.suspend_all_input = "0"b;		/* allow foreign side to send all the input it wants */
	     hmd.suspend_all_output = "0"b;		/* allow local devices to send output */
	     string (hmd.output_wabs) = (9)"1"b;
	     if (hmd.minor_state < HMD_NORMAL) then	/* must send a SIGNON record: only console may dialup */
		if (hmd.subchannels(hmd.console_hste_idx).state = HSTE_LISTENING) then
		     call hasp_mpx$dialup (hmd_ptr, hmd.console_hste_idx);
		else;				/* console isn't listening yet */
	     else					/* dialup any sub-channels that are listening */
	     do idx = 1 to hmd.n_subchannels;
		if hmd.subchannels(idx).state = HSTE_LISTENING then
		     call hasp_mpx$dialup (hmd_ptr, idx);
	     end;
	end;

	return;



/* Forbid further dialups on a sub-channel */

stop:
     entry (P_hmd_ptr, P_code);

	hmd_ptr = P_hmd_ptr;

	if hmd.state = HMD_STARTED then		/* if it was started, it isn't now */
	     hmd.state = HMD_LOADED;

	P_code = 0;
	return;
%page;
/* Shutdown the multiplexer:  equivalent to a crash */

shutdown:
     entry (P_hmd_ptr, P_code);

	hmd_ptr = P_hmd_ptr;

	if hmd.state > HMD_DOWN then			/* channel might be dialed up:  hangup */
	     call channel_manager$control (hmd.devx, "hangup", null (), (0));

	call hasp_mpx$crash (hmd_ptr);		/* do the dirty work */

	P_code = 0;
	return;



/* Terminate the multiplexer database for a given major channel */

terminate_multiplexer:
     entry (P_hmd_ptr, P_code);

	hmd_ptr = P_hmd_ptr;

	call release_mpx_storage ();

	P_hmd_ptr = null ();
	P_code = 0;

	return;



/* Free all storage allocated by this module for a HASP multiplexer */

release_mpx_storage:
	procedure ();

dcl  idx fixed binary;

	     if hmd_ptr ^= null () then do;		/* used in cleanup/area handlers */

		if hmd.saved_meters_ptr ^= null () then
		     call tty_area_manager$free (size (hasp_mpx_meters), hmd.saved_meters_ptr);

		do idx = 1 to hmd.n_subchannels;
		     if hmd.subchannels(idx).saved_meters_ptr ^= null () then
			call tty_area_manager$free (size (hasp_subchannel_meters), hmd.subchannels(idx).saved_meters_ptr);
		end;

		call tty_space_man$free_space (currentsize (hmd), hmd_ptr);
	     end;

	     return;

	end release_mpx_storage;
%page;
/* Parse a sub-channel name:  validate that the channel name is legal and not a duplicate */

parse_subchannel_name:
	procedure ();

dcl (name_part, number_part) character (3) varying;
dcl  name_lth fixed binary;

	     name_lth = length (rtrim (subchannel_name));
		if (name_lth < 3) | (name_lth > 6) then go to BAD_CHANNEL;

	     name_part = substr (subchannel_name, 1, 3);

	     if name_lth > 3 then			/* seems to have a device number */
		number_part = substr (subchannel_name, 4, (name_lth - 3));
	     else number_part = "";

	     if (name_part ^= "opr") & (name_part ^= "rdr") & (name_part ^= "prt") & (name_part ^= "pun") then
		go to BAD_CHANNEL;			/* unknown device type */


/* Determine device number */

	     if (name_part = "opr") then		/* the "operator's" console */
		if length (number_part) ^= 0 then	/* can't have a number */
		     go to BAD_CHANNEL;
		else device_number = 0;		/* operator's console always has device number of 0 */

	     else do;				/* reader/printer/punch */
		if length (number_part) = 0 then	/* must have device number */
		     go to BAD_CHANNEL;
		if verify (number_part, "0123456789") ^= 0 then go to BAD_CHANNEL;
		device_number = binary (number_part, 17, 0);
		if (device_number < 1) | (device_number > 8) then go to BAD_CHANNEL;
	     end;


/* Determine device type and whether this is a duplicate */

	     if (name_part = "opr") then
		if found_console then go to BAD_CHANNEL;
		else do;
		     found_console = "1"b;
		     device_type = HASP_CONSOLE;
		end;

	     else if (name_part = "rdr") then
		if found_readers (device_number) then go to BAD_CHANNEL;
		else do;
		     found_readers (device_number) = "1"b;
		     device_type = HASP_READER;
		end;

	     else if (name_part = "prt") then
		if found_printers (device_number) then
		     go to BAD_CHANNEL;
		else if found_punches (9-device_number) then
		     go to BAD_CHANNEL;
		else do;
		     found_printers (device_number) = "1"b;
		     device_type = HASP_PRINTER;
		end;

	     else if (name_part = "pun") then		/* last possibility */
		if found_punches (device_number) then
		     go to BAD_CHANNEL;
		else if found_printers (9-device_number) then
		     go to BAD_CHANNEL;
		else do;
		     found_punches (device_number) = "1"b;
		     device_type = HASP_PUNCH;
		end;

	     return;

	end parse_subchannel_name;
%page;
%include hasp_load_data;
%page;
%include hasp_mpx_data;
%page;
%include hasp_mpx_meters;
%page;
%include hasp_subchannel_meters;
%page;
%include hasp_rcb_byte;
%page;
%include mux_init_info;
%page;
%include tty_buf;
%page;
%include lct;
%page;
%include mcs_interrupt_info;
%page;
%include channel_manager_dcls;

%include tty_space_man_dcls;
%page;
%include get_comm_meters_info;

     end priv_hasp_mpx;




		    priv_ibm3270_mpx.pl1            11/11/89  1106.7rew 11/11/89  0803.8      118557



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


/* PRIV_IBM3270_MPX - Contains the portions of the ibm3270 multiplexer that need nt be wired */

/* Written May 1979 by Larry Johnson */
/* Modified June 1981 by Robert Coren to allocate and report meters */
/* Modified November 1984 by Robert Coren to use tty_area_manager to allocate and free meters */

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

/* Arguments */

dcl  arg_devx fixed bin;
dcl  arg_miip ptr;
dcl  arg_mdp ptr;
dcl  arg_infop ptr;
dcl  arg_order char (*);
dcl  arg_code fixed bin (35);

/* Automatic */

dcl  code fixed bin (35);
dcl  devx fixed bin;
dcl  (i, j) fixed bin;
dcl  name char (32) var;
dcl  sub_channel_flags (0:31) bit (1) unal;
dcl  infop ptr;
dcl  order char (32);

/* Internal static */

dcl  init_sw bit (1) int static init ("0"b);		/* Set on first ibm3270 load during multics bootload */

/* External */

dcl  tty_area_manager$allocate entry (fixed bin, ptr);
dcl  tty_area_manager$free entry (fixed bin, ptr);
dcl  ibm3270_mpx$crash entry (ptr);
dcl  ibm3270_mpx$dialup entry (ptr, fixed bin);
dcl  ibm3270_mpx$set_address_table entry (ptr);
dcl  ibm3270_mpx$start_general_poll entry (ptr);
dcl  ibm3270_mpx$init entry;

dcl  error_table_$bad_channel ext fixed bin (35);
dcl  error_table_$noalloc ext fixed bin (35);
dcl  error_table_$action_not_performed ext fixed bin (35);
dcl  error_table_$undefined_order_request ext fixed bin (35);
dcl  error_table_$bad_mpx_load_data ext fixed bin (35);
dcl  error_table_$unimplemented_version ext fixed bin (35);

dcl  pds$processid ext bit (36) aligned;
dcl  (area, cleanup) condition;

dcl  (addr, bin, index, length, low, null, reverse, rtrim, size, string, substr, unspec, verify) builtin;

/* Entry called at multiplexer creation time to build data bases */

init_multiplexer:
     entry (arg_devx, arg_miip, arg_mdp, arg_code);

	devx = arg_devx;
	miip = arg_miip;
	arg_mdp = null ();

	ttybp = addr (tty_buf$);
	lctp = tty_buf.lct_ptr;
	lcntp = lct.lcnt_ptr;

	md_nchan = mux_init_info.no_channels;
	string (sub_channel_flags) = "0"b;
	do i = 1 to md_nchan;
	     j = index (reverse (mux_init_info.name (i)), ".");
	     if j = 0
	     then go to bad_channel;
	     name = rtrim (substr (mux_init_info.name (i), length (mux_init_info.name (i)) - j + 2));
	     if length (name) ^= 3
	     then go to bad_channel;
	     if substr (name, 1, 1) ^= "p" & substr (name, 1, 1) ^= "d"
	     then go to bad_channel;
	     if verify (substr (name, 2, 2), "0123456789") ^= 0
	     then go to bad_channel;
	     j = bin (substr (name, 2, 2));
	     if j < 0 | j > 31
	     then go to bad_channel;
	     if sub_channel_flags (j)
	     then go to bad_channel;
	     sub_channel_flags (j) = "1"b;
	end;

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

	call tty_space_man$get_space (size (md), mdp);
	if mdp = null ()
	then do;
noalloc:
	     arg_code = error_table_$noalloc;
	     return;
	end;

	md.devx = devx;
	md.name = lcnt.names (devx);
	md.nchan = md_nchan;

	string (md.flags) = "0"b;
	md.error_stat = 0;
	md.chars = "";
	md.dialup_info = 0;
	md.address_tablep = null ();
	md.chan_map (*) = 0;
	md.last_select_address, md.last_poll_address = low (1);
	md.first_write_chan, md.last_write_chan = 0;
	md.first_poll_chan, md.last_poll_chan = 0;
	md.first_control_chan, md.last_control_chan = 0;
	md.cur_write_chan = 0;
	md.write_chain_ptr = null ();
	md.input_chain_ptr = null ();
	md.input_count = 0;

	on area
	     begin;
		call tty_space_man$free_space (size (md), mdp);
		go to noalloc;
	     end;

	call tty_area_manager$allocate (size (ibm3270_meters), md.saved_meters_ptr);
	revert area;

	do i = 1 to md.nchan;
	     mdep = addr (md.mde_entry (i));
	     mde.position = 0;
	     mde.line_size = 80;
	     mde.screen_size = 1920;
	     mde.next_write_chan = 0;
	     mde.next_poll_chan = 0;
	     mde.next_control_chan = 0;
	     mde.write_chain_ptr = null ();
	     string (mde.flags) = "0"b;
	     j = index (reverse (mux_init_info.name (i)), ".");
	     name = rtrim (substr (mux_init_info.name (i), length (mux_init_info.name (i)) - j + 2));
	     mdep = addr (md.mde_entry (i));
	     mde.devx = mux_init_info.devx (i);
	     mde.name = name;
	     j = bin (substr (name, 2, 2));
	     md.chan_map (j) = i;
	     mde.printer = (substr (name, 1, 1) = "p");
	     lctep = addr (lct.lcte_array (mde.devx));
	     lcte.subchannel = i;
	end;

	arg_mdp = mdp;
	if ^init_sw
	then do;					/* First caal of multics bootload */
	     call ibm3270_mpx$init;
	     init_sw = "1"b;
	end;

	arg_code = 0;

	return;

bad_channel:
	arg_code = error_table_$bad_channel;
	return;

/* Entry to free the multiplexer data base */

terminate_multiplexer:
     entry (arg_mdp, arg_code);

	mdp = arg_mdp;
	md_nchan = md.nchan;
	if md.write_chain_ptr ^= null
	then call tty_space_man$free_chain (md.devx, OUTPUT, (md.write_chain_ptr));
	md.write_chain_ptr = null ();
	if md.input_chain_ptr ^= null ()
	then call tty_space_man$free_chain (md.devx, INPUT, (md.input_chain_ptr));
	md.input_chain_ptr = null ();
	call tty_area_manager$free (size (ibm3270_meters), md.saved_meters_ptr);
	call tty_space_man$free_space (size (md), mdp);
	arg_mdp = null ();
	arg_code = 0;
	return;

/* Entry to allow dialups on the sub-channels */

start:
     entry (arg_mdp, arg_code);

	mdp = arg_mdp;
	if ^md.loaded
	then do;
	     arg_code = error_table_$action_not_performed;
	     return;
	end;

	md.started = "1"b;

	do i = 1 to md.nchan;			/* Look for hungup printers */
	     mdep = addr (md.mde_entry (i));
	     if mde.listen & ^mde.dialed & mde.printer
	     then call ibm3270_mpx$dialup (mdp, i);
	end;

	arg_code = 0;
	return;

/* Entry to dis-allow dialups on the sub-channels */

stop:
     entry (arg_mdp, arg_code);

	mdp = arg_mdp;
	if ^md.loaded
	then do;
	     arg_code = error_table_$action_not_performed;
	     return;
	end;

	md.started = "0"b;
	arg_code = 0;
	return;

/* Entry to do a forced shutdown (or crash) of the multiplexer */

shutdown:
     entry (arg_mdp, arg_code);

	mdp = arg_mdp;
	if md.loading | md.loaded
	then call channel_manager$control (md.devx, "hangup", null (), code);
	call ibm3270_mpx$crash (mdp);
	arg_code = 0;
	return;

/* Control orders */

priv_control:
     entry (arg_mdp, arg_order, arg_infop, arg_code);

	mdp = arg_mdp;
	order = arg_order;
	infop = arg_infop;

	if order = "copy_meters"
	then do;
	     md.saved_meters_ptr -> ibm3270_meters = md.error_stat;
	     call channel_manager$control (md.devx, order, infop, arg_code);
	end;

	else if order = "get_meters"
	then do;
	     if infop -> get_comm_meters_info.version ^= GET_COMM_METERS_INFO_VERSION_1
	     then arg_code = error_table_$unimplemented_version;
	     else do;
		meter_ptr = infop -> get_comm_meters_info.subchan_ptr;
		if meter_ptr ^= null ()
		then if meter_ptr -> ibm3270_meter_struc.version ^= IBM3270_METERS_VERSION_1
		     then arg_code = error_table_$unimplemented_version;
		     else do;
			meter_ptr -> ibm3270_meter_struc.current_meters = md.error_stat;
			meter_ptr -> ibm3270_meter_struc.saved_meters = md.saved_meters_ptr -> ibm3270_meters;
			call channel_manager$control (md.devx, order, infop, arg_code);
		     end;
	     end;
	end;

	else arg_code = error_table_$undefined_order_request;
	return;

hpriv_control:
     entry (arg_mdp, arg_order, arg_infop, arg_code);

	mdp = arg_mdp;
	order = arg_order;
	infop = arg_infop;

	if order = "load_mpx"
	then do;
	     load_infop = infop;
	     if md.loading | md.loaded
	     then code = error_table_$action_not_performed;
	     else do;
		call channel_manager$control (md.devx, "listen", null (), code);
		if code = 0
		then md.loading = "1"b;
		md.event_channel = load_info.event_channel;
		md.processid = pds$processid;
		md.ascii = load_info.ascii;
		md.debug = load_info.debug;
		md.allow_copy = load_info.allow_copy;
		md.allow_raw3270 = load_info.allow_raw3270;
		call ibm3270_mpx$set_address_table (mdp);
						/* Get right translation table */
		md.controller_address = load_info.controller_address;
						/* Default */
		md.controller_poll_address = address_table (md.controller_address);
		md.controller_select_address = address_table (md.controller_address + 32);
		md.general_poll_address = address_table (63);
		if md.nchan ^= load_info.nchan
		then do;				/* Something changed */
bad_load:
		     code = error_table_$bad_mpx_load_data;
		     go to control_return;
		end;
		do i = 1 to md.nchan;
		     mdep = addr (md.mde_entry (i));
		     chan_load_infop = addr (load_info.chan_info (i));
		     if mde.devx ^= chan_load_info.devx
		     then go to bad_load;
		     mde.screen_size = chan_load_info.screen_size;
		     mde.line_size = chan_load_info.line_size;
		     j = bin (substr (mde.name, 2, 2)); /* Poll address */
		     mde.device_address = address_table (j);
		end;
		if md.ascii
		then do;
		     unspec (md.nl) = "012"b3;
		     unspec (md.sba) = "021"b3;
		     unspec (md.stx) = "002"b3;
		     unspec (md.esc) = "033"b3;
		     unspec (md.write) = "061"b3;
		     unspec (md.erase_write) = "065"b3;
		     unspec (md.ic) = "023"b3;
		     unspec (md.etx) = "003"b3;
		     unspec (md.soh) = "001"b3;
		     unspec (md.eot) = "004"b3;
		     unspec (md.percent) = "045"b3;
		     unspec (md.slash) = "057"b3;
		     unspec (md.letter_R) = "122"b3;
		     unspec (md.etb) = "027"b3;
		     unspec (md.enter) = "047"b3;
		     unspec (md.clear) = "137"b3;
		     unspec (md.pa1) = "045"b3;
		     unspec (md.pa2) = "076"b3;
		     unspec (md.pa3) = "054"b3;
		     unspec (md.bs) = "010"b3;
		     unspec (md.cr) = "015"b3;
		     unspec (md.em) = "031"b3;
		     unspec (md.copy) = "067"b3;
		end;
		else do;
		     unspec (md.nl) = "025"b3;
		     unspec (md.sba) = "021"b3;
		     unspec (md.stx) = "002"b3;
		     unspec (md.esc) = "047"b3;
		     unspec (md.write) = "361"b3;
		     unspec (md.erase_write) = "365"b3;
		     unspec (md.ic) = "023"b3;
		     unspec (md.etx) = "003"b3;
		     unspec (md.soh) = "001"b3;
		     unspec (md.eot) = "067"b3;
		     unspec (md.percent) = "154"b3;
		     unspec (md.slash) = "141"b3;
		     unspec (md.letter_R) = "331"b3;
		     unspec (md.etb) = "046"b3;
		     unspec (md.enter) = "175"b3;
		     unspec (md.clear) = "155"b3;
		     unspec (md.pa1) = "154"b3;
		     unspec (md.pa2) = "156"b3;
		     unspec (md.pa3) = "054"b3;
		     unspec (md.bs) = "026"b3;
		     unspec (md.cr) = "015"b3;
		     unspec (md.em) = "031"b3;
		     unspec (md.copy) = "367"b3;
		end;
		if load_info.quit_key = PA1
		then md.quit_key = md.pa1;
		else if load_info.quit_key = PA2
		then md.quit_key = md.pa2;
		else if load_info.quit_key = PA3
		then md.quit_key = md.pa3;
		else md.quit_key = md.pa1;
		if load_info.formfeed_key = PA1
		then md.formfeed_key = md.pa1;
		else if load_info.formfeed_key = PA2
		then md.formfeed_key = md.pa2;
		else if load_info.formfeed_key = PA3
		then md.formfeed_key = md.pa3;
		else if load_info.formfeed_key = CLEAR
		then md.formfeed_key = md.clear;
		else md.formfeed_key = md.clear;
	     end;
	end;

	else if order = "start_mpx"
	then do;
	     if ^md.loaded
	     then do;
		code = error_table_$action_not_performed;
		go to control_return;
	     end;
	     line_ctl.val = 0;
	     call line_control (SET_3270_MODE);		/* Tell bisync I want the 3270 option */
	     line_ctl.val (1) = 3;
	     call line_control (SET_BID_LIMIT);
	     line_ctl.val (1) = 1;
	     call line_control (CONFIGURE);		/* Non-transparent ebcdic */
	     line_ctl.val (1) = 2;
	     line_ctl.val (2) = 2;
	     call line_control (SET_TTD_PARAMS);
	     i = 256;				/* input buffersize */
	     call channel_manager$control (md.devx, "set_input_message_size", addr (i), code);
	     if code ^= 0
	     then go to control_return;
	     call ibm3270_mpx$start_general_poll (mdp);
	end;

	else code = error_table_$undefined_order_request;

control_return:
	arg_code = code;
	return;

/* Internal procedure to perform a line control operation */

line_control:
     proc (op);

dcl  op fixed bin;

	line_ctl.op = op;
	call channel_manager$control (md.devx, "line_control", addr (line_ctl), code);
	if code ^= 0
	then go to control_return;
	return;

     end line_control;

%include tty_buf;
%include lct;
%include mux_init_info;
%include tty_space_man_dcls;
%include channel_manager_dcls;
%include bisync_line_data;
%include ibm3270_mpx_data;
%include ibm3270_mpx_load_data;
%include ibm3270_meters;
%include get_comm_meters_info;
     end priv_ibm3270_mpx;





		    priv_polled_vip_mpx.pl1         11/11/89  1106.7rew 11/11/89  0804.9      115281



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



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

/* This procedure contains the privileged entry points to the polled
   vip multiplexer.  These entries are never referenced at interrupt
   time and therefore need not be wired.

   Coded December 1978 by J. Stern
   Modified November 1984 by Robert Coren to use tty_area_manager entries
*/


/* Parameters */

dcl  pm_code fixed bin (35);				/* error code */
dcl  pm_devx fixed bin;				/* device (LCT) index */
dcl  pm_infop ptr;					/* ptr to control order info structure */
dcl  pm_miip ptr;					/* ptr to mux_init_info structure */
dcl  pm_order char (*);				/* control order name */
dcl  pm_pvmdp ptr;					/* ptr to pvmd (polled vip multiplexer data base) */


/* Automatic */

dcl  code fixed bin (35);
dcl  devx fixed bin;
dcl  meter_ptr ptr;
dcl  infop ptr;

dcl  1 lc_info aligned,				/* info structure for line control order */
       2 type fixed bin (17) unal,
       2 arg1 fixed bin (17) unal,
       2 station_mask (0:35) bit (1) unal;

dcl  major_name_len fixed bin;
dcl  order char (32);
dcl  subchan fixed bin;


/* Internal static */

dcl  init_sw bit (1) int static init ("0"b);


/* External static */

dcl  error_table_$action_not_performed fixed bin (35) ext;
dcl  error_table_$bad_channel fixed bin (35) ext;
dcl  error_table_$bad_mode fixed bin (35) ext;
dcl  error_table_$bad_mpx_load_data fixed bin (35) ext;
dcl  error_table_$bigarg fixed bin (35) ext;
dcl  error_table_$invalid_state fixed bin (35) ext;
dcl  error_table_$noalloc fixed bin (35) ext;
dcl  error_table_$undefined_order_request fixed bin (35) ext;
dcl  error_table_$unimplemented_version fixed bin (35) ext;
dcl  pds$process_id bit (36) aligned ext;

/* Constants */

dcl  (
     CONTROLLER_POLL fixed bin init (2),
     ECHO_MASK fixed bin init (5),
     PAUSE_TIME fixed bin init (4),
     STATION_POLL fixed bin init (1)
     ) int static options (constant);


/* Conditions */

dcl  (area, cleanup) condition;


/* Builtins */

dcl  (addr, bin, length, max, min, null, rtrim, size, string, substr, verify) builtin;


/* Entries */

dcl  tty_area_manager$allocate entry (fixed bin, ptr);
dcl  tty_area_manager$free entry (fixed bin, ptr);
dcl  polled_vip_mpx$crash entry (ptr);
dcl  polled_vip_mpx$dialup entry (ptr, fixed bin);
dcl  polled_vip_mpx$system_init entry;

%include polled_vip_mpx_data;

%include polled_vip_load_info;

%include mux_init_info;

%include lct;

%include tty_buf;

%include channel_manager_dcls;

%include polled_vip_mpx_meters;

%include pvip_subchan_meters;

%include tty_space_man_dcls;

%include get_comm_meters_info;

/* Entry to allocate and initialize the  multiplexer data base for a given major channel */

init_multiplexer:
     entry (pm_devx, pm_miip, pm_pvmdp, pm_code);

	devx = pm_devx;
	miip = pm_miip;
	pm_pvmdp = null;

	ttybp = addr (tty_buf$);
	lctp = tty_buf.lct_ptr;
	lcntp = lct.lcnt_ptr;

	pvmd_nchan = mux_init_info.no_channels;		/* size (pvmd) depends on this */
	if pvmd_nchan > 32
	then do;
	     pm_code = error_table_$bigarg;
	     return;
	end;
	pvmdp = null;
	on cleanup
	     begin;
		if pvmdp ^= null
		then call tty_space_man$free_space (size (pvmd), pvmdp);
	     end;

	call tty_space_man$get_space (size (pvmd), pvmdp);/* allocate space for multiplexer data base */
	if pvmdp = null
	then do;
noalloc:
	     pm_code = error_table_$noalloc;
	     return;
	end;

	pvmd.nchan = pvmd_nchan;			/* init major channel data */
	pvmd.devx = devx;
	pvmd.name = lcnt.names (devx);
	major_name_len = length (rtrim (pvmd.name));
	string (pvmd.flags) = ""b;

	pvmd.nstation = 0;				/* init subchannel data */
	string (pvmd.station_mask) = ""b;
	pvmd.station_to_subchan (*).display = 0;
	pvmd.station_to_subchan (*).printer = 0;

	on area
	     begin;
		call tty_space_man$free_space (size (pvmd), pvmdp);
		go to noalloc;
	     end;

	call tty_area_manager$allocate (size (pvip_mpx_meters), pvmd.saved_meters_ptr);

	do subchan = 1 to pvmd.nchan;			/* init subchannel entries */
	     pvstep = addr (pvmd.subchan_table (subchan));
	     pvste.devx = mux_init_info.devx (subchan);
	     pvste.name = substr (mux_init_info.name (subchan), major_name_len + 2);
						/* get last component of channel name */
	     if verify (substr (pvste.name, 1, 1), "dpx") ^= 0
	     then go to bad_chan;
	     if verify (substr (pvste.name, 2, 2), "0123456789") ^= 0
	     then go to bad_chan;
	     pvste.station_addr = bin (substr (pvste.name, 2, 2), 8);
	     if pvste.station_addr < 0 | pvste.station_addr > 31
	     then go to bad_chan;

	     if ^pvmd.station_mask (pvste.station_addr)
	     then do;
		pvmd.station_mask (pvste.station_addr) = "1"b;
		pvmd.nstation = pvmd.nstation + 1;
	     end;

	     string (pvste.flags) = ""b;
	     if substr (pvste.name, 1, 1) = "p"
	     then do;
		if pvmd.station_to_subchan (pvste.station_addr).printer ^= 0
		then go to bad_chan;
		pvmd.station_to_subchan (pvste.station_addr).printer = subchan;
	     end;
	     else do;
		if pvmd.station_to_subchan (pvste.station_addr).display ^= 0
		then go to bad_chan;
		pvmd.station_to_subchan (pvste.station_addr).display = subchan;
	     end;

	     call tty_area_manager$allocate (size (pvip_subchan_meters), pvste.saved_meters_ptr);

	     lctep = addr (lct.lcte_array (pvste.devx));
	     lcte.subchannel = subchan;
	end;

	if ^init_sw
	then do;
	     call polled_vip_mpx$system_init;
	     init_sw = "1"b;
	end;

	pm_pvmdp = pvmdp;
	pm_code = 0;
	return;


bad_chan:						/* come here for invlaid channel name */
	call tty_space_man$free_space (size (pvmd), pvmdp);
	pm_code = error_table_$bad_channel;
	return;



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

terminate_multiplexer:
     entry (pm_pvmdp, pm_code);

	pvmdp = pm_pvmdp;
	pvmd_nchan = pvmd.nchan;			/* size (pvmd) depends on this */
	do subchan = 1 to pvmd_nchan;			/* free all the saved meters */
	     pvstep = addr (pvmd.subchan_table (subchan));
	     call tty_area_manager$free (size (pvip_subchan_meters), pvste.saved_meters_ptr);
	end;

	call tty_area_manager$free (size (pvip_mpx_meters), pvmd.saved_meters_ptr);
	call tty_space_man$free_space (size (pvmd), pvmdp);

	pm_pvmdp = null;
	pm_code = 0;
	return;



/* Entry to allow dialups on multiplexer subchannels */

start:
     entry (pm_pvmdp, pm_code);

	pvmdp = pm_pvmdp;
	if ^pvmd.mpx_loaded
	then do;
	     pm_code = error_table_$action_not_performed;
	     return;
	end;

	call channel_manager$control (pvmd.devx, "set_input_message_size", addr (pvmd.max_message_len), code);

	if pvmd.crlf_echo
	then call send_echo_mask;

	lc_info.type = PAUSE_TIME;			/* set poll cycle pause time */
	lc_info.arg1 = pvmd.pause_time;
	call channel_manager$control (pvmd.devx, "line_control", addr (lc_info), code);

	if pvmd.controller_poll
	then lc_info.type = CONTROLLER_POLL;
	else do;
	     lc_info.type = STATION_POLL;
	     lc_info.arg1 = pvmd.nstation;
	     lc_info.station_mask = pvmd.station_mask;
	end;
	call channel_manager$control (pvmd.devx, "line_control", addr (lc_info), code);
	if code = 0
	then pvmd.polling_started = "1"b;

	pvmd.mpx_started = "1"b;
	do subchan = 1 to pvmd.nchan;			/* look for subchans that can dial up now */
	     pvstep = addr (pvmd.subchan_table (subchan));
	     if pvste.listen & ^pvste.dialed & pvste.slave
	     then call polled_vip_mpx$dialup (pvmdp, subchan);
						/* make dialup happen */
	end;

	pm_code = 0;
	return;



/* Entry to forbid dialups on multiplexer subchannels */

stop:
     entry (pm_pvmdp, pm_code);

	pvmdp = pm_pvmdp;
	pvmd.mpx_started = "0"b;
	pm_code = 0;
	return;



/* Entry to shut down the multiplexer (equivalent to a crash) */

shutdown:
     entry (pm_pvmdp, pm_code);

	pvmdp = pm_pvmdp;
	if pvmd.mpx_loading | pvmd.mpx_loaded
	then call channel_manager$control (pvmd.devx, "hangup", null, code);
	call polled_vip_mpx$crash (pvmdp);		/* simulate a crash */
	pm_code = 0;
	return;



/* Entry to perform privileged control orders */

priv_control:
     entry (pm_pvmdp, pm_order, pm_infop, pm_code);

	pvmdp = pm_pvmdp;
	order = pm_order;
	infop = pm_infop;

	if order = "copy_meters"
	then do;
	     pvmd.saved_meters_ptr -> pvip_mpx_meters = pvmd.error_counters;
	     call channel_manager$control (pvmd.devx, order, infop, pm_code);
	end;

	else if order = "get_meters"
	then do;
	     if infop -> get_comm_meters_info.version ^= GET_COMM_METERS_INFO_VERSION_1
	     then pm_code = error_table_$unimplemented_version;
	     else do;
		meter_ptr = infop -> get_comm_meters_info.subchan_ptr;
		if meter_ptr ^= null ()
		then if meter_ptr -> pvip_mpx_meter_struc.version ^= PVIP_MPX_METERS_VERSION_1
		     then pm_code = error_table_$unimplemented_version;
		     else do;
			meter_ptr -> pvip_mpx_meter_struc.current_meters = pvmd.error_counters;
			meter_ptr -> pvip_mpx_meter_struc.saved_meters = pvmd.saved_meters_ptr -> pvip_mpx_meters;
			call channel_manager$control (pvmd.devx, order, infop, pm_code);
		     end;
	     end;
	end;

	else pm_code = error_table_$undefined_order_request;
	return;



/* Entry to perform highly privileged control orders */

hpriv_control:
     entry (pm_pvmdp, pm_order, pm_infop, pm_code);

	pvmdp = pm_pvmdp;
	order = pm_order;
	code = 0;

	if order = "load_mpx"			/* bootload the multiplexed device */
	then do;					/* listen to major channel and wait for dialup */
	     if pvmd.mpx_loading | pvmd.mpx_loaded	/* one at a time, please */
	     then do;
		pm_code = error_table_$action_not_performed;
		return;
	     end;

	     pv_load_infop = pm_infop;		/* save load info */
	     if pv_load_info.nchan ^= pvmd.nchan
	     then do;
bad_load_data:
		pm_code = error_table_$bad_mpx_load_data;
		return;
	     end;

	     pvmd.controller_poll = pv_load_info.controller_poll;
	     pvmd.crlf_echo = pv_load_info.crlf_echo;
	     pvmd.omit_nl = pv_load_info.omit_nl;
	     pvmd.omit_ff = pv_load_info.omit_ff;
	     pvmd.gcos_break = pv_load_info.gcos_break;
	     pvmd.etb_mode = pv_load_info.etb_mode;

	     pvmd.load_proc_id = pds$process_id;
	     pvmd.load_ev_chan = pv_load_info.ev_chan;
	     pvmd.pause_time = pv_load_info.pause_time;
	     pvmd.max_text_len = min (1920, max (64, pv_load_info.max_text_len));
	     pvmd.max_message_len = min (1024, max (73, pv_load_info.max_message_len));
	     pvmd.quit = pv_load_info.quit;
	     pvmd.formfeed = pv_load_info.formfeed;

	     pvmd.mpx_started, pvmd.polling_started, pvmd.send_output, pvmd.partial_frame = "0"b;
	     pvmd.writep = null;
	     pvmd.write_chan = 0;
	     pvmd.input_timeouts, pvmd.input_frames_lost, pvmd.output_frames_lost, pvmd.bad_output_frames,
		pvmd.output_timeouts = 0;

	     do subchan = 1 to pvmd.nchan;		/* init some subchannel data */
		pvstep = addr (pvmd.subchan_table (subchan));
		pvste.write_chain = 0;
		pvste.naks = 0;
		pvste.pgofs, pvste.writes = 0;
		string (pvste.flags) = ""b;
		pvste.printer = (substr (pvste.name, 1, 1) = "p");
		pvste.slave = pv_load_info.slave (subchan);
		if pvste.devx ^= pv_load_info.devx (subchan)
		then go to bad_load_data;
		pvste.baud_rate = pv_load_info.baud_rate (subchan);
	     end;

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

	     pvmd.mpx_loading = "1"b;
	     pvmd.cur_station_mask = pvmd.station_mask;
	     pvmd.cur_nstation = pvmd.nstation;
	end;

	else code = error_table_$undefined_order_request;

	pm_code = code;
	return;

/* Subroutine to send the echo mask to the FNP */

send_echo_mask:
     proc;

dcl  p ptr;
dcl  i fixed bin;
dcl  count fixed bin;

	string (lc_info.station_mask) = ""b;
	count = 0;
	do i = 1 to pvmd.nchan;			/* find the subchans that require echoing */
	     p = addr (pvmd.subchan_table (i));
	     if substr (p -> pvste.name, 1, 1) = "d"	/* only display stations get echos */
	     then do;
		lc_info.station_mask (p -> pvste.station_addr) = "1"b;
		count = count + 1;
	     end;
	end;

	lc_info.type = ECHO_MASK;
	lc_info.arg1 = count;
	call channel_manager$control (pvmd.devx, "line_control", addr (lc_info), code);
     end;

     end;						/* priv_polled_vip_mpx */




		    priv_x25_mpx.pl1                11/11/89  1106.7rew 11/11/89  0804.9      105867



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



/****^  HISTORY COMMENTS:
  1) change(86-09-12,Beattie), approve(86-09-12,MCR7540),
     audit(86-09-19,Brunelle), install(86-10-07,MR12.0-1176):
     Ensure that LCT entries are freed when X.25 multiplexers crash or are
     dumped (TR17714).
  2) change(89-02-21,Parisek), approve(89-06-01,MCR8110),
     audit(89-10-09,Farley), install(89-10-25,MR12.3-1100):
     Add x25_packet_trace_(on off) orders for use in tracing PROTOCOL
     packet I/O.
                                                   END HISTORY COMMENTS */


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

/* This procedure contains the privileged entry points to the
   x25 multiplexer.  These entries are never referenced at interrupt
   time and therefore need not be wired.

   Coded December 1978 by J. Stern
   Modified 7/31/79 by B.Westcott to support x25 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 July 1983 by Robert Coren to implement administrative control of long_packet_size.
   Modified August 1983 by Jeff Schiller to implement the "reverse charging" facility.
   Modified October 1984 by R.J.C. Kissel to use the window size specified.
   Modified October 1984 by R.J.C. Kissel to set the specified value for the breakall idle timer.
*/

/* Parameters */

dcl  x25_code fixed bin (35);				/* error code */
dcl  x25_devx fixed bin;				/* device (LCT) index */
dcl  x25_infop ptr;					/* ptr to control order info structure */
dcl  x25_miip ptr;					/* ptr to mux_init_info structure */
dcl  x25_order char (*);				/* control order name */
dcl  X25_data_ptr ptr;				/* ptr to x25_data (x25 multiplexer data base) */


/* Automatic */

dcl  code fixed bin (35);
dcl  devx fixed bin;
dcl  order char (32);
dcl  infop pointer;
dcl  (lcx, scx) fixed bin;

dcl  1 activate_order aligned,
       2 dce_or_dte bit (1) unaligned,			/* ON = DCE */
       2 lap_or_lapb bit (1) unaligned,			/* ON = lapb */
       2 disc_first bit (1) unaligned,			/* ON = send disc upon physical connect */
       2 trace_off bit (1) unaligned,			/* ON = turn off trace upon line crash */
       2 pad bit (5) unaligned,			/* padding */
       2 activation_order bit (9) unaligned,		/* "001"b3 */
       2 frame_size uns fixed bin (18) unaligned,		/* max size of I-frame */
       2 K uns fixed bin (9) unaligned,			/* max unack frame in frame level */
       2 N2 uns fixed bin (9) unaligned,		/* number of retries */
       2 T1 uns fixed bin (9) unaligned,		/* retry timer in tenths of seconds */
       2 T3 uns fixed bin (9) unaligned;		/* init timer */

/* Based */

dcl  based_packet_size fixed bin based;


/* Internal static */

dcl  init_sw bit (1) aligned static init ("0"b);
dcl  modulus8 fixed bin int static options (constant) init (8);

/* External static */

dcl  error_table_$action_not_performed fixed bin (35) ext;
dcl  error_table_$dev_nt_assnd fixed bin (35) ext;
dcl  error_table_$noalloc fixed bin (35) ext;
dcl  error_table_$null_info_ptr fixed bin (35) ext;
dcl  error_table_$undefined_order_request fixed bin (35) ext;
dcl  error_table_$unimplemented_version fixed bin (35) ext;


/* Conditions */

dcl  cleanup condition;


/* Builtins */

dcl  (addr, after, before, currentsize, fixed, null, reverse, rtrim, size, string, unspec) builtin;


/* Entries */

dcl  x25_mpx$system_init entry;

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

init_multiplexer:
     entry (x25_devx, x25_miip, X25_data_ptr, x25_code);

	devx = x25_devx;
	miip = x25_miip;
	X25_data_ptr = null ();

	ttybp = addr (tty_buf$);
	lctp = tty_buf.lct_ptr;

	x25_data_n_sc = mux_init_info.no_channels;
	x25_data_ptr = null ();
	on cleanup
	     begin;
	     if x25_data_ptr ^= null () then call tty_space_man$free_space (size (x25_data), x25_data_ptr);
	end;

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

	x25_data.name = reverse (after (reverse (mux_init_info.channels (1).name), "."));
	x25_data.devx = devx;
	x25_data.state = X25_HUNGUP;
	x25_data.n_sc = x25_data_n_sc;
	x25_data.n_lc = 0;
	x25_data.lc_ptr = null ();
	x25_data.write_head, x25_data.write_tail = null ();

	do scx = 1 to x25_data.n_sc;
	     xscep = addr (x25_data.sc (scx));
	     xsce.name = mux_init_info.channels (scx).name;
	     xsce.state = SC_HUNGUP;
	     xsce.devx = mux_init_info.channels (scx).devx;
	     xsce.lcx = 0;
	     string (xsce.flags) = ""b;
	     xsce.service = rtrim (reverse (before (reverse (mux_init_info.channels (scx).name), ".")), " 0123456789");
	     xsce.write_head, xsce.write_tail = null ();
	     xsce.trans_table_ptr = null ();

	     lctep = addr (lct.lcte_array (xsce.devx));
	     lcte.subchannel = scx;
	end;

	if ^init_sw then do;
	     call x25_mpx$system_init;
	     init_sw = "1"b;
	     end;

	X25_data_ptr = x25_data_ptr;
	x25_code = 0;
	return;

/* * * * * * * * * * TERMINATE_MULTIPLEXER * * * * * * * * * */

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

terminate_multiplexer:
     entry (X25_data_ptr, x25_code);

	x25_data_ptr = X25_data_ptr;

	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;

	call tty_space_man$free_space (currentsize (x25_data), x25_data_ptr);

	X25_data_ptr = null ();
	x25_code = 0;
	return;

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

/* Entry to allow dialups on multiplexer subchannels */

start:
     entry (X25_data_ptr, x25_code);

	x25_data_ptr = X25_data_ptr;
	x25_data.flags.mpx_started = "1"b;
	x25_code = 0;
	return;

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

/* Entry to forbid dialups on multiplexer subchannels */

stop:
     entry (X25_data_ptr, x25_code);

	x25_data_ptr = X25_data_ptr;
	x25_data.flags.mpx_started = "0"b;
	x25_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 then listening
*/

shutdown:
     entry (X25_data_ptr, x25_code);

	x25_data_ptr = X25_data_ptr;
	if x25_data.state > X25_HUNGUP then call channel_manager$control (x25_data.devx, "hangup", null (), code);
	return;

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

/* Entry to perform privileged control orders */

priv_control:
     entry (X25_data_ptr, x25_order, x25_infop, x25_code);

	x25_data_ptr = X25_data_ptr;
	order = x25_order;
	x25_code = 0;

	if /* case */ order = "copy_meters" then do;
	     call channel_manager$control (x25_data.devx, order, x25_infop, x25_code);
	     end;

	else if order = "get_meters" then do;
	     call channel_manager$control (x25_data.devx, order, x25_infop, x25_code);
	     end;

	else if order = "x25_packet_trace_on" then x25_data.packet_trace_sw = "1"b;
	else if order = "x25_packet_trace_off" then x25_data.packet_trace_sw = "0"b;
	else x25_code = error_table_$undefined_order_request;

	return;

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

/* Entry to perform highly privileged control orders */

hpriv_control:
     entry (X25_data_ptr, x25_order, x25_infop, x25_code);

	x25_data_ptr = X25_data_ptr;
	order = x25_order;
	code = 0;

	if /* case */ order = "load_mpx" then do;	/* bootload the multiplexed device */
	     ttybp = addr (tty_buf$);
	     lctp = tty_buf.lct_ptr;
	     x25_load_infop = x25_infop;		/* save load info */

	     if x25_load_info.version ^= X25_LOAD_INFO_VERSION_1 then do;
		x25_code = error_table_$unimplemented_version;
		return;
		end;

	     if x25_data.state > X25_HUNGUP then do;	/* one at a time please */
		x25_code = error_table_$action_not_performed;
		return;
		end;

	     x25_data.n_lc = x25_load_info.n_lc;
	     call tty_space_man$get_space (size (x25_lces), x25_data.lc_ptr);
	     if x25_data.lc_ptr = null () then do;
		x25_code = error_table_$noalloc;
		return;
		end;

	     x25_data.load_proc_id = x25_load_info.pid;
	     x25_data.load_ev_chan = x25_load_info.ev_chan;

	     unspec (activate_order) = ""b;
	     activate_order.dce_or_dte = x25_load_info.dce;
	     activate_order.lap_or_lapb = x25_load_info.abm;
	     activate_order.disc_first = x25_load_info.disc_first;
	     activate_order.activation_order = "001"b3;
	     activate_order.trace_off = x25_load_info.trace_off;
	     activate_order.frame_size = x25_load_info.frame_size;
	     activate_order.K = x25_load_info.k;
	     activate_order.N2 = x25_load_info.n2;
	     activate_order.T1 = fixed (10e0 * x25_load_info.t1, 9);
	     activate_order.T3 = fixed (x25_load_info.t3, 9);

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

	     x25_data.net_type = x25_load_info.net_type;
	     x25_data.my_address = x25_load_info.my_address;
	     string (x25_data.flags) = ""b;
	     x25_data.flags.bypass_restart = x25_load_info.bypass_restart;
	     x25_data.flags.no_d = x25_load_info.no_d;
	     x25_data.flags.out_calls_collect = x25_load_info.flags.out_calls_collect;
	     x25_data.seq_mod = modulus8;
	     x25_data.gfid = "01"b;
	     x25_data.long_packet_size = x25_load_info.long_packet_size;
	     x25_data.breakall_idle_timer = x25_load_info.breakall_idle_timer;

	     do lcx = 1 to x25_data.n_lc;		/* init subchannel entries */
		xlcep = addr (x25_lces.lc (lcx));
		xlce.state = READY;
		xlce.scx = 0;
		xlce.max_packet_size = x25_load_info.max_packet_size;
		xlce.max_window_size = x25_load_info.window_size;
		xlce.window_size = x25_load_info.window_size;
		string (xlce.flags) = ""b;
	     end;

	     do scx = 1 to x25_data.n_sc;
		xscep = addr (x25_data.sc (scx));
		lctep = addr (lct.lcte_array (xsce.devx));
		lcte.physical_channel_devx = xsce.devx;
	     end;

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

	     x25_data.state = X25_LISTENING;
	     end;

	else if order = "set_long_packet_threshold" then do;
	     infop = x25_infop;
	     if infop = null () then code = error_table_$null_info_ptr;
	     else if x25_data.state = X25_HUNGUP then code = error_table_$dev_nt_assnd;
	     else x25_data.long_packet_size = infop -> based_packet_size;
	     end;

	else code = error_table_$undefined_order_request;

	x25_code = code;
	return;
%page;
%include x25_data;
%include x25_load_info;
%include mux_init_info;
%include lct;
%include tty_buf;
%include channel_manager_dcls;
%include tty_space_man_dcls;
     end priv_x25_mpx;




		    sty_mpx.pl1                     11/11/89  1106.7r w 11/11/89  0803.8      180234



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

sty_mpx:
     procedure;

/* Ring 0 multiplexer module for pseudo-TTY's. */
/* Written by C. Hornig, March 1979. */
/* Rewritten by C. Hornig, July 1981 */
/* Fixed bug in answerback string mechanism, March 8, 1982 by Richard Lamson */
/* Fixed bug in line_control control order, 22 April 1982 by Richard Lamson */
/* Fixed EOP processing 24 April 1982 by Richard Lamson */
/* Removed "standard" tty modes from the string retured as tty modes
   1 May 1982 by Richard Lamson */
/* Fixed lost wakeup bug, December, 1982 by C. Hornig */
/* Made to accept and ignore orders made by set_terminal_data so
   set_term_type will work properly, December 1982 by J. Spencer Love */
/* Made to handle (set get)_required_access_class orders, April 1983 by Robert Coren */
/* Changed to free any allocated mode_info structures on hangup order, September 1984 by Robert Coren */
/* Changed to use tty_area_manager entries to prevent collision of allocates and frees, November 1984 by Robert Coren */

dcl  (
     (Dp, Infop, Chainp, Miip) ptr,
     Code fixed bin (35),
     (Subchan, Devx) fixed bin,
     More_sw bit aligned,
     Mode_list ptr,
     Modes character (*),
     Order character (*)
     ) parameter;

dcl  (my_pdep, her_pdep) ptr;
dcl  1 my_pde aligned like pde based (my_pdep);
dcl  1 her_pde aligned like pde based (her_pdep);

dcl  based_area area based;
dcl  based_ev_chn fixed bin (71) based;
dcl  based_access_class bit (72) aligned based;

dcl  based_modes (currentsize (her_pde.mode_ptr -> mode_string_info)) fixed bin (35) based;

dcl  infop pointer;

dcl  1 dial_out_info aligned based (infop),
       2 len fixed bin (21),
       2 destination char (dial_out_info.len);

dcl  1 rw_abort aligned based (infop),
       2 (w, r) bit unaligned;

dcl  1 write_status aligned based (infop),
       2 ev_chn fixed bin (71),
       2 output_pending bit (1);

dcl  based_line_status bit (72) aligned based (infop);
dcl  line_status bit (72) aligned;

dcl  (
     error_table_$undefined_order_request,
     error_table_$inconsistent,
     error_table_$null_info_ptr,
     error_table_$unimplemented_version,
     error_table_$bad_mode,
     error_table_$ai_already_set,
     error_table_$noalloc
     ) fixed bin (35) external;

dcl  tty_area$ area external;

dcl  formline_ entry (fixed bin, fixed bin, ptr, fixed bin (21), fixed bin (1));
dcl  mode_string_$combine entry (ptr, ptr, char (*), fixed bin (35));
dcl  mode_string_$delete entry (ptr, (*) char (*), char (*), fixed bin (35));
dcl  mode_string_$parse entry (char (*), ptr, ptr, fixed bin (35));
dcl  tty_area_manager$allocate entry (fixed bin, ptr);
dcl  tty_area_manager$free entry (fixed bin, ptr);
dcl  tty_area_manager$lock_area entry ();
dcl  tty_area_manager$unlock_area entry ();

dcl  (sc, i) fixed;
dcl  mode_error bit (1) aligned;
dcl  blocko uns fixed bin (18);
dcl  code fixed bin (35);

dcl  FF_CR_LF char (3) static options (constant) init ("
");						/* FF, CR, LF */

dcl  (addr, binary, currentsize, divide, length, mod, null, pointer, rel, rtrim, size, substr, unspec) builtin;

dcl  (area, cleanup) condition;
%page;
/* * * * * * * * * * CONTROL * * * * * * * * * */

control:
     entry (Dp, Subchan, Order, Infop, Code);

	Code = 0;
	infop = Infop;
	call setup_subchan;

	if /* case */ Order = "listen" then do;
	     my_pde.location = "";
	     call bring_up_keep_ac;
	     end;

	else if Order = "dial_out" then do;
	     if infop ^= null () then do;
		call bring_up_keep_ac;
		my_pde.location = dial_out_info.destination;
		end;
	     else Code = error_table_$null_info_ptr;
	     end;

	else if Order = "hangup" then do;
	     call channel_manager$interrupt_later (her_pde.devx, HANGUP, ""b);
	     call channel_manager$interrupt_later (my_pde.devx, HANGUP, ""b);
	     my_pde.access_class_set,			/* clear out all access_class information */
		her_pde.access_class_set = "0"b;
	     my_pde.access_class, her_pde.access_class = "0"b;
	     call abort (my_pde);			/* free buffers */
	     call abort (her_pde);
	     if my_pde.mode_ptr ^= null () then call tty_area_manager$free (currentsize (my_pde.mode_ptr -> mode_string_info), my_pde.mode_ptr);
	     if her_pde.mode_ptr ^= null () then call tty_area_manager$free (currentsize (her_pde.mode_ptr -> mode_string_info), her_pde.mode_ptr);
	     my_pde.mode_ptr, her_pde.mode_ptr = null ();
	     my_pde.flags.listen, her_pde.flags.listen = "0"b;
	     end;

	else if Order = "wru" then do;
	     my_pde.flags.wru = "1"b;
	     if her_pde.head = 0 then call channel_manager$interrupt_later (my_pde.devx, INPUT_AVAILABLE, ""b);
	     end;

	else if Order = "abort" then do;
	     if infop ^= null () then do;
		if rw_abort.w then call abort (my_pde); /* free chained buffers */
		if rw_abort.r then call abort (her_pde);
		end;
	     else Code = error_table_$null_info_ptr;
	     end;

	else if Order = "write_status" then do;
	     if infop ^= null ()
	     then write_status.output_pending = (my_pde.head ^= 0);
						/* anything on list? */
	     else Code = error_table_$null_info_ptr;
	     end;

	else if Order = "interrupt" then do;
	     her_pde.end_of_page = "0"b;
	     call channel_manager$interrupt_later (her_pde.devx, QUIT, ""b);
	     call send_output (her_pde);
	     end;

	else if Order = "line_control" then do;
	     if infop = null () then do;
		Code = error_table_$null_info_ptr;
		return;
		end;
	     line_status = based_line_status;
	     call channel_manager$interrupt_later (her_pde.devx, LINE_STATUS, line_status);
	     end;

	else if Order = "printer_on" then call new_mode ("echo");

	else if Order = "printer_off" then call new_mode ("^echo");

	else if Order = "get_foreign_terminal_data" then do;
	     foreign_terminal_data_ptr = infop;
	     if foreign_terminal_data_ptr = null () then do;
		Code = error_table_$null_info_ptr;
		return;
		end;
	     if foreign_terminal_data.version ^= FOREIGN_TERMINAL_DATA_VERSION_1 then do;
		Code = error_table_$unimplemented_version;
		return;
		end;
	     foreign_terminal_data.mode_string_info_ptr = null ();
	     if her_pde.mode_ptr ^= null () then do;
		on area goto noalloc;
		allocate based_modes in (foreign_terminal_data.area_ptr -> based_area)
		     set (foreign_terminal_data.mode_string_info_ptr);
		foreign_terminal_data.mode_string_info_ptr -> based_modes = her_pde.mode_ptr -> based_modes;
		end;
	     her_pde.flags.notify_modes = "1"b;
	     end;

	else if Order = "set_required_access_class" then do;
	     if infop = null () then Code = error_table_$null_info_ptr;
	     else if my_pde.access_class_set		/* it's already been set */
	     then if my_pde.access_class = infop -> based_access_class
						/* but to the same thing */
		then Code = 0;			/* so it's OK */
		else Code = error_table_$ai_already_set;

	     else do;				/* not already set, do it now */
		my_pde.access_class, her_pde.access_class = infop -> based_access_class;
		my_pde.access_class_set, her_pde.access_class_set = "1"b;
		Code = 0;
		end;
	     end;

	else if Order = "get_required_access_class" then do;
	     if infop = null ()
	     then Code = error_table_$null_info_ptr;
	     else do;
		infop -> tty_access_class.access_class_set = my_pde.access_class_set;
		if my_pde.access_class_set
		then infop -> tty_access_class.access_class = my_pde.access_class;
		else infop -> tty_access_class.access_class = "0"b;
						/* for cleanliness */
		Code = 0;
		end;
	     end;

	else if Order = "input_flow_control_chars" then ;
	else if Order = "output_flow_control_chars" then ;
	else if Order = "set_delay" then ;
	else if Order = "set_framing_chars" then ;

	else Code = error_table_$undefined_order_request;

	return;
%page;
/* * * * * * * * * * WRITE * * * * * * * * * */

write:
     entry (Dp, Subchan, Chainp, Code);

	Code = 0;
	call setup_subchan;

	my_pde.flags.output_ready = "0"b;

	if Chainp = null () then return;

	if my_pde.end_of_page then return;		/* No, No, you can't write right now... */

	if her_pde.end_of_page then do;		/* Let other end send more output. */
	     her_pde.end_of_page = "0"b;		/* and take it out of EOP */
	     call send_output (her_pde);
	     blockp = Chainp;
	     if (buffer.next = 0)			/* only one buffer */
		& (buffer.tally <= 2)		/* with not much in it */
		& (verify (substr (string (buffer.chars), 1, buffer.tally), FF_CR_LF) = 0) then do;
						/* consisting exclusively of line-terminators */
		call tty_space_man$free_buffer (my_pde.devx, OUTPUT, Chainp);
						/* throw it away */
		call send_output (my_pde);		/* and send more */
		Chainp = null ();
		return;
		end;
	     end;

	blockp = Chainp;
	blocko = buffer.next;
	do while (blocko ^= 0 & ^buffer.end_of_page);	/* walk chain looking for EOP */
	     blockp = pointer (addr (tty_buf$), blocko);
	     blocko = buffer.next;
	end;

	buffer.next = 0;				/* Remove tail of this chain now. */
	buffer.flags.break = "1"b;			/* set break flag in last buffer */
	my_pde.flags.end_of_page = buffer.end_of_page;	/* note if we are at page break */
	if my_pde.head = 0				/* chain in the buffers */
	then do;					/* new chain */
	     my_pde.head = binary (rel (Chainp), 18);
	     my_pde.tail = binary (rel (blockp), 18);
	     call channel_manager$interrupt_later (her_pde.devx, INPUT_AVAILABLE, ""b);
						/* and tell the other side */
	     end;

	else do;					/* add to existing chain */
	     pointer (addr (tty_buf$), my_pde.tail) -> buffer.next = binary (rel (Chainp), 18);
	     my_pde.tail = binary (rel (blockp), 18);
	     end;

	if blocko = 0
	then					/* Are there any buffers after EOP? */
	     Chainp = null ();			/* No, we took it all */
	else Chainp = pointer (addr (tty_buf$), blocko);	/* Get later buffers after clear EOP */
	return;
%page;
/* * * * * * * * * * READ * * * * * * * * * */

read:
     entry (Dp, Subchan, Chainp, More_sw, Code);

	Code = 0;
	Chainp = null ();
	More_sw = "0"b;
	call setup_subchan;

	if /* case */ her_pde.head ^= 0 then do;	/* if there is any data */
	     Chainp = pointer (addr (tty_buf$), her_pde.head);
						/* give it away */
	     her_pde.head, her_pde.tail = 0;		/* and forget it */
	     call tty_space_man$switch_chain (her_pde.devx, my_pde.devx, OUTPUT, INPUT, Chainp);
	     call send_output (her_pde);		/* solicit more */
	     end;

	else if my_pde.flags.wru then do;
	     call tty_space_man$get_buffer (my_pde.devx, 16, INPUT, blockp);
	     if blockp ^= null () then do;
		my_pde.flags.wru = "0"b;
		string (buffer.chars) = rtrim (her_pde.location) || "
" /* NL */;
		buffer.tally = length (rtrim (string (buffer.chars)));
		string (buffer.flags) = ""b;
		buffer.flags.break = "1"b;
		buffer.next = 0;

		Chainp = blockp;
		end;
	     end;

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

check_modes:
     entry (Dp, Subchan, Mode_list, Code);

	Code = 0;
	call setup_subchan;

	mclp = Mode_list;
	if mcl.version ^= mcl_version_2 then do;
	     Code = error_table_$unimplemented_version;
	     return;
	     end;

	mcl.ll_error, mcl.pl_error, mcl.can_type_error = "0"b;

	do i = 1 to mcl.n_entries;
	     mcl.entries (i).flags.mpx_mode = "1"b;
	     mcl.entries (i).flags.error = "0"b;
	end;

	return;

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

set_modes:
     entry (Dp, Subchan, Mode_list, Code);

	Code = 0;
	call setup_subchan;

	mclp = Mode_list;
	if mcl.version ^= mcl_version_2 then do;
	     Code = error_table_$unimplemented_version;
	     return;
	     end;

	if mcl.flags.init & (my_pde.mode_ptr ^= null ()) then do;
	     call tty_area_manager$free (currentsize (my_pde.mode_ptr -> mode_string_info), my_pde.mode_ptr);
	     my_pde.mode_ptr = null ();
	     end;

	mcl.ll_error, mcl.pl_error, mcl.can_type_error = "0"b;

	if mcl.line_len ^= -1 then do;
	     call new_mode ("ll=^d", mcl.line_len);
	     mcl.ll_error = mode_error;
	     end;
	if mcl.page_len ^= -1 then do;
	     call new_mode ("pl=^d", mcl.page_len);
	     mcl.pl_error = mode_error;
	     end;
	if mcl.can_type ^= -1 then do;
	     call new_mode ("can_type=^[overstrike^;replace^]", mcl.can_type);
	     mcl.can_type_error = mode_error;
	     end;

	do i = 1 to mcl.n_entries;
	     if mcl.entries (i).mpx_mode then do;
		call new_mode ("^[^^^]^a", ^mcl.entries (i).flags.mode_switch, mcl.entries (i).mode_name);
		mcl.entries (i).flags.error = mode_error;
		end;
	end;

	return;

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

get_modes:
     entry (Dp, Subchan, Modes, Code);

	Code = 0;
	Modes = "";
	call setup_subchan;

	if my_pde.mode_ptr ^= null () then call mode_string_$delete (my_pde.mode_ptr, MODE_NAME, Modes, Code);
	if substr (Modes, length (rtrim (Modes)), 1) = "." then substr (Modes, length (rtrim (Modes)), 1) = " ";

	return;
%page;
/* * * * * * * * * * INIT_MULTIPLEXER * * * * * * * * * * */

init_multiplexer:
     entry (Devx, Miip, Dp, Code);

	Code = 0;
	lctp = addr (tty_buf$) -> tty_buf.lct_ptr;

	miip = Miip;
	sty_mpx_data_nchan = mux_init_info.no_channels;
	if mod (sty_mpx_data_nchan, 2) ^= 0 then do;	/* must come in pairs */
	     Code = error_table_$inconsistent;
	     return;
	     end;

	sty_mpx_data_ptr = null ();
	on cleanup
	     begin;
	     if sty_mpx_data_ptr ^= null () then call tty_area_manager$free (currentsize (sty_mpx_data), sty_mpx_data_ptr);
	end;
	on area goto noalloc;

	call tty_area_manager$allocate (size (sty_mpx_data), sty_mpx_data_ptr);

	sty_mpx_data.n_channels = sty_mpx_data_nchan;	/* tty_area_manager can't know to do this */
	sty_mpx_data.devx = Devx;
	sty_mpx_data.n_pairs = divide (sty_mpx_data.n_channels, 2, 17, 0);
	do sc = 1 to sty_mpx_data.n_channels;
	     my_pdep = addr (sty_mpx_data.pdes (sc));
	     call reset (my_pde, "1"b);
	     my_pde.head, my_pde.tail = 0;
	     my_pde.devx = mux_init_info.devx (sc);
	     my_pde.mode_ptr = null ();

	     lct.lcte_array (my_pde.devx).subchannel = sc;
	     lct.lcte_array (my_pde.devx).physical_channel_devx = my_pde.devx;
	end;

	Dp = sty_mpx_data_ptr;
	return;

noalloc:
	Code = error_table_$noalloc;
	return;

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

start:
     entry (Dp, Code);

	Code = 0;
	sty_mpx_data_ptr = Dp;

	sty_mpx_data.flags.started = "1"b;

	do i = 1 to sty_mpx_data.n_pairs;
	     my_pdep = addr (sty_mpx_data.pdes (i));
	     if my_pde.flags.listen then do;
		her_pdep = addr (sty_mpx_data.pdes (i + sty_mpx_data.n_pairs));
		call bring_up;
		end;
	end;

	return;

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

stop:
     entry (Dp, Code);

	Code = 0;
	sty_mpx_data_ptr = Dp;

	sty_mpx_data.flags.started = "0"b;
	return;

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

shutdown:
     entry (Dp, Code);

	Code = 0;
	sty_mpx_data_ptr = Dp;

	do sc = 1 to sty_mpx_data.n_channels;
	     call channel_manager$interrupt_later (sty_mpx_data.pdes (sc).devx, CRASH, ""b);
	     sty_mpx_data.pdes (sc).listen = "0"b;
	end;

	return;

/* * * * * * * * * * * TERMINATE_MULTIPLEXER * * * * * * * * * */

terminate_multiplexer:
     entry (Dp, Code);

	Code = 0;
	sty_mpx_data_ptr = Dp;

	do i = 1 to sty_mpx_data.n_channels;
	     my_pdep = addr (sty_mpx_data.pdes (i));
	     call abort (my_pde);
	     if my_pde.mode_ptr ^= null () then call tty_area_manager$free (currentsize (my_pde.mode_ptr -> mode_string_info), my_pde.mode_ptr);
	end;

	call tty_area_manager$free (currentsize (sty_mpx_data), sty_mpx_data_ptr);

	Dp = null ();
	return;
%page;
/* * * * * * * * * * SETUP_SUBCHAN * * * * * * * * * */

setup_subchan:
     procedure;

	sty_mpx_data_ptr = Dp;

	my_pdep = addr (sty_mpx_data.pdes (Subchan));
	her_pdep = addr (sty_mpx_data.pdes (mod (Subchan - 1 + sty_mpx_data.n_pairs, sty_mpx_data.n_channels) + 1));
	return;
     end setup_subchan;

/* * * * * * * * * ABORT * * * * * * * * * */

abort:
     procedure (Pde);
dcl  1 Pde aligned like pde;

	Pde.end_of_page = "0"b;
	if Pde.head ^= 0 then do;
	     call tty_space_man$free_chain (Pde.devx, OUTPUT, pointer (addr (tty_buf$), Pde.head));
	     Pde.head, Pde.tail = 0;
	     end;
	call send_output (Pde);
	return;
     end abort;

/* * * * * * * * * * NEW_MODE * * * * * * * * * */

new_mode:
     procedure options (variable);

dcl  old_mode_ptr ptr;
dcl  code fixed bin (35);
dcl  this_mode char (32);
dcl  combined_modes char (512);

	mode_string_info_ptr = null ();

	call formline_ (1, 2, addr (this_mode), length (this_mode), 1);

	call tty_area_manager$lock_area ();
	on cleanup call tty_area_manager$unlock_area ();

	call mode_string_$parse (this_mode, addr (tty_area$), mode_string_info_ptr, code);
	if code ^= 0 then goto bad_mode;

	call mode_string_$combine (my_pde.mode_ptr, mode_string_info_ptr, combined_modes, code);
	if code ^= 0 then goto bad_mode;

	free mode_string_info in (tty_area$);
	mode_string_info_ptr = null ();

	call mode_string_$parse (combined_modes, addr (tty_area$), mode_string_info_ptr, code);
	if code ^= 0 then goto bad_mode;

	old_mode_ptr = my_pde.mode_ptr;
	my_pde.mode_ptr = mode_string_info_ptr;
	if old_mode_ptr ^= null () then free old_mode_ptr -> mode_string_info in (tty_area$);
	call tty_area_manager$unlock_area ();

	if my_pde.flags.notify_modes then do;
	     call channel_manager$interrupt_later (her_pde.devx, LINE_STATUS, ""b);
	     my_pde.flags.notify_modes = "0"b;
	     end;

	mode_error = "0"b;
	return;

bad_mode:
	call tty_area_manager$unlock_area ();
	mode_error = "1"b;
	return;
     end new_mode;

/* * * * * * * * * * BRING_UP * * * * * * * * * */

bring_up:
     procedure;

dcl  reset_ac bit (1);

	reset_ac = "1"b;
	go to bring_up_join;

bring_up_keep_ac:
     entry;

	reset_ac = "0"b;

bring_up_join:
	if sty_mpx_data.flags.started & her_pde.flags.listen then do;
						/* is other side ready? */
	     unspec (dialup_info) = ""b;		/* yes, dial up */
	     dialup_info.line_type = LINE_ASCII;
	     dialup_info.max_buf_size = 128;
	     call channel_manager$interrupt_later (her_pde.devx, DIALUP, unspec (dialup_info));
	     call channel_manager$interrupt_later (my_pde.devx, DIALUP, unspec (dialup_info));

	     call reset (her_pde, reset_ac);
	     call reset (my_pde, reset_ac);
	     call send_output (her_pde);
	     call send_output (my_pde);
	     end;

	else my_pde.flags.listen = "1"b;		/* maybe later */

	return;
     end bring_up;

/* * * * * * * * * * RESET * * * * * * * * * */

reset:
     procedure (Pde, Reset_ac);
dcl  1 Pde aligned like pde;
dcl  Reset_ac bit (1);

dcl  old_ac_flag bit (1);

	if ^Reset_ac then old_ac_flag = Pde.access_class_set;
	string (Pde.flags) = ""b;
	if ^Reset_ac then Pde.access_class_set = old_ac_flag;
	Pde.location = "";
	if Reset_ac then Pde.access_class = "0"b;

	return;
     end reset;

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

send_output:
     procedure (Pde);
dcl  1 Pde aligned like pde;

	if ^Pde.flags.output_ready & ^Pde.flags.end_of_page & (Pde.head = 0) then do;
	     Pde.flags.output_ready = "1"b;
	     call channel_manager$interrupt_later (Pde.devx, SEND_OUTPUT, ""b);
	     end;
	return;
     end send_output;
%page;
%include sty_mpx_data;
%include foreign_terminal_data;
%include mcs_interrupt_info;
%include tty_buffer_block;
%include channel_manager_dcls;
%include mux_init_info;
%include lct;
%include tty_buf;
%include tty_space_man_dcls;
%include line_types;
%include mcs_modes_change_list;
%include mode_string_info;
%include tty_mode_names;
%include tty_access_class;

     end sty_mpx;





		    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
