1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Bull Inc., 1987                *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Information Systems Inc., 1986 *
   6         *                                                         *
   7         *********************************************************** */
   8 
   9 /****^  HISTORY COMMENTS:
  10   1) change(86-04-04,Smith), approve(87-07-15,MCR7580),
  11      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
  12      Coded execute_command
  13   2) change(86-04-15,Flegel), approve(87-07-15,MCR7580),
  14      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
  15      Coded create_instance, destroy_instance
  16   3) change(86-04-17,Flegel), approve(87-07-15,MCR7580),
  17      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
  18      Coded find_capability_name, find_capability_number
  19   4) change(86-04-30,Smith), approve(87-07-15,MCR7580),
  20      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
  21      Coded execute_capability
  22   5) change(86-06-11,Smith), approve(87-07-15,MCR7580),
  23      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
  24      Coded suspend_capability, resume_capability, terminate_capability
  25   6) change(86-06-23,Smith), approve(87-07-15,MCR7580),
  26      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
  27      Coded reset_capability, put_background_message
  28   7) change(86-07-01,Smith), approve(87-07-15,MCR7580),
  29      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
  30      Coded connect_request, connect_response, get_status, put_status, sleep,
  31      disconnect_request, disconnect_response
  32   8) change(86-10-22,Smith), approve(87-07-15,MCR7580),
  33      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
  34      Modified connect_request so that capability is created is it doesn't
  35      already exist.
  36   9) change(86-10-22,Smith), approve(87-07-15,MCR7580),
  37      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
  38      Mofidied destroy instance so that capability name not sent in
  39      delete_from_remote_cat_ message.
  40  10) change(86-11-07,Flegel), approve(87-07-15,MCR7580),
  41      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
  42      Changed put_background_message to split long messages into multiple
  43      pieces up to a length of MAXIMUM_BG_SIZE (mowse.incl.pl1).
  44  11) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
  45      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
  46      Approved.
  47  12) change(86-11-27,Flegel), approve(86-11-27,MCR7580),
  48      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
  49      If a long message is pending from the caller to execute_capability, an
  50      error code is returned because MOWSE protocol will not provide for
  51      multiple pending long messages.
  52  13) change(86-12-05,Flegel), approve(86-12-05,MCR7580),
  53      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
  54      Added chacks fo null MOWSE tables, if it occurs, then a new_process is
  55      generated.
  56  14) change(86-12-10,Flegel), approve(86-12-10,MCR7580),
  57      audit(87-07-30,RBarstad), install(87-08-07,MR12.1-1075):
  58      Replaced signalling of mowse_fatal_error with a call to fatal_mowse_trap_
  59                                                    END HISTORY COMMENTS */
  60 /* format: style4,indattr,ifthen,^indcomtxt,thendo,^indproc,^indblkcom,initcol1,declareind8,dclind4,struclvlind3,comcol55 */
  61 ws_:
  62      proc ();
  63 
  64 
  65 /* : PROCEDURE FUNCTION
  66 
  67 MOWSE Subroutine Library which provides a means with which applications can
  68 communicate with MOWSE.
  69 
  70 Entry Points:
  71 
  72      connect_request          connect_response
  73      create_instance          destroy_instance
  74      disconnect_request       disconnect_response
  75      execute_capability       execute_command
  76      find_capability_name     find_capability_number
  77      get_background_message   get_status
  78      put_background_message   resume_capability
  79      send_query_reply         sleep
  80      suspend_capability       terminate_capability
  81 */
  82 
  83 /*^L*/
  84 
  85 /* INPUT PARAMETERS */
  86 dcl p_args                 char (*) parameter;
  87 dcl p_reply_string         char (*) parameter;
  88 dcl p_status               fixed bin parameter;
  89 dcl p_capability_number    fixed bin parameter;
  90 dcl p_time                 fixed bin (35) parameter;
  91 dcl p_status_result        char (*) parameter;
  92 dcl p_status_request       char (*) parameter;
  93 dcl p_capability_name      char (*) parameter;
  94 dcl p_command              char (*) parameter;
  95 dcl p_data_block_ptr       ptr parameter;
  96 dcl p_data_len             fixed bin (17) parameter;
  97 dcl p_data_ptr             ptr parameter;
  98 dcl p_entry_name           char (*) parameter;
  99 dcl p_inbuff_length        fixed bin (17) parameter;
 100 dcl p_major                fixed bin (17) parameter;
 101 dcl p_mcb_ptr              ptr parameter;
 102 dcl p_minor                fixed bin (17) parameter;
 103 dcl p_outbuff_length       fixed bin (17) parameter;
 104 dcl p_system               fixed bin (17) parameter;
 105 
 106 
 107 /* OUTPUT PARAMETERS */
 108 dcl p_cmd_id               fixed bin (17) parameter;
 109 dcl p_code                 fixed bin (35) parameter;
 110 
 111 /* MISC VARIABLES */
 112 dcl connect_request_len    fixed bin (17);
 113 dcl connect_request_string char (MAXIMUM_PACKET_SIZE);
 114 dcl arguments              char (MAXIMUM_PACKET_SIZE - 33) var;
 115 dcl capname                char (32) var;
 116 dcl mowse_mcb_ptr          ptr;
 117 dcl mowse_iocb_ptr         ptr;
 118 dcl temp_major             fixed bin;
 119 dcl sysid                  fixed bin;
 120 dcl search_name            char (32);                 /* Temporary name for cap */
 121 dcl mowse_info_ptr         ptr;                       /* Pointer to mowse info structure */
 122 dcl temp_mcb_ptr           ptr;
 123 dcl temp_char              char;
 124 dcl minor_num              fixed bin;                 /* minor capability number */
 125 dcl first_byte             fixed bin;
 126 dcl longinfo_length        fixed bin;                 /* length of error_table_ longinofo */
 127 dcl longinfo               char (100) aligned;        /* longinfo status string */
 128 dcl shortinfo              char (8) aligned;          /* shortinfo status string */
 129 
 130 dcl formatted_string       char (MAXIMUM_BG_SIZE);    /* generated formatted string */
 131 dcl formatted_string_length
 132                            fixed bin;                 /* length of string generated by ioa_ call */
 133 dcl result_string          char (MAXIMUM_BG_SIZE);    /* generated result string */
 134 dcl result_string_length   fixed bin;                 /* length of result string */
 135 
 136 dcl arg_ptr                ptr;                       /* pointer to general argument */
 137 dcl arg_len                fixed bin (21);            /* length of arguments */
 138 dcl caller_name_length     fixed bin (21);            /* length of caller name */
 139 dcl based_caller_name      char (32) based (arg_ptr); /* overlay for caller's name */
 140 dcl caller_name            char (32);                 /* caller's name as in com_err_ */
 141 dcl based_code             fixed bin based (arg_ptr); /* overlay for code */
 142 dcl based_mcb_ptr          ptr based (arg_ptr);       /* overlay for mcb_ptr */
 143 dcl arg_list_ptr           ptr;                       /* pointer to arg list used in put_background_message */
 144 dcl errcode                fixed bin (35);
 145 dcl arg_count              fixed bin;
 146 dcl system_free_area       area based (system_free_area_ptr);
 147                                                       /* area used for the allocation of mowse structures */
 148 dcl system_free_area_ptr   ptr;
 149 dcl cap_index              fixed bin (17);            /* index into CAT tables */
 150 dcl cap_num                fixed bin (17);            /* index into CAT tables or a major capability */
 151 dcl destination            fixed bin (17);            /* major capability */
 152 dcl ecode                  fixed bin (35);
 153 dcl entry_point            entry variable;
 154 dcl i                      fixed bin (17);
 155 dcl in_space               char (
 156                            get_buff_length (p_inbuff_length,
 157                            MINIMUM_BUFFER_SIZE, MAXIMUM_BUFFER_SIZE)) based;
 158                                                       /* space for application buffers */
 159 dcl major_num              fixed bin (17);            /* capability number */
 160 dcl message_str            char (MAXIMUM_PACKET_SIZE);
 161                                                       /* MOWSE system id */
 162 dcl source_major           fixed bin (17);
 163 dcl source_system          fixed bin (17);
 164 dcl temp_buff_ptr          ptr;
 165 dcl input_buffer_length    fixed bin;
 166 dcl input_buffer_data      char (input_buffer_length) based (temp_buff_ptr);
 167                                                       /* temporary application buffers */
 168 
 169 /* STRUCTURES */
 170 
 171 dcl 01 mio_info            like mowse_io_info automatic;
 172                                                       /* Automatic mowse info */
 173 dcl 01 mio_sleep           like mowse_io_sleep_info automatic;
 174                                                       /*  Automatic sleep info structure */
 175                                                       /* used by create_instance to compose message destined for add_to_remote_cat_
 176    (internal mowse routine) */
 177 
 178 dcl 01 alter_remote_cat_msg,
 179        02 major            char (1) unal,
 180        02 major_name       char (CAPABILITY_NAME_LENGTH) unal;
 181 
 182 /* SYSTEM CALLS */
 183 dcl iox_$control           entry (ptr, char (*), ptr, fixed bin (35));
 184 dcl iox_$close             entry (ptr, fixed bin (35));
 185 dcl terminate_process_     entry (char (*), ptr);
 186 dcl com_err_$convert_status_code_
 187                            entry (fixed bin (35), char (8) aligned,
 188                            char (100) aligned);
 189 dcl ioa_$general_rs        entry (ptr, fixed bin, fixed bin, char (*),
 190                            fixed bin (21), bit (1) aligned, bit (1) aligned);
 191 dcl cu_$arg_ptr            entry (fixed bin, ptr, fixed bin (21),
 192                            fixed bin (35));
 193 dcl cu_$arg_list_ptr       entry (ptr);
 194 dcl cu_$arg_count          entry (fixed bin, fixed bin (35));
 195 dcl get_system_free_area_  entry () returns (ptr);
 196 dcl hcs_$make_entry        entry (ptr, char (*), char (*), entry,
 197                            fixed bin (35));
 198 
 199 /* SYSTEM CALL SUPPORT */
 200 dcl ws_error_$invalid_sleep_interval
 201                            fixed bin (35) ext static;
 202 dcl ws_error_$inconsistent_mowse_tables
 203                            fixed bin (35) ext static;
 204 dcl error_table_$unimplemented_version
 205                            fixed bin (35) ext static;
 206 dcl error_table_$no_table  fixed bin (35) ext static;
 207 dcl ws_error_$invalid_connect_status
 208                            fixed bin (35) ext static;
 209 dcl ws_error_$not_available
 210                            fixed bin (35) ext static;
 211 dcl ws_error_$sleeping     fixed bin (35) ext static;
 212 dcl ws_error_$cant_create_instance
 213                            fixed bin (35) ext static;
 214 dcl ws_error_$invalid_minor_capability
 215                            fixed bin (35) ext static;
 216 dcl ws_error_$suspended    fixed bin (35) ext static;
 217 dcl ws_error_$not_suspended
 218                            fixed bin (35) ext static;
 219 dcl ws_error_$invalid_capability_name
 220                            fixed bin (35) ext static;
 221 dcl ws_error_$invalid_capability_number
 222                            fixed bin (35) ext static;
 223 dcl ws_error_$invalid_mcb  fixed bin (35) ext static;
 224 dcl ws_error_$invalid_system_id
 225                            fixed bin (35) ext static;
 226 dcl ws_error_$buffer_overflow
 227                            fixed bin (35) ext static;
 228 
 229 /* EXTERNAL CALLS */
 230 dcl send_mowse_message_    entry (ptr, fixed bin, fixed bin, fixed bin,
 231                            fixed bin, fixed bin, fixed bin, ptr, fixed bin,
 232                            fixed bin, fixed bin (35));
 233 dcl find_mowse_io_         entry (ptr, fixed bin (35));
 234 dcl get_mowse_info_ptr_    entry (ptr, ptr, fixed bin (35));
 235 dcl send_msg_              entry (ptr, fixed bin, fixed bin, ptr, fixed bin,
 236                            fixed bin, fixed bin (35));
 237 dcl capability_$unpack     entry (fixed bin, fixed bin, fixed bin,
 238                            fixed bin (35));
 239 dcl capability_$pack       entry (fixed bin, fixed bin, fixed bin,
 240                            fixed bin (35));
 241 dcl find_free_cat_entry_   entry (ptr, fixed bin, fixed bin (35));
 242 dcl release_outbuffer_     entry (ptr);
 243 dcl fatal_mowse_trap_      entry (fixed bin (35));
 244 
 245 /* EXTERNAL CALL SUPPORT */
 246 
 247 /* BUILTINS */
 248 dcl min                    builtin;
 249 dcl null                   builtin;
 250 dcl addr                   builtin;
 251 dcl byte                   builtin;
 252 dcl length                 builtin;
 253 dcl round                  builtin;
 254 dcl rtrim                  builtin;
 255 dcl substr                 builtin;
 256 
 257 /* CONDITIONS */
 258 
 259 /* CONSTANTS */
 260 dcl VERSION                char (8) int static options (constant)
 261                            init ("version1");
 262 dcl CMD_ID_CNT             fixed bin int static init (1);
 263 dcl TRUE                   bit (1) int static options (constant) init ("1"b);
 264 dcl FALSE                  bit (1) int static options (constant) init ("0"b);
 265 
 266 /*^L*/
 267 /* INITIALIZATION */
 268 
 269 /* MAIN */
 270           return;
 271 
 272 /*^L*/
 273 
 274 /* ENTRY POINTS */
 275 
 276 /* : *** Entry: connect_request - internal entry for ws_ ****/
 277 
 278 /* ENTRY FUNCTION
 279 
 280 Request a connection to an application.
 281 */
 282 
 283 connect_request:
 284      entry (p_capability_name, p_args, p_system, p_mcb_ptr, p_code);
 285 
 286           p_code = 0;
 287 
 288 /* : check mcb pointer */
 289 
 290           call check_mcb_ptr (p_mcb_ptr, p_code);
 291           if p_code ^= 0 then
 292                return;
 293 
 294           mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
 295           capname = p_capability_name;
 296           capname = rtrim (capname);
 297           connect_request_string = capname;
 298           connect_request_len = length (capname);
 299           arguments = p_args;
 300 
 301           if (length (rtrim (arguments)) ^= 0) then do;
 302                connect_request_string = capname || " " || rtrim (arguments);
 303                connect_request_len = length (capname) + 1 +
 304                     length (rtrim (arguments));
 305           end;
 306 
 307           call capability_$pack (p_system, INTERNAL, destination, p_code);
 308           if p_code ^= 0 then
 309                return;
 310 
 311           call send_msg_ (p_mcb_ptr, destination, REQUEST_CONNECT,
 312                addr (connect_request_string), connect_request_len, BG, p_code);
 313           if p_code ^= 0 then do;
 314                call fatal_mowse_trap_ (p_code);
 315                return;
 316           end;
 317 
 318           return;
 319 
 320 /*^L*/
 321 
 322 /* : *** Entry: connect_response - internal entry for ws_ *** */
 323 
 324 /* : ENTRY FUNCTION
 325 
 326 Allows an application to respond to a connect request from some application.
 327 */
 328 
 329 connect_response:
 330      entry (p_status, p_major, p_mcb_ptr, p_code);
 331 
 332           p_code = 0;
 333 
 334           call check_mcb_ptr (p_mcb_ptr, p_code);
 335           if p_code ^= 0 then
 336                return;
 337 
 338 /* : check major capability_number */
 339 
 340           call capability_$unpack (sysid, major_num, p_major, p_code);
 341           if p_code ^= 0 then
 342                return;
 343 
 344 /* : check the status being sent as response */
 345 
 346           if (p_status ^= ACCEPT) & (p_status ^= REJECT) then do;
 347                p_code = ws_error_$invalid_connect_status;
 348                return;
 349           end;
 350 
 351           call verify_capability (p_mcb_ptr -> mcb.mowse_info_ptr,
 352                p_major, p_code);
 353           if p_code ^= 0 then
 354                return;
 355 
 356 /* : Send RESPONSE DISCONNECT message with status as data */
 357 
 358           temp_char = byte (p_status);
 359           call send_msg_ (p_mcb_ptr, p_major, RESPONSE_CONNECT,
 360                addr (temp_char), 1, BG, p_code);
 361           if p_code ^= 0 then do;
 362                call fatal_mowse_trap_ (p_code);
 363                return;
 364           end;
 365 
 366           return;
 367 
 368 /*^L*/
 369 
 370 /* : *** Entry: create_instance - internal entry for ws_ *** */
 371 
 372 /* : ENTRY FUNCTION
 373 
 374 Register the calling routine with MOWSE by assigning it a major capability
 375 number and adding it to MOWSE's capability table. The calling routine must
 376 supply the name by which it is to be known to MOWSE, and the entry point
 377 describing where it is to be invoked by an execute capability.
 378 */
 379 
 380 /* : NOTES
 381 
 382 All applications which expect to receive messages must have registered with
 383 MOWSE (through create_instance) in order to receive messages. A message is
 384 provided to the application when a the destination of the message specifies
 385 the major capability number of the application. The application will then be
 386 invoked at the entry name provided with the message (argument data), its
 387 length, and a pointer to the applications data_block as follows:
 388 
 389         application_$entry_point (minor_capability, major_sender,
 390                                   arg_ptr, arg_len, p_mcb_ptr, data_blk_ptr);
 391 
 392 The buffers inbuff and outbuff allow MOWSE to send and receive messages
 393 longer than one communications packet defined by PACKET_SIZE) in a manner
 394 transparent to the capability.
 395 */
 396 
 397 create_instance:
 398      entry (p_capability_name, p_entry_name, p_inbuff_length,
 399           p_outbuff_length, p_data_block_ptr, p_mcb_ptr, p_code);
 400 
 401           p_code = 0;
 402           cap_index = 0;
 403 
 404 /* : Get mowse info required before allocation of new mcb */
 405 
 406 /* : - get mowse iocb_ptr */
 407           call find_mowse_io_ (mowse_iocb_ptr, p_code);
 408           if p_code ^= 0 then
 409                return;
 410 
 411 /* : - get mowse mcb_ptr */
 412           mio_info.version = mowse_io_info_version_1;
 413           call iox_$control (mowse_iocb_ptr, "get_mowse_info",
 414                addr (mio_info), p_code);
 415           if p_code ^= 0 then
 416                return;
 417           mowse_mcb_ptr = mio_info.mcb_ptr;
 418 
 419 /* : - get mowse info_ptr */
 420 
 421           call get_mowse_info_ptr_ (mowse_mcb_ptr, mowse_info_ptr, p_code);
 422           if p_code ^= 0 then
 423                return;
 424 
 425           if mowse_info_ptr = null then
 426                call null_mowse_info_handler ();
 427 
 428           if mowse_info_ptr -> mowse_info.version ^= VERSION then do;
 429                p_code = error_table_$unimplemented_version;
 430                return;
 431           end;
 432 
 433 /* : If no free entry in local CAT, return error */
 434 
 435           call find_free_cat_entry_ (mowse_info_ptr, cap_index, p_code);
 436           if (p_code ^= 0) then
 437                return;
 438 
 439 /* : Create entry point call hcs_$make_entry */
 440 
 441           call hcs_$make_entry (null, p_capability_name, p_entry_name,
 442                entry_point, p_code);
 443           if (p_code ^= 0) then
 444                return;
 445 
 446 /* : Make major_capability number */
 447 
 448           call capability_$pack (LOCAL_SYSTEM, cap_index, cap_num, p_code);
 449           if (p_code ^= 0) then do;
 450                p_code = ws_error_$cant_create_instance;
 451                return;
 452           end;
 453 
 454 /* : allocate MCB */
 455 
 456           system_free_area_ptr = get_system_free_area_ ();
 457           allocate mcb in (system_free_area) set (p_mcb_ptr);
 458 
 459 /* : Set mcb_ptr stored in the local CAT table */
 460 
 461           mowse_info_ptr -> mowse_info.local_cat (cap_index).mcb_ptr =
 462                p_mcb_ptr;
 463 
 464 /* : Initialize CAT flags */
 465 
 466           mowse_info_ptr -> mowse_info.local_cat (cap_index).flags.reset
 467                = "0"b;
 468           mowse_info_ptr -> mowse_info.local_cat (cap_index).flags.suspended
 469                = "0"b;
 470           mowse_info_ptr -> mowse_info.local_cat (cap_index).flags.status
 471                = "0"b;
 472           mowse_info_ptr -> mowse_info.local_cat (cap_index).sleep_time
 473                = 0;
 474 
 475 /* : Initialize the mcb */
 476 
 477           p_mcb_ptr -> mcb.version = VERSION;
 478           p_mcb_ptr -> mcb.iocb_ptr = mowse_iocb_ptr;
 479           p_mcb_ptr -> mcb.major_capability = cap_num;
 480           p_mcb_ptr -> mcb.capability_name = p_capability_name;
 481           p_mcb_ptr -> mcb.entry_var = entry_point;
 482           p_mcb_ptr -> mcb.data_block_ptr = p_data_block_ptr;
 483 
 484           allocate in_space in (system_free_area)
 485                set (p_mcb_ptr -> mcb.inbuff);
 486           p_mcb_ptr -> mcb.inbuff_length
 487                =
 488                get_buff_length (p_inbuff_length, MINIMUM_BUFFER_SIZE,
 489                MAXIMUM_BUFFER_SIZE);
 490           p_mcb_ptr -> mcb.inbuff_position_index = 0;
 491           p_mcb_ptr -> mcb.inbuff_data_length = 0;
 492 
 493           p_mcb_ptr -> mcb.outbuff_length
 494                =
 495                get_buff_length (p_outbuff_length, MINIMUM_BUFFER_SIZE,
 496                MAXIMUM_BUFFER_SIZE);
 497 
 498           p_mcb_ptr -> mcb.outbuff_list_start = null;
 499           p_mcb_ptr -> mcb.outbuff_list_end = null;
 500           p_mcb_ptr -> mcb.mowse_info_ptr = mowse_info_ptr;
 501 
 502 /* : Send ADD_TO_REMOTE_CAT message to remote
 503      capability_number + capability_name (not padded) */
 504 
 505           alter_remote_cat_msg.major = byte (cap_index);
 506           alter_remote_cat_msg.major_name =
 507                substr (p_capability_name, 1, length (p_capability_name));
 508           call capability_$pack (REMOTE_SYSTEM, INTERNAL, destination,
 509                p_code);
 510           call send_msg_ (mowse_mcb_ptr, destination, ADD_TO_REMOTE_CAT,
 511                addr (alter_remote_cat_msg), length (p_capability_name) + 1,
 512                BG, p_code);
 513 
 514           if p_code ^= 0 then do;
 515                p_code = ws_error_$cant_create_instance;
 516                free p_mcb_ptr -> mcb;
 517                p_mcb_ptr = null;
 518                mowse_info_ptr -> mowse_info.local_cat (cap_index).mcb_ptr
 519                     = null;
 520           end;
 521 
 522           return;
 523 
 524 /*^L*/
 525 
 526 
 527 /* : *** Entry: destroy_instance - internal entry for ws_ *** */
 528 
 529 /* : ENTRY FUNCTION
 530 
 531 Remove all reference to the calling application from MOWSE.  This will include
 532 freeing all MOWSE associated buffers and control information blocks.
 533 */
 534 
 535 destroy_instance:
 536      entry (p_mcb_ptr, p_code);
 537 
 538           p_code = 0;
 539 
 540           call check_mcb_ptr (p_mcb_ptr, p_code);
 541           if p_code ^= 0 then
 542                return;
 543 
 544 /* : Get capability index */
 545           call capability_$unpack (sysid, cap_index,
 546                p_mcb_ptr -> mcb.major_capability, p_code);
 547 
 548 /* : Get mowse info pointer */
 549           mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
 550 
 551 /* : send DELETE_FROM_REMOTE_CAT message to remote system
 552      {capability_number} */
 553 
 554           alter_remote_cat_msg.major = byte (cap_index);
 555           call capability_$pack (REMOTE_SYSTEM, INTERNAL, destination,
 556                p_code);
 557 
 558           call send_msg_ (p_mcb_ptr, destination, DELETE_FROM_REMOTE_CAT,
 559                addr (alter_remote_cat_msg.major), 1, BG, p_code);
 560 
 561           if p_code ^= 0 then do;
 562                call fatal_mowse_trap_ (p_code);
 563                return;
 564           end;
 565 
 566 /* : Free message buffers and mcb */
 567 
 568           temp_buff_ptr = p_mcb_ptr -> mcb.inbuff;
 569           input_buffer_length = p_mcb_ptr -> mcb.inbuff_data_length;
 570           free input_buffer_data;
 571           temp_buff_ptr = null;
 572           p_mcb_ptr -> mcb.inbuff = null;
 573 
 574           call release_outbuffer_ (p_mcb_ptr);
 575 
 576           free p_mcb_ptr -> mcb;
 577           p_mcb_ptr = null;
 578           mowse_info_ptr -> mowse_info.local_cat (cap_index).mcb_ptr =
 579                null;
 580 
 581           p_code = 0;
 582           return;
 583 
 584 /*^L*/
 585 
 586 /* : *** Entry: disconnect_request - internal entry for ws_ *** */
 587 
 588 /* : ENTRY FUNCTION
 589 
 590 Request a disconnection to an application.
 591 */
 592 
 593 disconnect_request:
 594      entry (p_capability_number, p_mcb_ptr, p_code);
 595 
 596           p_code = 0;
 597 
 598           call check_mcb_ptr (p_mcb_ptr, p_code);
 599           if p_code ^= 0 then
 600                return;
 601 
 602 /* : check the capability_number */
 603 
 604           mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
 605           call verify_capability (mowse_info_ptr, p_capability_number, p_code);
 606           if p_code ^= 0 then
 607                return;
 608 
 609 /* : Send the REQUEST_DISCONNECT message */
 610 
 611           call send_msg_ (p_mcb_ptr, p_capability_number,
 612                REQUEST_DISCONNECT, null, 0, BG, p_code);
 613           if p_code ^= 0 then do;
 614                call fatal_mowse_trap_ (p_code);
 615                return;
 616           end;
 617 
 618           return;
 619 
 620 /*^L*/
 621 
 622 /* : *** Entry: disconnect_response - internal entry for ws_ *** */
 623 
 624 /* : ENTRY FUNCTION
 625 
 626 Allows some application to responds to a disconnect request from some
 627 application.
 628 */
 629 
 630 disconnect_response:
 631      entry (p_status, p_major, p_mcb_ptr, p_code);
 632 
 633           p_code = 0;
 634 
 635           call check_mcb_ptr (p_mcb_ptr, p_code);
 636           if p_code ^= 0 then
 637                return;
 638 
 639 /* : check the response to request */
 640 
 641           if (p_status ^= ACCEPT) & (p_status ^= REJECT) then do;
 642                p_code = ws_error_$invalid_connect_status;
 643                return;
 644           end;
 645 
 646 /* : verify that the capability for which the response is destined exists */
 647 
 648           mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
 649           call verify_capability (mowse_info_ptr, p_major, p_code);
 650           if p_code ^= 0 then
 651                return;
 652 
 653 /* : Send message containing response to requesting application */
 654 
 655           temp_char = byte (p_status);
 656           call send_msg_ (p_mcb_ptr, p_major, RESPONSE_DISCONNECT,
 657                addr (temp_char), 1, BG, p_code);
 658           if p_code ^= 0 then do;
 659                call fatal_mowse_trap_ (p_code);
 660                return;
 661           end;
 662 
 663           return;
 664 
 665 /*^L*/
 666 
 667 /* : *** Entry: execute_capability - internal entry for ws_ *** */
 668 
 669 /* ENTRY FUNCTION
 670 
 671 Executes a loaded capability locally or remotely.
 672 */
 673 
 674 execute_capability:
 675      entry (p_major, p_minor, p_data_ptr, p_data_len, p_mcb_ptr, p_code);
 676 
 677 /* : Look up major_capability number in the local and remote CAT tables. */
 678 
 679           p_code = 0;
 680 
 681           call check_mcb_ptr (p_mcb_ptr, p_code);
 682           if p_code ^= 0 then
 683                return;
 684 
 685           call capability_$unpack (sysid, major_num, p_major, p_code);
 686           if p_code ^= 0 then
 687                return;
 688 
 689 /* : Get mowse info pointer */
 690           mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
 691 
 692 /* : Check if minor is valid */
 693 
 694           if p_minor < MINIMUM_USER_MINOR | p_minor > MAXIMUM_USER_MINOR
 695           then do;
 696                p_code = ws_error_$invalid_minor_capability;
 697                return;
 698           end;
 699 
 700 /* : Check that the capability being executed exists */
 701 
 702           call verify_capability (mowse_info_ptr, p_major, p_code);
 703           if p_code ^= 0 then
 704                return;
 705 
 706 /* : Check if capability to be executed has been suspended or reset
 707      and the minor is not one of the dedicated (system)  minors.
 708      If it is then return ws_error_$suspended */
 709 
 710           if sysid = LOCAL_SYSTEM then do;
 711                if ((mowse_info_ptr
 712                     -> mowse_info.local_cat (major_num).flags.reset)
 713                     | (mowse_info_ptr
 714                     -> mowse_info.local_cat (major_num).flags.suspended)
 715                     & ^(p_minor < MINIMUM_USER_MINOR)) then do;
 716 
 717                     p_code = ws_error_$suspended;
 718                     return;
 719                end;
 720           end;
 721           else if
 722                ((mowse_info_ptr
 723                -> mowse_info.remote_cat (major_num).flags.reset)
 724                | (mowse_info_ptr
 725                -> mowse_info.remote_cat (major_num).flags.suspended)
 726                & ^(p_minor < MINIMUM_USER_MINOR)) then do;
 727 
 728                p_code = ws_error_$suspended;
 729                return;
 730           end;
 731 
 732 /* : Check if the capability is sleeping.
 733      - If it is then return ws_error_$sleeping */
 734 
 735           if sysid = LOCAL_SYSTEM then do;
 736                if (mowse_info_ptr
 737                     -> mowse_info.local_cat (major_num).sleep_time ^= 0)
 738                then do;
 739                     p_code = ws_error_$sleeping;
 740                     return;
 741                end;
 742           end;
 743           else if (mowse_info_ptr
 744                -> mowse_info.remote_cat (major_num).sleep_time ^= "0"b)
 745           then do;
 746                p_code = ws_error_$sleeping;
 747                return;
 748           end;
 749 
 750 /* : If the buffer is too small to handle that the information
 751      then return with p_code set to ws_error_$buffer_overflow
 752      OR if the message to be sent is long and there is a pending message in
 753      the outbuffer, return buffer overflow because protocol will not allow for
 754      more than one pending message */
 755 
 756           if p_data_len > p_mcb_ptr -> mcb.outbuff_length
 757                | (p_data_len > PACKET_SIZE - 6
 758                & p_mcb_ptr -> mcb.outbuff_list_start ^= null)
 759           then do;
 760                p_code = ws_error_$buffer_overflow;
 761                return;
 762           end;
 763 
 764 /* : Send message to the capability to be executed */
 765 
 766           call send_msg_ (p_mcb_ptr, p_major, p_minor, p_data_ptr,
 767                p_data_len, BG, p_code);
 768           if p_code ^= 0 then do;
 769                call fatal_mowse_trap_ (p_code);
 770                return;
 771           end;
 772 
 773           return;
 774 
 775 /*^L*/
 776 
 777 /* : *** Entry: execute_command - internal entry for ws_ *** */
 778 
 779 /* ENTRY FUNCTION
 780 
 781 Performs the execution of a command on either the remote or local systems.
 782 */
 783 
 784 execute_command:
 785      entry (p_command, p_system, p_cmd_id, p_mcb_ptr, p_code);
 786 
 787           p_code = 0;
 788 
 789           call check_mcb_ptr (p_mcb_ptr, p_code);
 790           if p_code ^= 0 then
 791                return;
 792 
 793 /* : Check for valid system */
 794           if p_system ^= LOCAL_SYSTEM & p_system ^= REMOTE_SYSTEM then do;
 795                p_code = ws_error_$invalid_system_id;
 796                return;
 797           end;
 798 
 799 /* : Get mowse_info_ptr */
 800           mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
 801 
 802 /* : Check for command which are too long */
 803           if length (p_command) > PACKET_SIZE - 2 then do;
 804                p_code = ws_error_$buffer_overflow;
 805                return;
 806           end;
 807 
 808 /* : Generate unique command identification number. */
 809           p_cmd_id = CMD_ID_CNT;
 810           CMD_ID_CNT = CMD_ID_CNT + 1;
 811 
 812 /* : If the system was local then execute command locally */
 813           if p_system = LOCAL_SYSTEM then
 814                call capability_$pack (LOCAL_SYSTEM, INTERNAL, destination,
 815                     p_code);
 816           else
 817                call capability_$pack (REMOTE_SYSTEM, INTERNAL, destination,
 818                     p_code);
 819           if p_code ^= 0 then
 820                return;
 821 
 822 /* : formulate message to be sent to remote or local mowse internal */
 823 
 824           first_byte = round ((p_cmd_id / 256), 0);
 825           message_str =
 826                byte (first_byte)
 827                || byte ((p_cmd_id - (first_byte * 256))) || p_command;
 828 
 829 /* : send message to destination */
 830           call send_msg_ (p_mcb_ptr, destination, EXECUTE_COMMAND,
 831                addr (message_str), length (p_command) + 2, BG, p_code);
 832           if p_code ^= 0 then do;
 833                call fatal_mowse_trap_ (p_code);
 834                return;
 835           end;
 836 
 837           return;
 838 
 839 /*^L*/
 840 
 841 /* : *** Entry: find_capability_name - internal entry for ws_ *** */
 842 
 843 /* : ENTRY FUNCTION
 844 
 845 Find the name of a capability given its major capability number.
 846 */
 847 
 848 find_capability_name:
 849      entry (p_major, p_capability_name, p_code);
 850 
 851           p_code = 0;
 852 
 853           call find_mowse_io_ (mowse_iocb_ptr, p_code);
 854           if p_code ^= 0 then
 855                return;
 856 
 857           mio_info.version = mowse_io_info_version_1;
 858           call iox_$control (mowse_iocb_ptr, "get_mowse_info",
 859                addr (mio_info), p_code);
 860           if p_code ^= 0 then
 861                return;
 862           mowse_info_ptr = mio_info.info_ptr;
 863           if mowse_info_ptr = null then
 864                call null_mowse_info_handler ();
 865 
 866 /* : Extract the system id and CAT index */
 867 
 868           call capability_$unpack (sysid, cap_num, p_major, p_code);
 869           if (p_code ^= 0) then do;
 870                p_code = ws_error_$invalid_capability_number;
 871                return;
 872           end;
 873 
 874 /* : If system is LOCAL_SYSTEM then
 875      - Check for validity
 876      - Invalid CAT index or inactive mcb return invalid_capability_number */
 877 
 878           if (sysid = LOCAL_SYSTEM) then do;
 879                if (cap_num < MINIMUM_CAT_ENTRY)
 880                     | (cap_num > MAXIMUM_CAT_ENTRY) then do;
 881                     p_code = ws_error_$invalid_capability_number;
 882                     return;
 883                end;
 884 
 885                if (mowse_info_ptr
 886                     -> mowse_info.local_cat (cap_num).mcb_ptr = null)
 887                then do;
 888                     p_code = ws_error_$invalid_capability_number;
 889                     return;
 890                end;
 891 
 892 /* : get the name */
 893 
 894                p_capability_name =
 895                     mowse_info_ptr
 896                     -> mowse_info.local_cat (cap_num).mcb_ptr
 897                     -> mcb.capability_name;
 898                return;
 899           end;
 900 
 901 /* : Else search remote CAT */
 902 
 903           i = cap_num;
 904           do while ((i < MAXIMUM_CAT_ENTRY + 1) &
 905                (mowse_info_ptr
 906                -> mowse_info.remote_cat (i).major_capability ^= p_major));
 907                i = i + 1;
 908           end;
 909 
 910 /* : if not found or inactive return invalid_capability_number */
 911           if (i > MAXIMUM_CAT_ENTRY) then do;
 912                p_code = ws_error_$invalid_capability_number;
 913                return;
 914           end;
 915 
 916 /* : Otherwise, return the name */
 917           p_capability_name =
 918                mowse_info_ptr
 919                -> mowse_info.remote_cat (i).capability_name;
 920           p_code = 0;
 921           return;
 922 
 923 /*^L*/
 924 
 925 /* : *** Entry: find_capability_number - internal entry for ws_ *** */
 926 
 927 /* : ENTRY FUNCTION
 928 
 929 Find the major capability number of an application given a capability name.
 930 */
 931 
 932 /* : NOTES
 933 
 934 MOWSE looks for the capability name in its capability table in the following
 935 fashion:
 936             1) If the provided major capability number is invalid,
 937             MOWSE will begin searching from the top of the specified system
 938             table.
 939             2) If the major capability number is valid, MOWSE will
 940             begin searching from the next entry in the table specified by
 941             the system.
 942 */
 943 
 944 find_capability_number:
 945      entry (p_capability_name, p_system, p_major, p_code);
 946 
 947           p_code = 0;
 948 
 949 /* : Make sure requested system is acceptable */
 950 
 951           if p_system ^= LOCAL_SYSTEM & p_system ^= REMOTE_SYSTEM then do;
 952                p_code = ws_error_$invalid_system_id;
 953                return;
 954           end;
 955 
 956 /* : Get MOWSE information for CATs */
 957 
 958           call find_mowse_io_ (mowse_iocb_ptr, p_code);
 959           if p_code ^= 0 then
 960                return;
 961 
 962           mio_info.version = mowse_io_info_version_1;
 963           call iox_$control (mowse_iocb_ptr, "get_mowse_info",
 964                addr (mio_info), p_code);
 965           if p_code ^= 0 then
 966                return;
 967 
 968           mowse_info_ptr = mio_info.info_ptr;
 969           if mowse_info_ptr = null then
 970                call null_mowse_info_handler ();
 971 
 972           call capability_$unpack (sysid, cap_index, p_major, p_code);
 973           if p_code ^= 0 then
 974                cap_index = MINIMUM_CAT_ENTRY - 1;
 975 
 976 /* : Search through the CAT specified by the system id sequentially */
 977 
 978           p_code = 0;
 979           do cap_index = cap_index + 1 to MAXIMUM_CAT_ENTRY;
 980                if p_system = LOCAL_SYSTEM then do;
 981                     if mowse_info_ptr
 982                          -> mowse_info.local_cat (cap_index).mcb_ptr
 983                          ^= null then do;
 984                          search_name =
 985                               mowse_info_ptr
 986                               -> mowse_info.local_cat (cap_index).mcb_ptr
 987                               -> mcb.capability_name;
 988                          temp_major =
 989                               mowse_info_ptr
 990                               -> mowse_info.local_cat (cap_index).mcb_ptr
 991                               -> mcb.major_capability;
 992                     end;
 993                     else
 994                          search_name = "";
 995                end;
 996                else do;
 997                     search_name =
 998                          mowse_info_ptr
 999                          -> mowse_info.remote_cat (cap_index)
