1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61 ws_:
62 proc ();
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
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
108 dcl p_cmd_id fixed bin (17) parameter;
109 dcl p_code fixed bin (35) parameter;
110
111
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);
121 dcl mowse_info_ptr ptr;
122 dcl temp_mcb_ptr ptr;
123 dcl temp_char char;
124 dcl minor_num fixed bin;
125 dcl first_byte fixed bin;
126 dcl longinfo_length fixed bin;
127 dcl longinfo char (100) aligned;
128 dcl shortinfo char (8) aligned;
129
130 dcl formatted_string char (MAXIMUM_BG_SIZE);
131 dcl formatted_string_length
132 fixed bin;
133 dcl result_string char (MAXIMUM_BG_SIZE);
134 dcl result_string_length fixed bin;
135
136 dcl arg_ptr ptr;
137 dcl arg_len fixed bin (21);
138 dcl caller_name_length fixed bin (21);
139 dcl based_caller_name char (32) based (arg_ptr);
140 dcl caller_name char (32);
141 dcl based_code fixed bin based (arg_ptr);
142 dcl based_mcb_ptr ptr based (arg_ptr);
143 dcl arg_list_ptr ptr;
144 dcl errcode fixed bin (35);
145 dcl arg_count fixed bin;
146 dcl system_free_area area based (system_free_area_ptr);
147
148 dcl system_free_area_ptr ptr;
149 dcl cap_index fixed bin (17);
150 dcl cap_num fixed bin (17);
151 dcl destination fixed bin (17);
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
159 dcl major_num fixed bin (17);
160 dcl message_str char (MAXIMUM_PACKET_SIZE);
161
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
168
169
170
171 dcl 01 mio_info like mowse_io_info automatic;
172
173 dcl 01 mio_sleep like mowse_io_sleep_info automatic;
174
175
176
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
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
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
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
246
247
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
258
259
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
267
268
269
270 return;
271
272
273
274
275
276
277
278
279
280
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
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
321
322
323
324
325
326
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
339
340 call capability_$unpack (sysid, major_num, p_major, p_code);
341 if p_code ^= 0 then
342 return;
343
344
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
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
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
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
405
406
407 call find_mowse_io_ (mowse_iocb_ptr, p_code);
408 if p_code ^= 0 then
409 return;
410
411
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
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
434
435 call find_free_cat_entry_ (mowse_info_ptr, cap_index, p_code);
436 if (p_code ^= 0) then
437 return;
438
439
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
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
455
456 system_free_area_ptr = get_system_free_area_ ();
457 allocate mcb in (system_free_area) set (p_mcb_ptr);
458
459
460
461 mowse_info_ptr -> mowse_info.local_cat (cap_index).mcb_ptr =
462 p_mcb_ptr;
463
464
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
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
503
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
525
526
527
528
529
530
531
532
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
545 call capability_$unpack (sysid, cap_index,
546 p_mcb_ptr -> mcb.major_capability, p_code);
547
548
549 mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
550
551
552
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
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
585
586
587
588
589
590
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
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
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
621
622
623
624
625
626
627
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
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
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
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
666
667
668
669
670
671
672
673
674 execute_capability:
675 entry (p_major, p_minor, p_data_ptr, p_data_len, p_mcb_ptr, p_code);
676
677
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
690 mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
691
692
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
701
702 call verify_capability (mowse_info_ptr, p_major, p_code);
703 if p_code ^= 0 then
704 return;
705
706
707
708
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
733
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
751
752
753
754
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
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
776
777
778
779
780
781
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
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
800 mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
801
802
803 if length (p_command) > PACKET_SIZE - 2 then do;
804 p_code = ws_error_$buffer_overflow;
805 return;
806 end;
807
808
809 p_cmd_id = CMD_ID_CNT;
810 CMD_ID_CNT = CMD_ID_CNT + 1;
811
812
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
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
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
840
841
842
843
844
845
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
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
875
876
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
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
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
911 if (i > MAXIMUM_CAT_ENTRY) then do;
912 p_code = ws_error_$invalid_capability_number;
913 return;
914 end;
915
916
917 p_capability_name =
918 mowse_info_ptr
919 -> mowse_info.remote_cat (i).capability_name;
920 p_code = 0;
921 return;
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944 find_capability_number:
945 entry (p_capability_name, p_system, p_major, p_code);
946
947 p_code = 0;
948
949
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
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
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
1014
1015 p_code = ws_error_$invalid_capability_name;
1016 return;
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031 get_background_message:
1032 entry (p_reply_string, p_code);
1033 p_code = ws_error_$not_available;
1034 return;
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
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
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080 put_background_message:
1081 entry options (variable);
1082
1083
1084
1085 errcode = 0;
1086 call cu_$arg_count (arg_count, errcode);
1087
1088
1089
1090 if arg_count < 3 then
1091 return;
1092
1093
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
1104
1105 call check_mcb_ptr (temp_mcb_ptr, ecode);
1106 if ecode ^= 0 then
1107 return;
1108
1109
1110
1111 mowse_info_ptr = temp_mcb_ptr -> mcb.mowse_info_ptr;
1112
1113
1114
1115
1116
1117
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
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
1143
1144 call capability_$pack (REMOTE_SYSTEM, INTERNAL, destination,
1145 errcode);
1146 if errcode ^= 0 then
1147 return;
1148
1149
1150
1151
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
1162
1163
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
1174
1175
1176
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
1194
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
1211
1212
1213
1214
1215
1216
1217
1218
1219 put_status:
1220 entry (p_major, p_status_result, p_mcb_ptr, p_code);
1221
1222
1223
1224 call check_mcb_ptr (p_mcb_ptr, p_code);
1225 if p_code ^= 0 then
1226 return;
1227
1228
1229
1230 mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
1231
1232
1233
1234 call capability_$unpack (sysid, major_num, p_major, p_code);
1235 if p_code ^= 0 then
1236 return;
1237
1238
1239
1240 call verify_capability (mowse_info_ptr, p_major, p_code);
1241 if p_code ^= 0 then
1242 return;
1243
1244
1245
1246 formatted_string_length =
1247 min ((length (p_status_result)), MAXIMUM_PACKET_SIZE);
1248
1249
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
1262
1263
1264
1265
1266
1267
1268
1269
1270 reset_capability:
1271 entry (p_major, p_mcb_ptr, p_code);
1272
1273
1274
1275 call check_mcb_ptr (p_mcb_ptr, p_code);
1276 if p_code ^= 0 then
1277 return;
1278
1279
1280
1281 mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
1282
1283
1284
1285
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
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
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
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326 resume_capability:
1327 entry (p_major, p_mcb_ptr, p_code);
1328
1329 p_code = 0;
1330
1331
1332
1333 call check_mcb_ptr (p_mcb_ptr, p_code);
1334 if p_code ^= 0 then
1335 return;
1336
1337
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
1346
1347 call capability_$unpack (sysid, major_num, p_major, p_code);
1348 if p_code ^= 0 then
1349 return;
1350
1351
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
1376
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
1386
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
1398
1399
1400
1401
1402
1403
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
1412
1413
1414
1415
1416
1417
1418
1419
1420 sleep:
1421 entry (p_mcb_ptr, p_time, p_code);
1422
1423 p_code = 0;
1424
1425
1426
1427 call check_mcb_ptr (p_mcb_ptr, p_code);
1428 if p_code ^= 0 then
1429 return;
1430
1431
1432
1433 mowse_info_ptr = p_mcb_ptr -> mcb.mowse_info_ptr;
1434
1435
1436
1437 if (p_time <= 0) then do;
1438 p_code = ws_error_$invalid_sleep_interval;
1439 return;
1440 end;
1441
1442
1443
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
1461
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
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492 suspend_capability:
1493 entry (p_major, p_mcb_ptr, p_code);
1494
1495 p_code = 0;
1496
1497
1498
1499 call check_mcb_ptr (p_mcb_ptr, p_code);
1500 if p_code ^= 0 then
1501 return;
1502
1503
1504
1505 call capability_$unpack (sysid, major_num, p_major, p_code);
1506 if p_code ^= 0 then
1507 return;
1508
1509
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
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
1542
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
1552
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
1564
1565
1566
1567
1568
1569
1570
1571
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
1583
1584
1585 call capability_$unpack (sysid, cap_num, p_major, p_code);
1586 if p_code ^= 0 then
1587 return;
1588
1589
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
1598
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
1610
1611
1612
1613
1614
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
1622
1623
1624
1625
1626
1627
1628 dcl p_channel fixed bin;
1629 dcl p_code fixed bin (35) parameter;
1630 dcl p_data_len fixed bin parameter;
1631 dcl p_data_ptr ptr parameter;
1632 dcl p_major fixed bin parameter;
1633 dcl p_minor fixed bin parameter;
1634 dcl p_mcb_ptr ptr parameter;
1635
1636
1637
1638 dcl data_length fixed bin;
1639 dcl send_data_pos fixed bin;
1640 dcl send_data char (p_data_len);
1641 dcl data_overlay char (p_data_len) based (p_data_ptr);
1642
1643
1644
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
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672 check_mcb_ptr:
1673 proc (p_mcb_ptr, p_code);
1674
1675
1676 dcl p_mcb_ptr ptr;
1677
1678
1679 dcl p_code fixed bin (35);
1680
1681
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
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729 get_buff_length:
1730 proc (length, min, max) returns (fixed bin (17));
1731
1732
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
1747
1748
1749
1750
1751 null_mowse_info_handler:
1752 proc ();
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768 dcl mowse_iocb_ptr ptr;
1769 dcl 01 fatal_error_info aligned,
1770 02 version fixed bin,
1771 02 status_code fixed bin (35);
1772
1773
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
1785
1786
1787
1788
1789 verify_capability:
1790 proc (p_mowse_info_ptr, p_capability_id, p_code);
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801 dcl p_mowse_info_ptr ptr;
1802 dcl p_capability_id fixed bin (17);
1803
1804
1805 dcl p_code fixed bin (35);
1806
1807
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
1845
1846
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_;