



		    PNOTICE_ws_tty_.alm             08/10/87  0927.7rew 08/07/87  1454.7        4815



" 
" HISTORY COMMENTS:
"  1) change(86-12-12,RBarstad), approve(86-12-12,MCR7585),
"     audit(86-12-12,Gilcrease), install(87-08-07,MR12.1-1075):
"               mowse video interface
"                                                      END HISTORY COMMENTS
"
	dec	1			"version 1 structure
	dec	1			"no. of pnotices
	dec	3			"no. of STIs
	dec	56			"lgth of all pnotices + no. of pnotices
          acc       "Copyright, (C) Honeywell Information Systems Inc., 1986"

	aci	"C1xxxxxx0000"
	aci	"C2xxxxxx0000"
	aci	"C3xxxxxx0000"
	end




		    ws_trace_.pl1                   08/10/87  0936.3rew 08/10/87  0936.3       90927



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1986 *
        *                                                         *
        *********************************************************** */

/****^  HISTORY COMMENTS:
  1) change(86-12-05,RBarstad), approve(86-12-11,MCR7585),
     audit(87-06-05,Gilcrease), install(87-08-07,MR12.1-1075):
     Created.
                                                   END HISTORY COMMENTS */

/* format: style3,ifthenstmt,indthenelse,^indnoniterdo,^indprocbody,initcol3,dclind5,idind32 */
ws_trace_:
     proc () options (variable);

/* ------------------------  DESCRIPTION  ---------------------------------- */

/****^    VERSION 1.10

  Trace and debug routine for mowse video support. Allows output 
  normally written to the terminal to be saved to a trace file.
  Also has entries to set and get the trace and debug settings.

*/
%page;
/* ------------------------  PARAMETERS  ----------------------------------- */

/* ------------------------  AUTOMATIC  ------------------------------------ */

dcl  arg_list_ptr		       ptr;
dcl  message		       char (512) unal;
dcl  raw_message_length	       fixed bin (21);
dcl  message_length		       fixed bin (21);
dcl  adj_bit_count		       fixed bin (35);
dcl  bit_count		       fixed bin (24);
dcl  code			       fixed bin (35);	/* local version of code */
dcl  created		       bit (1) aligned;
dcl  date_time_		       entry (fixed bin (71), char (*));
dcl  dir_name		       char (168);
dcl  i			       fixed bin (21);
dcl  last_char		       fixed bin (21);
dcl  lock_chars		       char (12) aligned;
dcl  now			       char (24);
dcl  process_id		       fixed bin based (addr (ws_seg.lock));
dcl  retval		       fixed bin (35);
dcl  ws_io_ptr		       ptr;

dcl  01 ws_seg		       aligned based (ws_io_ptr),
       02 lock		       bit (36),
       02 next_byte		       fixed bin (21),
       02 string		       char (MAX_CHARS);

/* ------------------------  ENTRIES  -------------------------------------- */

dcl  cu_$arg_list_ptr	       entry (ptr);
dcl  ioa_$general_rs	       entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned,
			       bit (1) aligned);

dcl  adjust_bit_count_	       entry (char (168), char (32), bit (1) aligned, fixed bin (35), fixed bin (35));
dcl  cv_bin_$oct		       entry (fixed bin, char (12) aligned);
dcl  get_wdir_		       entry () returns (char (168));
dcl  hcs_$set_bc_seg	       entry (ptr, fixed bin (24), fixed bin (35));
dcl  initiate_file_$create	       entry (char (*), char (*), bit (*), ptr, bit (1) aligned, fixed bin (24),
			       fixed bin (35));
dcl  set_lock_$lock		       entry (bit (36) aligned, fixed bin, fixed bin (35));
dcl  set_lock_$unlock	       entry (bit (36) aligned, fixed bin (35));
dcl  sub_err_		       entry () options (variable);
dcl  terminate_file_	       entry (ptr, fixed bin (24), bit (*), fixed bin (35));

/* ------------------------  EXTERNALS  ------------------------------------ */

dcl  (
     error_table_$invalid_lock_reset,
     error_table_$lock_not_locked,
     error_table_$locked_by_this_process
     )			       fixed bin (35) ext static;

/* ------------------------  CONSTANTS  ------------------------------------ */

