



		    g115_.pl1                       08/30/82  1519.8rew 08/30/82  1138.3      373707



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


g115_: proc;

	return;					/* not a legal entry */


/* Rewritten by D. Vinograd, 11/77, to make the G115 an iox based module for MR 6.1 */
/* Modified by J. Nicholls 7/78 to change full_cc to rr_cnt to use reocrd counting instead of character counting */
/* Modified by D. Vinograd, 10/78, for compatibility with MCS 3.3 and above */
/* Modified by J. C. Whitmore, 11/78, to make all attach options consistent with the remote_xxx_ dims */
/* Modified by J. C. Whitmore, 3/79, to correct size and initialization of delay variable */
/* Modified by J. C. Whitmore, 8/79, grossley changed to accept binary output mode and multiple channels per process */




/*	Parameters	*/

dcl  a_code fixed bin (35) parameter;
dcl (a_new_mode, a_old_mode) char (*) parameter;
dcl  a_nelem fixed bin (21) parameter;
dcl  a_nelemt fixed bin (21) parameter;
dcl  a_devx fixed bin parameter;
dcl  a_ddp ptr parameter;
dcl  a_adp ptr parameter;
dcl  a_bufp ptr parameter;
dcl  a_iocbp ptr parameter;
dcl  a_option (*) char (*) var parameter;
dcl  a_comerr_sw bit (1) parameter;
dcl  a_open_mode fixed bin parameter;
dcl  a_order char (*) parameter;
dcl  a_infop ptr parameter;

/*	Automatic		*/

dcl  attach_description char (256) var;
dcl  bufp ptr;
dcl  chn fixed bin (71);
dcl  code fixed bin (35);
dcl  comerr_sw bit (1) init ("0"b);
dcl  comm char (32);
dcl  delay fixed bin (35);
dcl  device char (32);
dcl  device_type fixed bin;
dcl  dial_msg_chan char (32);				/* Variables for dial manager */
dcl  dial_msg_module char (32);
dcl  dial_msg_ndialed fixed bin;
dcl  dummy_arg char (32);
dcl  i fixed bin;
dcl  ignore fixed bin (35);
dcl  infop ptr;
dcl  iocbp ptr;
dcl  level fixed bin;
dcl  mask bit (36);
dcl  max_length fixed bin;
dcl  open_mode fixed bin;
dcl  order char (32);
dcl  state fixed bin;
dcl  temp_ptr ptr;
dcl  terminal_type char (32);
dcl  tty char (32);

/*	Internal Static	*/

dcl  attach_areap ptr int static init (null);		/* pointer to attach_area */
dcl  first_device_data_p ptr int static init (null);	/* head of chain of device data structures */
dcl  last_device_data_p ptr int static init (null);	/* tail of this chain */
dcl  static_comerr_sw bit (1) int static init ("0"b);	/* to force error messages during debug */

/*	Based variables	*/

dcl  attach_area area (262144) based (attach_areap);	/* space for device_data and attach data structures */
dcl  info_string char (32) based (infop);		/* for the control entry */

/*	External Entries	*/

dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
dcl  timer_manager_$sleep entry (fixed bin (71), bit (2));
dcl  get_process_id_ entry () returns (bit (36));
dcl  get_ttt_info_ entry (ptr, fixed bin (35));
dcl  hcs_$tty_abort entry (fixed bin, fixed bin, fixed bin, fixed bin (35));
dcl  ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35));
dcl  ipc_$decl_ev_wait_chn entry (fixed bin (71), fixed bin (35));
dcl  ipc_$decl_ev_call_chn entry (fixed bin (71), entry, ptr, fixed bin, fixed bin (35));
dcl  ipc_$block entry (ptr, ptr, fixed bin (35));
dcl  hcs_$tty_attach entry (char (*), fixed bin (71), fixed bin, fixed bin, fixed bin (35));
dcl  ioa_ entry options (variable);
dcl  iox_$control entry (ptr, char (*), ptr, fixed bin (35));
dcl  hcs_$tty_detach entry (fixed bin, fixed bin, fixed bin, fixed bin (35));
dcl  g115_io_$read_status entry (ptr, ptr, fixed bin (35));
dcl  g115_io_$write entry (ptr, ptr, fixed bin (35));
dcl  hcs_$tty_order entry (fixed bin, char (*), ptr, fixed bin, fixed bin (35));
dcl  ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35));
dcl  convert_ipc_code_ entry (fixed bin (35));
dcl  dial_manager_$privileged_attach entry (ptr, fixed bin (35));
dcl  dial_manager_$release_channel entry (ptr, fixed bin (35));
dcl  dial_manager_$dial_out entry (ptr, fixed bin (35));
dcl  convert_dial_message_ entry (bit (72) aligned, char (*), char (*), fixed bin, 1 like dial_msg_flags aligned,
     fixed bin (35));
dcl  com_err_ entry options (variable);
dcl  get_temp_segment_ entry (char (*), ptr, fixed bin (35));
dcl  release_temp_segment_ entry (char (*), ptr, fixed bin (35));
dcl  continue_to_signal_ entry (fixed bin (35));
dcl  iox_$err_no_operation entry;
dcl  hcs_$set_ips_mask entry (bit (36), bit (36));
dcl  iox_$propagate entry (ptr);
dcl  hcs_$reset_ips_mask entry (bit (36), bit (36));
dcl  g115_protocol_$write entry (ptr, ptr, ptr, fixed bin (21), fixed bin (35));
dcl  g115_protocol_$read entry (ptr, ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));

/*	Builtins and Conditions	*/

dcl (null, addr, hbound, length, rtrim, ltrim, unspec, empty) builtin;

dcl  cleanup condition;
dcl  any_other condition;

/*	Error Table Entries		*/

dcl  error_table_$bad_conversion fixed bin (35) ext;
dcl  error_table_$noarg fixed bin (35) ext;
dcl  error_table_$line_status_pending ext fixed bin (35);
dcl  error_table_$action_not_performed ext fixed bin (35);
dcl  error_table_$ionmat ext fixed bin (35);
dcl  error_table_$wrong_no_of_args ext fixed bin (35);
dcl  error_table_$badopt ext fixed bin (35);
dcl  error_table_$bad_mode ext fixed bin (35);
dcl  error_table_$multiple_io_attachment ext fixed bin (35);
dcl  error_table_$invalid_read ext fixed bin (35);
dcl  error_table_$invalid_write ext fixed bin (35);
dcl  error_table_$not_attached fixed bin (35) ext;
dcl  error_table_$not_detached fixed bin (35) ext;
dcl  error_table_$not_open fixed bin (35) ext;
dcl  error_table_$not_closed fixed bin (35) ext;
dcl  error_table_$no_operation fixed bin (35) ext;
dcl  error_table_$io_no_permission fixed bin (35) ext;
dcl  error_table_$resource_attached fixed bin (35) ext;

/* 	Constants		 */

dcl  devices (4) char (32) static options (constant) init ("reader", "printer", "teleprinter", "punch");

/* Line Control and Status Values */

dcl  set_g115_remote_mode fixed bin int static init (3) options (constant);
dcl  test_for_fnp_output fixed bin int static init (5) options (constant);
dcl  reset_g115_remote_mode fixed bin int static static init (6) options (constant);
dcl  fnp_output_pending fixed bin int static init (8) options (constant);

/*	Structures	*/

dcl 1 line_status aligned,				/* for the Ring 0 line_status order */
   (2 value,
    2 mbz1,
    2 mbz2,
    2 mbz3) fixed bin unal;

dcl 1 hangup_proc aligned based (infop),		/* Data for hangup_proc order */
    2 entry_var entry variable,
    2 data_ptr ptr,
    2 prior fixed bin;

dcl 1 info_structure aligned based (infop),		/* for the read_status control order */
    2 ev_chan fixed bin (71),
    2 input_available bit (1);

dcl 1 modes aligned,				/* for the Ring 0 tty modes order */
    2 len fixed bin,
    2 str char (256);

dcl 1 event_info aligned,				/* data returned by ipc_$block */
    2 channel_id fixed bin (71),			/* event channel which signalled this wakeup */
    2 message fixed bin (71),				/* 72 bit event message from sender */
    2 sender bit (36),				/* process id of sending process */
    2 origin,
      3 dev_signal bit (18) unal,
      3 ring bit (18) unal,
    2 channel_index fixed bin (17);			/* index of channel_id in the wait list we blocked on */

dcl 1 dial_msg_flags aligned,				/* data returned from convert_dial_message_ */
    2 dialed_up bit (1) unal,
    2 hung_up bit (1) unal,
    2 control bit (1) unal,
    2 pad bit (33) unal;

dcl 1 dma aligned,					/* data for dial_manager_ to attach, dial_out or allow dials */
    2 version fixed bin,				/* this is the version 1 structure */
    2 dial_qual char (22),				/* phone number for dial_out, qualifier for allow dials */
    2 dial_mgr_ev_chan fixed bin (71),			/* IPC chan for Ans. Serv. to notify us on */
    2 device_name char (32);				/* name of the tty channel we want to have assigned */

dcl 1 dial_wait_list aligned,				/* IPC wait list for blocking after calling dial_manager_ */
    2 nchan fixed bin init (1),			/* number of channels in this list: always 1 */
    2 dummy_word fixed bin,				/* so the next will be on even word */
    2 dial_mgr_ev_chan fixed bin (71);


%include iocb;

%include iox_modes;

%include io_call_info;

%include g115_attach_data;

%include g115_device_data;

%include g115_message;

%include G115;

%include remote_ttt_info;

g115_attach: entry (a_iocbp, a_option, a_comerr_sw, a_code);

	comerr_sw = static_comerr_sw | a_comerr_sw;	/* print error messages if either switch is on */

	adp, device_data_p = null;			/* no attach data or device data structures defined yet */
	terminal_type, tty, comm, device = "";
	delay, code, a_code = 0;
	iocbp = a_iocbp;				/* copy the input iocb pointer */

	if iocbp -> iocb.attach_descrip_ptr ^= null then do; /* already used? */
	     code = error_table_$not_detached;
	     call abort_attach ("Already attached", "");
	end;

	if hbound (a_option, 1) < 1 then do;
	     code = error_table_$wrong_no_of_args;
	     call abort_attach ("No attach description", "");
	end;

	if attach_areap = null then do;		/* make an area for attach data structures */
	     call get_temp_segment_ ("g115_attach", attach_areap, code);
	     if code ^= 0 then call abort_attach ("Unable to create temp segment", "");
	     attach_area = empty;			/* initialize the area */
	end;

	on cleanup call clean_up_handler;

	dma.dial_qual = "";				/* prepare for call to dial manager */
	attach_description = "g115_";			/* start building att desc which we will tell iox_ about */
	do i = 1 to hbound (a_option, 1);
	     attach_description = attach_description || " " || a_option (i);
	     if a_option (i) = "-device" then device = get_option_arg (i);
	     else if a_option (i) = "-tty" then tty = get_option_arg (i);
	     else if a_option (i) = "-comm" then comm = get_option_arg (i);
	     else if a_option (i) = "-auto_call" then dma.dial_qual = get_option_arg (i);
	     else if a_option (i) = "-ascii" then;	/* ignore ascii/ebcdic specification */
	     else if a_option (i) = "-physical_line_length" | a_option (i) = "-pll" then dummy_arg = get_option_arg (i);
						/* ignore -pll N but no error */
	     else if a_option (i) = "-terminal_type" | a_option (i) = "-ttp" then terminal_type = get_option_arg (i);
	     else if a_option (i) = "-delay" then do;
		delay = cv_dec_check_ ((get_option_arg (i)), code);
		if code ^= 0 | delay < 0 then do;
		     code = error_table_$bad_conversion;
		     call abort_attach ("Invalid delay value", (a_option (i)));
		end;
	     end;
	     else do;
		code = error_table_$badopt;
		call abort_attach ("Invalid attach description option", (a_option (i)));
	     end;
	end;

	if comm ^= "rci" then do;
	     code = error_table_$badopt;		/* indicate bad, but not which one???? */
	     call abort_attach ("Invalid or missing -comm option", (comm));
	end;

	if tty = "" then do;
	     code = error_table_$badopt;
	     call abort_attach ("No ""-tty"" option given", "");
	end;

	do i = 1 to hbound (devices, 1) while (device ^= devices (i));
	end;
	if i > hbound (devices, 1) then do;
	     code = error_table_$badopt;
	     call abort_attach ("Invalid device specified", (device));
	end;
	else device_type = i;

	do temp_ptr = first_device_data_p repeat (temp_ptr -> g115_device_data.fwd_ptr)
		while (temp_ptr ^= null & device_data_p = null);
	     if temp_ptr -> g115_device_data.tty_name = tty then /* channel already defined ? */
		device_data_p = temp_ptr;		/* then grab the ptr and exit loop */
	end;

	if device_data_p = null then do;		/* first init for this device */
	     call ipc_$create_ev_chn (dial_wait_list.dial_mgr_ev_chan, code);
	     if code ^= 0 then call abort_attach ("Unable to create dial event channel", "");

	     dma.version = 1;			/* Setup dial manager request structure */
	     dma.dial_mgr_ev_chan = dial_wait_list.dial_mgr_ev_chan;
	     dma.device_name = tty;			/* say which tty channel we want */

	     if dma.dial_qual = ""			/* normal attach or auto_call (dial_out) */
	     then call dial_manager_$privileged_attach (addr (dma), code);
	     else call dial_manager_$dial_out (addr (dma), code);
	     if code = error_table_$action_not_performed | code = error_table_$resource_attached
		then go to maybe_mine_already;
	     if code ^= 0 then call abort_attach ("From dial_manager_ attaching ^a", (tty));

