1
2
3
4
5
6
7
8
9
10
11
12
13
14 iodc_:
15 procedure;
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 dcl a_ptr ptr;
46
47
48
49
50 dcl aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
51 dcl aim_check_$greater_or_equal
52 entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
53 dcl com_err_ entry options (variable);
54 dcl convert_ipc_code_ entry (fixed bin (35));
55 dcl debug entry;
56 dcl delete_$path entry (char (*) aligned, char (*) aligned, bit (6), char (*), fixed bin (35));
57 dcl expand_pathname_ entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (35));
58 dcl find_next_request_ entry (fixed bin, ptr) returns (bit (1) aligned);
59 dcl find_next_request_$init
60 entry (ptr);
61 dcl free_oldest_request_$cleanup
62 entry;
63 dcl free_oldest_request_$force
64 entry;
65 dcl free_oldest_request_$init
66 entry (ptr);
67 dcl get_authorization_ entry returns (bit (72) aligned);
68 dcl get_group_id_$tag_star entry returns (char (32));
69 dcl get_process_id_ entry returns (bit (36) aligned);
70 dcl get_ring_ entry returns (fixed bin (6));
71 dcl get_system_free_area_ entry (ptr);
72 dcl hcs_$chname_seg entry (ptr, char (*) aligned, char (*), fixed bin (35));
73 dcl hcs_$create_branch_ entry (char (*) aligned, char (*) aligned, ptr, fixed bin (35));
74 dcl hcs_$delentry_seg entry (ptr, fixed bin (35));
75 dcl hcs_$get_access_class entry (char (*) aligned, char (*), bit (72) aligned, fixed bin (35));
76 dcl hcs_$initiate_count entry (char (*) aligned, char (*) aligned, char (*), fixed bin (24),
77 fixed bin (2), ptr, fixed bin (35));
78 dcl hcs_$make_seg entry (char (*) aligned, char (*) aligned, char (*), fixed bin (5), ptr,
79 fixed bin (35));
80 dcl hcs_$set_ring_brackets entry (char (*) aligned, char (*) aligned, (3) fixed bin (3), fixed bin (35));
81 dcl hcs_$terminate_noname entry (ptr, fixed bin (35));
82 dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
83 dcl ioa_ entry options (variable);
84 dcl ioa_$ioa_stream entry options (variable);
85 dcl ioa_$rsnnl entry options (variable);
86 dcl iod_overseer_$coord_ready
87 entry;
88 dcl iodc_$command_level entry;
89 dcl iodc_$free_device entry (ptr, fixed bin (35));
90 dcl iodc_message_ entry (bit (3) aligned, fixed bin (35), char (*));
91 dcl iodc_message_$loud entry (bit (3) aligned, fixed bin (35), char (*));
92 dcl iodc_message_$init entry;
93 dcl iodd_$iodd_init entry (char (*) aligned, bit (1) aligned);
94 dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35));
95 dcl iox_$get_line entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35));
96 dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35));
97 dcl ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35));
98 dcl ipc_$decl_ev_call_chn entry (fixed bin (71), ptr, ptr, fixed bin, fixed bin (35));
99 dcl ipc_$drain_chn entry (fixed bin (71), fixed bin (35));
100 dcl ipc_$mask_ev_calls entry (fixed bin (35));
101 dcl ipc_$unmask_ev_calls entry (fixed bin (35));
102 dcl logout entry;
103 dcl match_request_id_ entry (fixed bin (71), char (*) aligned) returns (bit (1) aligned);
104 dcl message_segment_$create
105 entry (char (*) aligned, char (*) aligned, fixed bin (35));
106 dcl message_segment_$delete
107 entry (char (*) aligned, char (*) aligned, fixed bin (35));
108 dcl message_segment_$delete_index
109 entry (fixed bin, bit (72) aligned, fixed bin (35));
110 dcl message_segment_$ms_acl_add
111 entry (char (*) aligned, char (*) aligned, ptr, fixed bin, fixed bin (35));
112 dcl message_segment_$read_message_index
113 entry (fixed bin, pointer, pointer, fixed bin (35));
114 dcl message_segment_$open entry (char (*) aligned, char (*) aligned, fixed bin, fixed bin (35));
115 dcl message_segment_$check_salv_bit_index
116 entry (fixed bin, bit (1) aligned, bit (1) aligned, fixed bin (35));
117 dcl message_segment_$update_message_index
118 entry (fixed bin, fixed bin (24), bit (72) aligned, ptr, fixed bin (35));
119 dcl new_proc entry;
120 dcl print_devices entry options (variable);
121 dcl privileged_make_seg_ entry (char (*) aligned, char (*) aligned, char (*), fixed bin (5), ptr,
122 fixed bin (35));
123 dcl probe entry ();
124 dcl save_request_ entry (ptr, ptr);
125 dcl save_request_$init entry (ptr);
126 dcl set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35));
127 dcl signal_ entry (char (*));
128 dcl system_info_$access_ceiling
129 entry (bit (72) aligned);
130 dcl system_privilege_$initiate_count
131 entry (char (*) aligned, char (*) aligned, char (*), fixed bin (24),
132 fixed bin (2), ptr, fixed bin (35));
133 dcl timer_manager_$reset_alarm_wakeup
134 entry (fixed bin (71));
135 dcl unique_bits_ entry returns (bit (70));
136 dcl unique_chars_ entry (bit (*)) returns (char (15));
137 dcl unthread_descriptor_ entry (ptr);
138 dcl unthread_descriptor_$init
139 entry (ptr);
140
141
142
143 dcl ack_chan fixed bin (71);
144 dcl area_flag fixed bin;
145 dcl auth bit (72) aligned;
146 dcl bc fixed bin (24);
147 dcl chan_name fixed bin (71);
148 dcl cmd char (24) aligned;
149 dcl code fixed bin (35);
150 dcl code2 fixed bin (35);
151 dcl copy_ptr ptr;
152 dcl copy_words fixed bin;
153 dcl cwtp ptr;
154 dcl dcx fixed bin;
155 dcl desc_off fixed bin (18);
156 dcl desc_ptr ptr;
157 dcl dev_id char (32) aligned;
158 dcl dir_quota fixed bin;
159 dcl dr_ptr ptr;
160 dcl entry_type fixed bin;
161 dcl ev_info_ptr ptr;
162 dcl finish fixed bin;
163 dcl fwx fixed bin;
164 dcl i fixed bin;
165 dcl idtx fixed bin;
166 dcl iodc_data_ptr ptr;
167 dcl iwtp ptr;
168 dcl iwtrb (3) fixed bin (3);
169 dcl len fixed bin;
170 dcl line char (80);
171 dcl lwx fixed bin;
172 dcl mask_code fixed bin (35);
173 dcl match_dir char (168) aligned;
174 dcl match_ent char (32) aligned;
175 dcl mdtx fixed bin;
176 dcl message_len fixed bin;
177 dcl ms_id bit (72) aligned;
178 dcl nc fixed bin;
179 dcl new_driver_id char (32) aligned;
180 dcl new_idx fixed bin;
181 dcl new_iwtp ptr;
182 dcl next_ptr ptr;
183 dcl nseries fixed bin;
184 dcl nx fixed bin;
185 dcl out_len fixed bin;
186 dcl out_msg char (200);
187 dcl proc_id bit (36) aligned;
188 dcl q fixed bin;
189 dcl q_idx fixed bin;
190 dcl q_name char (32) aligned;
191 dcl quota fixed bin;
192 dcl retry fixed bin;
193 dcl reqp ptr;
194 dcl seg_name char (32) aligned;
195 dcl sender_class char (32) aligned;
196 dcl sender_device char (32) aligned;
197 dcl sender_id char (32) aligned;
198 dcl seq_id fixed bin (35);
199 dcl series_id fixed bin (35);
200 dcl series_sw bit (1) aligned;
201 dcl sig_type fixed bin;
202 dcl sip ptr;
203 dcl start fixed bin;
204 dcl subdir char (168) aligned;
205 dcl system_high bit (72) aligned;
206 dcl unbit bit (1) aligned;
207 dcl user_id char (32) aligned;
208 dcl wlp ptr;
209 dcl x fixed bin;
210
211
212
213 dcl areap ptr int static;
214 dcl driver_sig_chan fixed bin (71) int static;
215
216
217 dcl static_idtp int static ptr;
218 dcl static_mdtp int static ptr;
219 dcl driver_cmd_chan fixed bin (71) int static;
220
221
222 dcl recursion_flag fixed bin int static;
223
224 dcl scu_msg char (120) int static init ("");
225 dcl sysdir char (168) aligned int static;
226 dcl testing bit (1) int static;
227 dcl quit_flag bit (1) int static;
228 dcl err_label label int static;
229 dcl return_label label int static;
230
231 dcl comm_mseg_idx fixed bin int static;
232
233 dcl sysdir_len fixed bin int static;
234
235 dcl sysdir_class bit (72) aligned int static;
236
237 dcl initialized bit (1) aligned int static;
238
239 dcl coord_proc_id bit (36) int static;
240
241 dcl new_driver_series int static;
242 dcl com_level fixed bin int static;
243
244 dcl n_acl fixed bin int static;
245
246
247
248 dcl error_table_$action_not_performed
249 fixed bin (35) ext static;
250 dcl error_table_$bad_segment
251 fixed bin (35) ext static;
252 dcl error_table_$invalid_move_qmax
253 fixed bin (35) ext static;
254 dcl error_table_$noentry fixed bin (35) ext static;
255 dcl error_table_$namedup fixed bin (35) ext static;
256 dcl error_table_$pathlong fixed bin (35) ext static;
257 dcl error_table_$argerr fixed bin (35) ext static;
258 dcl error_table_$invalid_lock_reset
259 fixed bin (35) ext static;
260 dcl error_table_$segknown fixed bin (35) ext static;
261 dcl error_table_$request_not_recognized
262 fixed bin (35) ext static;
263 dcl error_table_$ai_above_allowed_max
264 fixed bin (35) ext static;
265 dcl error_table_$ai_restricted
266 fixed bin (35) ext static;
267
268 dcl iox_$user_input ptr ext;
269 dcl iox_$user_io ptr ext static;
270 %page;
271
272
273
274 dcl io_coordinator_version char (8) int static options (constant) init ("3.2");
275 dcl driver_command fixed bin int static options (constant) init (100);
276 dcl id char (16) int static options (constant) init ("io_coordinator");
277 dcl new_driver fixed bin int static options (constant) init (200);
278 dcl priority fixed bin int static options (constant) init (2);
279 dcl NL char (1) int static options (constant) init ("
280 ");
281
282
283
284
285 dcl any_other condition;
286 dcl quit condition;
287 dcl cleanup condition;
288 dcl area condition;
289
290
291
292 dcl free_oldest_request_$free_oldest_request_
293 fixed bin ext static;
294 dcl iodc_$new_driver fixed bin ext static;
295 dcl iodc_$driver_signal fixed bin ext static;
296 dcl iodc_$driver_command fixed bin ext static;
297
298
299
300 dcl based_message bit (message_len) aligned based;
301 dcl copy_template (copy_words) fixed bin based;
302
303 dcl sys_area area (65560) based (areap);
304
305
306
307
308 dcl (addr, before, divide, empty, fixed, length, ltrim, max, mod, null, ptr, rel, rtrim, stac, string,
309 substr, unspec) builtin;
310 %page;
311
312
313
314 dcl 1 ev_info based (ev_info_ptr),
315 2 channel fixed bin (71),
316 2 message fixed bin (71),
317 2 sending_proc bit (36);
318
319 dcl 1 acl (3) aligned int static,
320 2 ac_name char (32),
321 2 modes bit (36),
322 2 pad bit (36) init ((3) (36)"0"b),
323 2 code fixed bin (35);
324
325 dcl 1 dir_acl (2) aligned int static,
326 2 ac_name char (32),
327 2 modes bit (36),
328 2 code fixed bin (35);
329
330 dcl 1 driver_mmi aligned like mseg_message_info;
331
332 dcl 1 msg_mmi aligned like mseg_message_info;
333
334 dcl 1 coord_static int static aligned like iodc_static;
335
336
337 dcl 1 branch_info aligned int static like create_branch_info;
338
339 dcl 1 ms_acl aligned,
340 2 acc_name char (32),
341 2 mode bit (36),
342 2 exmode bit (36),
343 2 reterr fixed bin (35);
344
345 dcl 1 series_info (nseries) aligned based (sip),
346
347 2 count fixed bin,
348 2 first fixed bin,
349 2 last fixed bin,
350 2 dcx fixed bin;
351
352 dcl 1 option aligned,
353 2 dev bit (1) unal,
354 2 q bit (1) unal,
355 2 user bit (1) unal,
356 2 id bit (1) unal,
357 2 et bit (1) unal,
358 2 pn bit (1) unal,
359 2 pad bit (30) unal;
360
361 %page;
362
363 iodc_init:
364 entry (dir, test_bit, test_iod_tables);
365
366
367
368
369
370 dcl dir char (*);
371 dcl test_bit bit (1) aligned;
372 dcl test_iod_tables char (*);
373
374 call iodc_message_$init ();
375
376 call ioa_ ("I/O Coordinator Version: ^a", io_coordinator_version);
377
378 sysdir = dir;
379 sysdir_len = length (rtrim (sysdir));
380 if sysdir_len > 136
381 then do;
382 call com_err_ (error_table_$pathlong, "iodc_init", "Cannot append max size device name to ^a.",
383 sysdir);
384 go to forget_it;
385 end;
386
387 subdir = substr (sysdir, 1, sysdir_len) || ">coord_dir";
388
389
390 testing = test_bit;
391 return_label = back;
392 err_label = forget_it;
393 stat_p = addr (coord_static);
394
395 call get_system_free_area_ (areap);
396
397 new_driver_series = 0;
398 com_level = -1;
399
400
401
402 initialized = "0"b;
403 quit_flag = "0"b;
404 on quit call quit_handler;
405 call iox_$control (iox_$user_io, "quit_enable", null, code);
406
407 recursion_flag = 0;
408 on cleanup call clean_up;
409 on any_other call iodc_handler;
410
411
412
413 n_acl = 2;
414
415 dir_acl (1).ac_name, acl (1).ac_name = get_group_id_$tag_star ();
416
417 dir_acl (1).modes, acl (1).modes = "111"b;
418
419 dir_acl (2).ac_name, acl (2).ac_name = "*.*.*";
420 dir_acl (2).modes, acl (2).modes = "100"b;
421
422
423
424
425
426
427 call free_oldest_request_$init (stat_p);
428 call unthread_descriptor_$init (stat_p);
429
430 call initiate (subdir, "req_desc_seg", iodc_static.descr_seg_ptr, code);
431 if code ^= 0
432 then
433 no_purge:
434 call com_err_ (0, "iodc_init",
435 "Warning
436 else do;
437 call initiate (subdir, "request_seg", iodc_static.req_seg_ptr, code);
438 if code ^= 0
439 then go to no_purge;
440
441 iodc_static.save_first_req_p = addr (req_desc_seg.first_saved);
442 iodc_static.first_req_done = req_desc_seg.first_saved;
443 do while (iodc_static.first_req_done ^= 0);
444 call free_oldest_request_$cleanup;
445 end;
446 end;
447
448
449
450 call delete_$path (sysdir, "coord_dir", "101101"b, "", code);
451 if code ^= 0
452 then if code ^= error_table_$noentry
453 then do;
454 call com_err_ (code, "iodc_init", "Deleting coord_dir");
455 go to forget_it;
456 end;
457
458
459
460
461 call hcs_$get_access_class (sysdir, "", sysdir_class, code);
462 if code ^= 0
463 then do;
464 call com_err_ (code, "iodc_init", sysdir);
465 go to forget_it;
466 end;
467
468 auth = get_authorization_ ();
469 if ^testing
470 then do;
471 call system_info_$access_ceiling (system_high);
472 if ^aim_check_$equal (system_high, auth)
473 then call com_err_ (0, "iodc_init", "Warning
474 end;
475
476
477
478
479
480 branch_info.version = create_branch_version_2;
481 branch_info.dir_sw = "1"b;
482 branch_info.copy_sw = "0"b;
483 branch_info.chase_sw = "1"b;
484 branch_info.priv_upgrade_sw = "0"b;
485 branch_info.mbz1 = ""b;
486 branch_info.mode = "101"b;
487 branch_info.mbz2 = ""b;
488 branch_info.rings (1), branch_info.rings (2), branch_info.rings (3) = get_ring_ ();
489 branch_info.userid = acl (1).ac_name;
490 branch_info.bitcnt = 0;
491
492 call make_dir ("coord_dir", auth, 250, 25, code);
493 if code ^= 0
494 then do;
495 call com_err_ (code, "iodc_init", "^a>^a", sysdir, "coord_dir");
496 go to forget_it;
497 end;
498
499
500
501 seg_name = "iodc_data";
502 call make (sysdir, seg_name, iodc_data_ptr, code);
503 if code ^= 0
504 then do;
505 no_init:
506 call com_err_ (code, "iodc_init", "Could not initiate(create) ^a", seg_name);
507 forget_it:
508 call ioa_$ioa_stream ("error_output", "Process cannot be initialized.");
509 return;
510 end;
511
512 if test_bit & test_iod_tables ^= ""
513 then seg_name = test_iod_tables;
514 else seg_name = "iod_tables";
515 call initiate (sysdir, seg_name, ithp, code);
516 if code ^= 0
517 then go to no_init;
518 copy_words = divide (bc, 36, 24, 0);
519
520 if iod_tables_hdr.version ^= IODT_VERSION_5
521 then do;
522 call com_err_ (0, "iodc_init", "Wrong version number for iod_tables.");
523 go to forget_it;
524 end;
525
526
527 iwtp = null;
528 seg_name = "iod_working_tables";
529 call initiate (sysdir, seg_name, iwtp, code);
530 if code ^= 0
531 then if code = error_table_$noentry
532 then go to update;
533 else go to no_init;
534
535
536
537
538
539 if iwtp -> iod_tables_hdr.version ^= IODT_VERSION_5
540 then go to update;
541 if iod_tables_hdr.date_time_compiled > iwtp -> iod_tables_hdr.date_time_compiled
542 then do;
543 update:
544 seg_name = unique_chars_ (unique_bits_ ());
545
546 call make (sysdir, seg_name, new_iwtp, code);
547 if code ^= 0
548 then go to no_init;
549
550 iwtrb (1) = branch_info.rings (1);
551 iwtrb (2), iwtrb (3) = 5;
552 call hcs_$set_ring_brackets (sysdir, seg_name, iwtrb, code);
553 if code ^= 0
554 then do;
555 call com_err_ (code, "iodc_init", "Attempting to set ring brackets of ^a", seg_name);
556 go to forget_it;
557 end;
558
559 new_iwtp -> copy_template = ithp -> copy_template;
560
561
562 if iwtp ^= null
563 then do;
564 call hcs_$delentry_seg (iwtp, code);
565
566 if code ^= 0
567 then do;
568 call com_err_ (code, "iodc_init", "Attempting to delete iod_working_tables");
569 go to forget_it;
570 end;
571 end;
572 call hcs_$chname_seg (new_iwtp, seg_name, "iod_working_tables", code);
573
574 if code ^= 0
575 then do;
576 call com_err_ (code, "iodc_init", "Attempting to change name of iod_working_tables");
577 go to forget_it;
578 end;
579 iwtp = new_iwtp;
580 end;
581
582 call hcs_$terminate_noname (ithp, code);
583
584
585
586
587 seg_name = "coord_working_tables";
588 call make (subdir, seg_name, cwtp, code);
589 if code ^= 0
590 then go to no_init;
591 cwtp -> copy_template = iwtp -> copy_template;
592
593 call hcs_$terminate_noname (iwtp, code);
594
595 seg_name = "waiting_list";
596 call make (subdir, seg_name, iodc_static.wait_list_ptr, code);
597 if code ^= 0
598 then go to no_init;
599
600 seg_name = "req_desc_seg";
601 call make (subdir, "req_desc_seg", iodc_static.descr_seg_ptr, code);
602 if code ^= 0
603 then go to no_init;
604 descr_area = empty;
605
606 seg_name = "request_seg";
607 call make (subdir, "request_seg", iodc_static.req_seg_ptr, code);
608 if code ^= 0
609 then go to no_init;
610 req_area = empty;
611
612
613
614
615 static_idtp = ptr (cwtp, cwtp -> iod_tables_hdr.device_tab_offset);
616 static_mdtp = ptr (cwtp, cwtp -> iod_tables_hdr.minor_device_tab_offset);
617 text_strings_ptr = ptr (cwtp, cwtp -> iod_tables_hdr.text_strings_offset);
618 iodc_static.qgtp = ptr (cwtp, cwtp -> iod_tables_hdr.q_group_tab_offset);
619 iodc_static.dctp = ptr (cwtp, cwtp -> iod_tables_hdr.dev_class_tab_offset);
620 iodc_static.time_interval = cwtp -> iod_tables_hdr.grace_time;
621 iodc_static.max_q = cwtp -> iod_tables_hdr.max_queues;
622 iodc_static.first_req_done, iodc_static.last_req_done = 0;
623 iodc_static.save_first_req_p = addr (req_desc_seg.first_saved);
624 req_desc_seg.first_saved = 0;
625
626
627
628 call message_segment_$delete (sysdir, "coord_comm.ms", code);
629
630 if code ^= 0
631 then if code ^= error_table_$noentry
632 then do;
633 call com_err_ (code, "iodc_init", "Attempting to delete coord_comm.ms");
634 go to forget_it;
635 end;
636
637 seg_name = "coord_comm.ms";
638 call message_segment_$create (sysdir, "coord_comm.ms", code);
639
640 if code ^= 0
641 then go to no_init;
642 call message_segment_$open (sysdir, "coord_comm.ms", comm_mseg_idx, code);
643
644 if code ^= 0
645 then go to no_init;
646
647
648
649 ms_acl.mode = "101"b;
650 ms_acl.exmode = "1"b;
651
652 do q = 1 to iodc_static.qgtp -> q_group_tab.n_q_groups;
653
654 qgtep = addr (iodc_static.qgtp -> q_group_tab.entries (q));
655
656 if qgte.driver_id ^= acl (1).ac_name
657 then do;
658 ms_acl.acc_name = qgte.driver_id;
659 call message_segment_$ms_acl_add (sysdir, "coord_comm.ms", addr (ms_acl), 1, code);
660 if code ^= 0
661 then do;
662 if code = error_table_$argerr
663 then code = ms_acl.reterr;
664 call com_err_ (code, "iodc_init", "Adding to acl of coord_comm.ms");
665 go to forget_it;
666 end;
667 end;
668
669 qgte.open = 0;
670 end;
671
672
673
674 call find_next_request_$init (stat_p);
675 call save_request_$init (stat_p);
676
677
678
679 do idtx = 1 to static_idtp -> iod_device_tab.n_devices;
680 idtep = addr (static_idtp -> iod_device_tab.entries (idtx));
681 idte.process_id = ""b;
682 call iodc_$free_device (idtep, code);
683 if code ^= 0
684 then
685 go to forget_it;
686 end;
687
688
689
690
691 do dcx = 1 to iodc_static.dctp -> dev_class_tab.n_classes;
692 dctep = addr (iodc_static.dctp -> dev_class_tab.entries (dcx));
693 dcte.pending_request, dcte.restart_req = 0;
694 end;
695
696
697
698 n_acl = 3;
699 acl (n_acl).modes = "101"b;
700
701
702
703
704
705
706 call ipc_$create_ev_chn (chan_name, code);
707 if code ^= 0
708 then do;
709 no_ipc:
710 call convert_ipc_code_ (code);
711 call com_err_ (code, "iodc_init", "IPC error setting up event channels.");
712 go to forget_it;
713 end;
714 call ipc_$decl_ev_call_chn (chan_name, addr (iodc_$new_driver), null, 3, code);
715 if code ^= 0
716 then go to no_ipc;
717 iodc_data.init_event_channel = chan_name;
718
719 call ipc_$create_ev_chn (chan_name, code);
720 if code ^= 0
721 then go to no_ipc;
722 call ipc_$decl_ev_call_chn (chan_name, addr (iodc_$driver_signal), null, 1, code);
723 if code ^= 0
724 then go to no_ipc;
725 driver_sig_chan = chan_name;
726
727 call ipc_$create_ev_chn (chan_name, code);
728 if code ^= 0
729 then go to no_ipc;
730 call ipc_$decl_ev_call_chn (chan_name, addr (iodc_$driver_command), null, 2, code);
731 if code ^= 0
732 then go to no_ipc;
733 driver_cmd_chan = chan_name;
734
735
736
737 call ipc_$create_ev_chn (iodc_static.timer_chan, code);
738 if code ^= 0
739 then go to no_ipc;
740 call ipc_$decl_ev_call_chn (iodc_static.timer_chan, addr (free_oldest_request_$free_oldest_request_), null, 1,
741 code);
742 if code ^= 0
743 then go to no_ipc;
744
745
746
747
748 coord_proc_id, iodc_data.proc_id = get_process_id_ ();
749
750 initialized = "1"b;
751 call iodc_message_ ("010"b, 0, "I/O Coordinator initialized");
752 call iod_overseer_$coord_ready;
753 call iodc_$command_level;
754
755
756 back:
757 call clean_up;
758 return;
759
760
761 clean_up:
762 proc;
763
764 call timer_manager_$reset_alarm_wakeup (iodc_static.timer_chan);
765
766 call ipc_$drain_chn (iodc_static.timer_chan, code);
767 call iox_$control (iox_$user_io, "start", null (), code);
768 call ipc_$unmask_ev_calls (code2);
769 call ipc_$delete_ev_chn (iodc_static.timer_chan, code2);
770 call ipc_$delete_ev_chn (driver_cmd_chan, code2);
771 call ipc_$delete_ev_chn (driver_sig_chan, code2);
772 call ipc_$delete_ev_chn (iodc_data.init_event_channel, code2);
773 return;
774
775 end clean_up;
776 %page;
777
778 make:
779 proc (dirname, entname, p, code);
780
781 dcl dirname char (*) aligned;
782 dcl entname char (*) aligned;
783 dcl p ptr;
784 dcl code fixed bin (35);
785 dcl hcs_$replace_acl entry (char (*) aligned, char (*) aligned, ptr, fixed bin, bit (1) aligned,
786 fixed bin (35));
787
788 if testing
789 then call hcs_$make_seg (dirname, entname, "", 01111b, p, code);
790 else call privileged_make_seg_ (dirname, entname, "", 01111b, p, code);
791 if code ^= 0
792 then if code ^= error_table_$namedup
793 then if code ^= error_table_$segknown
794 then return;
795 call hcs_$replace_acl (dirname, entname, addr (acl), n_acl, "0"b, code);
796
797 return;
798 end;
799
800
801
802 make_dir:
803 proc (ename, aclass, aquota, adir_quota, code);
804
805 dcl ename char (*) aligned;
806 dcl aclass bit (72) aligned;
807 dcl aquota fixed bin;
808 dcl adir_quota fixed bin;
809 dcl code fixed bin (35);
810 dcl hcs_$replace_dir_acl entry (char (*) aligned, char (*) aligned, ptr, fixed bin, bit (1),
811 fixed bin (35));
812
813 branch_info.access_class = aclass;
814 if aim_check_$equal (aclass, sysdir_class)
815 then branch_info.quota, branch_info.dir_quota = 0;
816 else do;
817 branch_info.quota = aquota;
818 branch_info.dir_quota = adir_quota;
819 end;
820
821 create_branch:
822 call hcs_$create_branch_ (sysdir, ename, addr (branch_info), code);
823 if code = error_table_$invalid_move_qmax
824 then if branch_info.dir_quota = 0
825 then return;
826 else do;
827 branch_info.dir_quota = 0;
828 go to create_branch;
829 end;
830 if code ^= 0
831 then return;
832
833 call hcs_$replace_dir_acl (sysdir, ename, addr (dir_acl), 2, "0"b, code);
834 end make_dir;
835
836
837
838 initiate:
839 proc (dir, ent, p, code);
840
841 dcl dir char (*) aligned;
842 dcl ent char (*) aligned;
843 dcl p ptr;
844 dcl code fixed bin (35);
845
846 if testing
847 then
848 call hcs_$initiate_count (dir, ent, "", bc, 0, p, code);
849 else call system_privilege_$initiate_count (dir, ent, "", bc, 0, p, code);
850
851 if code = error_table_$segknown
852 then code = 0;
853
854 end initiate;
855 %page;
856
857 driver_signal:
858 entry (a_ptr);
859
860
861
862
863
864
865
866 mask_code = -1;
867 on cleanup
868 begin;
869 if mask_code = 0
870 then call ipc_$unmask_ev_calls (code2);
871 end;
872 call ipc_$mask_ev_calls (mask_code);
873
874 ev_info_ptr = a_ptr;
875 err_label = iodc_return;
876 proc_id = ev_info.sending_proc;
877
878
879
880 mdtx = addr (ev_info.message) -> ev_msg.minor_dev_index;
881
882
883 call identify_sender (code);
884 if code ^= 0
885 then go to bad_signal;
886
887
888
889 sig_type = addr (ev_info.message) -> ev_msg.code;
890 if sig_type < 0 | sig_type > 5
891 then do;
892 call ioa_$rsnnl ("Driver signal rejected from device ^a (bad code: ^d)", out_msg, out_len,
893 sender_device, sig_type);
894 bad_signal:
895 call iodc_message_ ("101"b, 0, out_msg);
896 go to iodc_return;
897 end;
898
899 go to sig_label (sig_type);
900
901
902
903
904 identify_sender:
905 proc (code);
906
907 dcl code fixed bin (35);
908
909 if mdtx < 0 | mdtx > static_mdtp -> minor_device_tab.n_minor
910
911 then do;
912 out_msg = "Driver signal rejected (bad device index)";
913 code = error_table_$request_not_recognized;
914 return;
915 end;
916
917 mdtep = addr (static_mdtp -> minor_device_tab.entries (mdtx));
918
919 idtx = mdte.major_index;
920 idtep = addr (static_idtp -> iod_device_tab.entries (idtx));
921
922
923 if idte.process_id ^= ev_info.sending_proc
924 then do;
925 out_msg = "Driver signal rejected (device not assigned to process)";
926 code = error_table_$request_not_recognized;
927 return;
928 end;
929
930 if mdte.active ^= 1
931 then do;
932 out_msg = "Driver signal rejected (minor device not active)";
933 code = error_table_$request_not_recognized;
934 return;
935 end;
936
937 dr_ptr = mdte.driver_ptr;
938 dcx = mdte.dev_class_index;
939 dctep = addr (iodc_static.dctp -> dev_class_tab.entries (dcx));
940
941 qgtep = addr (iodc_static.qgtp -> q_group_tab.entries (dcte.qgte_index));
942
943 sender_device = get_device_name ();
944 sender_class = get_class_name ();
945
946 code = 0;
947 return;
948
949 end identify_sender;
950
951
952
953 get_device_name:
954 proc returns (char (32) aligned);
955
956 dcl name char (32) aligned;
957
958 if idte.last_minor > idte.first_minor | idte.dev_id ^= mdte.dev_id
959 then
960 name = rtrim (idte.dev_id) || "." || mdte.dev_id;
961 else name = idte.dev_id;
962 return (name);
963
964 end get_device_name;
965
966
967
968
969 get_class_name:
970 proc returns (char (32) aligned);
971
972 dcl name char (32) aligned;
973
974 if qgte.last_dev_class > qgte.first_dev_class | qgte.name ^= dcte.id
975 then
976 name = rtrim (qgte.name) || "." || dcte.id;
977 else name = qgte.name;
978 return (name);
979
980 end get_class_name;
981 %page;
982
983 sig_label (0):
984 sig_label (1):
985
986
987
988
989 if mdte.current_request ^= 0
990 then do;
991
992
993
994
995 desc_ptr = ptr (iodc_static.descr_seg_ptr, mdte.current_request);
996 copy_ptr = addr (dr_ptr -> driver_status.descriptor);
997 if ^(copy_ptr -> request_descriptor.finished | copy_ptr -> request_descriptor.cancelled)
998 then go to iodc_return;
999 call update_descriptor;
1000
1001 mdte.current_request = 0;
1002
1003
1004
1005 call save_request_ (desc_ptr, dctep);
1006 end;
1007
1008 if sig_type = 0
1009 then go to iodc_return;
1010
1011
1012
1013 if dcte.pending_request ^= 0
1014 then do;
1015 desc_ptr = ptr (iodc_static.descr_seg_ptr, dcte.pending_request);
1016 dcte.pending_request = desc_ptr -> request_descriptor.next_pending;
1017 end;
1018
1019
1020
1021
1022 else if dcte.restart_req ^= 0
1023 then do;
1024 desc_ptr = ptr (iodc_static.descr_seg_ptr, dcte.restart_req);
1025 call unthread_descriptor_ (desc_ptr);
1026 desc_ptr -> request_descriptor.restarted = "1"b;
1027 desc_ptr -> request_descriptor.prev_seq_id = desc_ptr -> request_descriptor.seq_id;
1028 dcte.restart_req = 0;
1029
1030
1031
1032 if desc_ptr -> request_descriptor.series_restart
1033 then do;
1034 series_id = divide (desc_ptr -> request_descriptor.seq_id, 10000, 35, 0);
1035 desc_off = desc_ptr -> request_descriptor.next_done;
1036 do while (desc_off ^= 0);
1037 next_ptr = ptr (iodc_static.descr_seg_ptr, desc_off);
1038
1039 if divide (next_ptr -> request_descriptor.seq_id, 10000, 35, 0) = series_id
1040 then do;
1041 next_ptr -> request_descriptor.saved = "1"b;
1042
1043 next_ptr -> request_descriptor.series_restart = "1"b;
1044
1045 dcte.restart_req = desc_off;
1046
1047 desc_off = 0;
1048 end;
1049
1050 else desc_off = next_ptr -> request_descriptor.next_done;
1051 end;
1052 end;
1053 end;
1054
1055
1056 else do;
1057
1058
1059
1060 area_flag = 0;
1061 on area call area_handler;
1062 allocate request_descriptor in (descr_area) set (desc_ptr);
1063 revert area;
1064
1065 unspec (desc_ptr -> request_descriptor) = ""b;
1066
1067 if ^find_next_request_ (dcx, desc_ptr)
1068 then do;
1069
1070
1071
1072 free desc_ptr -> request_descriptor in (descr_area);
1073
1074 if dr_ptr -> driver_status.acknowledge
1075 then do;
1076 call hcs_$wakeup (idte.process_id, dr_ptr -> driver_status.driver_chan, 0, code);
1077 if code ^= 0
1078 then call check_wakeup_code (code);
1079 end;
1080
1081 go to iodc_return;
1082 end;
1083
1084 end;
1085
1086
1087
1088
1089 desc_ptr -> request_descriptor.seq_id = mdte.seq_id + 1;
1090 desc_ptr -> request_descriptor.finished = "0"b;
1091
1092 addr (dr_ptr -> driver_status.descriptor) -> request_descriptor = desc_ptr -> request_descriptor;
1093 addr (dr_ptr -> driver_status.descriptor) -> request_descriptor.saved = "0"b;
1094
1095 message_len = desc_ptr -> mseg_message_info.ms_len;
1096 addr (dr_ptr -> driver_status.message) -> based_message = desc_ptr -> mseg_message_info.ms_ptr -> based_message;
1097
1098 desc_off = fixed (rel (desc_ptr), 18);
1099
1100 if ^stac (addr (dr_ptr -> driver_status.request_pending), coord_proc_id)
1101 then do;
1102 make_pending:
1103 desc_ptr -> request_descriptor.next_pending = dcte.pending_request;
1104 dcte.pending_request = desc_off;
1105 go to iodc_return;
1106 end;
1107
1108 call hcs_$wakeup (idte.process_id, dr_ptr -> driver_status.driver_chan, 0, code);
1109 if code ^= 0
1110 then do;
1111 call check_wakeup_code (code);
1112 go to make_pending;
1113 end;
1114
1115 mdte.current_request = desc_off;
1116 if mod (desc_ptr -> request_descriptor.seq_id, 10000) = 9999
1117 then do;
1118 new_series:
1119 new_driver_series = new_driver_series + 10000;
1120 mdte.seq_id = new_driver_series;
1121 call ioa_$rsnnl ("Device ^a switched to series ^d.", out_msg, out_len, sender_device,
1122 new_driver_series);
1123 call iodc_message_ ("100"b, 0, out_msg);
1124 end;
1125 else mdte.seq_id = desc_ptr -> request_descriptor.seq_id;
1126
1127
1128
1129 iodc_return:
1130 call ipc_$unmask_ev_calls (code);
1131 recursion_flag = 0;
1132 return;
1133
1134
1135
1136
1137
1138
1139
1140
1141 update_descriptor:
1142 proc;
1143
1144 desc_ptr -> request_descriptor.driver_data = copy_ptr -> request_descriptor.driver_data;
1145 desc_ptr -> request_descriptor.cancelled = copy_ptr -> request_descriptor.cancelled;
1146 desc_ptr -> request_descriptor.dont_delete = copy_ptr -> request_descriptor.dont_delete;
1147 if ^desc_ptr -> request_descriptor.saved
1148 then
1149 desc_ptr -> request_descriptor.keep_in_queue = copy_ptr -> request_descriptor.keep_in_queue;
1150 desc_ptr -> request_descriptor.saved =
1151 copy_ptr -> request_descriptor.saved
1152 | copy_ptr -> request_descriptor.keep_in_queue;
1153
1154 end update_descriptor;
1155 %page;
1156
1157 sig_label (2):
1158 series_sw = "1"b;
1159 ack_chan = 0;
1160 seq_id = addr (ev_info.message) -> ev_msg.seq_id;
1161 go to restart_or_save;
1162
1163 sig_label (3):
1164 series_sw = "1"b;
1165 ack_chan = 0;
1166 seq_id = addr (ev_info.message) -> ev_msg.seq_id;
1167
1168
1169 restart_or_save:
1170
1171
1172
1173
1174
1175
1176 if sig_type = save
1177 then cmd = "Save";
1178 else cmd = "Restart";
1179
1180 call ioa_$rsnnl ("^a command received from device ^a", out_msg, out_len, cmd, idte.dev_id);
1181 call iodc_message_ ("110"b, 0, out_msg);
1182
1183 series_id = divide (seq_id, 10000, 35, 0);
1184
1185 do desc_off = iodc_static.first_req_done repeat desc_ptr -> request_descriptor.next_done while (desc_off ^= 0);
1186 desc_ptr = ptr (iodc_static.descr_seg_ptr, desc_off);
1187
1188 if divide (desc_ptr -> request_descriptor.seq_id, 10000, 35, 0) = series_id
1189 then
1190 if desc_ptr -> request_descriptor.seq_id >= seq_id
1191 then
1192 if desc_ptr -> request_descriptor.dev_class_index = dcx
1193 then
1194 go to found_desc;
1195
1196 else do;
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208 if idte.last_minor > idte.first_minor
1209 then
1210 do mdtx = idte.first_minor to idte.last_minor;
1211
1212 mdtep = addr (static_mdtp -> minor_device_tab.entries (mdtx));
1213 if mdte.active = 1
1214 then if mdte.dev_class_index = desc_ptr -> request_descriptor.dev_class_index
1215 then do;
1216 sender_device = get_device_name ();
1217 dctep =
1218 addr (iodc_static.dctp
1219 -> dev_class_tab.entries (mdte.dev_class_index));
1220 qgtep =
1221 addr (iodc_static.qgtp
1222 -> q_group_tab.entries (dcte.qgte_index));
1223 sender_class = get_class_name ();
1224 go to found_desc;
1225 end;
1226 end;
1227
1228 call ioa_$rsnnl (
1229 "^a rejected. Sender device class does not match that of specified request.",
1230 out_msg, out_len, cmd);
1231 call iodc_message_ ("110"b, 0, out_msg);
1232 code = error_table_$action_not_performed;
1233 call driver_ack (code, 0);
1234
1235 go to iodc_return;
1236 end;
1237
1238 end;
1239
1240
1241
1242
1243
1244 call ioa_$rsnnl ("No saved requests from number ^d", out_msg, out_len, seq_id);
1245 call iodc_message_ ("101"b, 0, out_msg);
1246 code = error_table_$noentry;
1247 go to tell_driver;
1248
1249
1250 found_desc:
1251 if sig_type = restart
1252 then
1253 if dcte.restart_req ^= 0
1254 then do;
1255 call ioa_$rsnnl ("Restart already in progress for request type ^a", out_msg, out_len,
1256 sender_class);
1257 call iodc_message_ ("101"b, 0, out_msg);
1258 code = error_table_$namedup;
1259 go to tell_driver;
1260 end;
1261
1262 if desc_ptr -> request_descriptor.seq_id > seq_id
1263 then do;
1264 call ioa_$rsnnl ("Request ^d is gone.", out_msg, out_len, seq_id);
1265 call iodc_message_ ("001"b, 0, out_msg);
1266 code = error_table_$noentry;
1267 if ^series_sw
1268 then go to tell_driver;
1269 end;
1270
1271 code = 0;
1272 seq_id = desc_ptr -> request_descriptor.seq_id;
1273
1274 call ioa_$rsnnl ("^a ^[from^;of^] request ^d initiated for request type ^a", out_msg, out_len, cmd, series_sw,
1275 seq_id, sender_class);
1276 call iodc_message_ ("110"b, 0, out_msg);
1277
1278 if sig_type = restart
1279 then
1280 dcte.restart_req = desc_off;
1281
1282
1283
1284 desc_ptr -> request_descriptor.saved = "1"b;
1285 if series_sw
1286 then do;
1287 if sig_type = restart
1288 then desc_ptr -> request_descriptor.series_restart = "1"b;
1289
1290 do desc_off = desc_ptr -> request_descriptor.next_done
1291 repeat desc_ptr -> request_descriptor.next_done while (desc_off ^= 0);
1292 desc_ptr = ptr (iodc_static.descr_seg_ptr, desc_off);
1293 if divide (desc_ptr -> request_descriptor.seq_id, 10000, 35, 0) = series_id
1294 then do;
1295 desc_ptr -> request_descriptor.saved = "1"b;
1296 if sig_type = restart
1297 then desc_ptr -> request_descriptor.series_restart = "1"b;
1298 end;
1299 end;
1300 end;
1301
1302
1303
1304 do mdtx = 1 to static_mdtp -> minor_device_tab.n_minor;
1305
1306 mdtep = addr (static_mdtp -> minor_device_tab.entries (mdtx));
1307 if mdte.active = 1
1308 then if divide (mdte.seq_id, 10000, 35, 0) = series_id
1309 then do;
1310 idtep = addr (static_idtp -> iod_device_tab.entries (mdte.major_index));
1311 sender_device = get_device_name ();
1312 call driver_ack (0, seq_id);
1313 go to new_series;
1314 end;
1315 end;
1316
1317 tell_driver:
1318 call driver_ack (code, seq_id);
1319 go to iodc_return;
1320
1321
1322
1323 driver_ack:
1324 proc (code, num);
1325
1326 dcl code fixed bin (35);
1327 dcl num fixed bin (35);
1328 dcl ec fixed bin (35);
1329
1330 if ack_chan = 0
1331 then return;
1332
1333 addr (event_message) -> ack_msg.code = code;
1334 addr (event_message) -> ack_msg.num = num;
1335
1336 call hcs_$wakeup (proc_id, ack_chan, event_message, ec);
1337
1338 if ec ^= 0
1339 then call iodc_message_ ("101"b, code, "Unable to acknowledge driver command.");
1340
1341 return;
1342
1343 end driver_ack;
1344 %page;
1345
1346
1347 sig_label (4):
1348
1349
1350
1351 call iodc_$free_device (idtep, code);
1352 if code = 0
1353 then do;
1354 call ioa_$rsnnl ("Driver logout for device ^a", out_msg, out_len, idte.dev_id);
1355 call iodc_message_ ("100"b, 0, out_msg);
1356 end;
1357 go to iodc_return;
1358
1359
1360
1361
1362
1363 sig_label (5):
1364
1365
1366
1367 event_message = driver_cmd_chan;
1368
1369 call hcs_$wakeup (proc_id, dr_ptr -> driver_status.driver_chan, event_message, code);
1370
1371 if code ^= 0
1372 then call check_wakeup_code (code);
1373
1374 go to iodc_return;
1375 %page;
1376
1377 free_device:
1378 entry (a_idtep, a_code);
1379
1380
1381
1382
1383
1384
1385
1386 dcl a_idtep ptr;
1387 dcl a_code fixed bin (35);
1388
1389
1390 idtep = a_idtep;
1391
1392
1393
1394 do mdtx = idte.first_minor to idte.last_minor;
1395 mdtep = addr (static_mdtp -> minor_device_tab.entries (mdtx));
1396 if idte.process_id ^= ""b
1397 then if mdte.active = 1
1398 then if mdte.current_request ^= 0
1399 then do;
1400 dctep = addr (iodc_static.dctp -> dev_class_tab.entries (mdte.dev_class_index));
1401 desc_ptr = ptr (iodc_static.descr_seg_ptr, mdte.current_request);
1402 copy_ptr = addr (mdte.driver_ptr -> driver_status.descriptor);
1403 call update_descriptor;
1404 if copy_ptr -> request_descriptor.finished | copy_ptr -> request_descriptor.cancelled
1405 then
1406 call save_request_ (desc_ptr, dctep);
1407
1408 else do;
1409 desc_ptr -> request_descriptor.next_pending = dcte.pending_request;
1410 dcte.pending_request = fixed (rel (desc_ptr), 18);
1411 desc_ptr -> request_descriptor.continued = "1"b;
1412
1413 desc_ptr -> request_descriptor.contd_seq_id =
1414 desc_ptr -> request_descriptor.seq_id;
1415 end;
1416
1417 mdte.current_request = 0;
1418 end;
1419
1420 mdte.active = 0;
1421 end;
1422
1423 idte.lock, idte.process_id = ""b;
1424
1425 call delete_$path (sysdir, idte.dev_id, "101101"b, "", code);
1426
1427 if code ^= 0
1428 then if code ^= error_table_$noentry
1429 then do;
1430 call ioa_$rsnnl ("Deleting ^a>^a. Cannot free device.", out_msg, out_len, sysdir, idte.dev_id);
1431 call iodc_message_ ("101"b, code, out_msg);
1432 end;
1433 else code = 0;
1434
1435 a_code = code;
1436
1437 return;
1438 %page;
1439
1440 new_driver:
1441 entry (a_ptr);
1442
1443
1444
1445
1446
1447
1448 entry_type = new_driver;
1449 go to read_comm_msg;
1450
1451
1452 driver_command:
1453 entry (a_ptr);
1454
1455
1456
1457
1458 entry_type = driver_command;
1459
1460 read_comm_msg:
1461 ack_chan = 0;
1462 mask_code = -1;
1463 on cleanup
1464 begin;
1465 call driver_ack (error_table_$action_not_performed, 0);
1466
1467 if mask_code = 0
1468 then call ipc_$unmask_ev_calls (code2);
1469 end;
1470 call ipc_$mask_ev_calls (mask_code);
1471 err_label = iodc_return;
1472 ev_info_ptr = a_ptr;
1473 proc_id = ev_info.sending_proc;
1474
1475
1476
1477
1478 ms_id = unspec (ev_info.message);
1479 unspec (driver_mmi) = ""b;
1480 driver_mmi.version = MSEG_MESSAGE_INFO_V1;
1481 driver_mmi.ms_id = ms_id;
1482 driver_mmi.message_code = MSEG_READ_SPECIFIED;
1483 call message_segment_$read_message_index (comm_mseg_idx, areap, addr (driver_mmi), code);
1484 if code ^= 0
1485 then do;
1486 call iodc_message_ ("101"b, code, "Attempting to read driver message from coord_comm.ms");
1487 go to iodc_return;
1488 end;
1489 call message_segment_$delete_index (comm_mseg_idx, ms_id, code);
1490
1491 if code ^= 0
1492 then call iodc_message_ ("101"b, code, "Deleting coord_comm.ms driver message");
1493
1494 if entry_type = new_driver
1495 then go to make_new_driver;
1496
1497
1498 %page;
1499
1500 comm_ptr = driver_mmi.ms_ptr;
1501 ack_chan = iodd_comm.ack_chan;
1502 err_label = abort_driver_cmd;
1503 mdtx = iodd_comm.minor_idx;
1504
1505 call identify_sender (code);
1506 if code ^= 0
1507 then do;
1508 bad_req:
1509 call driver_ack (code, 0);
1510 go to iodc_return;
1511 end;
1512
1513 sig_type = iodd_comm.type;
1514
1515 if sig_type = save | sig_type = restart
1516 then do;
1517 seq_id = iodd_comm.request_no;
1518 if iodd_comm.type_ext = ""b
1519 then series_sw = ""b;
1520 else series_sw = "1"b;
1521 go to restart_or_save;
1522 end;
1523
1524 if sig_type = restart_q
1525 then go to restart_queue;
1526
1527 if sig_type = next_req
1528 then go to next_request;
1529
1530 code = error_table_$request_not_recognized;
1531 go to bad_req;
1532
1533
1534 abort_driver_cmd:
1535 call driver_ack (error_table_$action_not_performed, 0);
1536 go to iodc_return;
1537 %page;
1538
1539 make_new_driver:
1540 new_driver_id = driver_mmi.sender_id;
1541 i = length (rtrim (new_driver_id));
1542 substr (new_driver_id, i) = "*";
1543 auth = driver_mmi.sender_authorization;
1544 new_driver_msg_p = driver_mmi.ms_ptr;
1545 chan_name = new_driver_msg.wakeup_chan;
1546
1547
1548
1549
1550 dcx = new_driver_msg.dev_class_index;
1551 if dcx < 1 | dcx > iodc_static.dctp -> dev_class_tab.n_classes
1552
1553 then do;
1554 code = 1;
1555 call ioa_$rsnnl ("New driver rejected: ^a (bad device class index)", out_msg, out_len, new_driver_id);
1556
1557 bad_new_driver:
1558 call iodc_message_ ("100"b, 0, out_msg);
1559 go to wake_driver;
1560 end;
1561
1562 dctep = addr (iodc_static.dctp -> dev_class_tab.entries (dcx));
1563
1564
1565 qgtep = addr (iodc_static.qgtp -> q_group_tab.entries (dcte.qgte_index));
1566
1567
1568 sender_class = get_class_name ();
1569
1570 if ^aim_check_$greater_or_equal (auth, dcte.max_access)
1571 then do;
1572 code = 2;
1573 call ioa_$rsnnl ("New driver rejected: ^a (wrong authorization for device class ^a)", out_msg,
1574 out_len, new_driver_id, sender_class);
1575 go to bad_new_driver;
1576 end;
1577
1578
1579
1580 if qgte.driver_id ^= new_driver_id
1581 then do;
1582 code = 3;
1583 call ioa_$rsnnl ("New driver rejected: ^a (invalid userid for ^a queue group)", out_msg, out_len,
1584 new_driver_id, qgte.name);
1585 go to bad_new_driver;
1586 end;
1587
1588
1589
1590
1591 mdtx = new_driver_msg.device_index;
1592 if mdtx < 1 | mdtx > static_mdtp -> minor_device_tab.n_minor
1593
1594 then do;
1595 code = 4;
1596 call ioa_$rsnnl ("New driver rejected: ^a (bad minor device index)", out_msg, out_len, new_driver_id);
1597 go to bad_new_driver;
1598 end;
1599
1600 mdtep = addr (static_mdtp -> minor_device_tab.entries (mdtx));
1601 idtx = mdte.major_index;
1602 idtep = addr (static_idtp -> iod_device_tab.entries (idtx));
1603 sender_device = get_device_name ();
1604
1605 if ^substr (dcte.device_list, mdtx, 1)
1606 then do;
1607 code = 5;
1608 call ioa_$rsnnl ("New driver rejected: ^a (device ^a invalid for device class ^a)", out_msg, out_len,
1609 new_driver_id, sender_device, sender_class);
1610 go to bad_new_driver;
1611 end;
1612
1613 if idte.process_id ^= ""b
1614 then
1615 if idte.process_id ^= proc_id
1616 then do;
1617 call set_lock_$lock (idte.lock, 0, code);
1618
1619 if code = 0 | code = error_table_$invalid_lock_reset
1620 then do;
1621 call iodc_$free_device (idtep, code);
1622 if code ^= 0
1623 then do;
1624 code = 10;
1625 go to wake_driver;
1626 end;
1627 end;
1628 else do;
1629 code = 6;
1630 call ioa_$rsnnl ("New driver rejected: ^a (device ^a assigned to other process)",
1631 out_msg, out_len, new_driver_id, idte.dev_id);
1632 go to bad_new_driver;
1633 end;
1634 end;
1635 else if mdte.active ^= 0
1636 then do;
1637 code = 7;
1638 call ioa_$rsnnl ("New driver rejected: ^a (device ^a already active)", out_msg, out_len,
1639 new_driver_id, sender_device);
1640 go to bad_new_driver;
1641 end;
1642
1643
1644
1645 if qgte.open = 0
1646 then
1647 do q = 1 to qgte.max_queues;
1648 qgte.last_read (q) = "0"b;
1649 call ioa_$rsnnl ("^a_^d.ms", q_name, out_len, qgte.name, q);
1650 call message_segment_$open (sysdir, q_name, q_idx, code);
1651
1652 if code ^= 0
1653 then do;
1654 if code = error_table_$noentry
1655 then call ioa_$rsnnl ("Queue ^d for request type ^a missing.", out_msg, out_len, q, dcte.id)
1656 ;
1657 else call ioa_$rsnnl ("Could not open ^a>^a", out_msg, out_len, sysdir, q_name);
1658 call iodc_message_ ("101"b, code, out_msg);
1659 code = 8;
1660 go to wake_driver;
1661 end;
1662
1663 call message_segment_$check_salv_bit_index (q_idx, "1"b, unbit, code);
1664 if unbit
1665 then do;
1666 call ioa_$rsnnl ("Message segment ^a was salvaged. Some requests may have been lost.",
1667 out_msg, out_len, q_name);
1668 call iodc_message_ ("110"b, 0, out_msg);
1669 end;
1670
1671 qgte.mseg_index (q) = q_idx;
1672 end;
1673
1674
1675
1676
1677
1678
1679
1680 if idte.process_id = ""b
1681 then do;
1682 quota = 2 * (idte.last_minor - idte.first_minor + 1);
1683
1684 dir_quota = max (5, divide (idte.last_minor - idte.first_minor + 1, 6, 17));
1685 call make_dir (idte.dev_id, auth, quota, dir_quota, code);
1686 if code ^= 0
1687 then do;
1688 call ioa_$rsnnl ("Cannot create directory for device ^a", out_msg, out_len, idte.dev_id);
1689 call iodc_message_ ("101"b, code, out_msg);
1690
1691 code = 9;
1692 go to wake_driver;
1693 end;
1694 end;
1695
1696
1697
1698 subdir = sysdir;
1699 substr (subdir, sysdir_len + 1, 1) = ">";
1700 substr (subdir, sysdir_len + 2) = idte.dev_id;
1701 acl (n_acl).ac_name = new_driver_id;
1702 call make (subdir, mdte.dev_id, dr_ptr, code);
1703
1704 if code ^= 0
1705 then do;
1706 call ioa_$rsnnl ("Cannot create driver status segment for device ^a", out_msg, out_len, sender_device)
1707 ;
1708 call iodc_message_ ("101"b, code, out_msg);
1709 code = 10;
1710 go to wake_driver;
1711 end;
1712
1713
1714
1715 unspec (dr_ptr -> driver_status) = "0"b;
1716 dr_ptr -> driver_status.req_type_label = sender_class;
1717 dr_ptr -> driver_status.dev_name_label = sender_device;
1718 dr_ptr -> driver_status.device_id = mdte.dev_id;
1719 dr_ptr -> driver_status.device_class_id = dcte.id;
1720 dr_ptr -> driver_status.coord_chan = driver_sig_chan;
1721 dr_ptr -> driver_status.request_pending = "0"b;
1722 dr_ptr -> driver_status.dev_index = mdtx;
1723 dr_ptr -> driver_status.maj_index = idtx;
1724 dr_ptr -> driver_status.dev_class_index = dcx;
1725 dr_ptr -> driver_status.minor_args = mdte.args;
1726 dr_ptr -> driver_status.min_banner = dcte.min_banner;
1727
1728 dr_ptr -> driver_status.rqti_ptr = null;
1729 dr_ptr -> driver_status.dev_out_iocbp = null;
1730 dr_ptr -> driver_status.dev_in_iocbp = null;
1731 dr_ptr -> driver_status.dev_out_stream = "";
1732 dr_ptr -> driver_status.dev_in_stream = "";
1733 dr_ptr -> driver_status.forms_validation_ptr = null;
1734 dr_ptr -> driver_status.dev_ptr1 = null;
1735 dr_ptr -> driver_status.dev_ctl_ptr = null;
1736
1737
1738
1739 qgte.open = 1;
1740 idte.lock = new_driver_msg.lock_id;
1741 idte.process_id = proc_id;
1742 mdte.dev_class_index = dcx;
1743 mdte.active = 1;
1744 mdte.driver_ptr = dr_ptr;
1745 mdte.current_request = 0;
1746 new_driver_series = new_driver_series + 10000;
1747 mdte.seq_id = new_driver_series;
1748
1749 call ioa_$rsnnl ("New driver for device ^a, request type ^a (series = ^d)", out_msg, out_len, sender_device,
1750 sender_class, new_driver_series);
1751 ;
1752 call iodc_message_ ("100"b, 0, out_msg);
1753
1754
1755 wake_driver:
1756 event_message = 0;
1757 addr (event_message) -> ev_msg.code = code;
1758
1759 call hcs_$wakeup (proc_id, chan_name, event_message, code);
1760 if code ^= 0
1761 then call check_wakeup_code (code);
1762 go to iodc_return;
1763 %page;
1764
1765 restart_queue:
1766
1767
1768
1769 wlp = iodc_static.wait_list_ptr;
1770 qgte.last_read (*) = ""b;
1771
1772 do dcx = qgte.first_dev_class to qgte.last_dev_class;
1773 dctep = addr (iodc_static.dctp -> dev_class_tab.entries (dcx));
1774 do q = 1 to 4;
1775 nx = dcte.first_waiting (q);
1776 if nx ^= 0
1777 then do;
1778 lwx, fwx = 0;
1779 do x = nx repeat nx while (nx ^= 0);
1780 nx = wlp -> waiting_list.next (x);
1781
1782 if wlp -> waiting_list.state (x) = priority
1783 then do;
1784 if fwx = 0
1785 then fwx = x;
1786 else wlp -> waiting_list.next (lwx) = x;
1787
1788 lwx = x;
1789 wlp -> waiting_list.next (x) = 0;
1790
1791 end;
1792 else do;
1793 if x = wlp -> waiting_list.last_used
1794 then do;
1795 wlp -> waiting_list.next (x) = 0;
1796 wlp -> waiting_list.last_used = wlp -> waiting_list.last_used - 1;
1797 end;
1798 else do;
1799 wlp -> waiting_list.next (x) = wlp -> waiting_list.first_free;
1800 wlp -> waiting_list.first_free = x;
1801 end;
1802 wlp -> waiting_list.state (x) = 0;
1803
1804 wlp -> waiting_list.ms_id (x) = ""b;
1805 wlp -> waiting_list.orig_q (x) = 0;
1806 dcte.n_waiting = dcte.n_waiting - 1;
1807
1808 end;
1809 end;
1810 dcte.first_waiting (q) = fwx;
1811 dcte.last_waiting (q) = lwx;
1812 end;
1813 end;
1814 end;
1815
1816 call driver_ack (0, 0);
1817 go to iodc_return;
1818 %page;
1819
1820 next_request:
1821
1822
1823
1824
1825
1826 if iodd_comm.queue_no = 0
1827 then do;
1828 start = 1;
1829 finish = qgte.max_queues;
1830 end;
1831 else start, finish = iodd_comm.queue_no;
1832
1833 if start < 1 | finish > qgte.max_queues
1834 then do;
1835 code = error_table_$action_not_performed;
1836 go to bad_req;
1837 end;
1838
1839 user_id = iodd_comm.user_id;
1840 string (option) = iodd_comm.type_ext;
1841
1842 if option.et
1843 then do;
1844 option.pn = ""b;
1845 match_dir = "";
1846 match_ent = iodd_comm.data;
1847 end;
1848 else if option.pn
1849 then do;
1850 call expand_pathname_ (iodd_comm.data, match_dir, match_ent, code);
1851 if code ^= 0
1852 then go to bad_req;
1853 end;
1854 else do;
1855 match_dir, match_ent = "";
1856 if ^option.id
1857 then do;
1858 code = error_table_$action_not_performed;
1859 go to bad_req;
1860 end;
1861 end;
1862
1863
1864
1865 code = 0;
1866
1867 do q = start to finish;
1868 q_idx = qgte.mseg_index (q);
1869 ms_id = ""b;
1870
1871 retry = 0;
1872 retry1:
1873 unspec (msg_mmi) = ""b;
1874 msg_mmi.version = MSEG_MESSAGE_INFO_V1;
1875 msg_mmi.message_code = MSEG_READ_FIRST;
1876 call message_segment_$read_message_index (q_idx, areap, addr (msg_mmi), code2);
1877 if code2 ^= 0
1878 then
1879 if code2 = error_table_$bad_segment
1880 then if retry = 0
1881 then do;
1882 retry = 1;
1883 go to retry1;
1884 end;
1885
1886 do while (code2 = 0);
1887 ms_id = msg_mmi.ms_id;
1888 reqp = msg_mmi.ms_ptr;
1889
1890 sender_id = msg_mmi.sender_id;
1891 len = length (rtrim (sender_id));
1892 sender_id = substr (sender_id, 1, len - 2);
1893
1894
1895 if sender_id ^= user_id
1896 then go to next_msg;
1897
1898
1899 if option.et
1900 then if match_ent ^= reqp -> queue_msg_hdr.ename
1901 then go to next_msg;
1902
1903 if option.pn
1904 then do;
1905 if match_ent ^= reqp -> queue_msg_hdr.ename
1906 then go to next_msg;
1907 if match_dir ^= reqp -> queue_msg_hdr.dirname
1908 then go to next_msg;
1909 end;
1910
1911 if option.id
1912 then if ^match_request_id_ (reqp -> queue_msg_hdr.msg_time, iodd_comm.req_id)
1913 then go to next_msg;
1914
1915
1916
1917 auth = msg_mmi.sender_authorization;
1918
1919 if ^aim_check_$greater_or_equal (auth, dcte.min_access)
1920 then
1921 code = error_table_$ai_restricted;
1922 else if aim_check_$greater_or_equal (dcte.max_access, auth)
1923 then do;
1924 reqp -> queue_msg_hdr.state = STATE_ELIGIBLE;
1925 retry = 0;
1926 retry3:
1927 call message_segment_$update_message_index (q_idx, msg_mmi.ms_len, ms_id, reqp, code2);
1928 if code2 ^= 0
1929 then do;
1930 if code2 = error_table_$bad_segment
1931
1932 then if retry = 0
1933 then do;
1934 retry = 1;
1935 go to retry3;
1936 end;
1937
1938 go to next_msg;
1939 end;
1940 go to found_next_request;
1941 end;
1942 else code = error_table_$ai_above_allowed_max;
1943
1944
1945
1946 next_msg:
1947 free reqp -> queue_msg_hdr in (sys_area);
1948
1949 retry = 0;
1950 retry2:
1951 unspec (msg_mmi) = ""b;
1952 msg_mmi.version = MSEG_MESSAGE_INFO_V1;
1953 msg_mmi.ms_id = ms_id;
1954 msg_mmi.message_code = MSEG_READ_AFTER_SPECIFIED;
1955 call message_segment_$read_message_index (q_idx, areap, addr (msg_mmi), code2);
1956 if code2 ^= 0
1957 then
1958 if code2 = error_table_$bad_segment
1959 then if retry = 0
1960 then do;
1961 retry = 1;
1962 go to retry2;
1963 end;
1964 end;
1965 end;
1966
1967
1968
1969 if code = 0
1970 then code = error_table_$noentry;
1971 go to bad_req;
1972
1973 found_next_request:
1974 free reqp -> queue_msg_hdr in (sys_area);
1975
1976
1977
1978 wlp = iodc_static.wait_list_ptr;
1979
1980 if wlp -> waiting_list.first_free > 0
1981 then do;
1982 new_idx = wlp -> waiting_list.first_free;
1983
1984 wlp -> waiting_list.first_free = wlp -> waiting_list.next (new_idx);
1985
1986 end;
1987 else do;
1988 if wlp -> waiting_list.last_used = max_wl_size
1989 then do;
1990 call iodc_message_ ("101"b, 0, "Waiting_list full.");
1991 code = error_table_$action_not_performed;
1992 go to bad_req;
1993 end;
1994 new_idx = wlp -> waiting_list.last_used + 1;
1995
1996 wlp -> waiting_list.last_used = new_idx;
1997 end;
1998
1999 wlp -> waiting_list.next (new_idx) = 0;
2000 wlp -> waiting_list.state (new_idx) = priority;
2001 wlp -> waiting_list.ms_id (new_idx) = ms_id;
2002 wlp -> waiting_list.orig_q (new_idx) = q;
2003
2004 nx = dcte.first_waiting (1);
2005 if nx > 0
2006 then do;
2007 lwx = 0;
2008 do x = nx repeat nx while (nx ^= 0);
2009 nx = wlp -> waiting_list.next (x);
2010 if wlp -> waiting_list.state (x) ^= priority
2011 then do;
2012 nx = 0;
2013 wlp -> waiting_list.next (new_idx) = x;
2014
2015 if lwx = 0
2016 then dcte.first_waiting (1) = new_idx;
2017
2018 else wlp -> waiting_list.next (lwx) = new_idx;
2019
2020 end;
2021 else if nx = 0
2022 then do;
2023 wlp -> waiting_list.next (x) = new_idx;
2024
2025 dcte.last_waiting (1) = new_idx;
2026
2027 end;
2028 lwx = x;
2029 end;
2030 end;
2031 else dcte.first_waiting (1), dcte.last_waiting (1) = new_idx;
2032
2033
2034 dcte.n_waiting = dcte.n_waiting + 1;
2035
2036 call driver_ack (0, 0);
2037 go to iodc_return;
2038 %page;
2039
2040 proc_dies:
2041 call ioa_$rsnnl ("^a^/New coordinator process will be created. All device drivers will be reinitialized.",
2042 out_msg, out_len, out_msg);
2043 call iodc_message_$loud ("001"b, code, out_msg);
2044
2045
2046
2047 if scu_msg ^= ""
2048 then call iodc_message_ ("100"b, code, scu_msg);
2049 call new_proc;
2050 %page;
2051
2052 quit_handler:
2053 proc;
2054
2055
2056
2057
2058 dcl mask_code fixed bin (35);
2059
2060 if quit_flag
2061 then if ^testing
2062 then do;
2063 call com_err_ (0, "io_coordinator", "QUIT already pending.");
2064 return;
2065 end;
2066
2067 mask_code = -1;
2068 on cleanup
2069 begin;
2070 if mask_code = 0
2071 then call ipc_$unmask_ev_calls (code2);
2072 end;
2073 call ipc_$mask_ev_calls (mask_code);
2074
2075 quit_flag = "1"b;
2076 call ioa_ ("QUIT received.");
2077 call iox_$control (iox_$user_input, "resetread", null (), code);
2078
2079 call iodc_$command_level;
2080
2081 quit_flag = "0"b;
2082 call ipc_$unmask_ev_calls (code2);
2083 call iox_$control (iox_$user_io, "start", null, code);
2084 return;
2085
2086 end quit_handler;
2087 %page;
2088
2089 command_level:
2090 entry;
2091
2092
2093
2094
2095
2096
2097 com_level = com_level + 1;
2098 mask_code = -1;
2099
2100 on cleanup
2101 begin;
2102 com_level = com_level - 1;
2103 if mask_code = 0
2104 then call ipc_$unmask_ev_calls (code2);
2105 end;
2106
2107 if com_level > 0
2108 then
2109 ask:
2110 call ioa_ ("Enter command.^[ (level ^d)^;^s^]", (com_level > 1), com_level);
2111
2112 if mask_code = 0
2113 then do;
2114 call ipc_$unmask_ev_calls (code2);
2115 mask_code = -1;
2116 end;
2117
2118 line = "";
2119 call iox_$get_line (iox_$user_input, addr (line), length (line), nc, code);
2120 line = ltrim (rtrim (line, NL || " "));
2121 cmd = before (line, " ");
2122 if cmd = "" | cmd = "."
2123 then go to ask;
2124
2125 call ipc_$mask_ev_calls (mask_code);
2126
2127 if cmd = "help"
2128 then do;
2129 call ioa_ ("list, logout, print_devices, restart_status, start, term, wait_status");
2130 if testing
2131 then call ioa_ ("**Test: debug, probe, driver, pi, return");
2132 go to ask;
2133 end;
2134
2135 if cmd = "start"
2136 then if com_level > 0
2137 then do;
2138 com_level = com_level - 1;
2139 if mask_code = 0
2140 then call ipc_$unmask_ev_calls (code2);
2141 return;
2142 end;
2143 else do;
2144 call com_err_ (0, "io_coordinator", "Coordinator already started.");
2145 go to ask;
2146 end;
2147
2148 if cmd = "return"
2149 then
2150 if testing
2151 then go to return_label;
2152 else go to bad_cmd;
2153
2154 if cmd = "debug" DEBUG
2155 then if testing
2156 then do;
2157 call debug;
2158 go to ask;
2159 end;
2160
2161 if cmd = "probe" | cmd = "pb"
2162 then if testing
2163 then do;
2164 call probe;
2165 go to ask;
2166 end;
2167
2168 if cmd = "pi"
2169 then if testing
2170 then do;
2171 call signal_ ("program_interrupt");
2172 go to ask;
2173 end;
2174
2175 if cmd = "logout"
2176 then if testing
2177 then go to return_label;
2178 else call logout;
2179
2180 if ^initialized
2181 then go to bad_cmd;
2182
2183 if cmd = "print_devices"
2184 then do;
2185 call print_devices ("-dir", sysdir);
2186 go to ask;
2187 end;
2188
2189 if cmd = "list"
2190 then do;
2191 i = 0;
2192 do idtx = 1 to static_idtp -> iod_device_tab.n_devices;
2193 idtep = addr (static_idtp -> iod_device_tab.entries (idtx));
2194 if idte.process_id ^= ""b
2195 then do mdtx = idte.first_minor to idte.last_minor;
2196 mdtep = addr (static_mdtp -> minor_device_tab.entries (mdtx));
2197 if mdte.active = 1
2198 then do;
2199 dctep =
2200 addr (iodc_static.dctp -> dev_class_tab.entries (mdte.dev_class_index));
2201 qgtep = addr (iodc_static.qgtp -> q_group_tab.entries (dcte.qgte_index));
2202 sender_device = get_device_name ();
2203 sender_class = get_class_name ();
2204 call ioa_ ("device ^a is active, request type ^a, request ^d", sender_device,
2205 sender_class, mdte.seq_id);
2206 i = i + 1;
2207 end;
2208 end;
2209 end;
2210 if i = 0
2211 then call ioa_ ("No active devices");
2212 go to ask;
2213 end;
2214
2215 if cmd = "restart_status"
2216 then do;
2217 nseries = divide (new_driver_series, 10000, 35, 0);
2218 if nseries = 0
2219 then go to no_restartable;
2220
2221 allocate series_info in (sys_area);
2222 series_info (*).count = 0;
2223
2224 desc_off = iodc_static.first_req_done;
2225 do while (desc_off ^= 0);
2226 desc_ptr = ptr (iodc_static.descr_seg_ptr, desc_off);
2227 series_id = divide (desc_ptr -> request_descriptor.seq_id, 10000, 35, 0);
2228
2229 if series_info (series_id).count = 0
2230 then do;
2231 series_info (series_id).first = desc_ptr -> request_descriptor.seq_id;
2232 series_info (series_id).dcx = desc_ptr -> request_descriptor.dev_class_index;
2233 end;
2234 series_info (series_id).last = desc_ptr -> request_descriptor.seq_id;
2235 series_info (series_id).count = series_info (series_id).count + 1;
2236
2237 desc_off = desc_ptr -> request_descriptor.next_done;
2238 end;
2239
2240 i = 0;
2241 do series_id = 1 to nseries;
2242 if series_info (series_id).count > 0
2243 then do;
2244 dctep = addr (iodc_static.dctp -> dev_class_tab.entries (series_info (series_id).dcx));
2245 qgtep = addr (iodc_static.qgtp -> q_group_tab.entries (dcte.qgte_index));
2246 sender_class = get_class_name ();
2247
2248
2249 call ioa_ ("^d restartable request(s) from ^d to ^d (^a)",
2250 series_info (series_id).count, series_info (series_id).first,
2251 series_info (series_id).last, sender_class);
2252
2253 if dcte.restart_req ^= 0
2254 then do;
2255 desc_ptr = ptr (iodc_static.descr_seg_ptr, dcte.restart_req);
2256 if divide (desc_ptr -> request_descriptor.seq_id, 10000, 35, 0) = series_id
2257 then call ioa_ (" restart in progress at request ^d",
2258 desc_ptr -> request_descriptor.seq_id);
2259 end;
2260
2261 i = i + 1;
2262 end;
2263 end;
2264
2265 free series_info in (sys_area);
2266
2267 if i = 0
2268 then
2269 no_restartable:
2270 call ioa_ ("No restartable requests.");
2271
2272 go to ask;
2273 end;
2274
2275 if cmd = "wait_status" | cmd = "defer_status"
2276 then do;
2277 i = 0;
2278 do q = 1 to iodc_static.qgtp -> q_group_tab.n_q_groups;
2279 qgtep = addr (iodc_static.qgtp -> q_group_tab.entries (q));
2280 if qgte.open = 1
2281 then do dcx = qgte.first_dev_class to qgte.last_dev_class;
2282 dctep = addr (iodc_static.dctp -> dev_class_tab.entries (dcx));
2283 if dcte.n_waiting ^= 0
2284 then do;
2285 sender_class = get_class_name ();
2286 call ioa_ ("^d request(s) waiting for device class ^a", dcte.n_waiting,
2287 sender_class);
2288 i = i + 1;
2289 end;
2290 end;
2291 end;
2292 if i = 0
2293 then call ioa_ ("No waiting requests");
2294 go to ask;
2295 end;
2296
2297 if cmd = "term"
2298 then if com_level > 0
2299 then go to not_after_quit;
2300 else do;
2301
2302
2303
2304 dev_id = ltrim (substr (line, 5));
2305 if dev_id = ""
2306 then do;
2307 call ioa_ ("Name of major device missing: term <devid>");
2308 go to ask;
2309 end;
2310
2311 do idtx = 1 to static_idtp -> iod_device_tab.n_devices;
2312 idtep = addr (static_idtp -> iod_device_tab.entries (idtx));
2313 if idte.dev_id = dev_id
2314 then do;
2315 call iodc_$free_device (idtep, code);
2316 go to ask;
2317 end;
2318 end;
2319 call com_err_ (0, "io_coordinator", "Unrecognized device name: ^a", dev_id);
2320
2321 go to ask;
2322 end;
2323
2324 if cmd = "driver"
2325 then
2326 if testing
2327 then if com_level > 0
2328 then go to not_after_quit;
2329 else do;
2330 if mask_code = 0
2331 then do;
2332 call ipc_$unmask_ev_calls (code2);
2333 mask_code = -1;
2334 end;
2335 call iodd_$iodd_init (sysdir, "1"b);
2336 go to ask;
2337 end;
2338
2339 bad_cmd:
2340 call com_err_ (0, "io_coordinator", "Invalid response
2341 go to ask;
2342
2343
2344 not_after_quit:
2345 if testing
2346 then call com_err_ (0, id, "Specified command can only be used at command level 0: ^a", cmd);
2347 else call com_err_ (0, id, "Specified command cannot be used after a QUIT: ^a", cmd);
2348
2349 go to ask;
2350 %page;
2351
2352 area_handler:
2353 proc;
2354
2355
2356
2357
2358
2359
2360 if area_flag ^= 0
2361 then do;
2362 out_msg = "Multiple area condition in request descriptor segment.";
2363 go to proc_dies;
2364 end;
2365
2366 area_flag = 1;
2367 call free_oldest_request_$force;
2368 return;
2369
2370 end;
2371 %page;
2372
2373 check_wakeup_code:
2374 proc (wcode);
2375
2376
2377
2378 dcl wcode fixed bin (35);
2379 dcl wp ptr;
2380 dcl code fixed bin (35);
2381
2382 dcl 1 two based aligned,
2383 2 word1 fixed bin,
2384 2 word2 fixed bin;
2385
2386
2387 if wcode = 2
2388 then call ioa_$rsnnl ("Invalid arguments to hcs_$wakeup.", out_msg, out_len);
2389
2390 else if wcode = 1 | wcode = 3
2391 then do;
2392 call ioa_$rsnnl ("Driver for device ^a is gone.", out_msg, out_len, idte.dev_id);
2393 call iodc_$free_device (idtep, code);
2394 end;
2395
2396 else do;
2397 wp = addr (dr_ptr -> driver_status.driver_chan);
2398 call ioa_$rsnnl ("^w ^w", out_msg, out_len, wp -> two.word1, wp -> two.word2);
2399 end;
2400
2401 if wcode < 4
2402 then wcode = 0;
2403 call iodc_message_$loud ("101"b, wcode, out_msg);
2404
2405 return;
2406
2407 end;
2408 %page;
2409
2410 iodc_handler:
2411 proc;
2412
2413
2414
2415 dcl conname char (32);
2416 dcl ec fixed bin (35);
2417
2418 dcl ap ptr;
2419 dcl mp ptr;
2420
2421 dcl m_len fixed bin;
2422
2423 dcl cond_mess char (m_len) based (mp);
2424
2425 dcl find_condition_info_ entry (ptr, ptr, fixed bin (35));
2426 dcl continue_to_signal_ entry (fixed bin (35));
2427 dcl condition_interpreter_ entry (ptr, ptr, fixed bin, fixed bin, ptr, char (*), ptr, ptr);
2428 dcl ioa_$ioa_stream_nnl entry options (variable);
2429
2430 dcl w (8) fixed bin based (scup);
2431
2432
2433 dcl 1 local_condition_info aligned like condition_info;
2434
2435 local_condition_info.version = condition_info_version_1;
2436
2437 call find_condition_info_ (null, addr (local_condition_info), ec);
2438 conname = local_condition_info.condition_name;
2439
2440 if conname = "command_question"
2441 then return;
2442 if conname = "command_error"
2443 then return;
2444
2445 if conname = "cput"
2446 then do;
2447 pass_on:
2448 call continue_to_signal_ (ec);
2449 return;
2450 end;
2451 if conname = "alrm"
2452 then go to pass_on;
2453 if conname = "finish"
2454 then go to pass_on;
2455 if testing
2456 then if conname = "program_interrupt"
2457 then go to pass_on;
2458 else if conname = "mme2"
2459 then go to pass_on;
2460
2461 call get_system_free_area_ (ap);
2462 call condition_interpreter_ (ap, mp, m_len, 3, local_condition_info.mc_ptr, conname,
2463 local_condition_info.wc_ptr, local_condition_info.info_ptr);
2464
2465
2466
2467 if m_len > 0
2468 then do;
2469 call ioa_$ioa_stream_nnl ("error_output", "io_coordinator: ");
2470 call iodc_message_ ("101"b, 0, cond_mess);
2471 end;
2472
2473 if testing
2474 then do;
2475 call iodc_$command_level;
2476 return;
2477 end;
2478
2479
2480 if recursion_flag ^= 0
2481 then do;
2482 call ioa_$rsnnl ("Condition ^a signalled while handling unclaimed signal.", out_msg, out_len, conname)
2483 ;
2484
2485
2486
2487 if local_condition_info.mc_ptr ^= null
2488 then do;
2489 scup = addr (local_condition_info.mc_ptr -> mc.scu);
2490 code = local_condition_info.mc_ptr -> mc.errcode;
2491 call ioa_$rsnnl ("^/scu: ^w ^w ^w ^w^/^5x^w ^w ^w ^w", scu_msg, out_len, w (1), w (2),
2492 w (3), w (4), w (5), w (6), w (7), w (8));
2493 end;
2494
2495 else do;
2496 code = 0;
2497 scu_msg = "";
2498 end;
2499
2500 go to proc_dies;
2501 end;
2502
2503 recursion_flag = 1;
2504 go to err_label;
2505
2506 end;
2507 %page;
2508 %include condition_info;
2509 %page;
2510 %include create_branch_info;
2511 %page;
2512 %include device_class;
2513 %page;
2514 %include driver_status;
2515 %page;
2516 %include iod_device_tab;
2517 %page;
2518 %include iod_event_message;
2519 %page;
2520 %include iod_tables_hdr;
2521 %page;
2522 %include iodc_data;
2523 %page;
2524 %include iodc_static;
2525 %page;
2526 %include iodc_wait_list;
2527 %page;
2528 %include iodd_comm;
2529 %page;
2530 %include mc;
2531 %page;
2532 %include mseg_message_info;
2533 %page;
2534 %include new_driver_msg;
2535 %page;
2536 %include q_group_tab;
2537 %page;
2538 %include queue_msg_hdr;
2539 %page;
2540 %include request_descriptor;
2541
2542 end iodc_;