dcl  (
     SEG_NAME		       char (32) init ("ws_tty_.trace"),
     MAX_CHARS		       fixed bin (21) init (1044472),
						/* 255*1024*4-2*4 */
     FUDGE		       fixed bin init (40),	/* 12+1+24+1+2: size of process id+date&time+NL+spaces */
     BLANK		       char (1) init (" "),
     NL			       char (1) init ("
"),						/* new line (line feed) */
     WAIT_TIME		       fixed bin init (10),
     DATE_LEN		       fixed bin init (16)
     )			       internal static options (constant);


/* ------------------------  BUILTINS and CONDITIONS  ---------------------- */

dcl  (addr, clock, divide, length, rtrim, substr)
			       builtin;

%page;
/* ------------------------  MAIN ENTRY  ----------------------------------- */

/****^	     algorithm

	     set the lock control word

	     write the date and time
	     write the caller name and message
	     write a new line

	     update the seg byte count
	     update the seg bit count

	     unlock the lock
*/

/* get and convert the callers ioa string */

     message = " ";
     call cu_$arg_list_ptr (arg_list_ptr);
     call ioa_$general_rs (arg_list_ptr, 1, 2, message, raw_message_length, "1"b, "0"b);
     raw_message_length = length (rtrim (message));
     message = esc_canon (message, raw_message_length, message_length);

/* initialize and get the seg */

     dir_name = get_wdir_ ();

     call initiate_file_$create (dir_name, SEG_NAME, "101"b, ws_io_ptr, created, bit_count, code);
     if code ^= 0 then goto err_exit;
     if bit_count = 0
	then do;					/* virgin seg */
	     bit_count = 72;
	     next_byte = 2;
	     substr (string, 1, 1) = NL;
	     call hcs_$set_bc_seg (ws_io_ptr, bit_count, code);
	     if code ^= 0 then goto err_exit;
	end;


/* lock */

     call set_lock_$lock (ws_seg.lock, WAIT_TIME, code);
     if code ^= 0
	then if code ^= error_table_$invalid_lock_reset
		then if code ^= error_table_$locked_by_this_process then goto err_exit;

/* write the stuff to it */

     if (next_byte + FUDGE + message_length) > MAX_CHARS
	then do;
	     next_byte = 2;
	     substr (string, 1, 1) = NL;
	end;

/* convert and write lock id */

     call cv_bin_$oct (process_id, lock_chars);
     substr (string, next_byte, 12) = lock_chars;
     next_byte = next_byte + 12;
     substr (string, next_byte, 1) = BLANK;
     next_byte = next_byte + 1;

/* write date and time */

     call date_time_ (clock (), now);
     substr (string, next_byte, DATE_LEN) = substr (now, 1, DATE_LEN);
     next_byte = next_byte + DATE_LEN;
     substr (string, next_byte, 1) = BLANK;
     next_byte = next_byte + 1;

/* write caller's message */

     substr (string, next_byte, message_length) = substr (message, 1, message_length);
     next_byte = next_byte + message_length;
     substr (string, next_byte, 1) = NL;
     next_byte = next_byte + 1;

/* set bit count blank to next NL (or end) */

     call adjust_bit_count_ (dir_name, SEG_NAME, "1"b, adj_bit_count, code);
     if code ^= 0 then goto unlock_exit;
     last_char = divide (adj_bit_count - 72, 9, 7);
     do i = next_byte to last_char while (substr (string, i, 1) ^= NL);
	substr (string, i, 1) = "$";
     end;

/* unlock and terminate seg */

     call set_lock_$unlock (ws_seg.lock, code);
     if code ^= 0
	then if code ^= error_table_$lock_not_locked then goto err_exit;

     call terminate_file_ (ws_io_ptr, (adj_bit_count), TERM_FILE_TERM, code);
     if code ^= 0 then goto err_exit;
     goto exit;

unlock_exit:
     ;
     call set_lock_$unlock (ws_seg.lock, code);
     goto exit;					/* code doesn't matter */

err_exit:
     ;

     call sub_err_ (code, "ws_trace_", ACTION_CAN_RESTART, sub_error_info_ptr, retval,
	"While attempting to access trace dump file ^a>^a", dir_name, SEG_NAME);

exit:
     ;
     return;

/* ------------------------  END MAIN  ------------------------------------- */
%page;
esc_canon:
     proc (in_string, I_length, O_length) returns (char (512));

dcl  in_string		       char (*) parm;
dcl  I_length		       fixed bin (21) parm;
dcl  O_length		       fixed bin (21) parm;

dcl  in_char		       char (1);
dcl  out_string		       char (512);
dcl  i			       fixed bin;
dcl  FIRST_CHAR		       char (1) int static options (constant) init (" ");
dcl  LAST_CHAR		       char (1) int static options (constant) init ("~");
dcl  ESC_CHAR		       char (1) int static options (constant) init ("\");
dcl  in_length,
     out_length		       fixed bin (21);
dcl  cv_bin_$oct		       entry (fixed bin, char (12) aligned);
dcl  ascii_chars		       char (12) aligned;
dcl  rank			       builtin;
dcl  MAX_LEN		       fixed bin int static options (constant) init (512);


     in_length = I_length;
     out_length = 0;
     out_string = " ";

     do i = 1 to in_length;
	in_char = substr (in_string, i, 1);
	if ((in_char < FIRST_CHAR) | (in_char > LAST_CHAR)) & (i < in_length)
	     then do;				/* control char */
		if out_length + 4 >= MAX_LEN then goto esc_done;
		out_length = out_length + 1;
		substr (out_string, out_length, 1) = ESC_CHAR;
		out_length = out_length + 1;
		call cv_bin_$oct (rank (in_char), ascii_chars);
		substr (out_string, out_length, 3) = substr (ascii_chars, 10, 3);
		if (substr (out_string, out_length, 1) = " ") then substr (out_string, out_length, 1) = "0";
		if (substr (out_string, out_length + 1, 1) = " ") then substr (out_string, out_length + 1, 1) = "0";
		out_length = out_length + 2;
	     end;
	     else do;				/* normal char */
		if out_length + 1 >= MAX_LEN then goto esc_done;
		out_length = out_length + 1;
		substr (out_string, out_length, 1) = in_char;
	     end;
     end;
esc_done:
     O_length = out_length;
     return (out_string);
     end esc_canon;
%page;
/* ------------------------  ENTRIES  ------------------------------------- */

set_debug:
     entry (debug_switch);
dcl  debug_switch		       bit (1) parm;	/* 1=on, 0=off */
     ws_tty_data$Flags.Debug = debug_switch;
     return;

get_debug:
     entry (debug_switch);
     debug_switch = ws_tty_data$Flags.Debug;
     return;

set_trace:
     entry (trace_switch);
dcl  trace_switch		       bit (1) parm;	/* 1=on, 0=off */
     ws_tty_data$Flags.Trace = trace_switch;
     return;

get_trace:
     entry (trace_switch);
     trace_switch = ws_tty_data$Flags.Trace;
     return;

/* ------------------------  END PROGRAM  ---------------------------------- */
%page;
/* ------------------------  INCLUDES  ------------------------------------- */

%include terminate_file;
%include sub_error_info;
%include condition_info_header;
%include sub_err_flags;
%include ws_tty_data;
     end ws_trace_;




		    ws_tty_.alm                     08/07/87  1543.7rew 08/07/87  1455.1       12753



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Bull Inc., 1987                *
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1986 *
" *                                                         *
" ***********************************************************

" HISTORY COMMENTS:
"  1) change(86-11-05,RBarstad), approve(86-12-11,MCR7585),
"     audit(86-12-12,Gilcrease), install(87-08-07,MR12.1-1075):
"     Created.
"                                                      END HISTORY COMMENTS

"
" ws_tty_: transfer vector to ws_tty_ functions.
"

	name	ws_tty_

macro	dispatch
	segdef	&1
&1:	getlp
	tra	&2$&3
&end

	dispatch  abort,ws_tty_main_,abort
	dispatch  attach,ws_tty_main_,attach
	dispatch  detach,ws_tty_main_,detach
	dispatch  event,ws_tty_main_,event
	dispatch  index,ws_tty_main_,index
	dispatch  order,ws_tty_main_,order
	dispatch	read,ws_tty_read_,read
	dispatch	read_echoed,ws_tty_read_,read_echoed
	dispatch	read_with_mark,ws_tty_read_,read_with_mark
	dispatch  write,ws_tty_write_,write
	dispatch  write_whole_string,ws_tty_write_,write_whole_string

	dispatch  set_trace,ws_trace_,set_trace
	dispatch  get_trace,ws_trace_,get_trace
	dispatch  set_debug,ws_trace_,set_debug
	dispatch  get_debug,ws_trace_,get_debug

	end




		    ws_tty_data.cds                 08/07/87  1544.1rew 08/07/87  1510.8       27027



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1986 *
   *                                                         *
   *********************************************************** */

/* HISTORY COMMENTS:
  1) change(86-11-17,RBarstad), approve(86-12-11,MCR7585),
     audit(86-12-12,Gilcrease):
     Written. External data seg for ws_tty_.
                                                   END HISTORY COMMENTS */

ws_tty_data:proc;

/* Version 1.0
*/

/** Initialize cds_args **/

	cds_args_ptr=addr(space_for_cds_args);
	unspec(space_for_cds_args)="0"b;

/** Reference structure input to cds to assure it is in runtime table. **/

	if addr(ws_tty_data)=null() then ;

/** No text section **/
	cds_args_ptr -> cds_args.sections (1).p = null ();
	cds_args_ptr -> cds_args.sections (1).len = 0;
	cds_args_ptr -> cds_args.sections (1).struct_name = "NO_TEXT";

/** Static section **/
	cds_args_ptr -> cds_args.sections (2).p = addr (ws_tty_data);	/* Caller's data. */
	cds_args_ptr -> cds_args.sections (2).len = size (ws_tty_data);	/* No. words in data structure. */
	cds_args_ptr -> cds_args.sections (2).struct_name = "ws_tty_data";

	cds_args_ptr -> cds_args.seg_name = "ws_tty_data";	/* Entryname of object segment. */
	cds_args_ptr -> cds_args.num_exclude_names = 0;		/* All level 2 names are entry points. */
	cds_args_ptr -> cds_args.exclude_array_ptr = null ();
	cds_args_ptr -> cds_args.switches.defs_in_link = "0"b;	/* Definitions contiguous to text section. */
	cds_args_ptr -> cds_args.switches.separate_static = "0"b;	/* Static in linkage section (to bind). */
	cds_args_ptr -> cds_args.switches.have_text = "0"b;	/* No text section. */
	cds_args_ptr -> cds_args.switches.have_static = "1"b;	/* There is a static section. */
	cds_args_ptr -> cds_args.switches.pad = "0"b;		/* Must be zeroes (see create_data_segment_). */

	call create_data_segment_ (cds_args_ptr, code);
	if code ^= 0 
	   then 
	      call com_err_ (code, "cds_ws_tty_data");
	   else 
	      call com_err_( 0,"ws_tty_data","Object for ws_tty_data created [^i words].",size(ws_tty_data));

	return;
%page;
/** Data for cds **/
dcl  addr                     builtin;
dcl  cds_args_ptr             ptr init(null());
dcl  code                     fixed bin(35);
dcl  com_err_                 entry options(variable);
dcl  create_data_segment_     entry(ptr,fixed bin(35));
dcl  null                     builtin;
dcl  size                     builtin;
dcl  unspec                   builtin;
dcl  1 space_for_cds_args     aligned like cds_args;
%page;
/** This data structure must exactly match that of ws_tty_data.incl.pl1 **/

dcl 1 ws_tty_data		aligned,
      2 Flags		aligned,
        3 Debug		bit (1) unaligned init ("0"b),
        3 Trace		bit (1) unaligned init ("0"b),
        3 Pad 		bit (34) unaligned init ((34)"0"b);

%page;
%include ws_tty_data;
%page;
%include cds_args;
end;




		    ws_tty_main_.pl1                01/24/89  0855.8r w 01/24/89  0847.4      208791



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1986 *
        *                                                         *
        *********************************************************** */

/****^  HISTORY COMMENTS:
  1) change(86-12-05,RBarstad), approve(86-12-11,MCR7585),
     audit(87-07-23,Gilcrease), install(87-08-07,MR12.1-1075):
     Created.
                                                   END HISTORY COMMENTS */

/* format: style3,^ifthenstmt,indthenelse,^indnoniterdo,^indprocbody,initcol3,dclind5,idind32 */
ws_tty_main_:
     proc ();
     return;

/* ------------------------  DESCRIPTION  ---------------------------------- */

/****^ VERSION 1.35
							
     ws_tty_ entries to support video mode in MOWSE work station. 	
     All calls here to iox_ are actually to mowse_io_

     ws_tty_$abort 					
     ws_tty_$attach 					
     ws_tty_$detach 					
     ws_tty_$event 					
     ws_tty_$index 					
     ws_tty_$order 					
 							
*/
%page;
/* ------------------------  PARAMETERS  ----------------------------------- */

dcl  I_argptr		       ptr parm;		/* pointer to order data */
dcl  I_dflag		       fixed bin parm;	/* disposition flag */
dcl  I_event		       fixed bin (71) parm;	/* event channel name */
dcl  I_name		       char (*) parm;	/* tty name such as tty192 */
dcl  I_order		       char (*) parm;	/* order name */
dcl  I_resetsw		       fixed bin parm;	/* abort code, 1 reset read, 2 reset write, 3 reset both */
dcl  I_iocb_ptr		       ptr parm;		/* ptr for iox */
dcl  O_code		       fixed bin (35) parm;	/* error code */
dcl  O_tty_state		       fixed bin parm;	/* tty state, 1 ignored, 2 listening, 5 dialed */

/* ------------------------  AUTOMATIC  ------------------------------------ */

dcl  argptr		       ptr;		/* pointer to order data */
dcl  break_table_ptr	       ptr;
dcl  break_table_size	       fixed bin;
dcl  code			       fixed bin (35);	/* error code */
dcl  dflag		       fixed bin;		/* disposition flag */
dcl  event		       fixed bin (71);	/* event channel name */
dcl  event_code		       fixed bin (35);
dcl  get_msg_id		       char (3);		/* message id returned from ws */
dcl  iocb_ptr		       ptr;		/* iocb pointer for iox */
dcl  name			       char (32);
dcl  num_exit_tries		       fixed bin;		/* count of reads for "SMX" */
dcl  order		       char (32);
dcl  resetsw		       fixed bin;		/* abort code, 1 reset read, 2 reset write, 3 reset both */
dcl  rw_switch		       bit (2) aligned;	/* bit-string version of reset read/write switch */
dcl  tty_state		       fixed bin;		/* tty state, 1 ignored, 2 listening, 5 dialed */
dcl  saved_mask		       bit (36) aligned;	/* saved ips mask */
dcl  unmask_count                    fixed bin;
dcl  count                           fixed bin;

dcl  1 saved_mask_bit	       aligned based (addr (saved_mask)),
       2 interrupts		       bit (35) unaligned,
       2 control		       bit (1) unaligned;

dcl  string_size		       fixed bin (21);
dcl  string_ptr		       ptr;
dcl  string		       char (MAX_SEND_MSG_SIZE);
dcl  1 video_mode_info	       like mowse_io_set_video_mode_info;

/* ------------------------  BASED  ---------------------------------------- */

dcl  1 modes_info		       aligned based (argptr),
       2 mode_length	       fixed bin,
       2 mode_string	       char (512);

dcl  new_modes		       char (512);

/* ------------------------  CONSTANTS  ------------------------------------ */

dcl  (
     ME			       char (12) init ("ws_tty_main_"),
     V1_ECHO_NEG_BREAK_TABLE_SIZE    fixed bin init (126),
     FALSE		       bit (1) init ("0"b),
     TRUE			       bit (1) init ("1"b),
     MAX_SEND_MSG_SIZE	       fixed bin (21) init (255),
     ZERO_IPS_MASK		       bit (36) init ((36)"0"b),
     EXIT_THRESHOLD		       fixed bin init (5)
     )			       internal static options (constant);

/* ------------------------  EXTERNALS  ------------------------------------ */

dcl  (
     error_table_$action_not_performed,
     error_table_$undefined_order_request,
     error_table_$unimplemented_version
     )			       fixed bin (35) external static;

/* ------------------------  ENTRIES  -------------------------------------- */

dcl  hcs_$set_ips_mask	       entry (bit (36) aligned, bit (36) aligned);
dcl  hcs_$reset_ips_mask	       entry (bit (36) aligned, bit (36) aligned);
dcl  ipc_$mask_ev_calls              entry (fixed bin(35));
dcl  ipc_$unmask_ev_calls            entry (fixed bin(35));
dcl  iox_$control		       entry (ptr, char (*), ptr, fixed bin (35));
dcl  iox_$modes		       entry (ptr, char (*), char (*), fixed bin (35));
dcl  ws_tty_mgr_$have_wsterm	       entry (ptr, fixed bin, fixed bin (35)) returns (bit (1));
dcl  ws_tty_mgr_$ok_iocb	       entry (ptr, ptr, ptr, fixed bin (35)) returns (bit (1));
dcl  ws_tty_mgr_$send_message	       entry (ptr, char (3), bit (9), ptr, fixed bin (21));
dcl  ws_tty_mgr_$get_message	       entry (ptr, ptr, fixed bin (21), fixed bin (21), char (3));
dcl  ws_trace_		       entry () options (variable);

/* ------------------------  BUILTINS and CONDITIONS  ---------------------- */

dcl  (addr, bit, byte, fixed, hbound, length, null, rtrim, substr)
			       builtin;

dcl  (any_other, cleanup)	       condition;

%page;
/* ------------------------  PROGRAM  -------------------------------------- */

abort:
     entry (I_iocb_ptr, I_resetsw, O_tty_state, O_code);

/* to reset read or write buffers  */

     code = 0;
     tty_state = 0;

     resetsw = I_resetsw;

     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$abort entry: iocb_ptr= ^p, resetws= ^i.", ME, I_iocb_ptr, resetsw);

     if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code)
	then goto abort_exit;

     call init_ips_mask;

     rw_switch = bit (fixed (resetsw, 2));

     if substr (rw_switch, 2, 1)
	then mowse_io_data.ws.flags.more_input = FALSE;

     call iox_$control (iocb_ptr, "abort", addr (rw_switch), code);
     if code ^= 0
	then goto abort_exit;

     call ws_tty_mgr_$send_message (iocb_ptr, WS_ABORT, WS_FLAG_NONE, null, 0);

abort_exit:
     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$abort exit: tty_state= ^i, code= ^i.^/", ME, tty_state, code);
     O_tty_state = tty_state;
     O_code = code;
     return;
%page;
attach:
     entry (I_iocb_ptr, I_name, I_event, O_tty_state, O_code);

/* notify wsterm to go to sync mode */
/* notify mowse_io_ that sync mode in effect */

/* initialize */
     code = 0;
     tty_state = 0;

/* get params */
     name = I_name;
     event = I_event;

     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$attach entry: name= ^a, event= ^i, iocb_ptr= ^p.", ME, name, event, I_iocb_ptr);

/* get iocb_ptr and check it */
     if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code)
	then goto attach_exit;