dial_wait:     call ipc_$block (addr (dial_wait_list), addr (event_info), code);
						/* wait for Answering Service to give us the device */
	     if code ^= 0 then do;
		call convert_ipc_code_ (code);
		call abort_attach ("From ipc_$block waiting for ^a attachment.", (tty));
	     end;

/*	Call convert_dial_message_ so it can update it's table of attached channels */

	     call convert_dial_message_ (unspec (event_info.message), dial_msg_chan, dial_msg_module,
		dial_msg_ndialed, dial_msg_flags, code);
	     if code ^= 0 then call abort_attach ("From dial_manager_ attaching ^a", (tty));

	     if ^dial_msg_flags.dialed_up then do;	/* OOPS - we got a wakeup for some other event - PUNT */
		call com_err_ (0, "g115_", "Dial message received: ^[HANGUP^;CONTROL^] on channel: ^a",
		     dial_msg_flags.hung_up, dial_msg_chan);
		go to dial_wait;			/* wait for our channel */
	     end;

maybe_mine_already:

	     call create_device_data (device_data_p);	/* allocate structure and link it */

	     call init_g115_device_data (device_data_p, code); /* then initialize it for this tty device */

	     if code ^= 0 then call abort_attach ("Unable to initialize device data", "");

	     g115_device_data.tty_name = tty;		/* save name for future attaches */
	     g115_device_data.dial_mgr_ev_chan = dial_wait_list.dial_mgr_ev_chan;
	     g115_device_data.delay = delay;		/* use the value from attach options */

/*	set up IPC wait list to use for input/output blocking:  two channels, tty and timeout */

	     call ipc_$create_ev_chn (g115_device_data.tty_ev_channel, code); /* create ring 0 tty event channel */
	     if code ^= 0 then call abort_attach ("Unable to create tty event channel", "");;

	     call ipc_$create_ev_chn (g115_device_data.timeout_ev_channel, code);
	     if code ^= 0 then call abort_attach ("Unable to create timeout event channel", "");;

	     g115_device_data.nchan = 2;

	     call hcs_$tty_attach (tty, g115_device_data.tty_ev_channel, g115_device_data.devx, state, code);
	     if state ^= 5 then code = error_table_$io_no_permission;
	     if code ^= 0 then call abort_attach ("Unable to attach communications channel.", "");

	     modes.str = "rawo,rawi,^hndlquit";
	     modes.len = length (modes.str);		/* set the max size for return info */

	     call hcs_$tty_order (g115_device_data.devx, "modes", addr (modes), state, code);
	     if state ^= 5 then code = error_table_$io_no_permission;
	     if code ^= 0 then call abort_attach ("Unable to set initial modes", "");

	     max_length = G115.max_msg_len + 10;	/* tell ring 0 the largest msg we will see */

	     call hcs_$tty_order (g115_device_data.devx, "set_input_message_size", addr (max_length), state, code);
	     if state ^= 5 then code = error_table_$io_no_permission;
	     if code ^= 0 then call abort_attach ("Unable to set input message size", "");
	end;

	allocate g115_attach_data in (attach_area) set (adp); /* get a place for the attach data structure */

	unspec (g115_attach_data) = "0"b;		/* initialize the attach data structure */
	g115_attach_data.device_type = device_type;	/* record the device type code (fixed bin) */
	g115_attach_data.device = device;		/* set device name in here (char) */
	g115_attach_data.attach_description = attach_description;
	g115_attach_data.device_ptr = device_data_p;	/* point it back to the device block */

/*	 define the media code for this attachment */

	if device_type = teleprinter then g115_attach_data.media_code = G115.teleprinter_mc;
	else if device_type = printer then g115_attach_data.media_code = G115.printer_mc;
	else if device_type = punch then g115_attach_data.media_code = G115.punch_bcd_mc; /* default data type */
	else g115_attach_data.media_code = "";		/* others are input devices */

/*	set default ttt data  */

	g115_attach_data.terminal_type = terminal_type;
	g115_attach_data.kill_char = "@";
	g115_attach_data.erase_char = "#";
	g115_attach_data.ttt_bits = "1"b;
	g115_attach_data.ttt_ptrs = null;

	if g115_attach_data.device_type = reader then g115_attach_data.canonicalize_input = "0"b;

	if g115_attach_data.terminal_type ^= "" then do;
	     call get_ttt_info_ (addr (g115_attach_data.ttt_info), code);
	     if code ^= 0 then call abort_attach ("Unknown terminal type specified", "");
	end;

	mask = "0"b;

	on any_other call any_other_handler;

	call hcs_$set_ips_mask ("0"b, mask);

	iocbp -> iocb.attach_descrip_ptr = addr (g115_attach_data.attach_description);
	iocbp -> iocb.attach_data_ptr = adp;
	iocbp -> iocb.open = g115_open;
	iocbp -> iocb.detach_iocb = g115_detach;
	iocbp -> iocb.control = iox_$err_no_operation;
	iocbp -> iocb.position = iox_$err_no_operation;
	iocbp -> iocb.modes = iox_$err_no_operation;
	iocbp -> iocb.put_chars = iox_$err_no_operation;
	iocbp -> iocb.get_chars = iox_$err_no_operation;
	iocbp -> iocb.get_line = iox_$err_no_operation;
	iocbp -> iocb.read_record = iox_$err_no_operation;
	iocbp -> iocb.write_record = iox_$err_no_operation;

	g115_device_data.attach_count = g115_device_data.attach_count + 1; /* count up attaches */

	call iox_$propagate (iocbp);

	revert cleanup;

	call hcs_$reset_ips_mask (mask, mask);

	revert any_other;

	code = 0;

attach_return:

	a_code = code;				/* pass back any error codes */

	return;

g115_open: entry (a_iocbp, a_open_mode, a_comerr_sw, a_code);

	a_code, code = 0;				/* be sure to initialize */
	iocbp = a_iocbp -> iocb.actual_iocb_ptr;
	adp = iocbp -> iocb.attach_data_ptr;
	device_data_p = g115_attach_data.device_ptr;

	if adp = null | device_data_p = null then do;
	     a_code = error_table_$not_attached;
	     return;
	end;

	if g115_device_data.hangup_signalled then do;	/* Illegal if we sent a hangup to the device */
	     a_code = error_table_$io_no_permission;
	     return;
	end;

	open_mode = a_open_mode;

	if ^((open_mode = Stream_input) | (open_mode = Stream_output) | (open_mode = Stream_input_output)) then do;
	     a_code = error_table_$bad_mode;
	     return;
	end;

	g115_attach_data.open_description = rtrim (iox_modes (open_mode));

	mask = "0"b;

	on any_other call any_other_handler;

	call hcs_$set_ips_mask ("0"b, mask);

	if ((open_mode = Stream_input) | (open_mode = Stream_input_output)) then do;
	     iocbp -> iocb.get_chars = g115_get_chars;
	     iocbp -> iocb.get_line = g115_get_chars;
	end;
	if ((open_mode = Stream_output) | (open_mode = Stream_input_output)) then do;
	     iocbp -> iocb.put_chars = g115_put_chars;
	end;
	iocbp -> iocb.read_record = iox_$err_no_operation;
	iocbp -> iocb.write_record = iox_$err_no_operation;
	iocbp -> iocb.control = g115_control;
	iocbp -> iocb.modes = g115_modes;
	iocbp -> iocb.close = g115_close;
	iocbp -> iocb.open_descrip_ptr = addr (g115_attach_data.open_description);

	call iox_$propagate (iocbp);

	call hcs_$reset_ips_mask (mask, mask);

	revert any_other;

	return;

g115_close: entry (a_iocbp, a_code);

	a_code, code = 0;				/* be sure to initialize */
	iocbp = a_iocbp -> iocb.actual_iocb_ptr;
	adp = iocbp -> iocb.attach_data_ptr;
	device_data_p = g115_attach_data.device_ptr;

	if adp = null | device_data_p = null then do;
	     a_code = error_table_$not_attached;
	     return;
	end;

	if iocbp -> iocb.open_descrip_ptr = null then do;
	     a_code = error_table_$not_open;
	     return;
	end;

	mask = "0"b;

	on any_other call any_other_handler;

	call hcs_$set_ips_mask ("0"b, mask);

	iocbp -> iocb.open_descrip_ptr = null;
	iocbp -> iocb.open = g115_open;
	iocbp -> iocb.detach_iocb = g115_detach;
	iocbp -> iocb.control = iox_$err_no_operation;
	iocbp -> iocb.position = iox_$err_no_operation;
	iocbp -> iocb.modes = iox_$err_no_operation;
	iocbp -> iocb.put_chars = iox_$err_no_operation;
	iocbp -> iocb.get_chars = iox_$err_no_operation;
	iocbp -> iocb.get_line = iox_$err_no_operation;
	iocbp -> iocb.read_record = iox_$err_no_operation;
	iocbp -> iocb.write_record = iox_$err_no_operation;

	call iox_$propagate (iocbp);

	call hcs_$reset_ips_mask (mask, mask);

	return;

g115_get_chars: entry (a_iocbp, a_bufp, a_nelem, a_nelemt, a_code);

/* This is an entry to get the next record from an input message block.
   The data is written into a_bufp -> buffer without any G115 media codes or record separators.
   The calling procedure must add on a trailing NL char if desired.
*/

	a_code, code = 0;				/* be sure to initialize */
	iocbp = a_iocbp -> iocb.actual_iocb_ptr;
	adp = iocbp -> iocb.attach_data_ptr;
	device_data_p = g115_attach_data.device_ptr;

	if adp = null | device_data_p = null then do;
	     a_code = error_table_$not_attached;
	     return;
	end;

	if g115_device_data.hangup_signalled then do;	/* Illegal if we sent a hangup to the device */
	     a_code = error_table_$io_no_permission;
	     return;
	end;

	if g115_attach_data.device_type = printer |	/* not a readable device */
	g115_attach_data.device_type = punch then do;
	     a_code = error_table_$invalid_read;
	     return;
	end;

	call g115_protocol_$read (adp, device_data_p, a_bufp, a_nelem, a_nelemt, a_code); /* pass on read */

	return;

g115_put_chars: entry (a_iocbp, a_bufp, a_nelem, a_code);

