console_server.pl1              07/18/86  1504.1rew 07/18/86  1235.1      250479



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



/****^  HISTORY COMMENTS:
  1) change(86-06-04,Hartogs), approve(86-06-04,MCR7383),
     audit(86-06-05,Coppola), install(86-07-18,MR12.0-1098):
     Changed to user version constant in rcp_device_info.incl.pl1.
                                                   END HISTORY COMMENTS */


/* CONSOLE_SERVER - Program to manage a console channel as a login device. */
/* Written May 1980 by Larry Johnson as his last official act. */

console_server: proc;

/* Automatic */

dcl  code fixed bin (35);
dcl  argp ptr;
dcl  argl fixed bin;
dcl  console_infop ptr;
dcl  consp ptr;
dcl  n_consoles fixed bin;
dcl  debug_sw bit (1);
dcl  forceread_sw bit (1);
dcl  argno fixed bin;
dcl  n_args fixed bin;
dcl  arg_list_ptr ptr;
dcl  prompt_string char (16);
dcl  prompt_string_length fixed bin (21);
dcl  more_args bit (1);
dcl  areap ptr;
dcl  processid bit (36);
dcl  i fixed bin;
dcl  event_wait_type_ptr ptr;
dcl  dial_manager_channel fixed bin (71);		/* Event channel for dealing with dial_manager */
dcl  comment char (128);
dcl  rcp_state fixed bin;
dcl  dmap ptr;					/* Pointer to dial_manager_arg structure */
dcl  io_module char (32);
dcl  device char (32);
dcl  input_len fixed bin (21);
dcl  xmit fixed bin (21);

dcl 1 auto_event_wait_info like event_wait_info aligned automatic;
dcl 1 auto_dial_manager_arg like dial_manager_arg aligned automatic;
dcl 1 get_channel_info aligned,			/* For get_channel_info order */
    2 version fixed bin,
    2 devx fixed bin,
    2 channel_name char (32);
dcl 1 dial_status aligned,				/* Flags set by convert dial message */
    2 dialed_up bit (1) unaligned,
    2 hung_up bit (1) unaligned,
    2 control bit (1) unaligned,
    2 pad bit (33) unaligned;
dcl 1 console_info aligned,				/* Info to control N consoles */
    2 console (8) like cons;				/* Can control 8 pairs */

dcl 1 greeting unal,
    2 cr1 char (1),
    2 nl1 char (1),
    2 pad1 (4) char (1),
    2 msg1 char (24) init ("Console server ready at "),
    2 msg2 char (24),
    2 cr2 char (1),
    2 nl2 char (1),
    2 pad2 (4) char (1);

dcl 1 crnl unal,
    2 cr char (1),
    2 nl char (1),
    2 pad (4) char (1);

/* Constants */