/* set up ips mask */
     call init_ips_mask;

/* see if wsterm still around */
     if ^ws_tty_mgr_$have_wsterm (iocb_ptr, tty_state, code)
	then goto attach_exit;

/* tell ws to enter sync mode */
     call ws_tty_mgr_$send_message (iocb_ptr, WS_ENTER_SYNC_MODE, WS_FLAG_NONE, null, 0);

/* get ws's response */
     string = " ";
     string_ptr = addr (string);
     get_msg_id = "   ";
     call ws_tty_mgr_$get_message (iocb_ptr, string_ptr, MAX_SEND_MSG_SIZE, string_size, get_msg_id);

     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$attach: enter sync mode reply= ^a.", ME, get_msg_id);

     if get_msg_id ^= WS_SYNC_MODE_ENTERED
	then do;
	     code = error_table_$action_not_performed;
	     goto attach_exit;
	end;

/* tell mowse too */
     video_mode_info.version = mowse_io_info_version_1;
     video_mode_info.mode = TRUE;
     video_mode_info.mbz = "0"b;
     mowse_io_set_video_mode_info_ptr = addr (video_mode_info);
     call iox_$control (iocb_ptr, "set_video_mode", mowse_io_set_video_mode_info_ptr, code);
     if code ^= 0
	then goto attach_exit;
     call iox_$modes (iocb_ptr, "force,^crecho,^lfecho", "", code);

attach_exit:
     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$attach exit: tty_state= ^i, code= ^i.^/", ME, tty_state, code);
     O_tty_state = tty_state;
     O_code = code;
     return;
%page;
detach:
     entry (I_iocb_ptr, I_dflag, O_tty_state, O_code);

/* notify wsterm to return to async mode */
/* notify mowse_io_ of return to async mode (TBD) */
/* dflag is ignored */

/* initialize */
     code = 0;
     tty_state = 0;
     num_exit_tries = 0;

/* get params */
     dflag = I_dflag;

     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$detach entry: iocb_ptr= ^p, dflag= ^i.", ME, I_iocb_ptr, dflag);

/* get iocb_ptr and check it */
     if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code)
	then goto detach_exit;

/* see if wsterm still around */
     if ^ws_tty_mgr_$have_wsterm (iocb_ptr, tty_state, code)
	then goto detach_exit;

/* flush input */
     call iox_$control (iocb_ptr, "resetread", null (), code);
     if code ^= 0
	then goto detach_exit;

/* tell ws to exit sync mode */
     call ws_tty_mgr_$send_message (iocb_ptr, WS_EXIT_SYNC_MODE, WS_FLAG_NONE, null, 0);

/* get ws's response */
     string = " ";
     string_ptr = addr (string);
     get_msg_id = "   ";

     do while ((get_msg_id ^= WS_SYNC_MODE_EXITED) & (num_exit_tries < EXIT_THRESHOLD));
	call ws_tty_mgr_$get_message (iocb_ptr, string_ptr, 256, string_size, get_msg_id);
	num_exit_tries = num_exit_tries + 1;
     end;

     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$detach: sync mode reply= ^a.", ME, get_msg_id);

     if get_msg_id ^= WS_SYNC_MODE_EXITED
	then do;
	     code = error_table_$action_not_performed;
	     goto detach_exit;
	end;

/* tell mowse too */
     video_mode_info.version = mowse_io_info_version_1;
     video_mode_info.mode = FALSE;
     video_mode_info.mbz = "0"b;
     mowse_io_set_video_mode_info_ptr = addr (video_mode_info);
     call iox_$control (iocb_ptr, "set_video_mode", mowse_io_set_video_mode_info_ptr, code);

detach_exit:
     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$detach exit: tty_state= ^i, code= ^i.^/", ME, tty_state, code);
     O_tty_state = tty_state;
     O_code = code;
     return;
%page;
event:
     entry (I_iocb_ptr, I_event, O_tty_state, O_code);

/* to change tty events signaled */

     code = 0;
     tty_state = 0;

     event = I_event;

     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$event entry: iocb_ptr= ^p, event= ^i.", ME, I_iocb_ptr, event);

     if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code)
	then goto event_exit;

event_exit:
     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$event exit: tty_state= ^i, code= ^i.^/", ME, O_tty_state, code);
     O_tty_state = tty_state;
     O_code = code;
     return;
%page;
index:
     entry (I_iocb_ptr, I_name, O_tty_state, O_code);

/* go get index from name, and sign onto tty */

     code = 0;
     tty_state = 0;

     name = I_name;

     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$index entry: name= ^a, iocb_ptr= ^p.", ME, name, I_iocb_ptr);

     if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code)
	then goto index_exit;

     if iocb_ptr -> iocb.version ^= iox_$iocb_version_sentinel
						/* only here to make visable to probe */
	then do;
	     code = error_table_$unimplemented_version;
	     goto attach_exit;
	end;

index_exit:
     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$index exit: tty_state= ^i, code= ^i.^/", ME, O_tty_state, code);
     O_tty_state = tty_state;
     O_code = code;
     return;
%page;
order:
     entry (I_iocb_ptr, I_order, I_argptr, O_tty_state, O_code);

/* to give tty orders */
/* the order may be done here, passed to WSTERM, or passed to mowse_io_ */
/*    via iox_ or any combination of these */

     code = 0;
     tty_state = 0;

     order = I_order;
     argptr = I_argptr;

     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$order entry: iocb_ptr= ^p, order= '^a', argptr= ^p.", ME, I_iocb_ptr, order, argptr);

     if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code)
	then goto order_exit;

     call init_ips_mask;