/* This is an entry to write a record which may be a partial or complete G115 message block.
   The record format is a string of ASCII characters without any media code or record separator
   characters.  If the attachment is for the printer device, the last character of the input
   record is a slew control character.
*/

	a_code, code = 0;				/* be sure to initialize */
	iocbp = a_iocbp -> iocb.actual_iocb_ptr;
	adp = iocbp -> iocb.attach_data_ptr;
	device_data_p = g115_attach_data.device_ptr;

	if adp = null | device_data_p = null then do;
	     a_code = error_table_$not_attached;
	     return;
	end;

	if g115_device_data.hangup_signalled then do;	/* Illegal if we sent a hangup to the device */
	     a_code = error_table_$io_no_permission;
	     return;
	end;

	if g115_attach_data.device_type = reader then do;
	     a_code = error_table_$invalid_write;
	     return;
	end;


	call g115_protocol_$write (adp, device_data_p, a_bufp, a_nelem, a_code);

	return;

g115_modes: entry (a_iocbp, a_new_mode, a_old_mode, a_code);

	a_code, code = 0;				/* be sure to initialize */
	iocbp = a_iocbp -> iocb.actual_iocb_ptr;
	adp = iocbp -> iocb.attach_data_ptr;
	device_data_p = g115_attach_data.device_ptr;

	if adp = null | device_data_p = null then do;
	     a_code = error_table_$not_attached;
	     return;
	end;

	if g115_device_data.hangup_signalled then do;	/* Illegal if we sent a hangup to the device */
	     a_code = error_table_$io_no_permission;
	     return;
	end;

	a_old_mode = "";				/* initialize return string */

	if a_new_mode = "non_edited" then g115_attach_data.edited = "0"b;
	else if a_new_mode = "default" then g115_attach_data.edited = "1"b;
	else do;
	     modes.str = a_new_mode;
	     modes.len = length (modes.str);		/* set the max size for return info */
M_1:
	     call hcs_$tty_order (g115_device_data.devx, "modes", addr (modes), state, code);
	     if state ^= 5 then code = error_table_$io_no_permission;
	     if line_status_pending (code) then go to M_1;
	     a_old_mode = modes.str;			/* copy back the old value */
	end;

	a_code = code;

	return;

g115_control: entry (a_iocbp, a_order, a_infop, a_code);

	a_code, code = 0;				/* be sure to initialize */
	iocbp = a_iocbp -> iocb.actual_iocb_ptr;
	adp = iocbp -> iocb.attach_data_ptr;
	device_data_p = g115_attach_data.device_ptr;

	if adp = null | device_data_p = null then do;
	     a_code = error_table_$not_attached;
	     return;
	end;

	if g115_device_data.hangup_signalled then do;	/* Illegal if we sent a hangup to the device */
	     a_code = error_table_$io_no_permission;
	     return;
	end;

	order = a_order;				/* get the order name */
	infop = a_infop;				/* and the data pointer */

	if order = "io_call" then do;			/* check this first so we can redefine the order */

	     if infop = null then do;
bad_call:		a_code = error_table_$no_operation;	/* say we didn't do it */
		return;
	     end;

	     order = infop -> io_call_info.order_name;	/* get the new order name */
	     infop = null;				/* make this cheap, only a few orders accepted */
	end;

	if order = "hangup" then do;
	     dma.version = 1;			/* make structure for call to dial_manager_ */
	     dma.dial_mgr_ev_chan = g115_device_data.dial_mgr_ev_chan;
	     dma.device_name = g115_device_data.tty_name;
	     dma.dial_qual = "";

	     call ipc_$decl_ev_wait_chn (g115_device_data.dial_mgr_ev_chan, code);
						/* in case a hangup_proc order was given */
	     call dial_manager_$release_channel (addr (dma), code);
	     if code ^= 0 then
		call hcs_$tty_order (g115_device_data.devx, order, infop, state, (0)); /* pass it on */

	     g115_device_data.hangup_signalled = "1"b;	/* this will end all but close and detach */
	     code = 0;				/* say it was good, since they MUST close and detach */
	end;
	else if order = "select_device" then do;	/* order to set device type for next write */
	     if infop = null then go to bad_call;	/* this order requires this pointer */
	     if info_string = "teleprinter" then do;
		g115_attach_data.media_code = G115.teleprinter_mc;
	     end;
	     else if info_string = "punch" then do;

/*		g115_attach_data.media_code = G115.punch_bcd_mc; */
	     end;
	     else if info_string = "printer" then do;
		g115_attach_data.media_code = G115.printer_mc;
	     end;
	     else if info_string = "reader" then do;
		g115_attach_data.media_code = G115.bcd_input_mc; /* character only */
	     end;
	     else do;				/* not a legal value, tell the caller */
		code = error_table_$action_not_performed;
	     end;
	end;
	else if order = "runout" then do;
	     msgp = g115_device_data.outp (g115_device_data.level + 1); /* buffer we would write into */
	     if msgp = null then return;		/* in case it was not allocated yet */
	     if g115_message.text_char_count = 0 then return; /* make it fast if nothing to runout */

	     if ^g115_message.being_changed then	/* only write consistent messages */
		call g115_io_$write (device_data_p, msgp, code);

	     g115_message.text_char_count = 0;		/* mark this as written */
	     g115_message.fmt_code = ""b;
	     g115_message.being_changed = "0"b;

	     call timer_manager_$sleep ((g115_device_data.delay), "10"b);
	end;
	else if order = "hangup_proc" then do;
	     if infop = null then go to bad_call;	/* this order requires this pointer */
	     call ipc_$decl_ev_call_chn (g115_device_data.dial_mgr_ev_chan, hangup_proc.entry_var, hangup_proc.data_ptr,
		hangup_proc.prior, code);
	     if code ^= 0 then call convert_ipc_code_ (code);
	end;
	else if order = "reset" then do;
	     if g115_attach_data.device_type = punch then
		g115_attach_data.media_code = G115.punch_bcd_mc;
	end;
	else if order = "binary_punch" then do;
	     if g115_attach_data.device_type ^= punch then go to bad_call;
	     g115_attach_data.media_code = G115.punch_bin_mc; /* all future records will be binary coded */
	end;
	else if order = "read_status" then do;		/* order to get read status */
	     if infop = null then go to bad_call;	/* this order requires this pointer */
	     info_structure.ev_chan = g115_device_data.tty_ev_channel; /* return ev chn on which read will return */
	     info_structure.input_available = "0"b;	/* none yet */
	     msgp = g115_device_data.first_bp;		/* set auto reference ptr */
follow_chain:  if g115_message.rec_count > 0 then do;	/* input is ready */
		info_structure.input_available = "1"b;	/* go to it daemons */
		return;
	     end;
	     if g115_message.next_bp ^= null then do;	/* if a chain exists, check it out */
		msgp = g115_message.next_bp;
		go to follow_chain;
	     end;

	     call g115_io_$read_status (device_data_p, infop, code); /* check for any ring-0 data */
	end;
	else if order = "end_write_mode" then do;
	     call iox_$control (iocbp, "runout", null, code);
	     if code ^= 0 then return;
	     line_status.value = fnp_output_pending;
	     do while (line_status.value = fnp_output_pending);
C_1:		line_status.value = test_for_fnp_output;
		call hcs_$tty_order (g115_device_data.devx, "line_control", addr (line_status), state, code);
		if state ^= 5 then code = error_table_$io_no_permission;
		if line_status_pending (code) then go to C_1;
		call timer_manager_$sleep (1, "11"b);	/* give fnp a chance to digest line_control */
		call hcs_$tty_order (g115_device_data.devx, "line_status", addr (line_status), state, code);
		if state ^= 5 then code = error_table_$io_no_permission;
		if line_status_pending (code) then go to C_1;
		if line_status.value = fnp_output_pending then
		     call timer_manager_$sleep (10, "11"b);
	     end;
	end;
	else if order = "resetread" then do;
	     msgp = g115_device_data.first_bp;
	     bufp = g115_message.next_bp;		/* find next input buffer in chain */
	     unspec (g115_message) = "0"b;		/* clear out everything */
	     g115_message.next_bp = null;		/* mark as chain end */
	     g115_device_data.last_bp = msgp;		/*    "    "	*/
	     do while (bufp ^= null);
		msgp = bufp;
		bufp = g115_message.next_bp;		/* walk the chain */
		free msgp -> g115_message in (buffer_area); /* Poof, it's gone */
	     end;
C_2:	     call hcs_$tty_abort (g115_device_data.devx, 1, state, code);
	     if state ^= 5 then code = error_table_$io_no_permission;
	     if line_status_pending (code) then go to C_2;
	end;
	else if order = "resetwrite" then do;
	     msgp = g115_device_data.outp (g115_device_data.level);
	     g115_message.text_char_count = 0;
	     g115_message.fmt_code = "0"b;
C_3:	     call hcs_$tty_abort (g115_device_data.devx, 2, state, code);
	     if state ^= 5 then code = error_table_$io_no_permission;
	     if line_status_pending (code) then go to C_3;
	end;
	else if order = "set_remote_mode" then do;	/* order to tell control tables to act as L6 */
C_4:	     line_status.value = set_g115_remote_mode;	/* set the proper value */
	     call hcs_$tty_order (g115_device_data.devx, "line_control", addr (line_status), state, code);
	     if state ^= 5 then code = error_table_$io_no_permission;
	     if line_status_pending (code) then go to C_4;
	end;
	else if order = "reset_remote_mode" then do;	/* order to tell control tables to act as host */
C_5:	     line_status.value = reset_g115_remote_mode;
	     call hcs_$tty_order (g115_device_data.devx, "line_control", addr (line_status), state, code);
	     if state ^= 5 then code = error_table_$io_no_permission;
	     if line_status_pending (code) then go to C_5;
	end;
	else do;
C_6:	     call hcs_$tty_order (g115_device_data.devx, order, infop, state, code); /* pass it on */
	     if state ^= 5 then code = error_table_$io_no_permission;
	     if line_status_pending (code) then go to C_6;
	end;

	a_code = code;

	return;

g115_detach: entry (a_iocbp, a_code);			/* entry to detach device */

	a_code, code = 0;				/* be sure to initialize */
	iocbp = a_iocbp -> iocb.actual_iocb_ptr;
	adp = iocbp -> iocb.attach_data_ptr;
	device_data_p = g115_attach_data.device_ptr;

	if adp = null | device_data_p = null then do;
	     a_code = error_table_$not_attached;
	     return;
	end;

	if iocbp -> iocb.open_descrip_ptr ^= null then do;
	     a_code = error_table_$not_closed;
	     return;
	end;

	mask = "0"b;

	on any_other call any_other_handler;

	call hcs_$set_ips_mask ("0"b, mask);

	iocbp -> iocb.attach_descrip_ptr = null;

	call iox_$propagate (iocbp);

	g115_device_data.attach_count = g115_device_data.attach_count - 1; /* count down for detach */

	call cleanup_and_detach (a_code);

	call hcs_$reset_ips_mask (mask, mask);

	return;

as_init:	entry (a_devx, a_ddp, a_adp, a_code);

	if attach_areap = null then do;
	     call get_temp_segment_ ("g115_attach", attach_areap, a_code);
	     if a_code ^= 0 then return;
	     attach_area = empty;
	end;

	call create_device_data (device_data_p);	/* make a new block for AS */

	call init_g115_device_data (device_data_p, a_code);
	if a_code ^= 0 then return;

	g115_device_data.tty_name = "as_tty";		/* make up a dummy name for now */
	g115_device_data.devx = a_devx;
	g115_device_data.dial_mgr_ev_chan = 0;
	g115_device_data.tty_ev_channel = 0;
	g115_device_data.timeout_ev_channel = 0;
	g115_device_data.as_priv_no_block = "1"b;	/* this is the answering service! */

	allocate g115_attach_data in (attach_area) set (adp);

	g115_attach_data.media_code = G115.teleprinter_mc; /* answering service is only a teleprinter */
	g115_attach_data.device = "teleprinter";
	g115_attach_data.device_type = teleprinter;
	g115_attach_data.attach_description = "AS_direct_attach";
	g115_attach_data.open_description = "stream_input_output";
	g115_attach_data.device_ptr = device_data_p;
	g115_attach_data.terminal_type = "";
	g115_attach_data.kill_char = "@";
	g115_attach_data.erase_char = "#";
	g115_attach_data.ttt_bits = "1"b;
	g115_attach_data.ttt_ptrs = null;

	a_ddp = device_data_p;
	a_adp = adp;

	return;



