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: --| --+--...---- tty_ --| --| --+--...---- syn_ ---- mowse_io_ ---- 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 : from :" || "^/: to :" || "^/: = " || "^/TRC Msg_type: : ^/" ); 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); /* - 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 = ""; 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 = ""; 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> => < > 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