/* ------------------------  Start of control orders  ---------------------- */

     if order = "abort"				/* tty_ */
	then goto order_iox;

     else if order = "debug_on"			/* mowse_io_ */
	then do;
	     mowse_io_debug_info_ptr = argptr;
	     call iox_$control (iocb_ptr, order, mowse_io_debug_info_ptr, code);
	end;

     else if order = "debug_off"			/* mowse_io_ */
	then do;
	     mowse_io_debug_info_ptr = argptr;
	     call iox_$control (iocb_ptr, order, mowse_io_debug_info_ptr, code);
	end;

     else if order = "flush_subchannel"			/* mowse */
	then call unmask_alarms_and_pass_on_to_mowse;

     else if order = "get_editing_chars"		/* tty_ */
	then goto order_iox;

     else if order = "get_event_channel"		/* tty_ */
	then goto order_iox;

     else if order = "get_foreign_terminal_data"		/* none */
	then do;
	     foreign_terminal_data_ptr = argptr;
	     if foreign_terminal_data.version ^= FOREIGN_TERMINAL_DATA_VERSION_1
		then goto wrong_version;
	     call iox_$control (iocb_ptr, order, foreign_terminal_data_ptr, code);
	end;

     else if order = "get_input_conversion"		/* no */
	then do;
	     goto order_not_defined;
	end;

     else if order = "get_input_translation"		/* no */
	then do;
	     goto order_not_defined;
	end;

     else if order = "get_mowse_info"			/* mowse_io_ */
	then goto order_iox;

     else if order = "get_output_conversion"		/* tty */
	then goto order_iox;

     else if order = "get_output_translation"		/* no */
	then do;
	     goto order_not_defined;
	end;

     else if order = "get_special"			/* none */
	then goto order_iox;

     else if order = "get_terminal_emulator_state"	/* mowse_io_ */
	then do;
	     mowse_io_terminal_state_ptr = argptr;
	     if mowse_io_terminal_state.version ^= mowse_io_info_version_1
		then goto wrong_version;
	     call iox_$control (iocb_ptr, order, mowse_io_terminal_state_ptr, code);
	end;

     else if order = "line_length"			/* mowse */
	then goto order_iox;

     else if order = "modes"				/* WSTERM via mowse */
	then do;
	     new_modes = "force," || rtrim (modes_info.mode_string);
	     call iox_$modes (iocb_ptr, new_modes, "" /*old_modes*/, code);
	end;

     else if order = "printer_off"			/* ws_tty_ */
	then do;
	     call ws_tty_mgr_$send_message (iocb_ptr, WS_PRINTER_OFF, WS_FLAG_NONE, null, 0);
	end;

     else if order = "printer_on"			/* ws_tty_ */
	then do;
	     call ws_tty_mgr_$send_message (iocb_ptr, WS_PRINTER_ON, WS_FLAG_NONE, null, 0);
	end;

     else if order = "put_to_sleep"			/* mowse_io_ */
	then goto order_iox;

     else if order = "quit_disable"			/* mowse */
	then goto order_iox;

     else if order = "quit_enable"			/* mowse */
	then goto order_iox;

     else if order = "read_status"			/* tty_ */
	then goto order_iox;

     else if order = "resetread"			/* tty_ */
	then do;
	     mowse_io_data.ws.flags.more_input = FALSE;
	     goto order_iox;
	end;

     else if order = "resetwrite"			/* tty_ */
	then goto order_iox;

     else if order = "send_local_message"		/* mowse_io_ */
	then goto order_iox;

     else if order = "send_message"			/* mowse_io_ */
	then goto order_iox;

     else if order = "set_echo_break_table"		/* tty */
	then do;
	     echo_neg_datap = argptr;
	     if echo_neg_data.version = echo_neg_data_version_2
		then do;
		     break_table_ptr = addr (echo_neg_data.break);
		     break_table_size = ECHO_NEG_BREAK_TABLE_SIZE;
		end;
	     else if echo_neg_data.version = echo_neg_data_version_1
		then do;
		     break_table_ptr = addr (v1_echo_neg_data.break);
		     break_table_size = V1_ECHO_NEG_BREAK_TABLE_SIZE;
		end;
	     else goto wrong_version;
	     call convert_break_table (break_table_ptr, break_table_size, string, string_size);
	     string_ptr = addr (string);
	     call ws_tty_mgr_$send_message (iocb_ptr, WS_SET_BREAK_TABLE, WS_FLAG_NONE, string_ptr, string_size);
	     call iox_$control (iocb_ptr, order, argptr, code);
	end;

     else if order = "set_editing_chars"		/* tty_ */
	then goto order_iox;

     else if order = "set_input_conversion"		/* no */
	then do;
	     goto order_not_defined;
	end;

     else if order = "set_input_translation"		/* none */
	then do;
	     goto order_not_defined;
	end;

     else if order = "set_output_conversion"		/* tty */
	then do;
	     if argptr -> cv_trans_struc.version > CV_TRANS_VERSION
		then goto wrong_version;
	     call iox_$control (iocb_ptr, order, argptr, code);
	end;

     else if order = "set_output_translation"		/* none */
	then do;
	     goto order_not_defined;
	end;

     else if order = "set_special"			/* tty_ */
	then goto order_iox;

     else if order = "set_terminal_data"		/* tty_ */
	then do;					/* set ll and pl */
	     ttdp = argptr;
	     if terminal_type_data.version ^= ttd_version_3
		then goto wrong_version;
	     call iox_$control (iocb_ptr, order, argptr, code);
	end;

     else if order = "set_term_type"			/* tty_ */
	then goto order_iox;

     else if order = "start"				/* tty_  */
	then goto order_iox;

     else if order = "store_id"			/* tty_ */
	then goto order_iox;

     else if order = "store_mowse_info"			/* mowse_io_ */
	then goto order_iox;

     else if order = "terminal_info"			/* tty_ */
	then do;
	     terminal_info_ptr = argptr;
	     if terminal_info.version ^= terminal_info_version
		then goto wrong_version;
	     call iox_$control (iocb_ptr, order, terminal_info_ptr, code);
	end;

     else if order = "trace_on"			/* mowse_io_ */
	then do;
	     mowse_io_debug_info_ptr = argptr;
	     call iox_$control (iocb_ptr, order, mowse_io_debug_info_ptr, code);
	end;

     else if order = "trace_off"			/* mowse_io_ */
	then do;
	     mowse_io_debug_info_ptr = argptr;
	     call iox_$control (iocb_ptr, order, mowse_io_debug_info_ptr, code);
	end;

     else if order = "write_status"			/* tty_ */
	then goto order_iox;

/* ------------------------  End of control orders  ------------------------ */

/**** none of the above, try something else */

     else if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$order: Unknown control order, '^a'.", ME, order);

/**** send it on to iox_$control AS IS */

order_iox:
     call iox_$control (iocb_ptr, order, argptr, code);
     goto order_exit;

/**** send it on to wsterm */

order_wsterm:
     string_ptr = addr (order);
     string_size = length (order);

     call ws_tty_mgr_$send_message (iocb_ptr, WS_ORDER, WS_FLAG_NONE, string_ptr, string_size);
     goto order_exit;

/**** exits */
order_not_defined:
     code = error_table_$undefined_order_request;
     goto order_exit;

wrong_version:
     code = error_table_$unimplemented_version;
     goto order_exit;

order_not_performed:
     code = error_table_$action_not_performed;

order_exit:
     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$order exit: tty_state= ^i, code= ^i.^/", ME, tty_state, code);
     O_tty_state = tty_state;
     O_code = code;
     return;

/* ------------------------  END PROGRAM  ---------------------------------- */
%page;
/* ------------------------  INTERNAL PROCEDURES  -------------------------- */

convert_break_table:
     proc (table_ptr, table_size, output_string, string_count);

dcl  table_ptr		       ptr parm;
dcl  table_size		       fixed bin parm;
dcl  output_string		       char (*) parm;
dcl  string_count		       fixed bin (21) parm;

dcl  table		       (0:ECHO_NEG_BREAK_TABLE_SIZE) bit (1) unaligned based (table_ptr);
dcl  index		       fixed bin;
dcl  FIRST_PRINT_CHAR_INDEX	       fixed bin int static options (constant) init (32);

     output_string = "";
     string_count = 0;

     do index = FIRST_PRINT_CHAR_INDEX to table_size;	/* ignore control chars */
	if table (index)
	     then do;
		string_count = string_count + 1;
		substr (output_string, string_count, 1) = byte (index);
	     end;
     end;
     return;
     end convert_break_table;
%page;
/* ------------------------------------------------------------------------- */

init_ips_mask:
     proc ();

dcl  create_ips_mask_	       entry (ptr, fixed bin, bit (36) aligned);
dcl  IPS_ARRAY		       (1) char (32) aligned int static options (constant) init ("-all");
dcl  mask			       bit (36) aligned;

     if mowse_io_data.ws.ips_mask = ZERO_IPS_MASK		/* if mask is zero then... */
	then do;

/**** call returns mask that DISABLES (=0) interrupts listed in IPS_ARRAY ... */
	     call create_ips_mask_ (addr (IPS_ARRAY), hbound (IPS_ARRAY, 1), mask);

/**** ... save the inverse to ENABLE (=1) the listed interrupts. */
	     mowse_io_data.ws.ips_mask = ^mask;
	end;

     return;
     end init_ips_mask;
%page;
/* ------------------------------------------------------------------------- */

unmask_alarms_and_pass_on_to_mowse:
     proc ();


/**** START CRITICAL SECTION ****/
     event_code = 0;
     unmask_count = 0;
     saved_mask = ZERO_IPS_MASK;
     on cleanup call cleanup_handler;
     on any_other call any_other_handler;
     call hcs_$set_ips_mask (mowse_io_data.ws.ips_mask, saved_mask);
     do while (event_code = 0);
	call ipc_$unmask_ev_calls (event_code);
          unmask_count = unmask_count +1;
     end;

     call iox_$control (iocb_ptr, order, argptr, code);

     if saved_mask_bit.control
	then call hcs_$reset_ips_mask (saved_mask, saved_mask);
     do count = 2 to unmask_count;
	call ipc_$mask_ev_calls (0); end;
     revert any_other, cleanup;
/**** END CRITICAL SECTION ****/

     return;
     end unmask_alarms_and_pass_on_to_mowse;
%page;
/* ------------------------------------------------------------------------- */

any_other_handler:
     proc;

dcl  continue_to_signal_	       entry (fixed bin (35));

     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("  ^a$any_other_handler :saved_mask=^o.", ME, saved_mask);

     if saved_mask_bit.control
	then call hcs_$reset_ips_mask (saved_mask, saved_mask);
     do count = 2 to unmask_count;
	call ipc_$mask_ev_calls (0);
	end;

     call continue_to_signal_ ((0));

     return;
     end any_other_handler;
%page;
/* ------------------------------------------------------------------------- */

cleanup_handler:
     proc;

     if ws_tty_data$Flags.Trace
	then call ws_trace_ (" ^a$cleanup_handler :saved_mask=^o.", ME, saved_mask);

     if saved_mask_bit.control
	then call hcs_$reset_ips_mask (saved_mask, saved_mask);
     do count = 2 to unmask_count;
	call ipc_$mask_ev_calls (0);
	end;

     return;
     end cleanup_handler;
%page;
/* ------------------------  INCLUDES  ------------------------------------- */

%include ws_control_ids;
%page;
%include ws_tty_data;
%page;
%include mowse_io_control_info;
%page;
%include terminal_info;
%page;
%include terminal_type_data;
%page;
%include foreign_terminal_data;
%page;
%include mcs_echo_neg;
%page;
%include iocb;
%page;
%include mowse_io_data;
%page;
%include tty_convert;

     end ws_tty_main_;




		    ws_tty_mgr_.pl1                 01/24/89  0855.8r w 01/24/89  0849.4      158157



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1986 *
        *                                                         *
        *********************************************************** */

/****^  HISTORY COMMENTS:
  1) change(86-12-05,RBarstad), approve(86-12-11,MCR7585),
     audit(87-08-05,Gilcrease), install(87-08-07,MR12.1-1075):
     Created.
                                                   END HISTORY COMMENTS */

/* format: style3,^ifthenstmt,indthenelse,^indnoniterdo,^indprocbody,initcol3,dclind5,idind32 */
ws_tty_mgr_:
     proc ();
     return;

/* ------------------------  DESCRIPTION  ---------------------------------- */

/****^ VERSION 1.36
							
     management entries for ws_tty_
 							
*/
%page;
/* ------------------------  PARAMETERS  ----------------------------------- */

dcl  I_iocb_ptr		       parm ptr;		/* iocb ptr input */
dcl  O_iocb_ptr		       parm ptr;		/* iocb ptr output */
dcl  I_flags		       parm bit (9);	/* control msg flags */
dcl  I_msg_id		       parm char (3);
dcl  I_msg_data_ptr		       parm ptr;
dcl  I_msg_data_size	       parm fixed bin (21);
dcl  O_msg_id		       parm char (3);	/* actual id returned from WSTERM */
dcl  O_msg_data_size	       parm fixed bin (21);	/* actual data size read from WSTERM */
dcl  O_code		       fixed bin (35) parm;

/* ------------------------  AUTOMATIC  ------------------------------------ */