as_detach: entry (a_devx, a_ddp, a_adp, a_code);

	adp = a_adp;
	device_data_p = a_ddp;

	free adp -> g115_attach_data in (attach_area);

	call release_temp_segment_ ("g115_io_buffer", g115_device_data.buffer_areap, a_code);

	call delete_device_data (device_data_p);	/* remove from the chain */

	return;

flip_comerr_sw: entry;

	static_comerr_sw = ^static_comerr_sw;		/* change the bit */

	call ioa_ ("g115_: Static com_err_ switch is ^[on^;off^]", static_comerr_sw);

	return;


cleanup_and_detach: proc (ec);

dcl  ec fixed bin (35);
dcl  ignore fixed bin (35);

	     if adp ^= null then
		free adp -> g115_attach_data in (attach_area);

	     if device_data_p ^= null then		/* check on deleting the device data */
		if g115_device_data.attach_count < 1 then do; /* no more streams attached, free block */
		     if ^g115_device_data.hangup_signalled then do; /* hang up the line if caller didn't */
			dma.version = 1;		/* make structure for call to dial_manager_ */
			dma.dial_mgr_ev_chan = g115_device_data.dial_mgr_ev_chan;
			dma.device_name = g115_device_data.tty_name;
			dma.dial_qual = "";

			call ipc_$decl_ev_wait_chn (g115_device_data.dial_mgr_ev_chan, ignore);
						/* in case a hangup_proc order was given */
			call dial_manager_$release_channel (addr (dma), ignore);
			if code ^= 0 then
			     call hcs_$tty_order (g115_device_data.devx, order, infop, state, ignore); /* pass it on */
		     end;
		     do chn = g115_device_data.tty_ev_channel, g115_device_data.timeout_ev_channel,
			     g115_device_data.dial_mgr_ev_chan;
			call ipc_$delete_ev_chn (chn, ignore);
		     end;

		     call hcs_$tty_detach (g115_device_data.devx, 0, state, ec);

		     call release_temp_segment_ ("g115_io_buffer", g115_device_data.buffer_areap, ignore);

		     call delete_device_data (device_data_p); /* remove from the chain */

		end;

	end cleanup_and_detach;



get_option_arg: proc (idx) returns (char (*) var);

/* this proc is used to do multiple tests and assignments within  a one line then clause of an if statement */

dcl  idx fixed bin;

	     idx = idx + 1;				/* bump the current option index, to find the option arg */
	     if idx > hbound (a_option, 1) then do;	/* still in range? */
		code = error_table_$noarg;		/* tell process it left out an arg */
		call abort_attach ("No argument after ", (a_option (i - 1)));
	     end;

	     attach_description = attach_description || " " || a_option (idx); /* include the arg in attach description */

	     return (a_option (idx));

	end get_option_arg;

abort_attach: proc (control_string, arg_value);		/* this proc handles attach errors */

dcl (control_string, arg_value) char (*) aligned;
dcl  saved_code fixed bin (35);

	     if comerr_sw then call com_err_ (code, "g115_", control_string, arg_value);

	     saved_code = code;			/* keep a copy */

	     call cleanup_and_detach (code);
	     if saved_code ^= 0 then code = saved_code;	/* use former reason if any */

	     go to attach_return;			/* non local transfer to finish off the abort */

	end abort_attach;



any_other_handler: proc;

/* this is the any_other handler to protect us while masked against IPS signals */

	     if mask then call hcs_$reset_ips_mask (mask, mask);
	     mask = ""b;

	     call continue_to_signal_ (code);

	     return;

	end any_other_handler;




clean_up_handler: proc;

/* this is the cleanup condition handler for errors during the attach entry */

	     call cleanup_and_detach (ignore);

	     return;

	end clean_up_handler;

init_g115_device_data: proc (ddp, ec);

dcl  ddp ptr;
dcl  ec fixed bin (35);
dcl  msgp ptr;
dcl  bp ptr;

	     ddp -> g115_device_data.tty_name = "";	/* let the main proc define this */
	     ddp -> g115_device_data.fmt_code.control = G115.special_nc;
	     ddp -> g115_device_data.fmt_code.data = G115.info_s_c; /* data will be compressed and split */
	     ddp -> g115_device_data.write_split, ddp -> g115_device_data.write_compress = "1"b; /* for easy test */
	     ddp -> g115_device_data.delay = 50000;	/* default to 50 msec for AS */
	     ddp -> g115_device_data.level = 0;		/* the write invocation level */
	     ddp -> g115_device_data.outp (*) = null;
	     ddp -> g115_device_data.process_id = get_process_id_ (); /* record our process id for wakeups */

/* make an area for allocation of input/output buffers */

	     call get_temp_segment_ ("g115_io_buffer", ddp -> g115_device_data.buffer_areap, ec);
	     if ec ^= 0 then return;

	     bp = ddp -> g115_device_data.buffer_areap;	/* get short pointer name */
	     bp -> buffer_area = empty;		/* initialize the area */

	     allocate g115_message in (bp -> buffer_area) set (ddp -> g115_device_data.template_ptr); /* OUTPUT buffer */

	     msgp = ddp -> g115_device_data.template_ptr; /* for easy structure reference */

/*		set up the template output buffer for speed later */

	     unspec (msgp -> g115_message) = "0"b;	/* set everything to zero */
	     msgp -> g115_message.next_bp = null;	/* output buffers are not chained */
	     msgp -> g115_message.soh = G115.soh_char;
	     msgp -> g115_message.addr_code = G115.addr_code_char;
	     msgp -> g115_message.op_code.use = "1"b;
	     msgp -> g115_message.id_code = G115.id_code_char;
	     msgp -> g115_message.stx = G115.stx_char;
	     msgp -> g115_message.etx = G115.etx_char;

	     allocate g115_message in (bp -> buffer_area) set (ddp -> g115_device_data.first_bp); /* INPUT buffer */

	     msgp, ddp -> g115_device_data.last_bp = ddp -> g115_device_data.first_bp; /* set the chain */
	     unspec (msgp -> g115_message) = "0"b;	/* make it clean */
	     msgp -> g115_message.next_bp = null;

	     return;

	end init_g115_device_data;

create_device_data: proc (ddp);

/* this proc allocates a copy of g115_device_data and threads it into the list */

dcl  ddp ptr;

	     allocate g115_device_data in (attach_area) set (ddp);

	     unspec (ddp -> g115_device_data) = "0"b;	/* set everything to zero */

	     ddp -> g115_device_data.back_ptr = last_device_data_p; /* point back to previous tail */
	     ddp -> g115_device_data.fwd_ptr = null;	/* this is the new tail of the chain */
	     if last_device_data_p ^= null		/* if tail already exists */
	     then last_device_data_p -> g115_device_data.fwd_ptr = ddp; /* link it to this block */
	     else first_device_data_p = ddp;		/* otherwise start the chain */
	     last_device_data_p = ddp;		/* record the new tail */

	     return;

delete_device_data: entry (ddp);

/* this entry removes a link in the chain and frees the data block */

	     if ddp -> g115_device_data.back_ptr = null then /* was this the head of the chain? */
		first_device_data_p = ddp -> g115_device_data.fwd_ptr; /* make the next one the head */
	     else ddp -> g115_device_data.back_ptr -> g115_device_data.fwd_ptr = ddp -> g115_device_data.fwd_ptr;
						/* move our fwd ptr to previous block */

	     if ddp -> g115_device_data.fwd_ptr = null then /* was this the tail of the chain */
		last_device_data_p = ddp -> g115_device_data.back_ptr; /* make previous the new tail */
	     else ddp -> g115_device_data.fwd_ptr -> g115_device_data.back_ptr = ddp -> g115_device_data.back_ptr;
						/* move our back ptr to next block */

	     free ddp -> g115_device_data in (attach_area);

	     ddp = null;				/* just to be sure */

	     return;

	end create_device_data;

line_status_pending: proc (ec) returns (bit (1));

dcl  ec fixed bin (35);

/* this proc returns true if there was a line status code and we cleared the line, ready for a retry */

	     if ec = 0 then return ("0"b);		/* avoid a loop for normal case */

	     do while (ec = error_table_$line_status_pending);
		call hcs_$tty_order (g115_device_data.devx, "line_status", addr (line_status), state, ec);
		if state ^= 5 then ec = error_table_$io_no_permission;
	     end;

	     if ec = 0 then return ("1"b);		/* OK to retry */

	     return ("0"b);				/* Do not retry */

	end line_status_pending;




     end g115_;




		    g115_as_.pl1                    02/06/80  1358.4rew 02/06/80  1131.0       95607



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

g115_as_: proc;


/* g115_as_ - procedure to interface answering service when it needs to communicate VIA G115 protocol.

   The tty_index entry must be called first to establish a data structure for the device.
   The other entries rely on the presence of this data structure. */


/* coded 07/11/75 by Bob Adsit */
/* Modified by J. C. Whitmore, 9/79, during restructure of g115_ I/O module. */

dcl  a_asw fixed bin parameter;
dcl  a_bufp ptr parameter;
dcl  a_code fixed bin (35);
dcl  a_device char (*) parameter;
dcl  a_devx fixed bin parameter;
dcl  a_dflag fixed bin parameter;
dcl  a_event fixed bin (71) parameter;
dcl  a_nelem fixed bin parameter;
dcl  a_nelemt fixed bin parameter;
dcl  a_new_mode char (*) parameter;
dcl  a_offset fixed bin parameter;
dcl  a_old_mode char (*) parameter;
dcl  a_order char (*) parameter;
dcl  a_orderp ptr parameter;
dcl  a_proc_id bit (36) aligned;
dcl  a_state fixed bin parameter;

dcl  io_buff char (322) aligned;
dcl  io_data char (322) var;
dcl  dd_idx fixed bin;
dcl  pos fixed bin;
dcl  state fixed bin;
dcl  idx fixed bin;

dcl  based_string char (322) based;

dcl (addr, addrel, index, length, rtrim, substr, translate, null, hbound) builtin;

dcl  error_table_$namedup fixed bin (35) ext;
dcl  error_table_$noentry fixed bin (35) ext;
dcl  error_table_$notalloc fixed bin (35) ext;
dcl  error_table_$io_no_permission ext fixed bin (35);

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



dcl 1 dd aligned static,				/* device data structure on active channels */
    2 last_used fixed bin init (0),			/* last entry defined in the array */
    2 free_idx fixed bin init (-1),			/* head of the free list of entries */
    2 entries (100),				/* array of entries larger than ever needed */
      3 next_idx fixed bin init ((100) 0),		/* next entry in the chain - (100) 0 = end */
      3 devx fixed bin init ((100) 0),			/* the device index for Ring 0 */
      3 adp ptr init ((100) null),			/* pointer to the attach data structure for devx */
      3 ddp ptr init ((100) null);			/* pointer to the device data structure for devx */


dcl 1 modes aligned,
    2 len fixed bin,
    2 str char (256);