dcl  name char (14) int static options (constant) init ("console_server");
dcl  foo char (4) int static options (constant) init ("foo
");
dcl  CR_INIT bit (9) int static options (constant) init ("015"b3);
dcl  CR char (1) based (addr (CR_INIT));
dcl  NL_INIT bit (9) int static options (constant) init ("012"b3);
dcl  NL char (1) based (addr (NL_INIT));
dcl  NUL_INIT bit (9) int static options (constant) init ("000"b3);
dcl  NUL char (1) based (addr (NUL_INIT));
dcl  ESC_INIT bit (9) int static options (constant) init ("033"b3);
dcl  ESC char (1) based (addr (ESC_INIT));

dcl  WRITE_ASCII bit (6) int static options (constant) init ("33"b3);
dcl  READ_ASCII bit (6) int static options (constant) init ("23"b3);

/* Based */

dcl  arg char (argl) based (argp);
dcl  free_area area based (areap);

dcl 1 cons aligned based (consp),			/* Info for a single console */
    2 console_name char (32),				/* Name of console device */
    2 tty_name char (32),				/* Name of tty device */
    2 rcp_id bit (36) aligned,			/* Rcp id for console attachment */
    2 ioi_index fixed bin,				/* Ioi index for console */
    2 iocbp ptr,					/* IOCB pointer for tty_ switch */
    2 tty_devx fixed bin,				/* Ring 0's tty devx */
    2 state_index fixed bin,				/* Current state of console attachment */
						/* 1 = not attached, 2 = in progress, 3 = attached */
    2 io_state fixed bin,				/* Type of I/O in progress */
    2 rcp_channel fixed bin (71),			/* Event channel for ioi/rcp */
    2 tty_channel fixed bin (71),			/* Event channel for tty_ */
    2 rcp_device_info like device_info,			/* Copy of rcp device info structure for attachment */
    2 max_work fixed bin (19),			/* Max workspace size */
    2 max_time fixed bin (71),			/* Max connect time */
    2 workspacep ptr,				/* Address of ioi workspace */
    2 tty_buffer char (256),				/* Tty input done into here */
    2 tty_buffer_used fixed bin (21),
    2 tty_buffer_left fixed bin (21),
    2 suppress_next_read bit (1),
    2 tty_hungup bit (1);

/* Settings for cons.io_state */

dcl (IO_STATE_GREET init (1),				/* Writing greeting */
     IO_STATE_INIT init (2),				/* Waiting for initial request from console */
     IO_STATE_DIAL init (3),				/* Waiting for sty channel dial to complete */
     IO_STATE_IDLE init (4),				/* Every thing attached, but console idle */
     IO_STATE_WRITE init (5),				/* Write in progress */
     IO_STATE_READ init (6),				/* Read in progress */
     IO_STATE_NL init (7)				/* Writing NL after input */
     ) fixed bin int static options (constant);

dcl 1 ioi_work aligned based (cons.workspacep),		/* The ioi workspace */
    2 status_queue like istat,
    2 pcw bit (36),
    2 dcw1 bit (36),
    2 idcw bit (36),
    2 dcw2 bit (36),
    2 write_buffer char (512),
    2 read_buffer char (512);

dcl 1 event_wait_type (event_wait_list_n_channels) aligned based (event_wait_type_ptr),
    2 channel_type fixed bin,				/* 1 = dial_manager, 2 = rcp-/ioi, 3=tty */
    2 channel_index fixed bin;			/* Index into console array */

/* External */

dcl  analyze_ioi_istat_ entry (ptr, ptr, char (*) var);
dcl  com_err_ entry options (variable);
dcl  convert_dial_message_ entry (fixed bin (71), char (*), char (*), fixed bin, 1 like dial_status aligned, fixed bin (35));
dcl  convert_ipc_code_ entry (fixed bin (35));
dcl  cu_$arg_count entry (fixed bin);
dcl  cu_$arg_list_ptr entry (ptr);
dcl  cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin, fixed bin (35), ptr);
dcl  date_time_ entry (fixed bin (71), char (*));
dcl  dial_manager_$dial_out entry (ptr, fixed bin (35));
dcl  dial_manager_$release_channel entry (ptr, fixed bin (35));
dcl  get_process_id_ entry returns (bit (36));
dcl  get_system_free_area_ entry returns (ptr);
dcl  hcs_$tty_read entry (fixed bin, ptr, fixed bin (21), fixed bin (21), fixed bin (21), fixed bin, fixed bin (35));
dcl  hcs_$tty_write entry (fixed bin, ptr, fixed bin (21), fixed bin (21), fixed bin (21), fixed bin, fixed bin (35));
dcl  hcs_$wakeup entry (bit (36), fixed bin (71), fixed bin (71), fixed bin (35));
dcl  ioa_ entry options (variable);
dcl  ioi_$connect entry (fixed bin, fixed bin, fixed bin (35));
dcl  ioi_$connect_pcw entry (fixed bin, fixed bin, bit (36), fixed bin (35));
dcl  ioi_$set_status entry (fixed bin, fixed bin (18), fixed bin (8), fixed bin (35));
dcl  ioi_$workspace entry (fixed bin, ptr, fixed bin (18), fixed bin (35));
dcl  iox_$attach_name entry (char (*), ptr, char (*), ptr, fixed bin (35));
dcl  iox_$close entry (ptr, fixed bin (35));
dcl  iox_$control entry (ptr, char (*), ptr, fixed bin (35));
dcl  iox_$detach_iocb entry (ptr, fixed bin (35));
dcl  iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
dcl  iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35));
dcl  ipc_$block entry (ptr, ptr, fixed bin (35));
dcl  ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35));
dcl  ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35));
dcl  rcp_$attach entry (char (*), ptr, fixed bin (71), char (*), bit (36) aligned, fixed bin (35));
dcl  rcp_$check_attach entry (bit (36) aligned, ptr, char (*), fixed bin, fixed bin (19), fixed bin (71), fixed bin, fixed bin (35));
dcl  rcp_$detach entry (bit (36) aligned, bit (*), fixed bin, char (*), fixed bin (35));
dcl  timer_manager_$sleep entry (fixed bin (71), bit (2));