dcl  n_chars_actually_read	       fixed bin (21);
dcl  iocb_ptr		       ptr;		/* local copy */
dcl  flags		       bit (9);		/* local copy */
dcl  event_code		       fixed bin (35);
dcl  code			       fixed bin (35);	/* error code */
dcl  offset_msg_data_ptr             pointer;
dcl  retval		       fixed bin (35);
dcl  saved_mask		       bit (36) aligned;	/* saved ips mask */
dcl  total_chars_read                fixed bin (21);
dcl  unmask_count                    fixed bin;
dcl  count                           fixed bin;

dcl  1 saved_mask_bit	       aligned based (addr (saved_mask)),
       2 interrupts		       bit (35) unaligned,
       2 control		       bit (1) unaligned;

dcl  1 ws_send_msg		       aligned,		/* sent by "send message" control */
       2 type		       fixed bin (8) unaligned, /* foreground or background */
       2 id		       char (3) unaligned,	/* one of ws_control_ids */
       2 flags		       bit (9) unaligned,
       2 data_size		       fixed bin (8) unaligned,
       2 message_data	       char (MAX_SEND_MSG_SIZE) unaligned;
						/* longest message */

dcl  1 ws_control_msg	       aligned,		/* for iox put&get chars */
       2 id		       char (3) unaligned,	/* one of ws_control_ids */
       2 data_size_hi	       fixed bin (8) unaligned,
       2 data_size_lo	       fixed bin (8) unaligned;

dcl  ws_message_ptr		       ptr;
dcl  ws_message_length	       fixed bin (21);

dcl  1 mio_message		       like mowse_io_message;

/* ------------------------  BASED  ---------------------------------------- */

dcl  msg_data_ptr		       ptr;		/* local copy of I_msg_data_ptr */
dcl  msg_data_size		       fixed bin (21);	/* local copy of I_msg_data_size */
dcl  msg_data		       char (msg_data_size) based (msg_data_ptr);
						/* caller's string */
dcl  based_chars                     (0:total_chars_read) char (1) based unaligned;  /* to bump read ptr */

/* ------------------------  CONSTANTS  ------------------------------------ */

dcl  (
     ME			       char (11) init ("ws_tty_mgr_"),
     BYTE_SIZE		       fixed bin init (256),
     DIALED_UP		       fixed bin init (5),	/* tty_state */
     IGNORE		       fixed bin init (1),	/* tty_state */
     FALSE		       bit (1) init ("0"b),
     TRUE			       bit (1) init ("1"b),
     MAX_SEND_MSG_SIZE	       fixed bin (21) init (255),
     ZERO_IPS_MASK		       bit (36) init ((36)"0"b),
     SEND_MSG_OVERHEAD	       fixed bin init (6),	/* 8K - longest string size */
     CONTROL_MSG_OVERHEAD	       fixed bin (21) init (5)/* 8K - longest string size */
     )			       internal static options (constant);

/* ------------------------  EXTERNALS  ------------------------------------ */

dcl  (
     error_table_$no_iocb,
     error_table_$no_operation,
     error_table_$io_no_permission,
     error_table_$unable_to_do_io
     )			       fixed bin (35) external static;

/* ------------------------  ENTRIES  -------------------------------------- */

dcl  hcs_$set_ips_mask	       entry (bit (36) aligned, bit (36) aligned);
dcl  hcs_$reset_ips_mask	       entry (bit (36) aligned, bit (36) aligned);
dcl  ipc_$mask_ev_calls              entry (fixed bin(35));
dcl  ipc_$unmask_ev_calls            entry (fixed bin(35));
dcl  iox_$control		       entry (ptr, char (*), ptr, fixed bin (35));
dcl  iox_$get_chars		       entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
dcl  iox_$put_chars		       entry (ptr, ptr, fixed bin (21), fixed bin (35));
dcl  sub_err_		       entry () options (variable);
dcl  ws_trace_		       entry () options (variable);

/* ------------------------  BUILTINS and CONDITIONS  ---------------------- */

dcl  (addr, max, min, null, substr)  builtin;
dcl  (any_other, cleanup)	       condition;

%page;
/* ------------------------  PROGRAM  -------------------------------------- */

send_message:
     entry (I_iocb_ptr, I_msg_id, I_flags, I_msg_data_ptr, I_msg_data_size);

     iocb_ptr = I_iocb_ptr;
     ws_send_msg.id = I_msg_id;
     flags = I_flags;
     msg_data_ptr = I_msg_data_ptr;
     msg_data_size = I_msg_data_size;

     mowse_io_data_ptr = iocb_ptr -> iocb.attach_data_ptr;

     ws_send_msg.type = FG_CONTROL_MESSAGE;

     if msg_data_ptr = null
	then do;					/* no data */
	     msg_data_size = 0;
	     ws_send_msg.data_size = 0;
	     ws_send_msg.flags = WS_FLAG_NONE;
	     ws_send_msg.message_data = "";

	     if ws_tty_data$Flags.Trace
		then call ws_trace_ (" ^a$send_message: ID= ^a, no data.", ME, ws_send_msg.id);

	end;
	else do;
	     if ws_tty_data$Flags.Trace
		then call ws_trace_ (" ^a$send_message: ID= ^a, size= ^i, '^a'.", ME, ws_send_msg.id, msg_data_size,
			msg_data);

	     if msg_data_size > MAX_SEND_MSG_SIZE
		then call sub_err_ (code, "ws_tty_mgr_$send_message", ACTION_CANT_RESTART, sub_error_info_ptr, retval,
			"String size of ^i too large for internal buffers.", msg_data_size);

	     ws_send_msg.data_size = msg_data_size;
	     ws_send_msg.flags = flags;
	     ws_send_msg.message_data = msg_data;
	end;

     mio_message.version = mowse_io_info_version_1;
     mio_message.channel = FG;
     mio_message.io_message_ptr = addr (ws_send_msg);
     mio_message.io_message_len = msg_data_size + SEND_MSG_OVERHEAD;
     mowse_io_message_ptr = addr (mio_message);

/**** BEGIN IO SECTION ****/
     event_code = 0;
     unmask_count = 0;
     saved_mask = ZERO_IPS_MASK;
     on cleanup call cleanup_handler;
     on any_other call any_other_handler;
     call hcs_$set_ips_mask (mowse_io_data.ws.ips_mask, saved_mask);
     do while (event_code = 0);
	call ipc_$unmask_ev_calls (event_code);
	unmask_count = unmask_count +1;
     end;

     call iox_$control (iocb_ptr, "send_message", mowse_io_message_ptr, code);

     if saved_mask_bit.control
	then call hcs_$reset_ips_mask (saved_mask, saved_mask);
     do count = 2 to unmask_count;
	call ipc_$mask_ev_calls (0); end;
     revert any_other, cleanup;
/**** END IO SECTION ****/

     if code ^= 0
	then call sub_err_ (code, "ws_tty_mgr_$send_message", ACTION_CANT_RESTART, sub_error_info_ptr, retval,
		"Attempting to write to iocb ^p via iox_$put_chars.", iocb_ptr);

     return;
%page;
/* ------------------------------------------------------------------------- */

send_text:
     entry (I_iocb_ptr, I_msg_data_ptr, I_msg_data_size);

     iocb_ptr = I_iocb_ptr;
     msg_data_ptr = I_msg_data_ptr;
     msg_data_size = I_msg_data_size;

     mowse_io_data_ptr = iocb_ptr -> iocb.attach_data_ptr;

     if msg_data_ptr = null
	then do;					/* no data */
	     msg_data_size = 0;

	     if ws_tty_data$Flags.Trace
		then call ws_trace_ (" ^a$send_text: no data.", ME);

	end;
	else do;
	     if ws_tty_data$Flags.Trace
		then call ws_trace_ (" ^a$send_text: size= ^i, '^a'.", ME, msg_data_size, msg_data);
	end;

/**** BEGIN IO SECTION ****/
     event_code = 0;
     unmask_count = 0;
     saved_mask = ZERO_IPS_MASK;
     on cleanup call cleanup_handler;
     on any_other call any_other_handler;
     call hcs_$set_ips_mask (mowse_io_data.ws.ips_mask, saved_mask);
     do while (event_code = 0);
	call ipc_$unmask_ev_calls (event_code);
	unmask_count = unmask_count +1;
     end;

     call iox_$put_chars (iocb_ptr, msg_data_ptr, msg_data_size, code);

     if saved_mask_bit.control
	then call hcs_$reset_ips_mask (saved_mask, saved_mask);
     do count = 2 to unmask_count;
	call ipc_$mask_ev_calls (0); end;
     revert any_other, cleanup;
/**** END IO SECTION ****/

     if code ^= 0
	then call sub_err_ (code, "ws_tty_mgr_$send_text", ACTION_CANT_RESTART, sub_error_info_ptr, retval,
		"Attempting to write to iocb ^p via iox_$put_chars.", iocb_ptr);

     return;
%page;
/* ------------------------------------------------------------------------- */

get_message:
     entry (I_iocb_ptr, I_msg_data_ptr, I_msg_data_size, O_msg_data_size, O_msg_id);

     iocb_ptr = I_iocb_ptr;
     msg_data_size = I_msg_data_size;
     msg_data_ptr = I_msg_data_ptr;

     mowse_io_data_ptr = iocb_ptr -> iocb.attach_data_ptr;

     if ws_tty_data$Flags.Trace
	then call ws_trace_ (" ^a$get_message: iocb ptr= ^p, size= ^i, data ptr= ^p.", ME, iocb_ptr, msg_data_size,
		msg_data_ptr);

     ws_message_ptr = addr (ws_control_msg);

/* init */
     n_chars_actually_read = 0;
     ws_control_msg.id = " ";
     ws_control_msg.data_size_lo = 0;
     ws_control_msg.data_size_hi = 0;
     total_chars_read = 0;

/* read the control id and count */
     call get_ws_chars (ws_message_ptr, CONTROL_MSG_OVERHEAD, n_chars_actually_read);
     if ws_tty_data$Flags.Trace
	then call ws_trace_ (" ^a$get_message: ID received= ^a, size= ^i, hi&lo= ^i, ^i.", ME, ws_control_msg.id,
		n_chars_actually_read, ws_control_msg.data_size_hi, ws_control_msg.data_size_lo);
     ws_message_length = ws_control_msg.data_size_lo + ws_control_msg.data_size_hi * BYTE_SIZE;