1000                          .capability_name;
1001                     temp_major =
1002                          mowse_info_ptr
1003                          -> mowse_info.remote_cat (cap_index)
1004                          .major_capability;
1005                end;
1006 
1007                if p_capability_name = rtrim (search_name) then do;
1008                     p_major = temp_major;
1009                     return;
1010                end;
1011           end;
1012 
1013 /* : Nothing was found, return invalid_capability_name */
1014 
1015           p_code = ws_error_$invalid_capability_name;
1016           return;
1017 
1018 /*^L*/
1019 
1020 /* : *** Entry: get_background_message - internal entry for ws_ *** */
1021 
1022 /* : ENTRY FUNCTION
1023 
1024 This entry point include for consistency with MTB741 but can never be used
1025 in this implementatiuon of MOWSE
1026 
1027 NOT AVAILABLE (Can only be use by foreground applications. This implementation
1028 of mowse does not support such applications.
1029 */
1030 
1031 get_background_message:
1032      entry (p_reply_string, p_code);
1033           p_code = ws_error_$not_available;
1034           return;
1035 
1036 /*^L*/
1037 
1038 /* : *** Entry: get_status - internal entry for ws_ *** */
1039 
1040 
1041 /* : ENTRY FUNCTION
1042 
1043 Request status information from a specified applicatiion. Since this can only
1044 be called from a foreground application and MOWSE is not able to support such
1045 applications this function need not be inplemented.  It will return an error
1046 code (ws_error_$not_available) if called.
1047 */
1048 
1049 get_status:
1050      entry (p_major, p_status_request, p_status_result, p_code);
1051           p_code = ws_error_$not_available;
1052           return;
1053 
1054 /*^L*/
1055 
1056 /* : *** Entry: put_background_message - internal entry for ws_ *** */
1057 
1058 /* : ENTRY FUNCTION
1059 
1060 Provides a background application with the means of displaying one of two
1061 types of messages through the foreground channel to a foreground application.
1062 */
1063 
1064 
1065 /* : NOTES
1066 
1067 p_code is one of the following:
1068 
1069      0 -- indicating that the background message consist only of the
1070           contents of the control_string.
1071 
1072      SEND_QUERY -- indicating that the control string will be used as a
1073           prompt requiring user INPUT.
1074 
1075      A standard Multics error code -- indicating that the background message
1076           will consist of the converted error code to com_err_ format of
1077           message
1078 */
1079 
1080 put_background_message:
1081      entry options (variable);
1082 
1083 /* : Find the number of arguments passed to this routine */
1084 
1085           errcode = 0;
1086           call cu_$arg_count (arg_count, errcode);
1087 
1088 /* : If the number of arguments is less than 3 then return */
1089 
1090           if arg_count < 3 then
1091                return;
1092 
1093 /* : Get the first argument (mcb_ptr) and return if it is null */
1094 
1095           call cu_$arg_list_ptr (arg_list_ptr);
1096           call cu_$arg_ptr (1, arg_ptr, arg_len, errcode);
1097           if errcode ^= 0 then
1098                return;
1099           if arg_ptr -> based_mcb_ptr = null then
1100                return;
1101           temp_mcb_ptr = arg_ptr -> based_mcb_ptr;
1102 
1103 /* : Check mcb_ptr */
1104 
1105           call check_mcb_ptr (temp_mcb_ptr, ecode);
1106           if ecode ^= 0 then
1107                return;
1108 
1109 /* : Get mowse info pointer */
1110 
1111           mowse_info_ptr = temp_mcb_ptr -> mcb.mowse_info_ptr;
1112 
1113 /* : Get the second argument (code) and perform the following
1114      assignment:
1115         code = 0          minor = PUT_TO_BACKGROUND_BUFFER
1116         code = SEND_QUERY minor = PUT_TO_QUERY_MESSAGE_BUFFER
1117         otherwise         minor = -1 */
1118 
1119           call cu_$arg_ptr (2, arg_ptr, arg_len, errcode);
1120           if errcode ^= 0 then
1121                return;
1122           ecode = arg_ptr -> based_code;
1123 
1124           if ecode = 0 then
1125                minor_num = PUT_TO_BACKGROUND_BUFFER;
1126           else if ecode = SEND_QUERY then
1127                minor_num = PUT_TO_QUERY_MESSAGE_BUFFER;
1128           else
1129                minor_num = -1;
1130 
1131 /* : get caller's name */
1132 
1133           call cu_$arg_ptr (3, arg_ptr, arg_len, errcode);
1134           if errcode ^= 0 then
1135                return;
1136           caller_name = arg_ptr -> based_caller_name;
1137           caller_name_length = min (arg_len, MAXIMUM_BG_SIZE);
1138 
1139           formatted_string_length = 0;
1140           longinfo_length = 0;
1141 
1142 /* : create destination = remote_system|internal */
1143 
1144           call capability_$pack (REMOTE_SYSTEM, INTERNAL, destination,
1145                errcode);
1146           if errcode ^= 0 then
1147                return;
1148 
1149 /* : If minor = PUT_TO_BACKGROUND_BUFFER then
1150      - if there is a fourth variable (control_string) get it.
1151      -- create a formatted string */
1152 
1153           if minor_num = PUT_TO_BACKGROUND_BUFFER then
1154                if arg_count >= 4 then do;
1155                     call ioa_$general_rs (arg_list_ptr, 4, 5,
1156                          formatted_string, arg_len, "0"b, "0"b);
1157                     formatted_string_length =
1158                          min (arg_len, MAXIMUM_BG_SIZE);
1159                end;
1160 
1161 /* : If minor = PUT_TO_QUERY_MESSAGE_BUFFER then
1162      - if the control string argument is present then
1163      -- generate the formatted string. */
1164 
1165           if minor_num = PUT_TO_QUERY_MESSAGE_BUFFER then
1166                if arg_count > 3 then do;
1167                     call ioa_$general_rs (arg_list_ptr, 4, 5,
1168                          formatted_string, arg_len, "0"b, "0"b);
1169                     formatted_string_length =
1170                          min (arg_len, MAXIMUM_BG_SIZE);
1171                end;
1172 
1173 /* : If minor = -1 then
1174      - convert the error code to a error string.
1175      - if a control string is present then
1176      -- convert it to a formatted string. */
1177 
1178           if minor_num = -1 then do;
1179                minor_num = PUT_TO_BACKGROUND_BUFFER;
1180                call com_err_$convert_status_code_ (ecode, shortinfo,
1181                     longinfo);
1182                do longinfo_length = length (longinfo) by -1 to 1
1183                     while (substr (longinfo, longinfo_length, 1) = " ");
1184                end;
1185 
1186                if arg_count > 3 then do;
1187                     call ioa_$general_rs (arg_list_ptr, 4, 5,
1188                          formatted_string, arg_len, "0"b, "0"b);
1189                     formatted_string_length = min (arg_len, MAXIMUM_BG_SIZE);
1190                end;
1191           end;
1192 
1193 /* : Concatenate "caller_name: longinfo formatted_string"
1194      send the message */
1195 
1196           result_string =
1197                substr (caller_name, 1, caller_name_length)
1198                || ": "
1199                || substr (longinfo, 1, longinfo_length)
1200                || " "
1201                || substr (formatted_string, 1, formatted_string_length);
1202           result_string_length =
1203                min (caller_name_length + longinfo_length
1204                + formatted_string_length + 3, MAXIMUM_BG_SIZE);
1205           call send_bg (temp_mcb_ptr, destination, minor_num,
1206                addr (result_string), result_string_length, FG, errcode);
1207 
1208           return;
1209 
1210 /*^L*/
1211 
1212 /* : *** Entry: put_status - internal entry for ws_ *** */
1213 
1214 /* : ENTRY FUNCTION
1215 
1216 Send status information to the capability application requesting it.
1217 */
1218 
1219 put_status:
1220      entry (p_major, p_status_result, p_mcb_ptr, p_code);
1221 
1222 /* : check the mcb pointer */
1223 
1224           call check_mcb_ptr (p_mcb_ptr, p_code);
1225           if p_code ^= 0 then
1226                return;
1227 
1228 /* : Get mowse info pointer */
1229 
1230           mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
1231 
1232 /* : unpack and check the major capability given as input */
1233 
1234           call capability_$unpack (sysid, major_num, p_major, p_code);
1235           if p_code ^= 0 then
1236                return;
1237 
1238 /* : Verify that the capability for which the status is destined exists */
1239 
1240           call verify_capability (mowse_info_ptr, p_major, p_code);
1241           if p_code ^= 0 then
1242                return;
1243 
1244 /* : The maximum size which may be sent is one packet */
1245 
1246           formatted_string_length =
1247                min ((length (p_status_result)), MAXIMUM_PACKET_SIZE);
1248 
1249 /* : Send status reply messsage */
1250 
1251           call send_msg_ (p_mcb_ptr, p_major, STATUS_REPLY,
1252                addr (p_status_result), formatted_string_length, FG,
1253                p_code);
1254           if p_code ^= 0 then do;
1255                call fatal_mowse_trap_ (p_code);
1256                return;
1257           end;
1258 
1259           return;
1260 
1261 /*^L*/
1262 
1263 /* : *** Entry: reset_capability - internal entry for ws_ *** */
1264 
1265 /* : ENTRY FUNCTION
1266 
1267 Resetting a capability on a remote or local system.
1268 */
1269 
1270 reset_capability:
1271      entry (p_major, p_mcb_ptr, p_code);
1272 
1273 /* : Check the mcb_ptr */
1274 
1275           call check_mcb_ptr (p_mcb_ptr, p_code);
1276           if p_code ^= 0 then
1277                return;
1278 
1279 /* : Get mowse info pointer */
1280 
1281           mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
1282 
1283 /* : Set reset flag of application issuing this call to prevent
1284      any messages destined for the aplication from being sent
1285      to it. */
1286 
1287           call capability_$unpack (sysid, major_num,
1288                p_mcb_ptr -> mcb.major_capability, p_code);
1289           if p_code ^= 0 then
1290                return;
1291 
1292 /* : if application on remote system then set the remote reset flag */
1293 
1294           if sysid = REMOTE_SYSTEM then
1295                mowse_info_ptr -> mowse_info.remote_cat (major_num).flags.reset
1296                     = TRUE;
1297           else
1298                mowse_info_ptr -> mowse_info.local_cat (major_num).flags.reset
1299                     = TRUE;
1300 
1301 /* : send a RESET_APPLICATION message  */
1302 
1303           call send_msg_ (p_mcb_ptr, p_major, RESET_APPLICATION, null, 0,
1304                BG, p_code);
1305           if p_code ^= 0 then do;
1306                call fatal_mowse_trap_ (p_code);
1307                return;
1308           end;
1309 
1310           return;
1311 
1312 /*^L*/
1313 
1314 /* : *** Entry: resume_capability - internal entry for ws_ *** */
1315 
1316 /* : ENTRY FUNCTION
1317 
1318 Tells MOWSE to resume a specified application
1319 */
1320 
1321 /* : NOTES
1322 
1323 "major" identifies both the capability and the system on which it is running.
1324 */
1325 
1326 resume_capability:
1327      entry (p_major, p_mcb_ptr, p_code);
1328 
1329           p_code = 0;
1330 
1331 /* : Check mcb_ptr */
1332 
1333           call check_mcb_ptr (p_mcb_ptr, p_code);
1334           if p_code ^= 0 then
1335                return;
1336 
1337 /* : Get mowse info pointer */
1338 
1339           mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
1340           call capability_$unpack (source_system, source_major,
1341                p_mcb_ptr -> mcb.major_capability, p_code);
1342           if p_code ^= 0 then
1343                return;
1344 
1345 /* : Unpack the major capability into a system and capability number. */
1346 
1347           call capability_$unpack (sysid, major_num, p_major, p_code);
1348           if p_code ^= 0 then
1349                return;
1350 
1351 /* : Check if capability is suspended */
1352 
1353           if sysid = LOCAL_SYSTEM then do;
1354                if ^mowse_info_ptr
1355                     -> mowse_info.local_cat (major_num).flags.suspended then
1356 
1357                     p_code = ws_error_$not_suspended;
1358           end;
1359           else if sysid = REMOTE_SYSTEM then do;
1360                if ^mowse_info_ptr
1361                     -> mowse_info.remote_cat (major_num).flags.suspended then
1362 
1363                     p_code = ws_error_$not_suspended;
1364 
1365                mowse_info_ptr
1366                     -> mowse_info.remote_cat (major_num).flags.suspended
1367                     = FALSE;
1368           end;
1369           else
1370                p_code = ws_error_$invalid_system_id;
1371 
1372           if p_code ^= 0 then
1373                return;
1374 
1375 /* : - Call the application via the predefined minor capability
1376      - RESUME_APPLICATION by sending a message */
1377 
1378           call send_msg_ (p_mcb_ptr, p_major, RESUME_APPLICATION, null,
1379                0, BG, p_code);
1380           if p_code ^= 0 then do;
1381                call fatal_mowse_trap_ (p_code);
1382                return;
1383           end;
1384 
1385 /* : If resuming a capability on the local system, send a RESET_SUSPEND to
1386      the remote */
1387 
1388           if sysid = LOCAL_SYSTEM then do;
1389                call capability_$pack (REMOTE_SYSTEM, INTERNAL,
1390                     temp_major, (0));
1391                call send_mowse_message_ (p_mcb_ptr, LOCAL_SYSTEM, major_num,
1392                     REMOTE_SYSTEM, INTERNAL, RESET_SUSPEND, LAST, null, 0, BG,
1393                     p_code);
1394           end;
1395           return;
1396 
1397 /*^L*/
1398 
1399 /* : *** Entry: send_query_reply - internal entry for ws_ *** */
1400 
1401 /* : ENTRY FUNCTION
1402 
1403 NOT AVAILABLE.
1404 */
1405 
1406 send_query_reply:
1407      entry (p_reply_string, p_major, p_code);
1408           p_code = ws_error_$not_available;
1409           return;
1410 
1411 /*^L*/
1412 
1413 /* : *** Entry: sleep - internal entry for ws_ *** */
1414 
1415 /* : ENTRY FUNCTION
1416 
1417 Puts the caller to sleep (suspends it) for a given number of seconds.
1418 */
1419 
1420 sleep:
1421      entry (p_mcb_ptr, p_time, p_code);
1422 
1423           p_code = 0;
1424 
1425 /* : Check the mcb pointer */
1426 
1427           call check_mcb_ptr (p_mcb_ptr, p_code);
1428           if p_code ^= 0 then
1429                return;
1430 
1431 /* : Get mowse info pointer */
1432 
1433           mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
1434 
1435 /* : If the time requested is zero do nothing */
1436 
1437           if (p_time <= 0) then do;
1438                p_code = ws_error_$invalid_sleep_interval;
1439                return;
1440           end;
1441 
1442 /* : Allocate control order structure, fill it with the required infomation
1443      and issue a control order to start application sleeping. */
1444 
1445           call capability_$unpack (sysid, major_num,
1446                p_mcb_ptr -> mcb.major_capability, p_code);
1447           if p_code ^= 0 then do;
1448                call fatal_mowse_trap_ (p_code);
1449                return;
1450           end;
1451 
1452           mio_sleep.version = mowse_io_info_version_1;
1453           mio_sleep.major_index = major_num;
1454           mio_sleep.sleep_seconds = p_time;
1455           call iox_$control (p_mcb_ptr -> mcb.iocb_ptr, "put_to_sleep",
1456                addr (mio_sleep), p_code);
1457           if p_code ^= 0 then
1458                return;
1459 
1460 /* : Send message to remote system telling it to update the remote
1461      CAT table entry for this application. */
1462 
1463           call capability_$pack (REMOTE_SYSTEM, INTERNAL, destination,
1464                p_code);
1465           if p_code ^= 0 then do;
1466                call fatal_mowse_trap_ (p_code);
1467                return;
1468           end;
1469 
1470           call send_msg_ (p_mcb_ptr, destination, SET_SLEEP_FLAG, null,
1471                0, BG, p_code);
1472 
1473           mowse_info_ptr -> mowse_info.local_cat (major_num).sleep_time =
1474                p_time;
1475 
1476           return;
1477 
1478 /*^L*/
1479 
1480 /* : *** Entry: suspend_capability - internal entry for ws_ *** */
1481 
1482 /* : ENTRY FUNCTION
1483 
1484 Tells MOWSE to suspend a given application.
1485 */
1486 
1487 /* : NOTES
1488 
1489 "major" identifies both the capability and the system on which it is running.
1490 */
1491 
1492 suspend_capability:
1493      entry (p_major, p_mcb_ptr, p_code);
1494 
1495           p_code = 0;
1496 
1497 /* : Check mcb_ptr */
1498 
1499           call check_mcb_ptr (p_mcb_ptr, p_code);
1500           if p_code ^= 0 then
1501                return;
1502 
1503 /* : Get capability number and sytem id of capability to suspend */
1504 
1505           call capability_$unpack (sysid, major_num, p_major, p_code);
1506           if p_code ^= 0 then
1507                return;
1508 
1509 /* : Get mowse info pointer */
1510 
1511           mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
1512           if mowse_info_ptr = null then do;
1513                p_code = ws_error_$invalid_mcb;
1514                return;
1515           end;
1516 
1517 /* : Check if the capability is not already suspended */
1518 
1519           if sysid = LOCAL_SYSTEM then do;
1520                if mowse_info_ptr
1521                     -> mowse_info.local_cat (major_num).flags.suspended then
1522 
1523                     p_code = ws_error_$suspended;
1524           end;
1525           else if sysid = REMOTE_SYSTEM then do;
1526                if mowse_info_ptr
1527                     -> mowse_info.remote_cat (major_num).flags.suspended then
1528 
1529                     p_code = ws_error_$suspended;
1530 
1531                mowse_info_ptr
1532                     -> mowse_info.remote_cat (major_num).flags.suspended
1533                     = TRUE;
1534           end;
1535           else
1536                p_code = ws_error_$invalid_system_id;
1537 
1538           if p_code ^= 0 then
1539                return;
1540 
1541 /* : - Call the application with the predefined minor capability
1542        SUSPEND_APPLICATION by sending a message */
1543 
1544           call send_msg_ (p_mcb_ptr, p_major, SUSPEND_APPLICATION, null, 0,
1545                BG, p_code);
1546           if p_code ^= 0 then do;
1547                call fatal_mowse_trap_ (p_code);
1548                return;
1549           end;
1550 
1551 /* : If suspending a capability on the local system, send a SET_SUSPEND to
1552      the remote */
1553 
1554           if sysid = LOCAL_SYSTEM then do;
1555                call capability_$pack (REMOTE_SYSTEM, INTERNAL,
1556                     temp_major, (0));
1557                call send_mowse_message_ (p_mcb_ptr, LOCAL_SYSTEM, major_num,
1558                     REMOTE_SYSTEM, INTERNAL, SET_SUSPEND, LAST, null, 0, BG,
1559                     p_code);
1560           end;
1561           return;
1562 
1563 /*^L*/
1564 
1565 /* : *** Entry: terminate_capability - internal entry for ws_ *** */
1566 
1567 
1568 /* ENTRY FUNCTION
1569 
1570 Tells MOWSE to terminate a specified application MOWSE directs an application
1571 to terminate itself.
1572 */
1573 
1574 terminate_capability:
1575      entry (p_major, p_mcb_ptr, p_code);
1576 
1577           p_code = 0;
1578           call check_mcb_ptr (p_mcb_ptr, p_code);
1579           if p_code ^= 0 then
1580                return;
1581 
1582 /* : Unpack the major capability into major capability number and system
1583      id. */
1584 
1585           call capability_$unpack (sysid, cap_num, p_major, p_code);
1586           if p_code ^= 0 then
1587                return;
1588 
1589 /* : Get mowse info pointer */
1590 
1591           mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
1592 
1593           call verify_capability (mowse_info_ptr, p_major, p_code);
1594           if p_code ^= 0 then
1595                return;
1596 
1597 /* : If system id is LOCAL_SYSTEM or REMOTE_SYSTEM then
1598      - call the capability with minor capability TERMINATE_APPLICATION */
1599 
1600           call send_msg_ (p_mcb_ptr, p_major, TERMINATE_APPLICATION,
1601                null, 0, BG, p_code);
1602           if p_code ^= 0 then do;
1603                call fatal_mowse_trap_ (p_code);
1604                return;
1605           end;
1606 
1607           return;
1608 
1609 /*^L*/
1610 
1611 /* INTERNAL PROCEDURES */
1612 
1613 
1614 /* *** Procedure: send_bg - Internal proc for COMMENTS  *** */
1615 
1616 
1617 send_bg:
1618      proc (p_mcb_ptr, p_major, p_minor, p_data_ptr, p_data_len, p_channel,
1619           p_code);
1620 
1621 /* : PROCEDURE FUNCTION
1622 
1623 Split a background message into pieces in the event that the message is
1624 greater than on mowse_io_ packet worth.
1625 */
1626 
1627 /* INPUT PARAMETERS */
1628 dcl p_channel              fixed bin;                 /* Message channel */
1629 dcl p_code                 fixed bin (35) parameter;
1630 dcl p_data_len             fixed bin parameter;       /* Length of data */
1631 dcl p_data_ptr             ptr parameter;             /* Data to send */
1632 dcl p_major                fixed bin parameter;       /* Destination major */
1633 dcl p_minor                fixed bin parameter;       /* Destination minor */
1634 dcl p_mcb_ptr              ptr parameter;             /* caller's mcb */
1635 
1636 
1637 /* MISC VARIABLES */
1638 dcl data_length            fixed bin;                 /* Length of partial message */
1639 dcl send_data_pos          fixed bin;                 /* Current position in send_data */
1640 dcl send_data              char (p_data_len);
1641 dcl data_overlay           char (p_data_len) based (p_data_ptr);
1642 
1643 
1644 /* INITIALIZATION */
1645           send_data_pos = 1;
1646 
1647           do while (send_data_pos <= p_data_len);
1648                data_length =
1649                     min (p_data_len - send_data_pos + 1, MAXIMUM_PACKET_SIZE);
1650                send_data = substr (data_overlay, send_data_pos, data_length);
1651                send_data_pos = send_data_pos + data_length;
1652 
1653                call send_msg_ (p_mcb_ptr, p_major, p_minor, addr (send_data),
1654                     data_length, FG, p_code);
1655                if p_code ^= 0 then do;
1656                     call fatal_mowse_trap_ (p_code);
1657                     return;
1658                end;
1659           end;
1660      end send_bg;
1661 
1662 /*^L*/
1663 
1664 /* : *** Procedure: check_mcb_ptr - internal proc for ws_ *** */
1665 
1666 /* : PROCEDURE FUNCTION
1667 
1668 Check the mcb_ptr to ensure that it is valid and that the major capability
1669 it contains is valid
1670 */
1671 
1672 check_mcb_ptr:
1673      proc (p_mcb_ptr, p_code);
1674 
1675 /* INPUT PARAMETER */
1676 dcl p_mcb_ptr              ptr;
1677 
1678 /* OUTPUT PARAMETERS */
1679 dcl p_code                 fixed bin (35);
1680 
1681 /* MISC VARIABLES */
1682 dcl code                   fixed bin (35);
1683 dcl system                 fixed bin;
1684 dcl major                  fixed bin;
1685 
1686 
1687           p_code = ws_error_$invalid_mcb;
1688           if p_mcb_ptr = null then
1689                return;
1690 
1691           if p_mcb_ptr -> mcb.version ^= VERSION then do;
1692                p_code = error_table_$unimplemented_version;
1693                return;
1694           end;
1695 
1696           mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
1697           if mowse_info_ptr = null then
1698                return;
1699 
1700           call capability_$unpack (system, major,
1701                p_mcb_ptr -> mcb.major_capability, code);
1702           if code ^= 0 then
1703                return;
1704           if system ^= LOCAL_SYSTEM then
1705                return;
1706           if major = INTERNAL then do;
1707                search_name = "internal_mowse_";
1708                if p_mcb_ptr -> mcb.capability_name ^= search_name then
1709                     return;
1710                p_code = 0;
1711                return;
1712           end;
1713           if mowse_info_ptr -> mowse_info.local_cat (major).mcb_ptr
1714                ^= p_mcb_ptr then
1715                return;
1716           p_code = 0;
1717      end check_mcb_ptr;
1718 
1719 /*^L*/
1720 
1721 /* : *** Procedure: get_buff_length - internal procedure for ws_ *** */
1722 
1723 /* : PROCEDURE FUNCTION
1724 
1725 Returns a valid buffer length in case the one the user passed is out of
1726 bounds.
1727 */
1728 
1729 get_buff_length:
1730      proc (length, min, max) returns (fixed bin (17));
1731 
1732 /* INPUT PARAMETERS */
1733 dcl length                 fixed bin (17);
1734 dcl min                    fixed bin (17);
1735 dcl max                    fixed bin (17);
1736 
1737           if (length < min) then
1738                return (min);
1739           else if (length > max) then
1740                return (max);
1741           else
1742                return (length);
1743 
1744      end get_buff_length;
1745 
1746 /*^L*/
1747 
1748 /* : *** Procedure: null_mowse_info_handler.  Internal procedure for ws_ *** */
1749 
1750 
1751 null_mowse_info_handler:
1752      proc ();
1753 
1754 /* : PROCEDURE FUNCTION
1755 
1756 Terminate the process as the MOWSE tables have disappeared, first tell
1757 mowse_io_ to close so that the PC can be told of the event.
1758 */
1759 
1760 /* : NOTES
1761 */
1762 
1763 /* INPUT PARAMETERS */
1764 
1765 /* OUTPUT PARAMETERS */
1766 
1767 /* MISC VARIABLES */
1768 dcl mowse_iocb_ptr         ptr;                       /* mowse_io_ iocb */
1769 dcl 01 fatal_error_info    aligned,
1770        02 version          fixed bin,                 /* Must be 0 */
1771        02 status_code      fixed bin (35);            /* Error code to terminate_process_ */
1772 
1773 /* INITIALIZATION */
1774 
1775           call find_mowse_io_ (mowse_iocb_ptr, (0));
1776           call iox_$close (mowse_iocb_ptr, (0));
1777 
1778           fatal_error_info.version = 0;
1779           fatal_error_info.status_code = error_table_$no_table;
1780           call terminate_process_ ("fatal_error", addr (fatal_error_info));
1781 
1782      end null_mowse_info_handler;
1783 
1784 /*^L*/
1785 
1786 /* : *** Procedure: verify_capability.  Internal procedure for ws_ *** */
1787 
1788 
1789 verify_capability:
1790      proc (p_mowse_info_ptr, p_capability_id, p_code);
1791 
1792 /* : PROCEDURE FUNCTION
1793 
1794 Verify that a capability exists by checking the respective CAT table
1795 */
1796 
1797 /* : NOTES
1798 */
1799 
1800 /* INPUT PARAMETERS */
1801 dcl p_mowse_info_ptr       ptr;
1802 dcl p_capability_id        fixed bin (17);
1803 
1804 /* OUTPUT PARAMETERS */
1805 dcl p_code                 fixed bin (35);
1806 
1807 /* MISC VARIABLES */
1808 dcl system_id              fixed bin (17);
1809 dcl capability_number      fixed bin (17);
1810 
1811 
1812           p_code = 0;
1813 
1814           if p_mowse_info_ptr = null then do;
1815                p_code = ws_error_$invalid_capability_number;
1816                return;
1817           end;
1818 
1819           call capability_$unpack (system_id, capability_number,
1820                p_capability_id, p_code);
1821           if p_code ^= 0 then
1822                return;
1823           if (system_id = LOCAL_SYSTEM) then do;
1824                call check_mcb_ptr ((p_mowse_info_ptr
1825                     -> mowse_info.local_cat (capability_number).mcb_ptr),
1826                     p_code);
1827                if p_code ^= 0 then do;
1828                     p_code = ws_error_$invalid_capability_number;
1829                     return;
1830                end;
1831           end;
1832           else if (system_id = REMOTE_SYSTEM) then do;
1833                if (p_mowse_info_ptr
1834                     -> mowse_info.remote_cat (capability_number).
1835                     major_capability = 0) then do;
1836                     p_code = ws_error_$invalid_capability_number;
1837                     return;
1838                end;
1839           end;
1840           else
1841                p_code = ws_error_$invalid_capability_number;
1842      end verify_capability;
1843 
1844 /*^L*/
1845 
1846 /* INCLUDE FILES */
1847 %include mowse_info;
1848 %include mowse;
1849 %include mowse_mcb;
1850 %include mowse_messages;
1851 %include mowse_io_control_info;
1852 %include access_mode_values;
1853      end ws_;