dcl (lower_case init ("abcdefghijklmnopqrstuvwxyz"),
     upper_case init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ")) char (26) int static options (constant);

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  g115_$as_init entry (fixed bin, ptr, ptr, fixed bin (35));
dcl  g115_$as_detach entry (fixed bin, ptr, ptr, fixed bin (35));
dcl  g115_protocol_$read entry (ptr, ptr, ptr, fixed bin, fixed bin, fixed bin (35));
dcl  g115_protocol_$write entry (ptr, ptr, ptr, fixed bin, fixed bin (35));
dcl  hcs_$tty_index entry (char (*), fixed bin, fixed bin, fixed bin (35));
dcl  hcs_$tty_event entry (fixed bin, fixed bin (71), fixed bin, fixed bin (35));
dcl  hcs_$tty_abort entry (fixed bin, fixed bin, fixed bin, fixed bin (35));
dcl  hcs_$tty_state entry (fixed bin, fixed bin, fixed bin (35));
dcl  hcs_$tty_order entry (fixed bin, char (*), ptr, fixed bin, fixed bin (35));
dcl  hcs_$tty_detach_new_proc entry (fixed bin, bit (36) aligned, fixed bin, fixed bin (35));

%include g115_device_data;

%include g115_attach_data;

%include remote_ttt_info;

as_index:	entry (a_device, a_devx, a_state, a_code);

/* This is the entry first called by answering service to set up the attachment through g115 */

	call hcs_$tty_index (a_device, a_devx, a_state, a_code); /* get the device index of the channel */
	if a_code ^= 0 then return;

	call make_dd_entry (a_devx, dd_idx, a_code);	/* get a place to save attachment data ptrs */
	if a_code ^= 0 then return;

	call g115_$as_init (a_devx, device_data_p, adp, a_code);
	if a_code ^= 0 then do;
drop_entry:    call delete_dd_entry (dd_idx);		/* remove the entry we made */
	     if device_data_p ^= null then
		call g115_$as_detach (a_devx, device_data_p, adp, (0));
	     return;
	end;

	dd.ddp (dd_idx) = device_data_p;		/* save these for the future */
	dd.adp (dd_idx) = adp;

	g115_attach_data.device = a_device;		/* record the device name given us */

	call ipc_$create_ev_chn (g115_device_data.tty_ev_channel, a_code); /* create ev chan for ring 0 */
	if a_code ^= 0 then go to drop_entry;

	call ipc_$create_ev_chn (g115_device_data.timeout_ev_channel, a_code); /* and one for timeout on blocking */
	if a_code ^= 0 then go to drop_entry;

	return;


as_event:	entry (a_devx, a_event, a_state, a_code);

/* This entry defines the event channel that AS will block on (listen to) */

	call find_dd_entry (a_devx, dd_idx, a_code);	/* get the structure ptr info */
	if a_code ^= 0 then return;

	device_data_p = dd.ddp (dd_idx);		/* get the pointer to g115_device_data */

	g115_device_data.as_ev_chan = a_event;		/* save the event channel for g115_io_ */

	call hcs_$tty_event (a_devx, a_event, a_state, a_code); /* set the AS event channel in ring  0 */

	return;

as_detach: entry (a_devx, a_dflag, a_state, a_code);

	call find_dd_entry (a_devx, dd_idx, a_code);	/* get the device data index */
	if a_code ^= 0 then return;

	device_data_p = dd.ddp (dd_idx);		/* copy the structure pointers */
	adp = dd.adp (dd_idx);

	call ipc_$delete_ev_chn (g115_device_data.tty_ev_channel, a_code); /* don't check the code, just try */
	call ipc_$delete_ev_chn (g115_device_data.timeout_ev_channel, a_code);

	call g115_$as_detach (a_devx, device_data_p, adp, a_code);

	a_state = 1;

	call delete_dd_entry (dd_idx);

	return;


as_detach_new_proc: entry (a_devx, a_proc_id, a_state, a_code);

	call hcs_$tty_detach_new_proc (a_devx, a_proc_id, a_state, a_code);
	return;


as_order:	entry (a_devx, a_order, a_orderp, a_state, a_code);

	call hcs_$tty_order (a_devx, a_order, a_orderp, a_state, a_code);
	return;


as_changemode: entry (a_devx, a_new_mode, a_old_mode, a_code);

	modes.len = length (modes.str);		/* set the max size for return info */
	modes.str = a_new_mode;

	call hcs_$tty_order (a_devx, "modes", addr (modes), state, a_code);
	if state ^= 5 then a_code = error_table_$io_no_permission;

	a_old_mode = modes.str;			/* copy back the old modes from Ring 0 */

	return;


as_state:	entry (a_devx, a_state, a_code);

	call hcs_$tty_state (a_devx, a_state, a_code);
	return;


as_abort:	entry (a_devx, a_asw, a_state, a_code);

	call hcs_$tty_abort (a_devx, a_asw, a_state, a_code);
	return;

as_write:
as_write_force: entry (a_devx, a_bufp, a_offset, a_nelem, a_nelemt, a_state, a_code);

	call find_dd_entry (a_devx, dd_idx, a_code);	/* get the device data index */
	if a_code ^= 0 then return;

	device_data_p = dd.ddp (dd_idx);		/* define the structure pointers */
	adp = dd.adp (dd_idx);

	io_buff = substr (addrel (a_bufp, a_offset) -> based_string, 1, a_nelem); /* be sure we fit into a message */

	call g115_protocol_$write (adp, device_data_p, addr (io_buff), a_nelem, a_code);

	a_nelemt = a_nelem;

	return;


as_read:	entry (a_devx, a_bufp, a_offset, a_nelem, a_nelemt, a_state, a_code);

	call find_dd_entry (a_devx, dd_idx, a_code);
	if a_code ^= 0 then return;

	device_data_p = dd.ddp (dd_idx);		/* define the structure pointers */
	adp = dd.adp (dd_idx);

	call g115_protocol_$read (adp, device_data_p, addr (io_buff), length (io_buff), a_nelemt, a_code);

	if a_code ^= 0 | a_nelemt = 0 then return;	/* none yet */

	io_buff = substr (io_buff, 1, a_nelemt);	/* remove any cruft */
	io_data = "";				/* clear the output string */
	pos = 1;					/* go through io_buff starting with char 1 */
	idx = index (io_buff, "\");			/* look for upper case escapes */

	do while (idx > 0);				/* loop processing all escapes */
	     io_data = io_data || translate (substr (io_buff, pos, idx - 1), lower_case, upper_case) ||
		substr (io_buff, pos + idx, 1);	/* omit the backslash and take following char as is */
	     pos = pos + idx + 1;
	     idx = index (substr (io_buff, pos), "\");	/* look for next one */
	end;

	io_data = io_data || translate (substr (io_buff, pos), lower_case, upper_case); /* add in the last part */
	io_data = rtrim (io_data) || NL;		/* and make it look like tty input */

	if length (io_data) > a_nelem then a_nelemt = a_nelem; /* only give back up to limit */
	else a_nelemt = length (io_data);

	substr (addrel (a_bufp, a_offset) -> based_string, 1, a_nelemt) = io_data; /* return the data */

	return;

make_dd_entry: proc (a_devx, dd_idx, ec);

dcl  a_devx fixed bin;
dcl  dd_idx fixed bin;
dcl  ec fixed bin (35);
dcl  idx fixed bin;

	     dd_idx = 0;				/* initialize output index */

	     do idx = 1 to dd.last_used while (dd_idx = 0); /* look for a duplicate entry */
		if dd.next_idx (idx) = 0 then		/* not in free list */
		     if dd.devx (idx) = a_devx then dd_idx = idx; /* found a match */
	     end;

	     if dd_idx = 0 then do;			/* must make an entry */
		if dd.free_idx < 0 then do;		/* no free entries, extend max used */
		     if dd.last_used = hbound (dd.entries, 1) then do;
			ec = error_table_$notalloc;
			return;
		     end;
		     dd_idx, dd.last_used = dd.last_used + 1; /* bump the count */
		end;
		else do;				/* take a free entry */
		     dd_idx = dd.free_idx;
		     dd.free_idx = dd.next_idx (dd_idx); /* shorten chain by one link */
		     dd.next_idx (dd_idx) = 0;	/* remove this from the chain */
		end;
		dd.devx (dd_idx) = a_devx;		/* assign the new device index */
	     end;
	     else ec = error_table_$namedup;		/* found a match!  WHY? */

	     return;


find_dd_entry: entry (a_devx, dd_idx, ec);

	     dd_idx = 0;				/* initialize output index */

	     do idx = 1 to dd.last_used while (dd_idx = 0); /* look for a duplicate entry */
		if dd.next_idx (idx) = 0 then		/* not in free list */
		     if dd.devx (idx) = a_devx then dd_idx = idx; /* found a match */
	     end;

	     if dd_idx = 0 then ec = error_table_$noentry;

	     return;

delete_dd_entry: entry (dd_idx);

	     dd.devx (dd_idx) = 0;			/* make the entry invalid */
	     dd.ddp (dd_idx) = null;
	     dd.adp (dd_idx) = null;

	     dd.next_idx (dd_idx) = dd.free_idx;	/* put at the head of the free chain */
	     dd.free_idx = dd_idx;

	     return;

	end make_dd_entry;




     end g115_as_;




		    g115_conv_.alm                  02/02/88  1719.3r w 02/02/88  1534.2       32886



"  ******************************************************
"  *                                                    *
"  *                                                    *
"  * Copyright (c) 1972 by Massachusetts Institute of   *
"  * Technology and Honeywell Information Systems, Inc. *
"  *                                                    *
"  *                                                    *
"  ******************************************************

" G115_CONV_ - Conversion for G115 remote printer.
"	coded 12/12/74 by Noel I. Morris
"	Modified 6/23/75 by Noel I. Morris
"	Modified 04/10/77 by Bob Franklin to change top of inside page char
"		and dont slew on punch
"	Modified by D. Vinograd, 7/78, to separate the teleprinter, printer, and punch entries
"	Modified by J. C. Whitmore, 11/78, to make all top of page slews the same
"	Modified by J. C. Whitmore, 9/79, to move protocol features to g115_protocol_.pl1

" This module performs the necessary conversion for printing on the
" G115 remote printer.
"
" The manner in which this procedure is utilized is described in detail
" in the listing of prt_conv_.
"
" A media code character will be inserted at the beginning of each
" output line.  


	name	g115_conv_

	segdef	teleprinter
	segdef	printer
	segdef	punch


	even
	temp	char
	temp	device_code	1 = printer, 0 = all others



teleprinter:
punch:
	tra	g115_send_init
	tra	g115_send_chars
	tra	g115_send_slew_pattern
	tra	g115_send_slew_count

printer:
	tra	g115_send_printer_init
	tra	g115_send_chars
	tra	g115_send_slew_pattern
	tra	g115_send_slew_count


" 
	include	prt_conv_info
" 

g115_send_init:

	ldq	0,du		set the all other device code
	stq	device_code	and save for later

	tra	end_init

g115_send_printer_init:

	ldq	1,du		set the printer code
	stq	device_code	and save for later

end_init:

	tra	sb|0		return to caller
" 

g115_send_chars:

	eaq	0,2		white space count in QU
	tmoz	nospace		skip if no white space

"	insert spaces as requested, compression is done at the next level

	mlr	(),(pr,rl),fill(040)  insert requisite number of blanks
	desc9a	*,0		..
	desc9a	bb|0,qu		..

	a9bd	bb|0,qu		bump output pointer

nospace:
	mlr	(pr,rl),(pr,rl)	copy characters into bb -> out_string
	desc9a	bp|0,au		..
	desc9a	bb|0,au		..

	a9bd	bp|0,au		step input and output pointers
	a9bd	bb|0,au		..
	eax2	0		make sure X2 now zero
	tra	pr7|0		return to caller


" 

g115_send_slew_pattern:

	ldq	device_code	see if this is a printer
	tze	return_to_caller	if not, there is no slew

	ldq	=1a ,du		load the FF slew code

set_slew:

	stq	char		save the slew code
	eax7	1		we will add one char to the output

	mlr	(pr,rl),(pr,rl)	copy into output
	desc9a	char,x7		..
	desc9a	bb|0,x7		..

	a9bd	bb|0,7		..

return_to_caller:
	tra	sb|0		return to caller
" 

g115_send_slew_count:

	ldq	device_code	see if this is a printer
	tze	no_slew		if not, there is no slew

	eaq	0,al		count in QU
	sbla	15,dl		decrement A by 15, residue will come later
	tmoz	*+2		can only take 15 lines at a time
	ldq	15,du		if > 15, take 15 for now
	ldq	skip,qu		get correct skip character
	tra	set_slew		join common code

no_slew:
"				just say we did it and return
	lda	0,dl		clear the residue count
	tra	sb|0		and return


"	GRTS codes for slew of N lines

skip:	aci	"0"		slew  0 lines
	aci	"1"		slew  1 line
	aci	"2"		slew  2 lines
	aci	"3"		slew  3 lines
	aci	"4"		slew  4 lines
	aci	"5"		slew  5 lines
	aci	"6"		slew  6 lines
	aci	"7"		slew  7 lines
	aci	"8"		slew  8 lines
	aci	"9"		slew  9 lines
	aci	"["		slew 10 lines
	aci	"#"		slew 11 lines
	aci	"@"		slew 12 lines
	aci	":"		slew 13 lines
	aci	">"		slew 14 lines
	aci	"?"		slew 15 lines

	end




		    g115_io_.pl1                    02/06/80  1358.4rew 02/06/80  1131.0      132318



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

g115_io_$write: proc (a_ddp, a_msgp, a_code);

/* this procedure handles the actual read and writing of the
   data to the L6-RBF via hcs_$tty calls. */

/* Coded 4/30/74 by Mike Grady */

/* Modified 06/10/75 by Bob Adsit to move line_status to MCS/355 */

/* Modified 04/10/77 by Bob Franklin to fix many bugs. Now multiple
   blocks must be unpacked on input in g115_message, special control
   records must be ignored, etc. Ignore Quit error on Writes. */

/* Modified to handle multiple buffers, line control orders and
   fit into the iox_ based total g115 package June 1978 by D. Vinograd */

/* Modified by J. Nicholls 7/78 to count records instead of characters */

/*   Modified by J. Nicholls Sept 78 to buffer input in ring 4, since the fnp dia channel may
   become clogged if the input sets in ring 0.  Thus if output is pending and input is available,
   we will read a record and buffer it, and keep trying until output is not pending and input is completed.
   If no more input, we'll go blocked; if no output pending, task is accomplished and we'll continue. */

/* Modified by J. C. Whitmore, 9/79, renamed g115_message_ to g115_io_ and restructured completely */

dcl  a_ddp ptr parameter;
dcl  a_msgp ptr parameter;
dcl  a_infop ptr parameter;
dcl  a_code fixed bin (35) parameter;

dcl  msg_block_ptr ptr;
dcl  nelemt fixed bin;
dcl  nelem fixed bin;
dcl  offset fixed bin;
dcl  idx fixed bin;
dcl  state fixed bin;
dcl  code fixed bin (35);
dcl  ec fixed bin (35);
dcl  send_wakeup bit (1) init ("0"b);			/* set if we should send a wakeup to previous (if any) invocation */
dcl  read_status_entry bit (1);


dcl  quit_code fixed bin (35) int static init (3000005) options (constant); /* quit occurred */


dcl 1 line_status aligned,
   (2 value,
    2 mbz1,
    2 mbz2,
    2 mbz3) fixed bin unal;

dcl 1 info aligned based,
    2 pad fixed bin (71),
    2 input_available bit (1);

dcl 1 io_status aligned,
    2 pad fixed bin (71),
    2 io_pending bit (1);

dcl 1 event_info aligned,				/* wakeup information */
    2 channel_id fixed bin (71) aligned,		/* channel over which to send wakeup */
    2 message char (8) aligned,			/* event message */
    2 sender bit (36) aligned,			/* process id of sending process */
    2 origin,
      3 dev_signal bit (18) unaligned,			/* ON if event occurred as result of i/o interrupt */
      3 ring bit (18) unaligned,			/* sender's validation level */
    2 wait_list_index fixed bin aligned;

dcl  convert_ipc_code_ entry (fixed bin (35));
dcl  ipc_$drain_chn entry (fixed bin (71), fixed bin (35));
dcl  ipc_$block entry (ptr, ptr, fixed bin (35));
dcl  hcs_$tty_write entry (fixed bin, ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (35));
dcl  hphcs_$tty_write_force entry (fixed bin, ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (35));
dcl  hcs_$tty_get_line entry (fixed bin, ptr, fixed bin, fixed bin, fixed bin, bit (1), fixed bin, fixed bin (35));
dcl  hcs_$tty_order entry (fixed bin, char (*), ptr, fixed bin, fixed bin (35));
dcl  hcs_$tty_event entry (fixed bin, fixed bin (71), fixed bin, fixed bin (35));
dcl  hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
dcl  ipc_$mask_ev_calls entry (fixed bin (35));
dcl  ipc_$unmask_ev_calls entry (fixed bin (35));
dcl  timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71));
dcl  timer_manager_$reset_alarm_wakeup entry (fixed bin (71));

dcl  error_table_$net_timeout ext fixed bin (35);
dcl  error_table_$line_status_pending ext fixed bin (35);
dcl  error_table_$io_no_permission ext fixed bin (35);
dcl  error_table_$improper_data_format ext fixed bin (35);


dcl (addr, null, unspec) builtin;

%include g115_device_data;

%include g115_message;

%include G115;

/* g115_io_$write:	proc (a_ddp, a_msgp, a_code);	*/

/* This procedure writes messages to the L6-RBF and will read input if output is still pending. */

	read_status_entry = "0"b;			/* this is not the read_status entry */
	a_code, code = 0;				/* set error code to 0 */
	msgp = a_msgp;
	device_data_p = a_ddp;

	if g115_message.text_char_count = 0 | g115_message.being_changed then do;
	     a_code = error_table_$improper_data_format;
	     return;
	end;

	nelem = g115_message.text_char_count + 8;	/* add in header-trailer to get actual length of message */
	msg_block_ptr = addr (msgp -> g115_msg_block);	/* get addr for tty_write */
	offset = 0;

	if g115_device_data.as_priv_no_block then go to ANS_SERVICE; /* special section for answering service */

check_write_completion:

	call check_write_status (code);		/* set the io_status structure */
	if code ^= 0 then go to RETURN;

	do while (io_status.io_pending);		/* if output is still in Ring 0, check for input */
	     call hcs_$tty_order (g115_device_data.devx, "read_status", addr (io_status), state, code);
	     if state ^= 5 then code = error_table_$io_no_permission;
	     if line_status_pending (code) then go to check_write_completion;
	     if code ^= 0 then go to RETURN;

	     if io_status.io_pending then do;		/* if we have input, get it out of Ring 0 */
		allocate g115_message in (buffer_area) set (msgp);
		unspec (g115_message) = "0"b;		/* be sure it is clear */
		g115_message.next_bp = null;
		g115_device_data.last_bp -> g115_message.next_bp = msgp; /* add to chain */
		g115_device_data.last_bp = msgp;

		send_wakeup = "1"b;			/* tell reader about input */

		call read_message (msgp, code);	/* read one message and verify it */
		if code ^= 0 then go to RETURN;
	     end;
	     else do;				/* output pending and no input, so just wait */

		call block (code);
		if code ^= 0 then go to RETURN;;
	     end;

	     call check_write_status (code);		/* check for output pending and loop back */
	     if code ^= 0 then go to RETURN;
	end;

try_write:
	nelemt, state = 0;
	call hcs_$tty_write (g115_device_data.devx, msg_block_ptr, offset, nelem, nelemt, state, code);
	if state ^= 5 then code = error_table_$io_no_permission;
	if code = quit_code then go to try_write;	/* ignore quit error its been reset */
	if line_status_pending (code) then go to try_write;
	if code ^= 0 then go to RETURN;

	if nelem = nelemt then go to RETURN;		/* all data was accepted by ring 0 */

	nelem = nelem - nelemt;			/* only a portion was sent, try to send remainder */
	offset = offset + nelemt;
	go to check_write_completion;



/* ===== SPECIAL SECTION FOR THE ANSWERING SERVICE ===== */

ANS_SERVICE:

/* We cannot allow the answering service to block on output indefinitely. So we use a timeout of 3 seconds
   if there is already output pending.  The event channel we block on must be different from
   the normal answering service channel so we change it each time. */

	call hcs_$tty_event (g115_device_data.devx, g115_device_data.tty_ev_channel, state, code);
	if state ^= 5 then code = error_table_$io_no_permission;
	if line_status_pending (code) then go to ANS_SERVICE; /* try all over */
	if code ^= 0 then go to RETURN;

	call check_write_status (code);		/* Check for output pending */
	if code ^= 0 then go to ANS_RETURN;		/* really screwed up, will have to be dropped */

	do while (io_status.io_pending);		/* if told to wait */
	     call ipc_$mask_ev_calls (ec);		/* stop answering service for a second */

	     call ipc_$drain_chn (g115_device_data.timeout_ev_channel, ec); /* be sure it is clear */

	     call timer_manager_$alarm_wakeup (3, "11"b, g115_device_data.timeout_ev_channel); /* 3 seconds max */

	     call block (code);			/* wait for completion or timeout */

	     call ipc_$unmask_ev_calls (ec);		/* ALWAYS reset the event call mask */

	     if code ^= 0 then go to ANS_RETURN;	/* check code from block, timeout is fatal */

	     call timer_manager_$reset_alarm_wakeup (g115_device_data.timeout_ev_channel); /* made it */

	     call check_write_status (code);
	     if code ^= 0 then go to ANS_RETURN;
	end;

	call hphcs_$tty_write_force (g115_device_data.devx, msg_block_ptr, offset, nelem, nelemt, state, code);
	if state ^= 5 then code = error_table_$io_no_permission;
	if line_status_pending (code) then go to ANS_SERVICE; /* start all over */

ANS_RETURN:

/* ALWAYS attempt to return the normal event channel to Ring 0 - error or not */

	call hcs_$tty_event (g115_device_data.devx, g115_device_data.as_ev_chan, state, ec);

	if code = 0 then code = ec;			/* give other errors priority */
	go to RETURN;				/* common return code (See read entry) */

check_write_status: proc (code);

dcl  code fixed bin (35);

	     call ipc_$drain_chn (g115_device_data.tty_ev_channel, code); /* clear wakeups? */


retry_ws:	     call hcs_$tty_order (g115_device_data.devx, "write_status", addr (io_status), state, code);
	     if state ^= 5 then code = error_table_$io_no_permission;

	     if line_status_pending (code) then go to retry_ws;

	     return;

	end check_write_status;



line_status_pending: proc (code) returns (bit (1));

/* this procedure simply clears any pending line status and throws it away */

dcl  code fixed bin (35);

	     if code = 0 then return ("0"b);		/* avoid a loop for normal case */

	     do while (code = error_table_$line_status_pending);
		call hcs_$tty_order (g115_device_data.devx, "line_status", addr (line_status), state, code);
		if state ^= 5 then code = error_table_$io_no_permission;
	     end;

	     if code = 0 then return ("1"b);		/* OK to retry the operation */

	     return ("0"b);				/* do not attempt a retry */

	end line_status_pending;



block:	proc (code);

/* this procedure blocks on the pre-defined wait list for the device and waits for a wakeup from ring 0 */

dcl  code fixed bin (35);

	     event_info.wait_list_index = 0;		/* initialize test value */

	     call ipc_$block (addr (g115_device_data.wait_list), addr (event_info), code);

	     if event_info.wait_list_index = 2 then code = error_table_$net_timeout;

	     else if code ^= 0 then call convert_ipc_code_ (code);

	     send_wakeup = "1"b;			/* we may have stolen a wakeup, so give it back */

	     return;

	end block;

read:	entry (a_ddp, a_msgp, a_code);

/* This entry reads a message from ring 0 and puts it into the message buffer defined by a_msgp */

	device_data_p = a_ddp;			/* define the g115_device_data for this invocation */
	msgp = a_msgp;
	read_status_entry = "0"b;			/* this is not the read_status entry */

	go to READ_COMMON;


read_status: entry (a_ddp, a_infop, a_code);

/* This entry tries to read a message from ring zero (if available) and saves it in the last input buffer of the chain.
   It sets the input_available flag in the structure a_infop -> info if there is a valid record
   count in the message read.
*/

	device_data_p = a_ddp;			/* define the g115_device_data for this invocation */

	msgp = g115_device_data.last_bp;		/* get ptr to tail buffer of chain */
	if g115_message.rec_count > 0 then do;		/* something there? */
	     a_infop -> info.input_available = "1"b;	/* tell caller */
	     a_code = 0;
	     return;
	end;

	read_status_entry = "1"b;			/* this is the read_status entry */


READ_COMMON:

	a_code, code = 0;


	call read_message (msgp, code);
	if code ^= 0 then go to RETURN;

	if read_status_entry then			/* see if the message was good */
	     if g115_message.rec_count > 0 then
		a_infop -> info.input_available = "1"b; /* OK to read */

RETURN:						/* this is the common exit point for this external procedure */

	a_code = code;				/* copy back any status */

/*	If we went blocked, we may have taken a wakeup from a read_status then block sequence. */
/*	So we will send back a wakeup unconditionally if we went blocked at all, just in case.		*/

	if send_wakeup then call hcs_$wakeup (g115_device_data.process_id, g115_device_data.tty_ev_channel, 0, code);

	return;

read_message: proc (msgp, code);

dcl  msgp ptr;
dcl  code fixed bin (35);
dcl  msg_len fixed bin;
dcl  offset fixed bin;
dcl  read_ptr ptr;
dcl  max_len fixed bin;
dcl  etx_found bit (1);

	     msgp -> g115_message.last_char_read = 0;	/* reset state variables */
	     msgp -> g115_message.text_char_count = 0;
	     msgp -> g115_message.rec_count = 0;

	     offset = 0;				/* hardcore read offset */
	     max_len = G115.max_msg_len + 8;		/* SOH -> STX = 7, ETX = 1, total = 8 chars */
	     read_ptr = addr (msgp -> g115_message.g115_msg_block); /* where ring 0 should put the message */
try_read:
	     etx_found = "0"b;
	     msg_len, state = 0;

	     call hcs_$tty_get_line (g115_device_data.devx, read_ptr, offset, max_len - offset, msg_len,
		etx_found, state, code);
	     if state ^= 5 then code = error_table_$io_no_permission;
	     if line_status_pending (code) then go to try_read;
	     if code ^= 0 then return;

	     if msg_len < 1 then do;			/* no meat to the message */
		if g115_message.text_char_count = 0 then /* on partial read wait for complete msg */
		     if read_status_entry | g115_device_data.as_priv_no_block then return;
						/* for these cases, don't wait for a message */

		call block (code);			/* wait for the message (or remainder) to arrive */
		if code ^= 0 then return;
		go to try_read;			/* should get it this time */
	     end;

	     if msgp -> g115_message.text_char_count = 0 then /* allow for message header? (SOH -> STX = 7 chars) */
		msgp -> g115_message.text_char_count = msg_len - 7;
	     else msgp -> g115_message.text_char_count = msgp -> g115_message.text_char_count + msg_len;

	     if etx_found then			/* when complete, take the ETX char out of the count */
		msgp -> g115_message.text_char_count = msgp -> g115_message.text_char_count - 1;
	     else do;
		offset = msgp -> g115_message.text_char_count + 7; /* next read follows last char read */
		go to try_read;
	     end;

/* count the records in the message */

	     do idx = 1 to g115_message.text_char_count;
		if g115_message.text (idx) = G115.RS then /* look for record separators (RS) */
		     g115_message.rec_count = g115_message.rec_count + 1; /* add up full records */
	     end;
	     if g115_message.text (g115_message.text_char_count) ^= G115.RS then
						/* if last char is not RS, record is split */
		g115_message.rec_count = g115_message.rec_count + 1; /* add partial record to count */

	     return;

	end read_message;



     end g115_io_$write;




		    g115_protocol_.pl1              02/14/80  1738.9rew 02/14/80  1738.1      186624



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

g115_protocol_$write: proc (a_adp, a_ddp, a_bufp, a_nelem, a_code);

/* This procedure performs all the message blocking and formatting required by the G115
   Remote Computer Interface protocol.  Input and output are in the form of records, where one
   record may be a partial message, a full message or must be split across messages.

   On output, records are packed into messages.  The message is sent when it becomes
   full or when the format code of the message must be changed. Each record of a message begins with
   a media code which defines the target device (e.g. printer, bcd punch, binary punch, teleprinter)

   On input, only character data is allowed.  This may be for the teleprinter (operator commands) or for the
   card_input facility, but we can't tell which one (a deficiency in the protocol).
*/

/* Adapted from the original program g115_io_ by J. C. Whitmore, 9/79 */

dcl  a_adp ptr parameter;
dcl  a_ddp ptr parameter;
dcl  a_bufp ptr parameter;
dcl  a_nelem fixed bin parameter;
dcl  a_nelemt fixed bin parameter;
dcl  a_code parameter;


dcl  bufp ptr;
dcl  nelem fixed bin;
dcl  code fixed bin (35);

dcl  binary_record bit (960) aligned;			/* one binary card image */
dcl  level fixed bin;				/* automatic version of our invocation level */
dcl  format_code bit (9);
dcl  slew_char char (1);
dcl  io_data char (646) var;				/* data part of an input or output record */
dcl  io_record char (648) var;			/* the full record with media code and record separator */
dcl  idx fixed bin;					/* index variable */
dcl  CC_index fixed bin;				/* where the next compression char sits */
dcl  temp_buffer char (648) var;
dcl  test_char char (1);
dcl  rep_count fixed bin;				/* number of repeated chars in compression sequence */
dcl  bcd_count fixed bin;				/* number of 6-bit elements in data to be output */
dcl  space_left fixed bin;				/* number of chars remaining in current message block */
dcl  count_char char (1);				/* ASCII char representing BCD equiv compression count */

dcl  mess_p ptr;					/* temporary pointer to partial input message */
dcl  mess_len fixed bin;				/* length of partial input message */
dcl  remaining_message char (mess_len) based (mess_p);	/* the partial input message */

dcl  six_bit_number (bcd_count) fixed bin (6) unsigned unal based;

dcl  data_string char (nelem) based;			/* input data for the write entry */
						/* or output data for the read entry */
dcl  data_bit_string bit (nelem) based;			/* for binary punch, record length is in bits */

dcl  based_record char (record_len) based;
dcl  record_len fixed bin;
dcl  rec_p ptr;

dcl  convert_string_$input entry (char (*) var, ptr, char (*) var, fixed bin (35));
dcl  convert_string_$output entry (char (*) var, ptr, char (*) var, fixed bin (35));
dcl  g115_io_$write entry (ptr, ptr, fixed bin (35));
dcl  g115_io_$read entry (ptr, ptr, fixed bin (35));

dcl (addr, null, length, substr, copy, index, divide, maxlength) builtin;

dcl (error_table_$eof_record,
     error_table_$too_many_buffers,
     error_table_$no_operation,
     error_table_$improper_data_format,
     error_table_$long_record,
     error_table_$data_loss) fixed bin (35) ext;


dcl  legal_slew_chars char (19) int static options (constant) init (" 0123456789[#@:>?AB");
						/* printer slew codes, in order: */
						/* Top of Form - space */
						/* slew 0 to 15 lines - 0...? */
						/* VFU_1 - A,  VFU_2 - B  */

dcl  bcd_equiv_string char (64) unal int static options (constant)
     init ("0123456789[#@:>? ABCDEFGHI&.](<\^JKLMNOPQR-$*);'+/STUVWXYZ_,%=""!");

dcl  bcd_equiv (0:63) char (1) unal defined (bcd_equiv_string); /* 6-bit index to get equiv ASCII char */

dcl  bcd_equiv_overlay char (63) defined (bcd_equiv_string) pos (2); /* overlay of bcd_equiv_string starting at element 2 */

dcl  cleanup condition;


%include g115_device_data;

%include g115_message;

%include G115;

%include g115_attach_data;

%include remote_ttt_info;

/* g115_protocol_$write:  proc (a_adp, a_ddp, a_bufp, a_nelem, a_code);  */

/* This entry takes a record described by a_bufp -> output_string (a_nelem) and prepares it to be
   sent to the remote computer.  The message defined by g115_device_data.outp (level) -> g115_message.g115_msg_block
   is used to accumulate records until the 324 char message block is full (or almost).  Then it is sent to the
   remote computer by calling g115_io_$write.

   The current message block is kept in a consistent state at all times so it can be "runout" by the
   subsystem at any time.  A cleanup handler is used to insure that any message being updated was not
   left in an inconsistent state.

   The attach data for the switch performing the write defines the media code (i.e. target device).
   A single message block can contain records for several devices as long as the format code of
   the entire message is constant for all records.

   The format code for the teleprinter device is different than for printer and punch data.
   Also, records for the teleprinter are sent immediately, one record per message block, and must not
   be compressed or split across messages.

   If the media code is printer, the last char of the input string must be the slew control character.

   If the media code is binary punch, the input string is a record of 1 to 960 bits as defined by a_nelem.
   The input string is taken 6-bits at a time and converted to
   an ASCII character equivalent to the BCD representation of the 6-bits.
*/

	a_code, code = 0;
	adp = a_adp;
	device_data_p = a_ddp;
	nelem = a_nelem;
	bufp = a_bufp;

	if g115_attach_data.media_code = G115.punch_bin_mc then do; /* length of binary input is different */
	     if nelem > length (binary_record) then go to NO_ROOM; /* too many bits for one card */
	end;
	else if nelem > maxlength (io_data) then do;	/* internal buffer limit for character records */
NO_ROOM:	     a_code = error_table_$long_record;
	     return;
	end;

	if g115_device_data.level = hbound (g115_device_data.outp, 1) then do;
	     a_code = error_table_$too_many_buffers;
	     return;
	end;

	g115_device_data.level = g115_device_data.level + 1; /* set buffer level for this invocation */
	level = g115_device_data.level;		/* save a copy in automatic storage */
	msgp = g115_device_data.outp (level);		/* get the output buffer for this level */
	if msgp = null then do;			/* if not allocated, do it (never free output buffers) */
	     allocate g115_message in (buffer_area) set (g115_device_data.outp (level));
	     msgp = g115_device_data.outp (level);	/* set ref ptr for structure */
	     g115_message = g115_device_data.template_ptr -> g115_message; /* initialize it */
	end;

	on cleanup begin;

/*	check out the status of the message defined by this invocation   */

	     if g115_message.being_changed | g115_device_data.level > 1 then do;
						/* flush inconsistent or higher level messages */
		msgp -> g115_message.text_char_count = 0;
		msgp -> g115_message.rec_count = 0;
		msgp -> g115_message.fmt_code = "0"b;
		msgp -> g115_message.being_changed = "0"b; /* OK now */
	     end;

	     g115_device_data.level = g115_device_data.level - 1; /* back to value when called */
	end;

/* define the format code for this record */

	if g115_attach_data.device_type = teleprinter then format_code = g115_device_data.fmt_code.control;
	else format_code = g115_device_data.fmt_code.data;

	if g115_message.text_char_count > 0 then	/* if there are records waiting */
	     if g115_message.fmt_code ^= format_code then do; /* and the format code is changing */
		call send_message_block (code);	/* then send the partial block */
		if code ^= 0 then go to WRITE_RETURN;
	     end;

	g115_message.fmt_code = format_code;		/* this may be redundant at times, but cheap ... */

/* start special processing of text */

	if g115_attach_data.device_type = printer then do; /* for the printer, check the slew char */
	     slew_char = substr (bufp -> data_string, nelem, 1); /* slew code is the last char of input data */
	     if index (legal_slew_chars, slew_char) = 0 then /* if slew code not defined ...  */
		slew_char = "1";			/* default to single new line */
	     nelem = nelem - 1;			/* process remaining text up to the slew char */
	end;

	if g115_attach_data.media_code = G115.punch_bin_mc then do; /* Binary Punch Output */
	     binary_record = bufp -> data_bit_string;	/* align data and pad with zeros */
	     bufp = addr (binary_record);		/* use our copy now */
	     bcd_count = divide (nelem + 5, 6, 0);	/* number of 6-bit elements */


	     io_data = "";				/* clear the conversion string */
	     do idx = 1 to bcd_count;
						/* get six bits as unsigned fixed bin index */
		io_data = io_data || bcd_equiv (bufp -> six_bit_number (idx)); /* output ASCII - bcd equiv of index */
	     end;
	end;
	else do;					/* Character Output */
	     temp_buffer = bufp -> data_string;		/* put data into local buffer */
	     if length (temp_buffer) > 0 then do;
						/* do any escape and/or translation processing */
		call convert_string_$output (temp_buffer, addr (g115_attach_data.ttt_info), io_data, code);
		if code ^= 0 then go to WRITE_RETURN;
	     end;
	     else io_data = "";			/* no data, could be just a printer slew record */
	end;

/* are we supposed to compress multiple characters (NOT allowed for teleprinter output) */

	if g115_device_data.write_compress & g115_attach_data.device_type ^= teleprinter then do;
	     temp_buffer = io_data;			/* copy into temp buffer */
	     io_data = "";				/* clear output and rebuild */
	     idx = 1;
	     do while (idx <= length (temp_buffer));	/* loop through the input string */
		test_char = substr (temp_buffer, idx, 1); /* find next char */
		rep_count = verify (substr (temp_buffer, idx), test_char) - 1; /* how many are there? */

		if rep_count < 1 then		/* remainder of string is the same */
		     rep_count = length (temp_buffer) - idx + 1; /* see how many */

		if rep_count > 3 then do;		/* compress if more than three in a row */
		     if rep_count > 64 then rep_count = 64; /* only compress 64 at a time */
		     count_char = bcd_equiv (rep_count - 1); /* don't include first char in repitition count */
		     io_data = io_data || test_char || G115.CC || count_char;
		end;

		else do;				/* put in a few (1 to 3) of the char */
		     io_data = io_data || substr (temp_buffer, idx, rep_count);
		end;

		idx = idx + rep_count;		/* bump the index */
	     end;
	end;

/* format the data into a legal G115 record: <media_code><data>[<slew>]<record_separator> */

	if g115_attach_data.device_type = printer
	then io_record = g115_attach_data.media_code || io_data || slew_char || G115.RS;
	else io_record = g115_attach_data.media_code || io_data || G115.RS;
	record_len = length (io_record);		/* set the length of the based record */

	if g115_attach_data.device_type = teleprinter & record_len > G115.max_msg_len then go to NO_ROOM;
						/* teleprinter records cannot be split */

/* this is the critical part of the code, add the record to the current message */

	space_left = G115.max_msg_len - g115_message.text_char_count;

	if record_len > space_left then do;		/* won't fit completely (can't happen for the teleprinter) */
	     if g115_device_data.write_split then do;	/* can we add part of it to current message block */
		g115_message.being_changed = "1"b;	/* mark as inconsistent */
		rec_p = addr (g115_message.etx);	/* get ptr to start of next record */
		substr (rec_p -> based_record, 1, space_left) = substr (io_record, 1, space_left);
		g115_message.text_char_count = g115_message.text_char_count + space_left;
		g115_message.etx = G115.etx_char;	/* put back the closing ETX */
		g115_message.being_changed = "0"b;	/* message is now back to normal */
		io_record = substr (io_record, space_left + 1); /* save the part not sent */
		record_len = length (io_record);	/* define new based record length */
	     end;
	     call send_message_block (code);		/* send off the current block and start a new one */
	     if code ^= 0 then go to WRITE_RETURN;
	end;

	g115_message.being_changed = "1"b;		/* tell handler message is inconsistent */
	rec_p = addr (g115_message.etx);		/* find start of next record */
	rec_p -> based_record = io_record;		/* add in the record (or the last part of split) */
	g115_message.text_char_count = g115_message.text_char_count + record_len;
	g115_message.etx = G115.etx_char;
	g115_message.being_changed = "0"b;		/* back to a legal message again */

/* All is safe now, the message is again consistent and ready to transmit.
   See if we should send it now or wait.  Protocol says that there can only be one record per message
   for the teleprinter, so always send teleprinter output.  Otherwise wait til there is enough to keep
   the line overhead down or til the caller wants a runout.

   The exception to this rule is that if this invocation level is greater than 1, we should send the
   message because we may not get back to this level again to fill up the block.
*/

	if g115_attach_data.device_type = teleprinter then call send_message_block (code);

	else if level > 1 then call send_message_block (code);

	else if g115_message.text_char_count > 300 then call send_message_block (code);
						/* if close to full, why wait? */
WRITE_RETURN:

	a_code = code;				/* copy back the code */

	g115_device_data.level = g115_device_data.level - 1; /* pop the invocation level */

	revert cleanup;				/* be sure we don't do it twice */

	return;




send_message_block: proc (code);

dcl  code fixed bin (35);

	     code = 0;

	     if ^g115_message.being_changed then do;	/* if not consistent, quietly flush it */
		call g115_io_$write (device_data_p, msgp, code);
		if code ^= 0 then return;
	     end;

	     g115_message.text_char_count = 0;		/* make this message block clean again */
	     g115_message.being_changed = ""b;

	     return;

	end send_message_block;

read:	entry (a_adp, a_ddp, a_bufp, a_nelem, a_nelemt, a_code);

/* This entry is used to read one record of a message block from the remote computer.
   Only character data is accepted, and we have no way of knowing if the data is for the reader device
   or for the operator.

   The caller wants the data to be put into the string a_bufp -> data_string (a_nelem).  The record may
   be shorter than a_nelem, so we tell how many were in the record by setting a_nelemt.
   If the record is greater than a_nelem, we return as many as possible, throw away the extra
   and return error_table_$data_loss as a status code.

*/

	a_code, code, a_nelemt = 0;			/* init return stuff */
	adp = a_adp;
	device_data_p = a_ddp;
	bufp = a_bufp;
	nelem = a_nelem;

	if nelem < 1 then do;			/* read zero length record? */
	     a_code = error_table_$no_operation;
	     return;
	end;

	msgp = g115_device_data.first_bp;		/* get pointer to first input buffer */
	if g115_message.rec_count < 1 then do;		/* is this block finished? */
	     call get_next_message (msgp, code);	/* find a new message to process */
	     if code ^= 0 then go to READ_RETURN;
	end;

/* at this point msgp should point to a valid data block (unless this is the Answering Service) */

	if msgp -> g115_message.rec_count < 1 then return; /* no data */

/* The input message block consists of one or more records of the form:

   <media_code><text_data><record_separator>

   we want to give the caller the text_data part of the next unprocessed record	*/
	test_char = g115_message.text (g115_message.last_char_read + 1); /* pickup the media code of next record */

	if test_char ^= G115.bcd_input_mc then do;	/* force the issue, ignore binary input */
	     g115_message.text_char_count = 0;
	     g115_message.rec_count = 0;		/* for now, kill the whole record */
	     code = error_table_$improper_data_format;
	     go to READ_RETURN;
	end;

	mess_p = addr (g115_message.text (g115_message.last_char_read + 2)); /* pointer to <text_data> (after media code) */
	mess_len = g115_message.text_char_count - g115_message.last_char_read - 1; /* length of remaining message */

	g115_message.last_char_read = g115_message.last_char_read + 1; /* we have used up the media code */

	io_data = "";				/* clear the buffer */
	idx = index (remaining_message, G115.RS);	/* find record separator which ends record */
	do while (idx = 0);				/* collect split records if any */
	     if length (io_data) + mess_len > maxlength (io_data) then do; /* will it fit */
LONG_RECORD:	a_code = error_table_$long_record;
		return;
	     end;
	     io_data = io_data || remaining_message;	/* first part of record is all this remaining message */
	     call get_next_message (msgp, code);	/* rest of record should be in next message */
	     if code ^= 0 then goto READ_RETURN;
	     mess_p = addr (g115_message.text (1));	/* define the new remaining message string */
	     mess_len = g115_message.text_char_count;	/* continuation of record has no media code */
	     idx = index (remaining_message, G115.RS);	/* look for the record separator */
	     if length (io_data) + idx > maxlength (io_data) then go to LONG_RECORD;
	end;
	io_data = io_data || substr (remaining_message, 1, idx - 1); /* last of record text less separator (G115.RS) */

	g115_message.last_char_read = g115_message.last_char_read + idx; /* record the last char that was used */
	g115_message.rec_count = g115_message.rec_count - 1; /* decrement input count in message */

/* The text_data can contain compressed data of the form:

   <repeat_char><G115.CC><count_char>

   Where:

   *	repeat_char	is the actual character that appears 3 to 64 times in a row.
   *	G115.CC		is the compression code - 037 octal.

   *	count_char	is an ASCII char, the equivalent 6-bit BCD value of which is the fixed bin
   *			representation of the number of times the repeat char is repeated AFTER the first occurance.
   *			(i.e. count_char "[" represents the number 10, thus 11 repeat_chars should appear
   *			in the output data after de-compression.)
*/

	temp_buffer = "";				/* get ready to rebuild the data in the temporary */
	idx = 1;					/* start looking from the first char in the record */
	CC_index = index (io_data, G115.CC);		/* look for a compression code (CC) */
	do while (CC_index > 0);			/* loop de-compressing record */
	     temp_buffer = temp_buffer || substr (io_data, idx, CC_index - 1); /* copy all up to compression code */
	     test_char = substr (io_data, idx + CC_index - 2, 1); /* pick up repeated char (before CC) */
	     idx = idx + CC_index + 1;		/* move index to next unprocessed char */
	     count_char = substr (io_data, idx - 1, 1);	/* this represents number of repeates */
	     rep_count = index (bcd_equiv_overlay, count_char); /* convert to fixed bin */
	     temp_buffer = temp_buffer || copy (test_char, rep_count);
	     CC_index = index (substr (io_data, idx), G115.CC); /* look for next compression code */
	end;
	temp_buffer = temp_buffer || substr (io_data, idx); /* copy remainder of input */

/* do any escape and/or translation processing */

	call convert_string_$input (temp_buffer, addr (g115_attach_data.ttt_info), io_data, code);
	if code ^= 0 then go to READ_RETURN;

	if io_data = "++EOF" | io_data = "++eof" then
	     code = error_table_$eof_record;		/* set end-of-file code */

	record_len = length (io_data);
	if nelem < record_len then do;		/* not enough room to return all */
	     code = error_table_$data_loss;		/* give warning */
	     record_len = nelem;
	end;
	substr (bufp -> data_string, 1, record_len) = substr (io_data, 1, record_len); /* give data to caller */
	a_nelemt = record_len;

READ_RETURN:

	a_code = code;

	return;


get_next_message: proc (msgp, code);

dcl  msgp ptr;
dcl  code fixed bin (35);

	     code = 0;

/*	see if there is a chain of messages already */

follow_chain:  if msgp -> g115_message.next_bp = null then	/* must read a message from Ring 0 */
		call g115_io_$read (device_data_p, msgp, code);

	     else do;				/* chain of input blocks exist, go to the next one */
		g115_device_data.first_bp = g115_message.next_bp;
		free msgp -> g115_message in (buffer_area);
		msgp = g115_device_data.first_bp;
		if msgp -> g115_message.rec_count = 0 then go to follow_chain; /* if empty, try again */
	     end;

	     return;

	end get_next_message;




     end g115_protocol_$write;



		    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