dcl  error_table_$noarg ext fixed bin (35);
dcl  error_table_$badopt ext fixed bin (35);
dcl  opc_status_table_$opc_status_table_ ext;

dcl  cleanup condition;

dcl (addr, bin, bit, clock, divide, hbound, index, length, low, min, null, rel, reverse, string, substr, unspec) builtin;

/* Argument processing */

	call cu_$arg_list_ptr (arg_list_ptr);
	call cu_$arg_count (n_args);

	n_consoles = 0;
	event_wait_list_ptr = null ();
	event_wait_type_ptr = null ();
	dial_manager_channel = 0;

	call scan_args;

	on cleanup call clean_up;

/* Set up event channels and wait list */

	processid = get_process_id_ ();
	event_wait_list_n_channels = 2 * n_consoles + 1;
	areap = get_system_free_area_ ();
	allocate event_wait_list in (free_area);
	event_wait_list.n_channels = 0;

	allocate event_wait_type in (free_area);

	dial_manager_channel = get_evchn ();
	call store_chan (dial_manager_channel, 1, 0);
	do i = 1 to n_consoles;
	     consp = addr (console_info.console (i));
	     cons.rcp_channel = get_evchn ();
	     call store_chan (cons.rcp_channel, 2, i);
	     cons.state_index = 1;
	     call hcs_$wakeup (processid, cons.rcp_channel, (0), code); /* Wakeup to kick things off */
	end;

/* The program should, from now on, spend most of its time, here, blocked */

	event_wait_info_ptr = addr (auto_event_wait_info);
block:	call ipc_$block (event_wait_list_ptr, event_wait_info_ptr, code);
	if code ^= 0 then do;
	     call convert_ipc_code_ (code);
	     call com_err_ (code, name, "Unable to block.");
	     go to done;
	end;

/* Got a wakeup.  branch depending on who it is from/for */

	go to wakeup_type (event_wait_type.channel_type (event_wait_info.channel_index));

wakeup_type (1):
	go to dial_manager_wakeup;
wakeup_type (2):
	go to rcp_ioi_wakeup;
wakeup_type (3):
	go to tty_wakeup;

done:	call clean_up;
	return;

/* Process dial_manager_wakeup */

dial_manager_wakeup:
	call convert_dial_message_ (event_wait_info.message, device, io_module, (0), dial_status, code);
	if code ^= 0 then do;
	     call com_err_ (code, name, "Bad dial code");
	     go to done;
	end;
	if dial_status.dialed_up then do;
	     if debug_sw then call ioa_ ("^a dialed", device);
	     do i = 1 to n_consoles;
		consp = addr (console_info.console (i));
		if cons.tty_name = device then do;
		     if cons.io_state ^= IO_STATE_DIAL then go to bad_dial;
		     call iox_$attach_name (device, cons.iocbp, "tty_ " || device, null (), code);
		     if code ^= 0 then do;
			call com_err_ (code, name, "Unable to attach ^a", device);
			go to done;
		     end;
		     call iox_$open (cons.iocbp, Stream_input_output, "0"b, code);
		     if code ^= 0 then do;
			call com_err_ (code, name, "Unable to open ^a", device);
			go to done;
		     end;
		     get_channel_info.version = 1;
		     call iox_$control (cons.iocbp, "get_channel_info", addr (get_channel_info), code);
		     if code ^= 0 then do;
			call com_err_ (code, name, "Unable to get devx for ^a", device);
			go to done;
		     end;
		     cons.tty_devx = get_channel_info.devx;
		     call iox_$control (cons.iocbp, "event_info", addr (cons.tty_channel), code);
		     if code ^= 0 then do;
			call com_err_ (code, name, "Unable to get event channel used for ^a", device);
			go to done;
		     end;
		     call store_chan (cons.tty_channel, 3, i);
		     cons.io_state = IO_STATE_IDLE;
		     go to tty_read;
		end;
	     end;
