



		    add_to_remote_cat_.pl1          08/07/87  1554.7rew 08/07/87  1455.0       32481



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

/****^  HISTORY COMMENTS:
  1) change(86-07-10,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */
/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
add_to_remote_cat_:
     proc (p_mcb_ptr, p_major_capability_number, p_major_capability_name,
	p_code);

/* : PROGRAM FUNCTION

Used to update the remote CAT entry, this is an internal MOWSE function call.
*/

/* : NOTES

Returns no errors because all erros are internal to mowse and recovery from
such errors is impossible (no reply given to sender).
*/


/* INPUT PARAMETERS */
dcl p_mcb_ptr	       ptr;		    /* MOWSE's mcb */
dcl p_major_capability_number
		       fixed bin parameter;	    /* Number of the new remot capability */
dcl p_major_capability_name
		       char (*) parameter;	    /* Name of new remote capability */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);


/* MISC VARIABLES */
dcl code		       fixed bin (35);
dcl major_num	       fixed bin;		    /* Packed major capability number */
dcl mowse_info_ptr	       ptr;		    /* pointer to mowse info structure */

/* SYSTEM CALL SUPPORT */
dcl ws_error_$invalid_capability_number
		       fixed bin (35) ext static;

/* EXTERNAL CALLS */
dcl capability_$pack       entry (fixed bin, fixed bin, fixed bin,
		       fixed bin (35));
dcl get_mowse_info_ptr_    entry (ptr, ptr, fixed bin (35));

/* BUILTINS */

/**/
/* INITIALIZATION */

	code = 0;
	major_num = 0;

	call get_mowse_info_ptr_ (p_mcb_ptr, mowse_info_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* MAIN */

/* : Check the major_capability_nubmer */

	if p_major_capability_number < MINIMUM_CAT_ENTRY |
	     p_major_capability_number > MAXIMUM_CAT_ENTRY then do;
	     p_code = ws_error_$invalid_capability_number;
	     return;
	end;

/* : Is it already used, return ws_error_$invalid_capability_number */

	if (mowse_info_ptr
	     -> mowse_info.remote_cat (p_major_capability_number)
	     .major_capability ^= 0) then do;

	     p_code = ws_error_$invalid_capability_number;
	     return;
	end;

/* : initialize the remote cat entry */

	call capability_$pack (REMOTE_SYSTEM, p_major_capability_number,
	     major_num, code);
	mowse_info_ptr
	     -> mowse_info.remote_cat (p_major_capability_number)
	     .major_capability = major_num;
	mowse_info_ptr
	     -> mowse_info.remote_cat (p_major_capability_number)
	     .capability_name = p_major_capability_name;
	mowse_info_ptr
	     -> mowse_info.remote_cat (p_major_capability_number).flags
	     .reset = "0"b;
	mowse_info_ptr
	     -> mowse_info.remote_cat (p_major_capability_number).flags
	     .suspended = "0"b;
	mowse_info_ptr
	     -> mowse_info.remote_cat (p_major_capability_number)
	     .flags.sleep_time = "0"b;

	p_code = 0;

%page;
/* INCLUDE FILES */

%include mowse;
%include mowse_info;

/* : END */
     end;




		    append_inbuff_.pl1              08/07/87  1554.7rew 08/07/87  1455.0       28044



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

/****^  HISTORY COMMENTS:
  1) change(86-08-27,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */
/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
append_inbuff_:
     proc (p_mcb_ptr, p_data, p_data_length, p_code);

/* PROGRAM FUNCTION

Append p_data to the application program's input buffer and update mcb input
buffer fields.
*/

/* : NOTES
*/


/* INPUT PARAMETERS */
dcl p_mcb_ptr	       ptr parameter;	    /* mcb contains inbuff info */
dcl p_data	       ptr parameter;	    /* data to append */
dcl p_data_length	       fixed bin (17) parameter;  /* length of data */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);	    /* Error code */


/* SYSTEM CALL SUPPORT */
dcl ws_error_$input_buffer_overflow
		       fixed bin (35) ext static;


/* MISC VARIABLES */
dcl input_data	       char (p_data_length) based (p_data);
dcl p		       ptr;		    /* pointer to application's buffer */
dcl input_buffer	       char (p_mcb_ptr -> mcb.inbuff_length) based (p);
dcl effective_data_length  fixed bin;
dcl buffer_space_left      fixed bin;

/* BUILTINS */
dcl substr	       builtin;

/**/

/* INITIALIZATION */
	p_code = 0;
	effective_data_length = p_data_length;

/* MAIN */

/* : determine amount of space left in the input buffer */

	buffer_space_left = p_mcb_ptr -> mcb.inbuff_length -
	     p_mcb_ptr -> inbuff_position_index;

/* : if amount of space left is less than amount of p_data to append set
     amount to copy to the amount of buffer space left  set p_code to indicate
     input buffer overflow took place  */

	if buffer_space_left < p_data_length then do;
	     effective_data_length = buffer_space_left;
	     p_code = ws_error_$input_buffer_overflow;
	end;

/* : - if there is space in buffer to copy p_data then copy p_data into the
       input buffer update the position index in the mcb for next time */

	if buffer_space_left > 0 then do;
	     p = p_mcb_ptr -> mcb.inbuff;
	     substr (input_buffer,
		p_mcb_ptr -> mcb.inbuff_position_index + 1,
		effective_data_length) =
		substr (input_data, 1, effective_data_length);

	     p_mcb_ptr -> mcb.inbuff_position_index =
		p_mcb_ptr -> mcb.inbuff_position_index
		+ effective_data_length;
	end;

%page;

/* INCLUDE FILES */

%include "mowse";
%include "mowse_mcb";

/* : END */
     end append_inbuff_;




		    atm.pl1                         08/07/87  1553.9rew 08/07/87  1450.0      108000



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

/****^  HISTORY COMMENTS:
  1) change(86-08-14,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-08-28,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Extracted get_at_ to separate module.
  3) change(86-10-07,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Added syn_mowse_i/o to allow easy location of the switch attached to
     mowse_io_ module.
  4) change(86-10-08,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Renamed attachments.
  5) change(86-10-09,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Masked around critical switch movements.
  6) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
  7) change(87-01-19,Flegel), approve(87-01-19,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Added check for WSTERM terminal type before attaching MOWSE.
  8) change(87-02-25,Flegel), approve(87-02-25,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Corrected terminal type setting test, installed the
     clean_up_init_mowse_info routine, and added the force request to the
     command.
  9) change(87-03-24,Flegel), approve(87-03-24,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Changed call to iox_$open_file in order to pass escape and EOP character
     information to mowse_io_.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
atm:
attach_mowse:
     proc ();

/* : PROGRAM FUNCTION

Attach the MOWSE environment to the user's process.
*/

/* : NOTES

The MOWSE environment is to be used only by the user when (s)he has logged
into Multics through the MOWSE environment on a Personal Computer.  Failure to
do so will result in a "hung" terminal.

MOWSE will be attached before tty_.  If tty_ does not exist, then attachment
will fail.

Below is a before/after look of the io switch attachments:

  --|
  --+--...--<foo_i/o>-- tty_
  --|

  --|
  --+--...--<foo_i/o>-- syn_ --<mowse_i/o>-- mowse_io_ --<mowse_tty>-- tty_
  --|
*/


/* MISC VARIABLES */
dcl open_descrip	       char (32);		    /* Open description arguments */
dcl err_string	       char (512) var;
dcl iocb_ptr	       ptr;
dcl switch_name	       char (32);		    /* Switch name to attach to */
dcl arg_count	       fixed bin;		    /* Number of arguments */
dcl arg_list_ptr	       ptr;		    /* Pointer to argument list */
dcl mowse_iocb_ptr	       ptr;		    /* Pointer to Mowse control block */
dcl syn_iocb_ptr	       ptr;		    /* Pointer to Syn Mowse control block */
dcl code		       fixed bin (35);	    /* Error code */
dcl old_mask	       bit (36) aligned;	    /* IPS mask */
dcl new_mask	       bit (36) aligned;	    /* IPS mask */

/* STRUCTURES */
dcl 01 term_info	       like terminal_info aligned automatic;
dcl 01 info	       like mowse_io_info automatic;

/* SYSTEM CALLS */
dcl iox_$open_file	       entry (ptr, fixed bin, char (*), bit (1) aligned, fixed bin (35));
dcl ioa_$ioa_switch	       entry () options (variable);
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 ioa_$rsnnl	       entry () options (variable);
dcl iox_$detach_iocb       entry (ptr, fixed bin (35));
dcl iox_$destroy_iocb      entry (ptr, fixed bin (35));
dcl iox_$look_iocb	       entry (char (*), ptr, fixed bin (35));
dcl cu_$arg_count	       entry (fixed bin, fixed bin (35));
dcl cu_$arg_list_ptr       entry (ptr);
dcl iox_$control	       entry (ptr, char (*), ptr, fixed bin (35));
dcl com_err_	       entry () options (variable);
dcl iox_$move_attach       entry (ptr, ptr, fixed bin (35));
dcl iox_$find_iocb	       entry (char (*), ptr, fixed bin (35));
dcl iox_$attach_ptr	       entry (ptr, char (*), ptr, fixed bin (35));


/* SYSTEM CALL SUPPORT */
dcl iox_$error_output      ptr ext static;
dcl ws_error_$unsupported_ws_terminal
		       fixed bin (35) ext static;
dcl iox_$user_io	       ptr ext static;	    /* User_i/o IOCB */


/* EXTERNAL CALLS */
dcl get_at_	       entry (char (*), char (*), ptr, fixed bin (35));
dcl init_mowse_	       entry (ptr, ptr, fixed bin (35));
dcl startup_parser_	       entry (ptr, fixed bin, ptr, char (*) var,
		       fixed bin (35));


/* EXTERNAL CALL SUPPORT */


/* BUILTINS */
dcl addr		       builtin;
dcl length	       builtin;
dcl null		       builtin;
dcl index		       builtin;

/* CONDITIONS */


/* CONSTANTS */
dcl MY_NAME	       char (12) int static options (constant)
		       init ("attach_mowse");


/**/
/* INITIALIZATION */
	open_struc_ptr = addr (open_descrip);
	init_mowse_info_ptr = null;
	new_mask = ""b;

/* MAIN */

/* : MOWSE already attached? */

	call iox_$look_iocb ("mowse_i/o", iocb_ptr, code);
	if iocb_ptr ^= null then do;
	     call ioa_$ioa_switch (iox_$error_output,
		"^a: MOWSE has already been invoked.", MY_NAME);
	     return;
	end;

/* : Parse the arglist */

	call cu_$arg_list_ptr (arg_list_ptr);
	call cu_$arg_count (arg_count, code);
	if code ^= 0 then do;
	     call com_err_ (code, MY_NAME, "Getting arg count.");
	     return;
	end;

/* : Call arg_list parser routine */

	call startup_parser_ (arg_list_ptr, arg_count, init_mowse_info_ptr,
	     err_string, code);
	if code ^= 0 then do;
	     call com_err_ (code, MY_NAME, err_string);
	     call clean_up_init_mowse_info (init_mowse_info_ptr);
	     return;
	end;

/* : See if we are on an acceptable terminal type */

	if ^init_mowse_info.flags.force_sw then do;
	     term_info.version = 1;
	     call iox_$control (iox_$user_io, "terminal_info",
		addr (term_info), code);
	     if code ^= 0 then do;
		call com_err_ (code, MY_NAME, "Getting terminal type.");
		call clean_up_init_mowse_info (init_mowse_info_ptr);
		return;
	     end;

	     if index (term_info.term_type, "MOWSE") = 0 then do;
		call com_err_ (ws_error_$unsupported_ws_terminal,
		     MY_NAME, "Use MOWSE.");
		call clean_up_init_mowse_info (init_mowse_info_ptr);
		return;
	     end;
	end;

/* : Find the iocb of the switch (if specified) under which to attach,
     otherwise next to tty_ */

	if ^init_mowse_info.flags.io_switch_sw then do;
	     call get_at_ ("tty_", "", iocb_ptr, code);
	     if code ^= 0 then do;
		call com_err_ (code, MY_NAME, "Finding tty_.");
		call clean_up_init_mowse_info (init_mowse_info_ptr);
		return;
	     end;
	end;
	else do;
	     switch_name = init_mowse_info.io_switch;
	     call iox_$look_iocb (switch_name, iocb_ptr, code);
	     if code ^= 0 then do;
		call com_err_ (code, MY_NAME, "Finding ^a",
		     switch_name);
		call clean_up_init_mowse_info (init_mowse_info_ptr);
		return;
	     end;
	end;

/* : Create mowse_tty control block */

	call iox_$find_iocb ("mowse_tty", mowse_iocb_ptr, code);
	if code ^= 0 then do;
	     call com_err_ (code, MY_NAME, "Finding mowse_tty.");
	     call clean_up_init_mowse_info (init_mowse_info_ptr);
	     return;
	end;

/* : Create mowse_i/o control block */

	call iox_$find_iocb ("mowse_i/o", syn_iocb_ptr, code);
	if code ^= 0 then do;
	     call iox_$destroy_iocb (mowse_iocb_ptr, (0));
	     call com_err_ (code, MY_NAME, "Finding mowse_i/o.");
	     call clean_up_init_mowse_info (init_mowse_info_ptr);
	     return;
	end;

/* : Move mowse_i/o onto the iocb above tty_ */

	new_mask = ""b;
	call hcs_$set_ips_mask (new_mask, old_mask);
	call iox_$move_attach (iocb_ptr, syn_iocb_ptr, code);
	if code ^= 0 then do;
	     call hcs_$reset_ips_mask (old_mask, new_mask);
	     call ioa_$rsnnl ("Moving ^a attachment to mowse_i/o.",
		err_string, length (err_string), iocb_ptr -> iocb.name);
	     goto DESTROY_IOCB_SYN;
	end;

/* : Attach the syn_ */

	call iox_$attach_ptr (iocb_ptr, "syn_ mowse_i/o", null, code);
	if code ^= 0 then do;
	     call hcs_$reset_ips_mask (old_mask, new_mask);
	     call ioa_$rsnnl ("Attaching ^a to mowse_i/o.", err_string,
		length (err_string), iocb_ptr -> iocb.name);
	     goto UNMOVE_ATTACH_SYN;
	end;
	call hcs_$reset_ips_mask (old_mask, new_mask);

/* : Move mowse_i/o to mowse_io_ */

	new_mask = ""b;
	call hcs_$set_ips_mask (new_mask, old_mask);
	call iox_$move_attach (syn_iocb_ptr, mowse_iocb_ptr, code);
	if code ^= 0 then do;
	     call hcs_$reset_ips_mask (old_mask, new_mask);
	     call ioa_$rsnnl ("Moving ^a attachment to mowse_i/o.",
		err_string, length (err_string), syn_iocb_ptr -> iocb.name)
		;
	     goto DESTROY_IOCB;
	end;

/* : Attach mowse_io_ to tty_ */

	call iox_$attach_ptr (syn_iocb_ptr, "mowse_io_ mowse_tty", null,
	     code);
	if code ^= 0 then do;
	     call hcs_$reset_ips_mask (old_mask, new_mask);
	     call ioa_$rsnnl ("Attaching ^a to mowse_tty.", err_string,
		length (err_string), syn_iocb_ptr -> iocb.name);
	     goto UNMOVE_ATTACH;
	end;
	call hcs_$reset_ips_mask (old_mask, new_mask);

/* : Open mowse_io_ */

	open_struc.flags.network_sw = "0"b;
	open_struc.flags.escape_sw = "0"b;
	if init_mowse_info.flags.escape_sw then do;
	     open_struc.flags.escape_sw = "1"b;
	     open_struc.escape.switches = init_mowse_info.escape.chars;
	end;
	if init_mowse_info.flags.network_sw then
	     open_struc.flags.network_sw = "1"b;

	call iox_$open_file (syn_iocb_ptr, Stream_input_output,
	     open_descrip, "0"b, code);
	if code ^= 0 then do;
	     err_string = "Opening mowse_tty.";
	     goto UNATTACH;
	end;

/* : Initialization of mowse */

	info.version = mowse_io_info_version_1;
	call iox_$control (syn_iocb_ptr, "get_mowse_info", addr (info),
	     code);
	if code ^= 0 then do;
	     call com_err_ (code, MY_NAME, "Getting mowse mcb.");
	     call clean_up_init_mowse_info (init_mowse_info_ptr);
	     return;
	end;

/* : Set up the mowse_info_ structure */

	call init_mowse_ (info.mcb_ptr, init_mowse_info_ptr, code);
	if code ^= 0 then do;
	     call com_err_ (code, MY_NAME, "Initializing mowse.");
	     call clean_up_init_mowse_info (init_mowse_info_ptr);
	     return;
	end;

	return;

/**/

/* : Label entries to transfer control to when a failure occurs during the
     attachment / movement of the iocbs */

UNATTACH:
	call iox_$detach_iocb (syn_iocb_ptr, (0));

UNMOVE_ATTACH:
	call iox_$move_attach (mowse_iocb_ptr, syn_iocb_ptr, (0));

DESTROY_IOCB:
	call iox_$destroy_iocb (mowse_iocb_ptr, (0));

UNMOVE_ATTACH_SYN:
	call iox_$detach_iocb (iocb_ptr, (0));
	call iox_$move_attach (syn_iocb_ptr, iocb_ptr, (0));

DESTROY_IOCB_SYN:
	call iox_$destroy_iocb (syn_iocb_ptr, (0));

	call com_err_ (code, MY_NAME, err_string);
	call clean_up_init_mowse_info (init_mowse_info_ptr);

	return;

/**/

/* INTERNAL PROCEDURES */

/* : *** Procedure clean_up_init_mowse_ptr: internal procedure for atm *** */

clean_up_init_mowse_info:
     proc (p_info_ptr);

/* : PROCEDURE FUNCTION

Free the init_mowse_info structure if the pointer is not null.
*/

/* INPUT PARAMETERS */
dcl p_info_ptr	       ptr parameter;

/* INITIALIZATION */

	if p_info_ptr ^= null then
	     free p_info_ptr -> init_mowse_info;
	p_info_ptr = null;

     end clean_up_init_mowse_info;

/**/

%page;
/* INCLUDE FILES */
%include iox_modes;
%include terminal_info;
%include mowse_info;
%include iocbv;
%include mowse_io_control_info;

/* : END */
     end;




		    capability_.pl1                 08/07/87  1554.7rew 08/07/87  1455.0       35406



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

/****^  HISTORY COMMENTS:
  1) change(86-05-15,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-07-12,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Minor revisions.
  3) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */
/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
capability_:
     proc ();

/* : PROGRAM FUNCTION

Contains two entry points:

	pack:   Converts a MOWSE system id and a capability number
                  into a single fixed bin value (major_capability).
          unpack: Convert a major_capability back into the system id
	        and the capability number.
*/

/* : NOTES
*/

/* INPUT PARAMETERS */
dcl p_system_id	       fixed bin parameter;	    /* MOWSE sytem id */
dcl p_major_capability     fixed bin parameter;	    /* Major capability id */
dcl p_major_number	       fixed bin parameter;	    /* CAT index of capability */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);


/* MISC VARIABLES */
dcl fixed8	       fixed bin (8) based;	    /* Dummy for convert */
dcl fixed17	       fixed bin (17) based;	    /* Dummey for convert */
dcl major_ptr	       ptr;		    /* Pointer to p_major_capability */
dcl major		       fixed bin (35);	    /* Temporary major_capability (packed) */


/* SYSTEM CALL SUPPORT */
dcl ws_error_$invalid_system_id
		       fixed bin (35) ext static;
dcl ws_error_$invalid_capability_number
		       fixed bin (35) ext static;

/* STRUCTURES */
dcl 01 major_overlay       unaligned based (major_ptr),
       02 pad	       bit (18),
       02 system	       fixed bin (8),
       02 index	       fixed bin (8);

/* BUILTINS */
dcl addr		       builtin;
dcl convert	       builtin;

/* MAIN */
	return;

/**/

/* : Pack: */
pack:
     entry (p_system_id, p_major_number, p_major_capability, p_code);

	p_code = 0;
	major = 0;
	major_ptr = addr (major);

/* : If major_capability_number is invalid */

	if (p_major_number < INTERNAL)
	     | (p_major_number > MAXIMUM_CAT_ENTRY) then do;

	     p_code = ws_error_$invalid_capability_number;
	     return;
	end;

/* : If p_system_id is invalid */

	if (p_system_id ^= REMOTE_SYSTEM) & (p_system_id ^= LOCAL_SYSTEM)
	then do;
	     p_code = ws_error_$invalid_system_id;
	     return;
	end;

/* : pack the system id and major number */

	major_overlay.system = convert (fixed8, p_system_id);
	major_overlay.index = convert (fixed8, p_major_number);
	p_major_capability = convert (fixed17, major);
	return;

/**/

/* : Unpack: */
unpack:
     entry (p_system_id, p_major_number, p_major_capability, p_code);

	p_code = 0;
	major = p_major_capability;
	major_ptr = addr (major);

/* : Check that the unpacked fields are correct */

	if (major_overlay.system ^= LOCAL_SYSTEM
	     & major_overlay.system ^= REMOTE_SYSTEM)
	     | (major_overlay.index < INTERNAL
	     | major_overlay.index > MAXIMUM_CAT_ENTRY) then

	     p_code = ws_error_$invalid_capability_number;

	else do;
	     p_major_number = major_overlay.index;
	     p_system_id = major_overlay.system;
	end;
	return;

%page;
/* INCLUDE FILES */
%include "mowse";
%include "mowse_info";

/* : END */
     end capability_;




		    delete_from_remote_cat_.pl1     08/07/87  1554.1rew 08/07/87  1450.4       38124



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

/****^  HISTORY COMMENTS:
  1) change(86-08-28,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-10-22,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Removed name of capability as an input parameter since it is not sent
     with a delete_from_remote_cat_message.
  3) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
  4) change(86-12-10,Flegel), approve(86-12-10,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Replaced signalling of mowse_fatal_error with a call to fatal_mowse_trap_.
                                                   END HISTORY COMMENTS */
/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
delete_from_remote_cat_:
     proc (p_mcb_ptr, p_major_capability_number, p_code);

/* : PROCEDURE FUNCTION

Handles DELETE_FROM_REMOTE_CAT messages sent to MOWSE from a remote system.
Since this is an internal function and no replys to such messages are given
any errors detected are fatal to  MOWSE.
*/

/* : NOTES
*/


/* INPUT PARAMETERS */
dcl p_mcb_ptr	       ptr;
dcl p_major_capability_number
		       fixed bin parameter;	    /* major capability number (system|cap_num) */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);	    /* return code */


/* MISC VARIABLES */
dcl mowse_info_ptr	       ptr;		    /* Pointer to mowse info structure */
dcl cap_numb	       fixed bin;		    /* major capability index (usable as index into CAT tables ) */
dcl sysid		       fixed bin;		    /* MOWSE system id */


/* STRUCTURES */


/* SYSTEM CALLS */
dcl capability_$unpack     entry (fixed bin, fixed bin, fixed bin,
		       fixed bin (35));


/* SYSTEM CALL SUPPORT */
dcl ws_error_$invalid_capability_number
		       fixed bin (35) ext static;

/* EXTERNAL CALLS */
dcl get_mowse_info_ptr_    entry (ptr, ptr, fixed bin (35));
dcl fatal_mowse_trap_      entry (fixed bin (35));

/* CONDITIONS */

/* BUILTINS */

/* CONSTANTS */
dcl FALSE		       bit (1) int static options (constant) init ("0"b);

/**/
/* INITIALIZATION */

	call get_mowse_info_ptr_ (p_mcb_ptr, mowse_info_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* MAIN */

/* : Check the major_capability_number */

	if p_major_capability_number < MINIMUM_CAT_ENTRY |
	     p_major_capability_number > MAXIMUM_CAT_ENTRY
	then do;
	     call fatal_mowse_trap_ (ws_error_$invalid_capability_number);
	     return;
	end;

/* : Find the remote cat table entry associated with input parameters
     If it is not found then return ws_error_$invalid_capability_number */

	call capability_$unpack (sysid, cap_numb,
	     (mowse_info_ptr
	     -> mowse_info.remote_cat (p_major_capability_number)
	     .major_capability), p_code);
	if p_code ^= 0 | cap_numb ^= p_major_capability_number then do;
	     call fatal_mowse_trap_ (ws_error_$invalid_capability_number);
	     return;
	end;

/* : re - initialize the remote cat entry */

	mowse_info_ptr
	     -> mowse_info.remote_cat (p_major_capability_number)
	     .major_capability = 0;
	mowse_info_ptr
	     -> mowse_info.remote_cat (p_major_capability_number)
	     .capability_name = "";
	mowse_info_ptr
	     -> mowse_info.remote_cat (p_major_capability_number).flags
	     .reset = "0"b;
	mowse_info_ptr
	     -> mowse_info.remote_cat (p_major_capability_number).flags
	     .suspended = "0"b;
	mowse_info_ptr
	     -> mowse_info.remote_cat (p_major_capability_number)
	     .sleep_time = FALSE;

	p_code = 0;
	return;

%page;
/* INCLUDE FILES */
%include mowse;
%include mowse_info;

/* : END */
     end;




		    dtm.pl1                         08/07/87  1554.6rew 08/07/87  1455.0       64539



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

/****^  HISTORY COMMENTS:
  1) change(86-08-14,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-08-28,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Looks for the switch attached to mowse_io_ rather than always to
     user_i/o.
  3) change(86-10-07,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Removes the syn_ attached above mowse_io_. Change to find support new
     names for io switches, added call to flush both subchannels being
     transmitted.
  4) change(86-10-09,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Masked around critical switch movements.
  5) change(86-10-10,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Look for user_terminal_ as we cannot detach with the video system
     invoked.
  6) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
  7) change(86-12-03,Flegel), approve(86-12-03,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Removed flushing of background subchannel.
  8) change(86-12-11,Flegel), approve(86-12-11,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Removed external static "interactive_initiated_disconnect" and replaced
     with a call iox_$close_file to mowse_i/o to tell mowse_io_ what kind of
     disconnect to perform with the PC.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
dtm:
detach_mowse:
     proc ();

/* : PROGRAM FUNCTION

Detach the MOWSE environment.
*/

/* : NOTES
*/

/* MISC VARIABLES */
dcl new_mask	       bit (36) aligned;	    /* IPS mask */
dcl old_mask	       bit (36) aligned;	    /* IPS mask */
dcl syn_iocb_ptr	       ptr;		    /* The iocb attached to the syn_ for mowse_i/o */
dcl iocb_ptr	       ptr;		    /* The iocb attached before mowse_io_ */
dcl mowse_iocb_ptr	       ptr;
dcl code		       fixed bin (35);

/* STRUCTURES */
dcl 01 fsc	       like mowse_io_flush_subchannel_info automatic;

/* EXTERNAL STATIC */

/* SYSTEM CALLS */
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 iox_$control	       entry (ptr, char (*), ptr, fixed bin (35));
dcl terminate_process_     entry (char (*), ptr);
dcl iox_$destroy_iocb      entry (ptr, fixed bin (35));
dcl iox_$look_iocb	       entry (char (*), ptr, fixed bin (35));
dcl com_err_	       entry () options (variable);
dcl iox_$move_attach       entry (ptr, ptr, fixed bin (35));
dcl iox_$detach_iocb       entry (ptr, fixed bin (35));
dcl iox_$close	       entry (ptr, fixed bin (35));
dcl iox_$close_file	       entry (ptr, char (*), fixed bin (35));


/* SYSTEM CALL SUPPORT */
dcl ws_error_$ws_video_invoked
		       fixed bin (35) ext static;
dcl error_table_$unable_to_do_io
		       fixed bin (35) ext static;


/* EXTERNAL CALLS */
dcl get_at_	       entry (char (*), char (*), ptr, fixed bin (35));


/* EXTERNAL CALL SUPPORT */


/* BUILTINS */
dcl addr		       builtin;


/* CONDITIONS */


/* CONSTANTS */
dcl dtm_name	       char (12) int static options (constant)
		       init ("detach_mowse");

/**/
/* INITIALIZATION */


/* MAIN */

/* : If mowse_i/o not found, return */

	call iox_$look_iocb ("mowse_tty", mowse_iocb_ptr, code);
	if code ^= 0 then do;
	     call com_err_ (code, dtm_name, "While looking for mowse_tty.");
	     return;
	end;

/* : Find the mowse_i/o switch */

	call iox_$look_iocb ("mowse_i/o", syn_iocb_ptr, code);
	if code ^= 0 then do;
	     call com_err_ (code, dtm_name, "While looking for mowse_i/o.");
	     return;
	end;

/* : Look for the user_terminal_ IOCB so that if it exists, the detachment
     will fail */

	call iox_$look_iocb ("user_terminal_", iocb_ptr, code);
	if code = 0 then do;
	     call com_err_ (ws_error_$ws_video_invoked, dtm_name,
		"MOWSE not detached.");
	     return;
	end;

/* : Flush both FG and BG subchannels */

	fsc.version = mowse_io_info_version_1;
	fsc.subchannel = FG;
	call iox_$control (syn_iocb_ptr, "flush_subchannel", addr (fsc),
	     (0));

/* : Find the switch attached to mowse_io_ */

	call get_at_ ("syn_", "mowse_i/o", iocb_ptr, code);
	if code ^= 0 then do;
	     call com_err_ (code, dtm_name,
		"Finding iocb attached to mowse_io_.");
	     return;
	end;

/* : Close MOWSE */

	call iox_$close_file (iocb_ptr, "confirmed_disconnect", code);

	if code ^= 0 then do;
	     call com_err_ (code, dtm_name,
		"While closing ^a.", iocb_ptr -> iocb.name);
	     return;
	end;

/* : Detach MOWSE */

	new_mask = ""b;
	call hcs_$set_ips_mask (new_mask, old_mask);
	call iox_$detach_iocb (iocb_ptr, code);
	if code ^= 0 then do;
	     call hcs_$reset_ips_mask (old_mask, new_mask);
	     call fatal_return ();
	end;

/* : Attach the iocb above mowse_i/o to tty_ */

	call iox_$move_attach (mowse_iocb_ptr, iocb_ptr, code);
	if code ^= 0 then do;
	     call hcs_$reset_ips_mask (old_mask, new_mask);
	     call fatal_return ();
	end;
	call hcs_$reset_ips_mask (old_mask, new_mask);

/* : Destroy the iocb to mowse_tty (it is in limbo as the switches have been
     moved around from foo_i/o to tty_) */

	call iox_$destroy_iocb (mowse_iocb_ptr, code);
	if code ^= 0 then do;
	     call com_err_ (code, dtm_name, "Destroying ^a.",
		mowse_iocb_ptr -> iocb.name);
	     return;
	end;

/* : Close the mowse_i/o (It better be there or all of MOWSE would not have
     been working properly) */

	call iox_$close (syn_iocb_ptr, (0));
	call iox_$detach_iocb (syn_iocb_ptr, (0));
	call iox_$destroy_iocb (syn_iocb_ptr, (0));

/**/
/* INTERNAL PROCEDURES */

/* : *** fatal_return: Internal procedure for detach_mowse *** */

fatal_return:
     proc ();

/* : PROCEDURE FUNCTION

Invoke a call to terminate_process because something really bad has happened.
*/

/* STRUCTURES */
dcl 01 fatal_error_info    aligned,
       02 version	       fixed bin,		    /* Must be 0 */
       02 status_code      fixed bin (35);	    /* Error code to terminate_process_ */


	fatal_error_info.version = 0;
	fatal_error_info.status_code = error_table_$unable_to_do_io;
	call terminate_process_ ("fatal_error", addr (fatal_error_info));

     end fatal_return;

%page;
/* INCLUDE FILES */
%include iocbv;
%include mowse_messages;
%include mowse_io_control_info;
%include mowse;

/* : END */
     end;




		    execom_.pl1                     08/07/87  1554.6rew 08/07/87  1454.9       36396



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

/****^  HISTORY COMMENTS:
  1) change(86-08-28,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
  3) change(86-12-10,Flegel), approve(86-12-10,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Replaced signalling of mowse_fatal_error with a call to fatal_mowse_trap_.
                                                   END HISTORY COMMENTS */
/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
execom_:
     proc (p_mcb_ptr, p_com_len, p_command, p_cmd_id, p_system,
	p_major_cap, p_ecode);

/* : PROGRAM FUNCTION

Handles EXECUTE_COMMAND messages sent to internal mowse from some system.
*/

/* : NOTES
*/


/* INPUT PARAMETERS */
dcl p_mcb_ptr	       ptr parameter;	    /* mowse mcb pointer */
dcl p_com_len	       fixed bin parameter;	    /* length of command */
dcl p_command	       char (*) parameter;	    /* command to be executed */
dcl p_cmd_id	       fixed bin parameter;	    /* unique command id */
dcl p_system	       fixed bin parameter;	    /* MOWSE system */
dcl p_major_cap	       fixed bin parameter;	    /* major capability number (index into CAT tables) */


/* OUTPUT PARAMETERS */
dcl p_ecode	       fixed bin (35);	    /* return code */


/* MISC VARIABLES */
dcl return_status	       fixed bin;		    /* status to be returned in reply message */
dcl dest_maj	       fixed bin;		    /* destination major capability */


/* STRUCTURES */
dcl 01 data,
       02 cmd_id	       fixed bin (17) unal,
       02 status	       char unal;


/* SYSTEM CALLS */
dcl send_msg_	       entry (ptr, fixed bin, fixed bin, ptr,
		       fixed bin, fixed bin, fixed bin (35));
dcl capability_$pack       entry (fixed bin, fixed bin, fixed bin,
		       fixed bin (35));
dcl cu_$cp	       entry (ptr, fixed bin (21), fixed bin (35));

/* EXTERNAL CALLS */
dcl fatal_mowse_trap_      entry (fixed bin (35));

/* EXTERNAL CALL SUPPORT */

/* BUILTINS */
dcl addr		       builtin;
dcl byte		       builtin;
dcl length	       builtin;

/* CONDITIONS */
dcl cleanup	       condition;


/**/
/* INITIALIZATION */
	p_ecode = 0;

	on cleanup
	     begin;
	     data.cmd_id = p_cmd_id;
	     data.status = byte (STATUS_FAILED);
	     call send_msg_ (p_mcb_ptr, dest_maj, EXECUTE_COMMAND_REPLY,
		addr (data), 3, BG, p_ecode);
	     if p_ecode ^= 0 then do;
		call fatal_mowse_trap_ (p_ecode);
		goto ERROR_RETURN;
	     end;
	end;

/* MAIN */

/* : Evaluate destination major first in case we blow up */

	call capability_$pack (p_system, p_major_cap, dest_maj, p_ecode);
	if p_ecode ^= 0 then do;
	     call fatal_mowse_trap_ (p_ecode);
	     return;
	end;

/* : Execute command */

	call cu_$cp (addr (p_command), length (p_command), p_ecode);

/* : if execution fails then
     - send a EXECUTE_COMMAND_REPLY message with the status = STAUS_FAILED
     - else send one with STATUS_SUCCESS.*/

	if p_ecode ^= 0 then
	     return_status = STATUS_FAILED;
	else
	     return_status = STATUS_SUCCESS;

	data.cmd_id = p_cmd_id;
	data.status = byte (return_status);

	call send_msg_ (p_mcb_ptr, dest_maj, EXECUTE_COMMAND_REPLY,
	     addr (data), 3, BG, p_ecode);
	if (p_ecode ^= 0) then do;
	     call fatal_mowse_trap_ (p_ecode);
	     return;
	end;

	return;

ERROR_RETURN:
	return;

%page;
/* INCLUDE FILES */
%include mowse;
%include mowse_messages;

/* : END */
     end;




		    external_mowse_.pl1             08/07/87  1554.6rew 08/07/87  1454.9      217647



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

/****^  HISTORY COMMENTS:
  1) change(86-08-27,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-10-22,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Modified code to handle the special mowse message responsible for
     resetting, suspending, resuming and terminating a capability.
  3) change(86-10-22,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Modified code to handle messages with invalid destinations.
  4) change(86-11-14,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Changed method of implementation of messages for suspended applications.
  5) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
  6) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Clear the application output buffers when a FAIL_CAPABILITY message is
     received.
  7) change(86-12-10,Flegel), approve(86-12-10,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Replaced signalling of mowse_fatal_error with a call to fatal_mowse_trap_.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
external_mowse_:
     proc (p_mowse_mcb_ptr, p_major, p_minor, p_mess_ptr, p_mess_len,
	p_ecode);

/* : PROGRAM FUNCTION

Places messages in the buffers associated with the capability to which a
message is 'addressed'.  Should a message be longer than the pre-defined
packet size the routine handles the reassembling of the complete message from
the several partial messages transmitted.  The routine also handles the
disassembly of long messages destined for some remote capability.  A
functionally identical routine exists on remote system within the mowse
environment. */

/* : NOTES
*/


/* INPUT PARAMETERS */
dcl p_mowse_mcb_ptr	       ptr parameter;	    /* mcb for mowse_io_ */
dcl p_major	       fixed bin parameter;	    /* Major cap number */
dcl p_minor	       fixed bin parameter;	    /* Minor cap number */
dcl p_mess_ptr	       ptr parameter;	    /* Message pointer */
dcl p_mess_len	       fixed bin parameter;	    /* Message length */
dcl p_ecode	       fixed bin (35) parameter;  /* Error code */


/* SYSTEM CALL SUPPORT */
dcl ws_error_$input_buffer_overflow
		       fixed bin (35) ext static;

/* EXTERNAL CALLS */
dcl prepare_trace_	       entry (ptr, fixed bin, ptr, fixed bin);
dcl mowse_error_handler_   entry (ptr, fixed bin, fixed bin);
dcl send_mowse_message_    entry (ptr, fixed bin, fixed bin, fixed bin,
		       fixed bin, fixed bin, fixed bin, ptr,
		       fixed bin, fixed bin, fixed bin (35));
dcl get_mowse_info_ptr_    entry (ptr, ptr, fixed bin (35));
dcl send_outbuff_data_     entry (ptr, fixed bin, fixed bin, fixed bin,
		       fixed bin (35));
dcl send_msg_	       entry (ptr, fixed bin, fixed bin, ptr,
		       fixed bin, fixed bin, fixed bin (35));
dcl capability_$pack       entry (fixed bin, fixed bin, fixed bin,
		       fixed bin (35));
dcl message_manager_       entry (ptr, fixed bin, fixed bin, ptr,
		       fixed bin, fixed bin (35));
dcl release_outbuffer_     entry (ptr);
dcl fatal_mowse_trap_      entry (fixed bin (35));

/* EXTERNAL CALL SUPPORT */
dcl ws_error_$recursive_background_error
		       fixed bin (35) ext static;

/* MISC VARIABLES */
dcl mowse_info_ptr	       ptr;		    /* Pointer to mowse info structure */
dcl destination	       fixed bin;		    /* Destination of failure message */
dcl mcb_ptr	       ptr;
dcl msg_type	       fixed bin;

/* BUILTINS */
dcl null		       builtin;
dcl rank		       builtin;

/* STRUCTURES */

/* CONDITIONS */
dcl any_other	       condition;

/* CONSTANTS */
dcl TRUE		       bit (1) int static options (constant) init ("1"b);
dcl FALSE		       bit (1) int static options (constant) init ("0"b);

/**/

/* INITIALIZATION */
	p_ecode = 0;
	call get_mowse_info_ptr_ (p_mowse_mcb_ptr, mowse_info_ptr,
	     p_ecode);
	if p_ecode ^= 0 then
	     return;

/*  Establish  handler */

	mowse_info_ptr -> mowse_info.mowse_flags.error_handled = FALSE;
	on any_other
	     begin;
	     call mowse_error_handler_ (p_mowse_mcb_ptr, p_major,
		p_minor);
	     goto CAPABILITY_ERROR_RETURN;
	end;

/* MAIN */

/* : If message_ptr is null, return */

	if p_mess_ptr = null then
	     return;

	msg_type = rank (p_mess_ptr -> event_message.header.msg_type);

/* : Call trace message to print message received */

	if mowse_info_ptr -> mowse_info.mowse_flags.trace = TRUE then
	     call prepare_trace_ (p_mess_ptr, p_mess_len,
		mowse_info_ptr -> mowse_info.mowse_flags.trace_file_iocb,
		p_minor);

/* : If invalid application, send a fail to source */

	if (p_major < MINIMUM_CAT_ENTRY) | (p_major > MAXIMUM_CAT_ENTRY)
	then do;
	     call send_fail (p_mess_ptr, p_minor, p_mowse_mcb_ptr, p_ecode);
	     if p_ecode ^= 0 then
		return;
	end;

/* : If destination MCB does not exist, send fail to source */

	mcb_ptr =
	     mowse_info_ptr -> mowse_info.local_cat (p_major).mcb_ptr;
	if mcb_ptr = null then do;
	     call send_fail (p_mess_ptr, p_minor, p_mowse_mcb_ptr, p_ecode);
	     if p_ecode ^= 0 then
		return;
	end;

/* : MORE message */

	if msg_type = MORE then do;
	     call external_more (mowse_info_ptr, mcb_ptr, p_mess_ptr,
		p_mess_len, p_ecode);
	     return;
	end;

/* : CONTINUE message */

	if msg_type = CONTINUE then do;
	     call external_continue (mcb_ptr, p_mowse_mcb_ptr,
		p_mess_ptr, p_mess_len, p_major, p_minor, p_ecode);
	     return;
	end;

/* : TERMINATE_APPLICATION message */

	if p_minor = TERMINATE_APPLICATION then do;
	     call external_terminate (mowse_info_ptr, mcb_ptr, p_mess_ptr,
		p_mess_len, p_ecode);
	     return;
	end;

/* : RESET_APPLICATION message */

	if p_minor = RESET_APPLICATION then do;
	     call external_reset (mcb_ptr, p_major, mowse_info_ptr,
		p_mess_ptr, p_mess_len, p_ecode);
	     return;
	end;

/* : FAIL_CAPABILITY or SYSTEM_ERROR message */

	if p_minor = FAIL_CAPABILITY | p_minor = SYSTEM_ERROR then do;
	     call external_fail (mcb_ptr, p_major, mowse_info_ptr,
		p_mess_ptr, p_mess_len, p_ecode);
	     return;
	end;

/* : SUSPEND_APPLICATION message */

	if p_minor = SUSPEND_APPLICATION then do;
	     call external_suspend (mcb_ptr, mowse_info_ptr, p_mess_ptr,
		p_mess_len, p_major, p_ecode);
	     return;
	end;

/* : RESUME_APPLICATION message */

	if p_minor = RESUME_APPLICATION then do;
	     call external_resume (mcb_ptr, mowse_info_ptr, p_mess_ptr,
		p_mess_len, p_ecode);
	     return;
	end;

/* : DEFAULT message (any other) */

	call message_processor (mowse_info_ptr, mcb_ptr, p_mess_ptr,
	     p_mess_len, p_minor, p_ecode);

	p_ecode = 0;
	return;

/* : Termination of application performed in the event of an "any_other".
     This is the control point of a non-local goto in the event of any
     condition signalled by the capability.  The capability is unwound
     from the stack (via the goto) and is removed from MOWSE because of
     its error.  */

CAPABILITY_ERROR_RETURN:

	p_ecode = 0;
	call capability_$pack (
	     rank (p_mess_ptr -> last_message.header.source_system),
	     rank (p_mess_ptr -> last_message.header.source_major),
	     destination, p_ecode);

	if p_ecode = 0 &
	     rank (p_mess_ptr -> last_message.header.source_major)
	     ^= INTERNAL
	     then
	     call send_msg_ (p_mowse_mcb_ptr, destination, FAIL_CAPABILITY,
		null, 0, BG, p_ecode);

	p_ecode = 0;
	call get_mowse_info_ptr_ (p_mowse_mcb_ptr, mowse_info_ptr, p_ecode);
	if (p_ecode ^= 0) then
	     return;

	if (mowse_info_ptr = null) then
	     return;

	if mowse_info_ptr -> mowse_info.mowse_flags.error_handled then do;
	     mowse_info_ptr -> mowse_info.mowse_flags.error_handled = FALSE;
	     revert any_other;
	     call fatal_mowse_trap_ (ws_error_$recursive_background_error);
	     return;
	end;

/**/

/* INTERNAL PROCEDURES */


/* : *** Procedure: message_processor - Internal proc for external_mowse_  *** */


message_processor:
     proc (p_mowse_info_ptr, p_mcb_ptr, p_message_ptr, p_message_len, p_minor,
	p_code);

/* : PROCEDURE FUNCTION

Take the current message and processes it accordingly.
*/

/* INPUT PARAMETERS */
dcl p_mowse_info_ptr       ptr parameter;	    /* MOWSE info */
dcl p_minor	       fixed bin parameter;	    /* Minor of message */
dcl p_message_len	       fixed bin;		    /* Length of message */
dcl p_mcb_ptr	       ptr parameter;	    /* Applciation's MCB */
dcl p_message_ptr	       ptr parameter;	    /* Message */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;


/* MISC VARIABLES */
dcl major		       fixed bin;		    /* Destination major */
dcl minor		       fixed bin;		    /* Minor to be passed */
dcl source_major	       fixed bin;		    /* Packed major capability of source */
dcl code		       fixed bin (35);	    /* Internal error code */
dcl source_major_num       fixed bin;		    /* Sourc emajor of message */
dcl source_system	       fixed bin;		    /* Source system of message */


/* INITIALIZATION */
	p_code = 0;

	source_system =
	     rank (p_message_ptr -> last_message.header.source_system);
	source_major_num =
	     rank (p_message_ptr -> last_message.header.source_major);

	call message_manager_ (p_mcb_ptr, LAST, source_major_num,
	     p_message_ptr, p_message_len, code);

/* : set the data_length field and the input buffer position so that the next
     block of data gets placed at the beginning of the buffer */

	p_mcb_ptr -> mcb.inbuff_data_length =
	     p_mcb_ptr -> mcb.inbuff_position_index;
	p_mcb_ptr -> mcb.inbuff_position_index = 0;

	call capability_$pack (source_system, source_major_num,
	     source_major, p_code);
	if p_code ^= 0 then
	     return;

/* : If suspended and the message is not resume or terminate, send a fail to
     the source */

	major = rank (p_message_ptr -> last_message.header.major);
	if p_mowse_info_ptr -> mowse_info.local_cat (major).flags.suspended
	     & p_minor ^= TERMINATE_APPLICATION
	     & p_minor ^= RESUME_APPLICATION
	     & p_minor ^= SUSPEND_APPLICATION
	then do;
	     if source_major_num = INTERNAL then
		return;
	     call send_msg_ (p_mcb_ptr, source_major, FAIL_CAPABILITY, null,
		0, BG, p_ecode);
	     return;
	end;

/* : If there is an overflow, call the application with the overflow minor
     Else pass the message on */

	minor = p_minor;
	if code = ws_error_$input_buffer_overflow then
	     minor = OVERFLOWED_BUFFER;

/* : All parameters MUST be passed by value as we cannot allow the application
     to modify them */

	call p_mcb_ptr -> mcb.entry_var ((minor), (source_major),
	     (p_mcb_ptr -> mcb.inbuff),
	     (p_mcb_ptr -> mcb.inbuff_data_length),
	     (p_mcb_ptr), (p_mcb_ptr -> data_block_ptr));

     end message_processor;

/**/

/* : *** Procedure: external_resume - Internal proc for external_mowse_  *** */


external_resume:
     proc (p_mcb_ptr, p_mowse_info_ptr, p_message_ptr, p_message_len, p_code);

/* : PROCEDURE FUNCTION

If the suspend flag is set then reset it and call the application, otherwise
ignore the message.
*/

/* INPUT PARAMETERS */
dcl p_message_len	       fixed bin parameter;	    /* Length of message */
dcl p_mcb_ptr	       ptr parameter;	    /* MCB of application */
dcl p_message_ptr	       ptr parameter;	    /* Message */
dcl p_mowse_info_ptr       ptr parameter;	    /* MOWSE info */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;


/* MISC VARIABLES */


/* INITIALIZATION */

	p_code = 0;

/* : If the suspend flag is not set then ignore */

	if ^p_mowse_info_ptr
	     -> mowse_info.local_cat (p_major).flags.suspended then do;

	     p_mcb_ptr -> inbuff_position_index = 0;
	     p_mcb_ptr -> inbuff_data_length = 0;
	     return;
	end;

/* : Set the flag and pass the message to the application */

	p_mowse_info_ptr -> mowse_info.local_cat (p_major).flags.suspended =
	     FALSE;

	p_mcb_ptr -> mcb.inbuff_position_index = 0;
	p_mcb_ptr -> mcb.inbuff_data_length = 0;

	call message_processor (p_mowse_info_ptr, p_mcb_ptr, p_message_ptr,
	     p_message_len, RESUME_APPLICATION, p_code);

     end external_resume;

/**/

/* : *** Procedure: external_suspend - Internal proc for external_mowse_  *** */


external_suspend:
     proc (p_mcb_ptr, p_mowse_info_ptr, p_message_ptr, p_message_len, p_major,
	p_code);

/* : PROCEDURE FUNCTION

If suspended flag is NOT set then set the suspended flag and pass the
message to the application
*/

/* INPUT PARAMETERS */
dcl p_message_len	       fixed bin parameter;	    /* Length of message */
dcl p_mcb_ptr	       ptr parameter;	    /* MCB of application */
dcl p_message_ptr	       ptr parameter;	    /* Message */
dcl p_major	       fixed bin parameter;	    /* Major capability of this application */
dcl p_mowse_info_ptr       ptr parameter;	    /* MOWSE info */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;


/* MISC VARIABLES */


/* INITIALIZATION */

	p_code = 0;

/* : If already suspended, then return */

	if p_mowse_info_ptr
	     -> mowse_info.local_cat (p_major).flags.suspended then do;

	     p_mcb_ptr -> inbuff_position_index = 0;
	     p_mcb_ptr -> inbuff_data_length = 0;
	     return;
	end;

/* : Else set the flag and pass the message to the application */

	p_mowse_info_ptr -> mowse_info.local_cat (p_major).flags.suspended
	     = TRUE;

	p_mcb_ptr -> mcb.inbuff_data_length = 0;
	p_mcb_ptr -> mcb.inbuff_position_index = 0;

	call message_processor (p_mowse_info_ptr, p_mcb_ptr, p_message_ptr,
	     p_message_len, SUSPEND_APPLICATION, p_code);

     end external_suspend;

/**/

/* : *** Procedure: external_fail - Internal proc for external_mowse_  *** */


external_fail:
     proc (p_mcb_ptr, p_major, p_mowse_info_ptr, p_message_ptr, p_message_len,
	p_code);

/* : PROCEDURE FUNCTION

Clear out the application's output buffer cause it was trying to send stuff
which caused a screwup.
*/

/* INPUT PARAMETERS */
dcl p_major	       fixed bin parameter;	    /* Major of message */
dcl p_message_len	       fixed bin parameter;	    /* Length of message */
dcl p_message_ptr	       ptr parameter;	    /* Message */
dcl p_mcb_ptr	       ptr parameter;	    /* Application's MCB */
dcl p_mowse_info_ptr       ptr parameter;	    /* MOWSE info */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);


/* MISC VARIABLES */


/* INITIALIZATION */

	p_code = 0;

/* : Empty out all stored messages in output buffer */

	call release_outbuffer_ (p_mcb_ptr);

/* : Call the application */

	call message_processor (p_mowse_info_ptr, p_mcb_ptr, p_message_ptr,
	     p_message_len, FAIL_CAPABILITY, p_code);
	if p_code ^= 0 then
	     return;
     end external_fail;

/**/

/* : *** Procedure: external_reset - Internal proc for external_mowse_  *** */


external_reset:
     proc (p_mcb_ptr, p_major, p_mowse_info_ptr, p_message_ptr, p_message_len,
	p_code);

/* : PROCEDURE FUNCTION

Set the reset flag and pass the message to the application only if the flag
was not already set.
*/

/* INPUT PARAMETERS */
dcl p_major	       fixed bin parameter;	    /* Major of message */
dcl p_message_len	       fixed bin parameter;	    /* Length of message */
dcl p_message_ptr	       ptr parameter;	    /* Message */
dcl p_mcb_ptr	       ptr parameter;	    /* Application's MCB */
dcl p_mowse_info_ptr       ptr parameter;	    /* MOWSE info */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);


/* MISC VARIABLES */
dcl source_major	       fixed bin;		    /* Packed source major capability */
dcl source_system	       fixed bin;		    /* Source system of message */

/* INITIALIZATION */

	p_code = 0;

/* : If the flag is already set, ignore the message */

	if p_mowse_info_ptr -> mowse_info.local_cat (p_major).flags.reset
	     then

	     return;

/* : Set the flag and pass the message to the application */

	p_mowse_info_ptr -> mowse_info.local_cat (p_major).flags.reset
	     = TRUE;

/* : Empty out all stored messages */

	p_mcb_ptr -> mcb.inbuff_position_index = 0;
	p_mcb_ptr -> mcb.inbuff_data_length = 0;

	call release_outbuffer_ (p_mcb_ptr);

/* : Call the application */

	call message_processor (p_mowse_info_ptr, p_mcb_ptr, p_message_ptr,
	     p_message_len, RESET_APPLICATION, p_code);
	if p_code ^= 0 then
	     return;

/* : Send the reset reply to the source system's MOWSE capability only if
     the source is on a remote system */

	p_mowse_info_ptr -> mowse_info.local_cat (p_major).flags.reset
	     = FALSE;

	source_system
	     = rank (p_message_ptr -> last_message.header.source_system);
	if source_system = LOCAL_SYSTEM then
	     return;

	call capability_$pack (source_system, INTERNAL, source_major,
	     p_code);
	if p_code ^= 0 then
	     return;

	call send_msg_ (p_mcb_ptr, source_major, RESET_REPLY, null, 0, BG,
	     p_code);

     end external_reset;

/**/

/* : *** Procedure: external_terminate - Internal proc for external_mowse_  *** */


external_terminate:
     proc (p_mowse_info_ptr, p_mcb_ptr, p_message_ptr, p_message_len, p_code);

/* : PROCEDURE FUNCTION

Handle the functions necessary for passing on a terminate message.
*/

/* INPUT PARAMETERS */
dcl p_mowse_info_ptr       ptr parameter;	    /* MOWSE info */
dcl p_message_len	       fixed bin parameter;	    /* Length of message */
dcl p_message_ptr	       ptr parameter;	    /* Message */
dcl p_mcb_ptr	       ptr parameter;	    /* Application's MCB */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;


/* MISC VARIABLES */


/* INITIALIZATION */

	p_code = 0;

/* : Clear the suspend flag */

	mowse_info_ptr -> mowse_info.local_cat (p_major).flags.suspended =
	     FALSE;

/* : Pass on the message */

	mcb_ptr -> mcb.inbuff_position_index = 0;
	mcb_ptr -> mcb.inbuff_data_length = 0;

	call message_processor (p_mowse_info_ptr, p_mcb_ptr, p_message_ptr,
	     p_message_len, TERMINATE_APPLICATION, p_code);

     end external_terminate;

/**/

/* : *** Procedure: external_continue - Internal proc for external_mowse_  *** */


external_continue:
     proc (p_mcb_ptr, p_mowse_mcb_ptr, p_message_ptr, p_message_len, p_major,
	p_minor, p_code);

/* : PROCEDURE FUNCTION

Place the message in a buffer associated with the source of the message.
If for some reason the applications mcb is not valid then return a
FAIL_CAPABILITY to the source of the message to indicate the the capability
failed.
*/

/* INPUT PARAMETERS */
dcl p_mcb_ptr	       ptr parameter;	    /* MCB of capability */
dcl p_minor	       fixed bin parameter;	    /* Minor of message */
dcl p_major	       fixed bin parameter;	    /* Major of destination */
dcl p_mowse_mcb_ptr	       ptr parameter;	    /* Mowse's MCB */
dcl p_message_len	       fixed bin parameter;	    /* Length of message */
dcl p_message_ptr	       ptr parameter;	    /* Message */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;


/* MISC VARIABLES */
dcl dest_system	       fixed bin;		    /* Destination system id of message */
dcl source_major_num       fixed bin;		    /* Source major number of message */
dcl source_system	       fixed bin;		    /* Source system of message */


/* INITIALIZATION */

	p_code = 0;

	source_system =
	     rank (p_message_ptr
	     -> more_remaining_message.header.source_system);
	source_major_num =
	     rank (p_message_ptr
	     -> more_remaining_message.header.source_major);
	dest_system =
	     rank (p_message_ptr -> more_remaining_message.header.system);

/* : If the source major is invalid, then ignore the message */

	if (source_major_num < MINIMUM_CAT_ENTRY)
	     | (source_major_num > MAXIMUM_CAT_ENTRY) then

	     return;

/* : Manipulate the message into the queues of the application */

	call message_manager_ (p_mcb_ptr, CONTINUE, source_major_num,
	     p_message_ptr, p_message_len, p_code);

/* : Get the next portion from the source */

	call send_mowse_message_ (p_mowse_mcb_ptr, source_system,
	     source_major_num, dest_system, p_major, p_minor, MORE, null, 0,
	     BG, p_code);

     end external_continue;

/**/

/* : *** Procedure: external_more - Internal proc for external_mowse_  *** */


external_more:
     proc (p_mowse_info_ptr, p_mcb_ptr, p_message_ptr, p_message_len, p_code);

/* : PROCEDURE FUNCTION

Send another packet from the outbuffer to the capability requesting more
data.
*/

/* INPUT PARAMETERS */
dcl p_mowse_info_ptr       ptr parameter;	    /* MOWSE info */
dcl p_message_len	       fixed bin parameter;	    /* Length of message */
dcl p_mcb_ptr	       ptr parameter;	    /* MCB of destination capability */
dcl p_message_ptr	       ptr parameter;	    /* Message */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);


/* MISC VARIABLES */
dcl source_minor	       fixed bin;		    /* Source minor of message */
dcl source_major_num       fixed bin;		    /* Source major of message */
dcl source_system	       fixed bin;		    /* Source system of message */


/* INITIALIZATION */

	p_code = 0;

	source_system =
	     rank (p_message_ptr
	     -> request_more_message.header.source_system);
	source_major_num =
	     rank (p_message_ptr
	     -> request_more_message.header.source_major);
	source_minor =
	     rank (p_message_ptr
	     -> request_more_message.header.source_minor);

/* : If source major or minor is invalid, ignore message */

	if (source_major_num < MINIMUM_CAT_ENTRY)
	     | (source_major_num > MAXIMUM_CAT_ENTRY)
	     | (source_minor < MINIMUM_SYSTEM_MINOR)
	     | (source_minor > MAXIMUM_USER_MINOR) then

	     return;

	call send_outbuff_data_ (p_mcb_ptr, source_system, source_major_num,
	     source_minor, p_code);
	if p_code = 0 then
	     return;

/* : If something went wrong with the next portion, send a FAIL capability
     to this application */

	p_mcb_ptr -> mcb.inbuff_position_index = 0;
	p_mcb_ptr -> mcb.inbuff_data_length = 0;

	call message_processor (p_mowse_info_ptr, p_mcb_ptr, p_message_ptr,
	     p_message_len, FAIL_CAPABILITY, p_code);

     end external_more;

/**/

/* : *** Procedure: send_fail - Internal proc for external_mowse_  *** */


send_fail:
     proc (p_message_ptr, p_minor, p_mowse_mcb_ptr, p_code);

/* : PROCEDURE FUNCTION

Determine if it is valid to send a FAIL_CAPABILITY message to the source of
the message, if so then send it.
*/

/* INPUT PARAMETERS */
dcl p_minor	       fixed bin parameter;	    /* Minor capability number */
dcl p_mowse_mcb_ptr	       ptr parameter;	    /* MOWSE's MCB */
dcl p_message_ptr	       ptr parameter;	    /* Invalid message destination */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;


/* MISC VARIABLES */
dcl destination	       fixed bin;		    /* Destination capability of fail */


/* INITIALIZATION */

	p_code = 0;

	if p_minor = EXECUTE_COMMAND_REPLY | p_minor = FAIL_CAPABILITY |
	     p_minor = RESET_REPLY | p_minor = QUERY_REPLY |
	     p_minor = RESPONSE_CONNECT | p_minor = RESPONSE_DISCONNECT
	then do;

	     p_code = 0;
	     return;
	end;

	call capability_$pack (
	     rank (p_message_ptr -> last_message.header.source_system),
	     rank (p_message_ptr -> last_message.header.source_major),
	     destination, p_code);
	if p_ecode ^= 0 then do;
	     p_code = 0;
	     return;
	end;

	call send_msg_ (p_mowse_mcb_ptr, destination, FAIL_CAPABILITY,
	     null, 0, BG, p_code);

     end send_fail;

/**/

%page;

/* INCLUDE FILES */
%include "mowse";
%include "mowse_info";
%include "mowse_mcb";
%include "mowse_messages";

/* : END external_mowse_ */
     end external_mowse_;




		    fatal_mowse_trap_.pl1           08/07/87  1554.6rew 08/07/87  1454.9       21825



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

/****^  HISTORY COMMENTS:
  1) change(86-12-10,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
fatal_mowse_trap_:
     proc (p_code);

/* : PROGRAM FUNCTION

Perform the necessary functions when a bizzarre condition error has occurred
within MOWSE itself.  Such conditions are invalid message formats, etc.
*/

/* : NOTES

This version prints out a message asking the user to perform certain functions
and then submitting the results to the maintaining personell.
*/


/* INPUT PARAMETERS */
dcl p_code	       fixed bin (35);	    /* Code at time of error */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl short_info	       char (8) aligned;
dcl long_info	       char (100) aligned;

/* SYSTEM CALLS */
dcl com_err_$convert_status_code_
		       entry (fixed bin (35), char (8) aligned,
		       char (100) aligned);
dcl ioa_$ioa_switch	       entry () options (variable);
dcl cu_$cl	       entry (1 aligned, 2 bit (1) unal, 2 bit (35) unal);

/* SYSTEM CALL SUPPORT */
dcl iox_$error_output      ptr ext static;

/* CONDITIONS */

/* STRUCTURES */
dcl 01 flags	       aligned,
       02 reset_sw	       bit (1) unal,
       02 mbz	       bit (35) unal;

/**/

/* INITIALIZATION */

	flags.reset_sw = "0"b;

/* MAIN */

	call com_err_$convert_status_code_ (p_code, short_info, long_info);
	call ioa_$ioa_switch (iox_$error_output,
	     "MOWSE: ^a^/^a^/^a^/^5t^a^/",
	     long_info,
	     "An abnormal condition has occurred within MOWSE.  Please execute the",
	     "following command and submit the results to maintenance:",
	     """fo mowse_error.info; trace_stack -long; ro""");

	call cu_$cl (flags);
%page;
/* INCLUDE FILES */

/* : END */
     end fatal_mowse_trap_;




		    find_free_cat_entry_.pl1        08/07/87  1554.5rew 08/07/87  1454.9       20412



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

/****^  HISTORY COMMENTS:
  1) change(86-07-01,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */
/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
find_free_cat_entry_:
     proc (p_mowse_info_ptr, p_cat_entry_index, p_code);

/* : PROGRAM FUNCTION

Finds the first free cat index in the local CAT table.
*/

/* : NOTES
*/


/* INPUT PARAMETERS */
dcl p_mowse_info_ptr       ptr;		    /* Pointer to mowse info structure */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);	    /* Error code */
dcl p_cat_entry_index      fixed bin;		    /* index into cat table which is free */

/* MISC VARIABLES */
dcl i		       fixed bin;		    /* counter */


/* STRUCTURES */


/* SYSTEM CALLS */


/* SYSTEM CALL SUPPORT */
dcl ws_error_$cant_create_instance
		       fixed bin (35) ext static;


/* EXTERNAL CALLS */


/* EXTERNAL CALL SUPPORT */


/* BUILTINS */
dcl null		       builtin;

/* CONDITIONS */


/* CONSTANTS */


/**/
/* INITIALIZATION */


/* MAIN */

/* : Find the first free one sequentially starting from
     MINIMUM_CAT_ENTRY  to MAXIMUM_CAT_ENTRY */

	do i = MINIMUM_CAT_ENTRY to MAXIMUM_CAT_ENTRY;
	     if (p_mowse_info_ptr
		-> mowse_info.local_cat (i).mcb_ptr = null ()) then do;

		p_cat_entry_index = i;
		p_code = 0;
		return;
	     end;
	end;

/* : Return error p_code if no free entry is found */

	p_code = ws_error_$cant_create_instance;

%page;
/* INCLUDE FILES */
%include mowse_info;

/* : END */
     end;




		    find_mowse_io_.pl1              08/07/87  1554.5rew 08/07/87  1454.9       18189



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

/****^  HISTORY COMMENTS:
  1) change(86-08-14,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-08-18,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Redesign to look at N iocbs rather than traverse a chain as mowse_io_
     could be attached to something not associated with user_i/o.
  3) change(86-10-08,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Looks for the switch name "mowse_i/o" rather than every switch to find
     what is attached to what.
  4) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */
/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
find_mowse_io_:
     proc (p_iocb_ptr, p_code);

/* : PROGRAM FUNCTION

Find the iocb_ptr of the switch which is attached to mowse_io_.
*/

/* : NOTES
*/


/* INPUT PARAMETERS */
dcl p_iocb_ptr	       ptr;		    /* Pointer to iocb which is above tty_ */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);


/* SYSTEM CALLS */
dcl iox_$look_iocb	       entry (char (*), ptr, fixed bin (35));


/**/

/* INITIALIZATION */
	p_code = 0;

/* MAIN */

	call iox_$look_iocb ("mowse_i/o", p_iocb_ptr, p_code);

%page;
/* INCLUDE FILES */

/* : END */
     end;




		    get_at_.pl1                     08/07/87  1554.5rew 08/07/87  1454.9       35289



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

/****^  HISTORY COMMENTS:
  1) change(86-09-01,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-10-07,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Allowed to provide a match to a second parameter in the attach
     description for searching.
  3) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */
/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
get_at_:
     proc (p_io_name, p_attached_to, p_iocb_ptr, p_code);

/* : PROGRAM FUNCTION

Find the iocb attached to before p_io_name.
*/

/* : NOTES

If none can be found, p_code is set to error_table_$no_iocb and iocb_ptr
is null.
*/


/* INPUT PARAMETERS */
dcl p_io_name	       char (*);		    /* IO module name to look for */
dcl p_attached_to	       char (*);		    /* Second name in description to look for */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);
dcl p_iocb_ptr	       ptr;		    /* Pointer to iocb which is above p_io_name */


/* MISC VARIABLES */
dcl right		       fixed bin;		    /* Right index into attach descript */
dcl left		       fixed bin;		    /* Left index into attach descript */
dcl atd_ptr	       ptr;		    /* Temp pointer to attach description */
dcl atd		       char (256) var based (atd_ptr);
					    /* Attach description */
dcl switch_name	       char (256) var;
dcl found		       bit (1);
dcl code		       fixed bin (35);
dcl iocb_ptr	       ptr;		    /* IOCB pointer */


/* SYSTEM CALLS */
dcl iox_$look_iocb	       entry (char (*), ptr, fixed bin (35));


/* SYSTEM CALL SUPPORT */
dcl error_table_$no_iocb   fixed bin (35) ext static;
dcl iox_$user_io	       ptr ext static;


/* BUILTINS */
dcl null		       builtin;
dcl index		       builtin;
dcl length	       builtin;
dcl ltrim		       builtin;
dcl rtrim		       builtin;
dcl substr	       builtin;

/**/

/* INITIALIZATION */
	p_code = 0;

/* MAIN */

/* : Traverse the attach descriptions to find tty_ */

	iocb_ptr = iox_$user_io;
	atd_ptr = iocb_ptr -> iocb.attach_descrip_ptr;
	found = "0"b;
	do while (^found);

/* : - If found who is attached to p_io_name and p_attached_to if not null */

	     found = (ltrim (rtrim (substr (atd, 1, index (atd, " ") - 1)))
		= p_io_name);
	     if found & p_attached_to ^= "" then
		found = (ltrim (rtrim (substr (atd, index (atd, " ") + 1,
		     length (p_attached_to)))) = p_attached_to);

/* : - Else get the next iocb
     -- Calculate the name of the next iocb */

	     if ^found then do;
		left = index (atd_ptr -> atd, " ");
		switch_name = ltrim (substr (atd_ptr -> atd, left));
		right = index (switch_name, " ");
		if right ^= 0 then
		     switch_name = rtrim (substr (switch_name, 1, right));

/* : -- Find next iocb, if none then error */

		call iox_$look_iocb (
		     substr (switch_name, 1, length (switch_name)),
		     iocb_ptr, code);
		if code ^= 0 | atd_ptr = null then do;
		     p_code = error_table_$no_iocb;
		     p_iocb_ptr = null;
		     return;
		end;
		atd_ptr = iocb_ptr -> iocb.attach_descrip_ptr;
	     end;
	end;

/* : Found switch name */

	p_iocb_ptr = iocb_ptr;

%page;
/* INCLUDE FILES */
%include iocbv;

/* : END */
     end get_at_;




		    get_mowse_info_ptr_.pl1         08/07/87  1554.5rew 08/07/87  1454.9       22995



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

/****^  HISTORY COMMENTS:
  1) change(86-07-24,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
get_mowse_info_ptr_:
     proc (p_mcb_ptr, p_mowse_info_ptr, p_code);

/* : PROGRAM FUNCTION

Gets the mowse info pointer from the mowse_i/o switch.
*/

/* : NOTES
*/

/* INPUT PARAMETERS */
dcl p_mcb_ptr	       ptr;		    /* Pointer to mcb of application issuing call */


/* OUTPUT PARAMETERS */
dcl p_mowse_info_ptr       ptr;		    /* Pointer to mowse info structure */
dcl p_code	       fixed bin (35);	    /* Error code */


/* MISC VARIABLES */


/* STRUCTURES */
dcl 01 info	       like mowse_io_info;


/* STRUCTURES */


/* SYSTEM CALLS */
dcl iox_$control	       entry (ptr, char (*), ptr, fixed bin (35));


/* SYSTEM CALL SUPPORT */


/* EXTERNAL CALLS */


/* EXTERNAL CALL SUPPORT */
dcl error_table_$unimplemented_version
		       fixed bin (35) ext static;
dcl ws_error_$invalid_mcb  fixed bin (35) ext static;


/* BUILTINS */
dcl addr		       builtin;
dcl null		       builtin;

/* CONDITIONS */


/* CONSTANTS */


/**/
/* INITIALIZATION */


/* MAIN */

	if p_mcb_ptr = null () then do;
	     p_code = ws_error_$invalid_mcb;
	     return;
	end;

	p_mowse_info_ptr = null ();
	info.version = mowse_io_info_version_1;
	call iox_$control (p_mcb_ptr -> mcb.iocb_ptr, "get_mowse_info",
	     addr (info), p_code);

	p_mowse_info_ptr = info.info_ptr;
	if p_code ^= 0 then
	     return;
	if p_mowse_info_ptr -> mowse_info.version ^= MOWSE_VERSION_ then do;
	     p_code = error_table_$unimplemented_version;
	     return;
	end;

%page;

/* INCLUDE FILES */
%include mowse;
%include mowse_mcb;
%include mowse_info;
%include mowse_io_control_info;

/* : END */
     end;




		    init_mowse_.pl1                 08/07/87  1554.5rew 08/07/87  1454.9       60552



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

/****^  HISTORY COMMENTS:
  1) change(86-08-13,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-09-19,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Allowed up to 32 (number of cat entry) capabilities to be autoloaded.
  3) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
  4) change(86-12-10,Flegel), approve(86-12-10,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Replaced signalling of mowse_fatal_error with a call to fatal_mowse_trap_.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
init_mowse_:
     proc (p_mowse_mcb_ptr, p_init_mowse_info_ptr, p_code);

/* : PROGRAM FUNCTION

Sets up tables required by MOWSE to allow the library functions
supported to be performed.  Sets flags used by mowse to determine
information to display to users based on command line arguements
given to atm (attach_mowse).
*/

/* : NOTES
*/

/* INPUT PARAMETERS */
dcl p_init_mowse_info_ptr  ptr;		    /* Pointer to initialization info structure */
dcl p_mowse_mcb_ptr	       ptr parameter;	    /* Pointer to mowse mcb */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;


/* MISC VARIABLES */
dcl mowse_info_ptr	       ptr;		    /* Pointer to mowse_info_ structure */
dcl i		       fixed bin;		    /* Counter */


/* STRUCTURES */
dcl 01 io_info_store       like mowse_io_store_info automatic;
dcl 01 io_info_debug       like mowse_io_debug_info automatic;
dcl 01 io_info_trace       like mowse_io_debug_info automatic;


/* SYSTEM CALLS */
dcl iox_$control	       entry (ptr, char (*), ptr, fixed bin (35));
dcl ioa_$ioa_switch	       entry () options (variable);
dcl get_temp_segment_      entry (char (*), ptr, fixed bin (35));


/* SYSTEM CALL SUPPORT */
dcl ws_error_$invalid_mcb  fixed bin (35) ext static;


/* EXTERNAL CALLS */
dcl execom_	       entry (ptr, fixed bin, char (*), fixed bin,
		       fixed bin, fixed bin, fixed bin (35));


/* EXTERNAL CALL SUPPORT */


/* BUILTINS */
dcl null		       builtin;
dcl addr		       builtin;
dcl length	       builtin;

/* CONDITIONS */


/* CONSTANTS */


/**/
/* INITIALIZATION */
	init_mowse_info_ptr = p_init_mowse_info_ptr;
	mowse_info_ptr = null;

/* MAIN */

/* : Check mcb pointer */

	if p_mowse_mcb_ptr = null then do;
	     p_code = ws_error_$invalid_mcb;
	     return;
	end;

/* : Get temp_seg (MOWSE_) in which tables will be allocated. */

	call get_temp_segment_ (temp_seg_name, mowse_info_ptr, p_code);
	if p_code ^= 0 then
	     return;

	io_info_store.version = mowse_io_info_version_1;
	io_info_store.info_ptr = mowse_info_ptr;
	call iox_$control (p_mowse_mcb_ptr -> mcb.iocb_ptr,
	     "store_mowse_info", addr (io_info_store), p_code);
	if p_code ^= 0 then
	     return;

/* : Initialize pointer to initialization info */

	p_mowse_mcb_ptr -> mcb.mowse_info_ptr = mowse_info_ptr;
	mowse_info_ptr -> mowse_info.init_mowse_info_ptr =
	     init_mowse_info_ptr;

/* : Set version of mowse_info structure */

	mowse_info_ptr -> mowse_info.version = MOWSE_VERSION_;

/* : Initialize the CAT tables */

	mowse_info_ptr -> mowse_info.local_cat (*).mcb_ptr = null;
	mowse_info_ptr -> mowse_info.local_cat (*).sleep_time = 1;
	mowse_info_ptr -> mowse_info.local_cat (*).flags.reset = "0"b;
	mowse_info_ptr -> mowse_info.local_cat (*).flags.suspended = "0"b;
	mowse_info_ptr -> mowse_info.local_cat (*).flags.status = "0"b;
	mowse_info_ptr -> mowse_info.remote_cat (*).major_capability = 0;

	mowse_info_ptr -> mowse_info.remote_cat (*).capability_name =
	     ((32)" ");
	mowse_info_ptr -> mowse_info.remote_cat (*).flags.reset = "0"b;
	mowse_info_ptr -> mowse_info.remote_cat (*).flags.suspended = "0"b;
	mowse_info_ptr -> mowse_info.remote_cat (*).sleep_time = "0"b;

/* : Initialize the message_manager_info substructure */

	mowse_info_ptr
	     -> mowse_info.message_manager_info.head_list_ptr = null;
	mowse_info_ptr
	     -> mowse_info.message_manager_info.tail_list_ptr = null;
	mowse_info_ptr
	     -> mowse_info.message_manager_info.pending_messages = 0;

	mowse_info_ptr -> mowse_info.mowse_flags.debug = "0"b;
	mowse_info_ptr -> mowse_info.mowse_flags.debug_file_iocb = null;
	mowse_info_ptr -> mowse_info.mowse_flags.trace = "0"b;
	mowse_info_ptr -> mowse_info.mowse_flags.trace_file_iocb = null;

/* : Examine arguements given to mowse and perform the required tasks */

	if init_mowse_info_ptr = null then
	     return;
	if init_mowse_info.version ^= MOWSE_VERSION_ then
	     return;

	if init_mowse_info.flags.debug_sw then do;
	     io_info_debug.version = mowse_io_info_version_1;
	     io_info_debug.segment_name = init_mowse_info.debug;
	     call iox_$control (p_mowse_mcb_ptr -> mcb.iocb_ptr, "debug_on",
		addr (io_info_debug), p_code);
	     if p_code ^= 0 then
		return;
	end;

	if init_mowse_info.flags.trace_sw then do;
	     io_info_trace.version = mowse_io_info_version_1;
	     io_info_trace.segment_name = init_mowse_info.trace;
	     call iox_$control (p_mowse_mcb_ptr -> mcb.iocb_ptr,
		"trace_on", addr (io_info_trace), p_code);
	     if p_code ^= 0 then
		return;
	     call ioa_$ioa_switch (mowse_info_ptr
		-> mowse_info.mowse_flags.trace_file_iocb,
		"MOWSE MESSAGE TRACE^/format:" ||
		"^/TRC <direction>: from <source_system>:" ||
		"^/<source_major>: to <destination_system>:" ||
		"^/<destination_major>:<destination_minor> = <minor_name>"
		||
		"^/TRC Msg_type<message_type>: <message_length>: <message>^/"
		);
	end;

/* : Execute all of the startup capabilities specified */

	i = 1;
	do while (init_mowse_info.startup (i) ^= ""
	     & init_mowse_info.flags.start_up_sw);

	     call execom_ (p_mowse_mcb_ptr,
		(length (init_mowse_info.startup (i))),
		(init_mowse_info.startup (i)),
		(0), (LOCAL_SYSTEM), (INTERNAL), p_code);
	     if p_code ^= 0 then
		return;
	     i = i + 1;
	end;

%page;
/* INCLUDE FILES */
%include mowse_io_control_info;
%include mowse_mcb;
%include mowse_info;
%include mowse;

/* : END */
     end;




		    internal_connect_request_.pl1   08/07/87  1554.4rew 08/07/87  1454.9       53496



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


/****^  HISTORY COMMENTS:
  1) change(86-11-20,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
  3) change(86-12-10,Flegel), approve(86-12-10,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Replaced signalling of mowse_fatal_error with a call to fatal_mowse_trap_.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
internal_connect_request_:
     proc (p_mcb_ptr, p_message_ptr, p_message_len, p_code);

/* PROGRAM FUNCTION

If the destination capability already exists, then simply pass on the message
to it.  Otherwise, create it and then pass on the message to it.  If the
creation fails, then return FAIL to the source of the request in the
connect_response message.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_mcb_ptr	       ptr parameter;	    /* MOWSE's MCB */
dcl p_message_ptr	       ptr parameter;	    /* Message */
dcl p_message_len	       fixed bin parameter;	    /* Length of message */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;


/* MISC VARIABLES */
dcl cap_num	       fixed bin;		    /* Capability_number */
dcl sysid		       fixed bin;		    /* System id */
dcl return_status	       char (1);		    /* SUCCESS/REJECT of connect */
dcl destination	       fixed bin;		    /* Destination of reply */
dcl major_num	       fixed bin;		    /* Number of the destination capability */
dcl capname_len	       fixed bin;		    /* Length of capability name */
dcl capname	       char (CAPABILITY_NAME_LENGTH);
					    /* Name of capability to connect to */
dcl connect_request_string char (MAXIMUM_PACKET_SIZE);
					    /* Message data */
dcl blkpos	       fixed bin;		    /* End of capability name */


/* STRUCTURES */


/* SYSTEM CALLS */
dcl cu_$cp	       entry (ptr, fixed bin (21), fixed bin (35));


/* SYSTEM CALL SUPPORT */


/* EXTERNAL CALLS */
dcl capability_$unpack     entry (fixed bin, fixed bin, fixed bin,
		       fixed bin (35));
dcl send_mowse_message_    entry (ptr, fixed bin, fixed bin, fixed bin,
		       fixed bin, fixed bin,
		       fixed bin, ptr, fixed bin, fixed bin,
		       fixed bin (35));
dcl send_msg_	       entry (ptr, fixed bin, fixed bin, ptr, fixed bin,
		       fixed bin, fixed bin (35));
dcl ws_$put_background_message
		       entry () options (variable);
dcl capability_$pack       entry (fixed bin, fixed bin, fixed bin,
		       fixed bin (35));
dcl ws_$find_capability_number
		       entry (char (*), fixed bin, fixed bin,
		       fixed bin (35));
dcl fatal_mowse_trap_      entry (fixed bin (35));

/* EXTERNAL CALL SUPPORT */


/* BUILTINS */
dcl null		       builtin;
dcl byte		       builtin;
dcl index		       builtin;
dcl min		       builtin;
dcl substr	       builtin;
dcl addr		       builtin;
dcl rank		       builtin;


/* CONDITIONS */


/* CONSTANTS */


/**/
/* INITIALIZATION */


/* MAIN */

/* : Extract the name of the capability */

	message_len = p_message_len;
	connect_request_string =
	     p_message_ptr -> last_message.data.data_buf;
	blkpos = index (connect_request_string, " ");
	if blkpos ^= 0 then
	     capname_len = min (blkpos - 1, CAPABILITY_NAME_LENGTH);
	else
	     capname_len = min (p_message_len - 5, CAPABILITY_NAME_LENGTH);
	capname = substr (connect_request_string, 1, capname_len);

/* : Try to find the capability to which connection is requested
     - If it is not found the try to create it */

	call ws_$find_capability_number (substr (capname, 1, capname_len),
	     LOCAL_SYSTEM, major_num, p_code);
	if p_code ^= 0 then do;
	     call cu_$cp (addr (connect_request_string), p_message_len - 5,
		p_code);
	     if p_code = 0 then
		call ws_$find_capability_number (
		     substr (capname, 1, capname_len), LOCAL_SYSTEM,
		     major_num, p_code);
	end;

/* : - If it cannot be created then send message to the capability requesting
       the connect that it has failed */

	if p_code ^= 0 then do;
	     call capability_$pack (
		rank (p_message_ptr -> last_message.header.source_system),
		rank (p_message_ptr -> last_message.header.source_major),
		destination, p_code);
	     if p_code ^= 0 then do;
		call ws_$put_background_message (p_mcb_ptr, p_code,
		     "MULTICS MOWSE",
		     "Request connect from invalid source");
		p_code = 0;
		return;
	     end;
	     return_status = byte (REJECT);
	     call send_msg_ (p_mcb_ptr, destination, RESPONSE_CONNECT,
		addr (return_status), 1, BG, p_code);
	     if p_code ^= 0 then do;
		call fatal_mowse_trap_ (p_code);
		return;
	     end;
	     return;
	end;

/* : - Otherwise send a request connect to the capability */

	call capability_$unpack (sysid, cap_num, major_num, p_code);
	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;
	call send_mowse_message_ (p_mcb_ptr,
	     rank (p_message_ptr -> last_message.header.source_system),
	     rank (p_message_ptr -> last_message.header.source_major),
	     sysid, cap_num, REQUEST_CONNECT, LAST, null, 0, BG, p_code);
	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

	return;

%page;
/* INCLUDE FILES */
%include mowse_info;
%include mowse_messages;
%include mowse;

     end;




		    internal_mowse_.pl1             08/07/87  1554.4rew 08/07/87  1454.8       82656



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

/****^  HISTORY COMMENTS:
  1) change(86-07-01,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-10-22,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Change code handling delete_from_remote_cat_ request so that no
     capability_name is expected in the alter_cat_message.  Include code
     for the handling of connect request messages.  Handled messages received
     with an invalid minor specified.
  3) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
internal_mowse_:
     proc (p_mcb_ptr, p_mess_len, p_minor, p_mess_ptr, p_ecode);


/* : PROGRAM FUNCTION

Determine the destination of the internal narc message depending on the minor
capability number and direct control appropriately. */

/* : NOTES
*/

/* INPUT PARAMETERS */
dcl p_mcb_ptr	       ptr parameter;	    /* mcb pointer of mowse_io_ */
dcl p_mess_len	       fixed bin parameter;	    /* Length of message */
dcl p_minor	       fixed bin parameter;	    /* Minor capability */
dcl p_mess_ptr	       ptr parameter;	    /* Pointer to message */
dcl p_ecode	       fixed bin (35) parameter;  /* Error code */


/* EXTERNAL CALLS */
dcl internal_connect_request_
		       entry (ptr, ptr, fixed bin, fixed bin (35));
dcl prepare_trace_	       entry (ptr, fixed bin, ptr, fixed bin);
dcl capability_$pack       entry (fixed bin, fixed bin, fixed bin,
		       fixed bin (35));
dcl send_msg_	       entry (ptr, fixed bin, fixed bin, ptr, fixed bin,
		       fixed bin, fixed bin (35));
dcl add_to_remote_cat_     entry (ptr, fixed bin, char (*), fixed bin (35));
dcl delete_from_remote_cat_
		       entry (ptr, fixed bin, fixed bin (35));
dcl get_mowse_info_ptr_    entry (ptr, ptr, fixed bin (35));
dcl ws_$put_background_message
		       entry () options (variable);
dcl execom_	       entry (ptr, fixed bin, char (*), fixed bin,
		       fixed bin, fixed bin, fixed bin (35));


/* MISC VARIABLES */
dcl cap_num	       fixed bin;
dcl destination	       fixed bin;		    /* source of message */
dcl major_name	       char (32);		    /* Capability name */
dcl old_modes	       char (256);		    /* returned from iox_$modes call */
dcl mowse_info_ptr	       ptr;		    /* Pointer to mowse info structure */
dcl command_id	       fixed bin;
dcl major_num	       fixed bin;


/* CONDITIONS */


/* BUILTINS */
dcl null		       builtin;
dcl substr	       builtin;
dcl rank		       builtin;

/* CONSTANTS */
dcl TRUE		       bit (1) int static options (constant) init ("1"b);
dcl FALSE		       bit (1) int static options (constant) init ("0"b);

/* SYSTEM CALLS */
dcl iox_$modes	       entry (ptr, char (*), char (*), fixed bin (35));

/* EXTERNAL CALL SUPPORT */


/**/

/* INITIALIZATION */

	p_ecode = 0;
	message_ptr = p_mess_ptr;
	message_len = p_mess_len;
	mowse_info_ptr = null;
	call get_mowse_info_ptr_ (p_mcb_ptr, mowse_info_ptr, p_ecode);
	if p_ecode ^= 0 then
	     return;

/* : MAIN */

/* : Call trace message to print message received */

	if mowse_info_ptr -> mowse_info.mowse_flags.trace = TRUE then
	     call prepare_trace_ (message_ptr, message_len,
		mowse_info_ptr -> mowse_info.mowse_flags.trace_file_iocb,
		0);

/* : - case SET_SLEEP_FLAG
     -- set the sleep flag of the source capability */

	if (p_minor = SET_SLEEP_FLAG) then do;
	     cap_num
		= rank (message_ptr -> last_message.header.source_major);
	     if cap_num < MINIMUM_CAT_ENTRY | cap_num > MAXIMUM_CAT_ENTRY
		then
		return;

	     mowse_info_ptr -> mowse_info.remote_cat (cap_num).sleep_time
		= "1"b;
	     return;
	end;

/* : - case RESET_SLEEP_FLAG
     -- clear the sleep flag of the source capability */

	if (p_minor = RESET_SLEEP_FLAG) then do;
	     cap_num
		= rank (message_ptr -> last_message.header.source_major);
	     if cap_num < MINIMUM_CAT_ENTRY | cap_num > MAXIMUM_CAT_ENTRY
		then
		return;

	     mowse_info_ptr -> mowse_info.remote_cat (cap_num).sleep_time
		= "0"b;
	     return;
	end;

/* : - case RESET_REPLY
     -- clear the reset flag on the source application (RESET_REPLYs only come
        from the remote system */

	if p_minor = RESET_REPLY then do;
	     cap_num
		= rank (message_ptr -> last_message.header.source_major);
	     if cap_num < MINIMUM_CAT_ENTRY | cap_num > MAXIMUM_CAT_ENTRY
		then
		return;

	     mowse_info_ptr -> mowse_info.remote_cat (cap_num).flags.reset
		= FALSE;
	     return;
	end;

/* : - case SET_SUSPEND
     -- set the suspend flag on the destination application (only come
        from the remote system) */

	if p_minor = SET_SUSPEND then do;
	     cap_num
		= rank (message_ptr -> last_message.header.source_major);
	     if cap_num < MINIMUM_CAT_ENTRY | cap_num > MAXIMUM_CAT_ENTRY
		then
		return;

	     mowse_info_ptr
		-> mowse_info.remote_cat (cap_num).flags.suspended
		= TRUE;
	     return;
	end;

/* : - case RESET_SUSPEND
     -- clear the suspend flag on the specified application (these only come
        from the remote system */

	if p_minor = RESET_SUSPEND then do;
	     cap_num
		= rank (message_ptr -> last_message.header.source_major);
	     if cap_num < MINIMUM_CAT_ENTRY | cap_num > MAXIMUM_CAT_ENTRY
		then
		return;

	     mowse_info_ptr
		-> mowse_info.remote_cat (cap_num).flags.suspended
		= FALSE;
	     return;
	end;

/* : - case EXECUTE_COMMAND:
     -- call procedure execom_ which will handle the execution of the command
        originating from some other system. */

	if (p_minor = EXECUTE_COMMAND) then do;
	     command_id = message_ptr -> execom_message.data.cmd_id;
	     call execom_ (p_mcb_ptr, message_len - 7,
		message_ptr -> execom_message.data.command, command_id,
		rank (message_ptr -> execom_message.header.source_system),
		rank (message_ptr -> execom_message.header.source_major),
		p_ecode);
	     p_ecode = 0;
	     return;
	end;

/* : - case EXECUTE_COMMAND_REPLY:
       (Execution of an application by mowse on startup failed)
     -- put a background message indicating the status of the execution
        (only if it failed) to the user. */

	if (p_minor = EXECUTE_COMMAND_REPLY) then do;
	     if (message_ptr -> execom_reply_msg.data.cmd_id = 0) &
		(rank (message_ptr -> execom_reply_msg.data.status) =
		STATUS_FAILED) then do;

		call ws_$put_background_message (p_mcb_ptr, 0, "MOWSE",
		     "Start up failed");
	     end;
	     p_ecode = 0;
	     return;
	end;

/* : - case ADD_TO_REMOTE_CAT:
     -- call procedure add_to_remote_cat_ with the capability_number and
        the name of the capability to be added to the remote CAT table. */

	if (p_minor = ADD_TO_REMOTE_CAT) then do;
	     if substr (message_ptr -> alter_cat_message.data.major_name, 1,
		6)
		= "WSTERM"
		then
		call iox_$modes (p_mcb_ptr -> mcb.iocb_ptr,
		     "", old_modes, p_ecode);

	     major_num = rank (message_ptr -> alter_cat_message.data.major);
	     major_name =
		substr (message_ptr -> alter_cat_message.data.major_name,
		1, p_mess_len - 6);
	     call add_to_remote_cat_ (p_mcb_ptr, major_num, major_name,
		p_ecode);

	     return;
	end;

/* : - case DELETE_FROM_REMOTE_CAT:
     -- call procedure delete_from_remote_cat_ with the capability_number and
        the name of the capability to be deleted from the remote CAT table. */

	if (p_minor = DELETE_FROM_REMOTE_CAT) then do;
	     cap_num =
		rank (message_ptr -> alter_cat_message.data.major);
	     call delete_from_remote_cat_ (p_mcb_ptr, cap_num, p_ecode);
	     return;
	end;

/* : - case REQUEST_CONNECT */

	if p_minor = REQUEST_CONNECT then do;
	     call internal_connect_request_ (p_mcb_ptr, p_mess_ptr,
		p_mess_len, p_ecode);
	     return;
	end;

/* : - case FAIL_CAPABILITY
       ignore it */

	if p_minor = FAIL_CAPABILITY then
	     return;

/* : Send execute_capability_failed message to source of illegal message */

	call capability_$pack (
	     rank (message_ptr -> input_message.header.source_system),
	     rank (message_ptr -> input_message.header.source_major),
	     destination, p_ecode);

/* : if source of message is illegal then ignore message
     else send execute_capability_reply message to source */

	if p_ecode ^= 0 then do;
	     p_ecode = 0;
	     return;
	end;

	call send_msg_ (p_mcb_ptr, destination, FAIL_CAPABILITY,
	     null, 0, BG, p_ecode);
	return;

%page;

/* INCLUDE FILES */
%include mowse_mcb;
%include mowse;
%include mowse_messages;
%include mowse_info;

/* : END internal_mowse_ */
     end internal_mowse_;




		    message_manager_.pl1            08/07/87  1554.4rew 08/07/87  1454.8      104373



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

/****^  HISTORY COMMENTS:
  1) change(86-08-27,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
message_manager_:
     proc (p_mcb_ptr, p_msg_type, p_source_major, p_msg_ptr, p_msg_len,
	p_code);

/* : PROGRAM FUNCTION

This module manages incoming partial messages holding them until the entire
message is recieved and then passing the entire message to the destination
application.
*/

/* : NOTES
*/

/* INPUT PARAMETERS */
dcl p_mcb_ptr	       ptr;		    /* pointer to destination's mcb */
dcl p_msg_type	       fixed bin parameter;	    /* last, more or continue */
dcl p_source_major	       fixed bin parameter;
dcl p_msg_ptr	       ptr parameter;	    /* Pointer to message */
dcl p_msg_len	       fixed bin parameter;	    /* Length of message */



/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);	    /* Error code */

/* MISC VARIABLES */
dcl mowse_info_ptr	       ptr;		    /* Pointer to mowse info structure */
dcl 01 xtn	       like message_node based (xtn_ptr);
					    /* node space to be deallocated */
dcl xtn_ptr	       ptr;		    /* pointer to node space to be freed */
dcl 01 xtpm	       like partial_message based (xtpm_ptr);
dcl xtpm_ptr	       ptr;		    /* pointer to space to be freed */
dcl tpm_ptr	       ptr;		    /* temp partial message pointer */
dcl temp_msg	       char (p_msg_len) based (p_msg_ptr);
					    /* temp message overlay */
dcl tn_ptr	       ptr;		    /* temp pointer */
dcl found		       bit (1);		    /* loop control */
dcl done		       bit (1);		    /* loop control */
dcl new_msg	       ptr;		    /* pointer to space allocated for the new partial message */


/* STRUCTURES */


/* SYSTEM CALLS */
dcl get_system_free_area_  entry () returns (ptr);


/* SYSTEM CALL SUPPORT */
dcl system_free_area_ptr   ptr;		    /* pointer to system free area */
dcl system_free_area       area based (system_free_area_ptr);
					    /* system free area */


/* EXTERNAL CALLS */
dcl get_mowse_info_ptr_    entry (ptr, ptr, fixed bin (35));
dcl append_inbuff_	       entry (ptr, ptr, fixed bin, fixed bin (35));


/* EXTERNAL CALL SUPPORT */


/* BUILTINS */
dcl addr		       builtin;
dcl null		       builtin;
dcl substr	       builtin;


/* CONDITIONS */


/* CONSTANTS */
dcl TRUE		       bit (1) int static options (constant) init ("1"b);
dcl FALSE		       bit (1) int static options (constant) init ("0"b);

/**/
/* INITIALIZATION */

	system_free_area_ptr = get_system_free_area_ ();
	message_ptr = p_msg_ptr;
	message_len = p_msg_len;
	call get_mowse_info_ptr_ (p_mcb_ptr, mowse_info_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* MAIN */

/* : If the message type is CONTINUE */

	if p_msg_type = CONTINUE then do;

/* : - If pointer to the head of the list is null then create
       a message node and attach to it the message */

	     if (mowse_info_ptr
		-> mowse_info.message_manager_info.head_list_ptr
		= null) then do;
		allocate message_node in (system_free_area);
		mowse_info_ptr
		     -> mowse_info.message_manager_info
		     .head_list_ptr =
		     msg_node_ptr;
		mowse_info_ptr
		     -> mowse_info.message_manager_info
		     .tail_list_ptr =
		     msg_node_ptr;
		mowse_info_ptr
		     -> mowse_info.message_manager_info
		     .pending_messages
		     = mowse_info_ptr
		     -> mowse_info.message_manager_info
		     .pending_messages
		     + 1;
		msg_node_ptr -> message_node.major = p_source_major;
		allocate partial_message in (system_free_area);
		msg_node_ptr -> message_node.partial_msg_list_ptr =
		     part_msg_ptr;
		msg_node_ptr -> message_node.last_part_msg =
		     part_msg_ptr;
		msg_node_ptr -> message_node.next_node = null;
		msg_node_ptr -> message_node.prev_node = null;
		part_msg_length = p_msg_len;
		allocate part_msg in (system_free_area) set (new_msg);
		part_msg_ptr -> partial_message.msg_ptr = new_msg;
		substr (new_msg -> part_msg, 1, p_msg_len) =
		     substr (p_msg_ptr -> temp_msg, 1, p_msg_len);
		part_msg_ptr -> partial_message.msg_len = part_msg_length;
		part_msg_ptr -> partial_message.next_msg = null;
	     end;

/* : - Else search through the list of nodes for one which has 
     the same source major as the message just received */

	     else do;
		done = FALSE;
		found = FALSE;
		tn_ptr =
		     mowse_info_ptr
		     -> mowse_info.message_manager_info.
		     head_list_ptr;
		do while (tn_ptr ^= null & ^done & ^found);
		     if tn_ptr -> message_node.major > p_source_major then
			done = TRUE;
		     else if tn_ptr -> message_node.major = p_source_major
		     then do;
			done = TRUE;
			found = TRUE;
		     end;
		     else
			tn_ptr = tn_ptr -> message_node.next_node;
		end;

/* : - If it is found then add the message to the list attached to
     this node */

		if found = TRUE then do;
		     allocate partial_message in (system_free_area);
		     part_msg_length = p_msg_len;
		     allocate part_msg in (system_free_area)
			set (new_msg);
		     part_msg_ptr -> partial_message.msg_ptr = new_msg;
		     substr (new_msg -> part_msg, 1, p_msg_len) =
			substr (p_msg_ptr -> temp_msg, 1, p_msg_len);
		     part_msg_ptr -> partial_message.msg_len =
			part_msg_length;
		     part_msg_ptr -> partial_message.next_msg = null;

		     if tn_ptr -> message_node.last_part_msg = null
		     then do;
			tn_ptr -> message_node.partial_msg_list_ptr =
			     part_msg_ptr;
			tn_ptr -> message_node.last_part_msg =
			     part_msg_ptr;
		     end;
		     else do;
			tn_ptr -> message_node.last_part_msg
			     -> partial_message.next_msg = part_msg_ptr;
			tn_ptr -> message_node.last_part_msg =
			     part_msg_ptr;
		     end;
		end;

/* : Else make a new message node and start a partial message list on the
     node */

		else do;
		     allocate message_node in (system_free_area);
		     mowse_info_ptr -> mowse_info.
			message_manager_info.pending_messages
			= mowse_info_ptr -> mowse_info.
			message_manager_info.pending_messages + 1;
		     msg_node_ptr -> message_node.major =
			p_source_major;
		     allocate partial_message in (system_free_area);
		     msg_node_ptr
			-> message_node.partial_msg_list_ptr =
			part_msg_ptr;
		     part_msg_length = p_msg_len;
		     allocate part_msg in (system_free_area)
			set (new_msg);
		     part_msg_ptr -> partial_message.msg_ptr = new_msg;
		     substr (new_msg -> part_msg, 1, p_msg_len) =
			substr (p_msg_ptr -> temp_msg, 1, p_msg_len);
		     part_msg_ptr -> partial_message.msg_len =
			part_msg_length;
		     part_msg_ptr -> partial_message.next_msg = null;

		     if mowse_info_ptr
			-> mowse_info.message_manager_info.head_list_ptr
			= tn_ptr then do;	    /* add to head */
			msg_node_ptr -> message_node.next_node = tn_ptr;
			msg_node_ptr -> message_node.prev_node = null;
			tn_ptr -> message_node.prev_node = msg_node_ptr;
			mowse_info_ptr -> mowse_info.
			     message_manager_info.head_list_ptr =
			     msg_node_ptr;
		     end;
		     else if tn_ptr = null then do;
					    /* append to end */
			msg_node_ptr -> message_node.next_node = null;
			msg_node_ptr -> message_node.prev_node =
			     mowse_info_ptr -> mowse_info.
			     message_manager_info.tail_list_ptr;
			mowse_info_ptr -> mowse_info.
			     message_manager_info.tail_list_ptr
			     -> message_node.next_node = msg_node_ptr;
			mowse_info_ptr -> mowse_info.
			     message_manager_info.tail_list_ptr =
			     msg_node_ptr;
		     end;
		     else if tn_ptr ^= null then do;
					    /* insert */
			tn_ptr -> message_node.prev_node
			     -> message_node.next_node = msg_node_ptr;
			msg_node_ptr -> message_node.next_node = tn_ptr;
			msg_node_ptr -> message_node.prev_node =
			     tn_ptr -> message_node.prev_node;
			tn_ptr -> message_node.prev_node = msg_node_ptr;
		     end;
		end;
	     end;
	end;

/* : Else if the message type is LAST
     - Search through the list of nodes for one with the same
       source major. */

	else if p_msg_type = LAST then do;
	     done = FALSE;
	     found = FALSE;
	     tn_ptr = mowse_info_ptr -> mowse_info.message_manager_info.
		head_list_ptr;
	     do while (tn_ptr ^= null & ^done & ^found);
		if tn_ptr -> message_node.major > p_source_major then
		     done = TRUE;
		else if tn_ptr -> message_node.major = p_source_major
		then do;
		     done = TRUE;
		     found = TRUE;
		end;
		else
		     tn_ptr = tn_ptr -> message_node.next_node;
	     end;

/* : - If a node is not found the place the last message is the
     input buffer of the application */

	     if found = FALSE then do;
		call append_inbuff_ (p_mcb_ptr,
		     addr (message_ptr -> last_message.data.data_buf),
		     message_len - 5, p_code);
	     end;

/* : - Else place all messages in the list attached to the node
     into the buffer of the application and then place the last
     message into the buffer */

	     else do;
		tpm_ptr = tn_ptr -> message_node.partial_msg_list_ptr;
		do while (tpm_ptr ^= null);
		     message_ptr = tpm_ptr -> partial_message.msg_ptr;
		     message_len = tpm_ptr -> partial_message.msg_len;
		     call append_inbuff_ (p_mcb_ptr,
			addr (message_ptr
			-> more_remaining_message.data.data_buf),
			message_len - 6, p_code);
		     xtpm_ptr = tpm_ptr;
		     tpm_ptr = tpm_ptr -> partial_message.next_msg;

		     free xtpm;
		     xtpm_ptr = null;
		end;
		xtn_ptr = tn_ptr;
		if mowse_info_ptr -> mowse_info.
		     message_manager_info.head_list_ptr = tn_ptr
		then do;			    /* delete from head of list */
		     mowse_info_ptr -> mowse_info.
			message_manager_info.head_list_ptr =
			tn_ptr -> message_node.next_node;
		     if tn_ptr -> message_node.next_node ^= null then
			tn_ptr -> message_node.next_node
			     -> message_node.prev_node = null;
		end;
		else if mowse_info_ptr -> mowse_info.
		     message_manager_info.tail_list_ptr = tn_ptr
		then do;			    /* delete from tail of list */
		     mowse_info_ptr -> mowse_info.
			message_manager_info.tail_list_ptr =
			tn_ptr -> message_node.prev_node;
		     if tn_ptr -> message_node.next_node ^= null then
			tn_ptr -> message_node.prev_node
			     -> message_node.next_node = null;
		end;
		else do;			    /* delete from middle of list */
		     tn_ptr -> message_node.prev_node
			-> message_node.next_node = tn_ptr
			-> message_node.next_node;
		     tn_ptr -> message_node.next_node
			-> message_node.prev_node = tn_ptr
			-> message_node.prev_node;
		end;

		free xtn;
		xtn_ptr = null;

/* : Send the last part of message to application buffer */

		message_ptr = p_msg_ptr;
		message_len = p_msg_len;

		call append_inbuff_ (p_mcb_ptr,
		     addr (message_ptr -> last_message.data.data_buf),
		     message_len - 5, p_code);
	     end;
	end;

%page;
/* INCLUDE FILES */
%include mowse;
%include mowse_mcb;
%include mowse_info;
%include mowse_messages;

/* : END */
     end;




		    message_parser_.pl1             08/07/87  1554.4rew 08/07/87  1454.8       30168



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

/****^  HISTORY COMMENTS:
  1) change(86-08-27,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
message_parser_:
     proc (p_mowse_mcb_ptr, p_msg_len, p_msg_ptr, p_ecode);

/* : PROGRAM FUNCTION

Determine the destination of the message depending on the major capability
number and direct control appropriately.
*/

/* : NOTES
*/


/* INPUT PARAMETERS */
dcl p_mowse_mcb_ptr	       ptr parameter;	    /* mcb of mowse_io_ */
dcl p_msg_len	       fixed bin (17) parameter;  /* Length of message */
dcl p_msg_ptr	       ptr parameter;	    /* Pointer to message */

/* OUTPUT PARAMETERS */
dcl p_ecode	       fixed bin (35) parameter;  /* Error code */


/* EXTERNAL CALLS */
dcl external_mowse_	       entry (ptr, fixed bin, fixed bin, ptr, fixed bin,
		       fixed bin (35));
dcl internal_mowse_	       entry (ptr, fixed bin, fixed bin, ptr,
		       fixed bin (35));


/* MISC VARIABLES */
dcl msg_type	       fixed bin;		    /* See send_mowse_message.pl1 */
dcl system	       fixed bin (17);
dcl major		       fixed bin (17);
dcl minor		       fixed bin (17);


/* CONDITIONS */


/* BUILTINS */
dcl rank		       builtin;


/**/

/* INITIALIZATION */

	p_ecode = 0;
	message_ptr = p_msg_ptr;
	message_len = p_msg_len;
	msg_type = rank (message_ptr -> event_message.header.msg_type);

	if msg_type = CONTINUE then do;
	     system =
		rank (message_ptr -> more_remaining_message.header.system);
	     major =
		rank (message_ptr -> more_remaining_message.header.major);
	     minor =
		rank (message_ptr -> more_remaining_message.header.minor);
	end;
	else if msg_type = MORE then do;
	     system =
		rank (message_ptr -> request_more_message.header.system);
	     major =
		rank (message_ptr -> request_more_message.header.major);
	     minor = -1;
	end;
	else do;
	     system = rank (message_ptr -> last_message.header.system);
	     major = rank (message_ptr -> last_message.header.major);
	     minor = rank (message_ptr -> last_message.header.minor);
	end;

/* : if major = INTERNAL then handle internal message */

	if (major = INTERNAL) then
	     call internal_mowse_ (p_mowse_mcb_ptr, message_len, minor,
		message_ptr, p_ecode);

/* : else handle message destined for some capability */

	else do;
	     call external_mowse_ (p_mowse_mcb_ptr, major, minor,
		message_ptr, message_len, p_ecode);
	     return;
	end;

%page;

/* INCLUDE FILES */
%include mowse;
%include mowse_messages;
%include mowse_info;

/* : END message_parser_ */
     end message_parser_;




		    mowse_error_handler_.pl1        08/07/87  1554.3rew 08/07/87  1454.8       75357



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

/****^  HISTORY COMMENTS:
  1) change(86-09-24,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
mowse_error_handler_:
     proc (p_mcb_ptr, p_cat_index, p_minor);


/* : PROGRAM FUNCTION

Clean up the CAT tables when an application experiences a fatal error.
*/

/* : NOTES
*/


/* INPUT PARAMETERS */
dcl p_mcb_ptr	       ptr;		    /* Pointer to caller mcb */
dcl p_cat_index	       fixed bin parameter;	    /* capabilitiy number of application */
dcl p_minor	       fixed bin parameter;	    /* minor to be executed */


/* OUTPUT PARAMETERS */


/* MISC VARIABLES */
dcl msg_len	       fixed bin;		    /* message length */
dcl msg_ptr	       ptr;		    /* condition message (not set since area is null) */
dcl cap_id	       fixed bin;		    /* capabilities index into CAT */
dcl cap_id_byte	       char;		    /* byte containing cap_id (char) */
dcl stack_ptr	       ptr;		    /*  Pointer to condition stack frame */
dcl code		       fixed bin (35);	    /* Error code */
dcl mowse_info_ptr	       ptr;		    /* Pointer to mowse info structure */
dcl 01 temp_mcb	       like mcb based (temp_mcb_ptr);
					    /* temporary mcb overlay */
dcl temp_mcb_ptr	       ptr;		    /* Pointer to temp mcb */
dcl temp_ptr	       ptr;		    /* Pointer to temporary buffers */
dcl temp_inbuff	       char (mowse_info_ptr
		       -> mowse_info.local_cat (p_cat_index).mcb_ptr
		       -> mcb.inbuff_data_length) based (temp_ptr);
					    /* temp buffer overlay */
dcl condition_message      char (1200) based (msg_ptr);
					    /* conditon message buffer */
dcl destination	       fixed bin;		    /* destination message */
dcl cap_name	       char (32) varying;	    /* capabilities name */
dcl system_free_area       area based (system_free_area_ptr);
					    /* area allocated in system space */
dcl system_free_area_ptr   ptr;		    /* Pointer to system free area */


/* STRUCTURES */


/* SYSTEM CALLS */
dcl ioa_$ioa_switch	       entry () options (variable);
dcl condition_interpreter_ entry (ptr, ptr, fixed bin, fixed bin, ptr,
		       char (*), ptr, ptr);
dcl ioa_		       entry () options (variable);
dcl find_condition_frame_  entry (ptr) returns (ptr);
dcl find_condition_info_   entry (ptr, ptr, fixed bin (35));
dcl get_system_free_area_  entry () returns (ptr);


/* SYSTEM CALL SUPPORT */


/* EXTERNAL CALLS */
dcl get_mowse_info_ptr_    entry (ptr, ptr, fixed bin (35));
dcl capability_$pack       entry (fixed bin, fixed bin, fixed bin,
		       fixed bin (35));
dcl send_msg_	       entry (ptr, fixed bin, fixed bin, ptr,
		       fixed bin, fixed bin, fixed bin (35));
dcl release_outbuffer_     entry (ptr);


/* EXTERNAL CALL SUPPORT */


/* BUILTINS */
dcl stackframeptr	       builtin;
dcl null		       builtin;
dcl addr		       builtin;
dcl byte		       builtin;
dcl substr	       builtin;


/* CONDITIONS */
dcl cleanup	       condition;


/* CONSTANTS */


/**/
/* INITIALIZATION */

	msg_ptr = null;
	stack_ptr = null;
	system_free_area_ptr = get_system_free_area_ ();
	condition_info_ptr = null;
	msg_len = -1;
	cap_id_byte = byte (p_cat_index);
	cap_id = p_cat_index;

	on cleanup
	     begin;
	     if condition_info_ptr ^= null then do;
		free condition_info_ptr -> condition_info;
		condition_info_ptr = null;
	     end;
	     if msg_ptr ^= null then do;
		free msg_ptr -> condition_message;
		msg_ptr = null;
	     end;
	end;

	allocate condition_info in (system_free_area)
	     set (condition_info_ptr);
	call get_mowse_info_ptr_ (p_mcb_ptr, mowse_info_ptr, code);

	if mowse_info_ptr -> mowse_info.mowse_flags.error_handled
	     ^= "0"b then
	     return;
	mowse_info_ptr -> mowse_info.mowse_flags.error_handled = "1"b;

/* : If MOWSE didn't catch that the major was invalid then
     indicatea fatal capability error */

	if p_cat_index < INTERNAL | p_cat_index > MAXIMUM_CAT_ENTRY
	then do;
	     call ioa_ ("^/MULTICS MOWSE:FATAL CAPABILITY ERROR [1]");
	     mowse_info_ptr -> mowse_info.mowse_flags.error_handled = "0"b;
	     return;
	end;

/* : If the p_cat_index is INTERNAL then initiate cleanup */

	if p_cat_index = INTERNAL then do;
	     call ioa_ ("^/MULTICS MOWSE:FATAL CAPABILITY ERROR [2]");
	     mowse_info_ptr -> mowse_info.mowse_flags.error_handled = "0"b;
	     return;
	end;

	if mowse_info_ptr -> mowse_info.local_cat (p_cat_index).mcb_ptr
	     = null
	then do;
	     call ioa_ ("^/MULTICS MOWSE:FATAL CAPABILITY ERROR [3]");
	     mowse_info_ptr -> mowse_info.mowse_flags.error_handled = "0"b;
	     return;
	end;

/* : else Free space allocated for application is system space */

	temp_ptr = mowse_info_ptr
	     -> mowse_info.local_cat (p_cat_index).mcb_ptr -> mcb.inbuff;

	if temp_ptr ^= null then do;
	     free temp_inbuff;
	     temp_ptr = null;
	     mowse_info_ptr
		-> mowse_info.local_cat (p_cat_index).mcb_ptr
		-> mcb.inbuff = null;
	end;

	call release_outbuffer_
	     (mowse_info_ptr -> mowse_info.local_cat (p_cat_index).mcb_ptr);

/* : Send a message to the remote system to update the CAT */

	cap_name = mowse_info_ptr
	     -> mowse_info.local_cat (p_cat_index).mcb_ptr
	     -> mcb.capability_name;

	call capability_$pack (REMOTE_SYSTEM, INTERNAL, destination,
	     code);
	call send_msg_
	     ((mowse_info_ptr -> mowse_info.local_cat (p_cat_index).mcb_ptr),
	     destination, DELETE_FROM_REMOTE_CAT, addr (cap_id_byte), 1, BG,
	     code);

/* : Send a background message to notify the user */

	stack_ptr = find_condition_frame_ (stackframeptr);
	call find_condition_info_ (stack_ptr, condition_info_ptr, code);
	if code ^= 0 | condition_info_ptr = null then do;
	     call ioa_ ("^/MULTICS MOWSE:FATAL CAPABILITY ERROR [4]");
	     mowse_info_ptr -> mowse_info.mowse_flags.error_handled = "0"b;
	     return;
	end;

	call condition_interpreter_ (system_free_area_ptr, msg_ptr,
	     msg_len, 1, condition_info_ptr -> condition_info.mc_ptr,
	     (condition_info_ptr -> condition_info.condition_name),
	     condition_info_ptr -> condition_info.wc_ptr,
	     condition_info_ptr -> condition_info.info_ptr);

	if msg_ptr ^= null then do;
	     call ioa_ ("^a",
		substr (msg_ptr -> condition_message, 1, msg_len));
	     if (mowse_info_ptr -> mowse_info.mowse_flags.trace = "1"b) then
		call ioa_$ioa_switch (mowse_info_ptr
		     -> mowse_info.mowse_flags.trace_file_iocb, "^a",
		     substr (msg_ptr -> condition_message, 1, msg_len));
	end;

	call ioa_ (
	     "MULTICS MOWSE: Terminating capability ^a [^d:^d:^d]",
	     cap_name, LOCAL_SYSTEM, p_cat_index, p_minor);
	if (mowse_info_ptr -> mowse_info.mowse_flags.trace = "1"b) then
	     call ioa_$ioa_switch (mowse_info_ptr
		-> mowse_info.mowse_flags.trace_file_iocb,
		"MULTICS MOWSE: Terminating capability ^a [cap_num = ^d] on minor ^d",
		cap_name, p_cat_index, p_minor);

/* Free the memory associated with the mcb */

	if p_cat_index > INTERNAL & p_cat_index <= MAXIMUM_CAT_ENTRY then do;
	     temp_mcb_ptr = mowse_info_ptr
		-> mowse_info.local_cat (p_cat_index).mcb_ptr;
	     if temp_mcb_ptr ^= null then do;
		free temp_mcb;
		temp_mcb_ptr = null;
		mowse_info_ptr
		     -> mowse_info.local_cat (p_cat_index).mcb_ptr = null;
	     end;
	end;

	free condition_info_ptr -> condition_info;
	condition_info_ptr = null;
	if msg_ptr ^= null then do;
	     free msg_ptr -> condition_message;
	     condition_info_ptr = null;
	end;
	mowse_info_ptr -> mowse_info.mowse_flags.error_handled = "0"b;

%page;
/* INCLUDE FILES */
%include condition_info;
%include mowse;
%include mowse_info;
%include mowse_mcb;
%include mowse_messages;

/* : END */
     end;




		    mowse_io_.pl1                   01/24/89  0854.8rew 01/24/89  0847.0      656082



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

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
mowse_io_:
     proc ();


/* PROGRAM FUNCTION

This is the main driver for "mowse_io_" module which includes I/O protocols
between a user's process on Multics and a Personal Computer (PC) through which
the user has logged into using the PC version of MOWSE.  The following I/O
system calls are provided for this module:

   attach		mowse_io_$mowse_io_attach
   close		mowse_io_$mowse_io_close
   close_file	mowse_io_$mowse_io_close_file
   control	mowse_io_$mowse_io_control
   detach_iocb	mowse_io_$mowse_io_detach_iocb
   get_chars	mowse_io_$mowse_io_get_chars
   get_line	mowse_io_$mowse_io_get_line
   modes		mowse_io_$mowse_io_modes
   open		mowse_io_$mowse_io_open
   open_file	mowse_io_$mowse_io_open_file
   put_chars	mowse_io_$mowse_io_put_chars
*/


/* NOTES
*/

/****^  HISTORY COMMENTS:
  1) change(87-04-16,Flegel), approve(87-06-23,MCR7649),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(87-08-18,LJAdams), approve(87-08-18,PBF7649),
     audit(87-08-18,Wallman), install(87-08-18,MR12.1-1091):
     Changed references to editing_chars_version to editing_chars_version_3.
  3) change(88-10-06,Flegel), approve(88-11-16,MCR8023), audit(88-12-12,Lee),
     install(89-01-24,MR12.3-1012):
     phx21215 - Changed (read write)_status control to use a mowse created
                event channel as the channel information returned.  This
                channel will have events transmitted on it when foregrond data
                is processed.
              - Added control order "get_event_channel".
                                                   END HISTORY COMMENTS */

/* INPUT PARAMETERS */
dcl p_newmodes	       char (*) parameter;	    /* Modes string */
dcl p_descrip	       char (*) parameter;	    /* Open description */
dcl p_unused	       bit (1) parameter;
dcl p_mode	       fixed bin parameter;	    /* Open mode */
dcl p_buf_len	       fixed bin (21) parameter;  /* Buffer length */
dcl p_buf_ptr	       ptr parameter;	    /* buffer pointer */
dcl p_order	       char (*) parameter;	    /* Control order */
dcl p_info_ptr	       ptr parameter;	    /* Control info pointer */
dcl p_options	       (*) char (*) var parameter;/* Option array */
dcl p_loud	       bit (1) aligned parameter; /* Turn on error printing here */
dcl p_iocb_ptr	       ptr parameter;	    /* IOCB structure pointer */

/* OUTPUT PARAMETERS */
dcl p_oldmodes	       char (*) parameter;	    /* Old modes string */
dcl p_chars_read	       fixed bin (21) parameter;
dcl p_code	       fixed bin (35) parameter;  /* Error code */

/* MISC VARIABLES */
dcl new_modes	       char (512);		    /* Mode string */
dcl confirmed_disconnect   bit (1);		    /* If disconnect will require confirmation */
dcl printer_msg	       char (5);		    /* POx00 message to WSTERM */
dcl order		       char (32) var;	    /* Control order */
dcl pl		       fixed bin;		    /* Page length */
dcl ll		       fixed bin;		    /* Line length */
dcl erkl_esc	       char (3);		    /* Erase, Kill, Escape chars */
dcl i		       fixed bin;
dcl iocb_ptr	       ptr;		    /* IOCB */
dcl system_free_area       area based (system_free_area_ptr);
dcl system_free_area_ptr   ptr;
dcl ind		       fixed bin;		    /* Index counter */
dcl target_iocb_ptr	       ptr;
dcl mask		       bit (36) aligned;	    /* IPS mask */
dcl mio_data_ptr	       ptr;		    /* mowse_io_ data */

/* STRUCTURES */
dcl fixedbin21	       fixed bin (21) based;
dcl fixedbin71al	       fixed bin (71) aligned based;
dcl 01 ipc_arg	       like ipc_create_arg_structure aligned automatic;
dcl 01 trans	       like cv_trans_struc aligned automatic;
dcl ll_overlay	       fixed bin (9) based;	    /* Info for line_length order */
dcl buf		       (p_buf_len) char (1) based (p_buf_ptr);
dcl 01 mio_data	       like mowse_io_data based (mio_data_ptr);
dcl 01 fatal_error_info    aligned,
       02 version	       fixed bin,		    /* Must be 0 */
       02 status_code      fixed bin (35);	    /* Error code */

/* SYSTEM CALLS */
dcl ipc_$create_event_channel entry (ptr, fixed bin (71), fixed bin (35));
dcl clock_	       entry () returns (fixed bin (71));
dcl ttt_info_$initial_string entry (char (*), char (*) var, fixed bin (35));
dcl ttt_info_$modes	       entry (char (*), char (*), fixed bin (35));
dcl ipc_$delete_ev_chn     entry (fixed bin (71), fixed bin (35));
dcl sct_manager_$get       entry (fixed bin, ptr, fixed bin (35));
dcl sct_manager_$set       entry (fixed bin, ptr, fixed bin (35));
dcl mode_string_$get_mode  entry (char (*), char (*), ptr, fixed bin (35));
dcl mode_string_$parse     entry (char (*), ptr, ptr, fixed bin (35));
dcl ipc_$create_ev_chn     entry (fixed bin (71), fixed bin (35));
dcl get_process_id_	       entry () returns (bit (36));
dcl iox_$modes	       entry (ptr, char (*), char (*), fixed bin (35));
dcl iox_$put_chars	       entry (ptr, ptr, fixed bin (21), fixed bin (35));
dcl iox_$get_line	       entry (ptr, ptr, fixed bin (21), fixed bin (21), 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 terminate_process_     entry (char (*), ptr);
dcl iox_$propagate	       entry (ptr);
dcl hcs_$reset_ips_mask    entry (bit (36) aligned, bit (36) aligned);
dcl com_err_	       entry () options (variable);
dcl hcs_$set_ips_mask      entry (bit (36) aligned, bit (36) aligned);
dcl get_system_free_area_  entry () returns (ptr);
dcl iox_$look_iocb	       entry (char (*), ptr, fixed bin (35));

/* SYSTEM CALL SUPPORT */
dcl error_table_$no_initial_string fixed bin (35) ext static;
dcl error_table_$unsupported_operation fixed bin (35) ext static;
dcl error_table_$unimplemented_version fixed bin (35) ext static;
dcl error_table_$null_info_ptr fixed bin (35) ext static;
dcl error_table_$long_record fixed bin (35) ext static;
dcl iox_$err_no_operation  entry () options (variable);
dcl error_table_$bad_mode  fixed bin (35) ext static;
dcl iox_$err_not_open      entry () options (variable);
dcl error_table_$unable_to_do_io fixed bin (35) ext static;
dcl error_table_$invalid_device fixed bin (35) ext static;
dcl error_table_$wrong_no_of_args fixed bin (35) ext static;
dcl error_table_$not_detached fixed bin (35) ext static;

/* EXTERNAL CALLS */
dcl ws_timer_$reset_connect entry ();
dcl ws_debug_$line	       entry () options (variable);
dcl ws_packet_transmitter_$terminate entry (ptr);
dcl ws_packet_transmitter_$local_data entry (ptr, fixed bin, ptr, fixed bin (21), fixed bin);
dcl ws_packet_dispatcher_$terminate entry ();
dcl ws_packet_dispatcher_$initialize entry (ptr, fixed bin (35)
		       );
dcl ws_timer_$queue_sleeper entry (fixed bin (71));
dcl ws_$find_capability_number entry (char (*), fixed bin, fixed bin, fixed bin (35));
dcl capability_$pack       entry (fixed bin, fixed bin, fixed bin, fixed bin (35));
dcl terminate_mowse_       entry (ptr, fixed bin (35));
dcl bound_process_env_$err_no_operation entry options (variable);
dcl ws_timer_$terminate    entry ();
dcl ws_timer_$reset_disconnect entry ();
dcl ws_timer_$initialize   entry (ptr);
dcl ws_channel_$wait_block entry (ptr, ptr, char (*), ptr);
dcl ws_tools_$reset_data   entry (ptr);
dcl ws_packet_transmitter_$supervisory entry (ptr, char (1));
dcl ws_channel_$wait_wakeup entry (ptr, ptr);
dcl ws_packet_transmitter_$reset entry (ptr);
dcl ws_packet_transmitter_$initialize entry (ptr, ptr, fixed bin (35));
dcl ws_debug_$trace_open   entry (ptr, ptr, fixed bin (35));
dcl ws_debug_$trace_close  entry (ptr, fixed bin (35));
dcl ws_debug_$debug_open   entry (ptr, ptr, fixed bin (35));
dcl ws_debug_$debug_close  entry (ptr, fixed bin (35));
dcl mowse_io_call_control_ entry (ptr, char (*), ptr, fixed bin (35));
dcl ws_packet_receiver_$sus_handler entry ();
dcl ws_packet_receiver_$terminate entry (fixed bin (35));
dcl ws_packet_receiver_$initialize entry (ptr, ptr, fixed bin (35));
dcl ws_packet_transmitter_$data entry (ptr, fixed bin, ptr, fixed bin (21), fixed bin);

/* EXTERNAL CALL SUPPORT */
dcl ws_error_$unsupported_ws_terminal
		       fixed bin (35) ext static;
dcl ws_error_$already_sleeping fixed bin (35) ext static;
dcl ws_error_$invalid_sleep_interval fixed bin (35) ext static;
dcl ws_error_$inconsistent_mowse_tables fixed bin (35) ext static;

/* BUILTINS */
dcl ltrim		       builtin;
dcl divide	       builtin;
dcl convert	       builtin;
dcl codeptr	       builtin;
dcl byte		       builtin;
dcl addr		       builtin;
dcl rank		       builtin;
dcl rtrim		       builtin;
dcl mod		       builtin;
dcl unspec	       builtin;
dcl substr	       builtin;
dcl length	       builtin;
dcl index		       builtin;
dcl null		       builtin;
dcl hbound	       builtin;

/* CONDITIONS */
dcl any_other	       condition;
dcl cleanup	       condition;

/* CONSTANTS */
dcl False		       bit (1) int static options (constant) init ("0"b);
dcl True		       bit (1) int static options (constant) init ("1"b);
dcl Stream_input_output_mode fixed bin int static options (constant) init (3);

/**/

/* INITIALIZATION */

/* MAIN */

	return;

/**/

%page;

/* INTERNAL ENTRIES */


/* *** Entry: mowse_io_attach - Internal entry for mowse_io_  *** */

mowse_io_attach:
     entry (p_iocb_ptr, p_options, p_loud, p_code);


/* ENTRY FUNCTION

Attach the MOWSE io module and allocate the MOWSE data space from system
free area.
*/

/* NOTES

MOWSE will not be up until the call to iox_$open is performed by the caller.
*/

	call setup_entry ();
	mask = ""b;
	target_iocb_ptr = null;

/* If the current iocb is not detached, error! */

	if iocb_ptr -> iocb.attach_descrip_ptr ^= null then do;
	     p_code = error_table_$not_detached;
	     if p_loud then
		call com_err_ (p_code, "mowse_io_");
	     return;
	end;

/* Check number of arguments */

	if hbound (p_options, 1) ^= 1 then do;
	     p_code = error_table_$wrong_no_of_args;
	     if p_loud then
		call com_err_ (p_code, "mowse_io_");
	     return;
	end;

/* Get an iocb for mowse_io_ */

	call iox_$look_iocb ((p_options (1)), target_iocb_ptr, p_code);
	if p_code ^= 0 then do;
	     if p_loud then
		call com_err_ (p_code, "mowse_io_");
	     return;
	end;

/* Is the device valid */

	if target_iocb_ptr -> iocb.attach_descrip_ptr = null then do;
	     p_code = error_table_$invalid_device;
	     if p_loud then
		call com_err_ (p_code, "mowse_io_");
	     return;
	end;

/* Is the description valid */

	if target_iocb_ptr -> iocb.open_descrip_ptr = null then do;
	     p_code = error_table_$invalid_device;
	     if p_loud then
		call com_err_ (p_code, "mowse_io_");
	     return;
	end;

/* Get attach data space from system free */

	mio_data_ptr = null;
	system_free_area_ptr = null;
	on cleanup call clean_up_mio_data ();
	system_free_area_ptr = get_system_free_area_ ();
	allocate mio_data in (system_free_area) set (mio_data_ptr);
	unspec (mio_data) = ""b;

/* Set options on the attach description */

	ind = index (p_options (1), " ");
	if ind = 0 then
	     ind = length (p_options (1));
	mio_data.attach_descrip =
	     "mowse_io_ " || substr (p_options (1), 1, ind);
	do i = 2 to hbound (p_options, 1);
	     mio_data.attach_descrip = mio_data.attach_descrip || " ";
	     mio_data.attach_descrip
		= mio_data.attach_descrip || p_options (i);
	end;

/* Initialize the fields of mowse_io_data (attach data) */

	mio_data.iocb_ptr = target_iocb_ptr;
	mio_data.default_iocb_ptr = iocb_ptr;
	call initialize_attach_data (p_code);
	if p_code ^= 0 then do;
	     if p_loud then
		call com_err_ (p_code, "mowse_io_");
	     call clean_up_mio_data ();
	     return;
	end;

/* Set up the iocb for mowse_io_ */

	on any_other begin;
	     fatal_error_info.version = 0;
	     fatal_error_info.status_code = error_table_$unable_to_do_io;
	     call terminate_process_ ("fatal_error", addr (fatal_error_info));
	end;

	call hcs_$set_ips_mask (""b, mask);
	iocb_ptr -> iocb.attach_data_ptr = mio_data_ptr;
	iocb_ptr -> iocb.attach_descrip_ptr = addr (mio_data.attach_descrip);
	iocb_ptr -> iocb.detach_iocb = mowse_io_detach_iocb;
	iocb_ptr -> iocb.open = mowse_io_open;
	iocb_ptr -> iocb.open_file = mowse_io_open_file;
	iocb_ptr -> iocb.close = iox_$err_not_open;
	iocb_ptr -> iocb.close_file = iox_$err_not_open;
	call iox_$propagate (iocb_ptr);
	call hcs_$reset_ips_mask (mask, mask);
	revert any_other;

	return;

/**/

/* *** Entry: mowse_io_close - Internal entry for mowse_io_  *** */

/* ENTRY FUNCTION

There are two entries into this section, dtm (detach_mowse) calls with options
(confirmed_disconnect) and other routines call without options, or to close.
*/

/* NOTES
*/

mowse_io_close:
     entry (p_iocb_ptr, p_code);

	call setup_entry ();

	confirmed_disconnect = False;

	goto JOIN_CLOSE;

mowse_io_close_file:
     entry (p_iocb_ptr, p_descrip, p_code);

	call setup_entry ();

	confirmed_disconnect = False;
	if length (p_descrip) > 0 then
	     confirmed_disconnect = (p_descrip = "confirmed_disconnect");

JOIN_CLOSE:

	mask = ""b;

	mio_data.disconnect_active = True;

/* Check the sus_ flag to determine if this process has been disconnected,
   if so, then DO NOT TELL THE TERMINAL as it is no longer valid otherwise,
   perform the necessary to notify the terminal */

	if ^mio_data.sus_data.activated then do;
	     if mio_data.info_ptr ^= null then do;
		call terminate_mowse_ (mio_data.info_ptr, (0));
		if mio_data.info_ptr ^= null then do;
		     free mio_data.info_ptr -> mowse_info;
		     mio_data.info_ptr = null;
		end;
	     end;

/* Perform the requested disconnect type */

	     call disconnect (confirmed_disconnect);

/* Turn off the the protocol stuff */

	     call ws_packet_receiver_$terminate ((0));
	     call ws_timer_$terminate ();
	     call ws_packet_dispatcher_$terminate ();
	     call ws_packet_transmitter_$terminate (mio_data_ptr);

/* MF - phx21215 - Return the foreground events channel to the system */

	     call ipc_$delete_ev_chn (
		mio_data.channel_info.foreground.channel, (0));

/* Close the trace and debug mechanisms */

	     call ws_debug_$debug_close (mio_data.debug_iocb_ptr, (0));
	     call ws_debug_$trace_close (mio_data.trace_iocb_ptr, (0));
	end;

/* Adjust the IOCB */

	on any_other begin;
	     fatal_error_info.version = 0;
	     fatal_error_info.status_code = error_table_$unable_to_do_io;
	     call terminate_process_ ("fatal_error", addr (fatal_error_info));
	end;

/* Must be masked */

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

/* Replace the sus_signal_handler_ to what it use to be */

	if ^mio_data.sus_data.activated then do;
	     call sct_manager_$set (susp_sct_index,
		mio_data.sus_data.sus_entry, p_code);
	     if p_code ^= 0 then do;
		call hcs_$reset_ips_mask (mask, mask);
		return;
	     end;
	end;

/* Fix iocb data */

	call initialize_iocb (iocb_ptr -> iocb.actual_iocb_ptr);
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.open_descrip_ptr
	     = null;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.detach_iocb
	     = mowse_io_detach_iocb;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.open
	     = mowse_io_open;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.open_file
	     = mowse_io_open_file;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.close_file
	     = iox_$err_not_open;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.close
	     = iox_$err_not_open;
	call iox_$propagate (iocb_ptr);

	if ^mio_data.sus_data.activated then
	     call iox_$modes (mio_data.iocb_ptr, mio_data.old_modes, "", (0));

	call hcs_$reset_ips_mask (mask, mask);
	revert any_other;

	if ^mio_data.sus_data.activated then
	     call iox_$control (mio_data.iocb_ptr, "quit_enable", null, (0));
	return;

/**/

/* *** Entry: mowse_io_control - Internal entry for mowse_io_  *** */

mowse_io_control:
     entry (p_iocb_ptr, p_order, p_info_ptr, p_code);


/* ENTRY FUNCTION

Handle the following iox_$control orders:

      MOWSE Specific:
      ---------------

	debug_off			debug_on
	flush_subchannel		get_mowse_info
	get_terminal_emulator_state	put_to_sleep
	send_local_message		send_message
	set_video_mode		store_mowse_info
	trace_off			trace_on

      Multics Specific (requiring special support):
      ---------------------------------------------

	abort		 get_editing_chars
	get_event_channel	 get_input_conversion
	io_call		 io_call_af
	line_length	 printer_off
	printer_on	 quit_disable
	quit_enable	 reconnection
	resetread		 resetwrite
	read_status	 set_default_modes
	set_editing_chars	 set_input_conversion
	set_term_type	 write_status
*/

/* NOTES
*/

	call setup_entry ();
	order = ltrim (rtrim (p_order));

/* <<<<<<<<<<<<< MOWSE Specific Control Orders >>>>>>>>>>>>>> */

/* debug_off */

	if order = "debug_off" then
	     call ws_debug_$debug_close (mio_data.debug_iocb_ptr, p_code);

/* debug_on */

	else if order = "debug_on" then do;
	     call ws_debug_$debug_open (p_info_ptr, mio_data.debug_iocb_ptr,
		p_code);
	     if p_code = 0 then
		call ws_debug_$line (mio_data.debug_iocb_ptr,
		     "Process ID: ^b^/"
		     || "Channel ID: user_input^9x^24d^/"
		     || "^12xpacket_receiver^4x^24d^/"
		     || "^12xpacket_transmitter ^24d^/"
		     || "Dispatcher: async channel^6x^24d^/"
		     || "^12xsync channel^7x^24d^/^/",
		     mio_data.channel_info.process_id,
		     mio_data.channel_info.user_input.channel,
		     mio_data.channel_info.packet_receiver.channel,
		     mio_data.channel_info.packet_transmitter.channel,
		     mio_data.channel_info.packet_dispatcher.async_channel,
		     mio_data.channel_info.packet_dispatcher.sync_channel);
	end;

/* flush_subchannel */

	else if order = "flush_subchannel" then
	     call flush_subchannel (p_info_ptr, p_code);

/* get_mowse_info */

	else if order = "get_mowse_info" then do;
	     if ^check_validity (p_info_ptr, mowse_io_info_version_1, p_code) then
		return;

	     p_info_ptr -> mowse_io_info.mcb_ptr = mio_data.mcb_ptr;
	     p_info_ptr -> mowse_io_info.info_ptr = mio_data.info_ptr;
	end;

/* get_terminal_emulator_state */

	else if order = "get_terminal_emulator_state" then
	     call get_emulator_state (p_info_ptr, p_code);

/* put_to_sleep */

	else if order = "put_to_sleep" then
	     call insert_sleeper (p_info_ptr, p_code);

/* send_local_message */

	else if order = "send_local_message" then do;
	     if ^check_validity (p_info_ptr, mowse_io_info_version_1, p_code) then
		return;

	     call ws_packet_transmitter_$local_data (mio_data_ptr,
		p_info_ptr -> mowse_io_message.channel,
		p_info_ptr -> mowse_io_message.io_message_ptr,
		p_info_ptr -> mowse_io_message.io_message_len,
		NO_MINOR);
	end;

/* send_message */

	else if order = "send_message" then do;
	     if ^check_validity (p_info_ptr, mowse_io_info_version_1, p_code) then
		return;

	     call ws_packet_transmitter_$data (mio_data_ptr,
		p_info_ptr -> mowse_io_message.channel,
		p_info_ptr -> mowse_io_message.io_message_ptr,
		p_info_ptr -> mowse_io_message.io_message_len,
		NO_MINOR);
	end;

/* set_video_mode */

	else if order = "set_video_mode" then do;
	     if ^check_validity (p_info_ptr, mowse_io_info_version_1, p_code) then
		return;

	     mio_data.ws.flags.video_mode
		= p_info_ptr -> mowse_io_set_video_mode_info.mode;
	     substr (unspec (mio_data.WSTERM_modes (WST_MODES)), 9, 1)
		= mio_data.ws.flags.video_mode;
	     call send_terminal_modes (byte (0) || byte (0) || byte (0), -1, -1);
	end;

/* store_mowse_info */

	else if order = "store_mowse_info" then do;
	     if ^check_validity (p_info_ptr, mowse_io_info_version_1, p_code) then
		return;

	     mio_data.info_ptr = p_info_ptr -> mowse_io_store_info.info_ptr;
	     mio_data.info_stored = True;
	     mio_data.mcb_ptr -> mcb.mowse_info_ptr = mio_data.info_ptr;
	end;

/* trace_off */

	else if order = "trace_off" then do;
	     call ws_debug_$trace_close (mio_data.trace_iocb_ptr, p_code);
	     mio_data.info_ptr -> mowse_info.mowse_flags.trace = False;
	     mio_data.info_ptr -> mowse_info.mowse_flags.trace_file_iocb
		= null;
	end;

/* trace_on */

	else if order = "trace_on" then do;
	     call ws_debug_$trace_open (p_info_ptr, mio_data.trace_iocb_ptr,
		p_code);
	     if p_code = 0 then do;
		mio_data.info_ptr -> mowse_info.mowse_flags.trace = True;
		mio_data.info_ptr -> mowse_info.mowse_flags.trace_file_iocb
		     = mio_data.trace_iocb_ptr;
	     end;
	end;

/* <<<<<<<<<<<< Multics Specific Control Orders >>>>>>>>>>>>> */

/* abort */

	else if order = "abort" then
	     mio_data.user_input.out = mio_data.user_input.in;

/* get_editing_chars */

	else if order = "get_editing_chars" then do;
	     if ^check_validity_int (p_info_ptr, editing_chars_version_3, p_code) then
		return;

	     p_info_ptr -> editing_chars.kill = mio_data.WSTERM_modes (WST_KILL);
	     p_info_ptr -> editing_chars.erase = mio_data.WSTERM_modes (WST_ERASE);
	end;

/* MF - phx21215 - get_event_channel */

	else if order = "get_event_channel" then do;
	     p_info_ptr -> fixedbin71al
		= mio_data.channel_info.foreground.channel;
	end;

/* io_call, io_call_af */

	else if order = "io_call" | order = "io_call_af" then
	     call mowse_io_call_control_ (p_iocb_ptr, p_order, p_info_ptr,
		p_code);

/* line_length */

	else if order = "line_length" then do;
	     ll = convert (ll, p_info_ptr -> ll_overlay);
	     call send_terminal_modes ("", -1, ll);
	end;

/* printer_off */

	else if order = "printer_off" then do;
	     printer_msg = "POF" || byte (0) || byte (0);
	     call ws_packet_transmitter_$data (mio_data_ptr, FG,
		addr (printer_msg), convert (fixedbin21, MinPktLen),
		FG_CONTROL_MESSAGE);
	end;

/* printer_on */

	else if order = "printer_on" then do;
	     printer_msg = "PON" || byte (0) || byte (0);
	     call ws_packet_transmitter_$data (mio_data_ptr, FG,
		addr (printer_msg), convert (fixedbin21, MinPktLen),
		FG_CONTROL_MESSAGE);
	end;

/* quit_disable */

	else if order = "quit_disable" then
	     mio_data.switches.quit_enable = False;

/* quit_enable */

	else if order = "quit_enable" then
	     mio_data.switches.quit_enable = True;

/* reconnection */

	else if order = "reconnection" then
	     call iox_$control (mio_data.iocb_ptr, p_order, p_info_ptr,
		p_code);

/* resetread */

	else if order = "resetread" then
	     mio_data.user_input.in = mio_data.user_input.out;

/* resetwrite */

	else if order = "resetwrite" then
	     mio_data.switches.reset_write = True;

/* read_status */

	else if order = "read_status" then do;
	     if p_info_ptr = null then do;
		p_code = error_table_$null_info_ptr;
		return;
	     end;
	     p_info_ptr -> tty_read_status_info.event_channel
		= mio_data.channel_info.foreground.channel; /* MF - phx21215 */
	     p_info_ptr -> tty_read_status_info.input_pending
		= (mio_data.user_input.out ^= mio_data.user_input.in);
	end;

/* set_default_modes */

	else if order = "set_default_modes" then
	     call send_terminal_modes ("@#\", WST_INIT_PL, WST_INIT_LL);

/* set_editing_chars */

	else if order = "set_editing_chars" then do;
	     if ^check_validity_int (p_info_ptr, 1, p_code) then
		return;

	     call send_terminal_modes (
		p_info_ptr -> editing_chars.kill
		|| p_info_ptr -> editing_chars.erase
		|| byte (0),
		-1, -1);
	end;

/* set_input_conversion */

	else if order = "set_input_conversion" then do;
	     if ^check_validity_int (p_info_ptr, 1, p_code) then
		return;

	     trans.version = 1;
	     call iox_$control (mio_data.iocb_ptr, "get_input_conversion",
		addr (trans), p_code);
	     if p_code ^= 0 then
		return;
	     call send_terminal_modes (
		byte (0) || byte (0) || get_escape_char (addr (trans)),
		-1, -1);
	end;

/* set_term_type */

	else if order = "set_term_type" then
	     call set_terminal (p_info_ptr, p_code);

/* start */

	else if order = "start" then do;
	     mio_data.switches.start_issued = True;
	     call ws_channel_$wait_wakeup (mio_data_ptr,
		addr (mio_data.channel_info.user_input));
	     call iox_$control (mio_data.iocb_ptr, p_order, p_info_ptr,
		p_code);
	end;

/* write_status */

	else if order = "write_status" then do;
	     if p_info_ptr = null then do;
		p_code = error_table_$null_info_ptr;
		return;
	     end;
	     p_info_ptr -> tty_read_status_info.event_channel
		= mio_data.channel_info.foreground.channel; /* MF - phx21215 */
	     p_info_ptr -> tty_read_status_info.input_pending
		= (mio_data.user_input.out ^= mio_data.user_input.in);
	end;

/* Bad order? YES - reject it;  NO - pass to tty_ */

	else do;
	     do i = 1 to N_BAD_CONTROL;
		if order = MOWSE_IO_BAD_CONTROL (i) then do;
		     p_code = error_table_$unsupported_operation;
		     return;
		end;
	     end;

	     call iox_$control (mio_data.iocb_ptr, p_order, p_info_ptr,
		p_code);
	     return;
	end;

	return;

/**/

/* *** Entry: mowse_io_detach - Internal entry for mowse_io_  *** */

mowse_io_detach_iocb:
     entry (p_iocb_ptr, p_code);


/* ENTRY FUNCTION

Detach the mowse i/o module.
*/

/* NOTES
*/

	call setup_entry ();
	mask = ""b;

/* Get rid of used space */

	call clean_up_mio_data ();

/* Adjust the iocb */

	on any_other begin;
	     fatal_error_info.version = 0;
	     fatal_error_info.status_code = error_table_$unable_to_do_io;
	     call terminate_process_ ("fatal_error", addr (fatal_error_info));
	end;

	call hcs_$set_ips_mask (""b, mask);
	iocb_ptr -> iocb.attach_descrip_ptr = null;
	call iox_$propagate (iocb_ptr);
	call hcs_$reset_ips_mask (mask, mask);

	revert any_other;
	return;

/**/

/* *** Entry: mowse_io_get_chars - Internal entry for mowse_io_  *** */

mowse_io_get_chars:
     entry (p_iocb_ptr, p_buf_ptr, p_buf_len, p_chars_read, p_code);


/* ENTRY FUNCTION

Retrieve "interactive" data from the terminal buffer.
*/

/* NOTES

This routine is the counterpart of the PC routine "gettdata" which retrieves
data which is destined to be displayed on the crt.  In this case (since there
is no crt associated at the Multics end, it is usually destined to be
processed by the Multics as "raw" character data.
*/

	p_chars_read = 0;
	call setup_entry ();

/* Buffer large enough ? */

	if p_buf_len < 1 then
	     return;
	if p_buf_ptr = null then
	     return;

/* Block while no data is ready on user_input */

	mio_data.switches.start_issued = False;
	do while (mio_data.user_input.in = mio_data.user_input.out
	     & ^mio_data.switches.start_issued);

	     call ws_channel_$wait_block (mio_data_ptr,
		addr (mio_data.channel_info.user_input),
		"user_input (get_chars)", mio_data.debug_iocb_ptr);
	end;

/* If a start was issued to break the loop, then we're done */

	if mio_data.switches.start_issued then do;
	     mio_data.switches.start_issued = False;
	     return;
	end;

/* Load the caller's buffer */

	do while (p_chars_read < p_buf_len
	     & mio_data.user_input.in ^= mio_data.user_input.out);

	     p_chars_read = p_chars_read + 1;

	     buf (p_chars_read)
		= mio_data.user_input.queue (mio_data.user_input.out);

	     mio_data.user_input.out
		= mod (mio_data.user_input.out + 1,
		hbound (mio_data.user_input.queue, 1) + 1);
	end;

	return;

/**/

/* *** Entry: mowse_io_get_line - Internal entry for mowse_io_  *** */

mowse_io_get_line:
     entry (p_iocb_ptr, p_buf_ptr, p_buf_len, p_chars_read, p_code);


/* ENTRY FUNCTION

Retrieve one line of "interactive" data from the terminal buffer.
*/

/* NOTES

This routine is the counterpart of the PC routine "gettdata" which retrieves
data which is destined to be displayed on the crt.  In this case (since there
is no crt associated at the Multics end), it is usually destined to be
processed by the Multics end as "raw" character data.
*/

	p_chars_read = 0;
	call setup_entry ();

/* Supplied buffer large enough */

	if p_buf_len < 1 then
	     return;
	if p_buf_ptr = null then
	     return;

/* While there is still room in the supplied buffer */

	do while (p_chars_read < p_buf_len);

/* - While the buffer is empty
     -- Block until something is read from tty_ */

	     mio_data.switches.start_issued = False;
	     do while (mio_data.user_input.out = mio_data.user_input.in
		& ^mio_data.switches.start_issued);

		call ws_channel_$wait_block (mio_data_ptr,
		     addr (mio_data.channel_info.user_input),
		     "user_input (get_line)", mio_data.debug_iocb_ptr);
	     end;

/* - If start caused the loop to break, quit here */

	     if mio_data.switches.start_issued then do;
		mio_data.switches.start_issued = False;
		return;
	     end;

/* - Copy the character into the supplied buffer */

	     p_chars_read = p_chars_read + 1;
	     buf (p_chars_read) =
		mio_data.user_input.queue (mio_data.user_input.out);
	     mio_data.user_input.out
		= mod (mio_data.user_input.out + 1,
		hbound (mio_data.user_input.queue, 1) + 1);

/* - <LF> found then return */

	     if buf (p_chars_read) = LF then do;
		return;
	     end;
	end;

/* Too much data for supplied buffer */

	p_code = error_table_$long_record;
	return;

/**/

/* *** Entry: mowse_io_modes - Internal entry for mowse_io_  *** */

mowse_io_modes:
     entry (p_iocb_ptr, p_newmodes, p_oldmodes, p_code);


/* ENTRY FUNCTION

Handle the following iox_$modes orders:

	pl = nn;
	ll = nn;
	crecho
	lfecho
	more	(ignored)
	more_mode (ignored)

Remaining control orders are NOT acceptable as MOWSE needs full control over
the communications line, thus only "terminal description" modes are
acceptable.
*/

/* NOTES
*/

	call setup_entry ();

/* Parse the new_modes string and update the MOWSE modes and send the modes
   message */

	call get_new_modes (p_newmodes, p_oldmodes, erkl_esc, pl, ll, p_code);
	if p_code ^= 0 then do;
	     p_oldmodes = "";
	     return;
	end;

/* wake_tbl can only be altered by mowse, if it is specified, then
   initialization / termination is occuring and it is NOT to be sent */

	if index (p_newmodes, "wake_tbl") = 0 then
	     call send_terminal_modes (erkl_esc, pl, ll);

	return;

/**/

/* *** Entry: mowse_io_open_file - Internal entry for mowse_io_  *** */

/* ENTRY FUNCTION

Open MOWSE io module.  Performs all of the necessary functions that open MOWSE
IO; starts up the "tasking" (scheduler); and sends a reset to the "other"
MOWSE (PC) to tell it that this one is up and running.
*/

/* NOTES
*/

mowse_io_open:
     entry (p_iocb_ptr, p_mode, p_unused, p_code);

	call setup_entry ();
	open_struc_ptr = null;
	goto JOIN_OPEN;

mowse_io_open_file:
     entry (p_iocb_ptr, p_mode, p_descrip, p_unused, p_code);

	call setup_entry ();
	open_struc_ptr = null;

	if length (p_descrip) <= 0 then
	     goto JOIN_OPEN;

	open_struc_ptr = addr (p_descrip);

JOIN_OPEN:

	mask = ""b;

/* Check the requested mode setting */

	if p_mode ^= Stream_input_output_mode then do;
	     p_code = error_table_$bad_mode;
	     return;
	end;

/* Initialize the mowse_io_ iocb */

	on any_other begin;
	     fatal_error_info.version = 0;
	     fatal_error_info.status_code = error_table_$unable_to_do_io;
	     call terminate_process_ ("fatal_error", addr (fatal_error_info));
	end;

/* Must be masked */

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

/* Establish sus_signal_handler replacement */

	call sct_manager_$get (susp_sct_index, mio_data.sus_data.sus_entry,
	     p_code);
	if p_code ^= 0 then do;
	     call hcs_$reset_ips_mask (mask, mask);
	     return;
	end;

	call sct_manager_$set (susp_sct_index,
	     codeptr (ws_packet_receiver_$sus_handler), p_code);
	if p_code ^= 0 then do;
	     call hcs_$reset_ips_mask (mask, mask);
	     return;
	end;

/* Set up the iocb */

	call initialize_iocb (iocb_ptr -> iocb.actual_iocb_ptr);
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.close
	     = mowse_io_close;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.close_file
	     = mowse_io_close_file;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.control
	     = mowse_io_control;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.get_chars
	     = mowse_io_get_chars;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.get_line
	     = mowse_io_get_line;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.put_chars
	     = mowse_io_put_chars;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.modes
	     = mowse_io_modes;
	iocb_ptr -> iocb.open_descrip_ptr = addr (mio_data.open_descrip);
	mio_data.open_descrip = "stream_input_output";
	call iox_$propagate (iocb_ptr);
	call hcs_$reset_ips_mask (mask, mask);

	revert any_other;

/* Set the mcb.iocb_ptr to mowse_i/o */

	mio_data.mcb_ptr -> mcb.iocb_ptr = p_iocb_ptr;

/* Turn OFF quit processing */

	call iox_$control (mio_data.iocb_ptr, "quit_disable", null, (0));

/* Set the modes on the line */

	new_modes
	     = "force,^crecho,^lfecho,^echoplex,^tabecho,rawi,rawo";
	call iox_$modes (mio_data.iocb_ptr, rtrim (new_modes),
	     mio_data.old_modes, (0));

	mio_data.current_modes = mio_data.old_modes;
	call adjust_modes ("^echoplex,tabs,^tabecho,rawi,rawo");

/* Set up a foreground event channel */

	ipc_arg.version = ipc_create_arg_structure_v1;
	ipc_arg.channel_type = FAST_EVENT_CHANNEL_TYPE;
	ipc_arg.call_entry = mowse_io_dummy;
	ipc_arg.call_data_ptr = null;
	ipc_arg.call_priority = 0;
	call ipc_$create_event_channel (addr (ipc_arg),
	     mio_data.channel_info.foreground.channel, p_code); /* MF - phx21215 */
	if (p_code ^= 0) then
	     goto CREATE_CHANNEL_ERROR;

/* Initialize protocol */

	call ws_timer_$initialize (mio_data_ptr);
	call ws_tools_$reset_data (mio_data_ptr);

	call ws_packet_transmitter_$initialize (mio_data_ptr, open_struc_ptr,
	     p_code);
	if p_code ^= 0 then
	     goto OPEN_TRANSMITTER_ERROR;

	call ws_packet_dispatcher_$initialize (mio_data_ptr, p_code);
	if p_code ^= 0 then
	     goto OPEN_DISPATCHER_ERROR;

	call ws_packet_receiver_$initialize (mio_data_ptr, open_struc_ptr,
	     p_code);
	if p_code ^= 0 then
	     goto OPEN_RECEIVER_ERROR;

	call connect (p_code);
	if p_code ^= 0 then
	     goto OPEN_CONNECT_ERROR;

	return;

OPEN_CONNECT_ERROR:
	call ws_packet_receiver_$terminate ((0));
OPEN_RECEIVER_ERROR:
	call ws_packet_dispatcher_$terminate ();
OPEN_DISPATCHER_ERROR:
	call ws_packet_transmitter_$terminate (mio_data_ptr);
OPEN_TRANSMITTER_ERROR:
	call ws_timer_$terminate ();
CREATE_CHANNEL_ERROR:
	call ipc_$delete_ev_chn (
	     mio_data.channel_info.foreground.channel, (0)); /* MF - phx21215 */

/* Put the IOCB back into a closed state */

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

	call initialize_iocb (iocb_ptr -> iocb.actual_iocb_ptr);
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.open_descrip_ptr
	     = null;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.detach_iocb
	     = mowse_io_detach_iocb;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.open
	     = mowse_io_open;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.open_file
	     = mowse_io_open_file;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.close_file
	     = iox_$err_not_open;
	iocb_ptr -> iocb.actual_iocb_ptr -> iocb.close
	     = iox_$err_not_open;
	call iox_$propagate (iocb_ptr);

	call iox_$modes (mio_data.iocb_ptr, mio_data.old_modes, "", (0));

	call hcs_$reset_ips_mask (mask, mask);

	return;

/**/

/* *** Entry: mowse_io_put_chars - Internal entry for mowse_io_  *** */

mowse_io_put_chars:
     entry (p_iocb_ptr, p_buf_ptr, p_buf_len, p_code);


/* ENTRY FUNCTION

Handle transmission of foreground terminal data to the remote (PC).
*/

/* NOTES
*/

	call setup_entry ();

	call ws_packet_transmitter_$data (mio_data_ptr, FG, p_buf_ptr,
	     p_buf_len, FG_TERMINAL_DATA);
	return;

/**/

/* *** Entry: mowse_io_tty_control   - Internal entry for mowse_io_  *** */
/* *** Entry: mowse_io_tty_get_chars - Internal entry for mowse_io_  *** */
/* *** Entry: mowse_io_tty_get_line  - Internal entry for mowse_io_  *** */
/* *** Entry: mowse_io_tty_put_chars - Internal entry for mowse_io_  *** */
/* *** Entry: mowse_io_tty_modes     - Internal entry for mowse_io_  *** */
/* *** Entry: mowse_io_dummy	       - Internal entry for mowse_io_  *** */

/* ENTRY FUNCTION

These entries are designed to merely pass on control to tty_ while mowse_i/o
is attached but not open.  Except for the dummy entry, it is used on the
foreground event wait channel and shold never be called.
*/

mowse_io_tty_control:
     entry (p_iocb_ptr, p_order, p_info_ptr, p_code);
	call setup_entry ();
	call iox_$control (mio_data.iocb_ptr, p_order, p_info_ptr,
	     p_code);
	return;

mowse_io_tty_get_chars:
     entry (p_iocb_ptr, p_buf_ptr, p_buf_len, p_chars_read, p_code);
	call setup_entry ();
	call iox_$get_chars (mio_data.iocb_ptr, p_buf_ptr, p_buf_len,
	     p_chars_read, p_code);
	return;

mowse_io_tty_get_line:
     entry (p_iocb_ptr, p_buf_ptr, p_buf_len, p_chars_read, p_code);
	call setup_entry ();
	call iox_$get_line (mio_data.iocb_ptr, p_buf_ptr, p_buf_len,
	     p_chars_read, p_code);
	return;

mowse_io_tty_put_chars:
     entry (p_iocb_ptr, p_buf_ptr, p_buf_len, p_code);
	call setup_entry ();
	call iox_$put_chars (mio_data.iocb_ptr, p_buf_ptr, p_buf_len,
	     p_code);
	return;

mowse_io_tty_modes:
     entry (p_iocb_ptr, p_newmodes, p_oldmodes, p_code);
	call setup_entry ();
	call iox_$modes (mio_data.iocb_ptr, p_newmodes, p_oldmodes,
	     p_code);
	return;

mowse_io_dummy:
     entry ();
	return;

/**/

%page;

/* INTERNAL PROCEDURES */


/* *** Procedure: adjust_modes - Internal proc for mowse_io_  *** */

adjust_modes:
     proc (p_newmodes);


/* PROCEDURE FUNCTION

Adjust the current mode settings maintained by mowse_io_ to the new modes
supplied.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_newmodes	       char (*) parameter;	    /* New modes settings */

/* MISC VARIABLES */
dcl new_mode	       char (32) var;	    /* New mode value */
dcl j		       fixed bin;
dcl found		       bit (1);
dcl i		       fixed bin;
dcl newmodes_ptr	       ptr;		    /* Mode value info ptr fot new modes */
dcl oldmodes_ptr	       ptr;		    /* Mode value info ptr for old modes */
dcl recover_modes	       char (256);		    /* In case of cleanup these are old values */

/* INITIALIZATION */
	recover_modes = mio_data.current_modes;
	oldmodes_ptr = null;
	newmodes_ptr = null;
	on cleanup begin;
	     call cleanup_modes_info (oldmodes_ptr);
	     call cleanup_modes_info (newmodes_ptr);
	     mio_data.current_modes = recover_modes;
	end;

/* MAIN */

/* Form two mode_string_info structures and then recombine them to one
   to form the resultant modes character string in mio_data.current_modes */

	call mode_string_$parse (mio_data.current_modes, null, oldmodes_ptr,
	     (0));
	call mode_string_$parse (p_newmodes, null, newmodes_ptr, (0));

/* For each of the modes in the old string, look in the new string to see if
   it exists, put the new value into the current modes (if it exists else put
   the old one back) */

	mio_data.current_modes = "";
	do i = 1 to oldmodes_ptr -> mode_string_info.number;
	     found = "0"b;
	     do j = 1 to newmodes_ptr -> mode_string_info.number;
		if oldmodes_ptr -> mode_string_info.modes (i).mode_name
		     = newmodes_ptr -> mode_string_info.modes (j).mode_name
		then do;
		     found = "1"b;
		     newmodes_ptr -> mode_string_info.modes (j).code = 1;
		     call parse_modes (
			addr (newmodes_ptr -> mode_string_info.modes (j)),
			("0"b), (0), new_mode);
		end;
	     end;

/* If the newmode changes an old mode, then insert it
   Else put the old mode in the string */

	     if found then
		mio_data.current_modes
		     = rtrim (mio_data.current_modes) || "," || new_mode;
	     else do;
		call parse_modes (
		     addr (oldmodes_ptr -> mode_string_info.modes (i)),
		     ("0"b), (0), new_mode);
		mio_data.current_modes
		     = rtrim (mio_data.current_modes) || "," || new_mode;
	     end;
	end;

/* For each of the modes in the new string that were not seen, append */

	do i = 1 to newmodes_ptr -> mode_string_info.number;
	     if newmodes_ptr -> mode_string_info.modes (i).code ^= 1 then do;
		call parse_modes (
		     addr (newmodes_ptr -> mode_string_info.modes (i)),
		     ("0"b), (0), new_mode);
		mio_data.current_modes
		     = rtrim (mio_data.current_modes) || "," || new_mode;
	     end;
	end;

/* Strip off the leading "," that was placed in */

	mio_data.current_modes = substr (rtrim (mio_data.current_modes), 2);

/* Release the space occupied back to the system */

	call cleanup_modes_info (oldmodes_ptr);
	call cleanup_modes_info (newmodes_ptr);

     end adjust_modes;

/**/

/* *** Procedure: check_validity - Internal proc for mowse_io_  *** */

check_validity:
     proc (p_info_ptr, p_version, p_code) returns (bit (1));


/* PROCEDURE FUNCTION


*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_info_ptr	       ptr parameter;	    /* Info structure */
dcl p_version	       char (8) parameter;	    /* Version number in characters */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */

/* STRUCTURES */
dcl 01 struc	       based (p_info_ptr),
       02 version	       char (8);

/* INITIALIZATION */
	p_code = 0;

/* MAIN */
	if p_info_ptr = null then do;
	     p_code = error_table_$null_info_ptr;
	     return (False);
	end;

	if p_info_ptr -> struc.version ^= p_version then do;
	     p_code = error_table_$unimplemented_version;
	     return (False);
	end;

	return (True);

     end check_validity;

/**/

/* *** Procedure: check_validity_int - Internal proc for mowse_io_  *** */

check_validity_int:
     proc (p_info_ptr, p_version, p_code) returns (bit (1));


/* PROCEDURE FUNCTION

Check the validity of an integer version field as well as test for null info.
*/

/* NOTES

Version number of the structure must be in the first field and fixed bin (17).
*/

/* INPUT PARAMETERS */
dcl p_info_ptr	       ptr parameter;	    /* Info structure */
dcl p_version	       fixed bin parameter;	    /* Structure version field */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */

/* STRUCTURES */
dcl 01 structure	       based (p_info_ptr),
       02 version	       fixed bin;

/* INITIALIZATION */
	p_code = 0;

/* MAIN */
	if p_info_ptr = null then do;
	     p_code = error_table_$null_info_ptr;
	     return (False);
	end;

	if p_info_ptr -> structure.version ^= p_version then do;
	     p_code = error_table_$unimplemented_version;
	     return (False);
	end;

	return (True);

     end check_validity_int;

/**/

/* *** Procedure: clean_up_cv_trans - Internal proc for mowse_io_  *** */

clean_up_cv_trans:
     proc (p_cv_trans_ptr);


/* PROCEDURE FUNCTION

Free the cv_trans_struc associated with the pointer provided.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_cv_trans_ptr	       ptr parameter;

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */

/* STRUCTURES */

/* INITIALIZATION */

/* MAIN */

	if p_cv_trans_ptr ^= null then do;
	     free p_cv_trans_ptr -> cv_trans_struc;
	     p_cv_trans_ptr = null;
	end;

     end clean_up_cv_trans;

/**/

/* *** Procedure: clean_up_mio_data - Internal proc for mowse_io_  *** */

clean_up_mio_data:
     proc ();


/* PROCEDURE FUNCTION

Free allocated attach data space back to the system, including possible
existence of the mcb.
*/

/* NOTES
*/

/* MISC VARIABLES */
dcl temp_ptr	       ptr;
dcl data		       char (data_len) based (data_ptr);
dcl data_len	       fixed bin (21);
dcl data_ptr	       ptr;
dcl node_ptr	       ptr;
dcl i		       fixed bin;

/* MAIN */

/* If mio_data is not null */

	if mio_data_ptr ^= null then do;
	     if mio_data.channel_info.user_input.channel ^= 0 then
		call ipc_$delete_ev_chn (
		     mio_data.channel_info.user_input.channel, (0));

	     if mio_data.mcb_ptr ^= null then do;
		free mio_data.mcb_ptr -> mcb;
		mio_data.mcb_ptr = null;
	     end;

	     call clean_up_cv_trans (mio_data.cv_trans_struc_ptr);

	     do i = 0 to ChnCnt - 1;
		node_ptr = mio_data.l_dat (i).out_ptr;
		do while (node_ptr ^= null);
		     data_ptr = node_ptr -> local_data_node.data_ptr;
		     data_len = node_ptr -> local_data_node.data_len;
		     free data_ptr -> data;
		     temp_ptr = node_ptr;
		     node_ptr = node_ptr -> local_data_node.next;
		     free temp_ptr -> local_data_node;
		end;
	     end;

	     free mio_data_ptr -> mowse_io_data;
	     mio_data_ptr = null;
	end;

     end clean_up_mio_data;

/**/

/* *** Procedure: cleanup_modes_info - Internal proc for mowse_io_  *** */

cleanup_modes_info:
     proc (p_info_ptr);


/* PROCEDURE FUNCTION

Release the modes info structure back to the system_free if it exists.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_info_ptr	       ptr parameter;

/* MAIN */

	if p_info_ptr ^= null then
	     free p_info_ptr -> mode_string_info;

     end cleanup_modes_info;

/**/

/* *** Procedure: connect - Internal proc for mowse_io_  *** */

connect:
     proc (p_code);


/* PROCEDURE FUNCTION

Perform the necessary functions to establish connection with the remote.
*/

/* NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */

/* STRUCTURES */

/* INITIALIZATION */
	p_code = 0;

/* MAIN */

	mio_data.switches.connect_active = True;
	call ws_timer_$reset_connect ();
	call ws_packet_transmitter_$reset (mio_data_ptr);

	do while (mio_data.switches.rs_pending (1) & mio_data.switches.connect_active);
	     call ws_channel_$wait_block (mio_data_ptr,
		addr (mio_data.channel_info.user_input),
		"user_input (connect)", mio_data.debug_iocb_ptr);
	end;

	if ^mio_data.switches.connect_active then do;
	     p_code = ws_error_$unsupported_ws_terminal;
	     return;
	end;

	call ws_channel_$wait_wakeup (mio_data_ptr,
	     addr (mio_data.channel_info.user_input));

     end connect;

/**/

/* *** Procedure: disconnect - Internal proc for mowse_io_  *** */

disconnect:
     proc (p_confirmed);


/* PROCEDURE FUNCTION

Perform the necessary functions to establish a disconnection from the PC
MOWSE in the following manner:

	send disconnect message;
	(accept only disconnect confirmation messages)
	block until disconnect confirmation received;
	send confirmation to disconnect message confirmation;
	return to caller;
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_confirmed	       bit (1) parameter;	    /* Fast or confirmed disconnect */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */

/* STRUCTURES */

/* INITIALIZATION */

/* MAIN */

/* If interactive_initiated_disconnect is False, then process no further */

	if ^p_confirmed then do;
	     call ws_packet_transmitter_$supervisory (mio_data_ptr,
		byte (FastDis));
	     return;
	end;

/* Send the disconnect request message */

	call ws_timer_$reset_disconnect ();
	call ws_packet_transmitter_$supervisory (mio_data_ptr,
	     byte (DisCon + Request));

/* Block until disconnect confirmation received */

	mio_data.ds_pending (1) = True;
	do while (mio_data.ds_pending (1));
	     call ws_channel_$wait_block (mio_data_ptr,
		addr (mio_data.channel_info.user_input),
		"user_input (disconnect)", mio_data.debug_iocb_ptr);
	end;
	call ws_channel_$wait_wakeup (mio_data_ptr,
	     addr (mio_data.channel_info.user_input));

/* Send the disconnect confirm confirmation */

	call ws_packet_transmitter_$supervisory (mio_data_ptr,
	     byte (DisCon + Confirm));

	call ws_tools_$reset_data (mio_data_ptr);

     end disconnect;

/**/

/* *** Procedure: flush_subchannel - Internal proc for mowse_io_  *** */

flush_subchannel:
     proc (p_info_ptr, p_code);


/* PROCEDURE FUNCTION

Wait until the specified subchannel has been cleared of all pending packets.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_info_ptr	       ptr parameter;	    /* Flush info */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */
dcl channel	       fixed bin;		    /* Channel ID */

/* STRUCTURES */

/* INITIALIZATION */
	p_code = 0;

/* MAIN */
	if ^check_validity (p_info_ptr, mowse_io_info_version_1, p_code) then
	     return;

	channel = p_info_ptr -> mowse_io_flush_subchannel_info.subchannel;
	do while (mio_data.s.psn (channel) ^= mio_data.r.asn (channel));
	     call ws_channel_$wait_block (mio_data_ptr,
		addr (mio_data.channel_info.user_input),
		"flush_subchannel", mio_data.debug_iocb_ptr);
	end;
	call ws_channel_$wait_wakeup (mio_data_ptr,
	     addr (mio_data.channel_info.user_input));

     end flush_subchannel;

/**/

/* *** Procedure: get_emulator_state - Internal proc for mowse_io_  *** */

get_emulator_state:
     proc (p_info_ptr, p_code);


/* PROCEDURE FUNCTION

Determine whether or not WSTERM is attached, if so return True in the info.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_info_ptr	       ptr parameter;	    /* Info structure */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */
dcl code		       fixed bin (35);
dcl cap_num	       fixed bin;		    /* Capability number of WSTERM */

/* STRUCTURES */

/* INITIALIZATION */
	cap_num = 0;
	p_code = 0;

/* MAIN */
	if ^check_validity (p_info_ptr, mowse_io_info_version_1, p_code) then
	     return;

/* Look for WSTERM on the remote system */

	cap_num = 0;
	call ws_$find_capability_number ("WSTERM", REMOTE_SYSTEM,
	     cap_num, code);

/* Code = 0, there; code = ^0, not there */

	if code ^= 0 then
	     p_info_ptr -> mowse_io_terminal_state.state = False;
	else
	     p_info_ptr -> mowse_io_terminal_state.state = True;

	if code = ws_error_$inconsistent_mowse_tables then
	     p_code = code;

     end get_emulator_state;

/**/

/* *** Procedure: get_escape_char - Internal proc for mowse_io_  *** */

get_escape_char:
     proc (p_cv_trans_ptr) returns (char (1));


/* PROCEDURE FUNCTION

Extracts the escape character from the conversion table.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_cv_trans_ptr	       ptr parameter;	    /* Pointer to conversion table */

/* MISC VARIABLES */
dcl i		       fixed bin;

/* INITIALIZATION */

/* MAIN */

/* Get a copy of the new translation */

	mio_data.cv_trans_struc_ptr -> cv_trans_struc =
	     p_cv_trans_ptr -> cv_trans_struc;

/* If there exists a "\" then return it */

	if p_cv_trans_ptr -> cv_trans_struc.cv_trans.value (rank ("\"))
	     = INPUT_CONVERT_ESCAPE
	     then
	     return ("\");

	else do;
	     i = 0;
	     do while (i < 256);		    /* There are 256 elements */
		if p_cv_trans_ptr -> cv_trans_struc.value (i)
		     = INPUT_CONVERT_ESCAPE
		     then
		     return (byte (i));
		else
		     i = i + 1;
	     end;
	     return ("\");
	end;

     end get_escape_char;

/**/

/* *** Procedure: get_new_modes - Internal proc for mowse_io_  *** */

get_new_modes:
     proc (p_newmodes, p_oldmodes, p_erkl_esc, p_pl, p_ll, p_code);


/* PROCEDURE FUNCTION

Parse the p_newmodes string and extract the necessary information, setting
p_oldmodes to the new modes setting, p_erkl_esc, p_pl, and p_ll to their new
values unless they haven't been changed.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_newmodes	       char (*) parameter;	    /* New modes string */

/* OUTPUT PARAMETERS */
dcl p_ll		       fixed bin parameter;	    /* Line length */
dcl p_code	       fixed bin (35) parameter;
dcl p_oldmodes	       char (*) parameter;	    /* Modes string */
dcl p_erkl_esc	       char (3) parameter;	    /* Erase, Kill, Escape */
dcl p_pl		       fixed bin parameter;	    /* Page length */

/* MISC VARIABLES */
dcl boolean_val	       bit (1);		    /* Boolean mode value */
dcl temp_chmod	       char (32) var;	    /* Single mode value string */
dcl i		       fixed bin;
dcl force_flag	       bit (1);		    /* Force reqyested */
dcl chmod		       char (512) var;	    /* New modes to be changed */
dcl r_len		       fixed bin (21);	    /* Return string length */
dcl code		       fixed bin (35);

/* INITIALIZATION */
	boolean_val = ""b;
	temp_chmod = "";
	force_flag = ""b;
	chmod = "";
	code = 0;
	r_len = 0;
	p_erkl_esc = byte (0) || byte (0) || byte (0);
	p_pl = -1;
	p_ll = -1;
	p_code = 0;

/* MAIN */

/* Set the oldmodes value to current settings */

	if length (p_oldmodes) > 0 then
	     p_oldmodes = mio_data.current_modes;

/* If there are no newmodes (0 length) then return */

	if length (p_newmodes) <= 0 then
	     return;

/* Parse the new modes string */

	mode_string_info_ptr = null;
	on cleanup call cleanup_modes_info (mode_string_info_ptr);
	call mode_string_$parse (p_newmodes, null, mode_string_info_ptr,
	     p_code);
	if p_code ^= 0 then do;
	     call cleanup_modes_info (mode_string_info_ptr);
	     return;
	end;

/* Check and interpret each */

	do i = 1 to mode_string_info.number;
	     if mode_string_info.modes (i).mode_name = "force" then
		force_flag = True;

	     else if mode_string_info.modes (i).mode_name = "pl" then do;
		call parse_modes (addr (mode_string_info.modes (i)),
		     ("0"b), p_pl, temp_chmod);
		chmod = chmod || ",";
		chmod = chmod || temp_chmod;
	     end;

	     else if mode_string_info.modes (i).mode_name = "ll" then do;
		call parse_modes (addr (mode_string_info.modes (i)),
		     ("0"b), p_ll, temp_chmod);
		chmod = chmod || ",";
		chmod = chmod || temp_chmod;
	     end;

	     else if mode_string_info.modes (i).mode_name = "wake_tbl"
	     then do;
		call parse_modes (addr (mode_string_info.modes (i)),
		     ("0"b), (0), temp_chmod);
		chmod = chmod || ",";
		chmod = chmod || temp_chmod;
	     end;

	     else if mode_string_info.modes (i).mode_name = "more"
		| mode_string_info.modes (i).mode_name = "more_mode"
		then
		;			    /* IGNORE */

	     else if mode_string_info.modes (i).mode_name = "crecho" then do;
		call parse_modes (addr (mode_string_info.modes (i)),
		     boolean_val, (0), temp_chmod);

		substr (unspec (mio_data.WSTERM_modes (WST_MODES)), 8, 1)
		     = boolean_val;
		chmod = chmod || ",";
		chmod = chmod || temp_chmod;
	     end;

	     else if mode_string_info.modes (i).mode_name = "lfecho" then do;
		call parse_modes (
		     addr (mode_string_info.modes (i)), boolean_val,
		     (0), temp_chmod);

		substr (unspec (mio_data.WSTERM_modes (WST_MODES)), 7, 1)
		     = boolean_val;
		chmod = chmod || ",";
		chmod = chmod || temp_chmod;
	     end;

	     else if ^force_flag then do;
		call cleanup_modes_info (mode_string_info_ptr);
		p_code = error_table_$bad_mode;
		return;
	     end;
	end;

/* Save the new settings in the current modes */

	if length (chmod) ^= 0 then
	     call adjust_modes (substr (chmod, 2, length (chmod) - 1));

/* Release the space to system */

	call cleanup_modes_info (mode_string_info_ptr);

     end get_new_modes;

/**/

/* *** Procedure: initialize_attach_data - Internal proc for mowse_io_  *** */

initialize_attach_data:
     proc (p_code);


/* PROCEDURE FUNCTION

Initialize the mowse_io_ data.
*/

/* NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */
dcl system_free_area_ptr   ptr;
dcl system_free_area       area based (system_free_area_ptr);
dcl code		       fixed bin (35);

/* STRUCTURES */
dcl 01 mode_val	       like mode_value automatic;
dcl 01 trans	       like cv_trans_struc automatic;
dcl 01 ed_chars	       like editing_chars automatic;

/* INITIALIZATION */
	system_free_area_ptr = get_system_free_area_ ();
	p_code = 0;

/* MAIN */

/* Modes */

	call iox_$modes (mio_data.iocb_ptr, "", mio_data.old_modes, p_code);
	if p_code ^= 0 then
	     return;
	mio_data.current_modes = mio_data.old_modes;

/* Channel info */

	mio_data.channel_info.process_id = get_process_id_ ();
	mio_data.channel_info.packet_receiver.channel = 0;

	mio_data.channel_info.user_input.count = 0;
	mio_data.channel_info.user_input.flags.transmitted = False;
	call ipc_$create_ev_chn (mio_data.channel_info.user_input.channel,
	     p_code);
	if p_code ^= 0 then
	     return;

/* Get the current conversion table */

	mio_data.cv_trans_struc_ptr = null;
	on cleanup call clean_up_cv_trans (mio_data.cv_trans_struc_ptr);
	allocate cv_trans_struc in (system_free_area)
	     set (mio_data.cv_trans_struc_ptr);
	mio_data.cv_trans_struc_ptr -> cv_trans_struc.version = 1;
	call iox_$control (mio_data.iocb_ptr, "get_input_conversion",
	     mio_data.cv_trans_struc_ptr, code);
	if code ^= 0 then
	     mio_data.cv_trans_struc_ptr -> cv_trans_struc.default = 1;

/* WSTERM modes header */

	mio_data.WSTERM_modes (WST_HEADER_1) = "S";
	mio_data.WSTERM_modes (WST_HEADER_2) = "T";
	mio_data.WSTERM_modes (WST_HEADER_3) = "M";
	mio_data.WSTERM_modes (WST_LENGTH_HIGH) = byte (0);
	mio_data.WSTERM_modes (WST_LENGTH_LOW) = byte (6);

/* WSTERM modes modes (00000xy0 forced) lfecho,crecho,video_mode */

	mio_data.WSTERM_modes (WST_MODES) = byte (0);
	mode_val.version = mode_value_version_3;
	call mode_string_$get_mode (mio_data.old_modes, "crecho",
	     addr (mode_val), (0));
	substr (unspec (mio_data.WSTERM_modes (WST_MODES)), 8, 1)
	     = mode_val.flags.boolean_value;
	call mode_string_$get_mode (mio_data.old_modes, "lfecho",
	     addr (mode_val), (0));
	substr (unspec (mio_data.WSTERM_modes (WST_MODES)), 7, 1)
	     = mode_val.flags.boolean_value;

/* WSTERM modes Kill / Erase chars */

	ed_chars.version = editing_chars_version_3;
	call iox_$control (mio_data.iocb_ptr, "get_editing_chars",
	     addr (ed_chars), code);
	if code ^= 0 then do;
	     mio_data.WSTERM_modes (WST_KILL) = "@";
	     mio_data.WSTERM_modes (WST_ERASE) = "#";
	end;
	else do;
	     mio_data.WSTERM_modes (WST_KILL) = ed_chars.kill;
	     mio_data.WSTERM_modes (WST_ERASE) = ed_chars.erase;
	end;

/* WSTERM modes Escape character */

	trans.version = 1;
	call iox_$control (mio_data.iocb_ptr, "get_input_conversion",
	     addr (trans), code);
	if code ^= 0 then
	     mio_data.WSTERM_modes (WST_ESCAPE) = "\";
	else
	     mio_data.WSTERM_modes (WST_ESCAPE) = get_escape_char (addr (trans));

/* WSTERM modes PL and LL */

	mode_val.version = mode_value_version_3;
	call mode_string_$get_mode (mio_data.old_modes, "pl",
	     addr (mode_val), code);
	if code ^= 0 then
	     mio_data.WSTERM_modes (WST_PAGE_LENGTH) = byte (24);
	else
	     mio_data.WSTERM_modes (WST_PAGE_LENGTH) = byte (mode_val.numeric_value);

	call mode_string_$get_mode (mio_data.old_modes, "ll",
	     addr (mode_val), code);
	if code ^= 0 then
	     mio_data.WSTERM_modes (WST_LINE_LENGTH) = byte (79);
	else
	     mio_data.WSTERM_modes (WST_LINE_LENGTH) = byte (mode_val.numeric_value);

/* Application control info segment */

	mio_data.switches.info_stored = False;
	mio_data.info_ptr = null;
	mio_data.sleepers = null;
	mio_data.dozers = 0;

/* Get an MCB */

	allocate mcb in (system_free_area) set (mio_data.mcb_ptr);
	mio_data.mcb_ptr -> mcb.version = MOWSE_VERSION_;
	mio_data.mcb_ptr -> mcb.capability_name = "internal_mowse_";
	call capability_$pack (LOCAL_SYSTEM, INTERNAL,
	     mio_data.mcb_ptr -> mcb.major_capability, (0));
	mio_data.mcb_ptr -> mcb.inbuff_length = 0;
	mio_data.mcb_ptr -> mcb.inbuff_position_index = 0;
	mio_data.mcb_ptr -> mcb.inbuff_data_length = 0;
	mio_data.mcb_ptr -> mcb.outbuff_length = 0;
	mio_data.mcb_ptr -> mcb.mbz1 = ""b;
	mio_data.mcb_ptr -> mcb.entry_var = bound_process_env_$err_no_operation;
	mio_data.mcb_ptr -> mcb.data_block_ptr = null;
	mio_data.mcb_ptr -> inbuff = null;
	mio_data.mcb_ptr -> mcb.outbuff_list_start = null;
	mio_data.mcb_ptr -> mcb.outbuff_list_end = null;
	mio_data.mcb_ptr -> mcb.iocb_ptr = null;
	mio_data.mcb_ptr -> mcb.mowse_info_ptr = mio_data.info_ptr;

/* Video system (ws_tty) information */

	mio_data.ws.flags.trace = False;
	mio_data.ws.flags.debug = False;
	mio_data.ws.flags.mark_set = False;
	mio_data.ws.flags.video_mode = False;
	mio_data.ws.flags.more_input = False;
	mio_data.ws.flags.pad = ""b;
	mio_data.ws.ips_mask = ""b;

/* Local message data */

	mio_data.l_dat (*).in_ptr = null;
	mio_data.l_dat (*).out_ptr = null;

/* sus_ handler information */

	mio_data.sus_data.activated = False;
	mio_data.sus_data.pad = ""b;
	mio_data.sus_data.sus_entry = null;

/* Buffer space */

	mio_data.user_input.in = 0;
	mio_data.user_input.out = 0;

/* State control switches */

	mio_data.switches.quit_enable = True;
	mio_data.switches.reset_write = False;
	mio_data.switches.disconnect_active = False;
	mio_data.switches.rs_pending (*) = False;
	mio_data.switches.ds_pending (*) = False;
	mio_data.switches.brk_pending = False;
	mio_data.switches.br_pending = False;
	mio_data.switches.connect_active = False;
	mio_data.switches.start_issued = False;

/* Tasking data */

	mio_data.task.active (*) = False;

/* Debug information */

	mio_data.debug_iocb_ptr = null;
	mio_data.trace_iocb_ptr = null;

     end initialize_attach_data;

/**/

/* *** Procedure: initialize_iocb - Internal proc for mowse_io_  *** */

initialize_iocb:
     proc (p_iocb_ptr);


/* PROCEDURE FUNCTION

Initialize the fields of the IOCB.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_iocb_ptr	       ptr parameter;	    /* IOCB to be initialized */

/* MAIN */

	p_iocb_ptr -> iocb.detach_iocb = iox_$err_no_operation;
	p_iocb_ptr -> iocb.open = iox_$err_no_operation;
	p_iocb_ptr -> iocb.open_file = iox_$err_no_operation;
	p_iocb_ptr -> iocb.close = iox_$err_no_operation;
	p_iocb_ptr -> iocb.close_file = iox_$err_no_operation;
	p_iocb_ptr -> iocb.get_line = iox_$err_no_operation;
	p_iocb_ptr -> iocb.get_chars = iox_$err_no_operation;
	p_iocb_ptr -> iocb.put_chars = iox_$err_no_operation;
	p_iocb_ptr -> iocb.modes = iox_$err_no_operation;
	p_iocb_ptr -> iocb.position = iox_$err_no_operation;
	p_iocb_ptr -> iocb.control = iox_$err_no_operation;
	p_iocb_ptr -> iocb.read_record = iox_$err_no_operation;
	p_iocb_ptr -> iocb.write_record = iox_$err_no_operation;
	p_iocb_ptr -> iocb.rewrite_record = iox_$err_no_operation;
	p_iocb_ptr -> iocb.delete_record = iox_$err_no_operation;
	p_iocb_ptr -> iocb.seek_key = iox_$err_no_operation;
	p_iocb_ptr -> iocb.read_key = iox_$err_no_operation;
	p_iocb_ptr -> iocb.read_length = iox_$err_no_operation;
     end initialize_iocb;

/**/

/* *** Procedure: insert_sleeper - Internal proc for mowse_io_  *** */

insert_sleeper:
     proc (p_info_ptr, p_code);


/* PROCEDURE FUNCTION

Insert the application to be put to sleep in the sleeper queue positioned 
according to when it will wake up.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_info_ptr	       ptr parameter;	    /* Info structure */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */
dcl fixed71	       fixed bin (71) based;
dcl current_time	       fixed bin (71);
dcl new_ptr	       ptr;		    /* New node */
dcl system_free_area       area based (system_free_area_ptr);
dcl system_free_area_ptr   ptr;
dcl look_ptr	       ptr;		    /* Sleep list search ptr */

/* STRUCTURES */
dcl 01 node	       like mowse_io_sleep_node based;

/* INITIALIZATION */
	p_code = 0;

/* MAIN */
	if ^check_validity (p_info_ptr, mowse_io_info_version_1, p_code) then
	     return;

/* Make sure it is not trying for <= 0 sleep time */

	if p_info_ptr -> mowse_io_sleep_info.sleep_seconds <= 0 then do;
	     p_code = ws_error_$invalid_sleep_interval;
	     return;
	end;

/* Make sure caller is not already sleeping */

	look_ptr = mio_data.sleepers;
	do while (look_ptr ^= null);
	     if look_ptr -> mowse_io_sleep_node.major
		= p_info_ptr -> mowse_io_sleep_info.major_index
	     then do;
		p_code = ws_error_$already_sleeping;
		return;
	     end;
	     look_ptr = look_ptr -> mowse_io_sleep_node.next;
	end;

/* Get a node and set the info fields */

	system_free_area_ptr = get_system_free_area_ ();
	allocate node in (system_free_area) set (new_ptr);

	new_ptr -> node.major =
	     p_info_ptr -> mowse_io_sleep_info.major_index;
	new_ptr -> node.last = null;
	new_ptr -> node.next = null;
	current_time = divide (clock_ (), 1000000, 0);
	new_ptr -> node.when =
	     convert (fixed71,
	     p_info_ptr -> mowse_io_sleep_info.sleep_seconds) + current_time;

/* Insert the node into the list
   - Null list */

	if mio_data.sleepers = null then do;
	     mio_data.sleepers = new_ptr;
	     call ws_timer_$queue_sleeper (new_ptr -> node.when);
	     return;
	end;

/* Insert somewhere else
   -- End of list */

	look_ptr = mio_data.sleepers;
	do while (new_ptr -> node.when >= look_ptr -> node.when);
	     if look_ptr -> node.next = null then do;
		new_ptr -> node.last = look_ptr;
		look_ptr -> node.next = new_ptr;
		call ws_timer_$queue_sleeper (new_ptr -> node.when);
		return;
	     end;
	     look_ptr = look_ptr -> node.next;
	end;

/* -- Front of list */

	if look_ptr -> node.last = null then do;
	     new_ptr -> node.next = mio_data.sleepers;
	     mio_data.sleepers = new_ptr;
	     look_ptr -> node.last = new_ptr;
	     call ws_timer_$queue_sleeper (new_ptr -> node.when);
	     return;
	end;

/* Between two nodes */

	else do;
	     new_ptr -> node.next = look_ptr;
	     new_ptr -> node.last = look_ptr -> node.last;
	     look_ptr -> node.last -> node.next = new_ptr;
	     look_ptr -> node.last = new_ptr;
	     call ws_timer_$queue_sleeper (new_ptr -> node.when);
	     return;
	end;

     end insert_sleeper;

/**/

/* *** Procedure: parse_modes - Internal proc for mowse_io_  *** */

parse_modes:
     proc (p_mode_info_ptr, p_boolean_value, p_numeric_value,
	p_char_value);


/* PROCEDURE FUNCTION

Look at the mode_value structure and return the appropriate data.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_mode_info_ptr	       ptr parameter;	    /* mode_value structure */

/* OUTPUT PARAMETERS */
dcl p_boolean_value	       bit (1) parameter;	    /* Boolean value of mode */
dcl p_numeric_value	       fixed bin parameter;	    /* Numeric value of mode */
dcl p_char_value	       char (*) var parameter;    /* Character value of mode */

/* MISC VARIABLES */

/* INITIALIZATION */
	p_boolean_value = "0"b;
	p_numeric_value = 0;
	p_char_value = rtrim (p_mode_info_ptr -> mode_value.mode_name);

/* MAIN */

	if p_mode_info_ptr -> mode_value.flags.boolean_valuep then do;
	     p_boolean_value
		= p_mode_info_ptr -> mode_value.flags.boolean_value;
	     if ^p_mode_info_ptr -> mode_value.flags.boolean_value then
		p_char_value = "^" || p_char_value;
	end;

	else if p_mode_info_ptr -> mode_value.flags.numeric_valuep then do;
	     p_numeric_value
		= p_mode_info_ptr -> mode_value.numeric_value;
	     p_char_value
		= p_char_value || p_mode_info_ptr -> mode_value.char_value;
	end;

	else if p_mode_info_ptr -> mode_value.flags.char_valuep then do;
	     p_char_value
		= p_char_value || "=" || p_mode_info_ptr -> mode_value.char_value;
	end;

     end parse_modes;

/**/

/* *** Procedure: send_terminal_modes - Internal proc for mowse_io_  *** */

send_terminal_modes:
     proc (p_chars, p_PL, p_LL);


/* PROCEDURE FUNCTION

Send a predefined mode message string to the MOWSE terminal emulator WSTERM.

A modes message is formulated and sent through the foreground channel to
be interpretted by WSTERM - the smart terminal emulator.
*/

/* NOTES

If WSTERM does not exist in the Capability Address Table the message will not
be sent and the error code error_table_$incompatible_term_type will be
returned.

Below is the format of the modes message:

 --------------------------------------------------------------
|S|T|M|0|6|mode_switches|kill|erase|esc|line_length|page_length|
 --------------------------------------------------------------

	STM	    - message header
	06	    - "\000\006" length of data of message
	mode_switches - "00000111" lfecho, crecho, video mode
	kill	    - kill character
	erase	    - erase character
         *esc	    - escape character
	page_length   - lines per page
	line_length   - columns per line

         *If more than one escape characters are defined, then if one of the
	characters is "\" it will be specified, otherwise the first
	character in the list will be used.

Values of p_chars, p_PL, or p_LL which are invalid will be looked for in the
current settings and filled in.  Invalid settings are as follows:

	p_chars(1:3)     = "";
	p_PL	       < 0;
	p_LL	       < 0:
*/

/* INPUT PARAMETERS */
dcl p_chars	       char (3) parameter;	    /* Kill, Erase, Escape chars */
dcl p_PL		       fixed bin parameter;	    /* Page length */
dcl p_LL		       fixed bin parameter;	    /* Line length */

/* MISC VARIABLES */
dcl r_len		       fixed bin (21);

/* INITIALIZATION */
	r_len = 0;

/* MAIN */

/* Set the kill character */

	if substr (p_chars, 1, 1) ^= byte (0) then
	     mio_data.WSTERM_modes (WST_KILL) = substr (p_chars, 1, 1);

/* Set the erase character */

	if substr (p_chars, 2, 1) ^= byte (0) then
	     mio_data.WSTERM_modes (WST_ERASE) = substr (p_chars, 2, 1);

/* Set the escape character */

	if substr (p_chars, 3, 1) ^= byte (0) then
	     mio_data.WSTERM_modes (WST_ESCAPE) = substr (p_chars, 3, 1);

/* Set the line length */

	if p_LL >= 0 then
	     mio_data.WSTERM_modes (WST_LINE_LENGTH) = byte (p_LL);

/* Set the page length */

	if p_PL >= 0 then
	     mio_data.WSTERM_modes (WST_PAGE_LENGTH) = byte (p_PL);

/* Send the modes message to the Foreground channel */

	call ws_packet_transmitter_$data (mio_data_ptr, FG,
	     addr (mio_data.WSTERM_modes), 11, FG_CONTROL_MESSAGE);

     end send_terminal_modes;

/**/

/* *** Procedure: set_terminal - Internal proc for mowse_io_  *** */

set_terminal:
     proc (p_info_ptr, p_code);


/* PROCEDURE FUNCTION

Parse through the termianal info and handle accordingly.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_info_ptr	       ptr parameter;	    /* set_term_type_info pointer */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */
dcl code		       fixed bin (35);
dcl ll		       fixed bin;		    /* Line length */
dcl pl		       fixed bin;		    /* Page length */
dcl erkl_esc	       char (3);		    /* Erase, kill, escape chars */
dcl initial_modes	       char (256);		    /* Initial modes */
dcl initial_string	       char (512) var;	    /* Initial terminal string */

/* STRUCTURES */
dcl 01 initial_string_struc based (addr (initial_string)),
       02 data_len	       fixed bin (21) aligned,
       02 data	       char (512);
dcl 01 term_info	       like terminal_info aligned automatic;
dcl 01 stty_info	       like set_term_type_info automatic;

/* INITIALIZATION */
	if ^check_validity_int (p_info_ptr, 1, p_code) then
	     return;

/* MAIN */

/* Copy callers set_term_type_info structure */

	stty_info = p_info_ptr -> set_term_type_info;

/* Tell tty_ of the change in terminal info, send init string and set modes
   must be nulled out as they are handled differently  */

	stty_info.flags.send_initial_string = False;
	stty_info.flags.set_modes = False;
	stty_info.ignore_line_type = True;
	call iox_$control (mio_data.iocb_ptr, "set_term_type",
	     addr (stty_info), p_code);
	if p_code ^= 0 then
	     return;

/* Get terminal info from tty_ */

	term_info.version = 1;
	call iox_$control (mio_data.iocb_ptr, "terminal_info",
	     addr (term_info), p_code);
	if p_code ^= 0 then
	     return;

/* If terminal modes are to be set, set default modes from the TTT and
   ^video_mode and send */

	if p_info_ptr -> set_term_type_info.flags.set_modes then do;
	     call ttt_info_$modes (rtrim (term_info.term_type),
		initial_modes, p_code);
	     if p_code ^= 0 then
		return;

	     if length (rtrim (initial_modes)) > 0 then do;
		call get_new_modes ("force," || initial_modes, "",
		     erkl_esc, pl, ll, p_code);
		if p_code ^= 0 then
		     return;
	     end;

	     substr (unspec (mio_data.WSTERM_modes (WST_MODES)), 9, 1) = "0"b;
	     call send_terminal_modes (erkl_esc, pl, ll);
	end;

	if p_info_ptr -> set_term_type_info.flags.send_initial_string then do;
	     call ttt_info_$initial_string (rtrim (term_info.term_type),
		initial_string, code);
	     if code = 0 then do;
		if initial_string_struc.data_len = 0 then do;
		     p_code = error_table_$no_initial_string;
		     return;
		end;

		call ws_packet_transmitter_$data (mio_data_ptr, FG,
		     addr (initial_string_struc.data),
		     initial_string_struc.data_len, FG_TERMINAL_DATA);
	     end;
	end;

     end set_terminal;

/**/

/* *** Procedure: setup_entry - Internal proc for mowse_io_  *** */

setup_entry:
     proc ();


/* PROCEDURE FUNCTION

Initialize all the ENTRY point parameters and mowsish stuff.
*/

/* NOTES
*/

/* MISC VARIABLES */

/* INITIALIZATION */

/* MAIN */

	p_code = 0;
	iocb_ptr = p_iocb_ptr;
	mio_data_ptr
	     = iocb_ptr -> iocb.actual_iocb_ptr -> iocb.attach_data_ptr;

     end setup_entry;

/**/

%page;

/* INCLUDE FILES */
%include ipc_create_arg;
%include mowse_io_structures;
%include mowse_mcb;
%include mowse_io_control_info;
%include mowse_info;
%include tty_read_status_info;
%include terminal_info;
%include set_term_type_info;
%include mowse_io_bad_control;
%include static_handlers;
%include tty_convert;
%include tty_editing_chars;
%include iox_modes;
%include mode_string_info;
%include mowse;
%include mowse_messages;
%include mowse_io_constants;
%include mowse_io_data;
%include iocbx;

     end;




		    mowse_io_call_control_.pl1      08/08/88  1544.9r w 08/08/88  1409.7       90036



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

/****^  HISTORY COMMENTS:
  1) change(86-08-14,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-10-08,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Added flush_subchannel control order to be
     disallowed.
  3) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
mowse_io_call_control_:
     proc (p_iocb_ptr, p_io_call_order, p_io_call_info_ptr, p_code);

/* : PROGRAM FUNCTION

Sets up info structures to execute mowse_io_ control orders on behalf of the
io_call command.
*/

/* : NOTES

The following orders are supported for io_call:

	store_id id
	set_term_type
	line_length N

The following orders are supported for io_call_af:

	read_status
	write_status
	terminal_info terminal_type
	terminal_info baud
	terminal_info id
	terminal_info line_type

This procedure is primarily an extraction of tty_io_call_control_ with minor
modifications in order to supply support for MOWSE.
*/

/* INPUT PARAMETERS */
dcl p_iocb_ptr	       ptr;		    /* Pointer to the iocb */
dcl p_io_call_order	       char (*);		    /* "io_call" or "io_call_af" */
dcl p_io_call_info_ptr     ptr;		    /* Info pointer */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);


/* MISC VARIABLES */
dcl line_length	       fixed bin (9);
dcl i		       fixed bin (35);
dcl new_type	       fixed bin (35);	    /* Index into device table */
dcl new_id	       char (4);		    /* Info for store_id */
dcl temp_type	       char (16);		    /* Temporary line type */
dcl caller	       char (32);		    /* Name of calling procedure */
dcl n_args	       fixed bin;		    /* Number of control args */
dcl order		       char (32);		    /* Control order requested */
dcl report	       entry variable options (variable);
					    /* io_call report handler */
dcl error		       entry variable options (variable);
					    /* io_call error handler */
dcl af_flag	       bit (1);		    /* If the call was from "io_call_af" */


/* STRUCTURES */
dcl 01 write_status	       aligned like tty_read_status_info;
dcl 01 read_status	       aligned like tty_read_status_info;
dcl 01 info	       like terminal_info automatic;


/* SYSTEM CALLS */
dcl cv_dec_check_	       entry (char (*), fixed bin (35))
		       returns (fixed bin (35));
dcl ioa_$rsnnl	       entry () options (variable);
dcl iox_$control	       entry (ptr, char (*), ptr, fixed bin (35));


/* SYSTEM CALL SUPPORT */
dcl error_table_$undefined_order_request
		       fixed bin (35) ext static;
dcl error_table_$noarg     fixed bin (35) ext static;
dcl error_table_$badopt    fixed bin (35) ext static;


/* BUILTINS */
dcl addr		       builtin;
dcl hbound	       builtin;
dcl lbound	       builtin;
dcl null		       builtin;
dcl rtrim		       builtin;
dcl translate	       builtin;
dcl unspec	       builtin;

/* CONSTANTS */
dcl info_orders	       (34) char (32) int static options (constant)
		       init ("set_delay",
		       "get_channel_info",
		       "get_delay",
		       "set_editing_chars",
		       "get_editing_chars",
		       "set_input_translation",
		       "set_input_conversion",
		       "set_output_translation",
		       "set_output_conversion",
		       "get_input_translation",
		       "get_input_conversion",
		       "get_output_translation",
		       "get_output_conversion",
		       "set_special",
		       "get_special",
		       "set_framing_chars",
		       "get_framing_chars",
		       "send_initial_string",
		       "set_default_modes",
		       "set_input_message_size",
		       "get_input_message_size",
		       "input_flow_control_chars",
		       "output_flow_control_chars",
		       "get_echo_break_table",
		       "set_wakeup_table",
		       "set_prompt",
		       "hangup_proc",
		       "get_terminal_emulator_state",
		       "get_mowse_info",
		       "put_to_sleep",
		       "send_message",
		       "send_local_message",
		       "store_mowse_info",
		       "flush_subchannel");

/**/
/* INITIALIZATION */

/* : Load information from the io_call_info structure into local storage */

	io_call_infop = p_io_call_info_ptr;
	caller = io_call_info.caller_name;
	n_args = io_call_info.nargs;
	order = io_call_info.order_name;
	report = io_call_info.report;
	error = io_call_info.error;
	af_flag = (p_io_call_order = "io_call_af");
	p_code = 0;

/* MAIN */

/* : read_status */

	if rtrim (order) = "read_status" then do;
	     call iox_$control (p_iocb_ptr, "read_status",
		addr (read_status), p_code);
	     if p_code = 0 then do;
		if af_flag then
		     if read_status.input_pending then
			io_call_af_ret = "true";
		     else
			io_call_af_ret = "false";
		else
		     call report (
			"^a: Event channel=^24.3b, input is ^[^;"
			|| "not ^]available.", caller,
			unspec (read_status.event_channel),
			read_status.input_pending);
	     end;
	end;

/* : write_status */

	else if rtrim (order) = "write_status" then do;
	     call iox_$control (p_iocb_ptr, "write_status",
		addr (write_status), p_code);
	     if p_code = 0 then do;
		if af_flag then
		     if write_status.input_pending then
			io_call_af_ret = "true";
		     else
			io_call_af_ret = "false";
		else
		     call report (
			"^a: Event channel=^24.3b, output is ^[^;"
			|| "not ^]pending.", caller,
			unspec (write_status.event_channel),
			write_status.input_pending);
	     end;
	end;

/* : terminal_info */

	else if rtrim (order) = "terminal_info" then do;
	     info.version = 1;
	     call iox_$control (p_iocb_ptr, "terminal_info", addr (info),
		p_code);
	     if p_code = 0 then do;
		if info.line_type < lbound (line_types, 1)
		     | info.line_type > hbound (line_types, 1) then
		     call ioa_$rsnnl ("^d", temp_type, (0),
			info.line_type);
		else
		     temp_type = line_types (info.line_type);

		if af_flag then do;
		     if n_args = 0 then
			io_call_af_ret = rtrim (info.term_type);
		     else if io_call_info.args (1) = "id" then
			io_call_af_ret = rtrim (info.id);
		     else if io_call_info.args (1) = "baud" then
			call ioa_$rsnnl ("^d", io_call_af_ret, (0),
			     info.baud_rate);
		     else if io_call_info.args (1) = "terminal_type"
			then
			io_call_af_ret = rtrim (info.term_type);
		     else if io_call_info.args (1) = "line_type" then
			io_call_af_ret = rtrim (temp_type);
		     else
			call error (error_table_$badopt, caller,
			     "^a",
			     io_call_info.args (1));
		end;
		else
		     call report (
			"^a: Terminal id=""^a"", baud_rate=^d, "
			|| "term_type = ""^a"", line_type=""^a""",
			caller, info.id, info.baud_rate,
			info.term_type,
			temp_type);
	     end;
	end;

/* : Remaining orders are active functions only */

	else if af_flag then
	     call error (0, caller,
		"The ^a order is not valid as an active function.",
		order);

/* : store_id */

	else if rtrim (order) = "store_id" then do;
	     if n_args <= 0 then
		call error (error_table_$noarg, caller, "ID.");
	     else do;
		new_id = io_call_info.args (1);
		call iox_$control (p_iocb_ptr, "store_id",
		     addr (new_id),
		     p_code);
	     end;
	end;

/* : set_term_type */

	else if rtrim (order) = "set_term_type" then do;
	     if n_args <= 0 then
		call error (error_table_$noarg, caller, "Type.");
	     else do;

/* : -- Convert the new type into fixed bin format, if error then the type
        is of an ascii sequence and it must be hunted down in the tables */

		new_type = cv_dec_check_ ((io_call_info.args (1)), i);
		if i ^= 0 then do;
		     temp_type =
			translate (io_call_info.args (1),
			"ABCDEFGHIJKLMNOPQRSTUVWXYZ",
			"abcdefghijklmnopqrstuvwxyz");

/* : -- Hunt down terminal type in tty_dev_type table */

		     do new_type = lbound (tty_dev_type, 1)
			to hbound (tty_dev_type, 1);

/* : --- Got match */

			if tty_dev_type (new_type) = temp_type
			then do;
			     call iox_$control (p_iocb_ptr,
				"set_type",
				addr (new_type), p_code);
			     return;
			end;
		     end;

		     call error (0, caller, "Invalid type: ^a",
			io_call_info.args (1));
		     p_code = 0;
		end;
		else
		     call iox_$control (p_iocb_ptr, "set_type",
			addr (new_type), p_code);
	     end;
	end;

/* : line_length */

	else if rtrim (order) = "line_length" then do;
	     if n_args ^> 0 then
		call error (error_table_$noarg, caller, "Linelength.");
	     else do;
		line_length =
		     cv_dec_check_ ((io_call_info.args (1)), i);
		if i ^= 0 then
		     call error (0, caller, "Invalid line length: ^a",
			io_call_info.args (1));
		else
		     call iox_$control (p_iocb_ptr, "line_length",
			addr (line_length), p_code);
	     end;
	end;

/* : Otherwise see if the order can be passed on (null info_ptr allowed) */

	else do;
	     do i = 1 to hbound (info_orders, 1)
		while (order ^= info_orders (i));
	     end;

/* : If on the disapproved list then it's an error */

	     if i <= hbound (info_orders, 1) then
		call error (error_table_$undefined_order_request,
		     caller,
		     order);
	     else
		call iox_$control (p_iocb_ptr, (order), null (),
		     p_code);
	end;

%page;
/* INCLUDE FILES */
%include tty_read_status_info;
%include ttyp;
%include set_term_type_info;
%include line_types;
%include terminal_info;
%include io_call_info;

/* : END */
     end mowse_io_call_control_;




		    prepare_trace_.pl1              08/07/87  1554.3rew 08/07/87  1454.7       35901



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

/****^  HISTORY COMMENTS:
  1) change(86-11-04,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
prepare_trace_:
     proc (p_message_ptr, p_message_len, p_trace_iocb_ptr, p_minor);

/* : PROGRAM FUNCTION

Prepare the trace message to be sent.
*/

/* : NOTES
*/

/* INPUT PARAMETERS */
dcl p_message_len	       fixed bin parameter;	    /* Length of message */
dcl p_message_ptr	       ptr;		    /* Message */
dcl p_trace_iocb_ptr       ptr;		    /* Trace IOCB */
dcl p_minor	       fixed bin parameter;	    /* Destination minor */


/* OUTPUT PARAMETERS */


/* MISC VARIABLES */


/* STRUCTURES */

/* First 2 fields in all messages */
dcl 01 message_overlay     based (p_message_ptr),
       02 system	       char (1) unal,
       02 major	       char (1) unal;

/* SYSTEM CALLS */


/* SYSTEM CALL SUPPORT */


/* EXTERNAL CALLS */
dcl trace_message_	       entry (ptr, ptr);


/* EXTERNAL CALL SUPPORT */


/* BUILTINS */
dcl addr		       builtin;
dcl rank		       builtin;
dcl substr	       builtin;

/* CONDITIONS */


/* CONSTANTS */


/**/
/* INITIALIZATION */


/* MAIN */
	trace_message_info.dest_system = rank (message_overlay.system);
	trace_message_info.dest_major = rank (message_overlay.major);
	trace_message_info.msg_type =
	     rank (p_message_ptr -> event_message.header.msg_type);
	trace_message_info.direction = RECEIVE;

	if rank (p_message_ptr -> event_message.header.msg_type)
	     = MORE then do;

	     trace_message_info.from_system =
		rank (p_message_ptr
		-> request_more_message.header.source_system);
	     trace_message_info.from_major =
		rank (p_message_ptr
		-> request_more_message.header.source_major);
	     trace_message_info.dest_minor = p_minor;
	     trace_message_info.message =
		p_message_ptr -> request_more_message.header.source_minor;
	     call trace_message_ (p_trace_iocb_ptr,
		addr (trace_message_info));
	end;

	else if rank (p_message_ptr -> event_message.header.msg_type)
	     = CONTINUE then do;

	     trace_message_info.from_system =
		rank (p_message_ptr
		-> more_remaining_message.header.source_system);
	     trace_message_info.from_major =
		rank (p_message_ptr
		-> more_remaining_message.header.source_major);
	     trace_message_info.dest_minor =
		rank (p_message_ptr
		-> more_remaining_message.header.minor);
	     trace_message_info.message =
		substr (p_message_ptr
		-> more_remaining_message.data.data_buf, 1,
		p_message_len - 6);
	     call trace_message_ (p_trace_iocb_ptr,
		addr (trace_message_info));
	end;

	else do;
	     trace_message_info.from_system =
		rank (p_message_ptr
		-> last_message.header.source_system);
	     trace_message_info.from_major =
		rank (p_message_ptr -> last_message.header.source_major);
	     trace_message_info.dest_minor =
		rank (p_message_ptr -> last_message.header.minor);
	     trace_message_info.message =
		substr (p_message_ptr
		-> last_message.data.data_buf, 1, p_message_len - 5);
	     trace_message_info.msg_type = LAST;
	     call trace_message_ (p_trace_iocb_ptr,
		addr (trace_message_info));
	end;

%page;
/* INCLUDE FILES */
%include mowse;
%include mowse_messages;

     end;




		    put_application_outbuff_.pl1    08/07/87  1554.3rew 08/07/87  1454.7       46197



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

/****^  HISTORY COMMENTS:
  1) change(86-07-03,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
put_application_outbuff_:
     proc (p_mcb_ptr, p_destination_system, p_destination_major,
	p_destination_minor, p_data_ptr, p_data_length, p_code);

/* : PROGRAM FUNCTION

Places data into the applicatio'n's output buffer and updates the required
field in the mcb of the application.
*/

/* : NOTES
*/


/* INPUT PARAMETERS */
dcl p_data_ptr	       ptr parameter;	    /* pointer to data to be placed in the buffer */
dcl p_mcb_ptr	       ptr parameter;	    /* Pointer to mcb of application */
dcl p_data_length	       fixed bin parameter;	    /* length of data to place in buffer */
dcl p_destination_system   fixed bin parameter;	    /* system destination of message */
dcl p_destination_major    fixed bin parameter;	    /* major capability destination */
dcl p_destination_minor    fixed bin parameter;	    /* minor destination */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);	    /* Error code */


/* MISC VARIABLES */
dcl output_buffer_ptr      ptr;
dcl data		       char (p_data_length) based (p_data_ptr);
					    /* data to be placed in buffer */
dcl bytes_to_copy	       fixed bin (17);	    /* length of data */
dcl system_free_area       area based (system_free_area_ptr);
dcl data_space	       char (bytes_to_copy) based;



/* STRUCTURES */


/* SYSTEM CALLS */


/* SYSTEM CALL SUPPORT */
dcl ws_error_$invalid_data_ptr
		       fixed bin (35) ext static;
dcl ws_error_$output_buffer_overflow
		       fixed bin (35) ext static;
dcl ws_error_$invalid_mcb  fixed bin (35) ext static;


/* EXTERNAL CALLS */
dcl get_system_free_area_  entry () returns (ptr);


/* EXTERNAL CALL SUPPORT */
dcl system_free_area_ptr   ptr;


/* BUILTINS */
dcl null		       builtin;
dcl byte		       builtin;
dcl min		       builtin;
dcl substr	       builtin;


/* CONDITIONS */


/* CONSTANTS */


/**/
/* INITIALIZATION */

	output_buffer_ptr = null;
	system_free_area_ptr = get_system_free_area_ ();

/* MAIN */

/* : if mcb_ptr is invalid, set error code */

	if p_mcb_ptr = null then
	     p_code = ws_error_$invalid_mcb;

/* : else if data_ptr is invalid, set error code */

	else if p_data_ptr = null then
	     p_code = ws_error_$invalid_data_ptr;

/* : else okay to copy
     - determine the amount characters to copy given the 
       size of the output buffer as upper limit */

	else do;
	     bytes_to_copy =
		min (p_mcb_ptr -> mcb.outbuff_length, p_data_length);

/* : - if all the data can be copied then set the code to 0 to indicate no
       errors otherwise set the code to indicate some data is truncated */

	     if bytes_to_copy = p_data_length then
		p_code = 0;
	     else
		p_code = ws_error_$output_buffer_overflow;

/* : allocate the output buffer is system space */

	     allocate output_buffer in (system_free_area)
		set (output_buffer_ptr);
	     output_buffer_ptr -> output_buffer.buffer_position = 0;
	     output_buffer_ptr -> output_buffer.buffer_length =
		bytes_to_copy;
	     output_buffer_ptr -> output_buffer.next_buffer = null;
	     output_buffer_ptr -> output_buffer.destination_system =
		byte (p_destination_system);
	     output_buffer_ptr -> output_buffer.destination_major =
		byte (p_destination_major);
	     output_buffer_ptr -> output_buffer.destination_minor =
		byte (p_destination_minor);
	     allocate data_space in (system_free_area)
		set (output_buffer_ptr -> output_buffer.data);

/* : copy the data into the output buffer set the data length field for
     the output buffer in the mcb */

	     substr (output_buffer_ptr -> output_buffer.data
		-> data_space, 1, bytes_to_copy) =
		substr (data, 1, bytes_to_copy);

/* : Attach the new buffer to the lists of buffers to be sent
     as messages to other capabilities. */

	     if p_mcb_ptr -> mcb.outbuff_list_start = null then do;
		p_mcb_ptr -> mcb.outbuff_list_start = output_buffer_ptr;
		p_mcb_ptr -> mcb.outbuff_list_end = output_buffer_ptr;
	     end;
	     else do;
		p_mcb_ptr -> mcb.outbuff_list_end
		     -> output_buffer.next_buffer = output_buffer_ptr;
		p_mcb_ptr -> mcb.outbuff_list_end = output_buffer_ptr;
	     end;
	end;

%page;
/* INCLUDE FILES */
%include "mowse";
%include "mowse_mcb";

/* : END */
     end;




		    rcvdat_.pl1                     08/07/87  1553.9rew 08/07/87  1450.0       72864



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

/****^  HISTORY COMMENTS:
  1) change(86-08-27,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-10-22,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Added checks for messages with invalid destinations.
  3) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
  4) change(86-12-10,Flegel), approve(86-12-10,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Replaced signalling of mowse_fatal_error with a call to fatal_mowse_trap_.
  5) change(86-12-11,Flegel), approve(86-12-11,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Guaruntee that a RESPONSE_DISCONNECT message is sent back in the event of
     an error to the destination of a REQUEST_DISCONNECT message.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
rcvdat_:
     proc (p_mowse_mcb_ptr, p_msg_ptr, p_msg_len, p_status);

/* : PROGRAM FUNCTION
Get a message from the Protocol Handler (0.1) and pass it on to the parser.
*/

/* : NOTES

All error handling should be done from here on down.
*/

/* INPUT PARAMETERS */
dcl p_mowse_mcb_ptr	       ptr parameter;	    /* mcb of mowse_io_ */
dcl p_msg_ptr	       ptr parameter;	    /* Pointer to a message record */
dcl p_msg_len	       fixed bin (21) parameter;  /* Length of message */
dcl p_status	       fixed bin (35) parameter;  /* Error code */


/* EXTERNAL CALLS */
dcl send_msg_	       entry (ptr, fixed bin, fixed bin, ptr, fixed bin,
		       fixed bin, fixed bin (35));
dcl capability_$pack       entry (fixed bin, fixed bin, fixed bin,
		       fixed bin (35));
dcl ws_$put_background_message
		       entry () options (variable);
dcl message_parser_	       entry (ptr, fixed bin, ptr, fixed bin (35));

/* SYSTEM CALLS */

/* SYSTEM CALL SUPPORT */
dcl ws_error_$no_capability
		       fixed bin (35) ext static;
dcl ws_error_$invalid_capability_number
		       fixed bin (35) ext static;
dcl ws_error_$invalid_system_id
		       fixed bin (35) ext static;

/* STRUCTURES */

/* MISC VARIABLES */
dcl mowse_info_ptr	       ptr;
dcl system	       fixed bin;
dcl major		       fixed bin;
dcl minor		       fixed bin;
dcl source_system	       fixed bin;
dcl source_major	       fixed bin;
dcl ecode		       fixed bin (35);

/* BUILTINS */
dcl convert	       builtin;
dcl null		       builtin;
dcl rank		       builtin;
dcl addr		       builtin;
dcl byte		       builtin;

/* CONDITIONS */

/**/

/* INITIALIZATION */

	p_status = 0;
	message_ptr = p_msg_ptr;
	message_len = convert (message_len, p_msg_len);

/* MAIN */

/* : Get mowse_info_ptr */

	mowse_info_ptr = p_mowse_mcb_ptr -> mcb.mowse_info_ptr;

/* : Ensure that the destination of the message is valid. Ignore messages
     received for the wrong system */

	system = rank (message_ptr -> input_message.header.system);
	major = rank (message_ptr -> input_message.header.major);
	minor = rank (message_ptr -> input_message.header.minor);
	if minor ^= CONTINUE then do;
	     source_system =
		rank (message_ptr -> input_message.header.source_system);
	     source_major =
		rank (message_ptr -> input_message.header.source_major);
	end;
	else do;
	     source_system =
		rank (message_ptr
		-> more_remaining_message.header.source_system);
	     source_major =
		rank (message_ptr
		-> more_remaining_message.header.source_major);
	end;

/* : If destination major or system is invalid, send an error */

	if major < INTERNAL | major > MAXIMUM_CAT_ENTRY then do;
	     call message_error (system, major, minor, source_system,
		source_major, p_mowse_mcb_ptr,
		ws_error_$invalid_capability_number);
	     return;
	end;

/* : If the system is invalid, send an error */

	if system ^= LOCAL_SYSTEM then do;
	     call message_error (system, major, minor, source_system,
		source_major, p_mowse_mcb_ptr,
		ws_error_$invalid_system_id);
	     return;
	end;

/* : If the major number of the destination is valid ensure that there
     is a valid MCB for this capability (ie the application is registered
     with MOWSE). */

	if major ^= INTERNAL then
	     if p_mowse_mcb_ptr -> mcb.mowse_info_ptr
		-> mowse_info.local_cat (major).mcb_ptr = null
	     then do;
		call message_error (system, major, minor, source_system,
		     source_major, p_mowse_mcb_ptr,
		     ws_error_$no_capability);
		return;
	     end;

/* : call message parser with message length and pointer to mesaage */

	call message_parser_ (p_mowse_mcb_ptr, message_len, p_msg_ptr,
	     ecode);

/* : if the message is invalid then display a message indicating this
     fact and terminate the capability sending the message */

	p_status = 0;
	if ecode ^= 0 then do;
	     call message_error (system, major, minor, source_system,
		source_major, p_mowse_mcb_ptr, ecode);
	     return;
	end;

/**/
/* INTERNAL PROCEDURES */

/* *** Procedure: message_error - Internal proc for rcvdat_  *** */


message_error:
     proc (p_system, p_major, p_minor, p_source_system, p_source_major,
	p_mowse_mcb_ptr, p_code);

/* : PROCEDURE FUNCTION

Generate the appropriate action when an invalid message has been received.
*/

/* INPUT PARAMETERS */
dcl p_minor	       fixed bin parameter;	    /* Destination minor capability */
dcl p_mowse_mcb_ptr	       ptr parameter;
dcl p_code	       fixed bin (35);
dcl p_source_major	       fixed bin parameter;	    /* Source major of message */
dcl p_source_system	       fixed bin parameter;	    /* Source system of message */
dcl p_major	       fixed bin parameter;	    /* Destination major */
dcl p_system	       fixed bin parameter;


/* MISC VARIABLES */
dcl data_message	       char (32);		    /* Data message string */
dcl source_major_cap       fixed bin;		    /* Packed capability number */
dcl data		       char (1);		    /* Data to send_msg_ */

/* INITIALIZATION */

/* : Generate an error message only if it is not because the destination
     capability does not exist */

	if p_code ^= ws_error_$no_capability then
	     call ws_$put_background_message (p_mowse_mcb_ptr,
		p_code, "MULTICS MOWSE", "From [^d:^d] to [^d:^d:^d]",
		p_source_system, p_source_major, p_system, p_major,
		p_minor);
	p_code = 0;

/* : If invalid message was from MOWSE then do not send a message to the
     source of the message. */

	if p_source_major = INTERNAL then
	     return;

/* : Otherwise send a message to the source of the invalid message. */

	call capability_$pack (p_source_system, p_source_major,
	     source_major_cap, ecode);
	if p_code ^= 0 then
	     return;

	if p_minor = REQUEST_DISCONNECT then do;
	     data = byte (REJECT);
	     call send_msg_ (p_mowse_mcb_ptr, source_major_cap,
		RESPONSE_DISCONNECT, addr (data), 1, BG, p_code);
	end;
	else if p_minor = STATUS then do;
	     data_message = "Capability does not exist.";
	     call send_msg_ (p_mowse_mcb_ptr, source_major_cap,
		STATUS_REPLY, addr (data_message), 26, FG, p_code);
	end;

	else if p_minor >= MINIMUM_USER_MINOR & p_minor <= MAXIMUM_USER_MINOR
	     then
	     call send_msg_ (p_mowse_mcb_ptr, source_major_cap,
		FAIL_CAPABILITY, null, 0, BG, p_code);
	else
	     call send_msg_ (p_mowse_mcb_ptr, source_major_cap,
		SYSTEM_ERROR, null, 0, BG, ecode);

     end message_error;

/**/

/**/
%page;

/* INCLUDE FILES */
%include mowse;
%include mowse_mcb;
%include mowse_messages;
%include mowse_info;

/* : END */
     end rcvdat_;




		    release_outbuffer_.pl1          08/07/87  1554.3rew 08/07/87  1454.7       23337



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


/****^  HISTORY COMMENTS:
  1) change(86-12-03,Flegel), approve(86-12-03,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created to place buffer freeing in one place.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
release_outbuffer_:
     proc (p_mcb_ptr);

/* : PROGRAM FUNCTION

Free the output buffer associated with the supplied mcb.
*/

/* : NOTES

Buffer strucure is as follows:

   data -------------------> characters (output_buffer.buffer_length)
   next_buffer
     |
     V
   data -------------------> characters (output_buffer.buffer_length)
   next_buffer
     |
     V
   
*/

/* INPUT PARAMETERS */
dcl p_mcb_ptr	       ptr;		    /* MCB */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl temp_buff_ptr	       ptr;		    /* Miscellaneous ptr */
dcl output_buffer_ptr      ptr;		    /* Output buffer node */
dcl output_buffer_length   fixed bin;		    /* Length of outbufferdata */

/* STRUCTURES */
dcl output_buffer_data     char (output_buffer_length)
		       based (output_buffer_ptr); /* Freed buffer */

/* SYSTEM CALLS */

/* SYSTEM CALL SUPPORT */

/* EXTERNAL CALLS */

/* EXTERNAL CALL SUPPORT */

/* BUILTINS */
dcl null		       builtin;

/* CONDITIONS */

/* CONSTANTS */

/**/
/* INITIALIZATION */
	if p_mcb_ptr = null then
	     return;

/* MAIN */

	temp_buff_ptr = p_mcb_ptr -> mcb.outbuff_list_start;
	p_mcb_ptr -> mcb.outbuff_list_start = null;
	p_mcb_ptr -> mcb.outbuff_list_end = null;
	do while (temp_buff_ptr ^= null);
	     output_buffer_ptr = temp_buff_ptr -> output_buffer.data;
	     output_buffer_length
		= temp_buff_ptr -> output_buffer.buffer_length;
	     free output_buffer_data;
	     output_buffer_ptr = null;

	     output_buffer_ptr = temp_buff_ptr;
	     temp_buff_ptr = output_buffer_ptr -> output_buffer.next_buffer;
	     free output_buffer_ptr -> output_buffer;
	     output_buffer_ptr = null;
	end;

%page;
/* INCLUDE FILES */
%include mowse_mcb;

/* : END */
     end;




		    send_mowse_message_.pl1         08/07/87  1554.1rew 08/07/87  1453.7      102744



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

/****^  HISTORY COMMENTS:
  1) change(86-07-01,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-21,Flegel), approve(86-12-10,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
  3) change(86-12-10,Flegel), approve(86-12-10,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Replaced signalling of mowse_fatal_error with a call to fatal_mowse_trap_.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
send_mowse_message_:
     proc (p_mcb_ptr, p_local_system, p_local_major, p_remote_system,
	p_remote_major, p_remote_minor, p_msg_type, p_data_ptr,
	p_data_length, p_channel, p_code);


/* : PROGRAM FUNCTION

Send a message for an application on the remote machine; the message includes
local and remote major capability numbers, a minor capability number, and
possibly data.  There are 3 possible formats for the messages, depending on
its use:

format 1) message composed of major capability on remote machine followed by
minor capability on remote machine followed by major capability on local
machine followed by data

format 2) message composed of major capability on remote machine followed by
WS_SENT_MORE value followed by minor capability on remote machine followed by
major capability on local machine followed by data

format 3) message composed of major capability on local machine followed by
WS_REQUEST_MORE value followed by major capability on remote machine followed
by minor capability on remote machine
*/

/* : NOTES
*/

/* INPUT PARAMETERS */
dcl p_mcb_ptr	       ptr parameter;	    /* pointer to sender's mcb */
dcl p_local_system	       fixed bin parameter;	    /* local system id */
dcl p_local_major	       fixed bin parameter;	    /* senders major */
dcl p_remote_system	       fixed bin parameter;	    /* remote system id */
dcl p_remote_major	       fixed bin parameter;	    /* receiver's major */
dcl p_remote_minor	       fixed bin parameter;	    /* receiver's minor */
dcl p_msg_type	       fixed bin parameter;	    /* type of message */
dcl p_data_ptr	       ptr parameter;	    /* message pointer */
dcl p_data_length	       fixed bin parameter;	    /* length of message */
dcl p_channel	       fixed bin parameter;	    /* Channel of message */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);	    /* Error code */

/* MISC VARIABLES */
dcl mowse_info_ptr	       ptr;		    /* Pointer to Mowse info */
dcl local_data_ptr	       ptr;
dcl data		       char (p_data_length) based (p_data_ptr);
dcl message	       char (PACKET_SIZE);
dcl message_length	       fixed bin (17);
dcl some_space	       char (1);


/* STRUCTURES */
dcl 01 mowse_io_msg	       like mowse_io_message automatic;


/* SYSTEM CALLS */
dcl iox_$control	       entry (ptr, char (*), ptr, fixed bin (35));


/* SYSTEM CALL SUPPORT */
dcl ws_error_$invalid_continue_message
		       fixed bin (35) ext static;
dcl ws_error_$invalid_last_message
		       fixed bin (35) ext static;
dcl ws_error_$invalid_data_ptr
		       fixed bin (35) ext static;
dcl ws_error_$invalid_more_message
		       fixed bin (35) ext static;
dcl ws_error_$invalid_message
		       fixed bin (35) ext static;

/* EXTERNAL CALLS */
dcl get_mowse_info_ptr_    entry (ptr, ptr, fixed bin (35));
dcl trace_message_	       entry (ptr, ptr);
dcl fatal_mowse_trap_      entry (fixed bin (35));

/* EXTERNAL CALL SUPPORT */

/* BUILTINS */
dcl null		       builtin;
dcl addr		       builtin;
dcl byte		       builtin;
dcl rank		       builtin;
dcl substr	       builtin;

/* CONDITIONS */

/* CONSTANTS */
dcl TRUE		       bit (1) int static options (constant) init ("1"b);

/**/
/* INITIALIZATION */

	local_data_ptr = p_data_ptr;
	p_code = 0;
	call get_mowse_info_ptr_ (p_mcb_ptr, mowse_info_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* MAIN */

/* : check for a null p_data_ptr given if the message type can contain data
     and the data length is not 0 */

	if p_data_ptr = null & p_data_length ^= 0 &
	     (p_msg_type = LAST | p_msg_type = MORE) then do;
	     p_code = ws_error_$invalid_data_ptr;
	     return;
	end;

/* : check for data exceeding packet size for last packet message type */

	if p_channel = BG then do;
	     if ((p_data_length - 5) > PACKET_SIZE) & (p_msg_type = LAST)
		then
		p_code = ws_error_$invalid_last_message;

/* : check for data exceeding packet size for other message type */

	     else if ((p_data_length - 6) > PACKET_SIZE) &
		(p_msg_type = CONTINUE) then
		p_code = ws_error_$invalid_continue_message;

	     else if (p_data_length ^= 6) & (p_msg_type = MORE) then
		p_code = ws_error_$invalid_more_message;
	end;
	else if p_channel = FG then do;
	     if ((p_data_length - 3) > PACKET_SIZE) then
		p_code = ws_error_$invalid_last_message;
	end;



/* : data lengths are okay, process message
     - assign a valid value in case ptr gets referenced */

	if local_data_ptr = null & p_data_length = 0 then
	     local_data_ptr = addr (some_space);

/* : - use p_msg_type to determine which message type to send
     - if p_msg_type = MORE then
     -- make a "MORE" message */

	if p_msg_type = MORE then do;
	     substr (message, 1, 1) = byte (p_local_system);
	     substr (message, 2, 1) = byte (p_local_major);
	     substr (message, 3, 1) = byte (MORE);
	     substr (message, 4, 1) = byte (p_remote_system);
	     substr (message, 5, 1) = byte (p_remote_major);
	     substr (message, 6, 1) = byte (p_remote_minor);
	     message_length = 6;

	     if mowse_info_ptr -> mowse_info.mowse_flags.trace = TRUE
	     then do;
		trace_message_info.direction = SEND;
		trace_message_info.from_system = p_remote_system;
		trace_message_info.from_major = p_remote_major;
		trace_message_info.dest_system = p_local_system;
		trace_message_info.dest_major = p_local_major;
		trace_message_info.dest_minor = -1;
		trace_message_info.msg_type = p_msg_type;
		trace_message_info.message = "<null>";
		call trace_message_ (
		     mowse_info_ptr
		     -> mowse_info.mowse_flags.trace_file_iocb,
		     addr (trace_message_info));
	     end;

/* : -- initialize the structure required to make the control order
     to send the message. */

	     mowse_io_msg.version = mowse_io_info_version_1;
	     mowse_io_msg.channel = p_channel;
	     mowse_io_msg.io_message_ptr = addr (message);
	     mowse_io_msg.io_message_len = message_length;
	end;

/* : - else if p_msg_type = CONTINUE then
     -- make a message with data specifying more to come */

	else if p_msg_type = CONTINUE then do;
	     substr (message, 1, 1) = byte (p_remote_system);
	     substr (message, 2, 1) = byte (p_remote_major);
	     substr (message, 3, 1) = byte (CONTINUE);
	     substr (message, 4, 1) = byte (p_remote_minor);
	     substr (message, 5, 1) = byte (p_local_system);
	     substr (message, 6, 1) = byte (p_local_major);
	     substr (message, 7, p_data_length) =
		substr (data, 1, p_data_length);
	     message_length = p_data_length + 6;

	     if mowse_info_ptr
		-> mowse_info.mowse_flags.trace = TRUE then do;

		trace_message_info.direction = SEND;
		trace_message_info.from_system = p_local_system;
		trace_message_info.from_major = p_local_major;
		trace_message_info.dest_system = p_remote_system;
		trace_message_info.dest_major = p_remote_major;
		trace_message_info.dest_minor = p_remote_minor;
		trace_message_info.msg_type = p_msg_type;
		trace_message_info.message =
		     substr (message, 7, p_data_length);
		call trace_message_ (mowse_info_ptr
		     -> mowse_info.mowse_flags.trace_file_iocb,
		     addr (trace_message_info));
	     end;

/* : -- allocate and initialize the structure required to make
        the control order to send the message. */

	     mowse_io_msg.version = mowse_io_info_version_1;
	     mowse_io_msg.channel = p_channel;
	     mowse_io_msg.io_message_ptr = addr (message);
	     mowse_io_msg.io_message_len = message_length;
	end;

/* : - else if p_msg_type = LAST then
     -- make final message to be send */

	else if p_msg_type = LAST then do;
	     if p_channel = FG then do;
		substr (message, 1, 1) = byte (p_remote_minor);
		substr (message, 2, 1) = byte (p_local_system);
		substr (message, 3, 1) = byte (p_local_major);
		substr (message, 4, p_data_length) =
		     substr (data, 1, p_data_length);
		message_length = p_data_length + 3;
	     end;
	     else do;
		substr (message, 1, 1) = byte (p_remote_system);
		substr (message, 2, 1) = byte (p_remote_major);
		substr (message, 3, 1) = byte (p_remote_minor);
		substr (message, 4, 1) = byte (p_local_system);
		substr (message, 5, 1) = byte (p_local_major);
		substr (message, 6, p_data_length) =
		     substr (data, 1, p_data_length);
		message_length = p_data_length + 5;
	     end;

	     if mowse_info_ptr
		-> mowse_info.mowse_flags.trace = TRUE then do;

		trace_message_info.direction = SEND;
		trace_message_info.from_system = p_local_system;
		trace_message_info.from_major = p_local_major;
		trace_message_info.dest_system = p_remote_system;
		trace_message_info.dest_major = p_remote_major;
		trace_message_info.dest_minor = p_remote_minor;
		trace_message_info.msg_type = p_msg_type;

		if p_remote_minor = PUT_TO_BACKGROUND_BUFFER |
		     p_remote_minor = PUT_TO_QUERY_MESSAGE_BUFFER then

		     trace_message_info.message =
			substr (message, 4, p_data_length);
		else
		     trace_message_info.message =
			substr (message, 6, p_data_length);

		call trace_message_ (mowse_info_ptr
		     -> mowse_info.mowse_flags.trace_file_iocb,
		     addr (trace_message_info));
	     end;

/* : -- allocate and initialize the structure required to make
        the control order to send the message. */

	     mowse_io_msg.version = mowse_io_info_version_1;
	     mowse_io_msg.channel = p_channel;
	     mowse_io_msg.io_message_ptr = addr (message);
	     mowse_io_msg.io_message_len = message_length;
	end;

/* : otherwise the message type specified is invalid
     (This should never happen) */

	else do;
	     call fatal_mowse_trap_ (ws_error_$invalid_message);
	     return;
	end;

/* : Perform iox_$control call to send message to destination */

/* COMPILER BUG AS THIS ALWAYS FAILED WHEN COMPILED WITH subscriptrange PREFIX */
(nosubscriptrange):
(nosize):
(nostringsize):
(nosubrg):
	if rank (substr (message, 1, 1)) = LOCAL_SYSTEM then do;
	     call iox_$control (p_mcb_ptr -> mcb.iocb_ptr,
		"send_local_message", addr (mowse_io_msg), p_code);
	end;
	else
	     call iox_$control (p_mcb_ptr -> mcb.iocb_ptr,
		"send_message", addr (mowse_io_msg), p_code);

	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

%page;
/* INCLUDE FILES */

%include mowse;
%include mowse_messages;
%include mowse_mcb;
%include mowse_io_control_info;
%include mowse_info;

/* : END */
     end;




		    send_msg_.pl1                   08/07/87  1554.1rew 08/07/87  1454.3       36612



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

/****^  HISTORY COMMENTS:
  1) change(86-07-01,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
send_msg_:
     proc (p_mcb_ptr, p_major, p_minor, p_arg, p_arg_len, p_channel, p_ecode);

/* : PROGRAM FUNCTION

Send a message to the specified application.
*/

/* : NOTES
*/


/* INPUT PARAMETERS */
dcl p_mcb_ptr	       ptr parameter;	    /* Pointer to callers mcb */
dcl p_major	       fixed bin (17) parameter;  /* Destination major */
dcl p_minor	       fixed bin (17) parameter;  /* Destination minor */
dcl p_arg		       ptr parameter;	    /* Message pointer */
dcl p_arg_len	       fixed bin (17) parameter;  /* Message length */
dcl p_channel	       fixed bin (17) parameter;  /* Channel (FG,BG) */
dcl p_ecode	       fixed bin (35) parameter;  /* Error code */

/* MISC VARIABLES */
dcl source_system	       fixed bin (17);
dcl source_p_major	       fixed bin (17);
dcl dest_system	       fixed bin (17);
dcl dest_p_major	       fixed bin (17);


/* EXTERNAL CALLS */
dcl put_application_outbuff_
		       entry (ptr, fixed bin, fixed bin, fixed bin,
		       ptr, fixed bin, fixed bin (35));
dcl send_mowse_message_    entry (ptr, fixed bin, fixed bin, fixed bin,
		       fixed bin, fixed bin, fixed bin, ptr,
		       fixed bin, fixed bin, fixed bin (35));
dcl send_outbuff_data_     entry (ptr, fixed bin, fixed bin, fixed bin,
		       fixed bin (35));
dcl capability_$unpack     entry (fixed bin, fixed bin, fixed bin, fixed
		       bin (35));


/* SYSTEM CALL SUPPORT */
dcl ws_error_$invalid_data_ptr
		       fixed bin (35) ext static;
dcl ws_error_$invalid_mcb  fixed bin (35) ext static;
dcl ws_error_$invalid_capability_number
		       fixed bin (35) ext static;

/* BUILTINS */
dcl null		       builtin;

/**/

/* INITIALIZATION */

/* MAIN */

/* : Null message then return */

	if (p_arg = null) & (p_arg_len ^= 0) then do;
	     p_ecode = ws_error_$invalid_data_ptr;
	     return;
	end;

/* : Check the mcb pointer */

	if p_mcb_ptr = null then do;
	     p_ecode = ws_error_$invalid_mcb;
	     return;
	end;

/* : Unpack the source and destination */

	call capability_$unpack (source_system, source_p_major,
	     p_mcb_ptr -> mcb.major_capability, p_ecode);
	if p_ecode ^= 0 then
	     return;

	call capability_$unpack (dest_system, dest_p_major, p_major,
	     p_ecode);
	if p_ecode ^= 0 then
	     return;

/* : If the message is large, use the outbuffer */

	if (p_arg_len > MAXIMUM_PACKET_SIZE) then do;
	     if (dest_p_major < MINIMUM_CAT_ENTRY |
		dest_p_major > MAXIMUM_CAT_ENTRY) then do;
		p_ecode = ws_error_$invalid_capability_number;
		return;
	     end;

	     call put_application_outbuff_ (p_mcb_ptr, dest_system,
		dest_p_major, p_minor, p_arg, p_arg_len, p_ecode);
	     if p_ecode ^= 0 then
		return;
	     call send_outbuff_data_ (p_mcb_ptr, dest_system, dest_p_major,
		p_minor, p_ecode);
	     return;
	end;

/* : Send the message */

	call send_mowse_message_ (p_mcb_ptr, source_system,
	     source_p_major, dest_system, dest_p_major, p_minor, LAST,
	     p_arg, p_arg_len, p_channel, p_ecode);

%page;

/* INCLUDE FILES */
%include mowse;
%include mowse_messages;
%include mowse_info;
%include mowse_mcb;

/* : END */
     end send_msg_;




		    send_outbuff_data_.pl1          08/07/87  1554.2rew 08/07/87  1454.6       64890



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

/****^  HISTORY COMMENTS:
  1) change(86-07-01,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Corrected minor capability number sending for multiple long messages
     pending when sending the current message.
  3) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
  4) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Corrected handling of multiple long messages (although these aren't
     properly supported in MOWSE protocol of long messages).
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
send_outbuff_data_:
     proc (p_mcb_ptr, p_system, p_major, p_minor, p_ecode);

/* : PROGRAM FUNCTION

Sends the contents of the output buffer to an application on the remote
machine.  Only one packet of data is sent per call to this routine.  If the
data exceeds the packet size, as much of the data as possible is sent in a
SENT_MORE type format 2) message otherwise all the data is sent in a SENT_LAST
type (format 1) message.  The pointers and fields in the mcb indicating the
location of the output buffer and where to sent the next batch of data will be
updated.  See mowse>mu_side>d>long_message_format for formats.
*/

/* : NOTES
*/


/* INPUT PARAMETERS */
dcl p_mcb_ptr	       ptr parameter;	    /* mcb contains outbuff info */
dcl p_system	       fixed bin (17) parameter;  /* system to send data to */
dcl p_major	       fixed bin parameter;	    /* capability to send data to */
dcl p_minor	       fixed bin parameter;	    /* minor of data */
dcl p_ecode	       fixed bin (35) parameter;  /* error code */


/* MISC VARIABLES */
dcl minor		       fixed bin;		    /* Minor cap of message protion */
dcl data_space	       (p_mcb_ptr -> mcb.outbuff_length) char
		       based (data_ptr);
dcl message_data	       ptr;
dcl data_ptr	       ptr;
dcl mowse_info_ptr	       ptr;		    /* Pointer to mowse info structure */
dcl system	       fixed bin;
dcl major		       fixed bin;
dcl channel	       fixed bin;
dcl chars_left	       fixed bin;
dcl chars_to_send	       fixed bin;
dcl used_output_buffer_len fixed bin;
dcl used_output_buffer     char (used_output_buffer_len) based (temp_ptr);
dcl temp_ptr	       ptr;


/* SYSTEM CALL SUPPORT */
dcl ws_error_$invalid_system_id
		       fixed bin (35) ext static;
dcl ws_error_$input_buffer_empty
		       fixed bin (35) ext static;
dcl ws_error_$invalid_capability_number
		       fixed bin (35) ext static;

/* EXTERNAL CALLS */
dcl send_mowse_message_    entry (ptr, fixed bin, fixed bin, fixed bin,
		       fixed bin, fixed bin, fixed bin, ptr,
		       fixed bin, fixed bin, fixed bin (35));
dcl get_mowse_info_ptr_    entry (ptr, ptr, fixed bin (35));
dcl capability_$unpack     entry (fixed bin, fixed bin, fixed bin,
		       fixed bin (35));

/* BUILTINS */
dcl addr		       builtin;
dcl null		       builtin;
dcl rank		       builtin;


/**/

/* INITIALIZATION */
	call get_mowse_info_ptr_ (p_mcb_ptr, mowse_info_ptr, p_ecode);
	if p_ecode ^= 0 then
	     return;

/* MAIN */

	channel = BG;
	if p_major < MINIMUM_CAT_ENTRY |
	     p_major > MAXIMUM_CAT_ENTRY then do;
	     p_ecode = ws_error_$invalid_capability_number;
	     return;
	end;

	if (p_system = REMOTE_SYSTEM) then
	     if (mowse_info_ptr
		-> mowse_info.remote_cat (p_major).major_capability = 0)
		|
		(p_mcb_ptr = null) then do;
		p_ecode = ws_error_$invalid_capability_number;
		return;
	     end;
	     else if (p_system = LOCAL_SYSTEM) then
		if (mowse_info_ptr
		     -> mowse_info.local_cat (p_major).mcb_ptr
		     ^= p_mcb_ptr)
		then do;
		     p_ecode = ws_error_$invalid_capability_number;
		     return;
		end;
		else do;
		     p_ecode = ws_error_$invalid_system_id;
		     return;
		end;

	call capability_$unpack (system, major,
	     (p_mcb_ptr -> mcb.major_capability), p_ecode);
	if p_ecode ^= 0 then
	     return;

/* : if the list of buffers to be sent is empty then return */

	if p_mcb_ptr -> mcb.outbuff_list_start = null then do;
	     p_ecode = 0;
	     return;
	end;

/* : get total number of characters left in message  */

	chars_left = p_mcb_ptr -> mcb.outbuff_list_start
	     -> output_buffer.buffer_length
	     - p_mcb_ptr -> mcb.outbuff_list_start
	     -> output_buffer.buffer_position;

/* : if the list is not empty then send a portion of the mesaage
     which is at most PACKET_SIZE long */

	if chars_left <= 0 then do;
	     p_ecode = ws_error_$input_buffer_empty;
	     return;
	end;

	if (chars_left <= (PACKET_SIZE - 6)) then
	     chars_to_send = chars_left;
	else
	     chars_to_send = PACKET_SIZE - 6;

/* : Get the data to send */

	data_ptr
	     = p_mcb_ptr -> mcb.outbuff_list_start -> output_buffer.data;
	message_data =
	     addr (data_ptr -> data_space
	     (p_mcb_ptr -> mcb.outbuff_list_start
	     -> output_buffer.buffer_position + 1));

/* : Figure out if this is the last or there is more in the message and
     then send it */

	if chars_to_send < chars_left then
	     minor = CONTINUE;
	else
	     minor = LAST;

	call send_mowse_message_ (p_mcb_ptr, system, major,
	     rank (p_mcb_ptr -> mcb.outbuff_list_start
	     -> output_buffer.destination_system),
	     rank (p_mcb_ptr -> mcb.outbuff_list_start
	     -> output_buffer.destination_major),
	     rank (p_mcb_ptr -> mcb.outbuff_list_start
	     -> output_buffer.destination_minor),
	     minor, message_data, chars_to_send, channel, p_ecode);
	if p_ecode ^= 0 then
	     return;

/* : Adjust the indexes in the outbuff data, there are two different
     circumstances of update depending on the length of the message that was
     sent */

	if chars_to_send < chars_left then do;
	     p_mcb_ptr -> mcb.outbuff_list_start
		-> output_buffer.buffer_position
		=
		p_mcb_ptr -> mcb.outbuff_list_start
		-> output_buffer.buffer_position
		+ chars_to_send;
	end;
	else do;
	     temp_ptr = p_mcb_ptr -> mcb.outbuff_list_start;
	     p_mcb_ptr -> mcb.outbuff_list_start
		= temp_ptr -> output_buffer.next_buffer;
	     used_output_buffer_len
		= temp_ptr -> output_buffer.buffer_length;
	     free temp_ptr -> output_buffer.data -> used_output_buffer;
	     free temp_ptr -> output_buffer;
	     temp_ptr = null;
	end;

%page;

/* INCLUDE FILES */

%include mowse;
%include mowse_info;
%include mowse_mcb;
%include mowse_messages;

/* : END send_outbuff_data_ */
     end send_outbuff_data_;




		    startup_parser_.pl1             08/07/87  1554.2rew 08/07/87  1453.4       82899



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

/****^  HISTORY COMMENTS:
  1) change(86-08-07,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created to parse through command line options.
  2) change(86-09-19,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Support to accept up to 32 capabilities to be autoloaded (-start_up).
  3) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
  4) change(87-02-25,Flegel), approve(87-02-25,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Added the force and no_force arguments.
  5) change(87-03-24,Flegel), approve(87-03-24,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Added -escape (-esc) and -network (-net) arguments.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
startup_parser_:
     proc (p_mowse_arg_list_ptr, p_arg_count, p_init_mowse_info_ptr,
	p_string, p_code);

/* : PROGRAM FUNCTION

Parse command line arguements and fills out a structure containing
information gathered from the command line.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_mowse_arg_list_ptr   ptr;		    /* Pointer to command line arguement list */
dcl p_arg_count	       fixed bin;		    /* Number of command line arguements */
dcl p_init_mowse_info_ptr  ptr;		    /* Pointer to structure containing initialization information */



/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;  /* return code */
dcl p_string	       char (*) var parameter;    /* return string for error message */

/* MISC VARIABLES */
dcl esc_index	       fixed bin (35);	    /* Octal conversion result */
dcl startup_indx	       fixed bin;		    /* Next available slot in startup list */
dcl system_free_area_ptr   ptr;
dcl system_free_area       area based (system_free_area_ptr);
dcl arg_str	       char (arg_len) based (arg_ptr);
					    /* argument in command line */
dcl arg_ptr	       ptr;		    /* Pointer to an arguement */
dcl arg_len	       fixed bin (21);	    /* length of a command line arguement */
dcl arg_num	       fixed bin;		    /* mowse arguement number */

/* SYSTEM CALLS */
dcl cv_oct_check_	       entry (char (*), fixed bin (35)) returns (fixed bin (35));
dcl get_system_free_area_  entry () returns (ptr);
dcl cu_$arg_ptr_rel	       entry (fixed bin, ptr, fixed bin (21),
		       fixed bin (35), ptr);


/* SYSTEM CALL SUPPORT */
dcl ws_error_$invalid_escape_char fixed bin (35) ext static;
dcl error_table_$badopt    fixed bin (35) ext static;
dcl error_table_$noarg     fixed bin (35) ext static;


/* BUILTINS */
dcl null		       builtin;
dcl substr	       builtin;

/**/

/* INITIALIZATION */
	p_string = "";
	startup_indx = 1;
	p_code = 0;
	system_free_area_ptr = get_system_free_area_ ();

/* MAIN */
/* : Allocate init_mowse_info structure */

	allocate init_mowse_info in (system_free_area)
	     set (p_init_mowse_info_ptr);
	init_mowse_info_ptr = p_init_mowse_info_ptr;

	init_mowse_info.version = MOWSE_VERSION_;
	init_mowse_info.flags.trace_sw = "0"b;
	init_mowse_info.flags.debug_sw = "0"b;
	init_mowse_info.flags.io_switch_sw = "0"b;
	init_mowse_info.flags.force_sw = "0"b;
	init_mowse_info.flags.start_up_sw = "0"b;
	init_mowse_info.flags.escape_sw = "0"b;
	init_mowse_info.flags.network_sw = "0"b;
	init_mowse_info.escape.chars (*) = "0"b;
	init_mowse_info.trace = "";
	init_mowse_info.debug = "";
	init_mowse_info.io_switch = "";
	init_mowse_info.startup (*) = "";

	if p_mowse_arg_list_ptr = null then
	     return;

	if p_arg_count <= 0 then
	     return;

/* : Parse command line arguements and fill out strucure accordingly
     Return with error code set if there was an error in the arguements */

	arg_num = 1;
	do while (arg_num <= p_arg_count);
	     call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len, p_code,
		p_mowse_arg_list_ptr);

/* : - debug */

	     if substr (arg_str, 1, arg_len) = "-debug" then do;
		init_mowse_info.debug = "debug.mowse_io_";
		init_mowse_info.flags.debug_sw = "1"b;

		if arg_num < p_arg_count then do;
		     call cu_$arg_ptr_rel ((arg_num + 1), arg_ptr,
			arg_len, p_code, p_mowse_arg_list_ptr);

		     if substr (arg_str, 1, 1) ^= "-" then do;
			init_mowse_info.debug
			     = substr (arg_str, 1, arg_len)
			     || ".mowse_io_";
			arg_num = arg_num + 1;
		     end;
		end;
	     end;

/* : - no_debug */

	     else if substr (arg_str, 1, arg_len) = "-no_debug" then do;
		init_mowse_info.flags.debug_sw = "0"b;
		init_mowse_info.debug = "";
	     end;

/* : - escape */

	     else if substr (arg_str, 1, arg_len) = "-escape"
		| substr (arg_str, 1, arg_len) = "-esc"
	     then do;
		call cu_$arg_ptr_rel ((arg_num + 1), arg_ptr,
		     arg_len, p_code, p_mowse_arg_list_ptr);
		if p_code ^= 0 then
		     return;
		if arg_ptr = null then do;
		     p_code = error_table_$noarg;
		     return;
		end;
		if substr (arg_str, 1, 1) = "-" then do;
		     p_code = error_table_$noarg;
		     return;
		end;

		esc_index = cv_oct_check_ (arg_str, p_code);
		if p_code ^= 0 then do;
		     p_string = arg_str;
		     return;
		end;
		if esc_index < 0 | esc_index > 255 then do;
		     p_code = ws_error_$invalid_escape_char;
		     p_string = arg_str;
		     return;
		end;

		p_init_mowse_info_ptr
		     -> init_mowse_info.escape.chars (esc_index) = "1"b;
		p_init_mowse_info_ptr -> init_mowse_info.flags.escape_sw
		     = "1"b;
		arg_num = arg_num + 1;
	     end;

/* : - network */

	     else if substr (arg_str, 1, arg_len) = "-network"
		| substr (arg_str, 1, arg_len) = "-net"
	     then do;
		p_init_mowse_info_ptr -> init_mowse_info.flags.network_sw
		     = "1"b;
	     end;

/* : - trace */

	     else if substr (arg_str, 1, arg_len) = "-trace" then do;
		init_mowse_info.trace = "trace.mowse_io_";
		init_mowse_info.flags.trace_sw = "1"b;

		if arg_num < p_arg_count then do;
		     call cu_$arg_ptr_rel ((arg_num + 1), arg_ptr,
			arg_len, p_code, p_mowse_arg_list_ptr);

		     if substr (arg_str, 1, 1) ^= "-" then do;
			p_init_mowse_info_ptr -> init_mowse_info.trace =
			     substr (arg_str, 1, arg_len)
			     || ".mowse_io_";
			arg_num = arg_num + 1;
		     end;
		end;
	     end;

/* : - no_trace */

	     else if substr (arg_str, 1, arg_len) = "-no_trace" then do;
		init_mowse_info.flags.trace_sw = "0"b;
		init_mowse_info.trace = "";
	     end;

/* : - io_switch */

	     else if substr (arg_str, 1, arg_len) = "-io_switch"
		| substr (arg_str, 1, arg_len) = "-iosw" then do;

		arg_num = arg_num + 1;
		call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len,
		     p_code, p_mowse_arg_list_ptr);

		if arg_ptr = null then do;
		     p_code = error_table_$noarg;
		     p_string = "";
		     return;
		end;
		else if substr (arg_str, 1, 1) = "-" then do;
		     p_code = error_table_$noarg;
		     p_string = "";
		     return;
		end;

		init_mowse_info.flags.io_switch_sw = "1"b;
		init_mowse_info.io_switch = substr (arg_str, 1, arg_len);
	     end;

/* : - start_up */

	     else if substr (arg_str, 1, arg_len) = "-start_up"
		| substr (arg_str, 1, arg_len) = "-su" then do;

		arg_num = arg_num + 1;
		call cu_$arg_ptr_rel (arg_num, arg_ptr, arg_len,
		     p_code, p_mowse_arg_list_ptr);

		if arg_ptr = null then do;
		     p_code = error_table_$noarg;
		     p_string = "";
		     return;
		end;

		if substr (arg_str, 1, 1) = "-" then do;
		     p_code = error_table_$noarg;
		     p_string = "";
		     return;
		end;

		init_mowse_info.flags.start_up_sw = "1"b;
		if startup_indx
		     <= MAXIMUM_CAT_ENTRY - MINIMUM_CAT_ENTRY + 1
		then do;
		     init_mowse_info.startup (startup_indx) =
			substr (arg_str, 1, arg_len);
		     startup_indx = startup_indx + 1;
		end;
	     end;

/* : - no_start_up */

	     else if substr (arg_str, 1, arg_len) = "-no_start_up"
		| substr (arg_str, 1, arg_len) = "-nsu"
	     then do;
		init_mowse_info.flags.start_up_sw = "0"b;
		init_mowse_info.startup (1) = "";
	     end;

/* : - force */

	     else if substr (arg_str, 1, arg_len) = "-force"
		| substr (arg_str, 1, arg_len) = "-fc"
	     then do;
		init_mowse_info.flags.force_sw = "1"b;
	     end;

/* : -no_force */

	     else if substr (arg_str, 1, arg_len) = "-no_force"
		| substr (arg_str, 1, arg_len) = "-nfc"
	     then do;
		init_mowse_info.flags.force_sw = "0"b;
	     end;

/* : - Default */

	     else do;
		p_code = error_table_$badopt;
		p_string = substr (arg_str, 1, arg_len);
		return;
	     end;

	     arg_num = arg_num + 1;
	end;

%page;
/* INCLUDE FILES */
%include mowse;
%include mowse_info;

/* : END */
     end;




		    terminate_mowse_.pl1            08/07/87  1554.2rew 08/07/87  1454.6       55179



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

/****^  HISTORY COMMENTS:
  1) change(86-08-28,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
terminate_mowse_:
     proc (p_mowse_info_ptr, p_code);

/* : PROGRAM FUNCTION

This module deallocates all space reserved by MOWSE and the applications
running in the MOWSE environment.
*/

/* : NOTES
*/

/* INPUT PARAMETERS */
dcl p_mowse_info_ptr       ptr;		    /* Pointer to mowse info structure */


/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);	    /* Error code */


/* MISC VARIABLES */
dcl cat_index	       fixed bin;		    /* CAT index */
dcl mcb_ptr	       ptr;		    /* MCB */
dcl temp_buff_ptr	       ptr;		    /* Miscellaneous ptr */
dcl temp_buff_ptr_2	       ptr;		    /* Miscellaneous ptr */
dcl input_buffer_length    fixed bin;		    /* Length of char buffer */
dcl partial_message_ptr_1  ptr;		    /* Node in message chain */
dcl partial_message_ptr_2  ptr;		    /* Node in message chain */
dcl mask		       bit (36) aligned;	    /* IPS mask */
dcl mowse_capability       fixed bin;		    /* MOWSE capability number */

/* STRUCTURES */
dcl input_buffer_data      char (input_buffer_length) based (temp_buff_ptr);
					    /* Freed buffer */

/* SYSTEM CALLS */
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 iox_$close	       entry (ptr, fixed bin (35));
dcl iox_$detach_iocb       entry (ptr, fixed bin (35));
dcl release_temp_segment_  entry (char (*), ptr, fixed bin (35));

/* SYSTEM CALL SUPPORT */


/* EXTERNAL CALLS */
dcl release_outbuffer_     entry (ptr);
dcl capability_$pack       entry (fixed bin, fixed bin, fixed bin,
		       fixed bin (35));

/* EXTERNAL CALL SUPPORT */


/* BUILTINS */
dcl null		       builtin;


/* CONDITIONS */


/* CONSTANTS */


/**/
/* INITIALIZATION */
	p_code = 0;
	call capability_$pack (LOCAL_SYSTEM, INTERNAL, mowse_capability,
	     p_code);
	if p_code ^= 0 then
	     return;

/* MAIN */

/* : If mowse_info_ptr is null then return */

	if p_mowse_info_ptr = null then
	     return;

/* : Look at mcb pointers associated with each local cat entry
     and release any space associated with it, if any */

	do cat_index = MINIMUM_CAT_ENTRY to MAXIMUM_CAT_ENTRY;
	     mcb_ptr = p_mowse_info_ptr
		-> mowse_info.local_cat (cat_index).mcb_ptr;

/* : - if mcb ptr is not null, then there is an application
     -- send a TERMINATE_APPLICATION to the capability
     - if application did not destroy its instance
     -- free its input buffer, output buffers (nodes and data), mcb */

	     if mcb_ptr ^= null then
		call mcb_ptr -> mcb.entry_var ((TERMINATE_APPLICATION),
		     (mowse_capability), (null), (0), (mcb_ptr),
		     (mcb_ptr -> data_block_ptr));

	     mcb_ptr = p_mowse_info_ptr
		-> mowse_info.local_cat (cat_index).mcb_ptr;
	     if mcb_ptr ^= null then do;
		temp_buff_ptr = mcb_ptr -> mcb.inbuff;
		if temp_buff_ptr ^= null then do;
		     input_buffer_length
			= mcb_ptr -> mcb.inbuff_data_length;
		     free input_buffer_data;
		     temp_buff_ptr = null;
		end;
		mcb_ptr -> inbuff = null;

		call release_outbuffer_ (mcb_ptr);

		free mcb_ptr -> mcb;
		mcb_ptr = null;
	     end;
	end;

/* : Clean up pending messages */

	temp_buff_ptr = p_mowse_info_ptr
	     -> mowse_info.message_manager_info.head_list_ptr;
	do while (temp_buff_ptr ^= null);
	     partial_message_ptr_1
		= temp_buff_ptr -> message_node.partial_msg_list_ptr;
	     do while (partial_message_ptr_1 ^= null);
		partial_message_ptr_2 =
		     partial_message_ptr_1 -> partial_message.msg_ptr;
		partial_message_ptr_1 =
		     partial_message_ptr_2 -> partial_message.next_msg;
		free partial_message_ptr_2 -> partial_message;
		partial_message_ptr_2 = null;
	     end;

	     temp_buff_ptr_2 = temp_buff_ptr;
	     temp_buff_ptr = temp_buff_ptr_2 -> message_node.next_node;
	     free temp_buff_ptr_2 -> message_node;
	     temp_buff_ptr_2 = null;
	end;

/* : Close debug and trace files if open */

	if p_mowse_info_ptr -> mowse_info.mowse_flags.debug_file_iocb
	     ^= null
	then do;
	     mask = ""b;
	     call hcs_$set_ips_mask (""b, mask);
	     call iox_$close (p_mowse_info_ptr
		-> mowse_info.mowse_flags.debug_file_iocb, (0));
	     call iox_$detach_iocb (p_mowse_info_ptr
		-> mowse_info.mowse_flags.debug_file_iocb, (0));
	     call hcs_$reset_ips_mask (mask, mask);
	end;

	if p_mowse_info_ptr -> mowse_info.mowse_flags.trace_file_iocb
	     ^= null
	then do;
	     mask = ""b;
	     call hcs_$set_ips_mask (""b, mask);
	     call iox_$close (p_mowse_info_ptr
		-> mowse_info.mowse_flags.trace_file_iocb, (0));
	     call iox_$detach_iocb (p_mowse_info_ptr
		-> mowse_info.mowse_flags.trace_file_iocb, (0));
	     call hcs_$reset_ips_mask (mask, mask);
	end;

/* : Free init_mowse_info structure */

	if p_mowse_info_ptr -> mowse_info.init_mowse_info_ptr ^= null
	then do;
	     free p_mowse_info_ptr
		-> mowse_info.init_mowse_info_ptr -> init_mowse_info;
	     p_mowse_info_ptr -> mowse_info.init_mowse_info_ptr = null;
	end;

/* : Release temporary segment */

	call release_temp_segment_ (temp_seg_name, p_mowse_info_ptr,
	     p_code);

%page;
/* INCLUDE FILES */
%include mowse_mcb;
%include mowse_messages;
%include mowse_info;
%include mowse;

/* : END */
     end;




		    trace_message_.pl1              08/07/87  1554.2rew 08/07/87  1454.5       80883



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

/****^  HISTORY COMMENTS:
  1) change(86-08-28,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
trace_message_:
     proc (p_iocb_ptr, p_trace_message_info_ptr);


/* : PROGRAM FUNCTION

Prints out diagnostic information about the messges received and sent by
MOWSE.
*/

/* : NOTES
*/

/* INPUT PARAMETERS */
dcl p_trace_message_info_ptr
		       ptr;		    /* Pointer to info to be contained in trace message */
dcl p_iocb_ptr	       ptr;		    /* Pointer to i/o switch control block */


/* OUTPUT PARAMETERS */


/* MISC VARIABLES */
dcl msg_type_name	       char (10) varying;
dcl direction_name	       char (3);
dcl from_system_name       char (32) varying;
dcl system_name	       char (32) varying;
dcl minor_name	       char (32) varying;


/* STRUCTURES */
dcl 01 trc_info	       like trace_message_info
		       based (p_trace_message_info_ptr);


/* SYSTEM CALLS */
dcl ioa_$ioa_switch	       entry () options (variable);
dcl ioa_$rsnnl	       entry () options (variable);

/* SYSTEM CALL SUPPORT */


/* EXTERNAL CALLS */


/* EXTERNAL CALL SUPPORT */


/* BUILTINS */
dcl length	       builtin;
dcl null		       builtin;

/* CONDITIONS */


/* CONSTANTS */


/**/
/* INITIALIZATION */


/* MAIN */
/* : Check the trace flag */

	if p_iocb_ptr = null then
	     return;

/* : Compose diagnostic message */

	if p_trace_message_info_ptr -> trc_info.direction = 0 then
	     direction_name = "SND";
	else if p_trace_message_info_ptr -> trc_info.direction = 1 then
	     direction_name = "RCV";
	else
	     direction_name = "???";

	if (p_trace_message_info_ptr -> trc_info.dest_minor < 32) &
	     (p_trace_message_info_ptr -> trc_info.dest_minor ^= -1)
	then do;
	     minor_name = "INVALID MINOR";
	     goto end_case;
	end;
	else if p_trace_message_info_ptr -> trc_info.dest_minor > 63
	then do;
	     minor_name = "USER MINOR";
	     goto end_case;
	end;
	else if p_trace_message_info_ptr -> trc_info.dest_minor = -1
	then do;
	     minor_name = "<MORE>";
	     goto end_case;
	end;


	if p_trace_message_info_ptr -> trc_info.dest_major = INTERNAL
	then do;
	     if p_trace_message_info_ptr -> trc_info.dest_minor > 63
		| p_trace_message_info_ptr -> trc_info.dest_minor < 32
	     then do;
		minor_name = "INVALID";
		goto end_case;
	     end;

	     if p_trace_message_info_ptr -> trc_info.dest_minor
		= EXECUTE_COMMAND then
		minor_name = "EXECUTE_COMMAND";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= ADD_TO_REMOTE_CAT then
		minor_name = "ADD_TO_REMOTE_CAT";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= DELETE_FROM_REMOTE_CAT then
		minor_name = "DELETE_FROM_REMOTE_CAT";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= REQUEST_CONNECT then
		minor_name = "REQUEST_CONNECT";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= SET_SLEEP_FLAG then
		minor_name = "SET_SLEEP_FLAG";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= RESET_REPLY then
		minor_name = "RESET_REPLY";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= RESET_SLEEP_FLAG then
		minor_name = "RESET_SLEEP_FLAG";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= SET_SUSPEND then
		minor_name = "SET_SUSPEND";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= RESET_SUSPEND then
		minor_name = "RESET_SUSPEND";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= PUT_TO_BACKGROUND_BUFFER then
		minor_name = "INFO";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= PUT_TO_QUERY_MESSAGE_BUFFER then
		minor_name = "QUERY";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= FAIL_CAPABILITY then
		minor_name = "FAIL_CAPABILITY";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= STATUS_REPLY then
		minor_name = "STATUS_REPLY";
	     else
		call ioa_$rsnnl ("^d", minor_name, (0),
		     p_trace_message_info_ptr -> trc_info.dest_minor);
	end;

	if p_trace_message_info_ptr -> trc_info.dest_major > INTERNAL
	then do;
	     if p_trace_message_info_ptr -> trc_info.dest_minor > 63
	     then do;
		minor_name = "INVALID";
		goto end_case;
	     end;

	     if p_trace_message_info_ptr -> trc_info.dest_minor
		= EXECUTE_COMMAND_REPLY then
		minor_name = "EXECUTE_COMMAND_REPLY";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= QUERY_REPLY then
		minor_name = "QUERY_REPLY";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= FAIL_CAPABILITY then
		minor_name = "FAIL_CAPABILITY";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= SUSPEND_APPLICATION then
		minor_name = "SUSPEND_APPLICATION";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= RESUME_APPLICATION then
		minor_name = "RESUME_APPLICATION";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= TERMINATE_APPLICATION then
		minor_name = "TERMINATE_APPLICATION";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= RESET_APPLICATION then
		minor_name = "RESET_APPLICATION";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= WAKE_UP then
		minor_name = "WAKE_UP";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= STATUS then
		minor_name = "STATUS";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= OVERFLOWED_BUFFER then
		minor_name = "OVERFLOWED_BUFFER";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= SYSTEM_ERROR then
		minor_name = "SYSTEM_ERROR";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= RESPONSE_CONNECT then
		minor_name = "RESPONSE_CONNECT";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= RESPONSE_DISCONNECT then
		minor_name = "RESPONSE_DISCONNECT";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= REQUEST_CONNECT then
		minor_name = "REQUEST_CONNECT";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= REQUEST_DISCONNECT then
		minor_name = "REQUEST_DISCONNECT";
	     else if p_trace_message_info_ptr -> trc_info.dest_minor
		= STATUS_REPLY then
		minor_name = "STATUS_REPLY";
	     else
		call ioa_$rsnnl ("^d", minor_name, (0),
		     p_trace_message_info_ptr -> trc_info.dest_minor);
	end;

end_case:

	if p_trace_message_info_ptr -> trc_info.dest_system
	     = LOCAL_SYSTEM then
	     system_name = "LOCAL_SYSTEM";
	else if p_trace_message_info_ptr -> trc_info.dest_system
	     = REMOTE_SYSTEM then
	     system_name = "REMOTE_SYSTEM";
	else
	     system_name = "INVALID_SYSTEM";

	if p_trace_message_info_ptr -> trc_info.from_system
	     = LOCAL_SYSTEM then
	     from_system_name = "LOCAL_SYSTEM";
	else if p_trace_message_info_ptr -> trc_info.from_system
	     = REMOTE_SYSTEM then
	     from_system_name = "REMOTE_SYSTEM";
	else
	     from_system_name = "INVALID_SYSTEM";

	if p_trace_message_info_ptr -> trc_info.msg_type = MORE then
	     msg_type_name = "MORE";
	else if p_trace_message_info_ptr -> trc_info.msg_type = CONTINUE
	     then
	     msg_type_name = "CONTINUE";
	else if p_trace_message_info_ptr -> trc_info.msg_type = LAST then
	     msg_type_name = "LAST";
	else
	     msg_type_name = "INVALID";


	call ioa_$ioa_switch (p_iocb_ptr,
	     "^/TRC ^a: from ^a:^d to ^a:^d:^d = ^a", direction_name,
	     from_system_name,
	     p_trace_message_info_ptr -> trc_info.from_major,
	     system_name,
	     p_trace_message_info_ptr -> trc_info.dest_major,
	     p_trace_message_info_ptr -> trc_info.dest_minor, minor_name);

	if length (p_trace_message_info_ptr -> trc_info.message) = 1 &
	     p_trace_message_info_ptr -> trc_info.message = " " then
	     call ioa_$ioa_switch (p_iocb_ptr, "TRC Msg_type ^a :^d:| |",
		msg_type_name,
		length (p_trace_message_info_ptr -> trc_info.message));
	else
	     call ioa_$ioa_switch (p_iocb_ptr, "TRC Msg_type ^a :^d:|^a",
		msg_type_name,
		length (p_trace_message_info_ptr -> trc_info.message),
		p_trace_message_info_ptr -> trc_info.message || "|");
	return;


/**/
/* INTERNAL PROCEDURES */




%page;
/* INCLUDE FILES */
%include mowse;
%include mowse_info;
%include mowse_messages;
%include mowse_io_control_info;

/* : END */
     end;




		    wake_up_sleeper_.pl1            08/07/87  1554.2rew 08/07/87  1454.4       29574



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

/****^  HISTORY COMMENTS:
  1) change(86-07-03,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
  3) change(86-12-10,Flegel), approve(86-12-10,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Replaced signalling of mowse_fatal_error with a call to fatal_mowse_trap_
                                                   END HISTORY COMMENTS */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
wake_up_sleeper_:
     proc (p_mcb_ptr, p_major_index);

/* : PROGRAM FUNCTION

Send a message to the capability associated with the major index
to cause it to wake up.
*/

/* : NOTES
*/

/* INPUT PARAMETERS */
dcl p_mcb_ptr	       ptr parameter;
dcl p_major_index	       fixed bin parameter;


/* OUTPUT PARAMETERS */


/* MISC VARIABLES */
dcl mowse_info_ptr	       ptr;		    /* Pointer to mowse info structure */
dcl code		       fixed bin (35);


/* STRUCTURES */
dcl 01 wake_up_message,
       02 header,
	03 system	       char unal,
	03 major	       char unal,
	03 minor	       char unal,
	03 source_system char unal,
	03 source_major  char unal;



/* SYSTEM CALLS */


/* SYSTEM CALL SUPPORT */


/* EXTERNAL CALLS */
dcl get_mowse_info_ptr_    entry (ptr, ptr, fixed bin (35));
dcl rcvdat_	       entry (ptr, ptr, fixed bin (21), fixed bin (35));
dcl fatal_mowse_trap_      entry (fixed bin (35));

/* EXTERNAL CALL SUPPORT */
dcl ws_error_$invalid_capability_number
		       fixed bin (35) ext static;

/* BUILTINS */
dcl addr		       builtin;
dcl byte		       builtin;

/* CONDITIONS */


/* CONSTANTS */


/**/
/* INITIALIZATION */

/* MAIN */
	if (p_major_index < MINIMUM_CAT_ENTRY)
	     | (p_major_index > MAXIMUM_CAT_ENTRY)
	then do;
	     call fatal_mowse_trap_ (ws_error_$invalid_capability_number);
	     return;
	end;

	call get_mowse_info_ptr_ (p_mcb_ptr, mowse_info_ptr, code);
	if code ^= 0 then do;
	     call fatal_mowse_trap_ (code);
	     return;
	end;

	mowse_info_ptr
	     -> mowse_info.local_cat (p_major_index).sleep_time = 0;

	wake_up_message.header.system = byte (LOCAL_SYSTEM);
	wake_up_message.header.major = byte (p_major_index);
	wake_up_message.header.minor = byte (WAKE_UP);
	wake_up_message.header.source_system = byte (LOCAL_SYSTEM);
	wake_up_message.header.source_major = byte (INTERNAL);

	call rcvdat_ (p_mcb_ptr, addr (wake_up_message), 5, code);
	if code ^= 0 then do;
	     call fatal_mowse_trap_ (code);
	     return;
	end;

%page;
/* INCLUDE FILES */
%include mowse;
%include mowse_mcb;
%include mowse_info;
%include mowse_io_control_info;

/* : END */
     end;




		    ws_.pl1                         08/07/87  1554.1rew 08/07/87  1453.8      457578



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

/****^  HISTORY COMMENTS:
  1) change(86-04-04,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Coded execute_command
  2) change(86-04-15,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Coded create_instance, destroy_instance
  3) change(86-04-17,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Coded find_capability_name, find_capability_number
  4) change(86-04-30,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Coded execute_capability
  5) change(86-06-11,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Coded suspend_capability, resume_capability, terminate_capability
  6) change(86-06-23,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Coded reset_capability, put_background_message
  7) change(86-07-01,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Coded connect_request, connect_response, get_status, put_status, sleep,
     disconnect_request, disconnect_response
  8) change(86-10-22,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Modified connect_request so that capability is created is it doesn't
     already exist.
  9) change(86-10-22,Smith), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Mofidied destroy instance so that capability name not sent in
     delete_from_remote_cat_ message.
 10) change(86-11-07,Flegel), approve(87-07-15,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Changed put_background_message to split long messages into multiple
     pieces up to a length of MAXIMUM_BG_SIZE (mowse.incl.pl1).
 11) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Approved.
 12) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     If a long message is pending from the caller to execute_capability, an
     error code is returned because MOWSE protocol will not provide for
     multiple pending long messages.
 13) change(86-12-05,Flegel), approve(86-12-05,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Added chacks fo null MOWSE tables, if it occurs, then a new_process is
     generated.
 14) change(86-12-10,Flegel), approve(86-12-10,MCR7580),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Replaced signalling of mowse_fatal_error with a call to fatal_mowse_trap_
                                                   END HISTORY COMMENTS */
/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
ws_:
     proc ();


/* : PROCEDURE FUNCTION

MOWSE Subroutine Library which provides a means with which applications can
communicate with MOWSE.

Entry Points:

     connect_request	connect_response
     create_instance	destroy_instance
     disconnect_request	disconnect_response
     execute_capability	execute_command
     find_capability_name	find_capability_number
     get_background_message	get_status
     put_background_message	resume_capability
     send_query_reply	sleep
     suspend_capability	terminate_capability
*/

/**/

/* INPUT PARAMETERS */
dcl p_args	       char (*) parameter;
dcl p_reply_string	       char (*) parameter;
dcl p_status	       fixed bin parameter;
dcl p_capability_number    fixed bin parameter;
dcl p_time	       fixed bin (35) parameter;
dcl p_status_result	       char (*) parameter;
dcl p_status_request       char (*) parameter;
dcl p_capability_name      char (*) parameter;
dcl p_command	       char (*) parameter;
dcl p_data_block_ptr       ptr parameter;
dcl p_data_len	       fixed bin (17) parameter;
dcl p_data_ptr	       ptr parameter;
dcl p_entry_name	       char (*) parameter;
dcl p_inbuff_length	       fixed bin (17) parameter;
dcl p_major	       fixed bin (17) parameter;
dcl p_mcb_ptr	       ptr parameter;
dcl p_minor	       fixed bin (17) parameter;
dcl p_outbuff_length       fixed bin (17) parameter;
dcl p_system	       fixed bin (17) parameter;


/* OUTPUT PARAMETERS */
dcl p_cmd_id	       fixed bin (17) parameter;
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */
dcl connect_request_len    fixed bin (17);
dcl connect_request_string char (MAXIMUM_PACKET_SIZE);
dcl arguments	       char (MAXIMUM_PACKET_SIZE - 33) var;
dcl capname	       char (32) var;
dcl mowse_mcb_ptr	       ptr;
dcl mowse_iocb_ptr	       ptr;
dcl temp_major	       fixed bin;
dcl sysid		       fixed bin;
dcl search_name	       char (32);		    /* Temporary name for cap */
dcl mowse_info_ptr	       ptr;		    /* Pointer to mowse info structure */
dcl temp_mcb_ptr	       ptr;
dcl temp_char	       char;
dcl minor_num	       fixed bin;		    /* minor capability number */
dcl first_byte	       fixed bin;
dcl longinfo_length	       fixed bin;		    /* length of error_table_ longinofo */
dcl longinfo	       char (100) aligned;	    /* longinfo status string */
dcl shortinfo	       char (8) aligned;	    /* shortinfo status string */

dcl formatted_string       char (MAXIMUM_BG_SIZE);    /* generated formatted string */
dcl formatted_string_length
		       fixed bin;		    /* length of string generated by ioa_ call */
dcl result_string	       char (MAXIMUM_BG_SIZE);    /* generated result string */
dcl result_string_length   fixed bin;		    /* length of result string */

dcl arg_ptr	       ptr;		    /* pointer to general argument */
dcl arg_len	       fixed bin (21);	    /* length of arguments */
dcl caller_name_length     fixed bin (21);	    /* length of caller name */
dcl based_caller_name      char (32) based (arg_ptr); /* overlay for caller's name */
dcl caller_name	       char (32);		    /* caller's name as in com_err_ */
dcl based_code	       fixed bin based (arg_ptr); /* overlay for code */
dcl based_mcb_ptr	       ptr based (arg_ptr);	    /* overlay for mcb_ptr */
dcl arg_list_ptr	       ptr;		    /* pointer to arg list used in put_background_message */
dcl errcode	       fixed bin (35);
dcl arg_count	       fixed bin;
dcl system_free_area       area based (system_free_area_ptr);
					    /* area used for the allocation of mowse structures */
dcl system_free_area_ptr   ptr;
dcl cap_index	       fixed bin (17);	    /* index into CAT tables */
dcl cap_num	       fixed bin (17);	    /* index into CAT tables or a major capability */
dcl destination	       fixed bin (17);	    /* major capability */
dcl ecode		       fixed bin (35);
dcl entry_point	       entry variable;
dcl i		       fixed bin (17);
dcl in_space	       char (
		       get_buff_length (p_inbuff_length,
		       MINIMUM_BUFFER_SIZE, MAXIMUM_BUFFER_SIZE)) based;
					    /* space for application buffers */
dcl major_num	       fixed bin (17);	    /* capability number */
dcl message_str	       char (MAXIMUM_PACKET_SIZE);
					    /* MOWSE system id */
dcl source_major	       fixed bin (17);
dcl source_system	       fixed bin (17);
dcl temp_buff_ptr	       ptr;
dcl input_buffer_length    fixed bin;
dcl input_buffer_data      char (input_buffer_length) based (temp_buff_ptr);
					    /* temporary application buffers */

/* STRUCTURES */

dcl 01 mio_info	       like mowse_io_info automatic;
					    /* Automatic mowse info */
dcl 01 mio_sleep	       like mowse_io_sleep_info automatic;
					    /*  Automatic sleep info structure */
					    /* used by create_instance to compose message destined for add_to_remote_cat_
   (internal mowse routine) */

dcl 01 alter_remote_cat_msg,
       02 major	       char (1) unal,
       02 major_name       char (CAPABILITY_NAME_LENGTH) unal;

/* SYSTEM CALLS */
dcl iox_$control	       entry (ptr, char (*), ptr, fixed bin (35));
dcl iox_$close	       entry (ptr, fixed bin (35));
dcl terminate_process_     entry (char (*), ptr);
dcl com_err_$convert_status_code_
		       entry (fixed bin (35), char (8) aligned,
		       char (100) aligned);
dcl ioa_$general_rs	       entry (ptr, fixed bin, fixed bin, char (*),
		       fixed bin (21), bit (1) aligned, bit (1) aligned);
dcl cu_$arg_ptr	       entry (fixed bin, ptr, fixed bin (21),
		       fixed bin (35));
dcl cu_$arg_list_ptr       entry (ptr);
dcl cu_$arg_count	       entry (fixed bin, fixed bin (35));
dcl get_system_free_area_  entry () returns (ptr);
dcl hcs_$make_entry	       entry (ptr, char (*), char (*), entry,
		       fixed bin (35));

/* SYSTEM CALL SUPPORT */
dcl ws_error_$invalid_sleep_interval
		       fixed bin (35) ext static;
dcl ws_error_$inconsistent_mowse_tables
		       fixed bin (35) ext static;
dcl error_table_$unimplemented_version
		       fixed bin (35) ext static;
dcl error_table_$no_table  fixed bin (35) ext static;
dcl ws_error_$invalid_connect_status
		       fixed bin (35) ext static;
dcl ws_error_$not_available
		       fixed bin (35) ext static;
dcl ws_error_$sleeping     fixed bin (35) ext static;
dcl ws_error_$cant_create_instance
		       fixed bin (35) ext static;
dcl ws_error_$invalid_minor_capability
		       fixed bin (35) ext static;
dcl ws_error_$suspended    fixed bin (35) ext static;
dcl ws_error_$not_suspended
		       fixed bin (35) ext static;
dcl ws_error_$invalid_capability_name
		       fixed bin (35) ext static;
dcl ws_error_$invalid_capability_number
		       fixed bin (35) ext static;
dcl ws_error_$invalid_mcb  fixed bin (35) ext static;
dcl ws_error_$invalid_system_id
		       fixed bin (35) ext static;
dcl ws_error_$buffer_overflow
		       fixed bin (35) ext static;

/* EXTERNAL CALLS */
dcl send_mowse_message_    entry (ptr, fixed bin, fixed bin, fixed bin,
		       fixed bin, fixed bin, fixed bin, ptr, fixed bin,
		       fixed bin, fixed bin (35));
dcl find_mowse_io_	       entry (ptr, fixed bin (35));
dcl get_mowse_info_ptr_    entry (ptr, ptr, fixed bin (35));
dcl send_msg_	       entry (ptr, fixed bin, fixed bin, ptr, fixed bin,
		       fixed bin, fixed bin (35));
dcl capability_$unpack     entry (fixed bin, fixed bin, fixed bin,
		       fixed bin (35));
dcl capability_$pack       entry (fixed bin, fixed bin, fixed bin,
		       fixed bin (35));
dcl find_free_cat_entry_   entry (ptr, fixed bin, fixed bin (35));
dcl release_outbuffer_     entry (ptr);
dcl fatal_mowse_trap_      entry (fixed bin (35));

/* EXTERNAL CALL SUPPORT */

/* BUILTINS */
dcl min		       builtin;
dcl null		       builtin;
dcl addr		       builtin;
dcl byte		       builtin;
dcl length	       builtin;
dcl round		       builtin;
dcl rtrim		       builtin;
dcl substr	       builtin;

/* CONDITIONS */

/* CONSTANTS */
dcl VERSION	       char (8) int static options (constant)
		       init ("version1");
dcl CMD_ID_CNT	       fixed bin int static init (1);
dcl TRUE		       bit (1) int static options (constant) init ("1"b);
dcl FALSE		       bit (1) int static options (constant) init ("0"b);

/**/
/* INITIALIZATION */

/* MAIN */
	return;

/**/

/* ENTRY POINTS */

/* : *** Entry: connect_request - internal entry for ws_ ****/

/* ENTRY FUNCTION

Request a connection to an application.
*/

connect_request:
     entry (p_capability_name, p_args, p_system, p_mcb_ptr, p_code);

	p_code = 0;

/* : check mcb pointer */

	call check_mcb_ptr (p_mcb_ptr, p_code);
	if p_code ^= 0 then
	     return;

	mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
	capname = p_capability_name;
	capname = rtrim (capname);
	connect_request_string = capname;
	connect_request_len = length (capname);
	arguments = p_args;

	if (length (rtrim (arguments)) ^= 0) then do;
	     connect_request_string = capname || " " || rtrim (arguments);
	     connect_request_len = length (capname) + 1 +
		length (rtrim (arguments));
	end;

	call capability_$pack (p_system, INTERNAL, destination, p_code);
	if p_code ^= 0 then
	     return;

	call send_msg_ (p_mcb_ptr, destination, REQUEST_CONNECT,
	     addr (connect_request_string), connect_request_len, BG, p_code);
	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

	return;

/**/

/* : *** Entry: connect_response - internal entry for ws_ *** */

/* : ENTRY FUNCTION

Allows an application to respond to a connect request from some application.
*/

connect_response:
     entry (p_status, p_major, p_mcb_ptr, p_code);

	p_code = 0;

	call check_mcb_ptr (p_mcb_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* : check major capability_number */

	call capability_$unpack (sysid, major_num, p_major, p_code);
	if p_code ^= 0 then
	     return;

/* : check the status being sent as response */

	if (p_status ^= ACCEPT) & (p_status ^= REJECT) then do;
	     p_code = ws_error_$invalid_connect_status;
	     return;
	end;

	call verify_capability (p_mcb_ptr -> mcb.mowse_info_ptr,
	     p_major, p_code);
	if p_code ^= 0 then
	     return;

/* : Send RESPONSE DISCONNECT message with status as data */

	temp_char = byte (p_status);
	call send_msg_ (p_mcb_ptr, p_major, RESPONSE_CONNECT,
	     addr (temp_char), 1, BG, p_code);
	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

	return;

/**/

/* : *** Entry: create_instance - internal entry for ws_ *** */

/* : ENTRY FUNCTION

Register the calling routine with MOWSE by assigning it a major capability
number and adding it to MOWSE's capability table. The calling routine must
supply the name by which it is to be known to MOWSE, and the entry point
describing where it is to be invoked by an execute capability.
*/

/* : NOTES

All applications which expect to receive messages must have registered with
MOWSE (through create_instance) in order to receive messages. A message is
provided to the application when a the destination of the message specifies
the major capability number of the application. The application will then be
invoked at the entry name provided with the message (argument data), its
length, and a pointer to the applications data_block as follows:

        application_$entry_point (minor_capability, major_sender,
                                  arg_ptr, arg_len, p_mcb_ptr, data_blk_ptr);

The buffers inbuff and outbuff allow MOWSE to send and receive messages
longer than one communications packet defined by PACKET_SIZE) in a manner
transparent to the capability.
*/

create_instance:
     entry (p_capability_name, p_entry_name, p_inbuff_length,
	p_outbuff_length, p_data_block_ptr, p_mcb_ptr, p_code);

	p_code = 0;
	cap_index = 0;

/* : Get mowse info required before allocation of new mcb */

/* : - get mowse iocb_ptr */
	call find_mowse_io_ (mowse_iocb_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* : - get mowse mcb_ptr */
	mio_info.version = mowse_io_info_version_1;
	call iox_$control (mowse_iocb_ptr, "get_mowse_info",
	     addr (mio_info), p_code);
	if p_code ^= 0 then
	     return;
	mowse_mcb_ptr = mio_info.mcb_ptr;

/* : - get mowse info_ptr */

	call get_mowse_info_ptr_ (mowse_mcb_ptr, mowse_info_ptr, p_code);
	if p_code ^= 0 then
	     return;

	if mowse_info_ptr = null then
	     call null_mowse_info_handler ();

	if mowse_info_ptr -> mowse_info.version ^= VERSION then do;
	     p_code = error_table_$unimplemented_version;
	     return;
	end;

/* : If no free entry in local CAT, return error */

	call find_free_cat_entry_ (mowse_info_ptr, cap_index, p_code);
	if (p_code ^= 0) then
	     return;

/* : Create entry point call hcs_$make_entry */

	call hcs_$make_entry (null, p_capability_name, p_entry_name,
	     entry_point, p_code);
	if (p_code ^= 0) then
	     return;

/* : Make major_capability number */

	call capability_$pack (LOCAL_SYSTEM, cap_index, cap_num, p_code);
	if (p_code ^= 0) then do;
	     p_code = ws_error_$cant_create_instance;
	     return;
	end;

/* : allocate MCB */

	system_free_area_ptr = get_system_free_area_ ();
	allocate mcb in (system_free_area) set (p_mcb_ptr);

/* : Set mcb_ptr stored in the local CAT table */

	mowse_info_ptr -> mowse_info.local_cat (cap_index).mcb_ptr =
	     p_mcb_ptr;

/* : Initialize CAT flags */

	mowse_info_ptr -> mowse_info.local_cat (cap_index).flags.reset
	     = "0"b;
	mowse_info_ptr -> mowse_info.local_cat (cap_index).flags.suspended
	     = "0"b;
	mowse_info_ptr -> mowse_info.local_cat (cap_index).flags.status
	     = "0"b;
	mowse_info_ptr -> mowse_info.local_cat (cap_index).sleep_time
	     = 0;

/* : Initialize the mcb */

	p_mcb_ptr -> mcb.version = VERSION;
	p_mcb_ptr -> mcb.iocb_ptr = mowse_iocb_ptr;
	p_mcb_ptr -> mcb.major_capability = cap_num;
	p_mcb_ptr -> mcb.capability_name = p_capability_name;
	p_mcb_ptr -> mcb.entry_var = entry_point;
	p_mcb_ptr -> mcb.data_block_ptr = p_data_block_ptr;

	allocate in_space in (system_free_area)
	     set (p_mcb_ptr -> mcb.inbuff);
	p_mcb_ptr -> mcb.inbuff_length
	     =
	     get_buff_length (p_inbuff_length, MINIMUM_BUFFER_SIZE,
	     MAXIMUM_BUFFER_SIZE);
	p_mcb_ptr -> mcb.inbuff_position_index = 0;
	p_mcb_ptr -> mcb.inbuff_data_length = 0;

	p_mcb_ptr -> mcb.outbuff_length
	     =
	     get_buff_length (p_outbuff_length, MINIMUM_BUFFER_SIZE,
	     MAXIMUM_BUFFER_SIZE);

	p_mcb_ptr -> mcb.outbuff_list_start = null;
	p_mcb_ptr -> mcb.outbuff_list_end = null;
	p_mcb_ptr -> mcb.mowse_info_ptr = mowse_info_ptr;

/* : Send ADD_TO_REMOTE_CAT message to remote 
     capability_number + capability_name (not padded) */

	alter_remote_cat_msg.major = byte (cap_index);
	alter_remote_cat_msg.major_name =
	     substr (p_capability_name, 1, length (p_capability_name));
	call capability_$pack (REMOTE_SYSTEM, INTERNAL, destination,
	     p_code);
	call send_msg_ (mowse_mcb_ptr, destination, ADD_TO_REMOTE_CAT,
	     addr (alter_remote_cat_msg), length (p_capability_name) + 1,
	     BG, p_code);

	if p_code ^= 0 then do;
	     p_code = ws_error_$cant_create_instance;
	     free p_mcb_ptr -> mcb;
	     p_mcb_ptr = null;
	     mowse_info_ptr -> mowse_info.local_cat (cap_index).mcb_ptr
		= null;
	end;

	return;

/**/


/* : *** Entry: destroy_instance - internal entry for ws_ *** */

/* : ENTRY FUNCTION

Remove all reference to the calling application from MOWSE.  This will include
freeing all MOWSE associated buffers and control information blocks.
*/

destroy_instance:
     entry (p_mcb_ptr, p_code);

	p_code = 0;

	call check_mcb_ptr (p_mcb_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* : Get capability index */
	call capability_$unpack (sysid, cap_index,
	     p_mcb_ptr -> mcb.major_capability, p_code);

/* : Get mowse info pointer */
	mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;

/* : send DELETE_FROM_REMOTE_CAT message to remote system
     {capability_number} */

	alter_remote_cat_msg.major = byte (cap_index);
	call capability_$pack (REMOTE_SYSTEM, INTERNAL, destination,
	     p_code);

	call send_msg_ (p_mcb_ptr, destination, DELETE_FROM_REMOTE_CAT,
	     addr (alter_remote_cat_msg.major), 1, BG, p_code);

	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

/* : Free message buffers and mcb */

	temp_buff_ptr = p_mcb_ptr -> mcb.inbuff;
	input_buffer_length = p_mcb_ptr -> mcb.inbuff_data_length;
	free input_buffer_data;
	temp_buff_ptr = null;
	p_mcb_ptr -> mcb.inbuff = null;

	call release_outbuffer_ (p_mcb_ptr);

	free p_mcb_ptr -> mcb;
	p_mcb_ptr = null;
	mowse_info_ptr -> mowse_info.local_cat (cap_index).mcb_ptr =
	     null;

	p_code = 0;
	return;

/**/

/* : *** Entry: disconnect_request - internal entry for ws_ *** */

/* : ENTRY FUNCTION

Request a disconnection to an application.
*/

disconnect_request:
     entry (p_capability_number, p_mcb_ptr, p_code);

	p_code = 0;

	call check_mcb_ptr (p_mcb_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* : check the capability_number */

	mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
	call verify_capability (mowse_info_ptr, p_capability_number, p_code);
	if p_code ^= 0 then
	     return;

/* : Send the REQUEST_DISCONNECT message */

	call send_msg_ (p_mcb_ptr, p_capability_number,
	     REQUEST_DISCONNECT, null, 0, BG, p_code);
	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

	return;

/**/

/* : *** Entry: disconnect_response - internal entry for ws_ *** */

/* : ENTRY FUNCTION

Allows some application to responds to a disconnect request from some
application.
*/

disconnect_response:
     entry (p_status, p_major, p_mcb_ptr, p_code);

	p_code = 0;

	call check_mcb_ptr (p_mcb_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* : check the response to request */

	if (p_status ^= ACCEPT) & (p_status ^= REJECT) then do;
	     p_code = ws_error_$invalid_connect_status;
	     return;
	end;

/* : verify that the capability for which the response is destined exists */

	mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
	call verify_capability (mowse_info_ptr, p_major, p_code);
	if p_code ^= 0 then
	     return;

/* : Send message containing response to requesting application */

	temp_char = byte (p_status);
	call send_msg_ (p_mcb_ptr, p_major, RESPONSE_DISCONNECT,
	     addr (temp_char), 1, BG, p_code);
	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

	return;

/**/

/* : *** Entry: execute_capability - internal entry for ws_ *** */

/* ENTRY FUNCTION

Executes a loaded capability locally or remotely.
*/

execute_capability:
     entry (p_major, p_minor, p_data_ptr, p_data_len, p_mcb_ptr, p_code);

/* : Look up major_capability number in the local and remote CAT tables. */

	p_code = 0;

	call check_mcb_ptr (p_mcb_ptr, p_code);
	if p_code ^= 0 then
	     return;

	call capability_$unpack (sysid, major_num, p_major, p_code);
	if p_code ^= 0 then
	     return;

/* : Get mowse info pointer */
	mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;

/* : Check if minor is valid */

	if p_minor < MINIMUM_USER_MINOR | p_minor > MAXIMUM_USER_MINOR
	then do;
	     p_code = ws_error_$invalid_minor_capability;
	     return;
	end;

/* : Check that the capability being executed exists */

	call verify_capability (mowse_info_ptr, p_major, p_code);
	if p_code ^= 0 then
	     return;

/* : Check if capability to be executed has been suspended or reset
     and the minor is not one of the dedicated (system)  minors.
     If it is then return ws_error_$suspended */

	if sysid = LOCAL_SYSTEM then do;
	     if ((mowse_info_ptr
		-> mowse_info.local_cat (major_num).flags.reset)
		| (mowse_info_ptr
		-> mowse_info.local_cat (major_num).flags.suspended)
		& ^(p_minor < MINIMUM_USER_MINOR)) then do;

		p_code = ws_error_$suspended;
		return;
	     end;
	end;
	else if
	     ((mowse_info_ptr
	     -> mowse_info.remote_cat (major_num).flags.reset)
	     | (mowse_info_ptr
	     -> mowse_info.remote_cat (major_num).flags.suspended)
	     & ^(p_minor < MINIMUM_USER_MINOR)) then do;

	     p_code = ws_error_$suspended;
	     return;
	end;

/* : Check if the capability is sleeping.
     - If it is then return ws_error_$sleeping */

	if sysid = LOCAL_SYSTEM then do;
	     if (mowse_info_ptr
		-> mowse_info.local_cat (major_num).sleep_time ^= 0)
	     then do;
		p_code = ws_error_$sleeping;
		return;
	     end;
	end;
	else if (mowse_info_ptr
	     -> mowse_info.remote_cat (major_num).sleep_time ^= "0"b)
	then do;
	     p_code = ws_error_$sleeping;
	     return;
	end;

/* : If the buffer is too small to handle that the information
     then return with p_code set to ws_error_$buffer_overflow
     OR if the message to be sent is long and there is a pending message in
     the outbuffer, return buffer overflow because protocol will not allow for
     more than one pending message */

	if p_data_len > p_mcb_ptr -> mcb.outbuff_length
	     | (p_data_len > PACKET_SIZE - 6
	     & p_mcb_ptr -> mcb.outbuff_list_start ^= null)
	then do;
	     p_code = ws_error_$buffer_overflow;
	     return;
	end;

/* : Send message to the capability to be executed */

	call send_msg_ (p_mcb_ptr, p_major, p_minor, p_data_ptr,
	     p_data_len, BG, p_code);
	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

	return;

/**/

/* : *** Entry: execute_command - internal entry for ws_ *** */

/* ENTRY FUNCTION

Performs the execution of a command on either the remote or local systems.
*/

execute_command:
     entry (p_command, p_system, p_cmd_id, p_mcb_ptr, p_code);

	p_code = 0;

	call check_mcb_ptr (p_mcb_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* : Check for valid system */
	if p_system ^= LOCAL_SYSTEM & p_system ^= REMOTE_SYSTEM then do;
	     p_code = ws_error_$invalid_system_id;
	     return;
	end;

/* : Get mowse_info_ptr */
	mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;

/* : Check for command which are too long */
	if length (p_command) > PACKET_SIZE - 2 then do;
	     p_code = ws_error_$buffer_overflow;
	     return;
	end;

/* : Generate unique command identification number. */
	p_cmd_id = CMD_ID_CNT;
	CMD_ID_CNT = CMD_ID_CNT + 1;

/* : If the system was local then execute command locally */
	if p_system = LOCAL_SYSTEM then
	     call capability_$pack (LOCAL_SYSTEM, INTERNAL, destination,
		p_code);
	else
	     call capability_$pack (REMOTE_SYSTEM, INTERNAL, destination,
		p_code);
	if p_code ^= 0 then
	     return;

/* : formulate message to be sent to remote or local mowse internal */

	first_byte = round ((p_cmd_id / 256), 0);
	message_str =
	     byte (first_byte)
	     || byte ((p_cmd_id - (first_byte * 256))) || p_command;

/* : send message to destination */
	call send_msg_ (p_mcb_ptr, destination, EXECUTE_COMMAND,
	     addr (message_str), length (p_command) + 2, BG, p_code);
	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

	return;

/**/

/* : *** Entry: find_capability_name - internal entry for ws_ *** */

/* : ENTRY FUNCTION

Find the name of a capability given its major capability number.
*/

find_capability_name:
     entry (p_major, p_capability_name, p_code);

	p_code = 0;

	call find_mowse_io_ (mowse_iocb_ptr, p_code);
	if p_code ^= 0 then
	     return;

	mio_info.version = mowse_io_info_version_1;
	call iox_$control (mowse_iocb_ptr, "get_mowse_info",
	     addr (mio_info), p_code);
	if p_code ^= 0 then
	     return;
	mowse_info_ptr = mio_info.info_ptr;
	if mowse_info_ptr = null then
	     call null_mowse_info_handler ();

/* : Extract the system id and CAT index */

	call capability_$unpack (sysid, cap_num, p_major, p_code);
	if (p_code ^= 0) then do;
	     p_code = ws_error_$invalid_capability_number;
	     return;
	end;

/* : If system is LOCAL_SYSTEM then
     - Check for validity
     - Invalid CAT index or inactive mcb return invalid_capability_number */

	if (sysid = LOCAL_SYSTEM) then do;
	     if (cap_num < MINIMUM_CAT_ENTRY)
		| (cap_num > MAXIMUM_CAT_ENTRY) then do;
		p_code = ws_error_$invalid_capability_number;
		return;
	     end;

	     if (mowse_info_ptr
		-> mowse_info.local_cat (cap_num).mcb_ptr = null)
	     then do;
		p_code = ws_error_$invalid_capability_number;
		return;
	     end;

/* : get the name */

	     p_capability_name =
		mowse_info_ptr
		-> mowse_info.local_cat (cap_num).mcb_ptr
		-> mcb.capability_name;
	     return;
	end;

/* : Else search remote CAT */

	i = cap_num;
	do while ((i < MAXIMUM_CAT_ENTRY + 1) &
	     (mowse_info_ptr
	     -> mowse_info.remote_cat (i).major_capability ^= p_major));
	     i = i + 1;
	end;

/* : if not found or inactive return invalid_capability_number */
	if (i > MAXIMUM_CAT_ENTRY) then do;
	     p_code = ws_error_$invalid_capability_number;
	     return;
	end;

/* : Otherwise, return the name */
	p_capability_name =
	     mowse_info_ptr
	     -> mowse_info.remote_cat (i).capability_name;
	p_code = 0;
	return;

/**/

/* : *** Entry: find_capability_number - internal entry for ws_ *** */

/* : ENTRY FUNCTION

Find the major capability number of an application given a capability name.
*/

/* : NOTES

MOWSE looks for the capability name in its capability table in the following
fashion:
            1) If the provided major capability number is invalid,
            MOWSE will begin searching from the top of the specified system
            table.
            2) If the major capability number is valid, MOWSE will
            begin searching from the next entry in the table specified by
            the system.
*/

find_capability_number:
     entry (p_capability_name, p_system, p_major, p_code);

	p_code = 0;

/* : Make sure requested system is acceptable */

	if p_system ^= LOCAL_SYSTEM & p_system ^= REMOTE_SYSTEM then do;
	     p_code = ws_error_$invalid_system_id;
	     return;
	end;

/* : Get MOWSE information for CATs */

	call find_mowse_io_ (mowse_iocb_ptr, p_code);
	if p_code ^= 0 then
	     return;

	mio_info.version = mowse_io_info_version_1;
	call iox_$control (mowse_iocb_ptr, "get_mowse_info",
	     addr (mio_info), p_code);
	if p_code ^= 0 then
	     return;

	mowse_info_ptr = mio_info.info_ptr;
	if mowse_info_ptr = null then
	     call null_mowse_info_handler ();

	call capability_$unpack (sysid, cap_index, p_major, p_code);
	if p_code ^= 0 then
	     cap_index = MINIMUM_CAT_ENTRY - 1;

/* : Search through the CAT specified by the system id sequentially */

	p_code = 0;
	do cap_index = cap_index + 1 to MAXIMUM_CAT_ENTRY;
	     if p_system = LOCAL_SYSTEM then do;
		if mowse_info_ptr
		     -> mowse_info.local_cat (cap_index).mcb_ptr
		     ^= null then do;
		     search_name =
			mowse_info_ptr
			-> mowse_info.local_cat (cap_index).mcb_ptr
			-> mcb.capability_name;
		     temp_major =
			mowse_info_ptr
			-> mowse_info.local_cat (cap_index).mcb_ptr
			-> mcb.major_capability;
		end;
		else
		     search_name = "";
	     end;
	     else do;
		search_name =
		     mowse_info_ptr
		     -> mowse_info.remote_cat (cap_index)
		     .capability_name;
		temp_major =
		     mowse_info_ptr
		     -> mowse_info.remote_cat (cap_index)
		     .major_capability;
	     end;

	     if p_capability_name = rtrim (search_name) then do;
		p_major = temp_major;
		return;
	     end;
	end;

/* : Nothing was found, return invalid_capability_name */

	p_code = ws_error_$invalid_capability_name;
	return;

/**/

/* : *** Entry: get_background_message - internal entry for ws_ *** */

/* : ENTRY FUNCTION

This entry point include for consistency with MTB741 but can never be used
in this implementatiuon of MOWSE 

NOT AVAILABLE (Can only be use by foreground applications. This implementation
of mowse does not support such applications.
*/

get_background_message:
     entry (p_reply_string, p_code);
	p_code = ws_error_$not_available;
	return;

/**/

/* : *** Entry: get_status - internal entry for ws_ *** */


/* : ENTRY FUNCTION

Request status information from a specified applicatiion. Since this can only
be called from a foreground application and MOWSE is not able to support such
applications this function need not be inplemented.  It will return an error
code (ws_error_$not_available) if called.
*/

get_status:
     entry (p_major, p_status_request, p_status_result, p_code);
	p_code = ws_error_$not_available;
	return;

/**/

/* : *** Entry: put_background_message - internal entry for ws_ *** */

/* : ENTRY FUNCTION

Provides a background application with the means of displaying one of two
types of messages through the foreground channel to a foreground application.
*/


/* : NOTES

p_code is one of the following:

     0 -- indicating that the background message consist only of the
	contents of the control_string.

     SEND_QUERY -- indicating that the control string will be used as a
          prompt requiring user INPUT.

     A standard Multics error code -- indicating that the background message
          will consist of the converted error code to com_err_ format of
	message
*/

put_background_message:
     entry options (variable);

/* : Find the number of arguments passed to this routine */

	errcode = 0;
	call cu_$arg_count (arg_count, errcode);

/* : If the number of arguments is less than 3 then return */

	if arg_count < 3 then
	     return;

/* : Get the first argument (mcb_ptr) and return if it is null */

	call cu_$arg_list_ptr (arg_list_ptr);
	call cu_$arg_ptr (1, arg_ptr, arg_len, errcode);
	if errcode ^= 0 then
	     return;
	if arg_ptr -> based_mcb_ptr = null then
	     return;
	temp_mcb_ptr = arg_ptr -> based_mcb_ptr;

/* : Check mcb_ptr */

	call check_mcb_ptr (temp_mcb_ptr, ecode);
	if ecode ^= 0 then
	     return;

/* : Get mowse info pointer */

	mowse_info_ptr = temp_mcb_ptr -> mcb.mowse_info_ptr;

/* : Get the second argument (code) and perform the following
     assignment:
        code = 0	      minor = PUT_TO_BACKGROUND_BUFFER
        code = SEND_QUERY minor = PUT_TO_QUERY_MESSAGE_BUFFER
        otherwise	      minor = -1 */

	call cu_$arg_ptr (2, arg_ptr, arg_len, errcode);
	if errcode ^= 0 then
	     return;
	ecode = arg_ptr -> based_code;

	if ecode = 0 then
	     minor_num = PUT_TO_BACKGROUND_BUFFER;
	else if ecode = SEND_QUERY then
	     minor_num = PUT_TO_QUERY_MESSAGE_BUFFER;
	else
	     minor_num = -1;

/* : get caller's name */

	call cu_$arg_ptr (3, arg_ptr, arg_len, errcode);
	if errcode ^= 0 then
	     return;
	caller_name = arg_ptr -> based_caller_name;
	caller_name_length = min (arg_len, MAXIMUM_BG_SIZE);

	formatted_string_length = 0;
	longinfo_length = 0;

/* : create destination = remote_system|internal */

	call capability_$pack (REMOTE_SYSTEM, INTERNAL, destination,
	     errcode);
	if errcode ^= 0 then
	     return;

/* : If minor = PUT_TO_BACKGROUND_BUFFER then
     - if there is a fourth variable (control_string) get it.
     -- create a formatted string */

	if minor_num = PUT_TO_BACKGROUND_BUFFER then
	     if arg_count >= 4 then do;
		call ioa_$general_rs (arg_list_ptr, 4, 5,
		     formatted_string, arg_len, "0"b, "0"b);
		formatted_string_length =
		     min (arg_len, MAXIMUM_BG_SIZE);
	     end;

/* : If minor = PUT_TO_QUERY_MESSAGE_BUFFER then
     - if the control string argument is present then
     -- generate the formatted string. */

	if minor_num = PUT_TO_QUERY_MESSAGE_BUFFER then
	     if arg_count > 3 then do;
		call ioa_$general_rs (arg_list_ptr, 4, 5,
		     formatted_string, arg_len, "0"b, "0"b);
		formatted_string_length =
		     min (arg_len, MAXIMUM_BG_SIZE);
	     end;

/* : If minor = -1 then
     - convert the error code to a error string.
     - if a control string is present then
     -- convert it to a formatted string. */

	if minor_num = -1 then do;
	     minor_num = PUT_TO_BACKGROUND_BUFFER;
	     call com_err_$convert_status_code_ (ecode, shortinfo,
		longinfo);
	     do longinfo_length = length (longinfo) by -1 to 1
		while (substr (longinfo, longinfo_length, 1) = " ");
	     end;

	     if arg_count > 3 then do;
		call ioa_$general_rs (arg_list_ptr, 4, 5,
		     formatted_string, arg_len, "0"b, "0"b);
		formatted_string_length = min (arg_len, MAXIMUM_BG_SIZE);
	     end;
	end;

/* : Concatenate "caller_name: longinfo formatted_string"
     send the message */

	result_string =
	     substr (caller_name, 1, caller_name_length)
	     || ": "
	     || substr (longinfo, 1, longinfo_length)
	     || " "
	     || substr (formatted_string, 1, formatted_string_length);
	result_string_length =
	     min (caller_name_length + longinfo_length
	     + formatted_string_length + 3, MAXIMUM_BG_SIZE);
	call send_bg (temp_mcb_ptr, destination, minor_num,
	     addr (result_string), result_string_length, FG, errcode);

	return;

/**/

/* : *** Entry: put_status - internal entry for ws_ *** */

/* : ENTRY FUNCTION

Send status information to the capability application requesting it.
*/

put_status:
     entry (p_major, p_status_result, p_mcb_ptr, p_code);

/* : check the mcb pointer */

	call check_mcb_ptr (p_mcb_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* : Get mowse info pointer */

	mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;

/* : unpack and check the major capability given as input */

	call capability_$unpack (sysid, major_num, p_major, p_code);
	if p_code ^= 0 then
	     return;

/* : Verify that the capability for which the status is destined exists */

	call verify_capability (mowse_info_ptr, p_major, p_code);
	if p_code ^= 0 then
	     return;

/* : The maximum size which may be sent is one packet */

	formatted_string_length =
	     min ((length (p_status_result)), MAXIMUM_PACKET_SIZE);

/* : Send status reply messsage */

	call send_msg_ (p_mcb_ptr, p_major, STATUS_REPLY,
	     addr (p_status_result), formatted_string_length, FG,
	     p_code);
	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

	return;

/**/

/* : *** Entry: reset_capability - internal entry for ws_ *** */

/* : ENTRY FUNCTION

Resetting a capability on a remote or local system.
*/

reset_capability:
     entry (p_major, p_mcb_ptr, p_code);

/* : Check the mcb_ptr */

	call check_mcb_ptr (p_mcb_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* : Get mowse info pointer */

	mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;

/* : Set reset flag of application issuing this call to prevent
     any messages destined for the aplication from being sent
     to it. */

	call capability_$unpack (sysid, major_num,
	     p_mcb_ptr -> mcb.major_capability, p_code);
	if p_code ^= 0 then
	     return;

/* : if application on remote system then set the remote reset flag */

	if sysid = REMOTE_SYSTEM then
	     mowse_info_ptr -> mowse_info.remote_cat (major_num).flags.reset
		= TRUE;
	else
	     mowse_info_ptr -> mowse_info.local_cat (major_num).flags.reset
		= TRUE;

/* : send a RESET_APPLICATION message  */

	call send_msg_ (p_mcb_ptr, p_major, RESET_APPLICATION, null, 0,
	     BG, p_code);
	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

	return;

/**/

/* : *** Entry: resume_capability - internal entry for ws_ *** */

/* : ENTRY FUNCTION

Tells MOWSE to resume a specified application
*/

/* : NOTES
 
"major" identifies both the capability and the system on which it is running.
*/

resume_capability:
     entry (p_major, p_mcb_ptr, p_code);

	p_code = 0;

/* : Check mcb_ptr */

	call check_mcb_ptr (p_mcb_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* : Get mowse info pointer */

	mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
	call capability_$unpack (source_system, source_major,
	     p_mcb_ptr -> mcb.major_capability, p_code);
	if p_code ^= 0 then
	     return;

/* : Unpack the major capability into a system and capability number. */

	call capability_$unpack (sysid, major_num, p_major, p_code);
	if p_code ^= 0 then
	     return;

/* : Check if capability is suspended */

	if sysid = LOCAL_SYSTEM then do;
	     if ^mowse_info_ptr
		-> mowse_info.local_cat (major_num).flags.suspended then

		p_code = ws_error_$not_suspended;
	end;
	else if sysid = REMOTE_SYSTEM then do;
	     if ^mowse_info_ptr
		-> mowse_info.remote_cat (major_num).flags.suspended then

		p_code = ws_error_$not_suspended;

	     mowse_info_ptr
		-> mowse_info.remote_cat (major_num).flags.suspended
		= FALSE;
	end;
	else
	     p_code = ws_error_$invalid_system_id;

	if p_code ^= 0 then
	     return;

/* : - Call the application via the predefined minor capability
     - RESUME_APPLICATION by sending a message */

	call send_msg_ (p_mcb_ptr, p_major, RESUME_APPLICATION, null,
	     0, BG, p_code);
	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

/* : If resuming a capability on the local system, send a RESET_SUSPEND to
     the remote */

	if sysid = LOCAL_SYSTEM then do;
	     call capability_$pack (REMOTE_SYSTEM, INTERNAL,
		temp_major, (0));
	     call send_mowse_message_ (p_mcb_ptr, LOCAL_SYSTEM, major_num,
		REMOTE_SYSTEM, INTERNAL, RESET_SUSPEND, LAST, null, 0, BG,
		p_code);
	end;
	return;

/**/

/* : *** Entry: send_query_reply - internal entry for ws_ *** */

/* : ENTRY FUNCTION

NOT AVAILABLE.
*/

send_query_reply:
     entry (p_reply_string, p_major, p_code);
	p_code = ws_error_$not_available;
	return;

/**/

/* : *** Entry: sleep - internal entry for ws_ *** */

/* : ENTRY FUNCTION 

Puts the caller to sleep (suspends it) for a given number of seconds.
*/

sleep:
     entry (p_mcb_ptr, p_time, p_code);

	p_code = 0;

/* : Check the mcb pointer */

	call check_mcb_ptr (p_mcb_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* : Get mowse info pointer */

	mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;

/* : If the time requested is zero do nothing */

	if (p_time <= 0) then do;
	     p_code = ws_error_$invalid_sleep_interval;
	     return;
	end;

/* : Allocate control order structure, fill it with the required infomation
     and issue a control order to start application sleeping. */

	call capability_$unpack (sysid, major_num,
	     p_mcb_ptr -> mcb.major_capability, p_code);
	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

	mio_sleep.version = mowse_io_info_version_1;
	mio_sleep.major_index = major_num;
	mio_sleep.sleep_seconds = p_time;
	call iox_$control (p_mcb_ptr -> mcb.iocb_ptr, "put_to_sleep",
	     addr (mio_sleep), p_code);
	if p_code ^= 0 then
	     return;

/* : Send message to remote system telling it to update the remote
     CAT table entry for this application. */

	call capability_$pack (REMOTE_SYSTEM, INTERNAL, destination,
	     p_code);
	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

	call send_msg_ (p_mcb_ptr, destination, SET_SLEEP_FLAG, null,
	     0, BG, p_code);

	mowse_info_ptr -> mowse_info.local_cat (major_num).sleep_time =
	     p_time;

	return;

/**/

/* : *** Entry: suspend_capability - internal entry for ws_ *** */

/* : ENTRY FUNCTION

Tells MOWSE to suspend a given application.
*/

/* : NOTES

"major" identifies both the capability and the system on which it is running.
*/

suspend_capability:
     entry (p_major, p_mcb_ptr, p_code);

	p_code = 0;

/* : Check mcb_ptr */

	call check_mcb_ptr (p_mcb_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* : Get capability number and sytem id of capability to suspend */

	call capability_$unpack (sysid, major_num, p_major, p_code);
	if p_code ^= 0 then
	     return;

/* : Get mowse info pointer */

	mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
	if mowse_info_ptr = null then do;
	     p_code = ws_error_$invalid_mcb;
	     return;
	end;

/* : Check if the capability is not already suspended */

	if sysid = LOCAL_SYSTEM then do;
	     if mowse_info_ptr
		-> mowse_info.local_cat (major_num).flags.suspended then

		p_code = ws_error_$suspended;
	end;
	else if sysid = REMOTE_SYSTEM then do;
	     if mowse_info_ptr
		-> mowse_info.remote_cat (major_num).flags.suspended then

		p_code = ws_error_$suspended;

	     mowse_info_ptr
		-> mowse_info.remote_cat (major_num).flags.suspended
		= TRUE;
	end;
	else
	     p_code = ws_error_$invalid_system_id;

	if p_code ^= 0 then
	     return;

/* : - Call the application with the predefined minor capability
       SUSPEND_APPLICATION by sending a message */

	call send_msg_ (p_mcb_ptr, p_major, SUSPEND_APPLICATION, null, 0,
	     BG, p_code);
	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

/* : If suspending a capability on the local system, send a SET_SUSPEND to
     the remote */

	if sysid = LOCAL_SYSTEM then do;
	     call capability_$pack (REMOTE_SYSTEM, INTERNAL,
		temp_major, (0));
	     call send_mowse_message_ (p_mcb_ptr, LOCAL_SYSTEM, major_num,
		REMOTE_SYSTEM, INTERNAL, SET_SUSPEND, LAST, null, 0, BG,
		p_code);
	end;
	return;

/**/

/* : *** Entry: terminate_capability - internal entry for ws_ *** */


/* ENTRY FUNCTION

Tells MOWSE to terminate a specified application MOWSE directs an application
to terminate itself.
*/

terminate_capability:
     entry (p_major, p_mcb_ptr, p_code);

	p_code = 0;
	call check_mcb_ptr (p_mcb_ptr, p_code);
	if p_code ^= 0 then
	     return;

/* : Unpack the major capability into major capability number and system
     id. */

	call capability_$unpack (sysid, cap_num, p_major, p_code);
	if p_code ^= 0 then
	     return;

/* : Get mowse info pointer */

	mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;

	call verify_capability (mowse_info_ptr, p_major, p_code);
	if p_code ^= 0 then
	     return;

/* : If system id is LOCAL_SYSTEM or REMOTE_SYSTEM then
     - call the capability with minor capability TERMINATE_APPLICATION */

	call send_msg_ (p_mcb_ptr, p_major, TERMINATE_APPLICATION,
	     null, 0, BG, p_code);
	if p_code ^= 0 then do;
	     call fatal_mowse_trap_ (p_code);
	     return;
	end;

	return;

/**/

/* INTERNAL PROCEDURES */


/* *** Procedure: send_bg - Internal proc for COMMENTS  *** */


send_bg:
     proc (p_mcb_ptr, p_major, p_minor, p_data_ptr, p_data_len, p_channel,
	p_code);

/* : PROCEDURE FUNCTION

Split a background message into pieces in the event that the message is
greater than on mowse_io_ packet worth.
*/

/* INPUT PARAMETERS */
dcl p_channel	       fixed bin;		    /* Message channel */
dcl p_code	       fixed bin (35) parameter;
dcl p_data_len	       fixed bin parameter;	    /* Length of data */
dcl p_data_ptr	       ptr parameter;	    /* Data to send */
dcl p_major	       fixed bin parameter;	    /* Destination major */
dcl p_minor	       fixed bin parameter;	    /* Destination minor */
dcl p_mcb_ptr	       ptr parameter;	    /* caller's mcb */


/* MISC VARIABLES */
dcl data_length	       fixed bin;		    /* Length of partial message */
dcl send_data_pos	       fixed bin;		    /* Current position in send_data */
dcl send_data	       char (p_data_len);
dcl data_overlay	       char (p_data_len) based (p_data_ptr);


/* INITIALIZATION */
	send_data_pos = 1;

	do while (send_data_pos <= p_data_len);
	     data_length =
		min (p_data_len - send_data_pos + 1, MAXIMUM_PACKET_SIZE);
	     send_data = substr (data_overlay, send_data_pos, data_length);
	     send_data_pos = send_data_pos + data_length;

	     call send_msg_ (p_mcb_ptr, p_major, p_minor, addr (send_data),
		data_length, FG, p_code);
	     if p_code ^= 0 then do;
		call fatal_mowse_trap_ (p_code);
		return;
	     end;
	end;
     end send_bg;

/**/

/* : *** Procedure: check_mcb_ptr - internal proc for ws_ *** */

/* : PROCEDURE FUNCTION

Check the mcb_ptr to ensure that it is valid and that the major capability
it contains is valid
*/

check_mcb_ptr:
     proc (p_mcb_ptr, p_code);

/* INPUT PARAMETER */
dcl p_mcb_ptr	       ptr;

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);

/* MISC VARIABLES */
dcl code		       fixed bin (35);
dcl system	       fixed bin;
dcl major		       fixed bin;


	p_code = ws_error_$invalid_mcb;
	if p_mcb_ptr = null then
	     return;

	if p_mcb_ptr -> mcb.version ^= VERSION then do;
	     p_code = error_table_$unimplemented_version;
	     return;
	end;

	mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
	if mowse_info_ptr = null then
	     return;

	call capability_$unpack (system, major,
	     p_mcb_ptr -> mcb.major_capability, code);
	if code ^= 0 then
	     return;
	if system ^= LOCAL_SYSTEM then
	     return;
	if major = INTERNAL then do;
	     search_name = "internal_mowse_";
	     if p_mcb_ptr -> mcb.capability_name ^= search_name then
		return;
	     p_code = 0;
	     return;
	end;
	if mowse_info_ptr -> mowse_info.local_cat (major).mcb_ptr
	     ^= p_mcb_ptr then
	     return;
	p_code = 0;
     end check_mcb_ptr;

/**/

/* : *** Procedure: get_buff_length - internal procedure for ws_ *** */

/* : PROCEDURE FUNCTION

Returns a valid buffer length in case the one the user passed is out of
bounds.
*/

get_buff_length:
     proc (length, min, max) returns (fixed bin (17));

/* INPUT PARAMETERS */
dcl length	       fixed bin (17);
dcl min		       fixed bin (17);
dcl max		       fixed bin (17);

	if (length < min) then
	     return (min);
	else if (length > max) then
	     return (max);
	else
	     return (length);

     end get_buff_length;

/**/

/* : *** Procedure: null_mowse_info_handler.  Internal procedure for ws_ *** */


null_mowse_info_handler:
     proc ();

/* : PROCEDURE FUNCTION

Terminate the process as the MOWSE tables have disappeared, first tell
mowse_io_ to close so that the PC can be told of the event.
*/

/* : NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl mowse_iocb_ptr	       ptr;		    /* mowse_io_ iocb */
dcl 01 fatal_error_info    aligned,
       02 version	       fixed bin,		    /* Must be 0 */
       02 status_code      fixed bin (35);	    /* Error code to terminate_process_ */

/* INITIALIZATION */

	call find_mowse_io_ (mowse_iocb_ptr, (0));
	call iox_$close (mowse_iocb_ptr, (0));

	fatal_error_info.version = 0;
	fatal_error_info.status_code = error_table_$no_table;
	call terminate_process_ ("fatal_error", addr (fatal_error_info));

     end null_mowse_info_handler;

/**/

/* : *** Procedure: verify_capability.  Internal procedure for ws_ *** */


verify_capability:
     proc (p_mowse_info_ptr, p_capability_id, p_code);

/* : PROCEDURE FUNCTION

Verify that a capability exists by checking the respective CAT table
*/

/* : NOTES
*/

/* INPUT PARAMETERS */
dcl p_mowse_info_ptr       ptr;
dcl p_capability_id	       fixed bin (17);

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35);

/* MISC VARIABLES */
dcl system_id	       fixed bin (17);
dcl capability_number      fixed bin (17);


	p_code = 0;

	if p_mowse_info_ptr = null then do;
	     p_code = ws_error_$invalid_capability_number;
	     return;
	end;

	call capability_$unpack (system_id, capability_number,
	     p_capability_id, p_code);
	if p_code ^= 0 then
	     return;
	if (system_id = LOCAL_SYSTEM) then do;
	     call check_mcb_ptr ((p_mowse_info_ptr
		-> mowse_info.local_cat (capability_number).mcb_ptr),
		p_code);
	     if p_code ^= 0 then do;
		p_code = ws_error_$invalid_capability_number;
		return;
	     end;
	end;
	else if (system_id = REMOTE_SYSTEM) then do;
	     if (p_mowse_info_ptr
		-> mowse_info.remote_cat (capability_number).
		major_capability = 0) then do;
		p_code = ws_error_$invalid_capability_number;
		return;
	     end;
	end;
	else
	     p_code = ws_error_$invalid_capability_number;
     end verify_capability;

/**/

/* INCLUDE FILES */
%include mowse_info;
%include mowse;
%include mowse_mcb;
%include mowse_messages;
%include mowse_io_control_info;
%include access_mode_values;
     end ws_;




		    ws_channel_.pl1                 01/24/89  0854.8r w 01/24/89  0847.1       68679



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

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
ws_channel_:
     proc ();


/* PROGRAM FUNCTION

This is a collection of entry points which are used to aid mowse in waiting
on specific events (wait channels).
*/


/* NOTES
*/

/****^  HISTORY COMMENTS:
  1) change(87-04-20,Flegel), approve(87-06-23,MCR7649),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
                                                   END HISTORY COMMENTS */

/* INPUT PARAMETERS */
dcl p_wait_ptr	       ptr parameter;	    /* Channel control info */
dcl p_iocb_ptr	       ptr parameter;	    /* Debug File */
dcl p_caller	       char (*) parameter;	    /* Caller name */
dcl p_channel	       fixed bin (71) aligned parameter; /* Channel ID */
dcl p_mio_data_ptr	       ptr parameter;	    /* mowse_io_ info */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl code		       fixed bin (35);
dcl mask		       bit (36) aligned;	    /* IPS mask */
dcl mio_data_ptr	       ptr;		    /* mowse_io_data pointer */

/* STRUCTURES */
dcl 01 mio_data	       like mowse_io_data based (mio_data_ptr);

dcl 01 fatal_error_info    aligned,
       02 version	       fixed bin,		    /* Must be 0 */
       02 status_code      fixed bin (35);	    /* Error code causing fatality */

/* SYSTEM CALLS */
dcl ipc_$unmask_ev_calls   entry (fixed bin(35));
dcl hcs_$wakeup	       entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
dcl ipc_$block	       entry (ptr, ptr, fixed bin (35));
dcl iox_$modes	       entry (ptr, char (*), char (*), fixed bin (35));
dcl hcs_$reset_ips_mask    entry (bit (36) aligned, bit (36) aligned);
dcl hcs_$set_ips_mask      entry (bit (36) aligned, bit (36) aligned);
dcl terminate_process_     entry (char (*), ptr);
dcl create_ips_mask_       entry (ptr, fixed bin, bit (36) aligned);
dcl hcs_$get_ips_mask      entry (bit (36) aligned);

/* SYSTEM CALL SUPPORT */
dcl error_table_$unable_to_do_io fixed bin (35) ext static;

/* EXTERNAL CALLS */
dcl ws_packet_transmitter_$supervisory entry (ptr, char(1));
dcl ws_debug_$line	       entry () options (variable);

/* EXTERNAL CALL SUPPORT */

/* BUILTINS */
dcl byte		       builtin;
dcl bool		       builtin;
dcl addr		       builtin;

/* CONDITIONS */
dcl mowse_io_error	       condition;
dcl cleanup	       condition;

/* CONSTANTS */
dcl True		       bit (1) int static options (constant) init ("1"b);
dcl False		       bit (1) int static options (constant) init ("0"b);

/**/

/* INITIALIZATION */

/* MAIN */

	return;

/**/

%page;

/* INTERNAL ENTRIES */


/* *** Entry: call_wakeup - Internal entry for ws_channel_  *** */

call_wakeup:
     entry (p_mio_data_ptr, p_channel);


/* ENTRY FUNCTION

Generate a wakeup on the specified channel which is a call event channel.
*/

/* NOTES

This is NOT an async channel so control will not be given until something goes
blocked.
*/

	mio_data_ptr = p_mio_data_ptr;
	call hcs_$wakeup (mio_data.channel_info.process_id, p_channel,
	     0, (0));

	return;

/**/

/* *** Entry: wait_block - Internal entry for ws_channel_  *** */

wait_block:
     entry (p_mio_data_ptr, p_wait_ptr, p_caller, p_iocb_ptr);


/* ENTRY FUNCTION

Wait for an event to occur on the specified channel.
*/

/* NOTES
*/

	mio_data_ptr = p_mio_data_ptr;

	call check_ips_mask ();

/* Add myself to the count of blocked events */

	mask = ""b;
	call hcs_$set_ips_mask (""b, mask);
	p_wait_ptr -> wait_info.count = p_wait_ptr -> wait_info.count + 1;
	on cleanup
	     p_wait_ptr -> wait_info.count = p_wait_ptr -> wait_info.count - 1;
	call hcs_$reset_ips_mask (mask, mask);

/* Block */

	call ws_debug_$line (p_iocb_ptr, "vvv blocking:   ^a (^d)", p_caller,
	     p_wait_ptr -> wait_info.count);

	call wait_block_handle (p_wait_ptr -> wait_info.channel);

	call ws_debug_$line (p_iocb_ptr, "^^^^^^ unblocking: ^a (^d)",
	     p_caller, p_wait_ptr -> wait_info.count);

/* Remove from the list of blocked on user_input */

	p_wait_ptr -> wait_info.flags.transmitted = False;
	p_wait_ptr -> wait_info.count = p_wait_ptr -> wait_info.count - 1;

	return;

/**/

/* *** Entry: user_input_wakeup - Internal entry for ws_channel_  *** */

wait_wakeup:
     entry (p_mio_data_ptr, p_wait_ptr);


/* ENTRY FUNCTION

Issue a wakeup on the wait channel if there is something waiting on it.
*/

/* NOTES
*/

	mio_data_ptr = p_mio_data_ptr;

	if p_wait_ptr -> wait_info.count > 0
	     & ^p_wait_ptr -> wait_info.flags.transmitted
	then do;
	     p_wait_ptr -> wait_info.flags.transmitted = True;
	     call hcs_$wakeup (mio_data.channel_info.process_id,
		p_wait_ptr -> wait_info.channel, 0, code);
	     if code ^= 0 then
		signal mowse_io_error;
	end;

	return;

/**/

%page;

/* INTERNAL PROCEDURES */


/* *** Procedure: check_ips_mask - Internal proc for ws_channel_  *** */

check_ips_mask:
     proc ();


/* PROCEDURE FUNCTION

When blocking on a channel, the alrm_ mask cannot be masked, otherwise a wakeup
will never be seen on the channel.  If this condition occurs, the process is
terminated and the remote is notified.

In addition, event calls (ipc_$mask_ev_calls) cannot be set.
*/

/* NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl mask_array	       (2) char (32) aligned;	    /* Array of IPS names */
dcl mask		       bit (36) aligned;	    /* Current IPS mask */
dcl test_mask	       bit (36) aligned;	    /* IPS test mask */
dcl code		       fixed bin (35);

/* STRUCTURES */

/* INITIALIZATION */
	test_mask = ""b;
	mask = ""b;
	mask_array (1) = "wkp_";
	mask_array (2) = "alrm";

/* MAIN */

	call hcs_$get_ips_mask (mask);
	call create_ips_mask_ (addr (mask_array), 2, test_mask);
	if bool (^mask, ^test_mask, And) then
	     goto FATAL_IO_ERROR;

	call ipc_$unmask_ev_calls (code);
	if code = 0 then
	     goto FATAL_IO_ERROR;

	return;

FATAL_IO_ERROR:
	call ws_packet_transmitter_$supervisory (mio_data_ptr,
	     byte (FastDis));
	call iox_$modes (mio_data.iocb_ptr, mio_data.old_modes, "", 0);
	fatal_error_info.version = 0;
	fatal_error_info.status_code = error_table_$unable_to_do_io;
	call terminate_process_ ("fatal_error", addr (fatal_error_info));

     end check_ips_mask;

/**/

/* *** Procedure: wait_block_handle - Internal proc for ws_channel_  *** */

wait_block_handle:
     proc (p_channel_id);


/* PROCEDURE FUNCTION

Wait on the specified channel for a wakeup.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_channel_id	       fixed bin (71) aligned parameter; /* Channel to wait on */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl code		       fixed bin (35);

/* STRUCTURES */
dcl 01 ewc	       like event_wait_channel aligned automatic;
dcl 01 ewi	       like event_wait_info aligned automatic;

/* INITIALIZATION */

/* MAIN */

	ewc.n_channels = 1;
	ewc.pad = ""b;
	ewc.channel_id = p_channel_id;

	call ipc_$block (addr (ewc), addr (ewi), code);
	if code ^= 0 then
	     signal mowse_io_error;

     end wait_block_handle;

/**/

%page;

/* INCLUDE FILES */
%include mowse_io_constants;
%include event_wait_info;
%include event_wait_channel;
%include mowse_io_data;

     end;




		    ws_debug_.pl1                   01/24/89  0854.8r w 01/24/89  0847.5      109431



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

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
ws_debug_:
     proc ();


/* PROGRAM FUNCTION

This is a collection of entry points which are responsible for handling the
debug files of MOWSE.
*/


/* NOTES
*/

/****^  HISTORY COMMENTS:
  1) change(87-05-04,Flegel), approve(87-06-23,MCR7649),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
                                                   END HISTORY COMMENTS */

/* INPUT PARAMETERS */
dcl p_header	       char (*) parameter;	    /* Packet header info */
dcl p_packet_ptr	       ptr parameter;	    /* Packet */
dcl p_packet_len	       fixed bin (21) parameter;  /* Length of packet */
dcl p_info_ptr	       ptr parameter;	    /* Control info pointer */

/* OUTPUT PARAMETERS */
dcl p_iocb_ptr	       ptr parameter;	    /* IOCB of debug file */
dcl p_code	       fixed bin (35) parameter;  /* Error code */

/* MISC VARIABLES */
dcl asn		       fixed bin;		    /* Packet ACK SN */
dcl psn		       fixed bin;		    /* Packet SN */
dcl channel	       fixed bin;		    /* Channel ID */
dcl debug_len	       fixed bin (21);	    /* Length of nonvarying debug string */
dcl debug_string	       char (512);		    /* Non-varying debug string */
dcl iocb_ptr	       ptr;		    /* IOCB */
dcl arg_len	       fixed bin (21);	    /* Length of argument */
dcl arg_ptr	       ptr;		    /* Argument */
dcl arg_list_ptr	       ptr;		    /* Argument list */
dcl code		       fixed bin (35);
dcl arg_count	       fixed bin;		    /* Number of args */
dcl chr		       char (1);		    /* Single char holder */
dcl i		       fixed bin (21);
dcl debug_string_var       char (512) var;	    /* Output string */
dcl debug_name	       char (512) var;	    /* Debug file name */

/* STRUCTURES */
dcl based_ptr	       ptr based;		    /* ptr overlay */
dcl packet_data	       char (p_packet_len) based (p_packet_ptr);

/* SYSTEM CALLS */
dcl cu_$arg_ptr	       entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
dcl iox_$put_chars	       entry (ptr, ptr, fixed bin (21), fixed bin (35));
dcl ioa_$general_rs	       entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned,
		       bit (1) aligned);
dcl cu_$arg_list_ptr       entry (ptr);
dcl cu_$arg_count	       entry (fixed bin, fixed bin (35));
dcl iox_$close	       entry (ptr, fixed bin (35));
dcl iox_$detach_iocb       entry (ptr, fixed bin (35));
dcl iox_$open	       entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
dcl iox_$attach_name       entry (char (*), ptr, char (*), ptr, fixed bin (35));

/* SYSTEM CALL SUPPORT */
dcl error_table_$active_function fixed bin (35) ext static;
dcl ws_error_$trace_already_on fixed bin (35) ext static;
dcl error_table_$unimplemented_version fixed bin (35) ext static;
dcl ws_error_$debug_already_on fixed bin (35) ext static;

/* EXTERNAL CALLS */
dcl ws_tools_$ars	       entry (fixed bin, fixed bin) returns (fixed bin);
dcl ws_debug_$line	       entry options (variable);

/* EXTERNAL CALL SUPPORT */

/* BUILTINS */
dcl substr	       builtin;
dcl addr		       builtin;
dcl rank		       builtin;
dcl divide	       builtin;
dcl mod		       builtin;
dcl byte		       builtin;
dcl index		       builtin;
dcl null		       builtin;
dcl length	       builtin;

/* CONDITIONS */

/* CONSTANTS */

/**/

/* INITIALIZATION */

/* MAIN */

	return;

/**/

%page;

/* INTERNAL ENTRIES */


/* *** Entry: debug_close - Internal entry for ws_debug_  *** */

debug_close:
     entry (p_iocb_ptr, p_code);


/* ENTRY FUNCTION

Close and detach the specified IOCB.
*/

/* NOTES
*/

	p_code = 0;
	call close_file (p_iocb_ptr, p_code);

	return;

/**/

/* *** Entry: line - Internal entry for ws_debug_  *** */

line:
     entry options (variable);


/* ENTRY FUNCTION

Works like ioa_$ioa_switch but provides a single entry into all writing
to the debug file.
*/

/* NOTES

Calling sequence:

   call ws_debug_$line (iocb_ptr, control_string, arg1, ..., argN);
*/

/* Verify that the number of args is OK */

	call cu_$arg_count (arg_count, code);
	if code ^= 0 & code ^= error_table_$active_function then
	     return;
	if arg_count < 2 then
	     return;

/* The first argument must be a pointer (IOCB) */

	call cu_$arg_list_ptr (arg_list_ptr);
	call cu_$arg_ptr (1, arg_ptr, arg_len, code);
	if code ^= 0 then
	     return;
	if arg_ptr = null then
	     return;
	if arg_ptr -> based_ptr = null then
	     return;
	iocb_ptr = arg_ptr -> based_ptr;

/* Get the remainder of the arguments and write the string */

	call ioa_$general_rs (arg_list_ptr, 2, 3, debug_string, debug_len,
	     "0"b, "1"b);
	call iox_$put_chars (iocb_ptr, addr (debug_string), debug_len, code);
	if code ^= 0 then
	     return;

	return;

/**/

/* *** Entry: debug_open - Internal entry for ws_debug_  *** */

debug_open:
     entry (p_info_ptr, p_iocb_ptr, p_code);


/* ENTRY FUNCTION

Open the specified IOCB into which debug info is dumped.
*/

/* NOTES
*/

	p_code = 0;

/* IOCB not null means that it is already open */

	if p_iocb_ptr ^= null then do;
	     p_code = ws_error_$debug_already_on;
	     return;
	end;

/* Determine what to call the file */

	debug_name = "debug.mowse_io_";
	if p_info_ptr ^= null then do;
	     if p_info_ptr -> mowse_io_debug_info.version
		^= mowse_io_info_version_1
	     then do;
		p_code = error_table_$unimplemented_version;
		return;
	     end;

	     if length (p_info_ptr -> mowse_io_debug_info.segment_name) ^= 0
		then
		debug_name
		     = p_info_ptr -> mowse_io_debug_info.segment_name;
	end;

	if index (debug_name, ".mowse_io_") = 0 then
	     debug_name = debug_name || ".mowse_io_";

/* Open the file */

	call open_file (debug_name, "mowse_io_debug", p_iocb_ptr, p_code);

	return;

/**/

/* *** Entry: packet - Internal entry for ws_debug_  *** */

packet:
     entry (p_header, p_packet_ptr, p_packet_len, p_iocb_ptr);


/* ENTRY FUNCTION

Write the packet to the debug file.
*/

/* NOTES
*/

/* Does the file exist? */

	if p_iocb_ptr = null then
	     return;

/* Write the info to the file */

	debug_string_var = "";
	do i = 1 to p_packet_len;
	     if substr (packet_data, i, 1) < " "
		| substr (packet_data, i, 1) > "~"
	     then do;
		chr = substr (packet_data, i, 1);
		debug_string_var = debug_string_var
		     || "\";
		debug_string_var = debug_string_var
		     || byte (mod (divide (rank (chr), 64, 3), 8)
		     + rank ("0"));
		debug_string_var = debug_string_var
		     || byte (mod (divide (rank (chr), 8, 3), 8)
		     + rank ("0"));
		debug_string_var = debug_string_var
		     || byte (mod (rank (chr), 8)
		     + rank ("0"));
	     end;
	     else
		debug_string_var = debug_string_var
		     || substr (packet_data, i, 1);
	end;

	if substr (packet_data, 1, 1) = byte (1) then do;
	     call extract_type (rank (substr (packet_data, 2, 1)), channel,
		psn, asn);
	     call ws_debug_$line (p_iocb_ptr,
		"^a(^[BG^;FG^;SS^]-^[P^d^;**^s^]-^[A^d^;**^s^]):^a",
		p_header, channel + 1, (psn >= 0), psn, (asn >= 0), asn,
		debug_string_var);
	end;
	else
	     call ws_debug_$line (p_iocb_ptr, "^a^a", p_header,
		debug_string_var);

	return;

/**/

/* *** Entry: trace_close - Internal entry for ws_debug_  *** */

trace_close:
     entry (p_iocb_ptr, p_code);


/* ENTRY FUNCTION

Close and detach the specified IOCB.
*/

/* NOTES
*/

	p_code = 0;
	call close_file (p_iocb_ptr, p_code);

	return;

/**/

/* *** Entry: trace_open - Internal entry for ws_debug_  *** */

trace_open:
     entry (p_info_ptr, p_iocb_ptr, p_code);


/* ENTRY FUNCTION

Open the specified IOCB into which trace info is dumped.
*/

/* NOTES
*/

	p_code = 0;

/* IOCB not null means that it is already open */

	if p_iocb_ptr ^= null then do;
	     p_code = ws_error_$trace_already_on;
	     return;
	end;

/* Determine what to call the file */

	debug_name = "trace.mowse_io_";
	if p_info_ptr ^= null then do;
	     if p_info_ptr -> mowse_io_debug_info.version
		^= mowse_io_info_version_1
	     then do;
		p_code = error_table_$unimplemented_version;
		return;
	     end;

	     if length (p_info_ptr -> mowse_io_debug_info.segment_name) ^= 0
		then
		debug_name
		     = p_info_ptr -> mowse_io_debug_info.segment_name;
	end;

	if index (debug_name, ".mowse_io_") = 0 then
	     debug_name = debug_name || ".mowse_io_";

/* Open the file */

	call open_file (debug_name, "mowse_io_trace", p_iocb_ptr, p_code);

	return;

/**/

%page;

/* INTERNAL PROCEDURES */


/* *** Procedure: close_file - Internal proc for ws_debug_  *** */

close_file:
     proc (p_iocb_ptr, p_code);


/* PROCEDURE FUNCTION

Close and detach the specified file IOCB.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_iocb_ptr	       ptr parameter;	    /* the IOCB to close and detach */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */

/* STRUCTURES */

/* INITIALIZATION */
	p_code = 0;

/* MAI */

	if p_iocb_ptr = null then
	     return;

	call iox_$close (p_iocb_ptr, p_code);
	if p_code ^= 0 then
	     return;

	call iox_$detach_iocb (p_iocb_ptr, p_code);
	if p_code ^= 0 then
	     return;

	p_iocb_ptr = null;

     end close_file;

/**/

/* *** Procedure: extract_type - Internal proc for ws_debug_  *** */

extract_type:
     proc (p_type, p_channel, p_psn, p_asn);


/* PROCEDURE FUNCTION

Given a type field, extract the channel, packet sequence number and ack
sequence number.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_type	       fixed bin parameter;	    /* Packet type to decipher */

/* OUTPUT PARAMETERS */
dcl p_channel	       fixed bin parameter;	    /* Channel ID */
dcl p_psn		       fixed bin parameter;	    /* Packet SN */
dcl p_asn		       fixed bin parameter;	    /* Packet ACK SN */

/* MISC VARIABLES */
dcl fields	       fixed bin;		    /* Type offset removed */

/* STRUCTURES */

/* INITIALIZATION */
	p_channel = 2;
	p_psn = -1;
	p_asn = -1;

/* MAIN */

	if DatOff <= p_type & p_type < DatOff + DatCnt then do;
	     fields = p_type - DatOff;
	     p_asn = mod (fields, SeqCnt);
	     p_psn = mod (ws_tools_$ars (fields, SeqFld), SeqCnt);
	     channel = ws_tools_$ars (fields, SeqFld + SeqFld);
	end;
	else if AckOff <= p_type & p_type < AckOff + AckCnt then do;
	     fields = p_type - AckOff;
	     p_asn = mod (fields, SeqCnt);
	     p_channel = ws_tools_$ars (fields, SeqFld);
	end;
	else if NakOff <= p_type & p_type < NakOff + NakCnt then do;
	     fields = p_type - NakOff;
	     p_asn = mod (fields, SeqCnt);
	     p_channel = ws_tools_$ars (fields, SeqFld);
	end;
	else
	     return;

     end extract_type;

/**/

/* *** Procedure: open_file - Internal proc for ws_debug_  *** */

open_file:
     proc (p_name, p_switch_name, p_iocb_ptr, p_code);


/* PROCEDURE FUNCTION

Open an IOCB for the specified file on the provided switch name.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_name	       char (*) var parameter;    /* Name of file */
dcl p_switch_name	       char (*) parameter;	    /* name of IOCB switch */

/* OUTPUT PARAMETERS */
dcl p_iocb_ptr	       ptr parameter;	    /* IOCB block */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */

/* STRUCTURES */

/* INITIALIZATION */

/* MAIN */

	call iox_$attach_name (p_switch_name, p_iocb_ptr,
	     "vfile_ " || p_name, null, p_code);
	if p_code ^= 0 then do;
	     p_iocb_ptr = null;
	     return;
	end;

	call iox_$open (p_iocb_ptr, Stream_output, ""b, p_code);
	if p_code ^= 0 then do;
	     call iox_$detach_iocb (p_iocb_ptr, (0));
	     p_iocb_ptr = null;
	     return;
	end;

     end open_file;

/**/

%page;

/* INCLUDE FILES */
%include mowse_io_constants;
%include iox_modes;
%include mowse_io_control_info;
%include mowse_io_data;

     end;




		    ws_error_.alm                   08/07/87  1558.4rew 08/07/87  1454.8       37728



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

" HISTORY COMMENTS:
"  1) change(86-01-15,Flegel), approve(87-07-15,MCR7580),
"     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
"     Created.
"  2) change(86-11-25,Flegel), approve(87-07-15,MCR7580),
"     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
"     Added already_sleeping error code.
"  3) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
"     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
"     Approved
"  4) change(86-12-05,Flegel), approve(86-12-05,MCR7580),
"     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
"     Added inconsistent_mowse_tables error to signal that MOWSE data has
"     become bad.  this should be treated as a fatal process error as MOWSE is
"     no longer in a valid state.
"  5) change(86-12-10,Flegel), approve(86-12-10,MCR7580),
"     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
"     Added error code for recursive background error description.
"  6) change(87-01-19,Flegel), approve(87-01-19,MCR7580),
"     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
"     Added unsupported_ws_terminal error code.
"  7) change(87-03-24,Flegel), approve(87-03-24,MCR7580),
"     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
"     Added invalid_escape_char error code.
"                                                      END HISTORY COMMENTS

"MOWSE Error Codes


	include	et_macros
	et	ws_error_

ec	already_sleeping,sleeping,
	(Already sleeping.)

ec	buffer_overflow,bufovr,
	(Message buffer overflowed.)

ec	cant_create_instance,cantcret,
	(Cannot create instance of application.)

ec	debug_already_off,debugoff,
	(MOWSE debugging facility is already off.)

ec	debug_already_on,debugon,
	(MOWSE debugging facility is already on.)

ec	inconsistent_mowse_tables,badwstbl,
	(MOWSE tables are in an inconsistent state.)

ec	input_buffer_empty,inbufept,
	(Application tried to send empty buffer.)

ec	input_buffer_overflow,inbufovf,
	(Application's input buffer overflowed.)

ec	invalid_buffer_length,invbufln,
	(Application's buffer length is too small.)

ec	invalid_capability_name,invnam,
	(Invalid capability name.)

ec	invalid_capability_number,invnum,
	(Invalid major capability number.)

ec	invalid_continue_message,invcntms,
          (Invalid continuation message format.)

ec	invalid_connect_status,invcstat,
	(Invalid connect status response.)

ec	invalid_data_ptr,invdtptr,
	(Invalid data pointer.)

ec	invalid_entry_name,inventry,
	(Invalid application entry point name.) 

ec	invalid_escape_char,badesc,
	(Invalid escape character.)

ec	invalid_last_message,invlstms,
	(Invalid last message format.)

ec	invalid_mcb,invmcb,
	(Invalid MOWSE Control Block.)

ec        invalid_message,invmsg,
	(Invalid message format.)

ec	invalid_minor_capability,invmin,
	(Invalid minor capability number.)

ec	invalid_more_message,invmorms,
	(Invalid more message fromat.)

ec	invalid_sleep_interval,invsleep,
	(Invalid sleep interval.)

ec	invalid_system_id,invsysid,
	(Invalid system identifier.)

ec	no_capability,no_cap,
	(Capability does not exist.)

ec	not_available,notavlbe,
	(Entry unavailable.)

ec	not_suspended,nosspnd,
	(Application is not suspended.)

ec	output_buffer_overflow,otbufovf,
	(Application's output buffer overflowed.)

ec	recursive_background_error,recbgerr,
	(Recursive errors occurred in background application.)

ec	sleeping,sleep,
	(Application is sleeping.)

ec	suspended,suspend,
	(Application is suspended.)

ec	trace_already_off,traceoff,
	(MOWSE tracing facility is already off.)

ec	trace_already_on,traceon,
	(MOWSE tracing facility is already on.)

ec	unsupported_ws_terminal,nowsterm,
	(Specified terminal is not supported by MOWSE.)

ec	ws_video_invoked,wsvideo,
	(The window system is invoked.)

end




		    ws_packet_dispatcher_.pl1       01/24/89  0854.8r w 01/24/89  0847.3       84861



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

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
ws_packet_dispatcher_:
     proc (p_mio_data_ptr);


/* PROGRAM FUNCTION

This procedure is respoinsible for dispatching background packets to MOWSE
itself.  It actually works with packets and lets MOWSE do all of the assembly
of packets into complete messages and also lets MOWSE dispatch the message to
the appropriate background handler.
*/


/* NOTES

This procedure is to be called ONLY when the background processing flags have
been set - ie. there are no other invocations of ws_packet_dispatcher_
executing.
*/

/****^  HISTORY COMMENTS:
  1) change(87-04-16,Flegel), approve(87-06-23,MCR7649),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
                                                   END HISTORY COMMENTS */

/* INPUT PARAMETERS */
dcl p_mio_data_ptr	       ptr parameter;	    /* MOWSE data */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */
dcl buffer	       char (data_len) based (data_ptr);
dcl data_ptr	       ptr;
dcl code		       fixed bin (35);
dcl data		       (MaxDatLen) char (1);	    /* Data */
dcl data_len	       fixed bin (21);	    /* Data length */
dcl mio_data_ptr	       ptr int static;	    /* Local copy of mowse_io_data_ptr */

/* STRUCTURES */
dcl 01 mio_data	       like mowse_io_data based (mio_data_ptr);
dcl 01 fatal_error_info    aligned,
       02 version	       fixed bin,
       02 status_code      fixed bin (35);

/* SYSTEM CALLS */
dcl ipc_$delete_ev_chn     entry (fixed bin (71), fixed bin (35));
dcl ipc_$create_event_channel entry (ptr, fixed bin (71), fixed bin (35));

/* SYSTEM CALL SUPPORT */
dcl error_table_$no_table  fixed bin (35) ext static;

/* EXTERNAL CALLS */
dcl ws_tools_$getldat      entry (ptr, fixed bin, ptr) returns (fixed bin (21));
dcl ws_tools_$getdat       entry (ptr, fixed bin, ptr, fixed bin) returns (fixed bin);
dcl terminate_process_     entry (char (*), ptr);
dcl ws_packet_transmitter_$supervisory entry (ptr, char (1));
dcl rcvdat_	       entry (ptr, ptr, fixed bin (21), fixed bin (35));
dcl ws_debug_$line	       entry () options (variable);
dcl wake_up_sleeper_       entry (ptr, fixed bin);

/* EXTERNAL CALL SUPPORT */

/* BUILTINS */
dcl divide	       builtin;
dcl byte		       builtin;
dcl null		       builtin;
dcl addr		       builtin;
dcl clock		       builtin;

/* CONDITIONS */
dcl cleanup	       condition;
dcl mowse_io_error	       condition;

/* CONSTANTS */

/**/

/* INITIALIZATION */

/* MAIN */

	return;

/**/

%page;

/* INTERNAL ENTRIES */


/* *** Entry: initialize - Internal entry for ws_packet_dispatcher_  *** */

initialize:
     entry (p_mio_data_ptr, p_code);


/* ENTRY FUNCTION

Initialize the packet dispatcher.
*/

/* NOTES
*/

	mio_data_ptr = p_mio_data_ptr;

	call setup_channel (p_code);

	return;

/**/

/* *** Entry: processor - Internal entry for ws_packet_dispatcher_  *** */

processor:
     entry ();


/* ENTRY FUNCTION

This is the main entry into the dispatcher.  Entry is through an event
signalled on a call event channel.
*/

/* NOTES
*/

/* If already processing, then quit */

	if mio_data.task.active (BG_task) then
	     return;

	mio_data.task.active (BG_task) = ^Idle;
	on cleanup mio_data.task.active (BG_task) = Idle;

/* Process sleepers */

	if mio_data.sleepers ^= null then do;
	     if mio_data.info_ptr = null then
		goto NULL_MOWSE_TABLES;
	     call wakeup ();
	end;

/* Process each pending packet from the local system until all of the
   messages currently pending are processed, leaving any new messages
   for the next scheduler interrupt */

	data_len = ws_tools_$getldat (mio_data_ptr, BG, data_ptr);
	do while (data_len > 0);
	     if mio_data.info_ptr = null then
		goto NULL_MOWSE_TABLES;

	     call ws_debug_$line (mio_data.debug_iocb_ptr,
		"   ****** START LOCAL MESSAGE ******");

	     call rcvdat_ (mio_data.mcb_ptr, data_ptr, data_len, code);
	     free data_ptr -> buffer;

	     call ws_debug_$line (mio_data.debug_iocb_ptr,
		"   ****** DONE  LOCAL MESSAGE ******");

	     if code ^= 0 then do;
		signal mowse_io_error;
		mio_data.task.active (BG_task) = Idle;
		return;
	     end;

	     data_len = ws_tools_$getldat (mio_data_ptr, BG, data_ptr);
	end;

/* Process each pending packet from the remote system */

	data_len = ws_tools_$getdat (mio_data_ptr, BG, addr (data), MaxDatLen);
	do while (data_len > 0);
	     if mio_data.info_ptr = null then
		goto NULL_MOWSE_TABLES;

	     call ws_debug_$line (mio_data.debug_iocb_ptr,
		"****** START REMOTE MESSAGE ******");
	     call rcvdat_ (mio_data.mcb_ptr, addr (data), data_len, code);
	     call ws_debug_$line (mio_data.debug_iocb_ptr,
		"****** DONE  REMOTE MESSAGE ******");
	     if code ^= 0 then do;
		signal mowse_io_error;
		mio_data.task.active (BG_task) = Idle;
		return;
	     end;

	     data_len = ws_tools_$getdat (mio_data_ptr, BG, addr (data),
		MaxDatLen);
	end;

	mio_data.task.active (BG_task) = Idle;
	return;

/* If mowse_info has become null then MOWSE data base is screwed up
   and there is a real problem with MOWSE, so tell the PC to disconnect
   and signal FATAL PROCESS ERROR */

NULL_MOWSE_TABLES:
	mio_data.task.active (BG_task) = Idle;
	call ws_packet_transmitter_$supervisory (mio_data_ptr,
	     byte (FastDis));

	fatal_error_info.version = 0;
	fatal_error_info.status_code = error_table_$no_table;
	call terminate_process_ ("fatal_error", addr (fatal_error_info));

	return;

/**/

/* *** Entry: terminate - Internal entry for ws_packet_dispatcher_  *** */

terminate:
     entry ();


/* ENTRY FUNCTION

Shutdown all stuff associated with the dispatchig process.
*/

/* NOTES
*/

	if mio_data.channel_info.packet_dispatcher.async_channel ^= 0 then
	     call ipc_$delete_ev_chn (
		mio_data.channel_info.packet_dispatcher.async_channel,
		(0));

	if mio_data.channel_info.packet_dispatcher.sync_channel ^= 0 then
	     call ipc_$delete_ev_chn (
		mio_data.channel_info.packet_dispatcher.sync_channel, (0));

	mio_data_ptr = null;
	return;

/**/

%page;

/* INTERNAL PROCEDURES */


/* *** Procedure: setup_channel - Internal proc for ws_packet_dispatcher_  *** */

setup_channel:
     proc (p_code);


/* PROCEDURE FUNCTION

Setup a call channel where events are to be generated when there is something
to do.
*/

/* NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */

/* STRUCTURES */
dcl 01 ipc_arg	       like ipc_create_arg_structure aligned automatic;

/* INITIALIZATION */
	mio_data.channel_info.packet_dispatcher.async_channel = 0;
	mio_data.channel_info.packet_dispatcher.sync_channel = 0;

/* MAIN */
	ipc_arg.version = ipc_create_arg_structure_v1;
	ipc_arg.channel_type = CALL_EVENT_CHANNEL_TYPE;
	ipc_arg.call_entry = processor;
	ipc_arg.call_data_ptr = null;
	ipc_arg.call_priority = 0;
	call ipc_$create_event_channel (addr (ipc_arg),
	     mio_data.packet_dispatcher.async_channel, p_code);

	ipc_arg.version = ipc_create_arg_structure_v1;
	ipc_arg.channel_type = ASYNC_CALL_EVENT_CHANNEL_TYPE;
	ipc_arg.call_entry = processor;
	ipc_arg.call_data_ptr = null;
	ipc_arg.call_priority = 0;
	call ipc_$create_event_channel (addr (ipc_arg),
	     mio_data.packet_dispatcher.sync_channel, p_code);

     end setup_channel;

/**/

/* *** Procedure: wakeup - Internal proc for ws_packet_dispatcher_  *** */

wakeup:
     proc ();


/* PROCEDURE FUNCTION

Look through the list of currently sleeping applications and generate a call
to wak_up_sleeper_ if an appllication is to be awoken.
*/

/* NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl temp_ptr	       ptr;		    /* Search reference ptr */
dcl current_time	       fixed bin (71);

/* STRUCTURES */
dcl 01 node	       like mowse_io_sleep_node based;

/* INITIALIZATION */
	current_time = divide (clock, 1000000, 0);

/* MAIN */

/* If none sleeping then return */

	if mio_data.sleepers = null then
	     return;

/* Wake up each of the sleepers who are to be awoken and remove the node
   from the list */

	do while (mio_data.sleepers -> node.when <= current_time);
	     temp_ptr = mio_data.sleepers;
	     mio_data.sleepers = mio_data.sleepers -> node.next;
	     if mio_data.sleepers ^= null then
		mio_data.sleepers -> node.last = null;

	     call ws_debug_$line (mio_data.debug_iocb_ptr,
		"   ****** START WAKEUP ******");
	     call wake_up_sleeper_ (mio_data.mcb_ptr, temp_ptr -> node.major);
	     call ws_debug_$line (mio_data.debug_iocb_ptr,
		"   ****** DONE WAKEUP *******");

	     free temp_ptr -> node;
	     temp_ptr = null;
	     if mio_data.sleepers = null then
		return;
	end;

     end wakeup;

/**/

%page;

/* INCLUDE FILES */
%include ipc_create_arg;
%include mowse_io_structures;
%include mowse_messages;
%include mowse_io_constants;
%include mowse;
%include mowse_io_data;

     end;




		    ws_packet_receiver_.pl1         10/17/90  0821.1rew 10/17/90  0815.3      369873



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1990   *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1987 *
        *                                                         *
        * Copyright, (C) Honeywell Bull Inc., 1987                *
        *                                                         *
        *********************************************************** */

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
ws_packet_receiver_:
     proc ();


/* PROGRAM FUNCTION

This routine is responsible for the receipt of data from the remote (PC).
It's ONLY entry is through the immediate call event channel mechanism
released with MR12.0.  An event is signalled on the channel when tty_
(hcs_) has received the EOP character from the remote (PC) and wake up
immediately to process the packet.
*/


/* NOTES

Certain situations require that this be recursively called in order that
events for which a previous invocation of this call handler is waiting
can be received.  Such is performed by the calls to ipc_$resetev_call_chn
*/

/****^  HISTORY COMMENTS:
  1) change(87-04-20,Flegel), approve(87-06-23,MCR7649),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(87-09-02,RBarstad), approve(87-09-02,PBF7649),
     audit(87-09-02,LJAdams), install(87-09-02,MR12.1-1096):
     Fixed to wrap mio_data.user_input.queue at (0) and not (1).
  3) change(88-11-08,Flegel), approve(88-11-16,MCR8023), audit(88-12-12,Lee),
     install(89-01-24,MR12.3-1012):
     phx21215 - Added support for a foreground event channel upon which
                events are transmitted when foreground data has been
                received.
  4) change(90-09-20,Bubric), approve(90-10-01,MCR8211), audit(90-10-01,Itani),
     install(90-10-17,MR12.4-1044):
     Have the calls to the routine 'nothing' changed to calls to
     'null_entry_'.
                                                   END HISTORY COMMENTS */

/* INPUT PARAMETERS */
dcl p_open_struc_ptr       ptr parameter;	    /* User control info */
dcl p_mio_data_ptr	       ptr parameter;	    /* mowse_io_ data */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */
dcl input_ready	       bit (1);		    /* Data from the PC */
dcl i		       fixed bin;

/* STATIC */
dcl mio_data_ptr	       ptr int static init (null);/* mowse_io_ data */

/* STRUCTURES */
dcl fixedbin21	       fixed bin (21) based;
dcl 01 cond_info	       like condition_info aligned automatic;
dcl 01 mio_data	       like mowse_io_data based (mio_data_ptr);

/* SYSTEM CALLS */
dcl hcs_$wakeup	       entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
dcl ipc_$reset_ev_call_chn entry (fixed bin (71), fixed bin (35));
dcl signal_	       entry () options (variable);
dcl null_entry_	       entry options (variable);
dcl ipc_$create_event_channel entry (ptr, fixed bin (71), fixed bin (35));
dcl hcs_$reset_ips_mask    entry (bit (36) aligned, bit (36) aligned);
dcl iox_$modes	       entry (ptr, char (*), char (*), fixed bin (35));
dcl hcs_$set_ips_mask      entry (bit (36) aligned, bit (36) aligned);
dcl ipc_$unmask_ev_calls   entry (fixed bin (35));
dcl ipc_$mask_ev_calls     entry (fixed bin (35));
dcl ipc_$delete_ev_chn     entry (fixed bin (71), fixed bin (35));
dcl sct_manager_$call_handler entry (ptr, char (*), ptr, ptr, bit (1) aligned);
dcl find_condition_info_   entry (ptr, ptr, fixed bin (35));
dcl sct_manager_$set       entry (fixed bin, ptr, fixed bin (35));
dcl iox_$get_chars	       entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
dcl iox_$control	       entry (ptr, char (*), ptr, fixed bin (35));

/* SYSTEM CALL SUPPORT */
dcl error_table_$line_status_pending fixed bin (35) ext static;

/* EXTERNAL CALLS */
dcl ws_debug_$line	       entry () options (variable);
dcl ws_channel_$call_wakeup entry (ptr, fixed bin (71));
dcl ws_tools_$getdat       entry (ptr, fixed bin, ptr, fixed bin (21)) returns (fixed bin (21));
dcl ws_packet_transmitter_$data entry (ptr, fixed bin, ptr, fixed bin (21), fixed bin);
dcl ws_timer_$reset_disconnect entry options (variable);
dcl ws_timer_$reset_break  entry options (variable);
dcl ws_packet_transmitter_$ack entry (fixed bin, ptr);
dcl ws_packet_transmitter_$resend entry (ptr, fixed bin);
dcl ws_packet_transmitter_$supervisory entry (ptr, char (1));
dcl ws_tools_$reset_data   entry (ptr);
dcl ws_packet_transmitter_$nak entry (fixed bin, ptr);
dcl ws_tools_$ars	       entry (fixed bin, fixed bin) returns (fixed bin);
dcl ws_tools_$check_length entry (fixed bin (21)) returns (char (1));
dcl ws_tools_$crc_char     entry (char (1), fixed bin) returns (fixed bin);
dcl ws_debug_$packet       entry (char (*), ptr, fixed bin (21), ptr);
dcl ws_channel_$wait_wakeup entry (ptr, ptr);

/* EXTERNAL CALL SUPPORT */

/* BUILTINS */
dcl unspec	       builtin;
dcl length	       builtin;
dcl hbound	       builtin;
dcl bool		       builtin;
dcl byte		       builtin;
dcl mod		       builtin;
dcl substr	       builtin;
dcl rank		       builtin;
dcl null		       builtin;
dcl convert	       builtin;
dcl addr		       builtin;

/* CONDITIONS */
dcl cleanup	       condition;
dcl mowse_io_error	       condition;

/* CONSTANTS */
dcl False		       bit (1) int static options (constant) init ("0"b);
dcl True		       bit (1) int static options (constant) init ("1"b);

/**/

/* INITIALIZATION */

/* MAIN */

/* Debugging information */

	if mio_data.debug_iocb_ptr ^= null then do;
	     call ws_debug_$line (mio_data.debug_iocb_ptr,
		"   tasks:^[Modem ^]^[FG ^]^[BG^]",
		mio_data.task.active (0), mio_data.task.active (1),
		mio_data.task.active (2));
	end;

/* Process all interrupts, even those which occurred while this processing
   occurred */

	if ^mio_data.task.active (Modem_Reader_Task) then do;
	     mio_data.task.active (Modem_Reader_Task) = ^Idle;

	     input_ready = True;
	     do while (input_ready);
		call modem_reader ();
		input_ready = prime_tty ();
	     end;

	     mio_data.task.active (Modem_Reader_Task) = Idle;
	end;

/* Allow recursive calls and schedule all data that has arrived */

	call ipc_$reset_ev_call_chn (
	     mio_data.channel_info.packet_receiver.channel, (0));
	call scheduler ();

/* Keep the receive windows active (if they are close to being full, then
   send an ack to open them */

	do i = 0 to ChnCnt - 1;
	     if mod (mio_data.r.psn (i) - mio_data.s.lasn (i), SeqCnt)
		>= RWS - 1
		then
		call ws_packet_transmitter_$ack (i, mio_data_ptr);
	end;

	return;

/**/

%page;

/* INTERNAL ENTRIES */


/* *** Entry: initialize - Internal entry for ws_packet_receiver_  *** */

initialize:
     entry (p_mio_data_ptr, p_open_struc_ptr, p_code);


/* ENTRY FUNCTION

Initialize the packet receiver.
*/

/* NOTES
*/
	mio_data_ptr = p_mio_data_ptr;
	open_struc_ptr = p_open_struc_ptr;

	if open_struc_ptr ^= null then
	     if open_struc.flags.network_sw then
		mio_data.r.eop = CR;
	     else
		mio_data.r.eop = LF;

	mio_data.r.sop = SOH;
	mio_data.r.esc (0) = ESC;
	mio_data.r.esc (1) = SI;
	mio_data.r.esc (2) = SO;
	mio_data.r.esc_count = 0;
	mio_data.r.asn (*) = 0;
	mio_data.r.dat (*, *) = "";
	mio_data.r.esckey = ""b;
	mio_data.r.ignoring (*) = False;
	mio_data.r.pkt (*) = " ";
	mio_data.r.pktin = 0;
	mio_data.r.pktout = 0;
	mio_data.r.psn (*) = 0;

	call setup_wakeup (p_code);
	return;

/**/

/* *** Entry: sus_handler - Internal entry for ws_packet_receiver_  *** */

sus_handler:
     entry ();


/* ENTRY FUNCTION

This entry is invoked whenever the process receives a sus_signal.  This is
in order for mowse_io_ to detect that the process has been detached from the
terminal in which case future talks to the terminal are impossible.
*/

/* NOTES

All that is done is that a flag (sus_data.activated) is set, alarms are turned
off, and then control is passed on to the sus_signal_handler_ that existed
before MOWSE was attached.
*/

	mio_data.sus_data.activated = True;

	call ws_debug_$line (mio_data.debug_iocb_ptr,
	     "===== SUS Activated =====");

	call sct_manager_$set (susp_sct_index, mio_data.sus_data.sus_entry,
	     (0));
	cond_info.version = condition_info_version_1;
	call find_condition_info_ (null, addr (cond_info), (0));
	call sct_manager_$call_handler (cond_info.mc_ptr, "sus_", null, null,
	     ("0"b));

	return;

/**/

/* *** Entry: terminate - Internal entry for ws_packet_receiver_  *** */

terminate:
     entry (p_code);


/* ENTRY FUNCTION

Perform the necessary functions to turn off the receiver wakeups.
*/

/* NOTES
*/

	call reset_wakeup (p_code);
	return;

/**/

%page;

/* INTERNAL PROCEDURES */


/* *** Procedure: accept_ack - Internal proc for ws_packet_receiver_  *** */

accept_ack:
     proc (p_channel, p_asn) returns (bit (1));


/* PROCEDURE FUNCTION

Update the flow control with the provided acknowledge sequence number.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_channel	       fixed bin parameter;	    /* Channel ID */
dcl p_asn		       fixed bin parameter;	    /* Ack sequenc number */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl asn_valid	       bit (1);		    /* Sequence number validation */

/* STRUCTURES */

/* INITIALIZATION */

/* MAIN */

/* If the acknowledgement sequence number is invalid, reject the packet. */

	if mio_data.r.asn (p_channel) <= mio_data.s.psn (p_channel) then
	     asn_valid =
		(mio_data.r.asn (p_channel) <= p_asn
		& p_asn <= mio_data.s.psn (p_channel));
	else
	     asn_valid =
		(mio_data.r.asn (p_channel) <= p_asn
		| p_asn <= mio_data.s.psn (p_channel));

	if ^asn_valid then
	     return (False);

/* Save the new acknowledgement sequence number */

	mio_data.r.asn (p_channel) = p_asn;

/* Generate a wakeup to something which may be waiting for a send queue to
   open (which is done when an ack is received) */

	call ws_channel_$wait_wakeup (mio_data_ptr,
	     addr (mio_data.channel_info.packet_transmitter));

/* Indicate packet was valid */

	return (True);

     end accept_ack;

/**/

/* *** Procedure: approve_packet - Internal proc for ws_packet_receiver_  *** */

approve_packet:
     proc (p_packet_ptr, p_packet_len);


/* PROCEDURE FUNCTION

Approve a packet.  If the packet appears to valid, dispatch it to the
appropriate parser for further analysis, otherwise reject it.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_packet_len	       fixed bin (21) parameter;  /* Packet length */
dcl p_packet_ptr	       ptr parameter;	    /* Packet to be approved */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl type		       fixed bin (8);	    /* Type character */
dcl chkidx	       fixed bin;		    /* Index of chkcrc character */
dcl lenidx	       fixed bin;		    /* Index of chklen character */

/* STRUCTURES */
dcl 01 packet	       based (p_packet_ptr),
       02 length	       fixed bin (21) aligned,
       02 data	       char (p_packet_len) unal;

/* INITIALIZATION */


/* MAIN */

/* If packet is too short or too long, reject it. */

	if packet.length < MinPktLen | packet.length > MaxPktLen then do;
	     if mio_data.debug_iocb_ptr ^= null then
		call ws_debug_$packet ("---R:PKT/SIZ-->",
		     addr (packet.data), packet.length,
		     mio_data.debug_iocb_ptr);
	     return;
	end;

/* If check-length is incorrect, reject it */

	lenidx = packet.length - EOPLen - ChkLen - LenLen + 1;
	if ws_tools_$check_length (packet.length + mio_data.r.esc_count)
	     ^= substr (packet.data, lenidx, LenLen)
	then do;
	     if mio_data.debug_iocb_ptr ^= null then
		call ws_debug_$packet ("---R:PKT/LEN-->",
		     addr (packet.data), packet.length,
		     mio_data.debug_iocb_ptr);
	     return;
	end;

/* If CRC is incorrect, reject packet. */

	chkidx = lenidx + ChkLen;
	if check_crc (addr (packet.data), chkidx - 1)
	     ^= substr (packet.data, chkidx, ChkLen)
	then do;
	     if mio_data.debug_iocb_ptr ^= null then
		call ws_debug_$packet ("---R:PKT/CRC-->",
		     addr (packet.data), packet.length,
		     mio_data.debug_iocb_ptr);
	     return;
	end;

/* If packet type is valid, dispatch accordingly; else reject packet. */

	type = rank (substr (packet.data, SOPLen + 1, 1));
	if ^mio_data.rs_pending (1) & ^mio_data.rs_pending (2) then do;
	     if DatOff <= type & type < DatOff + DatCnt then
		call parse_data (p_packet_ptr, p_packet_len);
	     else if AckOff <= type & type < AckOff + AckCnt then
		call parse_ack (p_packet_ptr, p_packet_len);
	     else if NakOff <= type & type < NakOff + NakCnt then
		call parse_nak (p_packet_ptr, p_packet_len);
	     else if BrkOff <= type & type < BrkOff + BrkCnt then
		call parse_break (p_packet_ptr, p_packet_len);
	     else if RstOff <= type & type < RstOff + RstCnt then
		call parse_reset (p_packet_ptr, p_packet_len);
	     else if FastDis = type then
		call remote_disconnect (True);
	     else do;
		call ws_debug_$packet ("---R:TYPE-->",
		     addr (packet.data), packet.length,
		     mio_data.debug_iocb_ptr);
	     end;
	end;
	else if RstOff <= type & type < RstOff + RstCnt then
	     call parse_reset (p_packet_ptr, p_packet_len);

     end approve_packet;

/**/

/* *** Procedure: check_crc - Internal proc for ws_packet_receiver_  *** */

check_crc:
     proc (p_packet_ptr, p_packet_len) returns (char (1));


/* PROCEDURE FUNCTION

Calculate the printable ascii character of the CRC that should have been used
on this packet data
*/

/* NOTES
*/

/* RETURNS

The desired CRC character.
*/

/* INPUT PARAMETERS */
dcl p_packet_ptr	       ptr parameter;	    /* Packet */
dcl p_packet_len	       fixed bin (21) parameter;  /* length of packet */

/* MISC VARIABLES */
dcl string	       (0:p_packet_len - 1) char (1) unal based (p_packet_ptr); /* String overlay */
dcl i		       fixed bin;
dcl crc		       fixed bin;		    /* Accumulated CRC */

/* INITIALIZATION */

/* MAIN */

/* Sum the ranks of the characters in the string. */

	crc = INIT_CRC;
	do i = 0 to p_packet_len - 1;
	     crc = ws_tools_$crc_char (string (i), crc);
	end;

/* Return a printable ASCII character between ' ' and '~'. */

	return (byte (crc + 32));

     end check_crc;

/**/

/* *** Procedure: get_channel - Internal proc for ws_packet_receiver_  *** */

get_channel:
     proc (p_channel_id, p_type, p_handler, p_code);


/* PROCEDURE FUNCTION

Get ahold of a channel of the specified type.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_handler	       variable entry (ptr);	    /* Call handler */
dcl p_type	       fixed bin parameter;	    /* Channel type */

/* OUTPUT PARAMETERS */
dcl p_channel_id	       fixed bin (71) aligned parameter; /* Channel gotten */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */

/* STRUCTURES */
dcl 01 ipc_arg	       like ipc_create_arg_structure aligned automatic;

/* INITIALIZATION */
	p_code = 0;

/* MAIN */

	ipc_arg.version = ipc_create_arg_structure_v1;
	ipc_arg.channel_type = p_type;
	ipc_arg.call_entry = ws_packet_receiver_;
	ipc_arg.call_data_ptr = null;
	ipc_arg.call_priority = 0;
	call ipc_$create_event_channel (addr (ipc_arg), p_channel_id,
	     p_code);

     end get_channel;

/**/

/* *** Procedure: handle_fg_break - Internal proc for ws_packet_receiver_  *** */

handle_fg_break:
     proc ();


/* PROCEDURE FUNCTION

Perform the necessary functions to signal a break on the foreground channel.
*/

/* NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl message	       char (5);		    /* FG_BREAK data */

/* STRUCTURES */

/* INITIALIZATION */
	mio_data.switches.brk_pending = False;
	message = "BRK";

/* MAIN */

/* If quits have been disabled, return */

	if ^mio_data.switches.quit_enable then
	     return;

/* Send a data message to the remote with the FG_BREAK minor cap number */

	call ws_packet_transmitter_$data (mio_data_ptr, FG, addr (message),
	     convert (fixedbin21, MinPktLen), FG_BREAK);

/* Clear user buffer and signal quit */

	mio_data.user_input.out = mio_data.user_input.in;
	call signal_ ("quit", null (), null (), null ());

     end handle_fg_break;

/**/

/* *** Procedure: modem_reader - Internal proc for ws_packet_receiver_  *** */

modem_reader:
     proc ();


/* PROCEDURE FUNCTION

Read data from tty_.
*/

/* NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl line_status_info       bit (72) aligned;
dcl input_buffer	       (1024) char (1);	    /* Input packet */
dcl i		       fixed bin (21);
dcl n_chars_read	       fixed bin (21);
dcl code		       fixed bin (35);

/* STRUCTURES */
dcl 01 read_status_info    like tty_read_status_info aligned automatic;

/* INITIALIZATION */

/* MAIN */

/* See if there really is data */

	code = error_table_$line_status_pending;
	do while (code = error_table_$line_status_pending);
	     call iox_$control (mio_data.iocb_ptr, "read_status",
		addr (read_status_info), code);
	     if code = error_table_$line_status_pending then
		call iox_$control (mio_data.iocb_ptr, "line_status",
		     addr (line_status_info), (0));
	end;
	if code ^= 0 then
	     signal mowse_io_error;

/* NO, then lets forget it */

	if ^read_status_info.input_pending then
	     return;

/* Yes, then process it a character at a time */

	call iox_$get_chars (mio_data.iocb_ptr, addr (input_buffer),
	     hbound (input_buffer, 1), n_chars_read, code);
	if code ^= 0 then
	     signal mowse_io_error;

/* Process each of the characters received */

	do i = 1 to n_chars_read;
	     call receive_char (input_buffer (i));
	end;

     end modem_reader;

/**/

/* *** Procedure: parse_ack - Internal proc for ws_packet_receiver_  *** */

parse_ack:
     proc (p_packet_ptr, p_packet_len);


/* PROCEDURE FUNCTION

Parse an Ack-packet.  If the packet is valid, flow control information is
updated accordingly
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_packet_ptr	       ptr parameter;	    /* Packet */
dcl p_packet_len	       fixed bin (21) parameter;  /* Length of packet */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl channel	       fixed bin;		    /* Channel number */
dcl asn		       fixed bin;		    /* Acknowledge sequence number */
dcl fields	       fixed bin;		    /* Packet type */

/* STRUCTURES */
dcl 01 packet	       based (p_packet_ptr),
       02 length	       fixed bin (21) aligned,
       02 data	       char (p_packet_len) unal;

/* INITIALIZATION */

/* MAIN */

/* If packet length incorrect, reject packet. */

	if p_packet_len ^= MinPktLen then
	     return;

/* Extract the acknowledgement sequence number and the channel number. */

	fields = rank (substr (packet.data, SOPLen + 1, 1)) - AckOff;
	asn = mod (fields, SeqCnt);
	channel = ws_tools_$ars (fields, SeqFld);

/* Accept the ack sequence number */

	if ^accept_ack (channel, asn) then do;
	     if mio_data.debug_iocb_ptr ^= null then
		call ws_debug_$packet ("---R:ACK/PSN-->",
		     addr (packet.data), packet.length,
		     mio_data.debug_iocb_ptr);

	     return;
	end;

	if mio_data.debug_iocb_ptr ^= null then
	     call ws_debug_$packet ("R:ACK---->", addr (packet.data),
		packet.length, mio_data.debug_iocb_ptr);

     end parse_ack;

/**/

/* *** Procedure: parse_break - Internal proc for ws_packet_receiver_  *** */

parse_break:
     proc (p_packet_ptr, p_packet_len);


/* PROCEDURE FUNCTION

Parse a break packet and perform the associated functions.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_packet_ptr	       ptr parameter;	    /* Packet */
dcl p_packet_len	       fixed bin (21) parameter;  /* Packet length */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */

/* STRUCTURES */
dcl 01 packet	       based (p_packet_ptr),
       02 length	       fixed bin (21) aligned,
       02 data	       char (p_packet_len) unal;

/* INITIALIZATION */

/* MAIN */

/* If a foreground break */

	if rank (substr (packet.data, SOPLen + 1, 1)) = FGBrk + Request
	then do;
	     if mio_data.debug_iocb_ptr ^= null then
		call ws_debug_$packet ("R:FGBrk-->",
		     addr (packet.data), packet.length,
		     mio_data.debug_iocb_ptr);

/* - Send the confirmation */

	     call ws_timer_$reset_break ();
	     call ws_packet_transmitter_$supervisory (mio_data_ptr,
		byte (FGBrk + Confirm));

/* - Set the appropriate flags indicating a break is pending */

	     mio_data.br_pending = True;
	     mio_data.brk_pending = True;
	end;

/* Else if receiving FG break confirmation confirmation
     - clear pending flag */

	else if rank (substr (packet.data, SOPLen + 1, 1)) = FGBrk + Confirm
	then do;
	     mio_data.br_pending = False;
	     if mio_data.debug_iocb_ptr ^= null then
		call ws_debug_$packet ("R:FGBrk-C>",
		     addr (packet.data), packet.length,
		     mio_data.debug_iocb_ptr);
	end;

/* Else if receiving Disconnect confirmation */

	else if rank (substr (packet.data, SOPLen + 1, 1)) = DisCon + Confirm
	then do;
	     if mio_data.debug_iocb_ptr ^= null then
		call ws_debug_$packet ("R:DisCn-C>",
		     addr (packet.data), packet.length,
		     mio_data.debug_iocb_ptr);

/* - Set flag */

	     mio_data.ds_pending (1) = False;

/* - If remote initiated, then handle accordingly */

	     if mio_data.ds_pending (2) then
		call remote_disconnect (False);
	end;

/* Else if PC originated disconnect */

	else if rank (substr (packet.data, SOPLen + 1, 1)) = DisCon + Request
	then do;

	     if mio_data.debug_iocb_ptr ^= null then
		call ws_debug_$packet ("R:DisCon-R-->",
		     addr (packet.data), packet.length,
		     mio_data.debug_iocb_ptr);

/* - Set flag and send a confirmation */

	     mio_data.ds_pending (2) = True;
	     call ws_timer_$reset_disconnect ();
	     call ws_packet_transmitter_$supervisory (mio_data_ptr,
		byte (DisCon + Confirm));
	end;

     end parse_break;

/**/

/* *** Procedure: parse_data - Internal proc for ws_packet_receiver_  *** */

parse_data:
     proc (p_packet_ptr, p_packet_len);


/* PROCEDURE FUNCTION

Parse a data packet.  If the packet is valid, the data is stored in the
receive data queue for extraction at an appropriate time.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_packet_ptr	       ptr parameter;	    /* Packet */
dcl p_packet_len	       fixed bin (21) parameter;  /* Length of packet */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl data_len	       fixed bin (21);	    /* Length of data */
dcl psn		       fixed bin;		    /* Packet sequence number */
dcl asn		       fixed bin;		    /* Ack sequence number */
dcl channel	       fixed bin;		    /* Channel ID of packet */
dcl fields	       fixed bin;		    /* Packet type */

/* STRUCTURES */
dcl 01 packet	       based (p_packet_ptr) unal,
       02 length	       fixed bin (21) aligned,
       02 data	       char (p_packet_len) unal;

/* INITIALIZATION */

/* MAIN */

/* Extract the acknowledgement sequence number, packet sequence number and
   channel number from the type char. */

	fields = rank (substr (packet.data, SOPLen + 1, 1)) - DatOff;
	asn = mod (fields, SeqCnt);
	psn = mod (ws_tools_$ars (fields, SeqFld), SeqCnt);
	channel = ws_tools_$ars (fields, SeqFld + SeqFld);

/* Accept the acknowledge sequence number */

	if ^accept_ack (channel, asn) then do;
	     if mio_data.debug_iocb_ptr ^= null then
		call ws_debug_$packet ("---R:DAT/ASN-->",
		     addr (packet.data), packet.length,
		     mio_data.debug_iocb_ptr);

	     return;
	end;

/* If we are disconnecting, then ignore the data */

	if mio_data.ds_pending (1) | mio_data.ds_pending (2) then
	     return;

/* If the send sequence number is not the one we expect, send a Nak-packet,
   (unless one has already been sent) and ignore this packet. */

	if psn ^= mio_data.r.psn (channel) then do;
	     if mio_data.debug_iocb_ptr ^= null then
		call ws_debug_$packet ("---R:DAT/PSN-->",
		     addr (packet.data), packet.length,
		     mio_data.debug_iocb_ptr);

	     if ^mio_data.r.ignoring (channel) then do;
		call ws_packet_transmitter_$nak (channel, mio_data_ptr);
		mio_data.r.ignoring (channel) = True;
	     end;

	     return;
	end;

/* Accept the data. */

	data_len = packet.length - MinPktLen;
	mio_data.r.dat (channel, psn) =
	     substr (packet.data, SOPLen + TypLen + 1, data_len);
	mio_data.r.ignoring (channel) = False;
	mio_data.r.psn (channel) = mod (psn + 1, SeqCnt);
	if mio_data.debug_iocb_ptr ^= null then
	     call ws_debug_$packet ("R:DAT---->", addr (packet.data),
		packet.length, mio_data.debug_iocb_ptr);

     end parse_data;

/**/

/* *** Procedure: parse_nak - Internal proc for ws_packet_receiver_  *** */

parse_nak:
     proc (p_packet_ptr, p_packet_len);


/* PROCEDURE FUNCTION

Parse a Nak-packet.  If the packet is valid, any data packets that have been
sent but have not been acknowledged by this Nak are resent.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_packet_ptr	       ptr parameter;	    /* Packet */
dcl p_packet_len	       fixed bin (21) parameter;  /* Packet_length */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl channel	       fixed bin;		    /* Channel ID */
dcl asn		       fixed bin;		    /* Acknowledge sequence number */
dcl fields	       fixed bin;		    /* Packet type */

/* STRUCTURES */
dcl 01 packet	       based (p_packet_ptr),
       02 length	       fixed bin (21) aligned,
       02 data	       char (p_packet_len) unal;

/* INITIALIZATION */

/* MAIN */

/* If packet length is incorrect, reject the packet. */

	if packet.length ^= MinPktLen then
	     return;

/* Extract field information (sequence number, channel number, etc.) */

	fields = rank (substr (packet.data, SOPLen + 1, 1)) - NakOff;
	asn = mod (fields, SeqCnt);
	channel = ws_tools_$ars (fields, SeqFld);

/* Accept the acked sequence number in the nak packet */

	if ^accept_ack (channel, asn) then do;
	     if mio_data.debug_iocb_ptr ^= null then
		call ws_debug_$packet ("---R:NAK/PSN-->",
		     addr (packet.data), packet.length,
		     mio_data.debug_iocb_ptr);
	     return;
	end;

	if mio_data.debug_iocb_ptr ^= null then
	     call ws_debug_$packet ("R:NAK---->", addr (packet.data),
		packet.length, mio_data.debug_iocb_ptr);

/* Resend any data in the send data queue. */

	call ws_packet_transmitter_$resend (mio_data_ptr, channel);

     end parse_nak;

/**/

/* *** Procedure: parse_reset - Internal proc for ws_packet_receiver_  *** */

parse_reset:
     proc (p_packet_ptr, p_packet_len);


/* PROCEDURE FUNCTION

Parse a reset packet and handle accordingly.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_packet_ptr	       ptr parameter;	    /* Packet */
dcl p_packet_len	       fixed bin (21) parameter;  /* Packet length */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */

/* STRUCTURES */
dcl 01 packet	       based (p_packet_ptr),
       02 length	       fixed bin (21) aligned,
       02 data	       char (p_packet_len) unal;

/* INITIALIZATION */

/* MAIN */

/* If in process of disconnecting, then ignore reset */

	if mio_data.ds_pending (1) | mio_data.ds_pending (2) then
	     return;

/* If PC requested reset: reset and send confirmation */

	if rank (substr (packet.data, SOPLen + 1, 1)) = RstOff + Request
	then do;
	     if mio_data.debug_iocb_ptr ^= null then
		call ws_debug_$packet ("R:RST-R-->", addr (packet.data),
		     packet.length, mio_data.debug_iocb_ptr);

	     mio_data.rs_pending (2) = True;
	     call ws_tools_$reset_data (mio_data_ptr);
	     mio_data.r.pktin = 1;
	     call ws_packet_transmitter_$supervisory (mio_data_ptr,
		byte (RstOff + Confirm));
	end;

/* Else if Confirmation */

	else if rank (substr (packet.data, SOPLen + 1, 1)) = RstOff + Confirm
	then do;
	     if mio_data.debug_iocb_ptr ^= null then
		call ws_debug_$packet ("R:RST-C-->", addr (packet.data),
		     packet.length, mio_data.debug_iocb_ptr);

/* - Send the confirmation */

	     if mio_data.rs_pending (1) then
		call ws_packet_transmitter_$supervisory (mio_data_ptr,
		     byte (RstOff + Confirm));
	     mio_data.rs_pending (*) = False;
	end;

     end parse_reset;

/**/

/* *** Procedure: prime_tty - Internal proc for ws_packet_receiver_  *** */

prime_tty:
     proc () returns (bit (1));


/* PROCEDURE FUNCTION

Perform a read status control order to tty_ in order to pprime it for the
next event.
*/

/* NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */

/* STRUCTURES */
dcl 01 read_status_info    like tty_read_status_info aligned automatic;

/* INITIALIZATION */

/* MAIN */

	call iox_$control (mio_data.iocb_ptr, "read_status",
	     addr (read_status_info), (0));
	return (read_status_info.input_pending);

     end prime_tty;

/**/

/* *** Procedure: receive_char - Internal proc for ws_packet_receiver_  *** */

receive_char:
     proc (p_chr);


/* PROCEDURE FUNCTION

To receive the next character detected by the interrupt handler for input from
the remote.  If the character is valid, it is added to the packet currently
being assembled.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_chr		       char (1) parameter;	    /* character received */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl nextin	       fixed bin;		    /* Next packet in */
dcl test_ds	       (2) bit (1);		    /* Testing disconnect status */
dcl packet	       char (MaxDatLen) var based (packet_ptr); /* Packet to be built */
dcl packet_ptr	       ptr;		    /* Building packet pointer */

/* STRUCTURES */

/* INITIALIZATION */

/* MAIN */

/* Assemble the packet in the next slot of the receive packet queue. */

	packet_ptr = addr (mio_data.r.pkt (mio_data.r.pktin));

/* If the received char is the SOP char, start a new packet. */

	if p_chr = mio_data.r.sop then do;
	     mio_data.r.esckey = "000"b3;
	     packet = p_chr;
	end;

/* Else if we are not assembling a packet, discard the received char. */

	else if length (packet) = 0 then
	     return;

/* Else if the received char is the EOP char, append it to the packet.  If
   there is room in the received packet queue, make the packet visible (by
   updating the "in" pointer); otherwise flush the packet. */

	else if p_chr = mio_data.r.eop then do;
	     packet = packet || p_chr;

	     if mio_data.r.pktin < RQS then
		nextin = mio_data.r.pktin + 1;
	     else
		nextin = 0;

	     if nextin ^= mio_data.r.pktout then do;
		mio_data.r.pktin = nextin;
		mio_data.r.pkt (nextin) = "";
	     end;
	     else
		packet = "";
	end;

/* Else append the character (or what it stands for if it was preceded
   by an escape character) to the buffer, unless it is an escape
   character.  If this fills the packet (in which case there will be
   no room for the EOP character), flush the packet. */

	else do;
	     if mio_data.r.esckey ^= "000"b3 then do;
		unspec (p_chr) =
		     bool (unspec (p_chr), mio_data.r.esckey, XOR);
		mio_data.r.esckey = "000"b3;
	     end;
	     else if p_chr = mio_data.r.esc (0) then do;
		mio_data.r.esc_count = mio_data.r.esc_count + 1;
		mio_data.r.esckey = "100"b3;
	     end;
	     else if p_chr = mio_data.r.esc (1) then do;
		mio_data.r.esc_count = mio_data.r.esc_count + 1;
		mio_data.r.esckey = "200"b3;
	     end;
	     else if p_chr = mio_data.r.esc (2) then do;
		mio_data.r.esc_count = mio_data.r.esc_count + 1;
		mio_data.r.esckey = "300"b3;
	     end;

	     if mio_data.r.esckey = "000"b3 then do;
		if length (packet) < MaxPktLen then
		     packet = packet || p_chr;
		else
		     packet = "";
	     end;
	end;

/* Approve completed packets and handle accordingly */

	do while (mio_data.r.pktin ^= mio_data.r.pktout);
	     test_ds = mio_data.ds_pending;
	     call approve_packet (addr (mio_data.r.pkt (mio_data.r.pktout)),
		length (mio_data.r.pkt (mio_data.r.pktout)));
	     mio_data.r.esc_count = 0;
	     if mio_data.r.pktout < RQS then
		mio_data.r.pktout = mio_data.r.pktout + 1;
	     else
		mio_data.r.pktout = 0;
	     if test_ds (2) then
		call remote_disconnect (False);
	end;

     end receive_char;

/**/

/* *** Procedure: receive_fg - Internal proc for ws_packet_receiver_  *** */

receive_fg:
     proc ();


/* PROCEDURE FUNCTION

Extract all Foreground data from the protocol queues and insert into
the user_input queues for extraction through iox_$get_(line chars).
*/

/* NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl fixedbin21	       fixed bin (21) based;
dcl data		       (MaxDatLen) char (1);	    /* Message buffer */
dcl i		       fixed bin (21);
dcl data_len	       fixed bin (21);	    /* Message length */

/* STRUCTURES */

/* INITIALIZATION */

/* MAIN */

/* Initiate the processing FG loop, if no data then return */

	data_len
	     = ws_tools_$getdat (mio_data_ptr, FG, addr (data),
	     convert (fixedbin21, MaxDatLen));

/* Process pending foreground channel packets */

	do while (data_len > 0);
	     do i = 2 to data_len;
		mio_data.user_input.queue (mio_data.user_input.in)
		     = data (i);

		if mio_data.user_input.in
		     < hbound (mio_data.user_input.queue, 1)
		     then
		     mio_data.user_input.in = mio_data.user_input.in + 1;
		else
		     mio_data.user_input.in = 0;  /* hcom 2. */
	     end;

	     data_len
		= ws_tools_$getdat (mio_data_ptr, FG, addr (data),
		convert (fixedbin21, MaxDatLen));
	end;

/* Wakeup blocked procedure on user_input */

	call ws_channel_$wait_wakeup (mio_data_ptr,
	     addr (mio_data.channel_info.user_input));

/* MF - phx21215 - Send a signal on the foreground event channel that data
 * has arrived
 */
	call hcs_$wakeup (mio_data.channel_info.process_id,
	     mio_data.channel_info.foreground.channel, 0, (0));

     end receive_fg;

/**/

/* *** Procedure: remote_disconnect - Internal proc for ws_packet_receiver_  *** */

remote_disconnect:
     proc (p_fast);


/* PROCEDURE FUNCTION

This is a null routine which will be used to implement mowse_io_ detachment
at the request of the PC.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_fast	       bit (1) parameter;	    /* Fast (non-confirmed) request */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */

/* STRUCTURES */

/* INITIALIZATION */

/* MAIN */

	mio_data.ds_pending (*) = False;

     end remote_disconnect;

/**/

/* *** Procedure: reset_wakeup - Internal proc for ws_packet_receiver_  *** */

reset_wakeup:
     proc (p_code);


/* PROCEDURE FUNCTION

Reset the wakeup mechanism for the packet_receiver.
*/

/* NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */
dcl input_pending	       bit (1);		    /* Data arrived */
dcl tty_channel	       fixed bin (71) aligned;    /* tty_channel to install */
dcl mask		       bit (36) aligned;

/* STRUCTURES */
dcl 01 wake_info	       like swt_info aligned automatic;

/* INITIALIZATION */
	p_code = 0;

/* If we came in from a sus_ signal, then get the heck out */

	if mio_data.sus_data.activated then
	     return;

/* Have we really initialized ? */

	if mio_data.channel_info.packet_receiver.channel = 0 then
	     return;

/* Mask the world according to Multics */

	call hcs_$set_ips_mask (""b, mask);
	call ipc_$mask_ev_calls (p_code);
	if p_code ^= 0 then
	     goto EXIT_RESET_WAKEUP;

/* MAIN */

/* Turn wakeups off */

	call iox_$modes (mio_data.iocb_ptr, "^wake_tbl", "", p_code);
	if p_code ^= 0 then
	     goto EXIT_RESET_WAKEUP;

	wake_info.version = swt_info_version_1;
	wake_info.new_table = mio_data.channel_info.wake_info;
	call iox_$control (mio_data.iocb_ptr, "set_wakeup_table",
	     addr (wake_info), p_code);
	if p_code ^= 0 then
	     goto EXIT_RESET_WAKEUP_MODES;

/* Restore the tty event channel with a fast channel.  If can't get a
   fast channel, then try for a wait channel */

	call get_channel (tty_channel, FAST_EVENT_CHANNEL_TYPE,
	     null_entry_, p_code);
	if p_code ^= 0 then
	     call get_channel (tty_channel, WAIT_EVENT_CHANNEL_TYPE,
		null_entry_, p_code);

	call iox_$control (mio_data.iocb_ptr, "set_event_channel",
	     addr (tty_channel), p_code);
	if p_code ^= 0 then
	     goto EXIT_RESET_WAKEUP_RESTORE;

/* Delete the old channel */

	call ipc_$delete_ev_chn (
	     mio_data.channel_info.packet_receiver.channel, (0));
	mio_data.channel_info.packet_receiver.channel = 0;
	goto EXIT_RESET_WAKEUP;

EXIT_RESET_WAKEUP_RESTORE:

	wake_info.new_table.wake_map (*) = "0"b;
	wake_info.new_table.wake_map (rank (mio_data.r.eop)) = "1"b;
	call iox_$control (mio_data.iocb_ptr, "set_wakeup_table",
	     addr (wake_info), (0));

EXIT_RESET_WAKEUP_MODES:

	call iox_$modes (mio_data.iocb_ptr, "wake_tbl", "", p_code);

EXIT_RESET_WAKEUP:

	call ipc_$unmask_ev_calls ((0));
	call hcs_$reset_ips_mask (mask, mask);

/* tty_ needs to be primed due to the event channel change */

	input_pending = prime_tty ();

     end reset_wakeup;

/**/

/* *** Procedure: scheduler - Internal proc for ws_packet_receiver_  *** */

scheduler:
     proc ();


/* PROCEDURE FUNCTION

Process any received data.
*/

/* NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */

/* STRUCTURES */

/* INITIALIZATION */

/* MAIN */

/* Check for input from the PC on the foreground channel */

	if ^mio_data.task.active (FG_task) then do;
	     on cleanup mio_data.task.active (FG_task) = Idle;
	     mio_data.task.active (FG_task) = ^Idle;
	     call receive_fg ();
	     mio_data.task.active (FG_task) = Idle;
	     revert cleanup;
	end;

/* Check for input on the background channel, local or remote */

	if ^mio_data.task.active (BG_task) then do;
	     if mio_data.l_dat (BG).out_ptr ^= null
		| mio_data.r.psn (BG) ^= mio_data.s.nasn (BG)
		then
		call ws_channel_$call_wakeup (mio_data_ptr,
		     mio_data.channel_info.packet_dispatcher.async_channel);
	end;

/* Process any break requests */

	if ^mio_data.task.active (BG_task) & mio_data.switches.brk_pending then do;
	     call handle_fg_break ();
	end;

     end scheduler;

/**/

/* *** Procedure: setup_wakeup - Internal proc for ws_packet_receiver_  *** */

setup_wakeup:
     proc (p_code);


/* PROCEDURE FUNCTION

Set up the appropriate functions to have the packet_receiver_ awaken properly.
*/

/* NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */
dcl input_pending	       bit (1);		    /* Data arrived from PC */
dcl tty_channel	       fixed bin (71) aligned;    /* Old tty channel */
dcl mask		       bit (36) aligned;	    /* IPS mask */

/* STRUCTURES */
dcl 01 wake_info	       like swt_info aligned automatic;

/* INITIALIZATION */
	p_code = 0;
	call hcs_$set_ips_mask (""b, mask);
	call ipc_$mask_ev_calls (p_code);
	if p_code ^= 0 then
	     goto EXIT_SETUP_WAKEUP;

	mio_data.channel_info.packet_receiver.channel = 0;
	call iox_$control (mio_data.iocb_ptr, "get_event_channel",
	     addr (tty_channel), (0));

/* MAIN */

/* Create an event call channel and attach it so that we get the wakeups
   on the call channel */

	call get_channel (mio_data.channel_info.packet_receiver.channel,
	     ASYNC_CALL_EVENT_CHANNEL_TYPE, ws_packet_receiver_, p_code);
	if p_code ^= 0 then
	     goto EXIT_SETUP_WAKEUP;

	call iox_$control (mio_data.iocb_ptr, "set_event_channel",
	     addr (mio_data.channel_info.packet_receiver.channel), p_code);
	if p_code ^= 0 then
	     goto EXIT_SETUP_WAKEUP_DELETE;

/* Delete the old tty_channel as it is no longer valid */

	call ipc_$delete_ev_chn (tty_channel, (0));

/* Set the wakeup table to be the EOP character */

	call iox_$modes (mio_data.iocb_ptr, "^wake_tbl", "", p_code);
	if p_code ^= 0 then
	     goto EXIT_SETUP_WAKEUP_RESTORE;

	wake_info.version = swt_info_version_1;
	wake_info.new_table.wake_map (*) = "0"b;
	wake_info.new_table.wake_map (rank (mio_data.r.eop)) = "1"b;
	wake_info.new_table.mbz = ""b;
	call iox_$control (mio_data.iocb_ptr, "set_wakeup_table",
	     addr (wake_info), p_code);
	mio_data.channel_info.wake_info = wake_info.old_table;
	if p_code ^= 0 then
	     goto EXIT_SETUP_WAKEUP_RESTORE;

	call iox_$modes (mio_data.iocb_ptr, "wake_tbl", "", p_code);
	call iox_$modes (mio_data.default_iocb_ptr, "wake_tbl", "", (0));
	if p_code = 0 then
	     goto EXIT_SETUP_WAKEUP;

EXIT_SETUP_WAKEUP_MODES:

	call iox_$modes (mio_data.iocb_ptr, "^wake_tbl", "", (0));
	call iox_$modes (mio_data.default_iocb_ptr, "^wake_tbl", "", (0));

EXIT_SETUP_WAKEUP_RESTORE:

	call get_channel (tty_channel, FAST_EVENT_CHANNEL_TYPE,
	     null_entry_, (0));
	call iox_$control (mio_data.iocb_ptr, "set_event_channel",
	     addr (tty_channel), (0));

EXIT_SETUP_WAKEUP_DELETE:

	call ipc_$delete_ev_chn (
	     mio_data.channel_info.packet_receiver.channel, (0));
	mio_data.channel_info.packet_receiver.channel = 0;

EXIT_SETUP_WAKEUP:

/* Turn events back on */

	call ipc_$unmask_ev_calls ((0));
	call hcs_$reset_ips_mask (mask, mask);

/* tty_ needs to be primed due to the event channel change */

	input_pending = prime_tty ();

     end setup_wakeup;

/**/

%page;

/* INCLUDE FILES */
%include mowse;
%include mowse_messages;
%include mowse_info;
%include ipc_create_arg;
%include set_wakeup_table_info;
%include static_handlers;
%include condition_info;
%include mowse_io_data;
%include mowse_io_constants;
%include tty_read_status_info;

     end;




		    ws_packet_transmitter_.pl1      01/24/89  0854.8rew 01/24/89  0847.1      214686



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

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
ws_packet_transmitter_:
     proc ();


/* PROGRAM FUNCTION

This procedure is responsible for the transmission of data to the PC.  Such
data consists of all BG and FG data packets and supervisory packets.

There are a number of means of entry into this procedure: one is through direct
procedure calls from a timeout handler, the packet receiver (for supervisory
packet transmission) and the I/O interface; also this procedure may be
required to block due to a data transmission window being full, in this case
then it awaits a wakeup on the event wait channel from the packet receiver
when the window has opened up.
*/


/* NOTES
*/

/****^  HISTORY COMMENTS:
  1) change(87-04-16,Flegel), approve(87-06-23,MCR7649),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(88-11-08,Flegel), approve(88-11-16,MCR8023), audit(88-12-12,Lee),
     install(89-01-24,MR12.3-1012):
     phx21215 - Added support for a foreground event channel upon which
                events are transmitted when foreground data has finished
                transmission.
                                                   END HISTORY COMMENTS */

/* INPUT PARAMETERS */
dcl p_type	       char (1) parameter;	    /* Packet type field */
dcl p_open_struc_ptr       ptr parameter;	    /* User specified control settings */
dcl p_mio_data_ptr	       ptr parameter;	    /* mowse_io_data */
dcl p_minor	       fixed bin parameter;	    /* Minor capability number */
dcl p_channel	       fixed bin parameter;	    /* Channel type */
dcl p_data_ptr	       ptr parameter;	    /* Data buffer pointer */
dcl p_data_len	       fixed bin (21) parameter;  /* Data length */

/* OUTPUT PARAMETERS */
dcl p_code	       fixed bin (35) parameter;

/* MISC VARIABLES */
dcl psn		       fixed bin;		    /* Packet sequence number */
dcl type		       char (1);		    /* Packet type */
dcl i		       fixed bin (21);
dcl mio_data_ptr	       ptr;		    /* mowse_io_ data */

/* STRUCTURES */
dcl 01 mio_data	       like mowse_io_data based (mio_data_ptr);

/* SYSTEM CALLS */
dcl hcs_$wakeup	       entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
dcl ipc_$unmask_ev_calls   entry (fixed bin (35));
dcl ipc_$mask_ev_calls     entry (fixed bin (35));
dcl ipc_$delete_ev_chn     entry (fixed bin (71), fixed bin (35));
dcl get_system_free_area_  entry () returns (ptr);
dcl ipc_$create_ev_chn     entry (fixed bin (71), fixed bin (35));
dcl hcs_$reset_ips_mask    entry (bit (36) aligned, bit (36) aligned);
dcl iox_$put_chars	       entry (ptr, ptr, fixed bin (21), fixed bin (35));
dcl hcs_$set_ips_mask      entry (bit (36) aligned, bit (36) aligned);

/* SYSTEM CALL SUPPORT */

/* EXTERNAL CALLS */
dcl ws_debug_$line	       entry () options (variable);
dcl ws_channel_$call_wakeup entry (ptr, fixed bin (71));
dcl ws_timer_$reset_reset  entry options (variable);
dcl ws_timer_$reset_sender entry (fixed bin);
dcl ws_channel_$wait_block entry (ptr, ptr, char (*), ptr);
dcl ws_tools_$reset_data   entry (ptr);
dcl ws_tools_$ars	       entry (fixed bin, fixed bin) returns (fixed bin);
dcl ws_tools_$check_length entry (fixed bin (21)) returns (char (1));
dcl ws_tools_$crc_char     entry (char (1), fixed bin) returns (fixed bin);
dcl ws_debug_$packet       entry (char (*), ptr, fixed bin (21), ptr);
dcl ws_channel_$wait_wakeup entry (ptr, ptr);

/* EXTERNAL CALL SUPPORT */

/* BUILTINS */
dcl translate	       builtin;
dcl substr	       builtin;
dcl addr		       builtin;
dcl bool		       builtin;
dcl null		       builtin;
dcl unspec	       builtin;
dcl length	       builtin;
dcl rank		       builtin;
dcl mod		       builtin;
dcl byte		       builtin;

/* CONDITIONS */
dcl mowse_io_error	       condition;

/* CONSTANTS */
dcl EscKey	       (0:2) bit (9) int static options (constant) init ("100"b3, "200"b3, "300"b3);
dcl GrpEscIdx	       (0:7) fixed bin int static options (constant) init (0, -1, -1, 0, 2, 1, 1, 2);
dcl False		       bit (1) int static options (constant) init ("0"b);
dcl True		       bit (1) int static options (constant) init ("1"b);
dcl Null_Convert	       fixed bin (8) int static options (constant) init (20);

/**/

/* INITIALIZATION */

/* MAIN */

	return;

/**/

%page;

/* INTERNAL ENTRIES */


/* *** Entry: ack - Internal entry for ws_packet_transmitter_  *** */

ack:
     entry (p_channel, p_mio_data_ptr);


/* ENTRY FUNCTION

Send an ack-packet to the remote.
*/

/* NOTES
*/

	call setup_entry ();

	type = byte ((p_channel * SeqCnt) + mio_data.s.nasn (p_channel)
	     + AckOff);
	call send_packet (type, "");
	mio_data.s.lasn (p_channel) = mio_data.s.nasn (p_channel);

	return;

/**/

/* *** Entry: data - Internal entry for ws_packet_transmitter_  *** */

data:
     entry (p_mio_data_ptr, p_channel, p_data_ptr, p_data_len, p_minor);


/* ENTRY FUNCTION

Transmit a data packet to the remote (PC).  This includes inserting control
and maintaining transmit packet Queues.
*/

/* NOTES
*/

	call setup_entry ();

	call send_data (p_channel, p_data_ptr, p_data_len, p_minor);

/* MF - phx21215 - Send an event on the foreground channel to signal
 * completion
 */
	if p_channel = FG then do;
	     call hcs_$wakeup (mio_data.channel_info.process_id,
		mio_data.channel_info.foreground.channel, 0, (0));
	end;

	return;

/**/

/* *** Entry: initialize - Internal entry for ws_packet_transmitter_  *** */

initialize:
     entry (p_mio_data_ptr, p_open_struc_ptr, p_code);


/* ENTRY FUNCTION

Initialize all pertinent data in the mowse_io_data which is used by the
packet transmitter.
*/

/* NOTES
*/

	call setup_entry ();

	open_struc_ptr = p_open_struc_ptr;

/* Create a wait channel for blocking */

	mio_data.channel_info.packet_transmitter.channel = 0;
	mio_data.channel_info.packet_transmitter.count = 0;
	mio_data.channel_info.packet_transmitter.flags.transmitted = False;
	call ipc_$create_ev_chn (
	     mio_data.channel_info.packet_transmitter.channel, p_code);
	if p_code ^= 0 then
	     return;

/* Initialize transmitter control variables */

	mio_data.r.asn (*) = 0;

	if open_struc_ptr ^= null then
	     if open_struc.flags.network_sw then
		mio_data.s.eop = CR;
	     else
		mio_data.s.eop = LF;

	mio_data.s.sop = SOH;
	mio_data.s.esc (0) = ESC;
	mio_data.s.esc (1) = SI;
	mio_data.s.esc (2) = SO;
	mio_data.s.psn (*) = 0;
	mio_data.s.lasn (*) = 0;
	mio_data.s.nasn (*) = 0;
	mio_data.s.dat (*, *) = "";

	mio_data.s.escreq (*) = False;
	mio_data.s.escreq (Null_Convert) = True;
	mio_data.s.escreq (rank (SOH)) = True;
	mio_data.s.escreq (rank (ESC)) = True;
	mio_data.s.escreq (rank (SI)) = True;
	mio_data.s.escreq (rank (SO)) = True;
	mio_data.s.escreq (rank (mio_data.s.eop)) = True;
	do i = 128 to 255;
	     mio_data.s.escreq (i) = True;
	end;
	if open_struc_ptr ^= null then
	     if open_struc.flags.escape_sw then
		mio_data.s.escreq
		     = bool (mio_data.s.escreq, open_struc.escape.switches,
		     OR);

	return;

/**/

/* *** Entry: local_data - Internal entry for ws_packet_transmitter_  *** */

local_data:
     entry (p_mio_data_ptr, p_channel, p_data_ptr, p_data_len, p_minor);


/* ENTRY FUNCTION

To queue data to send to the local system.
*/

/* NOTES

Messages are stored in packet_size chunks as a linked list of pending packets.
*/

	call setup_entry ();

	call send_local_data (p_channel, p_data_ptr, p_data_len, p_minor);

	return;

/**/

/* *** Entry: nak - Internal entry for ws_packet_transmitter_  *** */

nak:
     entry (p_channel, p_mio_data_ptr);


/* ENTRY FUNCTION

Send a Nak-packet to the remote.
*/

/* NOTES
*/

	call setup_entry ();

	type = byte ((p_channel * SeqCnt) + mio_data.s.nasn (p_channel)
	     + NakOff);
	call send_packet (type, "");

	return;

/**/

/* *** Entry: resend - Internal entry for ws_packet_transmitter_  *** */

resend:
     entry (p_mio_data_ptr, p_channel);


/* ENTRY FUNCTION

Resend all unacknowledged packets on the specified channel.
*/

/* NOTES
*/

	call setup_entry ();

/* For each of the packet numbers on the specified channel */

	do psn = mio_data.r.asn (p_channel) repeat mod (psn + 1, SeqCnt)
	     while (psn ^= mio_data.s.psn (p_channel));

/* - Determine the type of the packet to be resent */

	     if mio_data.debug_iocb_ptr ^= null then
		call ws_debug_$line (mio_data.debug_iocb_ptr, "resend");

	     type = byte ((((p_channel * SeqCnt) + psn) * SeqCnt)
		+ mio_data.s.nasn (p_channel) + DatOff);

/* - Send the packet again */

	     call send_packet (type, mio_data.s.dat (p_channel, psn));
	     mio_data.s.lasn (p_channel) = mio_data.s.nasn (p_channel);
	     call ws_timer_$reset_sender (p_channel);
	end;

	return;

/**/

/* *** Entry: reset - Internal entry for ws_packet_transmitter_  *** */

reset:
     entry (p_mio_data_ptr);


/* ENTRY FUNCTION

Send a reset packet.
*/

/* NOTES

Reset will reset both foreground and background channels and block the sending
and receiving of data (except the reset confirm) until confirmation has been
received from the PC.
*/

	mio_data_ptr = p_mio_data_ptr;

/* If currently resetting, ignore */

	if mio_data.rs_pending (1) | mio_data.rs_pending (2) then
	     return;

/* Send the reset request packet */

	mio_data.rs_pending (1) = True;
	call ws_tools_$reset_data (mio_data_ptr);
	call send_packet (byte (RstOff + Request), "");
	call ws_timer_$reset_reset ();
	return;

/**/

/* *** Entry: supervisory - Internal entry for ws_packet_transmitter_  *** */

supervisory:
     entry (p_mio_data_ptr, p_type);


/* ENTRY FUNCTION

Given a packet type, send the packet to the remote.  The packet contains NO
data and the type field is assumed to be valid for the complete packet.
*/

/* NOTES
*/

	call setup_entry ();

	call send_packet (p_type, "");

	return;

/**/

/* *** Entry: terminate - Internal entry for ws_packet_transmitter_  *** */

terminate:
     entry (p_mio_data_ptr);


/* ENTRY FUNCTION

Terminate all necessary items to the transmitter.
*/

/* NOTES
*/

	call setup_entry ();

	if mio_data.channel_info.packet_transmitter.channel ^= 0 then do;
	     call ipc_$delete_ev_chn (
		mio_data.channel_info.packet_transmitter.channel, (0));
	     mio_data.channel_info.packet_transmitter.count = 0;
	end;

	return;

/**/

%page;

/* INTERNAL PROCEDURES */


/* *** Procedure: send_data - Internal proc for ws_packet_transmitter_  *** */

send_data:
     proc (p_channel, p_data_ptr, p_data_len, p_minor);


/* PROCEDURE FUNCTION

To queue and send data to the remote.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_channel	       fixed bin parameter;	    /* FG or BG channel */
dcl p_data_ptr	       ptr parameter;	    /* Data */
dcl p_data_len	       fixed bin (21) parameter;  /* Data length */
dcl p_minor	       fixed bin parameter;	    /* Minor capability of data */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl type		       char (1);		    /* Packet type */
dcl send_data_ptr	       ptr;		    /* Ptr to data packet */
dcl send_psn	       fixed bin;		    /* Temporary send packet SN */
dcl new_length	       fixed bin (21);	    /* New length of data */
dcl i		       fixed bin (21);
dcl reset_write_flag       bit (1);		    /* resetwrite state on entry */
dcl minor		       fixed bin;		    /* Local copy of minor */

/* STRUCTURES */
dcl data		       char (p_data_len) based (p_data_ptr);
dcl out_data	       char (MaxDatLen) var based (send_data_ptr); /* Data to transmit */

/* INITIALIZATION */
	minor = p_minor;
	reset_write_flag = mio_data.switches.reset_write;

/* MAIN */

/* Return if we are disconnecting */

	if mio_data.switches.disconnect_active then
	     return;

/* Wait while a reset is going on */

	do while (mio_data.switches.rs_pending (1)
	     | mio_data.switches.rs_pending (2));

	     call ws_channel_$wait_block (mio_data_ptr,
		addr (mio_data.channel_info.packet_transmitter),
		"packet_transmitter (send_data-1)",
		mio_data.debug_iocb_ptr);
	end;

/* Build and send packets until all data is sent. */

	i = 0;
	do while (i < p_data_len);

/* Resetwrite is tested, however, we can do nothing about it for now.  This
   section is left in case future development requires something to be done
   with resetwrite */

	     if mio_data.switches.reset_write & ^reset_write_flag
		& (p_channel = FG)
	     then do;
		mio_data.reset_write = False;
	     end;

/* If a break has started, then quit sending the current stream and return */

	     if mio_data.brk_pending & p_channel = FG
		& p_minor = FG_TERMINAL_DATA
		then
		return;

/* Determine amount of data to be sent in the next packet; it is the
   smaller of what is left and MaxDatLen. */

	     new_length = p_data_len - i;
	     if new_length > MaxDatLen then
		new_length = MaxDatLen - 1;

/* If the send data queue is full we must wait until it opens before
   making our new data visible by updating the packet sequence number.
   - Block until something is read from tty_ */

	     do while (
		mod (mio_data.s.psn (p_channel) - mio_data.r.asn (p_channel),
		SeqCnt) >= SWS);

		call ws_channel_$wait_block (mio_data_ptr,
		     addr (mio_data.channel_info.packet_transmitter),
		     "packet_transmitter (send_data-2)",
		     mio_data.debug_iocb_ptr);
	     end;

/* Save the data in the next slot of the send data queue. */

	     call ipc_$mask_ev_calls ((0));

	     send_psn = mio_data.s.psn (p_channel);
	     mio_data.s.psn (p_channel) = mod (send_psn + 1, SeqCnt);

	     send_data_ptr = addr (mio_data.s.dat (p_channel, send_psn));
	     if minor = FG_CONTROL_MESSAGE | minor = FG_TERMINAL_DATA
		| minor = FG_BREAK
		then
		out_data
		     = byte (minor) || substr (data, i + 1, new_length);
	     else
		out_data = substr (data, i + 1, new_length);

	     i = i + new_length;

/* Send the data and reset the resend timer. */

	     type = byte ((((p_channel * SeqCnt) + send_psn) * SeqCnt) +
		mio_data.s.nasn (p_channel) + DatOff);
	     call send_packet (type, out_data);
	     mio_data.s.lasn (p_channel) = mio_data.s.nasn (p_channel);

	     call ipc_$unmask_ev_calls ((0));

	     call ws_timer_$reset_sender (p_channel);
	end;

/* Open up the blocking channel in case anything is awaiting */

	call ws_channel_$wait_wakeup (mio_data_ptr,
	     addr (mio_data.channel_info.packet_transmitter));

     end send_data;

/**/

/* *** Procedure: send_local_data - Internal proc for ws_packet_transmitter_  *** */

send_local_data:
     proc (p_channel, p_data_ptr, p_data_len, p_minor);


/* PROCEDURE FUNCTION

To queue data to send between local applications.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_channel	       fixed bin parameter;	    /*  Channel ID */
dcl p_data_ptr	       ptr parameter;	    /* Data */
dcl p_data_len	       fixed bin (21) parameter;  /* Length of data */
dcl p_minor	       fixed bin parameter;	    /* Minor capability number */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl data_ptr	       ptr;
dcl p_data	       char (p_data_len) based (p_data_ptr);
dcl data		       char (p_data_len) based (data_ptr); /* Data descriptor */
dcl node_ptr	       ptr;
dcl system_free_area_ptr   ptr;
dcl system_free_area       area based (system_free_area_ptr);

/* STRUCTURES */

/* INITIALIZATION */
	system_free_area_ptr = get_system_free_area_ ();

/* MAIN */

/* No data, return */

	if p_data_ptr = null | p_data_len <= 0 then
	     return;

/* Allocate a node for message */

	allocate local_data_node in (system_free_area) set (node_ptr);
	node_ptr -> local_data_node.next = null;

/* Allocate space for data */

	allocate data in (system_free_area) set (data_ptr);
	data = p_data;
	node_ptr -> local_data_node.data_ptr = data_ptr;
	node_ptr -> local_data_node.data_len = p_data_len;

/* Debugging info */

	if mio_data.debug_iocb_ptr ^= null then
	     call ws_debug_$packet ("S:L:DAT-->",
		node_ptr -> local_data_node.data_ptr, p_data_len,
		mio_data.debug_iocb_ptr);

/* Message queue currently empty? put at in_ptr position */

	if mio_data.l_dat (p_channel).in_ptr = null then do;
	     mio_data.l_dat (p_channel).in_ptr = node_ptr;
	     mio_data.l_dat (p_channel).out_ptr = node_ptr;
	end;

/* Insert somewhere else in queue */

	else do;
	     mio_data.l_dat (p_channel).in_ptr -> local_data_node.next
		= node_ptr;
	     mio_data.l_dat (p_channel).in_ptr = node_ptr;
	end;

/* Process the message if there is NO background processing going on */

	if ^mio_data.task.active (BG_task)
	     & mio_data.l_dat (BG).out_ptr ^= null
	     then
	     call ws_channel_$call_wakeup (mio_data_ptr,
		mio_data.channel_info.packet_dispatcher.async_channel);

     end send_local_data;

/**/

/* *** Procedure: send_modem_string - Internal proc for ws_packet_transmitter_  *** */

send_modem_string:
     proc (p_string_ptr, p_string_len);


/* PROCEDURE FUNCTION

Send a string of characters to the remote.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_string_ptr	       ptr parameter;	    /* String pointer to transmit */
dcl p_string_len	       fixed bin (21) parameter;  /* String length to transmit */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl mask		       bit (36) aligned;	    /* IPS mask */
dcl code		       fixed bin (35);
dcl buffer	       char (p_string_len);	    /* Conversion buffer for NULL converted */

/* STRUCTURES */
dcl packet_buffer	       char (p_string_len) based (p_string_ptr);

/* INITIALIZATION */

/* MAIN */

/* : Convert all NULL characters to another character as the PC is ignoring
     these */

	buffer = translate (packet_buffer, byte (Null_Convert), byte (0));

/* : Put the modem string out */

	call hcs_$set_ips_mask (""b, mask);
	call iox_$put_chars (mio_data.iocb_ptr, addr (buffer), p_string_len,
	     code);
	call hcs_$reset_ips_mask (mask, mask);

	if code ^= 0 then do;
	     signal mowse_io_error;
	     return;
	end;
     end send_modem_string;

/**/

/* *** Procedure: send_packet - Internal proc for ws_packet_transmitter_  *** */

send_packet:
     proc (p_type, p_data);


/* PROCEDURE FUNCTION

To send a packet to the remote.
*/

/* NOTES

The packet to be sent is built in the local buffer 'pkt' and then sent to
the remote all at once.  The space required for this buffer could be saved
if the packet were sent to the remote a character at a time.  This was not
done because the time to execute a call to the routine that sends data to
the remote is greater than that to add a character to a buffer, and because
to send the packet in pieces would require that interrupts be inhibited for
the duration of the execution of 'sndpkt' in order to prevent it from being
re-entered.

Data outside the range ' ' through '_' for which the corresponding element
of 's_escreq' is set is replaced in the packet by a two character escape
sequence consisting of an element of the array "s_ESC" followed by a
printable ASCII character between ' ' and '_'.  These two characters are
chosen such that the exclusive-or of the second with 64 times the ordinal
in 's_ESC' of the first yields the character they represent.

        eg. <\000> => <esc>< >

The replacement of data characters via two character escape sequences has
no effect upon the checksum of the packet:  The checksum is calculated
using the original data characters rather than those actually sent in the
data field of the packet.  This allows the receiver of the packet to revert
escape sequences as soon as they are encountered.
*/

/* INPUT PARAMETERS */
dcl p_type	       char (1) parameter;	    /* Packet type */
dcl p_data	       char (*) var parameter;    /* Packet data to be sent */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl escidx	       fixed bin;		    /* Escape table index */
dcl group		       fixed bin;		    /* Escape group number */
dcl type		       fixed bin (8);	    /* Packet type converted */
dcl i		       fixed bin (21);
dcl crc		       fixed bin;		    /* CRC control char */
dcl chr		       fixed bin (8) unal;	    /* 8-bit character translations */
dcl data_len	       fixed bin (21);	    /* Length of packet data */
dcl packet_len	       fixed bin (21);	    /* Length of packet to send */
dcl packet	       (0:MinPktLen + 2 * MaxDatLen - 1) char (1); /* Sending packet */

/* STRUCTURES */

/* INITIALIZATION */
	crc = 0;

/* MAIN */

/* If disconnect is in progress and the packet type is not DisCon, don't
   send the message */

	if (mio_data.ds_pending (1) | mio_data.ds_pending (2))
	     & (rank (p_type) ^= DisCon + Request
	     & rank (p_type) ^= DisCon + Confirm)
	     then
	     return;

/* Assemble the packet.  Insert escape sequences as required. */

	packet (0) = mio_data.s.sop;
	packet (1) = p_type;
	packet_len = 2;
	crc = ws_tools_$crc_char (packet (0), INIT_CRC);
	crc = ws_tools_$crc_char (packet (1), crc);
	data_len = length (p_data);

/* For each character */

	do i = 1 to data_len;

/* - Build the checksum (make sure that the p_data character will fit into
       8 bits) */

	     unspec (chr) = bool (unspec (substr (p_data, i, 1)),
		"011111111"b, And);
	     crc = ws_tools_$crc_char (byte (chr), crc);

/* - Convert escape sequences */

	     group = ws_tools_$ars ((chr), 5);
	     escidx = GrpEscIdx (group);
	     if escidx >= 0 & mio_data.s.escreq (chr) then do;
		packet (packet_len) = mio_data.s.esc (escidx);
		packet_len = packet_len + 1;
		unspec (chr) =
		     bool (unspec (chr), EscKey (escidx), XOR);
	     end;

/* - Accumulate packet */

	     packet (packet_len) = byte (chr);
	     packet_len = packet_len + 1;
	end;

/* Delimit packet with control information */

	packet (packet_len)
	     = ws_tools_$check_length (packet_len + LenLen + ChkLen + EOPLen);
	crc = ws_tools_$crc_char (packet (packet_len), crc);
	packet_len = packet_len + 1;
	packet (packet_len) = byte (crc + CONVERT_CRC);
	packet_len = packet_len + 1;
	packet (packet_len) = mio_data.s.eop;
	packet_len = packet_len + 1;

	if mio_data.debug_iocb_ptr ^= null then do;
	     type = rank (p_type);
	     if DatOff <= type & type < DatOff + DatCnt then
		call ws_debug_$packet ("S:DAT---->", addr (packet), packet_len, mio_data.debug_iocb_ptr);
	     else if AckOff <= type & type < AckOff + AckCnt then
		call ws_debug_$packet ("S:ACK---->", addr (packet), packet_len, mio_data.debug_iocb_ptr);
	     else if NakOff <= type & type < NakOff + NakCnt then
		call ws_debug_$packet ("S:NAK---->", addr (packet), packet_len, mio_data.debug_iocb_ptr);
	     else if BrkOff <= type & type < BrkOff + BrkCnt - 2 then
		call ws_debug_$packet ("S:DisCon->", addr (packet), packet_len, mio_data.debug_iocb_ptr);
	     else if BrkOff <= type & type < BrkOff + BrkCnt then
		call ws_debug_$packet ("S:Brk---->", addr (packet), packet_len, mio_data.debug_iocb_ptr);
	     else if RstOff <= type & type < RstOff + RstCnt then
		call ws_debug_$packet ("S:RST---->", addr (packet), packet_len, mio_data.debug_iocb_ptr);
	end;

/* Send packet to the remote */

	call send_modem_string (addr (packet), packet_len);

     end send_packet;

/**/

/* *** Procedure: setup_entry - Internal proc for ws_packet_transmitter_  *** */

setup_entry:
     proc ();


/* PROCEDURE FUNCTION

Initialize the necessary information for each of the entry points.
*/

/* NOTES
*/

/* MAIN */

	mio_data_ptr = p_mio_data_ptr;

     end setup_entry;

/**/

%page;

/* INCLUDE FILES */
%include mowse_io_structures;
%include mowse_info;
%include mowse_messages;
%include mowse_io_constants;
%include mowse;
%include mowse_io_data;

     end;




		    ws_timer_.pl1                   01/24/89  0854.8r w 01/24/89  0847.9      144918



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

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
ws_timer_:
     proc ();


/* PROGRAM FUNCTION

These are the timeout handlers which recover for lost packets.
*/


/* NOTES
*/

/****^  HISTORY COMMENTS:
  1) change(87-06-10,Flegel), approve(87-06-23,MCR7649),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
  2) change(87-09-02,RBarstad), approve(87-09-02,PBF7649),
     audit(87-09-02,LJAdams), install(87-09-02,MR12.1-1096):
     Fixed to not reset timer if timers not being used.
                                                   END HISTORY COMMENTS */

/* INPUT PARAMETERS */
dcl p_wakeup	       fixed bin (71) parameter;  /* When a sleeper is to wake */
dcl p_channel	       fixed bin parameter;	    /* Channel ID */
dcl p_mio_data_ptr	       ptr parameter;	    /* Control structure info */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl timer_id	       fixed bin;		    /* Which timer is being handled */

/* STATIC */
dcl mio_data_ptr	       ptr int static;

/* STRUCTURES */
dcl 01 mio_data	       like mowse_io_data based (mio_data_ptr);

/* SYSTEM CALLS */
dcl ioa_$rsnnl	       entry () options (variable);
dcl timer_manager_$alarm_call entry (fixed bin (71), bit (2), entry);
dcl timer_manager_$reset_alarm_call entry (entry);

/* SYSTEM CALL SUPPORT */

/* EXTERNAL CALLS */
dcl ws_channel_$wait_wakeup
		    entry (ptr, ptr);
dcl ws_packet_transmitter_$supervisory entry (ptr, char (1));
dcl ws_packet_transmitter_$resend entry (ptr, fixed bin);
dcl ws_packet_transmitter_$ack entry (fixed bin, ptr);
dcl ws_debug_$line	       entry () options (variable);

/* EXTERNAL CALL SUPPORT */

/* BUILTINS */
dcl addr		       builtin;
dcl byte		       builtin;
dcl mod		       builtin;
dcl null		       builtin;
dcl clock		       builtin;
dcl divide	       builtin;

/* CONDITIONS */

/* CONSTANTS */
dcl False		   bit(1) int static options (constant) init ("0"b);
dcl ABSOLUTE_SECONDS       bit (2) int static options (constant) init ("01"b);
dcl NO_TIMER	       fixed bin int static options (constant) init (0);
dcl TRUE		       bit (1) int static options (constant) init ("1"b);
dcl FALSE		       bit (1) int static options (constant) init ("0"b);
dcl TIMER_INTERVALS	       (8) fixed bin int static options (constant) init (30, 30, 7, 7, 30, 15, 15, 60);
dcl NUMBER_OF_TIMERS       fixed bin int static options (constant) init (8);
dcl CONNECT_TIMER	       fixed bin int static options (constant) init (8);
dcl FG_SENDER_TIMER	       fixed bin int static options (constant) init (7);
dcl BG_SENDER_TIMER	       fixed bin int static options (constant) init (6);
dcl RESET_TIMER	       fixed bin int static options (constant) init (5);
dcl FG_RECEIVER_TIMER      fixed bin int static options (constant) init (4);
dcl BG_RECEIVER_TIMER      fixed bin int static options (constant) init (3);
dcl DISCONNECT_TIMER       fixed bin int static options (constant) init (2);
dcl BREAK_TIMER	       fixed bin int static options (constant) init (1);

/**/

/* INITIALIZATION */

/* MAIN */

	return;

/**/

%page;

/* INTERNAL ENTRIES */


/* *** Entry: initialize - Internal entry for ws_timer_  *** */

initialize:
     entry (p_mio_data_ptr);


/* ENTRY FUNCTION

Initialize the timer.
*/

/* NOTES
*/

/* The pointer is kept static because the timers wakeup on their own and need
   to have the information and nobody is there to give it */

	mio_data_ptr = p_mio_data_ptr;

/* Turn all timer control data off */

	mio_data.timer_info (*).wakeup = 0;
	mio_data.timer_info (*).timer_id = NO_TIMER;

	return;

/**/

/* *** Entry: sleep_processor - Internal entry for ws_timer_  *** */

sleep_processor:
     entry ();


/* ENTRY FUNCTION

Handle the awakening of a sleeping application.
*/

/* NOTES
*/

	mio_data.dozers = mio_data.dozers + 1;
	return;

/**/

/* *** Entry: timer_processor - Internal entry for ws_timer_  *** */

timer_processor:
     entry ();

/* ENTRY FUNCTION

This is the handler for timer wakeups.
*/

/* NOTES
*/

	call dequeue_timer ();
	call reset_alarm ();

	return;

/**/

/* *** Entry: queue_sleeper - Internal entry for ws_timer_  *** */

queue_sleeper:
     entry (p_wakeup);


/* ENTRY FUNCTION

Queue a sleeper wakeup.
*/

/* NOTES

The queue is already assumed to be formed.  If the next wakeup on the queue
is to occur AFTER the one just inserted, then a wakeup is to be scheduled for
the new time.
*/

/* Nothing to schedule */

	if mio_data.sleepers = null then
	     return;

/* Let's have some debug stuff */

	if mio_data.debug_iocb_ptr ^= null then
	     call ws_debug_$line (mio_data.debug_iocb_ptr,
		"   sleeping: ^d (^d)",
		mio_data.sleepers -> mowse_io_sleep_node.major,
		mio_data.sleepers -> mowse_io_sleep_node.when);

/* First node */

	if mio_data.sleepers -> mowse_io_sleep_node.next = null then do;
	     call reset_wakeup ();
	     return;
	end;

/* Rescheduling required */

	if mio_data.sleepers -> mowse_io_sleep_node.next -> mowse_io_sleep_node.when > p_wakeup then do;
	     call reset_wakeup ();
	     return;
	end;

	return;

/**/

/* *** Entry: reset_(*) - Internal entry for ws_timer_  *** */

/* ENTRY FUNCTION

These are entry points into the queue management for generating alarm calls
when a specified time period has elapsed.
*/

/* NOTES
*/

reset_break:
     entry ();

	timer_id = BREAK_TIMER;
	goto JOIN_RESET;

reset_connect:
     entry ();

	timer_id = CONNECT_TIMER;
	goto JOIN_RESET;

reset_disconnect:
     entry ();

	timer_id = DISCONNECT_TIMER;
	goto JOIN_RESET;

reset_receiver:
     entry (p_channel);

	timer_id = BG_RECEIVER_TIMER + p_channel;
	goto JOIN_RESET;

reset_reset:
     entry ();

	timer_id = RESET_TIMER;
	goto JOIN_RESET;

reset_sender:
     entry (p_channel);

	timer_id = BG_SENDER_TIMER + p_channel;
	goto JOIN_RESET;

JOIN_RESET:

	call queue_timer (timer_id);

	return;

/**/

/* *** Entry: terminate - Internal entry for ws_timer_  *** */

terminate:
     entry ();


/* ENTRY FUNCTION

Turn off all alarm calls as we are shutting down.
*/

/* NOTES
*/

	call timer_manager_$reset_alarm_call (timer_processor);
	mio_data.timer_info (*).timer_id = NO_TIMER;
	mio_data.timer_info (*).wakeup = 0;

	return;

/**/

%page;

/* INTERNAL PROCEDURES */


/* *** Procedure: dequeue_timer - Internal proc for ws_timer_  *** */

dequeue_timer:
     proc ();


/* PROCEDURE FUNCTION

Remove an entry from the timer queue - that which caused this alarm wakeup
to occur - and perform the necessary functions associated with the timer
type being dequeued.
*/

/* NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl request_type	       fixed bin;		    /* Request or Confirmation */
dcl channel	       fixed bin;		    /* Channel ID */
dcl i		       fixed bin;
dcl current_time	       fixed bin (71);

/* STRUCTURES */

/* INITIALIZATION */
	current_time = divide (clock, 1000000, 71);

/* MAIN */

/* Process all timer_ids that were to wakup at this moment */

	do while (mio_data.timer_info (1).wakeup <= current_time
	     & mio_data.timer_info (1).timer_id ^= NO_TIMER);

/* Get timer ID and upshift the remaining entries */

	     timer_id = mio_data.timer_info (1).timer_id;

	     do i = 1 to NUMBER_OF_TIMERS - 1;
		mio_data.timer_info (i).timer_id
		     = mio_data.timer_info (i + 1).timer_id;
		mio_data.timer_info (i).wakeup
		     = mio_data.timer_info (i + 1).wakeup;
	     end;
	     mio_data.timer_info (NUMBER_OF_TIMERS).timer_id = NO_TIMER;
	     mio_data.timer_info (NUMBER_OF_TIMERS).wakeup = 0;

/* Switch on the timer id */

	     channel = BG;
	     goto case (timer_id);

case (1):					    /* BREAK */
	     if mio_data.switches.br_pending then do;
		call ws_packet_transmitter_$supervisory (mio_data_ptr,
		     byte (FGBrk + Confirm));
		call reset_break ();
	     end;
	     goto end_case;

case (2):					    /* DISCONNECT */
	     if mio_data.switches.ds_pending (1)
		| mio_data.switches.ds_pending (2)
	     then do;
		if mio_data.switches.ds_pending (1) then
		     request_type = Request;
		else
		     request_type = Confirm;

		call ws_packet_transmitter_$supervisory (mio_data_ptr,
		     byte (DisCon + request_type));
		call reset_disconnect ();
	     end;
	     goto end_case;

case (4):	     channel = FG;			    /* FG_RECEIVER */
case (3):					    /* BG RECEIVER */
	     if mio_data.s.nasn (channel) ^= mio_data.s.lasn (channel) then
		call ws_packet_transmitter_$ack (channel, mio_data_ptr);
	     call reset_receiver (channel);
	     goto end_case;

case (5):					    /* RESET */
	     if mio_data.switches.rs_pending (1)
		| mio_data.switches.rs_pending (2)
	     then do;
		if mio_data.switches.rs_pending (1) then
		     request_type = Request;
		else
		     request_type = Confirm;

		call ws_packet_transmitter_$supervisory (mio_data_ptr,
		     byte (RstOff + request_type));
		call reset_reset ();
	     end;
	     goto end_case;

case (7):	     channel = FG;			    /* FG_SENDER */
case (6):					    /* BG_SENDER */
	     call ws_packet_transmitter_$resend (mio_data_ptr, channel);
	     goto end_case;

case (8):	     if mio_data.connect_active then do;    /* CONNECT */
		mio_data.switches.connect_active = False;
		call ws_channel_$wait_wakeup (mio_data_ptr,
		     addr (mio_data.channel_info.user_input));
	     end;

	     goto end_case;
end_case:
	     if mio_data.debug_iocb_ptr ^= null then
		call display_queue ("dequeue", timer_id, current_time);

	end;

     end dequeue_timer;

/**/

/* *** Procedure: display_queue - Internal proc for ws_timer_  *** */

display_queue:
     proc (p_request, p_timer_id, p_wakeup);


/* PROCEDURE FUNCTION

Write the timer queue to the debug file, if it is attached.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_wakeup	       fixed bin (71) parameter;  /* When processing occurs */
dcl p_timer_id	       fixed bin parameter;	    /* Who is being processed */
dcl p_request	       char (*) parameter;	    /* Who called */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl j		       fixed bin;
dcl temp_string	       char (32) var;
dcl debug_string	       char (256) var;

/* STRUCTURES */

/* INITIALIZATION */

/* MAIN */

	if mio_data.debug_iocb_ptr = null then
	     return;

	debug_string = "";
	do j = 1 to 7;
	     if mio_data.timer_info (j).timer_id ^= NO_TIMER then do;
		call ioa_$rsnnl (
		     " (^[   ^;BRK^;DSC^;BGr^;FGr^;RST^;BGs^;FGs^;CON^],^d)",
		     temp_string, (0), mio_data.timer_info (j).timer_id + 1,
		     mod (mio_data.timer_info (j).wakeup, 1000));
		debug_string = debug_string || temp_string;
	     end;
	end;

	call ws_debug_$line (mio_data.debug_iocb_ptr,
	     "   ^a (^[BRK^;DSC^;BGr^;FGr^;RST^;BGs^;FGs^;CON^],^d):^a",
	     p_request, p_timer_id, mod (p_wakeup, 1000), debug_string);

     end display_queue;

/**/

/* *** Procedure: queue_timer - Internal proc for ws_timer_  *** */

queue_timer:
     proc (p_timer_id);


/* PROCEDURE FUNCTION

Place a request in the timer_info structure for a wakeup of the specified
type.
*/

/* NOTES
*/

/* INPUT PARAMETERS */
dcl p_timer_id	       fixed bin parameter;	    /* Timer to queue */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl swap_wake	       fixed bin (71);	    /* Swapping holding place */
dcl swap_id	       fixed bin;		    /* Space for swapping */
dcl temp_wake	       fixed bin (71);	    /* Temporary holding */
dcl when_wakeup	       fixed bin (71);	    /* When a wakeup occurs */
dcl current_seconds	       fixed bin (71);	    /* Current time in seconds */
dcl temp_id	       fixed bin;		    /* Temp ID for swapping */
dcl j		       fixed bin;
dcl done		       bit (1);		    /* Search control flag */
dcl i		       fixed bin;

/* STRUCTURES */

/* INITIALIZATION */

/* MAIN */
	current_seconds = divide (clock, 1000000, 71);
	when_wakeup = current_seconds + TIMER_INTERVALS (p_timer_id);
	i = 1;
	done = FALSE;
	do while (^done);

/* Add wakeup */

	     if mio_data.timer_info (i).timer_id = NO_TIMER then do;
		mio_data.timer_info (i).timer_id = p_timer_id;
		mio_data.timer_info (i).wakeup = when_wakeup;
		done = TRUE;
	     end;

/* Replace wakeup */

	     else if mio_data.timer_info (i).timer_id = p_timer_id then do;
		do j = i + 1 to NUMBER_OF_TIMERS;

/* Empty slot, so it's the end of the queue */

		     if mio_data.timer_info (j).timer_id = NO_TIMER then do;
			mio_data.timer_info (j - 1).timer_id = p_timer_id;
			mio_data.timer_info (j - 1).wakeup = when_wakeup;
			j = NUMBER_OF_TIMERS;
		     end;

/* Last slot */

		     else if j = NUMBER_OF_TIMERS then do;
			mio_data.timer_info (j).timer_id = p_timer_id;
			mio_data.timer_info (j).wakeup = when_wakeup;
		     end;

/* Found the position */

		     else if mio_data.timer_info (j).wakeup > when_wakeup then do;
			mio_data.timer_info (j - 1).timer_id = p_timer_id;
			mio_data.timer_info (j - 1).wakeup = when_wakeup;
			j = NUMBER_OF_TIMERS;
		     end;

/* Upshift slots */

		     else do;
			mio_data.timer_info (j - 1).timer_id
			     = mio_data.timer_info (j).timer_id;
			mio_data.timer_info (j - 1).wakeup
			     = mio_data.timer_info (j).wakeup;
		     end;
		end;

		done = TRUE;
	     end;

/* Insert wakeup */

	     else if when_wakeup < mio_data.timer_info (i).wakeup then do;
		temp_id = mio_data.timer_info (i).timer_id;
		temp_wake = mio_data.timer_info (i).wakeup;
		mio_data.timer_info (i).timer_id = p_timer_id;
		mio_data.timer_info (i).wakeup = when_wakeup;

		do j = i + 1 to NUMBER_OF_TIMERS;

/* No duplicates */

		     if mio_data.timer_info (j).timer_id = p_timer_id then do;
			mio_data.timer_info (j).timer_id = temp_id;
			mio_data.timer_info (j).wakeup = temp_wake;
			j = NUMBER_OF_TIMERS;
		     end;

/* Downshift slots */

		     else do;
			swap_id = mio_data.timer_info (j).timer_id;
			swap_wake = mio_data.timer_info (j).wakeup;
			mio_data.timer_info (j).timer_id = temp_id;
			mio_data.timer_info (j).wakeup = temp_wake;
			temp_id = swap_id;
			temp_wake = swap_wake;
		     end;
		end;

		done = TRUE;
	     end;

	     else
		i = i + 1;
	end;

/* Lets see some debugging */

	if mio_data.debug_iocb_ptr ^= null then
	     call display_queue ("  queue", p_timer_id, when_wakeup);

/* If terminated on first iteration, then the actual alarm needs to be reset */

	if i = 1 then
	     call reset_alarm ();

     end queue_timer;

/**/

/* *** Procedure: reset_alarm - Internal proc for ws_timer_  *** */

reset_alarm:
     proc ();


/* PROCEDURE FUNCTION

Set the timer_manager_ up with a new wakeup (the next one in the timer_info
queue).
*/

/* NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */

/* STRUCTURES */

/* INITIALIZATION */

/* MAIN */
     if mio_data.timer_info (1).timer_id ^= NO_TIMER    /* hcom #2 */
	then do;
	call timer_manager_$reset_alarm_call (timer_processor);
	call timer_manager_$alarm_call (mio_data.timer_info (1).wakeup,
	     ABSOLUTE_SECONDS, timer_processor);
     end;

     end reset_alarm;

/**/

/* *** Procedure: reset_wakeup - Internal proc for ws_timer_  *** */

reset_wakeup:
     proc ();


/* PROCEDURE FUNCTION

Reschedule a wakeup for handling the sleepers queue.
*/

/* NOTES
*/

/* INPUT PARAMETERS */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */

/* STRUCTURES */

/* INITIALIZATION */

/* MAIN */

	call timer_manager_$reset_alarm_call (sleep_processor);
	call timer_manager_$alarm_call (
	     mio_data.sleepers -> mowse_io_sleep_node.when,
	     ABSOLUTE_SECONDS, sleep_processor);

     end reset_wakeup;

/**/

%page;

/* INCLUDE FILES */
%include mowse_io_structures;
%include mowse;
%include mowse_io_constants;
%include mowse_messages;
%include mowse_io_data;

     end;




		    ws_tools_.pl1                   01/24/89  0854.8r w 01/24/89  0850.0       85608



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

/* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
ws_tools_:
     proc ();


/* PROGRAM FUNCTION

This is a collection of routines which need to be accessed from a number of
external entry points for the MOWSE protocol handling.
*/


/* NOTES
*/

/****^  HISTORY COMMENTS:
  1) change(87-05-28,Flegel), approve(87-06-23,MCR7649),
     audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
     Created.
                                                   END HISTORY COMMENTS */

/* INPUT PARAMETERS */
dcl p_buffer_size	       fixed bin (21) parameter;  /* Size of buffer */
dcl p_buffer_ptr	       ptr parameter;	    /* Buffer to fill */
dcl p_channel	       fixed bin;		    /* Channel ID */
dcl p_mio_data_ptr	       ptr parameter;	    /* mowse_io_ data */
dcl p_value	       fixed bin parameter;	    /* Value to be shifted */
dcl p_shift	       fixed bin parameter;	    /* Value to be shifted */
dcl p_packet_length	       fixed bin (21) parameter;  /* Packet length */
dcl p_chr		       char (1) parameter;	    /* Character to be CRCed */
dcl p_seed	       fixed bin parameter;	    /* Value 0 to 63 wich is the seed for the calculation */

/* OUTPUT PARAMETERS */

/* MISC VARIABLES */
dcl data_ptr	       ptr;
dcl rdatl		       fixed bin (21);	    /* Extracted data length */
dcl space		       fixed bin (21);	    /* Space remaining in user_input queue */
dcl buffer_size	       fixed bin (21);	    /* Local copy of buffer size */
dcl buffer_ptr	       ptr;		    /* Local copy of buffer pointer */
dcl mio_data_ptr	       ptr;		    /* mowse_io_ data pointer */
dcl channel	       fixed bin;		    /* Channel ID */
dcl i		       fixed bin;
dcl q		       fixed bin;		    /* Next quotient of division */
dcl b		       fixed bin;		    /* Bit counter */
dcl schr		       fixed bin;		    /* rank of crc shifted right 'b' times */
dcl crc		       fixed bin;		    /* Accumulator */

/* STRUCTURES */
dcl buffer	       char (buffer_size) based (buffer_ptr);
dcl 01 mio_data	       like mowse_io_data based (mio_data_ptr);

/* SYSTEM CALLS */

/* SYSTEM CALL SUPPORT */

/* EXTERNAL CALLS */
dcl ws_debug_$packet       entry (char (*), ptr, fixed bin (21), ptr);

/* EXTERNAL CALL SUPPORT */

/* BUILTINS */
dcl byte		       builtin;
dcl null		       builtin;
dcl length	       builtin;
dcl hbound	       builtin;
dcl bool		       builtin;
dcl unspec	       builtin;
dcl divide	       builtin;
dcl mod		       builtin;
dcl rank		       builtin;

/* CONDITIONS */

/* CONSTANTS */
dcl False		       bit (1) int static options (constant) init ("0"b);
dcl Exp2		       (0:16) fixed bin static options (constant)
		       init (1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024,
		       2048, 4096, 8192, 1634, 3276, 65536);

/**/

/* INITIALIZATION */

/* MAIN */

	return;

/**/

%page;

/* INTERNAL ENTRIES */


/* *** Entry: ars - Internal entry for ws_tools_  *** */

ars:
     entry (p_value, p_shift) returns (fixed bin);


/* PROCEDURE FUNCTION

Arithmetic shift right.
*/

/* NOTES
*/

	return (divide (p_value, Exp2 (p_shift), 17, 0));

/**/

/* *** Entry: check_length - Internal entry for ws_tools_  *** */

check_length:
     entry (p_packet_length) returns (char (1));


/* ENTRY FUNCTION

Calculate the check length character.
*/

/* RETURNS:

chklen = (p_length & 077) + 32
*/

/* NOTES
*/

	return (byte (mod (p_packet_length, 64) + 32));

/**/

/* *** Entry: crc_char - Internal entry for ws_tools_  *** */

crc_char:
     entry (p_chr, p_seed) returns (fixed bin);


/* ENTRY FUNCTION

Calculate a 6-bit CRC for a character based on a generator polynomial of:
	x**6 + x**5 + x**2 + 1.
*/

/* RETURNS

A value in the range 0 through 63 which is the desired CRC.
*/

/* NOTES

The result of this function is the remainder produced by synthetic division
modulo 2 of a 7-bit integer (whose bits are the coefficients of the generator
polynomial) into a 14-bit integer (whose top 8 bits are those of the
character, in reverse order, and whose low 6 bits are the low 6 bits of the
seed).

The CRC for a string of characters is calculated by calling crc_chr' once for
each character in the block, from first character to last.  The seed for the
first character is 0 and the seed for each remaining character is the CRC
produced for the previous character.  The CRC produced for the last character
is the CRC for the whole string.
*/

	crc = p_seed;
	schr = rank (p_chr);

/* For each bit in the character
     - q = xor of low bits of crc and schr */

	do b = 0 to 7;
	     q = mod (crc + schr, 2);
	     crc = divide (crc, 2, 17);
	     if q ^= 0 then
		unspec (crc) =
		     bool (unspec (crc), unspec (REVPOLY), XOR);
	     schr = divide (schr, 2, 17);
	end;

	return (crc);

/**/

/* *** Entry: getdat - Internal entry for ws_tools_  *** */

getdat:
     entry (p_mio_data_ptr, p_channel, p_buffer_ptr, p_buffer_size)
	returns (fixed bin (21));

/* ENTRY FUNCTION

Retreive a packet of data from the packet queue on the specified channel.
Update all necessary control info related to the extraction.
*/

/* RETURNS

The amount of data extracted.
*/

/* NOTES
*/

	mio_data_ptr = p_mio_data_ptr;
	buffer_ptr = p_buffer_ptr;
	buffer_size = p_buffer_size;

/* If the received data queue is empty, there is nothing to do. */

	if mio_data.r.psn (p_channel) = mio_data.s.nasn (p_channel) then
	     return (0);

/* If Disconnect is active, return 0 */

	if mio_data.switches.disconnect_active then
	     return (0);

/* If the foreground channel, then make sure there is enough space in the
   user_input queue before getting it out */

	if p_channel = FG then do;

/* Calculate the amount of space in the input queue */

	     if mio_data.user_input.in >= mio_data.user_input.out then
		space = hbound (mio_data.user_input.queue, 1) -
		     mio_data.user_input.in
		     + mio_data.user_input.out - 1;
	     else
		space = mio_data.user_input.out
		     - mio_data.user_input.out - 1;

/* If not enough space then return 0 for length */

	     if space < length (mio_data.r.dat (FG, mio_data.s.nasn (FG)))
		then
		return (0);
	end;

/* Extract the data in the head element of the queue. */

	rdatl = length (mio_data.r.dat (p_channel, mio_data.s.nasn (p_channel)));
	buffer = mio_data.r.dat (p_channel, mio_data.s.nasn (p_channel));
	mio_data.s.nasn (p_channel) =
	     mod (mio_data.s.nasn (p_channel) + 1, SeqCnt);

	return (rdatl);

/**/

/* *** Entry: getldat - Internal entry for ws_tools_  *** */

getldat:
     entry (p_mio_data_ptr, p_channel, p_buffer_ptr)
	returns (fixed bin (21));


/* ENTRY FUNCTION

Get any available received data from the local queue.
*/

/* NOTES

Data is stored in Packet size packet size chunks to emulate what happens in
regards to remote packets, so they are extracted the same.
*/

	mio_data_ptr = p_mio_data_ptr;

/* If the recevied data queue is empty there is nothing to do */

	if mio_data.l_dat (p_channel).out_ptr = null then
	     return (0);

/* If Disconnect is active, return 0 */

	if mio_data.disconnect_active then
	     return (0);

/* Extract the data from the head element of the queue */

	p_buffer_ptr = mio_data.l_dat (p_channel).out_ptr -> local_data_node.data_ptr;
	rdatl = mio_data.l_dat (p_channel).out_ptr -> local_data_node.data_len;

/* Free the node from the queue */

	data_ptr = mio_data.l_dat (p_channel).out_ptr;
	if data_ptr -> local_data_node.next = null then do;
	     mio_data.l_dat (p_channel).in_ptr = null;
	     mio_data.l_dat (p_channel).out_ptr = null;
	end;
	else
	     mio_data.l_dat (p_channel).out_ptr =
		data_ptr -> local_data_node.next;

	free data_ptr -> local_data_node;
	data_ptr = null;

	if mio_data.debug_iocb_ptr ^= null then
	     call ws_debug_$packet ("R:L:DAT-->", p_buffer_ptr, rdatl,
		mio_data.debug_iocb_ptr);

	return (rdatl);

/**/

/* *** Entry: reset_data - Internal entry for ws_tools_  *** */

reset_data:
     entry (p_mio_data_ptr);


/* ENTRY FUNCTION

To initialize the flow control related variables of the protocol.
*/

/* NOTES
*/

	mio_data_ptr = p_mio_data_ptr;

/* Clear the receive packet queue */

	do i = 0 to RQS - 1;
	     mio_data.r.pkt (i) = "";
	end;
	mio_data.r.pktin = 0;
	mio_data.r.pktout = 0;

/* Clear the pending flags */

	mio_data.ds_pending (*) = False;

/* For each message channel */

	do channel = 0 to ChnCnt - 1;

/* Clear all receiving windows */

	     do i = 0 to SeqCnt - 1;
		mio_data.r.dat (channel, i) = "";
	     end;
	     mio_data.r.ignoring (channel) = False;
	     mio_data.r.asn (channel) = 0;
	     mio_data.r.psn (channel) = 0;

/* : - Clear all sending channels */

	     do i = 0 to SeqCnt - 1;
		mio_data.s.dat (channel, i) = "";
	     end;
	     mio_data.s.lasn (channel) = 0;
	     mio_data.s.nasn (channel) = 0;
	     mio_data.s.psn (channel) = 0;
	end;

	return;

/**/

%page;

/* INTERNAL PROCEDURES */

/**/

%page;

/* INCLUDE FILES */
%include mowse_io_structures;
%include mowse;
%include mowse_messages;
%include mowse_io_data;
%include mowse_io_constants;

     end ws_tools_;




		    PNOTICE_mowse.alm               11/14/89  1108.0r w 11/14/89  1108.0        2313



	dec	1			"version 1 structure
	dec	1			"no. of pnotices
	dec	3			"no. of STIs
	dec	41			"lgth of all pnotices + no. of pnotices
          acc       "Copyright, (C) Honeywell Bull Inc., 1989"

	aci	"C1MOWM0E0000"
	aci	"C2MOWM0E0000"
	aci	"C3MOWM0E0000"
	end






		    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