/* read the actual input chars */
     if ws_message_length = 0
	then O_msg_data_size = 0;
	else do;
	     call get_ws_chars (msg_data_ptr, min (ws_message_length, msg_data_size), n_chars_actually_read);
	     if ws_tty_data$Flags.Trace
		then call ws_trace_ (" ^a$get_message: #chars received= ^i, chars= '^a'.", ME, n_chars_actually_read,
			substr (msg_data, 1, max (1, n_chars_actually_read)));

	     if ws_message_length > msg_data_size
		then do;
		if ws_tty_data$Flags.Trace then do;
		    call ws_trace_ (" ^a$get_message sub_err_: ws_message_length(^i) > msg_data_size(^i)", ME, ws_message_length, msg_data_size);
		    call ws_trace_ (" ^a$get_message sub_err_: ID=^a, hi&lo=^i&^i.", 
		         ME, ws_control_msg.id, ws_control_msg.data_size_hi, ws_control_msg.data_size_lo);
		    call ws_trace_ (" ^a$get_message sub_err_: #chars read=^i, chars='^a'.", 
		         ME, n_chars_actually_read, substr (msg_data, 1, max (1, n_chars_actually_read)));
		    end /* Trace */;
		    call sub_err_ (error_table_$no_operation, "ws_tty_mgr_$get_message", ACTION_CANT_RESTART,
			sub_error_info_ptr, retval, "Input truncated to fit caller's buffer.");
	         end;

	     total_chars_read = n_chars_actually_read;
	     do while (total_chars_read < ws_message_length); /* message got split up into packets */
		offset_msg_data_ptr = addr (msg_data_ptr -> based_chars (total_chars_read));
		call get_ws_chars (offset_msg_data_ptr, (ws_message_length-total_chars_read), n_chars_actually_read);
		total_chars_read = total_chars_read + n_chars_actually_read;
	     end;

	     O_msg_data_size = total_chars_read;
	end;

     O_msg_id = ws_control_msg.id;

     return;
%page;
/* ------------------------------------------------------------------------- */

have_wsterm:
     entry (I_iocb_ptr, O_tty_state, O_code) returns (bit (1));

/* checks to see if WSTERM is connected */
/*  if it is, returns TRUE and sets tty_state to DIALED_UP */
/*  if it is not, returns FALSE, sets tty_state to IGNORE, and sets code to error_table_$io_no_permission */

dcl  O_tty_state		       fixed bin parm;
dcl  internal_ws_state_ptr	       ptr;
dcl  1 internal_ws_state	       aligned like mowse_io_terminal_state;

     O_code = 0;

     iocb_ptr = I_iocb_ptr;

     internal_ws_state.version = mowse_io_info_version_1;
     internal_ws_state_ptr = addr (internal_ws_state);

     call iox_$control (iocb_ptr, "get_terminal_emulator_state", internal_ws_state_ptr, code);

     if ws_tty_data$Flags.Trace
	then call ws_trace_ (" ^a$have_wsterm: terminal_emulator_state = ^b, code= ^i.", ME, internal_ws_state.state,
		code);

     if code ^= 0
	then do;
	     O_tty_state = 0;
	     O_code = code;
	     return (FALSE);
	end;

     if internal_ws_state.state = FALSE
	then do;
	     O_tty_state = IGNORE;
	     O_code = error_table_$io_no_permission;
	end;
	else /* state = TRUE */
	     O_tty_state = DIALED_UP;

     return (internal_ws_state.state);
%page;
/* ------------------------------------------------------------------------- */

ok_iocb:
     entry (I_iocb_ptr, O_iocb_ptr, O_attach_data_ptr, O_code) returns (bit (1));

/* checks the iocb_ptr and returns the actual ptr and the attach_data_ptr */
/* returns TRUE if all ok */

dcl  O_attach_data_ptr	       ptr parm;

     O_iocb_ptr, O_attach_data_ptr = null;

     if I_iocb_ptr = null
	then goto no_iocb;

     O_iocb_ptr = I_iocb_ptr -> iocb.actual_iocb_ptr;

     if O_iocb_ptr = null
	then goto no_iocb;

     O_attach_data_ptr = O_iocb_ptr -> iocb.attach_data_ptr;

     if ws_tty_data$Flags.Trace
	then do;
	     call ws_trace_ (
		" ^a$ok_iocb(TRUE): I_iocb_ptr=^p, O_iocb_ptr=^p, O_attach_data_ptr=^p, iocb.name=^a, open_descrip=^a.",
		ME, I_iocb_ptr, O_iocb_ptr, O_attach_data_ptr, O_iocb_ptr -> iocb.name,
		O_attach_data_ptr -> mowse_io_data.open_descrip);
	end;

     O_code = 0;
     return (TRUE);

no_iocb:
     if ws_tty_data$Flags.Trace
	then call ws_trace_ (" ^a$ok_iocb(FALSE):I_iocb_ptr=^p, O_iocb_ptr=^p.", ME, I_iocb_ptr, O_iocb_ptr);

     O_code = error_table_$no_iocb;
     return (FALSE);

/* ------------------------  END PROGRAM  ---------------------------------- */
%page;
/* ------------------------  INTERNAL PROCEDURES  -------------------------- */

get_ws_chars:
     proc (buffer_ptr, n_chars_to_read, n_chars_returned);

dcl  buffer_ptr		       ptr parm;
dcl  n_chars_to_read	       fixed bin (21) parm;
dcl  n_chars_returned	       fixed bin (21) parm;

/**** BEGIN IO SECTION ****/
     event_code = 0;
     unmask_count = 0;
     saved_mask = ZERO_IPS_MASK;
     on cleanup call cleanup_handler;
     on any_other call any_other_handler;
     call hcs_$set_ips_mask (mowse_io_data.ws.ips_mask, saved_mask);
     do while (event_code = 0);
	call ipc_$unmask_ev_calls (event_code);
          unmask_count = unmask_count +1;
     end;

     call iox_$get_chars (iocb_ptr, buffer_ptr, n_chars_to_read, n_chars_returned, code);

     if saved_mask_bit.control
	then call hcs_$reset_ips_mask (saved_mask, saved_mask);
     do count = 2 to unmask_count;
	call ipc_$mask_ev_calls (0); end;
     revert any_other, cleanup;
/**** END IO SECTION ****/

     if code ^= 0
	then call sub_err_ (code, "ws_tty_mgr_$get_message", ACTION_CANT_RESTART, sub_error_info_ptr, retval,
		"Attempting to read from iocb ^p via iox_$get_chars.", iocb_ptr);

     return;
     end get_ws_chars;
%page;
/* ------------------------------------------------------------------------- */

cleanup_handler:
     proc;

     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("  ^a$cleanup_handler :saved_mask=^o.", ME, saved_mask);

     if saved_mask_bit.control
	then call hcs_$reset_ips_mask (saved_mask, saved_mask);
     do count = 2 to unmask_count;
	call ipc_$mask_ev_calls (0);
	end;

     return;
     end cleanup_handler;
%page;
/* ------------------------------------------------------------------------- */

any_other_handler:
     proc;

dcl  1 ci			       aligned like condition_info;
dcl  find_condition_info_	       entry (ptr, ptr, fixed bin (35));
dcl  continue_to_signal_	       entry (fixed bin (35));

     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("  ^a$any_other_handler :saved_mask=^o.", ME, saved_mask);

     if saved_mask_bit.control
	then call hcs_$reset_ips_mask (saved_mask, saved_mask);
     do count = 2 to unmask_count;
	call ipc_$mask_ev_calls (0);
	end;

     ci.version = 1;
     call find_condition_info_ (null (), addr (ci), (0));

     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("  ^a$any_other_handler: condition_name=^a.", ME, ci.condition_name);

     call continue_to_signal_ ((0));

     return;
     end any_other_handler;
%page;
/* ------------------------  INCLUDES  ------------------------------------- */

%include ws_control_ids;
%page;
%include ws_tty_data;
%page;
%include mowse_io_control_info;
%page;
%include mowse;
%page;
%include mowse_messages;
%page;
%include sub_err_flags;
%page;
%include sub_error_info;
%page;
%include condition_info_header;
%page;
%include condition_info;
%page;
%include iocb;
%page;
%include mowse_io_data;

     end ws_tty_mgr_;




		    ws_tty_read_.pl1                01/24/89  0855.8r w 01/24/89  0849.2      136899



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1986 *
        *                                                         *
        *********************************************************** */

/****^  HISTORY COMMENTS:
  1) change(86-12-05,RBarstad), approve(86-12-11,MCR7585),
     audit(87-08-05,Gilcrease), install(87-08-07,MR12.1-1075):
     Created.
                                                   END HISTORY COMMENTS */

/* format: style3,^ifthenstmt,indthenelse,^indnoniterdo,^indprocbody,initcol3,dclind5,idind32 */
ws_tty_read_:
     proc ();
     return;

/* ------------------------  DESCRIPTION  ---------------------------------- */

/****^ VERSION 1.72
							
     ws_tty_ entries to support video mode in MOWSE work station
 							
     ws_tty_$read_echoed 					
     ws_tty_$read
     ws_tty_$read_with_mark

*/
%page;
/* ------------------------  PARAMETERS  ----------------------------------- */

dcl  I_n_chars_to_read	       fixed bin (21) parm;	/* maximum number of chars to return */
dcl  I_offset		       fixed bin (21) parm;	/* offset in buffer to start at */
dcl  I_buffer		       char (*) parm;	/* caller's buffer used by read_with_mark */
dcl  I_buffer_ptr		       ptr parm;		/* pointer to caller's buffer */
dcl  I_screen_left		       fixed bin parm;	/* Space left on line, negotiate entry */
dcl  I_iocb_ptr		       ptr parm;		/* io ptr for iox */
dcl  I_never_block		       bit (1) aligned parm;
dcl  O_code		       fixed bin (35) parm;	/* error code */
dcl  O_echoed		       fixed bin (21) parm;	/* Chars echoed by interrupt side */
dcl  O_mark_index		       fixed bin (21) parm;	/* index in returned string of "mark" */
dcl  O_n_chars_read		       fixed bin (21) parm;	/* actual number of characters returned */
dcl  O_state		       fixed bin parm;	/* tty state, 1 ignored, 2 listening, 5 dialed */

/* ------------------------  AUTOMATIC  ------------------------------------ */