bad_dial:	     call ioa_ ("Ignored dialup for ^a", device);
	     go to block;
	end;

	else if dial_status.hung_up then do;
	     if debug_sw then call ioa_ ("^a hungup", device);
	     do i = 1 to n_consoles;
		consp = addr (console_info.console (i));
		if cons.tty_name = device then do;
		     if cons.iocbp ^= null then do;
			call iox_$close (cons.iocbp, code);
			call iox_$detach_iocb (cons.iocbp, code);
			call forget_chan (cons.tty_channel);
			cons.tty_channel = 0;
			cons.iocbp = null ();
		     end;
		     call reset_tty_buffer;
		     cons.tty_hungup = "0"b;
		     if cons.io_state = IO_STATE_IDLE | cons.io_state = IO_STATE_INIT | cons.io_state = IO_STATE_DIAL then
			go to prepare_greeting;
		     cons.tty_hungup = "1"b;
		     go to block;
		end;
	     end;
	     call ioa_ ("Ignored hangup for ^a", device);
	     go to block;
	end;
	go to block;

/* Come here on RCP or IOI wakeups */

rcp_ioi_wakeup:
	consp = addr (console_info.console (event_wait_type.channel_index (event_wait_info.channel_index)));
	go to rcp_wakeup (cons.state_index);

/* Console must be attached from RCP */

rcp_wakeup (1):
	device_info_ptr = addr (cons.rcp_device_info);
	device_info.version_num = DEVICE_INFO_VERSION_1;
	device_info.usage_time = 0;
	device_info.wait_time = 0;
	device_info.system_flag = "0"b;
	device_info.device_name = cons.console_name;
	device_info.model = 0;
	device_info.qualifiers (*) = 0;

	call rcp_$attach ("special", device_info_ptr, cons.rcp_channel, "", cons.rcp_id, code);
	if code ^= 0 then do;
attach_err:    call com_err_ (code, name, "Unable to attach ^a.", cons.console_name);
	     go to done;
	end;
	cons.state_index = 2;


/* Wakup to complete attachment */

rcp_wakeup (2):
	device_info_ptr = addr (cons.rcp_device_info);
	call rcp_$check_attach (cons.rcp_id, device_info_ptr, comment, cons.ioi_index, cons.max_work, cons.max_time,
	     rcp_state, code);
	if rcp_state = 3 then go to attach_err;
	if rcp_state = 1 then do;			/* Short wait */
	     if comment ^= "" then call ioa_ ("^a: Waiting for attachment of ^a. ^a", name, cons.console_name, comment);
	     go to block;
	end;
	if rcp_state = 2 then do;			/* Long wait */
	     call ioa_ ("^a: Long wait for attachment of ^a. ^a", name, cons.console_name, comment);
	     go to block;
	end;
	if rcp_state ^= 0 then go to attach_err;	/* 0 should be all thats left */
	cons.state_index = 3;			/* Now attached */

	call ioi_$workspace (cons.ioi_index, cons.workspacep, 1024, code);
	if code ^= 0 then do;
	     call com_err_ (code, name, "Unable to get workspace for ^a", cons.console_name);
	     go to done;
	end;
	call ioi_$set_status (cons.ioi_index, bin (rel (addr (ioi_work.status_queue))), 1, code);
	if code ^= 0 then do;
	     call com_err_ (code, name, "Unable to setup status queue for ^a", cons.console_name);
	     go to done;
	end;
	if debug_sw then call ioa_ ("^a: ^a attached", name, cons.console_name);

