1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16 iodd_: proc;
17
18
19
20
21
22 return;
23
24
25 iodd_init: entry (system_dir, testing);
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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90 %page;
91
92
93 dcl system_dir char (*),
94 testing bit (1) aligned;
95
96
97
98
99 dcl aim_check_$greater_or_equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
100 dcl charge_user_ entry (char (*), char (*), ptr, fixed bin (35));
101 dcl convert_dial_message_
102 entry (fixed bin (71), char (*) aligned, char (*) aligned, fixed bin, 1 aligned like status_flags,
103 fixed bin (35));
104 dcl convert_ipc_code_ entry (fixed bin (35));
105 dcl continue_to_signal_ entry (fixed bin (35));
106 dcl cv_entry_ entry (char (*), ptr, fixed bin (35)) returns (entry);
107 dcl debug entry options (variable);
108 dcl dial_manager_$allow_dials entry (ptr, fixed bin (35));
109 dcl dial_manager_$privileged_attach entry (ptr, fixed bin (35));
110 dcl dial_manager_$release_channel entry (ptr, fixed bin (35));
111 dcl get_at_entry_ entry (char (*), char (*) aligned, char (*) aligned, char (*)) returns (fixed bin (35));
112 dcl get_group_id_ entry () returns (char (32));
113 dcl get_group_id_$tag_star entry () returns (char (32));
114 dcl get_process_id_ entry () returns (bit (36));
115 dcl get_authorization_ entry () returns (bit (72) aligned);
116 dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
117 dcl hcs_$make_ptr entry (ptr, char (*), char (*), ptr, fixed bin (35));
118 dcl hcs_$terminate_name entry (char (*), fixed bin (35));
119 dcl hcs_$terminate_file entry (char (*), char (*) aligned, fixed bin (1), fixed bin (35));
120 dcl hcs_$terminate_noname entry (ptr, fixed bin (35));
121 dcl hcs_$tty_index entry (char (*) aligned, fixed bin, fixed bin, fixed bin (35));
122 dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
123 dcl head_sheet_$print_head_sheet entry (ptr, ptr, ptr, fixed bin (35));
124 dcl head_sheet_$print_separator entry (ptr, ptr, char (*), fixed bin (35));
125 dcl head_sheet_$test entry (char (*));
126 dcl ioa_$ioa_stream entry () options (variable);
127 dcl ioa_$rsnnl entry () options (variable);
128 dcl io_daemon_account_$set_line_prices entry (fixed bin, ptr, fixed bin (35));
129 dcl iodd_command_processor_$init entry (ptr);
130 dcl iodd_hangup_$iodd_hangup_ entry (ptr);
131 dcl iodd_msg_ entry options (variable);
132 dcl iodd_quit_handler_$init entry (ptr);
133 dcl iodd_signal_handler_ entry;
134 dcl iodd_signal_handler_$init entry (ptr);
135 dcl ios_$attach entry (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned);
136 dcl ios_$detach entry (char (*) aligned, char (*) aligned, char (*) aligned, bit (72) aligned);
137 dcl ios_$write entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned);
138 dcl ios_$order entry (char (*) aligned, char (*) aligned, ptr, bit (72) aligned);
139 dcl ipc_$drain_chn entry (fixed bin (71), fixed bin (35));
140 dcl ipc_$block entry (ptr, ptr, fixed bin (35));
141 dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35));
142 dcl ipc_$decl_ev_call_chn entry (fixed bin (71), ptr, ptr, fixed bin, fixed bin (35));
143 dcl ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35));
144 dcl ipc_$decl_ev_wait_chn entry (fixed bin (71), fixed bin (35));
145 dcl logout entry () options (variable);
146 dcl message_segment_$add_file entry (char (*), char (*), ptr, fixed bin, bit (72) aligned, fixed bin (35));
147 dcl iodd_parse_$command entry (char (*), ptr, fixed bin (35));
148 dcl probe entry options (variable);
149 dcl print_devices entry options (variable);
150 dcl print_line_ids entry options (variable);
151 dcl read_password_$switch entry (ptr, ptr, char (*), char (*), fixed bin (35));
152 dcl scramble_ entry (char (8)) returns (char (8));
153 dcl set_iod_val entry options (variable);
154 dcl set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35));
155 dcl tail_sheet_$print_tail_sheet entry (ptr, ptr, ptr, fixed bin (35));
156 dcl timer_manager_$alarm_call entry (fixed bin (71), bit (2), entry);
157 dcl timer_manager_$reset_alarm_call entry (entry);
158 dcl timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71));
159 dcl timer_manager_$reset_alarm_wakeup entry (fixed bin (71));
160 dcl timer_manager_$sleep entry (fixed bin (71), bit (2));
161 dcl validate_card_input_$station entry (char (*), char (*), char (*), fixed bin (35));
162 dcl write_control_form_$init entry (ptr);
163
164
165
166
167 dcl code fixed bin (35);
168 dcl dev_label char (32);
169 dcl dev_class char (32);
170 dcl queue_type char (32);
171 dcl request_type char (64);
172 dcl table_time fixed bin (71);
173 dcl first_arg char (32);
174 dcl second_arg char (64);
175 dcl dev_name char (32) aligned;
176 dcl dim_name char (32) aligned;
177 dcl (i, j) fixed bin;
178 dcl ig char (4);
179 dcl io_stat bit (72) aligned;
180 dcl line char (120);
181 dcl nchars fixed bin (21);
182 dcl init_ev_chan fixed bin (71);
183 dcl iodc_data_ptr ptr;
184 dcl seg_name char (32);
185 dcl question char (64);
186 dcl use_default bit (1);
187 dcl msgp ptr;
188 dcl message_id bit (72) aligned;
189 dcl driver_dir char (168);
190 dcl rqt_name char (32);
191 dcl rqt_string char (168) var;
192 dcl rqti_dir char (168);
193 dcl sys_dir char (168);
194 dcl meter_dir char (168);
195 dcl entry_name char (32);
196 dcl entry_variable entry variable options (variable);
197 dcl times fixed bin;
198 dcl temp_dir char (168) varying;
199 dcl temp_dir_entry char (256);
200 dcl temp_password char (8);
201 dcl temp_ptr ptr;
202 dcl input_iocbp ptr;
203
204 dcl 1 st aligned based (addr (io_stat)),
205 2 code fixed bin (35) aligned,
206 2 stat bit (36) aligned;
207
208 dcl temp_label label variable;
209 dcl based_ptr ptr based;
210 dcl ref_ptr ptr;
211 dcl 1 driver_message aligned like new_driver_msg;
212 %page;
213
214
215
216 dcl iodd_stat_p ptr ext static;
217
218 dcl error_table_$ionmat fixed bin (35) ext static;
219 dcl error_table_$not_detached fixed bin (35) ext static;
220 dcl error_table_$not_closed fixed bin (35) ext static;
221 dcl error_table_$noentry fixed bin (35) ext static;
222 dcl error_table_$ai_restricted fixed bin (35) ext static;
223 dcl error_table_$user_not_found fixed bin (35) ext static;
224 dcl error_table_$noarg fixed bin (35) ext static;
225 dcl error_table_$badopt fixed bin (35) ext static;
226 dcl error_table_$no_ext_sym fixed bin (35) ext static;
227 dcl error_table_$no_operation fixed bin (35) ext static;
228 dcl error_table_$namedup fixed bin (35) ext static;
229
230
231
232
233 dcl io_daemon_driver_version char (8) int static options (constant) init ("5.7");
234
235 dcl null_stream char (32) int static init ("iodd_null_stream") options (constant);
236 dcl bel_string char (40) aligned int static options (constant) init ((40)"^G");
237 dcl stars char (50) aligned int static options (constant) init ((5)"**********");
238 dcl error fixed bin int static options (constant) init (2);
239 dcl normal fixed bin int static options (constant) init (1);
240 dcl master fixed bin int static options (constant) init (1);
241 dcl slave fixed bin int static options (constant) init (2);
242 dcl both fixed bin int static options (constant) init (0);
243 dcl id char (24) int static options (constant) init ("iodd_");
244 dcl STATION_PW_PROMPT char (23) static options (constant) init ("Enter station password:");
245 dcl try_10_times fixed bin int static options (constant) init (10);
246 dcl try_0_times fixed bin int static options (constant) init (0);
247
248 dcl 1 real_iodd_static int static aligned like iodd_static;
249
250 dcl NL char (1) int static options (constant) init ("
251 ");
252
253 dcl FF char (1) int static options (constant) init ("^L");
254
255 dcl 1 driver_list aligned int static,
256 2 dummy (32) fixed bin (71);
257
258
259
260
261 dcl (addr, after, before, bit, char, fixed, hbound, index, length, ltrim,
262 null, ptr, rtrim, size, string, substr, unspec) builtin;
263 %page;
264
265
266
267 dcl 1 request_dev aligned,
268 2 major_name char (32),
269 2 major_index fixed bin,
270 2 n_minor fixed bin,
271 2 minor (30) aligned,
272 3 name char (32) unal,
273 3 index fixed bin,
274 3 dev_class char (32),
275 3 dvc_index fixed bin;
276
277 dcl 1 event_info aligned,
278 2 channel fixed bin (71),
279 2 message fixed bin (71),
280 2 sender bit (36),
281 2 origin,
282 3 dev_signal bit (18) unal,
283 3 rings bit (18) unal,
284 2 wait_list_index fixed bin;
285
286 dcl 1 ev_chan_list aligned,
287 2 number fixed bin,
288 2 channel (32) fixed bin (71);
289
290 dcl 1 read_info aligned,
291 2 ev_chan fixed bin (71),
292 2 input_pending bit (1);
293
294 dcl 1 input aligned,
295 2 max fixed bin,
296 2 number fixed bin,
297 2 arg (4) char (64) var;
298
299 dcl 1 status_flags aligned,
300 2 dialed_up bit (1) unal,
301 2 hung_up bit (1) unal,
302 2 control bit (1) unal,
303 2 stat_pad bit (33) unal;
304
305 dcl 1 release_arg aligned like dial_manager_arg;
306 %page;
307
308 dcl (quit, any_other, daemon_logout, daemon_slave_logout, program_interrupt, no_coord, seg_fault_error,
309 daemon_new_device, command_error, alrm, daemon_idle) condition;
310 %page;
311
312 stat_p = addr (real_iodd_static);
313 sys_dir = system_dir;
314 iodd_static.sys_dir_ptr = addr (sys_dir);
315 iodd_static.flags.test_entry = testing;
316 iodd_stat_p = stat_p;
317 iodd_static.io_daemon_version = io_daemon_driver_version;
318
319 rqti_dir = rtrim (sys_dir) || ">rqt_info_segs";
320 meter_dir = rtrim (sys_dir) || ">meter_data";
321 list_ptr = addr (driver_list);
322 driver_ptr_list.number = 0;
323 iodd_static.auto_start_delay = 60;
324 iodd_static.timer_chan = 0;
325 iodd_static.cmd_ack_chan = 0;
326
327 iodd_static.re_init_label = re_init_driver;
328 iodd_static.no_coord_label = no_coord_signal;
329
330 call iodd_signal_handler_$init (stat_p);
331
332 on quit call early_quit;
333 on daemon_logout go to driver_logout_label;
334 on daemon_slave_logout go to driver_logout_label;
335 on daemon_new_device go to start_new_device_cleanup;
336
337 on daemon_idle
338 begin;
339 end;
340 on any_other call iodd_signal_handler_;
341
342
343 call ios_$order ("user_i/o", "quit_enable", null (), io_stat);
344
345 code = get_at_entry_ ("user_i/o", dim_name, dev_name, ig);
346
347 if dim_name = "mrd_" then do;
348 call ios_$attach ("error_i/o", "mrd_", dev_name, "", io_stat);
349 call ios_$attach ("log_i/o", "mrd_", dev_name, "", io_stat);
350 end;
351 else do;
352 call ios_$attach ("error_i/o", "syn", "user_i/o", "", io_stat);
353 call ios_$attach ("log_i/o", "syn", "user_i/o", "", io_stat);
354 end;
355
356 call ios_$attach ("master_output", "syn", "user_i/o", "", io_stat);
357 call ios_$attach ("master_input", "syn", "user_i/o", "", io_stat);
358 call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat);
359 call ios_$attach ("log_output", "syn", "log_i/o", "", io_stat);
360
361 call iox_$look_iocb ("master_output", iodd_static.master_out, code);
362 call iox_$look_iocb ("master_input", iodd_static.master_in, code);
363 call iox_$look_iocb ("log_output", iodd_static.log_iocbp, code);
364 call iox_$look_iocb ("error_i/o", iodd_static.error_io, code);
365
366 call iodd_msg_ (normal, master, 0, "", "^/IO Daemon Driver Version: ^a^[^/Driver running in test mode.^]^/",
367 iodd_static.io_daemon_version, iodd_static.test_entry);
368
369 temp_label = out;
370 ref_ptr = addr (temp_label) -> based_ptr;
371 %page;
372
373 iodd_static.ctl_term.ctl_attach_name = "";
374 iodd_static.ctl_term.ctl_attach_type = 0;
375 iodd_static.ctl_term.ctl_dial_chan = 0;
376 iodd_static.ctl_term.ctl_ev_chan = 0;
377 iodd_static.ctl_term.ctl_device = "";
378 iodd_static.ctl_term.ctl_dev_dim = "";
379 iodd_static.ctl_term.attached = "0"b;
380
381 new_device:
382 iodd_static.ctl_term.form_type = "undefined_form";
383 iodd_static.ctl_term.forms = "0"b;
384 iodd_static.slave.active = "0"b;
385 iodd_static.slave_ev_chan = 0;
386 iodd_static.slave_in, iodd_static.slave_out = null;
387 iodd_static.slave_input, iodd_static.slave_output = null_stream;
388 iodd_static.slave.allow_quits = "0"b;
389 iodd_static.slave.accept_input = "0"b;
390 iodd_static.slave.print_errors = "0"b;
391 iodd_static.slave.log_msg = "0"b;
392 iodd_static.slave.echo_cmd = "0"b;
393 iodd_static.slave.priv1 = "0"b;
394 iodd_static.slave.priv2 = "0"b;
395 iodd_static.slave.priv3 = "0"b;
396 iodd_static.re_init_in_progress = "0"b;
397 iodd_static.wakeup_time = 30;
398 iodd_static.recursion_flag = "0"b;
399 iodd_static.no_coord_flag = "0"b;
400 iodd_static.initialized = "0"b;
401 iodd_static.dummy_ptr = null;
402 iodd_static.attach_type = 0;
403 iodd_static.line_tab_idx = 0;
404 iodd_static.major_device = "";
405
406 if iodd_static.timer_chan ^= 0 then
407 call ipc_$delete_ev_chn (iodd_static.timer_chan, code);
408 if iodd_static.cmd_ack_chan ^= 0 then
409 call ipc_$delete_ev_chn (iodd_static.cmd_ack_chan, code);
410
411 call ipc_$create_ev_chn (iodd_static.timer_chan, code);
412 if code ^= 0 then do;
413 no_ipc:
414 call convert_ipc_code_ (code);
415 call iodd_msg_ (error, master, code, id, "Fatal error: Unable to create event channel.");
416 go to out;
417 end;
418
419 call ipc_$create_ev_chn (iodd_static.cmd_ack_chan, code);
420 if code ^= 0 then
421 go to no_ipc;
422
423 call io_daemon_account_$set_line_prices (0, null, code);
424 %page;
425
426
427
428 ask_for_dev:
429 if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then
430 go to get_tables;
431
432 call iodd_msg_ (normal, master, 0, "", "Enter command or device/request_type:");
433
434 get_dev_id:
435 call iox_$get_line (iodd_static.master_in, addr (line), 120, nchars, code);
436 if code ^= 0 then do;
437 no_master:
438 call iodd_msg_ (error, master, code, id, "Fatal_error: Unable to read from master console.");
439 go to out;
440 end;
441 if nchars < 2 then
442 go to get_dev_id;
443
444 input.max = 4;
445 call iodd_parse_$command (substr (line, 1, nchars), addr (input), code);
446 if code ^= 0 then
447 if code = error_table_$noarg then
448 go to get_dev_id;
449 else do;
450 bad_line:
451 call iodd_msg_ (normal, master, 0, "", "Invalid response. Try again.");
452 go to ask_for_dev;
453 end;
454 if input.arg (1) = "quit" | input.arg (1) = "logout" then
455 go to out;
456 if input.arg (1) = "help" then do;
457 call iodd_msg_ (normal, master, 0, "", "Enter device name and optional request type, or any of:");
458 call iodd_msg_ (normal, master, 0, "", "logout, print_devices, listen <line_id>, print_line_ids");
459 go to ask_for_dev;
460 end;
461 if input.arg (1) = "print_line_ids" then do;
462 call print_line_ids ("-dir", rtrim (sys_dir));
463 go to ask_for_dev;
464 end;
465 if input.arg (1) = "print_devices" then do;
466 call print_devices ("-dir", rtrim (sys_dir), "-an", before (get_group_id_$tag_star (), ".*"));
467 go to ask_for_dev;
468 end;
469 if length (input.arg (1)) > length (first_arg) then
470 go to bad_line;
471 first_arg = input.arg (1);
472 first_arg = before (first_arg, ".");
473 if first_arg = "" then
474 go to bad_line;
475 if input.number = 1 then
476 if first_arg = "listen" then
477 go to bad_line;
478 else second_arg = "";
479 else do;
480 if length (input.arg (2)) > length (second_arg) then
481 go to bad_line;
482 second_arg = input.arg (2);
483 end;
484
485 get_tables:
486
487
488
489
490
491 seg_name = "iodc_data";
492 call init_seg (sys_dir, seg_name, iodc_data_ptr, try_10_times, code);
493
494 if code ^= 0 then do;
495 fatal_init:
496 call iodd_msg_ (error, master, code, id, "^/Fatal error: Unable to initiate ^a in ^a", seg_name, sys_dir);
497 if iodd_static.test_entry then
498 call early_quit;
499 go to out;
500 end;
501
502 seg_name = "iod_working_tables";
503 call init_seg (sys_dir, seg_name, ithp, try_10_times, code);
504 if code ^= 0 then
505 go to fatal_init;
506
507 if iod_tables_hdr.version ^= IODT_VERSION_5 then do;
508 call iodd_msg_ (error, master, 0, id,
509 "Fatal error: Incorrect version of iod_working_tables.");
510 go to out;
511 end;
512
513
514
515 iodd_static.ithp = ithp;
516 iodd_static.ltp, ltp = ptr (ithp, iod_tables_hdr.line_tab_offset);
517 iodd_static.idtp, idtp = ptr (ithp, iod_tables_hdr.device_tab_offset);
518 iodd_static.mdtp, mdtp = ptr (ithp, iod_tables_hdr.minor_device_tab_offset);
519 iodd_static.qgtp, qgtp = ptr (ithp, iod_tables_hdr.q_group_tab_offset);
520 iodd_static.dev_class_ptr = ptr (ithp, iod_tables_hdr.dev_class_tab_offset);
521 iodd_static.text_strings_ptr, text_strings_ptr = ptr (ithp, iod_tables_hdr.text_strings_offset);
522
523
524
525 iodd_static.attach_type = 0;
526
527 if first_arg = "listen" then do;
528
529 iodd_static.line_tab_idx = 0;
530 do i = 1 to line_tab.n_lines while (iodd_static.line_tab_idx = 0);
531 ltep = addr (line_tab.entries (i));
532 if lte.line_id = second_arg then
533 iodd_static.line_tab_idx = i;
534 end;
535 if iodd_static.line_tab_idx = 0 then do;
536 call iodd_msg_ (normal, master, 0, "", "No line table entry found for ^a", second_arg);
537 go to ask_for_dev;
538 end;
539 call attach_and_listen (code);
540 if code ^= 0 then
541 go to new_device;
542 request_type = "default";
543 input_iocbp = iodd_static.slave_in;
544 end;
545 else do;
546
547
548
549 request_dev.major_index = 0;
550 do i = 1 to iod_device_tab.n_devices while (request_dev.major_index = 0);
551 idtep = addr (iod_device_tab.entries (i));
552
553 if idte.dev_id = first_arg then
554 request_dev.major_index = i;
555 end;
556 if request_dev.major_index = 0 then do;
557 call iodd_msg_ (normal, master, 0, "", "Device ""^a"" not found in device table.", first_arg);
558 go to ask_for_dev;
559 end;
560 if idte.attach_type = ATTACH_TYPE_VARIABLE_LINE then do;
561
562 call iodd_msg_ (normal, master, 0, "", "Specified device must be used with the ""listen"" command.");
563 go to ask_for_dev;
564 end;
565 iodd_static.attach_type = idte.attach_type;
566 iodd_static.attach_name = idte.attach_name;
567 iodd_static.major_device, request_dev.major_name = first_arg;
568 request_type = second_arg;
569 input_iocbp = iodd_static.master_in;
570 end;
571 %page;
572
573
574
575 request_dev.n_minor = 0;
576
577
578 do i = idte.first_minor to idte.last_minor while (request_dev.n_minor < hbound (request_dev.minor, 1));
579 mdtep = addr (minor_device_tab.entries (i));
580 if mdte.major_index = request_dev.major_index then do;
581
582
583 request_dev.n_minor = request_dev.n_minor + 1;
584 request_dev.minor.name (request_dev.n_minor) = mdte.dev_id;
585 request_dev.minor.index (request_dev.n_minor) = i;
586 request_dev.minor.dvc_index (request_dev.n_minor) = mdte.default_dev_class;
587 end;
588 end;
589
590 if (request_dev.n_minor > 0) & (i <= idte.last_minor) then
591 call iodd_msg_ (normal, slave, 0, "", "Restriction: only the first ^d minor devices will be used",
592 hbound (request_dev.minor, 1));
593
594 if request_dev.n_minor = 0 then do;
595 call iodd_msg_ (error, both, 0, id,
596 "Fatal error: Inconsistent data in minor_device_tab. Re-init the coordinator.");
597 if iodd_static.test_entry then
598 call early_quit;
599 go to out;
600 end;
601
602
603
604 if request_type = "" then
605 if request_dev.n_minor = 1 then
606 use_default = "1"b;
607 else use_default = "0"b;
608 else if request_type = "default" then
609 use_default = "1"b;
610 else use_default = "0"b;
611
612
613
614 if request_dev.n_minor > 1 | use_default then do;
615 do i = 1 to request_dev.n_minor;
616 if ^use_default | request_dev.minor (i).dvc_index = 0 then do;
617
618 get_dvc:
619 if request_dev.minor (i).dvc_index = 0 then
620 question = "Enter request type for minor device ""^a"":";
621 else question = "Enter request type (or ""default"") for minor device ""^a"":";
622 call iodd_msg_ (normal, slave, 0, "", question, request_dev.minor.name (i));
623 call iox_$control (input_iocbp, "runout", null, code);
624
625 call iox_$get_line (input_iocbp, addr (line), 120, nchars, code);
626 if code ^= 0 then
627 go to new_device;
628 if nchars < 2 then
629 go to get_dvc;
630
631 input.max = 4;
632 call iodd_parse_$command (substr (line, 1, nchars), addr (input), code);
633
634 if code ^= 0 then do;
635 if code = error_table_$noarg then
636 go to get_dvc;
637 else do;
638 bad_dvc:
639 call iodd_msg_ (normal, slave, 0, "", "Invalid response.");
640 call iox_$control (input_iocbp, "resetread", null, code);
641
642 request_dev.minor (i).dvc_index = 0;
643
644 go to get_dvc;
645 end;
646 end;
647 if length (input.arg (1)) > length (request_type) then
648 go to bad_dvc;
649 request_type = input.arg (1);
650 if request_type = "quit" | request_type = "new_device" | request_type = "newdevice" then
651 go to ask_for_dev;
652 if request_type = "default" then do;
653 if request_dev.minor (i).dvc_index = 0 then do;
654 call iodd_msg_ (normal, slave, 0, "", "No default has been specified.");
655 go to get_dvc;
656 end;
657 end;
658 else do;
659
660 call find_device_class (request_type, j, dev_class, queue_type, code);
661
662 if code ^= 0 then
663 go to bad_dvc;
664
665 request_dev.minor (i).dvc_index = j;
666
667 end;
668 end;
669
670
671
672 call validate_request (i, code);
673 if code ^= 0 then
674 go to bad_dvc;
675 end;
676 end;
677
678 else do;
679
680 call find_device_class (request_type, j, dev_class, queue_type, code);
681 if code ^= 0 then
682 go to ask_for_dev;
683
684 request_dev.minor (1).dvc_index = j;
685
686 call validate_request (1, code);
687 if code ^= 0 then
688 go to ask_for_dev;
689 end;
690
691
692 %page;
693
694 re_init_junction:
695
696
697
698
699
700 iodd_static.major_device = request_dev.major_name;
701 iodd_static.admin_ec_name = rtrim (request_dev.major_name) || "_admin.ec";
702
703 iodd_static.coord_proc_id = iodc_data.proc_id;
704 iodd_static.driver_proc_id = get_process_id_ ();
705 iodd_static.no_coord_flag = "1"b;
706 iodd_static.recursion_flag = "0"b;
707 iodd_static.request_in_progress = "0"b;
708 iodd_static.initialized = "0"b;
709 iodd_static.master_hold = "0"b;
710 iodd_static.slave_hold = "0"b;
711 iodd_static.step = "0"b;
712 iodd_static.quit_during_request = "0"b;
713 iodd_static.logout_pending = "0"b;
714 iodd_static.runout_requests = "0"b;
715 iodd_static.quit_signaled = "0"b;
716 iodd_static.auto_logout_interval = 0;
717 iodd_static.assigned_devices = 0;
718 iodd_static.current_devices = 0;
719 iodd_static.output_device = "Undefined";
720 iodd_static.auto_start_delay = 60;
721 if iodd_static.attach_type ^= ATTACH_TYPE_VARIABLE_LINE then do;
722
723 iodd_static.slave_in, iodd_static.slave_out = null;
724
725 iodd_static.slave.active = "0"b;
726 iodd_static.slave_ev_chan = 0;
727 iodd_static.slave.accept_input = "0"b;
728 iodd_static.slave.print_errors = "0"b;
729 iodd_static.slave_output = null_stream;
730 iodd_static.slave_input = null_stream;
731 end;
732 iodd_static.slave.log_msg = "0"b;
733 iodd_static.slave.echo_cmd = "0"b;
734 iodd_static.slave.allow_quits = "0"b;
735 iodd_static.dev_io_stream = null_stream;
736 iodd_static.dev_in_stream = null_stream;
737 iodd_static.dev_out_stream = null_stream;
738 iodd_static.driver_ptr = null ();
739 iodd_static.driver_list_ptr,
740 list_ptr = addr (driver_list);
741
742 iodd_static.chan_list_ptr = addr (ev_chan_list);
743 iodd_static.segptr = null;
744
745 call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat);
746
747 call ios_$detach ("broadcast_errors", "", "", io_stat);
748
749 call ios_$attach ("broadcast_errors", "broadcast_", "error_i/o", "", io_stat);
750
751 iodd_static.master_output = "master_output";
752 iodd_static.master_input = "master_input";
753 iodd_static.log_stream = "log_output";
754
755 call iox_$look_iocb ("master_output", iodd_static.master_out, code);
756
757 call iox_$look_iocb ("master_input", iodd_static.master_in, code);
758 call iox_$look_iocb ("log_output", iodd_static.log_iocbp, code);
759 call iox_$look_iocb ("error_i/o", iodd_static.error_io, code);
760
761
762
763 on seg_fault_error begin;
764 ithp = null;
765 go to get_tables;
766 end;
767
768 table_time = iod_tables_hdr.date_time_compiled;
769
770 revert seg_fault_error;
771
772
773
774
775 rqt_string = "";
776 driver_dir = rtrim (sys_dir) || ">" || request_dev.major_name;
777 init_ev_chan = iodc_data.init_event_channel;
778 ev_chan_list.number = 2;
779 ev_chan_list.channel (1) = 0;
780 ev_chan_list.channel (2) = iodd_static.timer_chan;
781
782 driver_ptr_list.number = 0;
783
784 new_driver_msg_p = addr (driver_message);
785 driver_message.lock_id = "0"b;
786
787 call set_lock_$lock (driver_message.lock_id, 0, code);
788
789 %page;
790
791
792
793
794
795
796 if iodd_static.test_entry then
797 call iodd_msg_ (normal, master, 0, "", "Requesting devices from coordinator.");
798
799 do i = 1 to request_dev.n_minor;
800
801 call ipc_$create_ev_chn (driver_message.wakeup_chan, code);
802
803 if code ^= 0 then do;
804 call convert_ipc_code_ (code);
805 call iodd_msg_ (error, both, code, id, "Fatal error: Unable to create minor device event channel.");
806 call kill_device;
807 go to out;
808 end;
809
810 ev_chan_list.channel (1) = driver_message.wakeup_chan;
811
812 driver_message.device_index = request_dev.minor (i).index;
813
814 driver_message.dev_class_index = request_dev.minor (i).dvc_index;
815
816 call message_segment_$add_file (sys_dir, "coord_comm.ms", new_driver_msg_p, size (new_driver_msg) * 36,
817 message_id, code);
818
819 if code ^= 0 then do;
820 call iodd_msg_ (error, both, code, id,
821 "Fatal error: Unable to send new driver request to coord_comm.ms in ^a", sys_dir);
822 call kill_device;
823 if iodd_static.test_entry then
824 call early_quit;
825 go to out;
826 end;
827
828 unspec (event_message) = message_id;
829
830 call hcs_$wakeup (iodd_static.coord_proc_id, init_ev_chan, event_message, code);
831 if code ^= 0 then
832 signal no_coord;
833
834
835
836 call ipc_$drain_chn (iodd_static.timer_chan, code);
837
838 call timer_manager_$alarm_wakeup (300, RELATIVE_SECONDS, iodd_static.timer_chan);
839
840 call ipc_$block (addr (ev_chan_list), addr (event_info), code);
841
842 call timer_manager_$reset_alarm_wakeup (iodd_static.timer_chan);
843
844 if code ^= 0 then do;
845 call convert_ipc_code_ (code);
846 call iodd_msg_ (error, both, code, id, "Fatal error: from ipc_$block .");
847 call kill_device;
848 if iodd_static.test_entry then
849 call early_quit;
850 go to out;
851 end;
852
853
854
855 if event_info.wait_list_index = 2 then do;
856 call iodd_msg_ (normal, both, 0, id, "Coordinator did not respond to new driver wakeup.");
857 signal no_coord;
858 end;
859
860 code = addr (event_info.message) -> ev_msg.code;
861
862 if code ^= 0 then do;
863
864 if request_dev.n_minor = 1 then
865 dev_label = request_dev.major_name;
866 else dev_label = rtrim (request_dev.major_name) || "." || request_dev.minor (i).name;
867
868 if code = 6 then do;
869 call iodd_msg_ (normal, both, 0, id, "Device ^a assigned to another process", dev_label);
870 go to ask_for_dev;
871 end;
872 else if code = 7 then do;
873 call iodd_msg_ (normal, both, 0, id, "Device ^a already assigned to this process.", dev_label);
874 end;
875 else do;
876 call iodd_msg_ (error, both, 0, id, "Coordinator could not initialize ^a driver. Code = ^d",
877 dev_label, code);
878 call kill_device;
879 go to ask_for_dev;
880 end;
881
882 end;
883 %page;
884
885
886
887 call hcs_$initiate (driver_dir, request_dev.minor (i).name, "", 0, 1, driver_status_ptr, code);
888 if driver_status_ptr = null then do;
889 call iodd_msg_ (error, both, code, id, "Unable to initiate driver status segment: ^a in ^a",
890 request_dev.minor (i).name, driver_dir);
891 call kill_device;
892 go to ask_for_dev;
893 end;
894
895 driver_ptr_list.number = driver_ptr_list.number + 1;
896 driver_ptr_list.stat_segp (driver_ptr_list.number) = driver_status_ptr;
897 driver_status.driver_chan = ev_chan_list.channel (1);
898 driver_status.last_wake_time = 0;
899 driver_status.list_index = driver_ptr_list.number;
900 string (driver_status.status_flags) = "0"b;
901 driver_status.dev_ctl_ptr = null;
902
903
904
905
906 dctep = addr (iodd_static.dev_class_ptr -> dev_class_tab.entries (request_dev.minor (i).dvc_index));
907 qgtep = addr (iodd_static.qgtp -> q_group_tab.entries (dcte.qgte_index));
908
909 driver_status.generic_type = qgte.generic_type;
910
911
912 if return_string (qgte.accounting) = "nothing" then
913 driver_status.have_accounting = "0"b;
914 else do;
915 driver_status.have_accounting = "1"b;
916 if return_string (qgte.accounting) = "system" then
917 driver_status.acct_entry = charge_user_;
918 else do;
919 temp_dir_entry = return_string (qgte.accounting);
920
921 driver_status.acct_entry = cv_entry_ (temp_dir_entry, null (), code);
922 if code ^= 0 then do;
923 if return_string (qgte.accounting) = "system" then
924 call iodd_msg_ (error, both, code, id,
925 "Unable to get pointer to system accounting procedure: ^a", temp_dir_entry);
926 else call iodd_msg_ (error, both, code, id, "Unable to get pointer to accounting procedure: ^a.",
927 temp_dir_entry);
928 call kill_device;
929 go to ask_for_dev;
930 end;
931 end;
932 end;
933
934
935
936 call io_daemon_account_$set_line_prices (driver_ptr_list.number, qgtep, code);
937 if code ^= 0 then do;
938 call iodd_msg_ (error, both, code, id, "Unable to set line charge prices for request type ^a.",
939 driver_status.req_type_label);
940 call kill_device;
941 go to ask_for_dev;
942 end;
943 %page;
944
945
946
947 entry_name = qgte.rqti_seg_name;
948 if entry_name ^= "" then do;
949 call init_seg (rqti_dir, entry_name, driver_status.rqti_ptr, try_0_times, code);
950
951 if driver_status.rqti_ptr = null then do;
952 call iodd_msg_ (error, both, code, id, "Unable to find RQTI segment ^a.", entry_name);
953 call kill_device;
954 go to ask_for_dev;
955 end;
956 end;
957 else driver_status.rqti_ptr = null;
958
959 rqt_name = before (rtrim (driver_status.req_type_label), ".");
960
961
962 if index (rqt_string, rtrim (rqt_name)) = 0 then
963 rqt_string = rqt_string || " " || rtrim (rqt_name);
964
965
966 call set_iod_val (rtrim (driver_status.device_id), rtrim (rqt_name));
967
968
969
970 end;
971
972
973
974 idtep = addr (iod_device_tab.entries (request_dev.major_index));
975 iodd_static.major_args = idte.args;
976
977
978 if idte.paper_type = PAPER_TYPE_SINGLE then
979 iodd_static.paper_type = idte.paper_type;
980 else iodd_static.paper_type = PAPER_TYPE_CONTINUOUS;
981
982 iodd_static.assigned_devices = driver_ptr_list.number;
983 iodd_static.driver_ptr, driver_status_ptr = driver_ptr_list.stat_segp (1);
984 iodd_static.output_device = iodd_static.driver_ptr -> driver_status.device_id;
985
986
987
988 event_message = 0;
989 msgp = addr (event_message);
990 msgp -> ev_msg.code = 5;
991 msgp -> ev_msg.minor_dev_index =
992 driver_ptr_list.stat_segp (1) -> driver_status.dev_index;
993 init_ev_chan = driver_ptr_list.stat_segp (1) -> driver_status.coord_chan;
994
995
996
997 call hcs_$wakeup (iodd_static.coord_proc_id, init_ev_chan, event_message, code);
998 if code ^= 0 then
999 signal no_coord;
1000
1001 call ipc_$drain_chn (iodd_static.timer_chan, code);
1002
1003 call timer_manager_$alarm_wakeup (300, RELATIVE_SECONDS, iodd_static.timer_chan);
1004
1005
1006
1007 ev_chan_list.channel (1) = driver_ptr_list.stat_segp (1) -> driver_status.driver_chan;
1008
1009 call ipc_$block (addr (ev_chan_list), addr (event_info), code);
1010
1011
1012 call timer_manager_$reset_alarm_wakeup (iodd_static.timer_chan);
1013
1014 if code ^= 0 then do;
1015 call convert_ipc_code_ (code);
1016 call iodd_msg_ (error, both, code, id, "Fatal error: from ipc_$block .");
1017 call kill_device;
1018 if iodd_static.test_entry then
1019 call early_quit;
1020 go to out;
1021 end;
1022
1023 if event_info.wait_list_index = 2 then do;
1024 call iodd_msg_ (normal, both, 0, id, "Coordinator did not respond to standard wakeup.");
1025 signal no_coord;
1026 end;
1027
1028 iodd_static.coord_cmd_chan = event_info.message;
1029
1030
1031
1032 temp_dir = return_string (idte.driver_module);
1033 temp_dir_entry = temp_dir || "$init";
1034 iodd_static.driver_init = cv_entry_ (temp_dir_entry, null (), code);
1035 if code ^= 0 then do;
1036 bad_entry:
1037 call iodd_msg_ (error, both, code, id, "Unable to find driver module ""^a"".", temp_dir_entry);
1038 call kill_device;
1039 go to ask_for_dev;
1040 end;
1041
1042 temp_dir_entry = temp_dir || "$request";
1043 iodd_static.driver_request = cv_entry_ (temp_dir_entry, null (), code);
1044 if code ^= 0 then
1045 go to bad_entry;
1046
1047 temp_dir_entry = temp_dir || "$command";
1048 iodd_static.driver_command = cv_entry_ (temp_dir_entry, null (), code);
1049 if code ^= 0 then
1050 go to bad_entry;
1051
1052 temp_dir_entry = temp_dir || "$default_handler";
1053 iodd_static.driver_default_handler = cv_entry_ (temp_dir_entry, null (), code);
1054 if code ^= 0 then do;
1055 if code ^= error_table_$no_ext_sym then
1056 go to bad_entry;
1057 else do;
1058 temp_dir_entry = "iodd_$iodd_";
1059 iodd_static.driver_default_handler = cv_entry_ (temp_dir_entry, null (), code);
1060 if code ^= 0 then
1061 go to bad_entry;
1062 end;
1063 end;
1064
1065
1066
1067
1068 temp_dir = return_string (idte.head_sheet);
1069 if temp_dir = "" then do;
1070 iodd_static.print_head_sheet = head_sheet_$print_head_sheet;
1071 iodd_static.print_head_separator = head_sheet_$print_separator;
1072 end;
1073 else do;
1074 temp_dir_entry = temp_dir || "$print_head_sheet";
1075 iodd_static.print_head_sheet = cv_entry_ (temp_dir_entry, null (), code);
1076 if code ^= 0 then do;
1077 bad_banner_entry:
1078 call iodd_msg_ (error, both, code, id, "Unable to find banner page module ""^a"".", temp_dir_entry);
1079 call kill_device;
1080 go to ask_for_dev;
1081 end;
1082
1083 temp_dir_entry = temp_dir || "$print_separator";
1084 iodd_static.print_head_separator = cv_entry_ (temp_dir_entry, null (), code);
1085 if code ^= 0 then
1086 go to bad_banner_entry;
1087 end;
1088
1089 if iodd_static.test_entry then do;
1090 if temp_dir = "" then
1091 call head_sheet_$test (sys_dir);
1092 else do;
1093 temp_dir_entry = temp_dir || "$test";
1094 entry_variable = cv_entry_ (temp_dir_entry, null (), code);
1095 if code ^= 0 then
1096 go to bad_banner_entry;
1097 call entry_variable (sys_dir);
1098 end;
1099 end;
1100
1101
1102 temp_dir = return_string (idte.tail_sheet);
1103 if temp_dir = "" then
1104 iodd_static.print_tail_sheet = tail_sheet_$print_tail_sheet;
1105 else do;
1106 temp_dir_entry = temp_dir || "$print_tail_sheet";
1107 iodd_static.print_tail_sheet = cv_entry_ (temp_dir_entry, null (), code);
1108 if code ^= 0 then
1109 go to bad_banner_entry;
1110 end;
1111
1112
1113
1114 call iox_$control (iodd_static.master_in, "read_status", addr (read_info), code);
1115 if code ^= 0 then do;
1116 call iodd_msg_ (error, both, code, id, "Attempting read_status control on master_input.");
1117 call kill_device;
1118 go to out;
1119 end;
1120 ev_chan_list.channel (1) = read_info.ev_chan;
1121
1122 do i = 1 to driver_ptr_list.number;
1123 ev_chan_list.channel (i + 2) = driver_ptr_list.stat_segp (i) -> driver_status.driver_chan;
1124 end;
1125 ev_chan_list.number = driver_ptr_list.number + 2;
1126
1127 if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then
1128 ev_chan_list.channel (2) = iodd_static.slave_ev_chan;
1129
1130
1131
1132
1133 if iodd_static.ctl_term.attached then do;
1134 call check_for_dialup (code);
1135
1136 if code = 0 then
1137 go to set_ctl_streams;
1138
1139 if code = 5 then do;
1140 line = NL || "hangup terminal" || NL;
1141 call ios_$write (iodd_static.ctl_io, addr (line), 0, length (rtrim (line)), (0), io_stat);
1142 call ios_$order (iodd_static.ctl_io, "runout", null, io_stat);
1143 call ipc_$decl_ev_wait_chn (iodd_static.ctl_dial_chan, code);
1144
1145
1146
1147 release_arg.version = dial_manager_arg_version_2;
1148 release_arg.channel_name = iodd_static.ctl_device;
1149 release_arg.dial_channel = iodd_static.ctl_dial_chan;
1150 release_arg.dial_qualifier = "";
1151
1152 call dial_manager_$release_channel (addr (release_arg), code);
1153 if code ^= 0 then
1154 call ios_$order ((iodd_static.ctl_io), "hangup", null, io_stat);
1155
1156
1157 call ipc_$delete_ev_chn (iodd_static.ctl_dial_chan, code);
1158
1159 end;
1160 call ios_$detach (iodd_static.ctl_io, "", "", io_stat);
1161
1162 call ios_$detach (iodd_static.ctl_input, "", "", io_stat);
1163 call ios_$detach (iodd_static.ctl_output, "", "", io_stat);
1164 iodd_static.ctl_term.attached = "0"b;
1165 end;
1166
1167 iodd_static.ctl_term.ctl_attach_name = idte.ctl_attach_name;
1168 iodd_static.ctl_term.ctl_attach_type = idte.ctl_attach_type;
1169
1170 if iodd_static.ctl_attach_type = CTL_ATTACH_TYPE_TTY | iodd_static.ctl_attach_type = CTL_ATTACH_TYPE_DIAL then do;
1171 call wait_for_dial (code);
1172 if code ^= 0 then do;
1173 if code > 10 then
1174 call iodd_msg_ (normal, master, code, id, "Unable to get dialed terminal.");
1175 else call iodd_msg_ (normal, master, 0, id, "Unable to get dialed terminal. code = ^d", code);
1176 call kill_device;
1177 go to ask_for_dev;
1178 end;
1179 end;
1180 else if iodd_static.ctl_attach_type = CTL_ATTACH_TYPE_MC then do;
1181
1182 iodd_static.ctl_dev_dim = "mrd_";
1183 iodd_static.ctl_device = idte.ctl_attach_name;
1184
1185 end;
1186 else do;
1187 iodd_static.ctl_input = null_stream;
1188 iodd_static.ctl_output = null_stream;
1189 iodd_static.ctl_io = null_stream;
1190 iodd_static.ctl_dev_dim = "Undefined";
1191 iodd_static.ctl_dial_chan = 0;
1192 iodd_static.ctl_ev_chan = 0;
1193
1194 go to call_driver;
1195 end;
1196
1197 call ios_$attach ("ctl_i/o", iodd_static.ctl_dev_dim, iodd_static.ctl_device, "", io_stat);
1198 if st.code ^= 0 then do;
1199 if st.code = error_table_$ionmat then
1200 go to set_ctl_streams;
1201 call iodd_msg_ (normal, master, st.code, id,
1202 "Attaching ""ctl_i/o"" to ""^a"" with interface module ""^a"".", iodd_static.ctl_device,
1203 iodd_static.ctl_dev_dim);
1204 call kill_device;
1205 go to ask_for_dev;
1206 end;
1207
1208 set_ctl_streams:
1209 iodd_static.ctl_term.attached = "1"b;
1210 iodd_static.ctl_io = "ctl_i/o";
1211 iodd_static.ctl_input = "ctl_input";
1212 iodd_static.ctl_output = "ctl_output";
1213
1214 if iodd_static.ctl_term.forms then
1215 dim_name = "form_";
1216 else dim_name = "syn";
1217
1218 call ios_$attach ("ctl_input", dim_name, iodd_static.ctl_io, "", io_stat);
1219 if st.code ^= 0 then
1220 if st.code ^= error_table_$ionmat then do;
1221 syn_err:
1222 call iodd_msg_ (normal, master, st.code, id, "Error attaching control terminal streams. Dim: ^a",
1223 dim_name);
1224 go to start_new_device_cleanup;
1225 end;
1226
1227 call ios_$attach ("ctl_output", dim_name, iodd_static.ctl_io, "", io_stat);
1228 if st.code ^= 0 then
1229 if st.code ^= error_table_$ionmat then
1230 go to syn_err;
1231
1232
1233
1234 call ios_$order (iodd_static.ctl_io, "read_status", addr (read_info), io_stat);
1235 if st.code ^= 0 then do;
1236 call iodd_msg_ (normal, master, st.code, id, """read_status"" on stream ""^a"".", iodd_static.ctl_io);
1237 go to start_new_device_cleanup;
1238 end;
1239
1240 iodd_static.ctl_ev_chan = read_info.ev_chan;
1241
1242 if ^iodd_static.slave.active then do;
1243
1244 ev_chan_list.channel (2) = read_info.ev_chan;
1245 iodd_static.slave_ev_chan = read_info.ev_chan;
1246
1247
1248
1249 iodd_static.slave_input = iodd_static.ctl_input;
1250 iodd_static.slave_output = iodd_static.ctl_output;
1251 iodd_static.slave.active = "1"b;
1252
1253 call iox_$look_iocb ((iodd_static.slave_output), iodd_static.slave_out, code);
1254 if code ^= 0 then do;
1255 slave_init_err:
1256 call iodd_msg_ (normal, master, code, id, "Unable to find slave iocbp.");
1257 go to start_new_device_cleanup;
1258 end;
1259
1260 call iox_$look_iocb ((iodd_static.slave_input), iodd_static.slave_in, code);
1261 if code ^= 0 then
1262 go to slave_init_err;
1263
1264 call ios_$order (iodd_static.ctl_io, "start", null (), io_stat);
1265 end;
1266 %page;
1267
1268 call_driver:
1269 call set_iod_val ("device", rtrim (request_dev.major_name));
1270
1271 call set_iod_val ("station_id", rtrim (request_dev.major_name));
1272 call set_iod_val ("channel", rtrim (iodd_static.attach_name));
1273 if iodd_static.assigned_devices > 1 then
1274 request_type = "";
1275 else request_type = before (iodd_static.driver_ptr -> driver_status.req_type_label, ".");
1276 call set_iod_val ("request_type", rtrim (request_type));
1277 call set_iod_val ("rqt_string", (rqt_string));
1278
1279 if ^iodd_static.slave.active then do;
1280 iodd_static.slave.allow_quits = "0"b;
1281 iodd_static.slave.accept_input = "0"b;
1282 iodd_static.slave.print_errors = "0"b;
1283 end;
1284 else do;
1285 dim_name = "broadcast_";
1286 call ios_$attach ("broadcast_errors", dim_name, iodd_static.slave_output, "", io_stat);
1287 if st.code ^= 0 then
1288 call iodd_msg_ (normal, both, st.code, id, "Unable to attach broadcast_errors to slave.");
1289 else do;
1290 call ios_$attach ("error_output", "syn", "broadcast_errors", "", io_stat);
1291 if st.code ^= 0 then
1292 call iodd_msg_ (normal, both, st.code, id,
1293 "Unable to attach error_output stream to broadcast_errors.");
1294 end;
1295
1296 iodd_static.slave.allow_quits = "1"b;
1297 iodd_static.slave.accept_input = "1"b;
1298 iodd_static.slave.print_errors = "1"b;
1299 if iodd_static.slave_output ^= iodd_static.ctl_output then
1300 iodd_static.slave.log_msg = "1"b;
1301 end;
1302
1303 if iodd_static.test_entry then
1304 if iodd_static.coord_proc_id = iodd_static.driver_proc_id then
1305 iodd_static.driver_proc_id = bit (fixed (iodd_static.driver_proc_id, 35) + 100, 36);
1306
1307 call iodd_command_processor_$init (stat_p);
1308 call iodd_quit_handler_$init (stat_p);
1309
1310 call write_control_form_$init (stat_p);
1311
1312 iodd_static.initialized = "1"b;
1313
1314
1315 call iodd_static.driver_init (stat_p);
1316
1317
1318
1319
1320 call iodd_msg_ (error, both, 0, id, "Unable to initialize driver.^/");
1321
1322 go to start_new_device_cleanup;
1323 %page;
1324
1325 out:
1326 if iodd_static.test_entry then do;
1327 if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then
1328 call hangup_station;
1329 call ipc_$delete_ev_chn (iodd_static.timer_chan, code);
1330 call ipc_$delete_ev_chn (iodd_static.cmd_ack_chan, code);
1331 call ipc_$delete_ev_chn (iodd_static.ctl_dial_chan, code);
1332 call ipc_$delete_ev_chn (iodd_static.dial_ev_chan, code);
1333 call ios_$attach ("error_output", "syn", "user_i/o", "", io_stat);
1334
1335
1336 call ios_$detach ("broadcast_errors", "", "", io_stat);
1337 call ios_$order ("user_i/o", "start", null (), io_stat);
1338
1339
1340 return;
1341 end;
1342 else call logout;
1343
1344 start_new_device_cleanup:
1345
1346
1347 call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat);
1348
1349
1350 if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then
1351 call hangup_station;
1352
1353 call kill_device;
1354 go to new_device;
1355
1356 driver_logout_label:
1357 if iodd_static.ctl_term.attached then do;
1358 call ipc_$delete_ev_chn (iodd_static.ctl_dial_chan, code);
1359
1360 line = NL || "hangup terminal" || NL;
1361 call ios_$write (iodd_static.ctl_io, addr (line), 0, length (rtrim (line)), (0), io_stat);
1362 call ios_$order (iodd_static.ctl_io, "runout", null, io_stat);
1363 call ios_$order (iodd_static.ctl_io, "hangup", null, io_stat);
1364
1365 call ios_$detach (iodd_static.ctl_io, "", "", io_stat);
1366 end;
1367 call kill_device;
1368 call hangup_station;
1369 go to out;
1370
1371 re_init_driver:
1372
1373
1374 call kill_device;
1375 if iodd_static.re_init_in_progress then
1376 if iodd_static.logout_on_hangup then do;
1377 call iodd_msg_ (error, both, 0, id, "Driver logging out. (hangup_on_logout in effect.)");
1378 goto out;
1379 end;
1380 iodd_static.recursion_flag = "0"b;
1381 iodd_static.re_init_in_progress = "0"b;
1382 if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then do;
1383
1384 if ^iodd_static.initialized then
1385 call hangup_station;
1386 iodd_static.initialized = "0"b;
1387 iodd_static.no_coord_flag = "0"b;
1388 call timer_manager_$sleep (10, RELATIVE_SECONDS);
1389 go to get_tables;
1390 end;
1391 iodd_static.initialized = "0"b;
1392 if iodd_static.attach_type ^= ATTACH_TYPE_IOM then
1393 call timer_manager_$sleep (10, RELATIVE_SECONDS);
1394 if iodd_static.no_coord_flag then
1395 go to re_init_junction;
1396 go to new_device;
1397
1398 no_coord_signal:
1399
1400
1401 call kill_device;
1402 iodd_static.recursion_flag = "0"b;
1403 iodd_static.initialized = "0"b;
1404 iodd_static.re_init_in_progress = "0"b;
1405
1406 call iodd_msg_ (error, master, 0, id, "Driver will await new coordinator.");
1407 times = 0;
1408
1409 check_proc_id:
1410 if iodc_data.proc_id ^= (36)"0"b then
1411 if iodc_data.proc_id ^= iodd_static.coord_proc_id then
1412
1413 if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then
1414 go to get_tables;
1415 else go to re_init_junction;
1416
1417
1418
1419 times = times + 1;
1420 if times > 10 then do;
1421
1422 call iodd_msg_ (error, master, 0, id, "^a^/Waited too long for coordinator. Process logging out.^/^a^a",
1423 stars, stars, bel_string);
1424 go to driver_logout_label;
1425
1426 end;
1427 call timer_manager_$sleep (30, RELATIVE_SECONDS);
1428 go to check_proc_id;
1429 %page;
1430
1431
1432
1433
1434
1435 early_quit: proc;
1436
1437
1438
1439
1440 dcl cmd char (80);
1441 dcl line char (32);
1442 dcl nc fixed bin (21);
1443 dcl stat bit (72) aligned;
1444 dcl give_start bit (1);
1445
1446 give_start = "1"b;
1447
1448 call ioa_$ioa_stream ("user_i/o", "^/Early ""quit""^/");
1449
1450 call timer_manager_$alarm_call (iodd_static.auto_start_delay, RELATIVE_SECONDS, try_auto_start);
1451
1452 on alrm call continue_to_signal_ (code);
1453
1454 on any_other begin;
1455 give_start = "0"b;
1456 call timer_manager_$reset_alarm_call (try_auto_start);
1457
1458 call continue_to_signal_ (code);
1459 end;
1460
1461 get_line:
1462 call ioa_$ioa_stream ("user_i/o", "Enter command(early quit):");
1463 call iox_$get_line (iodd_static.master_in, addr (cmd), 80, nc, code);
1464
1465 if give_start then do;
1466 give_start = "0"b;
1467 call timer_manager_$reset_alarm_call (try_auto_start);
1468
1469 end;
1470 if code ^= 0 then
1471 go to no_master;
1472
1473 line = substr (cmd, 1, nc - 1);
1474 if line = "" then
1475 go to get_line;
1476
1477 if line = "start" then do;
1478 auto_start:
1479 call ios_$order ("user_i/o", "start", null, stat);
1480
1481 return;
1482 end;
1483
1484 else if line = "new_device" then do;
1485 go to start_new_device_cleanup;
1486 end;
1487
1488 else if line = "logout" then do;
1489 go to driver_logout_label;
1490 end;
1491
1492 else if line = "return" then do;
1493 if iodd_static.test_entry then
1494 go to out;
1495 end;
1496
1497 else if line = "debug" then do;
1498 if iodd_static.test_entry then do;
1499 call ioa_$ioa_stream ("user_i/o", "Calling debug");
1500
1501 call debug;
1502 go to get_line;
1503 end;
1504 end;
1505
1506 else if line = "probe" | line = "pb" then do;
1507 if iodd_static.test_entry then do;
1508 call ioa_$ioa_stream ("user_i/o", "Calling probe");
1509
1510 call probe;
1511 go to get_line;
1512 end;
1513 end;
1514
1515 else if line = "pi" then do;
1516 if iodd_static.test_entry then do;
1517 signal program_interrupt;
1518 go to get_line;
1519 end;
1520 end;
1521
1522 else if line = "." | line = "hold" then
1523 go to get_line;
1524
1525 else if line = "help" then do;
1526 call ioa_$ioa_stream ("user_i/o", "Commands at this level are: hold, start, new_device, logout");
1527 if iodd_static.test_entry then
1528 call ioa_$ioa_stream ("user_i/o", "Test commands: debug, probe, return, pi");
1529 go to get_line;
1530 end;
1531
1532 call ioa_$ioa_stream ("user_i/o", "Invalid response: ""^a"" Type ""help"" for instructions.", line);
1533 go to get_line;
1534
1535 try_auto_start: proc;
1536
1537 if give_start then do;
1538 call ioa_$ioa_stream ("user_i/o", "Automatic start given.");
1539 go to auto_start;
1540 end;
1541 return;
1542
1543 end;
1544
1545 end early_quit;
1546 %page;
1547
1548
1549 init_seg: proc (dir_name, seg_name, segp, num_times, ec);
1550
1551
1552
1553 dcl seg_name char (*);
1554 dcl segp ptr;
1555 dcl dir_name char (*);
1556 dcl num_times fixed bin;
1557 dcl ec fixed bin (35);
1558 dcl times fixed bin;
1559
1560 times = 0;
1561 try_again:
1562 call hcs_$initiate (dir_name, seg_name, seg_name, 0, 1, segp, ec);
1563 if segp = null () then
1564 if ec = error_table_$namedup then do;
1565 call hcs_$terminate_name (seg_name, ec);
1566 if ec = 0 then
1567 go to try_again;
1568 return;
1569 end;
1570 else if ec = error_table_$noentry then do;
1571
1572
1573 times = times + 1;
1574 if times > num_times then
1575 return;
1576 call timer_manager_$sleep (30, RELATIVE_SECONDS);
1577 go to try_again;
1578 end;
1579 else return;
1580 ec = 0;
1581 return;
1582 end init_seg;
1583 %page;
1584
1585 attach_and_listen: proc (code);
1586
1587 dcl station_id char (32);
1588 dcl code fixed bin (35);
1589 dcl att_desc char (256);
1590 dcl tries fixed bin;
1591 dcl station_password char (8);
1592 dcl cmd_msg char (32);
1593 dcl err_msg char (80);
1594 dcl len fixed bin (21);
1595
1596 dcl 1 hangup_info aligned,
1597 2 entry entry,
1598 2 data_ptr ptr,
1599 2 priority fixed bin;
1600
1601 code = 0;
1602 tries = 0;
1603
1604
1605 call ioa_$rsnnl ("remote_teleprinter_ " || return_string (lte.att_desc), att_desc, len, lte.chan_id);
1606
1607 attach_chan:
1608 tries = tries + 1;
1609 if tries > 5 then do;
1610 code = error_table_$no_operation;
1611 call iodd_msg_ (error, master, 0, id, "All attach attempts failed.");
1612
1613 return;
1614 end;
1615
1616 call iodd_msg_ (normal, master, 0, "", "Attaching line ""^a"" on channel (^a).", lte.line_id, lte.chan_id);
1617
1618 call timer_manager_$sleep (5, RELATIVE_SECONDS);
1619
1620 iodd_static.major_device = "";
1621 iodd_static.attach_type = 0;
1622 iodd_static.attach_name = "";
1623 request_dev.major_index = 0;
1624 request_dev.major_name = "";
1625
1626 call iox_$attach_name ("teleprinter", iodd_static.slave_in, att_desc, null, code);
1627 if code ^= 0 then
1628 if ^(code = error_table_$ionmat | code = error_table_$not_detached) then do;
1629
1630 call iodd_msg_ (normal, master, code, id, "Unable to attach line.");
1631 call hangup_station;
1632 go to attach_chan;
1633 end;
1634
1635 call iox_$open (iodd_static.slave_in, Stream_input_output, ""b, code);
1636 if code ^= 0 then
1637 if code ^= error_table_$not_closed then do;
1638 call iodd_msg_ (normal, master, code, id, "Unable to open line io switch.");
1639 call hangup_station;
1640 go to attach_chan;
1641 end;
1642
1643 iodd_static.slave.active = "1"b;
1644 iodd_static.slave.accept_input = "1"b;
1645 iodd_static.slave.print_errors = "1"b;
1646 iodd_static.slave_out = iodd_static.slave_in;
1647 iodd_static.slave_input, iodd_static.slave_output = "teleprinter";
1648 iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE;
1649
1650 iodd_static.attach_name = lte.chan_id;
1651
1652 call iox_$control (iodd_static.slave_in, "read_status", addr (read_info), code);
1653 if code ^= 0 then do;
1654 call iodd_msg_ (normal, master, code, id, "Attempting read_status control operation.");
1655 call hangup_station;
1656 go to attach_chan;
1657 end;
1658
1659 iodd_static.slave_ev_chan = read_info.ev_chan;
1660
1661 hangup_info.entry = iodd_hangup_$iodd_hangup_;
1662 hangup_info.data_ptr = stat_p;
1663 hangup_info.priority = 1;
1664
1665 call iox_$control (iodd_static.slave_in, "hangup_proc", addr (hangup_info), code);
1666 if code ^= 0 then
1667 call iodd_msg_ (normal, master, code, id,
1668 "Warning: Could not establish handler for hangups from the device.");
1669
1670 call iodd_msg_ (normal, master, 0, "", "Requesting station identifier on line ""^a"".", lte.line_id);
1671
1672 call iox_$put_chars (iodd_static.slave_out, addr (FF), 1, code);
1673
1674 if code ^= 0 then
1675 go to drop_station;
1676
1677 tries = 0;
1678 cmd_msg = "Enter station command:" || NL;
1679 go to ask_for_station;
1680
1681 clear_input_buffer:
1682 call iox_$control (iodd_static.slave_in, "resetread", null, code);
1683
1684 ask_for_station:
1685 tries = tries + 1;
1686 if tries > 10 then
1687 go to drop_station;
1688
1689 call iox_$put_chars (iodd_static.slave_out, addr (cmd_msg), length (rtrim (cmd_msg)), code);
1690 if code ^= 0 then do;
1691 drop_station: call hangup_station;
1692 call iodd_msg_ (normal, master, code, id, "Trouble initializing station. Will re-attach line.");
1693 tries = 0;
1694 call timer_manager_$sleep (10, RELATIVE_SECONDS);
1695 go to attach_chan;
1696 end;
1697
1698 call iox_$control (iodd_static.slave_out, "runout", null, code);
1699
1700
1701
1702
1703 line = "";
1704 call iox_$get_line (iodd_static.slave_in, addr (line), 80, len, code);
1705 if code ^= 0 then
1706 go to drop_station;
1707
1708 line = rtrim (line, " " || NL);
1709
1710 if index (line, "station") = 0 then
1711 go to bad_cmd;
1712
1713 station_id = before (ltrim (after (line, "station")), " ");
1714
1715 if station_id = "" then do;
1716 bad_cmd: call iodd_msg_ (normal, both, 0, "***", "Invalid station command.");
1717 go to clear_input_buffer;
1718 end;
1719
1720 station_password = before (ltrim (after (line, rtrim (station_id))), " ");
1721 if station_password = "" then
1722 call read_password_$switch (iodd_static.slave_out, iodd_static.slave_in, STATION_PW_PROMPT,
1723 station_password, code);
1724 if station_password = "*" then
1725 station_password = "";
1726
1727 if station_password ^= "" then do;
1728 temp_password = station_password;
1729 station_password = scramble_ (temp_password);
1730 temp_password = "";
1731 end;
1732 call validate_card_input_$station (station_id, station_password, err_msg, code);
1733 station_password = "";
1734 if code ^= 0 then do;
1735 call iodd_msg_ (normal, both, 0, "***", "^a: ^a", err_msg, station_id);
1736 go to clear_input_buffer;
1737 end;
1738
1739
1740
1741 request_dev.major_name, iodd_static.major_device = station_id;
1742
1743 request_dev.major_index = 0;
1744 do i = 1 to iod_device_tab.n_devices while (request_dev.major_index = 0);
1745 idtep = addr (iod_device_tab.entries (i));
1746 if idte.dev_id = request_dev.major_name then
1747 request_dev.major_index = i;
1748 end;
1749 if request_dev.major_index = 0 then do;
1750 call iodd_msg_ (normal, both, 0, "***", "Station ""^a"" not defined in iod_tables.",
1751 request_dev.major_name);
1752 go to clear_input_buffer;
1753 end;
1754
1755 if substr (lte.maj_dev_list, request_dev.major_index, 1) ^= "1"b then do;
1756
1757 call iodd_msg_ (normal, both, 0, "***", "Station ""^a"" is not permitted to use Line ""^a"".", idte.dev_id,
1758 lte.line_id);
1759 go to clear_input_buffer;
1760 end;
1761
1762 call iodd_msg_ (normal, master, 0, "", "Driver initializing for station: ^a", iodd_static.major_device);
1763
1764 code = 0;
1765
1766 return;
1767
1768 end attach_and_listen;
1769 %page;
1770
1771 find_device_class: proc (string, ind, dev_class, request_type, ec);
1772
1773
1774
1775
1776
1777
1778 dcl string char (*);
1779 dcl ind fixed bin;
1780 dcl dev_class char (32);
1781 dcl request_type char (32);
1782 dcl ec fixed bin (35);
1783 dcl i fixed bin;
1784 dcl qgt_index fixed bin;
1785
1786
1787 ec = 0;
1788
1789
1790
1791
1792 request_type = before (string, ".");
1793 dev_class = after (string, ".");
1794 if dev_class = "" then
1795 dev_class = request_type;
1796 if request_type = "" then do;
1797 ec = error_table_$badopt;
1798 call iodd_msg_ (normal, slave, 0, "", "Illegal form of request_type: ^a", string);
1799 return;
1800 end;
1801
1802
1803 do i = 1 to iodd_static.qgtp -> q_group_tab.n_q_groups;
1804 if iodd_static.qgtp -> q_group_tab.entries (i).name = request_type then
1805 go to found_group;
1806 end;
1807
1808 call iodd_msg_ (normal, slave, 0, "", "Request type ""^a"" not found in table.", request_type);
1809 ec = error_table_$badopt;
1810 return;
1811
1812 found_group:
1813 qgtep = addr (iodd_static.qgtp -> q_group_tab.entries (i));
1814
1815 qgt_index = i;
1816
1817
1818 do i = qgte.first_dev_class to qgte.last_dev_class;
1819 dctep = addr (iodd_static.dev_class_ptr -> dev_class_tab.entries (i));
1820 if dcte.qgte_index = qgt_index then
1821 if dcte.id = dev_class then do;
1822 ind = i;
1823 return;
1824 end;
1825 end;
1826
1827 ec = error_table_$badopt;
1828 call iodd_msg_ (normal, slave, 0, "", "Device class ""^a"" not found.", dev_class);
1829 return;
1830
1831 end find_device_class;
1832 %page;
1833
1834 validate_request: proc (ind, code);
1835
1836
1837
1838
1839
1840
1841
1842 dcl ind fixed bin;
1843 dcl code fixed bin (35);
1844 dcl ec fixed bin (35);
1845 dcl i fixed bin;
1846 dcl authorization bit (72) aligned;
1847 dcl dev_label char (32);
1848 dcl allowed_name char (24);
1849 dcl allowed_proj char (12);
1850 dcl driver_name char (24);
1851 dcl driver_proj char (12);
1852 dcl userid char (32);
1853
1854 i = ind;
1855 if request_dev.n_minor = 1 then
1856 dev_label = request_dev.major_name;
1857 else dev_label = char (rtrim (request_dev.major_name) || "." || request_dev.minor (i).name, length (dev_label));
1858 if request_dev.minor (i).dvc_index = 0 then do;
1859 call iodd_msg_ (normal, both, 0, "", "No default request type has been assigned to device ""^a"".",
1860 dev_label);
1861 code = error_table_$noentry;
1862 return;
1863 end;
1864
1865 dctep = addr (iodd_static.dev_class_ptr -> dev_class_tab.entries (request_dev.minor (i).dvc_index));
1866
1867 ec = 0;
1868
1869
1870 if ^(substr (dcte.device_list, request_dev.minor (i).index, 1)) then do;
1871
1872 call iodd_msg_ (normal, both, 0, "", "Device ""^a"" is not allowed for device class ""^a"".", dev_label,
1873 dcte.id);
1874 ec = error_table_$noentry;
1875
1876 end;
1877
1878
1879
1880 authorization = get_authorization_ ();
1881
1882 if ^aim_check_$greater_or_equal (authorization, dcte.max_access) then do;
1883
1884
1885 call iodd_msg_ (normal, both, 0, "",
1886 "Process access authorization is not sufficient for device class ""^a"".", dcte.id);
1887 ec = error_table_$ai_restricted;
1888
1889
1890 end;
1891
1892
1893
1894 userid = get_group_id_ ();
1895 driver_name = before (userid, ".");
1896 driver_proj = before (after (userid, "."), ".");
1897
1898
1899
1900 qgtep = addr (iodd_static.qgtp -> q_group_tab.entries (dcte.qgte_index));
1901
1902 userid = qgte.driver_id;
1903 allowed_name = before (userid, ".");
1904 allowed_proj = before (after (userid, "."), ".");
1905
1906 if allowed_name ^= driver_name then
1907 if allowed_name ^= "*" then
1908 go to name_err;
1909
1910 if allowed_proj ^= driver_proj then do;
1911 name_err:
1912 call iodd_msg_ (normal, both, 0, "", "User ""^a.^a"" not authorized as driver for request type ""^a"".",
1913 driver_name, driver_proj, qgte.name);
1914 ec = error_table_$user_not_found;
1915 end;
1916
1917
1918 if ec = 0 then
1919 request_dev.minor (i).dev_class = dcte.id;
1920 code = ec;
1921
1922 return;
1923
1924
1925 end validate_request;
1926 %page;
1927
1928 kill_device: proc;
1929
1930
1931
1932
1933 dcl coord_chan fixed bin (71);
1934 dcl send bit (1);
1935 dcl recursion_flag bit (1);
1936 dcl i fixed bin;
1937 dcl (p, p1) ptr;
1938 dcl code fixed bin (35);
1939
1940 recursion_flag = "0"b;
1941
1942 on command_error ;
1943 on any_other begin;
1944 send = "0"b;
1945 if recursion_flag then
1946 go to forget_it;
1947 recursion_flag = "1"b;
1948 go to term_seg;
1949 end;
1950
1951 if driver_ptr_list.number = 0 then do;
1952 send = "0"b;
1953 go to term_seg;
1954 end;
1955 else send = "1"b;
1956
1957 event_message = 0;
1958 msgp = addr (event_message);
1959 msgp -> ev_msg.code = 4;
1960 msgp -> ev_msg.minor_dev_index =
1961 driver_ptr_list.stat_segp (1) -> driver_status.dev_index;
1962 coord_chan = driver_ptr_list.stat_segp (1) -> driver_status.coord_chan;
1963
1964
1965 term_seg:
1966 do i = 1 to driver_ptr_list.number;
1967 p = driver_ptr_list.stat_segp (i);
1968 if send then do;
1969 call ipc_$delete_ev_chn (p -> driver_status.driver_chan, code);
1970 p1 = p -> driver_status.rqti_ptr;
1971 if p1 ^= null then
1972 call hcs_$terminate_noname (p1, code);
1973
1974 end;
1975 call hcs_$terminate_noname (p, code);
1976 if code ^= 0 then
1977 call iodd_msg_ (error, master, code, "kill_device",
1978 "Warning: driver status segment may be initiated.");
1979 end;
1980 if iodd_static.major_device ^= "" then do;
1981 call hcs_$terminate_file (sys_dir, iodd_static.major_device, 0, code);
1982 if code ^= 0 then
1983 call iodd_msg_ (error, master, code, "kill_device",
1984 "Warning: directory ^a in ^a may not be terminated.", iodd_static.major_device, sys_dir);
1985 end;
1986 iodd_static.major_device = "";
1987 driver_ptr_list.number = 0;
1988 if send then
1989 call hcs_$wakeup (iodd_static.coord_proc_id, coord_chan, event_message, code);
1990
1991
1992 forget_it:
1993 return;
1994
1995 end kill_device;
1996 %page;
1997
1998 hangup_station: proc;
1999
2000 dcl ec fixed bin (35);
2001
2002
2003 if iodd_static.slave_out ^= null then do;
2004 call iox_$control (iodd_static.slave_out, "hangup", null, ec);
2005 call iox_$close (iodd_static.slave_out, ec);
2006 call iox_$detach_iocb (iodd_static.slave_out, ec);
2007 end;
2008
2009 iodd_static.attach_name = "";
2010 iodd_static.slave_out, iodd_static.slave_in = null;
2011 iodd_static.slave.active = "0"b;
2012 iodd_static.slave.allow_quits = "0"b;
2013 iodd_static.slave.accept_input = "0"b;
2014 iodd_static.slave.print_errors = "0"b;
2015 iodd_static.slave.log_msg = "0"b;
2016 iodd_static.slave.echo_cmd = "0"b;
2017 iodd_static.slave.priv1 = "0"b;
2018 iodd_static.slave.priv2 = "0"b;
2019 iodd_static.slave.priv3 = "0"b;
2020 iodd_static.slave_output = null_stream;
2021 iodd_static.slave_input = null_stream;
2022
2023 return;
2024
2025 end hangup_station;
2026 %page;
2027
2028 wait_for_dial: proc (ec);
2029
2030
2031
2032
2033 dcl ec fixed bin (35);
2034 dcl n_dev fixed bin;
2035 dcl 1 dial_wait aligned,
2036 2 num fixed bin,
2037 2 chan fixed bin (71);
2038
2039 dcl 1 dial_arg aligned like dial_manager_arg;
2040
2041 call ipc_$create_ev_chn (iodd_static.ctl_dial_chan, ec);
2042 if ec ^= 0 then
2043 return;
2044
2045 dial_wait.num = 1;
2046 dial_wait.chan = iodd_static.ctl_dial_chan;
2047 dial_arg.version = dial_manager_arg_version_2;
2048 dial_arg.dial_qualifier = char (iodd_static.ctl_attach_name, length (dial_arg.dial_qualifier));
2049 dial_arg.dial_channel = dial_wait.chan;
2050 dial_arg.channel_name = iodd_static.ctl_attach_name;
2051
2052
2053 dial_arg.dial_out_destination = "";
2054 dial_arg.reservation_string = "";
2055 if iodd_static.ctl_attach_type = CTL_ATTACH_TYPE_TTY then do;
2056
2057
2058 call dial_manager_$privileged_attach (addr (dial_arg), ec);
2059
2060 if ec ^= 0 then
2061 return;
2062 call iodd_msg_ (normal, both, 0, "",
2063 "^a driver waiting for control terminal channel ""^a"" to become active.", iodd_static.major_device,
2064 iodd_static.ctl_attach_name);
2065 end;
2066 else do;
2067 call dial_manager_$allow_dials (addr (dial_arg), ec);
2068 if ec ^= 0 then
2069 return;
2070
2071 call iodd_msg_ (normal, both, 0, "", "^a driver waiting for control terminal ""^a"" to dial.",
2072 iodd_static.major_device, iodd_static.ctl_term.ctl_attach_name);
2073
2074 end;
2075
2076 wait:
2077 call ipc_$block (addr (dial_wait), addr (event_info), ec);
2078 if ec ^= 0 then
2079 return;
2080
2081 call convert_dial_message_ (event_info.message, dev_name, dim_name, n_dev, status_flags, ec);
2082 if ec ^= 0 then
2083 return;
2084
2085 if status_flags.hung_up then do;
2086 call iodd_hangup_$iodd_hangup_ (addr (event_info));
2087 go to wait;
2088 end;
2089 if ^status_flags.dialed_up then
2090 go to wait;
2091
2092 iodd_static.ctl_device = dev_name;
2093 iodd_static.ctl_dev_dim = dim_name;
2094
2095 call hcs_$make_ptr (ref_ptr, "iodd_hangup_", "iodd_hangup_", temp_ptr, ec);
2096
2097 if ec ^= 0 then
2098 return;
2099
2100 call ipc_$decl_ev_call_chn (iodd_static.ctl_dial_chan, temp_ptr, stat_p, 1, ec);
2101 if ec ^= 0 then
2102 return;
2103
2104 call iodd_msg_ (normal, both, 0, "", "Control terminal accepted.");
2105 return;
2106
2107 end wait_for_dial;
2108 %page;
2109
2110 check_for_dialup: proc (ec);
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123 Note
2124
2125
2126
2127 dcl ec fixed bin (35);
2128 dcl tw_index fixed bin;
2129 dcl state fixed bin;
2130
2131
2132
2133
2134 ec = 0;
2135
2136 if iodd_static.ctl_attach_name ^= idte.ctl_attach_name
2137 | iodd_static.ctl_attach_type ^= idte.ctl_attach_type then do;
2138 ec = 5;
2139 return;
2140 end;
2141
2142 if iodd_static.ctl_dev_dim = "mrd_" then
2143 return;
2144
2145 call hcs_$tty_index (iodd_static.ctl_device, tw_index, state, ec);
2146 if ec ^= 0 then
2147 return;
2148
2149 if state ^= 5 then
2150 ec = 10;
2151
2152 return;
2153
2154 end check_for_dialup;
2155 %page;
2156
2157 return_string: proc (target) returns (char (*));
2158
2159
2160
2161
2162 dcl 1 target unaligned like text_offset;
2163
2164 if target.total_chars = 0 then
2165 return ("");
2166 else return (
2167 substr (iodd_static.text_strings_ptr -> text_strings.chars,
2168 target.first_char, target.total_chars)
2169 );
2170
2171 end return_string;
2172 %page; %include device_class;
2173 %page; %include dial_manager_arg;
2174 %page; %include driver_ptr_list;
2175 %page; %include driver_status;
2176 %page; %include iod_constants;
2177 %page; %include iod_device_tab;
2178 %page; %include iod_event_message;
2179 %page; %include iod_line_tab;
2180 %page; %include iod_tables_hdr;
2181 %page; %include iodc_data;
2182 %page; %include iodd_static;
2183 %page; %include iox_dcls;
2184 %page; %include iox_modes;
2185 %page; %include mseg_message_info;
2186 %page; %include new_driver_msg;
2187 %page; %include q_group_tab;
2188 %page; %include request_descriptor;
2189 %page; %include timer_manager_constants;
2190
2191 end iodd_;