dcl  code			       fixed bin (35);	/* error code */
dcl  echoed		       fixed bin (21);	/* Chars echoed by interrupt side */
dcl  iocb_ptr		       ptr;		/* iocb pointer for iox */
dcl  mark_index		       fixed bin (21);	/* local copy */
dcl  get_msg_id		       char (3);		/* message id actually returned from WSTERM */
dcl  n_chars_to_read	       fixed bin (21);	/* maximum number of chars to return */
dcl  n_chars_read		       fixed bin (21);	/* actual number of characters returned */
dcl  never_block		       bit (1) aligned;
dcl  offset		       fixed bin (21);	/* offset in buffer to start at */
dcl  buffer_ptr		       ptr;		/* pointer to caller's buffer */
dcl  read_ptr		       ptr;		/* actuall ptr to read buffer */
dcl  read_data		       char (2);		/* read count */
dcl  read_data_len		       fixed bin (21);	/* size of read data */
dcl  read_data_ptr		       ptr;
dcl  screen_left		       fixed bin;		/* Space left on line, negotiate entry */
dcl  state		       fixed bin;		/* tty state, 1 ignored, 2 listening, 5 dialed */
dcl  total_chars_read	       fixed bin;
dcl  read_flags		       bit (9);

/* ------------------------  BASED  ---------------------------------------- */

dcl  based_chars		       (0:offset) char (1) based unal;
						/* to bump write ptr */

/* ------------------------  CONSTANTS  ------------------------------------ */

dcl  (
     ME			       char (12) init ("ws_tty_read_"),
     BYTE_SIZE		       fixed bin init (256),
     FALSE		       bit (1) init ("0"b),
     TRUE			       bit (1) init ("1"b)
     )			       internal static options (constant);

/* ------------------------  EXTERNALS  ------------------------------------ */

dcl  (
     error_table_$bad_arg,
     error_table_$improper_data_format
     )			       fixed bin (35) external static;

/* ------------------------  ENTRIES  -------------------------------------- */

dcl  ws_tty_mgr_$ok_iocb	       entry (ptr, ptr, ptr, fixed bin (35)) returns (bit (1));
dcl  ws_tty_mgr_$send_message	       entry (ptr, char (3), bit (9), ptr, fixed bin (21));
dcl  ws_tty_mgr_$get_message	       entry (ptr, ptr, fixed bin (21), fixed bin (21), char (3));
dcl  ws_trace_		       entry () options (variable);

/* ------------------------  BUILTINS and CONDITIONS  ---------------------- */

dcl  (addr, divide, length, max, min) builtin;

dcl  cleanup		       condition;

%page;
/* ------------------------  PROGRAM  -------------------------------------- */

read:
     entry (I_iocb_ptr, I_buffer_ptr, I_offset, I_n_chars_to_read, O_n_chars_read, O_state, O_code);

/**** get params */
     buffer_ptr = I_buffer_ptr;
     offset = I_offset;
     n_chars_to_read = I_n_chars_to_read;

/**** init */
     code = 0;
     state = 0;
     n_chars_read = 0;
     on cleanup call clean_up;

     if ws_tty_data$Flags.Trace = TRUE
	then call ws_trace_ ("^a$read entry: iocb_ptr=^p, buffer_ptr=^p, offset=^i, chars=^i.", ME, I_iocb_ptr,
		buffer_ptr, offset, n_chars_to_read);

/**** check environment */
     if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code)
	then goto read_exit;

/**** get buffer ptrs and sizes */

     if n_chars_to_read < 0
	then do;
	     code = error_table_$bad_arg;
	     goto read_exit;
	end;

     read_ptr = addr (buffer_ptr -> based_chars (offset));

     read_data = convert_read_count (n_chars_to_read);
     read_data_ptr = addr (read_data);
     read_data_len = length (read_data);

     if ws_tty_data$Flags.Trace = TRUE
	then call ws_trace_ ("^a$read: read_count=^i.", ME, mowse_io_data.ws.read_count);

/**** read it */
     if (mowse_io_data.ws.read_count = 0) | (n_chars_to_read = 0)
	then do;
	     call ws_tty_mgr_$send_message (iocb_ptr, WS_READ_WITH_NO_ECHO, WS_FLAG_NONE, read_data_ptr, read_data_len);
	     mowse_io_data.ws.read_count = mowse_io_data.ws.read_count + 1;
	end;

     call ws_tty_mgr_$get_message (iocb_ptr, read_ptr, n_chars_to_read, n_chars_read, get_msg_id);

/**** check what was read */
     if get_msg_id = WS_END_NON_ECHOED_INPUT
	then mowse_io_data.ws.read_count = mowse_io_data.ws.read_count - 1;
     else if get_msg_id ^= WS_UNECHOED_INPUT_CHARS
	then code = error_table_$improper_data_format;

read_done:
     O_n_chars_read = n_chars_read;

read_exit:
     if ws_tty_data$Flags.Trace = TRUE
	then call ws_trace_ ("^a$read exit: n_chars_read=^i, state=^i, code=^i.^/", ME, n_chars_read, state, code);

     O_state = state;
     O_code = code;
     return;
%page;
read_echoed:
     entry (I_iocb_ptr, I_buffer_ptr, I_offset, I_n_chars_to_read, O_n_chars_read, O_echoed, I_screen_left, O_state,
	O_code);

/**** get params */
     buffer_ptr = I_buffer_ptr;
     offset = I_offset;
     n_chars_to_read = I_n_chars_to_read;
     screen_left = I_screen_left;

/**** init */
     code = 0;
     state = 0;
     n_chars_read = 0;
     echoed = 0;
     get_msg_id = "   ";
     total_chars_read = 0;
     on cleanup call clean_up;

     if ws_tty_data$Flags.Trace
	then call ws_trace_ (
		"^a$read_echoed entry: iocb_ptr=^p, buffer_ptr=^p, offset=^i, chars=^i, screen=^i, O_echoed=^i.", ME,
		I_iocb_ptr, buffer_ptr, offset, n_chars_to_read, screen_left, O_echoed);

/**** check environment */

     if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code)
	then goto read_echoed_exit;

/**** get buffer ptrs and sizes */

     if n_chars_to_read = 0
	then goto read_echoed_done;

     if n_chars_to_read < 0
	then do;
	     code = error_table_$bad_arg;
	     goto read_echoed_exit;
	end;

     read_ptr = addr (buffer_ptr -> based_chars (offset));

     if ws_tty_data$Flags.Trace = TRUE
	then call ws_trace_ ("^a$read_echoed: read_count=^i.", ME, mowse_io_data.ws.read_count);
%page;
/**** read it */
     if screen_left ^= 0 /* turn echo ON, OR return any previously entered non-echoed input */
	then do;
	     n_chars_to_read = min (n_chars_to_read, screen_left);
	     read_data = convert_read_count (n_chars_to_read);
	     read_data_ptr = addr (read_data);
	     read_data_len = length (read_data);

	     if (mowse_io_data.ws.read_count > 0)	/* non-echoed input to clean up */
		then do;
		     call ws_tty_mgr_$send_message (iocb_ptr, WS_READ_WITH_NO_ECHO, WS_FLAG_NO_BLOCK, read_data_ptr,
			read_data_len);
		     mowse_io_data.ws.read_count = mowse_io_data.ws.read_count + 1;

		     do while (mowse_io_data.ws.read_count > 0);
			call ws_tty_mgr_$get_message (iocb_ptr, read_ptr, n_chars_to_read, n_chars_read, get_msg_id);

			total_chars_read = total_chars_read + n_chars_read;
			if get_msg_id = WS_END_NON_ECHOED_INPUT
			     then mowse_io_data.ws.read_count = mowse_io_data.ws.read_count - 1;

			else if (get_msg_id = WS_UNECHOED_INPUT_CHARS)
			     then do;		/* not end, prepare to read again */
				offset = offset + n_chars_read;
				n_chars_to_read = n_chars_to_read - n_chars_read;
				read_ptr = addr (buffer_ptr -> based_chars (offset));
				read_data = convert_read_count (n_chars_to_read);
			     end;

			else if (get_msg_id = " ") & (n_chars_read = 0)
						/* special case from start control order */
			     then /* ignore */;

			else code = error_table_$improper_data_format;
		     end /* do while */;
		end /* if mowse_io_data.ws.read_count > 0 */;

	     /* now finally, we can read echoed input, but only if there was no unechoed input*/
	     if total_chars_read = 0
		then call ws_tty_mgr_$send_message (iocb_ptr, WS_READ_WITH_ECHO, WS_FLAG_NONE, read_data_ptr,
			read_data_len);

	end /* screen_left ^= 0 */;

	else /* screen_left = 0, turn echo OFF */
	     do while ((get_msg_id ^= WS_END_ECHOED_INPUT) & (n_chars_to_read > 0) & (code = 0));
		call ws_tty_mgr_$get_message (iocb_ptr, read_ptr, n_chars_to_read, n_chars_read, get_msg_id);

		total_chars_read = total_chars_read + n_chars_read;
		if get_msg_id = WS_END_ECHOED_INPUT	/* the end */
		     then do;
			echoed = echoed + n_chars_read;
			mowse_io_data.ws.read_count = 0; /* just in case */
		     end;
		     else do /* not WS_END_ECHOED_INPUT, prepare to read again */;
			offset = offset + n_chars_read;
			n_chars_to_read = n_chars_to_read - n_chars_read;
			read_ptr = addr (buffer_ptr -> based_chars (offset));
			read_data = convert_read_count (n_chars_to_read);

			if get_msg_id = WS_ECHOED_INPUT_CHARS
			     then echoed = echoed + n_chars_read;

			else if (get_msg_id = " ") & (n_chars_read = 0)
			     /* special case from start control order */
			     then do;
				n_chars_to_read = 0 /* force stop and exit */;
			     end;

			else code = error_table_$improper_data_format;
		     end /* else not WS_END_ECHOED_INPUT */;
	     end /* do while */;

read_echoed_done:
     O_n_chars_read = total_chars_read;
     O_echoed = echoed;

read_echoed_exit:
     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$read_echoed exit: total_chars_read=^i, echoed=^i, state=^i, code=^i.^/", ME,
		total_chars_read, echoed, state, code);

     O_state = state;
     O_code = code;
     return;
%page;
read_with_mark:
     entry (I_iocb_ptr, I_buffer, I_never_block, O_n_chars_read, O_mark_index, O_state, O_code);

/**** get params */
     never_block = I_never_block;

/**** init */
     code = 0;
     state = 0;
     mark_index = 0;
     n_chars_read = 0;
     total_chars_read = 0;
     offset = 0;
     on cleanup call clean_up;

     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$read_with_mark entry: iocb_ptr=^p, never-block=^i.", ME, I_iocb_ptr, never_block);

/**** check environment */
     if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code)
	then goto read_with_mark_exit;

/**** get buffer ptrs and sizes */

     buffer_ptr = addr (I_buffer);
     n_chars_to_read = length (I_buffer);

     if n_chars_to_read < 0
	then do;
	     code = error_table_$bad_arg;
	     goto read_with_mark_exit;
	end;

     read_ptr = buffer_ptr;

     read_data = convert_read_count (n_chars_to_read);
     read_data_ptr = addr (read_data);
     read_data_len = length (read_data);

     if never_block
	then read_flags = WS_FLAG_NO_BLOCK;
	else read_flags = WS_FLAG_NONE;