prepare_greeting:
	cons.tty_hungup = "0"b;
	greeting.cr1, greeting.cr2 = CR;
	greeting.nl1, greeting.nl2 = NL;
	greeting.pad1 (*), greeting.pad2 (*) = NUL;
	call date_time_ (clock (), greeting.msg2);
	cons.tty_buffer = string (greeting);
	call setup_output (addr (cons.tty_buffer), length (string (greeting)));
	call connect;
	cons.io_state = IO_STATE_GREET;
	go to block;

/* This wakeup is really from IOI_ */

rcp_wakeup (3):
	imp = addr (event_wait_info.message);
	isp = addr (ioi_work.status_queue);
	statp = addr (istat.iom_stat);
	if imess.level = "7"b3 then do;		/* This is a special */
	     if cons.tty_hungup then go to block;
	     else go to ioi_special (cons.io_state);
	end;
	else if imess.level = "3"b3 then do;
	     if cons.tty_hungup then go to prepare_greeting;
	     else go to ioi_terminate (cons.io_state);
	end;
	else if cons.tty_hungup then go to prepare_greeting;
	else return;

/* Process special status */

ioi_special (2):					/* No device attached yet */
attach_terminal:
	dmap = addr (auto_dial_manager_arg);
	dmap -> dial_manager_arg.version = dial_manager_arg_version_2;
	dmap -> dial_manager_arg.dial_out_destination = cons.console_name; /* Ignored, but make nice message on console */
	dmap -> dial_manager_arg.dial_channel = dial_manager_channel;
	dmap -> dial_manager_arg.channel_name = cons.tty_name;
	dmap -> dial_manager_arg.reservation_string = "";
	call dial_manager_$dial_out (dmap, code);
	if code ^= 0 then do;
	     call com_err_ (code, name, """Dialing"" to ^a.", cons.tty_name);
	     go to done;
	end;
	cons.io_state = IO_STATE_DIAL;
	go to block;

ioi_special (1):
ioi_special (3):
ioi_special (0):
ioi_special (6):
ioi_special (7):
	go to block;				/* Ignore more specials until channel is dialed */

ioi_special (4):
start_read:
	call setup_input;				/* Request while idle */
	call connect;
	cons.io_state = IO_STATE_READ;
	go to block;

ioi_special (5):					/* Request during outpuit */
	call cause_quit;
	go to block;

/* Process terminate status */


ioi_terminate (1):
	if istat.er & debug_sw then call print_io_error ("Error writing greeting");
	cons.io_state = IO_STATE_INIT;
	if forceread_sw then go to start_read;
	go to block;
ioi_terminate (2):
ioi_terminate (3):
ioi_terminate (4):
ioi_terminate (0):
	go to block;
ioi_terminate (5):
ioi_terminate (7):
	if istat.er & debug_sw then call print_io_error ("Write");
	cons.io_state = IO_STATE_IDLE;
	go to tty_read;
ioi_terminate (6):					/* End of input */
	cons.io_state = IO_STATE_IDLE;
	if cons.iocbp = null () then do;		/* Must be forceread mode */
	     if ^istat.er then go to attach_terminal;
	     if status.major = "0011"b & status.sub = "001000"b then do; /* operator discracted */
		cons.io_state = IO_STATE_INIT;
		go to block;
	     end;
	     else go to attach_terminal;
	end;
	if ^istat.st then go to write_nl;
	if istat.er then do;
	     if debug_sw then call print_io_error ("Read");
	     statp = addr (istat.iom_stat);
	     if status.major = "0011"b & status.sub = "001000"b then /* Operator distracted */
		cons.suppress_next_read = "1"b;
	     else cons.suppress_next_read = "0"b;
	     go to write_nl;
	end;
	input_len = length (ioi_work.read_buffer) - 4 * bin (status.tally);
	if status.char_pos ^= "0"b then
	     input_len = input_len - (4 - bin (status.char_pos, 3));
	if input_len = 2 then if substr (ioi_work.read_buffer, 1, 2) = "!q" then do;
		call cause_quit;
		go to write_nl;
	     end;
	substr (ioi_work.read_buffer, input_len + 1, 1) = NL;
	if input_len = 0 then cons.suppress_next_read = "1"b;
	else cons.suppress_next_read = "0"b;
	input_len = input_len + 1;
	call iox_$put_chars (cons.iocbp, addr (ioi_work.read_buffer), input_len, code);

write_nl:	crnl.cr = CR;
	crnl.nl = NL;
	crnl.pad (*) = NUL;
	call setup_output (addr (crnl), length (string (crnl)));
	call connect;
	cons.io_state = IO_STATE_NL;
	go to tty_read;

/* Process tty wakeups */

tty_wakeup:
	consp = addr (console_info.console (event_wait_type.channel_index (event_wait_info.channel_index)));
tty_read:	if cons.io_state ^= IO_STATE_IDLE then go to block;
	call fill_tty_buffer;
	if cons.tty_buffer_used = 0 then do;
no_input:	     if forceread_sw then do;
		if cons.suppress_next_read then do;
		     cons.suppress_next_read = "0"b;
		     go to block;
		end;
		else go to start_read;
	     end;
	     else go to block;
	end;
	i = index (reverse (substr (cons.tty_buffer, 1, cons.tty_buffer_used)), NL); /* Try to break at line */
	if i ^= 0 then do;
	     xmit = cons.tty_buffer_used - i + 1;
	     do while (xmit < cons.tty_buffer_used & substr (cons.tty_buffer, xmit + 1, 1) = NUL);
		xmit = xmit + 1;			/* Include padding for NL */
	     end;
	end;
	else do;					/* No NL's */
	     xmit = cons.tty_buffer_used;
	     if substr (cons.tty_buffer, xmit, 1) = ESC then
		xmit = xmit - 1;			/* Console ignores trailing escapes */
	     if xmit = 0 then go to no_input;		/* Hold on to lone escape until rest of output arrives */
	end;
	call setup_output (addr (cons.tty_buffer), xmit);
	if xmit < cons.tty_buffer_used then		/* Shift remaining text */
	     substr (cons.tty_buffer, 1, cons.tty_buffer_used - xmit) = substr (cons.tty_buffer, xmit + 1, cons.tty_buffer_used - xmit);
	cons.tty_buffer_used = cons.tty_buffer_used - xmit;
	cons.tty_buffer_left = cons.tty_buffer_left + xmit;

	call connect;
	cons.io_state = IO_STATE_WRITE;
	cons.suppress_next_read = "0"b;
	go to block;

fill_tty_buffer: proc;

dcl  amt_read fixed bin (21);
dcl  state fixed bin;

	     amt_read = -1;
	     do while (cons.tty_buffer_left > 0 & amt_read ^= 0);
		call hcs_$tty_read (cons.tty_devx, addr (cons.tty_buffer), cons.tty_buffer_used, cons.tty_buffer_left,
		     amt_read, state, code);
		if code ^= 0 then amt_read = 0;
		cons.tty_buffer_used = cons.tty_buffer_used + amt_read;
		cons.tty_buffer_left = cons.tty_buffer_left - amt_read;
	     end;
	     return;

	end fill_tty_buffer;

reset_tty_buffer: proc;

	     cons.tty_buffer_used = 0;
	     cons.tty_buffer_left = length (cons.tty_buffer);
	     cons.tty_buffer = "";
	     return;

	end reset_tty_buffer;

cause_quit: proc;

	     call reset_tty_buffer;
	     call iox_$control (cons.iocbp, "abort", null (), code);
	     call iox_$control (cons.iocbp, "interrupt", null (), code);
	     return;

	end cause_quit;

/* Setup dcw list for doing output */

setup_output: proc (p, n);

dcl  p ptr;					/* Address of data */
dcl  n fixed bin (21);				/* Its length */
dcl  c char (n) based (p);
dcl  tally fixed bin (12) uns;
dcl  cpos fixed bin (3) uns;

	     tally = divide (n + 3, 4, 17, 0);		/* Length of message in words */
	     cpos = 4 * tally - n;			/* Where to start so end is word boundry */
	     substr (ioi_work.write_buffer, cpos + 1, n) = c; /* Copy into buffer */
	     if cpos > 0 then substr (ioi_work.write_buffer, 1, cpos) = low (cpos);
						/* Does neatness count? */

	     idcwp = addr (ioi_work.pcw);
	     unspec (idcw) = "0"b;
	     idcw.command = WRITE_ASCII;
	     idcw.code = "111"b;
	     dcwp = addr (ioi_work.dcw1);
	     unspec (dcw) = "0"b;
	     dcw.address = rel (addr (ioi_work.write_buffer));
	     dcw.tally = bit (tally);
	     dcw.char_pos = bit (cpos);
	     return;

	end setup_output;

setup_input: proc;

dcl  tally fixed bin (12) uns;

	     if prompt_string_length = 0 then do;
		idcwp = addr (ioi_work.pcw);
		dcwp = addr (ioi_work.dcw1);
	     end;
	     else do;
		call setup_output (addr (prompt_string), prompt_string_length);
		idcwp = addr (ioi_work.pcw);
		substr (idcw.control, 1, 1) = "1"b;	/* Continue */
		idcwp = addr (ioi_work.idcw);
		dcwp = addr (ioi_work.dcw2);
	     end;
	     unspec (idcw) = "0"b;
	     idcw.command = READ_ASCII;
	     idcw.code = "111"b;
	     unspec (dcw) = "0"b;
	     dcw.address = rel (addr (ioi_work.read_buffer));
	     tally = divide (length (ioi_work.read_buffer), 4, 12, 0);
	     dcw.tally = bit (tally);
	     return;

	end setup_input;

connect:	proc;

	     call ioi_$connect_pcw (cons.ioi_index, bin (rel (addr (ioi_work.dcw1))), (ioi_work.pcw), code);
	     return;

	end connect;

/* Scan argument list */

scan_args: proc;

dcl  console_expected bit (1);
dcl  i fixed bin;

	     console_expected = "1"b;
	     debug_sw = "0"b;
	     forceread_sw = "0"b;
	     prompt_string = "";
	     prompt_string_length = 0;
	     argno = 1;
	     more_args = (argno <= n_args);
	     if n_args = 0 then do;
usage:		call com_err_ (error_table_$noarg, name, "Usage: ^a console_name sty_name", name);
		go to done;
	     end;

	     do while (more_args);
		call get_arg;
		if substr (arg, 1, 1) = "-" then do;
		     if arg = "-debug" | arg = "-db" then debug_sw = "1"b;
		     else if arg = "-forceread" then forceread_sw = "1"b;
		     else if arg = "-prompt" then do;
			if ^more_args then do;
			     prompt_string = "->";
			     prompt_string_length = 2;
			end;
			else do;
			     call get_arg;
			     prompt_string = arg;
			     prompt_string_length = min (length (prompt_string), length (arg));
			end;
		     end;
		     else do;
			call com_err_ (error_table_$badopt, name, "^a", arg);
			go to done;

		     end;
		end;
		else if console_expected then do;
		     if n_consoles >= hbound (console_info.console, 1) then do;
			call com_err_ (0, name, "Too many consoles specifed. Max is ^d.",
			     hbound (console_info.console, 1));
			go to done;
		     end;
		     i = n_consoles + 1;
		     consp = addr (console_info.console (i));
		     cons.console_name = arg;
		     cons.tty_name = "";
		     cons.rcp_id = "0"b;
		     cons.ioi_index = -1;
		     cons.iocbp = null ();
		     cons.tty_devx = -1;
		     cons.state_index = 0;
		     cons.rcp_channel = 0;
		     cons.io_state = 0;
		     call reset_tty_buffer;
		     cons.suppress_next_read = "0"b;
		     cons.tty_hungup = "0"b;
		     n_consoles = i;
		     console_expected = "0"b;
		end;
		else do;
		     cons.tty_name = arg;
		     console_expected = "1"b;
		end;
	     end;

	     if n_consoles = 0 then go to usage;
	     if ^console_expected then do;
		call com_err_ (0, name, "No tty channel specified for ^a", cons.console_name);
		go to done;
	     end;

	end scan_args;

get_arg:	proc;

	     call cu_$arg_ptr_rel (argno, argp, argl, code, arg_list_ptr);
	     if code ^= 0 then do;			/* Cant fail */
		call com_err_ (code, name, "Arg ^d.", argno);
		go to done;
	     end;
	     argno = argno + 1;
	     more_args = (argno <= n_args);
	     return;

	end get_arg;

/* Entry to get an event channel */

get_evchn: proc returns (fixed bin (71));

dcl  ev fixed bin (71);

	     call ipc_$create_ev_chn (ev, code);
	     if code ^= 0 then do;
		call convert_ipc_code_ (code);
		call com_err_ (code, name, "Unable to create event channel.");
		go to done;
	     end;
	     return (ev);

	end get_evchn;

/* Entry to make list in event wait list for channel */

store_chan: proc (chan, type, index);

dcl  chan fixed bin (71);
dcl (type, index) fixed bin;
dcl  i fixed bin;

	     i = event_wait_list.n_channels + 1;
	     event_wait_list.n_channels = i;
	     event_wait_list.channel_id (i) = chan;
	     event_wait_type.channel_type (i) = type;
	     event_wait_type.channel_index (i) = index;
	     return;

	end store_chan;

free_chan: proc (chan);

dcl  chan fixed bin (71);

	     if chan = 0 then return;
	     call ipc_$delete_ev_chn (chan, code);
	     chan = 0;
	     return;

	end free_chan;

/* remove channel from wait list */

forget_chan: proc (chan);

dcl  chan fixed bin (71);
dcl  i fixed bin;

	     do i = 1 to event_wait_list.n_channels;
		if event_wait_list.channel_id (i) = chan then do;
		     do i = i + 1 to event_wait_list.n_channels;
			event_wait_list.channel_id (i - 1) = event_wait_list.channel_id (i);
		     end;
		     event_wait_list.channel_id (event_wait_list.n_channels) = 0;
		     event_wait_list.n_channels = event_wait_list.n_channels - 1;
		     return;
		end;
	     end;
	     return;

	end forget_chan;


print_io_error: proc (prefix);

dcl  prefix char (*);
dcl  message char (100) var;

	     call analyze_ioi_istat_ (isp, addr (opc_status_table_$opc_status_table_), message);
	     call ioa_ ("^a error on ^a: ^a", prefix, cons.console_name, message);
	     return;

	end print_io_error;


clean_up:	proc;

dcl  i fixed bin;

	     if event_wait_list_ptr ^= null () then do;
		event_wait_list.n_channels = event_wait_list_n_channels;
		free event_wait_list;
	     end;
	     if event_wait_type_ptr ^= null () then
		free event_wait_type;

	     do i = 1 to n_consoles;
		consp = addr (console_info.console (i));
		call free_chan (cons.rcp_channel);
		if cons.rcp_id ^= "0"b then
		     call rcp_$detach (cons.rcp_id, "0"b, 0, "", code);
		if cons.io_state > IO_STATE_INIT then do;
		     if cons.iocbp ^= null () then do;
			call iox_$close (cons.iocbp, code);
			call iox_$detach_iocb (cons.iocbp, code);
		     end;
		     dmap = addr (auto_dial_manager_arg);
		     dmap -> dial_manager_arg.version = dial_manager_arg_version_2;
		     dmap -> dial_manager_arg.dial_qualifier = "";
		     dmap -> dial_manager_arg.dial_channel = dial_manager_channel;
		     dmap -> dial_manager_arg.channel_name = cons.tty_name;
		     call dial_manager_$release_channel (dmap, code);
		end;
	     end;

	     call free_chan (dial_manager_channel);

	     return;

	end clean_up;

%include event_wait_list;

%include event_wait_info;

%include rcp_device_info;

%include ioi_stat;

%include iom_stat;

%include dial_manager_arg;

%include iox_modes;

%include iom_pcw;

%include iom_dcw;

     end console_server;






		    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