/**** read it */
     if ws_tty_data$Flags.Trace = TRUE
	then call ws_trace_ ("^a$read_with_mark: read_count=^i.", ME, mowse_io_data.ws.read_count);

     if (mowse_io_data.ws.read_count = 0) | (n_chars_to_read = 0) | (never_block)
	then do;
	     call ws_tty_mgr_$send_message (iocb_ptr, WS_READ_WITH_NO_ECHO, read_flags, read_data_ptr, read_data_len);
	     mowse_io_data.ws.read_count = mowse_io_data.ws.read_count + 1;
	end;

unechoed_get_message:      /* come here to complete last unecho read request */
     call ws_tty_mgr_$get_message (iocb_ptr, read_ptr, n_chars_to_read, n_chars_read, get_msg_id);

/**** check what was read */
     if get_msg_id = WS_END_NON_ECHOED_INPUT
	then mowse_io_data.ws.read_count = mowse_io_data.ws.read_count - 1;
     else if get_msg_id ^= WS_UNECHOED_INPUT_CHARS
	then if (get_msg_id = " ") & (n_chars_read = 0)	/* special case from start control order */
		then /* ignore */;
		else code = error_table_$improper_data_format;

     total_chars_read = total_chars_read + n_chars_read;

     if never_block & (mowse_io_data.ws.read_count > 0)
	then do;
	     offset = offset + n_chars_read;
	     read_ptr = addr (buffer_ptr -> based_chars (offset));
	     n_chars_to_read = max (0, n_chars_to_read - n_chars_read);
	     read_data = convert_read_count (n_chars_to_read);
	     goto unechoed_get_message;
	end;

     if (total_chars_read > 0) & (code = 0)
	then if mowse_io_data.ws.flags.mark_set
		then do;
		     mark_index = 1;
		     mowse_io_data.ws.flags.mark_set = FALSE;
		end;

read_with_mark_exit:
     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$read_with_mark exit: total_chars_read=^i, mark_index=^i, state=^i, code=^i.^/", ME,
		total_chars_read, mark_index, state, code);

     O_n_chars_read = total_chars_read;
     O_mark_index = mark_index;
     O_state = state;
     O_code = code;
     return;

/* ------------------------  END PROGRAM  ---------------------------------- */
%page;
/* ------------------------  INTERNAL PROCEDURES  -------------------------- */

clean_up:
     proc;
     n_chars_read, O_n_chars_read = 0;
     state = 0;
     return;
     end clean_up;
%page;
/* ------------------------------------------------------------------------- */

convert_read_count:
     proc (count) returns (char (2));

dcl  count		       fixed bin (21) parm;
dcl  count_chars		       char (2);
dcl  1 count_bytes		       unaligned based (addr (count_chars)),
       2 hi		       fixed bin (8),
       2 lo		       fixed bin (8);

     if count < BYTE_SIZE
	then do;
	     count_bytes.hi = 0;
	     count_bytes.lo = count;
	end;
	else do;
	     count_bytes.hi = divide (count, BYTE_SIZE, 3);
	     count_bytes.lo = count - (BYTE_SIZE * count_bytes.hi);
	end;
     return (count_chars);
     end convert_read_count;
%page;
/* ------------------------  INCLUDES  ------------------------------------- */

%include ws_control_ids;
%page;
%include ws_tty_data;
%page;
%include iocb;
%page;
%include mowse_io_data;

     end ws_tty_read_;




		    ws_tty_write_.pl1               01/24/89  0855.8r w 01/24/89  0849.0       61047



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1986 *
        *                                                         *
        *********************************************************** */

/****^  HISTORY COMMENTS:
  1) change(86-12-05,RBarstad), approve(86-12-11,MCR7585),
     audit(87-06-05,Gilcrease), install(87-08-07,MR12.1-1075):
     Created.
                                                   END HISTORY COMMENTS */

/* format: style3,^ifthenstmt,indthenelse,^indnoniterdo,^indprocbody,initcol3,dclind5,idind32 */
ws_tty_write_:
     proc ();
     return;

/* ------------------------  DESCRIPTION  ---------------------------------- */

/****^ VERSION 1.10
	
     ws_tty_write_ entries to support video mode in MOWSE
 							
     ws_tty_write_$write        
     ws_tty_write_$write_whole_string
 							
*/
%page;
/* ------------------------  PARAMETERS  ----------------------------------- */

dcl  I_mark_flag		       bit (1) parm;	/* whether to set a mark on write_whole_string entry */
dcl  I_n_chars_to_write	       fixed bin (21) parm;	/* maximum number of chars to return */
dcl  I_offset		       fixed bin (21) parm;	/* offset in buffer to start at */
dcl  I_buffer_ptr		       ptr parm;		/* pointer to caller's buffer */
dcl  I_string		       char (*) parm;
dcl  I_iocb_ptr		       ptr parm;		/* tty index (actually also device index ) */
dcl  O_code		       fixed bin (35) parm;	/* error code */
dcl  O_n_chars_written	       fixed bin (21) parm;	/* actual number of characters returned */
dcl  O_state		       fixed bin parm;	/* tty state, 1 ignored, 2 listening, 5 dialed */

/* ------------------------  AUTOMATIC  ------------------------------------ */

dcl  code			       fixed bin (35);	/* error code */
dcl  iocb_ptr		       ptr;		/* iocb pointer for iox */
dcl  mark_flag		       bit (1);		/* whether to set a mark on write_whole_string entry */
dcl  n_chars_to_write	       fixed bin (21);	/* maximum number of chars to return */
dcl  n_chars_written	       fixed bin (21);	/* actual number of characters returned */
dcl  offset		       fixed bin (21);	/* offset in buffer to start at */
dcl  buffer_ptr		       ptr;		/* pointer to caller's buffer */
dcl  state		       fixed bin;		/* tty state, 1 ignored, 2 listening, 5 dialed */
dcl  write_ptr		       ptr;		/* the right ptr to the data to write */

/* ------------------------  BASED  ---------------------------------------- */

dcl  based_chars		       (0:offset) char (1) based unal;
						/* to bump write ptr */

/* ------------------------  CONSTANTS  ------------------------------------ */

dcl  (
     ME			       char (13) init ("ws_tty_write_"),
     FALSE		       bit (1) init ("0"b),
     TRUE			       bit (1) init ("1"b)
     )			       internal static options (constant);

/* ------------------------  EXTERNALS  ------------------------------------ */

dcl  (error_table_$bad_arg)	       fixed bin (35) external static;

/* ------------------------  ENTRIES  -------------------------------------- */

dcl  ws_tty_mgr_$ok_iocb	       entry (ptr, ptr, ptr, fixed bin (35)) returns (bit (1));
dcl  ws_tty_mgr_$send_text	       entry (ptr, ptr, fixed bin (21));
dcl  ws_trace_		       entry () options (variable);

/* ------------------------  BUILTINS and CONDITIONS  ---------------------- */

dcl  (addr, length)		       builtin;

/* dcl cleanup condition; */

%page;
/* ------------------------  PROGRAM  -------------------------------------- */

write:
     entry (I_iocb_ptr, I_buffer_ptr, I_offset, I_n_chars_to_write, O_n_chars_written, O_state, O_code);

/**** get parameters */
     buffer_ptr = I_buffer_ptr;
     offset = I_offset;
     n_chars_to_write = I_n_chars_to_write;

/**** init */
     code = 0;
     state = 0;
     n_chars_written = 0;

     if ws_tty_data$Flags.Trace = TRUE
	then call ws_trace_ ("^a$write entry: iocb_ptr=^p, buffer=^p, offset=^i, chars=^i.", ME, I_iocb_ptr, buffer_ptr,
		offset, n_chars_to_write);

/**** check environment */
     if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code)
	then goto write_exit;

     mowse_io_data.ws.flags.mark_set = FALSE;

/**** check size of write */
     if n_chars_to_write < 0
	then do;
	     code = error_table_$bad_arg;
	     goto write_exit;
	end;

     if n_chars_to_write = 0
	then goto write_done;

/**** find the portion of the caller's buffer to write */
     write_ptr = addr (buffer_ptr -> based_chars (offset));
     n_chars_written = n_chars_to_write;

/**** write it */
     call ws_tty_mgr_$send_text (iocb_ptr, write_ptr, n_chars_written);

write_done:
     O_n_chars_written = n_chars_written;

write_exit:
     if ws_tty_data$Flags.Trace = TRUE
	then call ws_trace_ ("^a$write exit: n_chars_written=^i, state=^i, code=^i.^/", ME, n_chars_written, state,
		code);

     O_state = state;
     O_code = code;
     return;
%page;
write_whole_string:
     entry (I_iocb_ptr, I_string, I_mark_flag, O_n_chars_written, O_state, O_code);

/**** get parameters */
     mark_flag = I_mark_flag;

/**** init */
     code = 0;
     state = 0;
     n_chars_written = 0;
     offset = 0;

     if ws_tty_data$Flags.Trace
	then call ws_trace_ ("^a$write_whole_string entry: iocb_ptr=^p, string='^a', mark=^i.", ME, I_iocb_ptr,
		I_string, mark_flag);

/**** check environment */
     if ^ws_tty_mgr_$ok_iocb (I_iocb_ptr, iocb_ptr, mowse_io_data_ptr, code)
	then goto write_whole_string_exit;

     mowse_io_data.ws.flags.mark_set = mark_flag;		/* for the benefit of read_with_mark */

/**** get pointers and string sizes */
     write_ptr = addr (I_string);
     n_chars_to_write = length (I_string);

     if n_chars_to_write = 0
	then goto write_whole_done;

/**** write it */
     call ws_tty_mgr_$send_text (iocb_ptr, write_ptr, n_chars_to_write);
     n_chars_written = n_chars_to_write;

write_whole_done:
     O_n_chars_written = n_chars_written;

write_whole_string_exit:
     if ws_tty_data$Flags.Trace = TRUE
	then call ws_trace_ ("^a$write_whole_string exit: n_chars_written=^i, state=^i, code=^i.^/", ME,
		n_chars_written, state, code);

     O_state = state;
     O_code = code;
     return;

/* ------------------------  END PROGRAM  ---------------------------------- */

/* ------------------------  INTERNAL PROCEDURES  -------------------------- */
%page;
/* ------------------------  INCLUDES  ------------------------------------- */

%include ws_control_ids;
%page;
%include ws_tty_data;
%page;
%include iocb;
%page;
%include mowse_io_data;

     end ws_tty_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
