1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Bull Inc., 1987                *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   6         *                                                         *
   7         * Copyright (c) 1972 by Massachusetts Institute of        *
   8         * Technology and Honeywell Information Systems, Inc.      *
   9         *                                                         *
  10         *********************************************************** */
  11 
  12 /* format: style4 */
  13 
  14 /* format: off */
  15 
  16 iodd_: proc;
  17 
  18 /* This is not the main entry point.  It is used to set the entry variable for
  19    the driver module default handler if that entry was not defined.  We have
  20    to be able to call something! */
  21 
  22           return;
  23 
  24 
  25 iodd_init: entry (system_dir, testing);
  26 
  27 /* This is the initialization procedure for all IO Daemon drivers.  It is
  28    called with two arguments: system_dir which defines the directory which
  29    will contain the common IO Daemon data bases; and testing, which indicates
  30    that the driver is being run in test mode.  This procedure determines from
  31    the site operator which device is to be used, establishes communication
  32    with the IO Coordinator, attaches the device control terminal if needed,
  33    and transfers to the driver control procedure specified in the iod_tables
  34    source file.
  35 
  36    The design was adapted from the original IO Daemon driver designed by
  37    Robert S. Coren in September 1973.  This design is provided to make the
  38    IO Daemon compatible with the Access Isolation Mechanism.
  39 
  40    Coded in January 1975 by J. C. Whitmore.
  41 
  42    Modified in November 1975 by M. A. Braida
  43    to initialize data for seg_fault_error check.   */
  44 /* Modified Nov 1977 by J. C. Whitmore for new iodd_static data, initiation of rqti segs, and condition handling */
  45 /* Modified Mar 1978 by J. C. Whitmore for upgrade and addition of per RQT accounting and rqti seg from iod_tables */
  46 /* Modified by J. C. Whitmore, 7/78, to setup for new driver -> coord command strategy & "x" cmd */
  47 /* Modified by J. C. Whitmore, 10/78, to extend number of RJE stations (version 3 iod_tables format) */
  48 /* Modified by J. C. Whitmore, 11/78, to start using driver version numbers starting at 5.0 (5 major changes since MR 6.0) */
  49 /* Modified by J. C. Whitmore, 3/79 (V-5.1),  for minor message and logic bug fixes */
  50 /* Modified by J. C. Whitmore, 5/79 (V-5.2), to retry listen attachment 5 times before aborting */
  51 /* Modified by C. Hornig, 8/79 (V-5.3), for multiple minor devices of the same generic type */
  52 /* Modified by J. C. Whitmore, 10/79 (V-5.4), for daemon_idle default condition handler */
  53 /* Modified by E. N. Kittlitz, 6/81 (V-5.5), for UNCA rate structures */
  54 /* Modified:  November 1981 by G. Palter, V-5.6, to use read_password_ to get the station password if it is omitted from
  55    the station command, to not consider inability to set hangup_proc as fatal, to call head_sheet_$test when in a test
  56    environment, FILL IN THE BLANK, and fix the following bugs from the I/O daemon error list:
  57       0032: phx11372
  58          When running an I/O daemon in test mode with the coordinator and driverin the same process, printing a single
  59          request, exiting the I/O daemon, re-entering the I/O daemon, and printing another request will cause the
  60          head/tail sheets of the first request to be printed surrounding the file specified in the second request */
  61 /* Modified January 1982 by E. N. Kittlitz (V-5.7) for accounting change.
  62       accounting:nothing; in the IODT will really do nothing in io_daemon_account_. */
  63 /* Modified January 1983 by C. Marker  Added probe as a legal command in test mode. */
  64 /* Modified 1984-08-17 by E. Swenson for Version 2 PNTs. */
  65 /* Modified February 23, 1985 by C. Marker to use version 5 message segments */
  66 
  67 
  68 /****^  HISTORY COMMENTS:
  69   1) change(85-02-14,Homan), approve(87-04-06,MCR7656),
  70      audit(87-06-13,Beattie), install(87-08-06,MR12.1-1068):
  71      Add support for logout_on_hangup.
  72   2) change(88-02-18,Brunelle), approve(88-06-02,MCR7911),
  73      audit(88-10-19,Wallman), install(88-11-08,MR12.2-1199):
  74      Upgraded to version 5 iod tables.  Add support for head/tail_sheet entry
  75      variables and paper_type variable.  Remove calls to head_sheet_$init &
  76      tail_sheet_$init.
  77   3) change(88-11-03,Brunelle), approve(88-11-03,MCR7911),
  78      audit(88-11-03,Wallman), install(88-11-08,MR12.2-1199):
  79      Corrected a pass-by-value problem which was causing control terminal i/o
  80      to go to the message coordinator.
  81   4) change(88-11-11,Brunelle), approve(88-11-03,PBF7911),
  82      audit(88-11-14,Wallman), install(88-11-14,MR12.2-1212):
  83      Add a 10 second wait in all non-IOM configurations to allow the
  84      answering service at both ends of the communications line to handle
  85      all the traffic generated when a re_init is signalled.
  86                                                    END HISTORY COMMENTS */
  87 
  88 
  89 /* format: on */
  90 %page;
  91 /* ----------- ARGUMENTS ------------- */
  92 
  93 dcl  system_dir char (*),                                   /* directory containing common data bases */
  94      testing bit (1) aligned;                               /* test mode indicator */
  95 
  96 
  97 /* --------EXTERNAL ENTRIES---------- */
  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);                /* command for data in iod tables */
 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 /* --------- AUTOMATIC ----------- */
 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);                                  /* queue_type when we need to look for it */
 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;                                      /* index variables */
 178 dcl  ig char (4);                                           /* dummy for get_at_entry_ call */
 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);                                    /* temp for segment initialization */
 185 dcl  question char (64);                                    /* question to ask operator */
 186 dcl  use_default bit (1);                                   /* switch indicating that default device classes are used */
 187 dcl  msgp ptr;                                              /* pointer to the event message */
 188 dcl  message_id bit (72) aligned;                           /* id if a message segment message */
 189 dcl  driver_dir char (168);                                 /* path of driver major device directory */
 190 dcl  rqt_name char (32);
 191 dcl  rqt_string char (168) var;
 192 dcl  rqti_dir char (168);                                   /* path of dir with rqti segs */
 193 dcl  sys_dir char (168);                                    /* local copy of system directory path */
 194 dcl  meter_dir char (168);                                  /* path of meter data segs directory */
 195 dcl  entry_name char (32);                                  /* accounting proc entry point name */
 196 dcl  entry_variable entry variable options (variable);
 197 dcl  times fixed bin;                                       /* number of times the driver tries to find cord */
 198 dcl  temp_dir char (168) varying;
 199 dcl  temp_dir_entry char (256);
 200 dcl  temp_password char (8);                                /* temporary for password manipulation */
 201 dcl  temp_ptr ptr;                                          /* random temporary pointer variable */
 202 dcl  input_iocbp ptr;                                       /* iocb pointer for reading request type data */
 203 
 204 dcl  1 st aligned based (addr (io_stat)),                   /* breakout of an ios_ status code */
 205        2 code fixed bin (35) aligned,
 206        2 stat bit (36) aligned;
 207 
 208 dcl  temp_label label variable;                             /* for the fancy footwork needed to get a */
 209 dcl  based_ptr ptr based;                                   /* referencing_dir pointer for the search rules */
 210 dcl  ref_ptr ptr;
 211 dcl  1 driver_message aligned like new_driver_msg;          /* allocate space for mseg message  structure */
 212 %page;
 213 
 214 /* ----------EXTERNAL STATIC ---------- */
 215 
 216 dcl  iodd_stat_p ptr ext static;                            /* external copy of stat_p */
 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 /* ----------- INTERNAL STATIC -------- */
 232 
 233 dcl  io_daemon_driver_version char (8) int static options (constant) init ("5.7");
 234                                                             /* current version of the driver */
 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;/* allocation of 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,                      /* this is where the driver_ptr_list is allocated */
 256        2 dummy (32) fixed bin (71);                         /* be sure we reserve enough space for 30 drivers */
 257 
 258 
 259 /* ----------- BUILTINS ------- */
 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 /* ---------- STRUCTURES & MISC INCLUDE FILES ---------- */
 266 
 267 dcl  1 request_dev aligned,                                 /* major and minor devices to request from coord */
 268        2 major_name char (32),                              /* name of the major device */
 269        2 major_index fixed bin,                             /* device table index for it */
 270        2 n_minor fixed bin,                                 /* number of minor devices requested */
 271        2 minor (30) aligned,                                /* save room for 30 minor devices */
 272          3 name char (32) unal,                             /* minor device name...unal for the compiler */
 273          3 index fixed bin,                                 /* device table index for it */
 274          3 dev_class char (32),                             /* expected dvc to be used */
 275          3 dvc_index fixed bin;                             /* device class table index for the dvc */
 276 
 277 dcl  1 event_info aligned,                                  /* ipc_ info from a wakeup */
 278        2 channel fixed bin (71),                            /* event channel signaled */
 279        2 message fixed bin (71),                            /* event message sent to us */
 280        2 sender bit (36),                                   /* sender's process id */
 281        2 origin,
 282          3 dev_signal bit (18) unal,                        /* was this a process or device? */
 283          3 rings bit (18) unal,                             /* what ring sent it? */
 284        2 wait_list_index fixed bin;                         /* where was the channel in the wait list */
 285 
 286 dcl  1 ev_chan_list aligned,                                /* wait list for ipc_$block */
 287        2 number fixed bin,
 288        2 channel (32) fixed bin (71);
 289 
 290 dcl  1 read_info aligned,                                   /* structure to be filled in by read_status order */
 291        2 ev_chan fixed bin (71),                            /* event_channel the stream blocks on */
 292        2 input_pending bit (1);                             /* 1 if the stream is waiting for us to read */
 293 
 294 dcl  1 input aligned,                                       /* structure to hold arguments input by the operator */
 295        2 max fixed bin,                                     /* <the most tokens we ever expect */
 296        2 number fixed bin,                                  /* current number of tokens */
 297        2 arg (4) char (64) var;                             /* text of each token */
 298 
 299 dcl  1 status_flags aligned,                                /* status structure for convert_dial_message_ */
 300        2 dialed_up bit (1) unal,                            /* 1 = device has dialed the process */
 301        2 hung_up bit (1) unal,                              /* 1 = device has hung up */
 302        2 control bit (1) unal,                              /* 1 = accepted, rejected or number signal */
 303        2 stat_pad bit (33) unal;
 304 
 305 dcl  1 release_arg aligned like dial_manager_arg;           /* for calls to dial_manager_$release_channel */
 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);                 /* initialize the pointer used for all iodd_static references */
 313           sys_dir = system_dir;                             /* copy the arguments */
 314           iodd_static.sys_dir_ptr = addr (sys_dir);         /* so we can publish the dir name */
 315           iodd_static.flags.test_entry = testing;
 316           iodd_stat_p = stat_p;                             /* make it easier to create iodd procs */
 317           iodd_static.io_daemon_version = io_daemon_driver_version;
 318                                                             /* publish the version number */
 319           rqti_dir = rtrim (sys_dir) || ">rqt_info_segs";   /* this is where we find rqti segs */
 320           meter_dir = rtrim (sys_dir) || ">meter_data";     /* this is where we find the meter data segs */
 321           list_ptr = addr (driver_list);
 322           driver_ptr_list.number = 0;
 323           iodd_static.auto_start_delay = 60;                /* ready for early quit, 60 sec for auto-start */
 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);          /* initialize our general signal handler */
 331 
 332           on quit call early_quit;                          /* setup some condition handlers */
 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                                                             /* this is how we transfer back after new_device command */
 337           on daemon_idle
 338                begin;
 339           end;                                              /* do nothing but grab the condition */
 340           on any_other call iodd_signal_handler_;           /* we don't want the standard default */
 341                                                             /* handler to come to command level */
 342 
 343           call ios_$order ("user_i/o", "quit_enable", null (), io_stat); /* be sure quits are enabled */
 344 
 345           code = get_at_entry_ ("user_i/o", dim_name, dev_name, ig); /* this MUST work */
 346 
 347           if dim_name = "mrd_" then do;                     /* separate the streams for message coord */
 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;                                          /* use the same streams for consistency */
 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;                                 /* get a pointer to use with make_ptr for reference proc */
 370           ref_ptr = addr (temp_label) -> based_ptr;
 371 %page;
 372 
 373           iodd_static.ctl_term.ctl_attach_name = "";        /* initialize ctl_term once here, then let */
 374           iodd_static.ctl_term.ctl_attach_type = 0;         /* it be handled dynamically */
 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:                                                 /* we come here after a new_device command (from the handler) */
 382           iodd_static.ctl_term.form_type = "undefined_form";/* use default unless operator changes */
 383           iodd_static.ctl_term.forms = "0"b;                /* don't simulate terminal FF unless asked */
 384           iodd_static.slave.active = "0"b;                  /* be sure slave functions are dead */
 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;                 /* must ask for log messages */
 392           iodd_static.slave.echo_cmd = "0"b;                /* no echoing of command lines */
 393           iodd_static.slave.priv1 = "0"b;                   /* driver module defined privleges */
 394           iodd_static.slave.priv2 = "0"b;                   /* " */
 395           iodd_static.slave.priv3 = "0"b;                   /* " */
 396           iodd_static.re_init_in_progress = "0"b;           /* this is not a re_init */
 397           iodd_static.wakeup_time = 30;                     /* default to 30 seconds between wakeups */
 398           iodd_static.recursion_flag = "0"b;                /* be sure these are off for testing */
 399           iodd_static.no_coord_flag = "0"b;
 400           iodd_static.initialized = "0"b;
 401           iodd_static.dummy_ptr = null;                     /* in case it has been set */
 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); /* get an event channel for the timer */
 412           if code ^= 0 then do;                             /* an error is very bad */
 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;                                   /* not much else to do */
 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); /* set up default prices */
 424 %page;
 425 
 426 /*        Get the device name and device class from the operator */
 427 
 428 ask_for_dev:                                                /* for variable line, try new station */
 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                                                             /* ask for some input */
 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;                            /* ignore null lines */
 443 
 444           input.max = 4;                                    /* most tokens allowed */
 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;                       /* line was all blank */
 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;                                   /* easy 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;       /* he forgot the device names */
 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);                        /* save intact for reinit function */
 472           first_arg = before (first_arg, ".");              /* if major.minor, drop minor */
 473           if first_arg = "" then
 474                go to bad_line;
 475           if input.number = 1 then                          /* assume second arg is null if not given */
 476                if first_arg = "listen" then
 477                     go to bad_line;                         /* requires an second arg */
 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);                  /* save the second_arg if not too big */
 483           end;
 484 
 485 get_tables:
 486 
 487 /* This label is put here so a reinit will work even if the working tables
 488    have changed.  Find the tables in iod_working_tables so we can validate the
 489    requested device and device class */
 490 
 491           seg_name = "iodc_data";                           /* segment name for possible error msg */
 492           call init_seg (sys_dir, seg_name, iodc_data_ptr, try_10_times, code);
 493                                                             /* use internal proc to initiate */
 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;                        /* let the quit handler take it to */
 499                go to out;                                   /* normally there is nothing to do but quit */
 500           end;
 501 
 502           seg_name = "iod_working_tables";                  /* ....for error msg */
 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;                                   /* this is really bad!! */
 511           end;
 512 
 513 /*        Set the pointers to each table within the iod_working_tables */
 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 /*        see if we have to wait for a remote station to dial up  */
 524 
 525           iodd_static.attach_type = 0;                      /* start fresh, and avoid loop if tables change */
 526 
 527           if first_arg = "listen" then do;                  /* YES, wait for a station */
 528                                                             /* first validate the line_id given from master console */
 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));     /* get entry pointer */
 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);               /* attach line, wait for dialup, and validate the station id */
 540                if code ^= 0 then
 541                     go to new_device;                       /* just to be sure */
 542                request_type = "default";                    /* try for default request types */
 543                input_iocbp = iodd_static.slave_in;          /* if we need to ask for a request_type */
 544           end;
 545           else do;
 546 
 547 /* this is the normal device and request type case */
 548 /* search for the major device in the device table */
 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                                                             /* use new ptr for easy reference */
 553                     if idte.dev_id = first_arg then
 554                          request_dev.major_index = i;       /* record the index */
 555                end;
 556                if request_dev.major_index = 0 then do;      /* not found */
 557                     call iodd_msg_ (normal, master, 0, "", "Device ""^a"" not found in device table.", first_arg);
 558                     go to ask_for_dev;                      /* let him try again....or quit */
 559                end;
 560                if idte.attach_type = ATTACH_TYPE_VARIABLE_LINE then do;
 561                                                             /* can't use Line variable type here */
 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;  /* initialize major device info in static */
 567                iodd_static.major_device, request_dev.major_name = first_arg;
 568                request_type = second_arg;                   /* keep first_arg and second_arg intact */
 569                input_iocbp = iodd_static.master_in;         /* in case we have to ask for a request type */
 570           end;
 571 %page;
 572 
 573 /*        Find each associated minor device and save the index and default device class */
 574 
 575           request_dev.n_minor = 0;                          /* indicate that none have been found yet */
 576 
 577 /* look for all posible minor devices...up to the max */
 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)); /* set pointer to table entry */
 580                if mdte.major_index = request_dev.major_index then do;
 581 
 582 /* we found one that belongs to the major dev */
 583                     request_dev.n_minor = request_dev.n_minor + 1; /* count it */
 584                     request_dev.minor.name (request_dev.n_minor) = mdte.dev_id; /* copy the minor device name */
 585                     request_dev.minor.index (request_dev.n_minor) = i; /* save the minor index */
 586                     request_dev.minor.dvc_index (request_dev.n_minor) = mdte.default_dev_class; /* save the default device class index */
 587                end;
 588           end;                                              /* end of the table search */
 589 
 590           if (request_dev.n_minor > 0) & (i <= idte.last_minor) then /* see if we omitted a minor device */
 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;               /* OOPS...the table is garbage */
 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;                        /* give programmer a look */
 599                go to out;                                   /* then give up */
 600           end;
 601 
 602 /*        See if we should force the operator to give a device class */
 603 
 604           if request_type = "" then                         /* if no optional device class was given, check n_minor */
 605                if request_dev.n_minor = 1 then
 606                     use_default = "1"b;                     /* assume the default */
 607                else use_default = "0"b;                     /* force response for multiple devices */
 608           else if request_type = "default" then
 609                use_default = "1"b;                          /* operator overrides */
 610           else use_default = "0"b;                          /* take the given class or ask if multiple */
 611 
 612 /*        Now we check out each possible device class for the requested devices */
 613 
 614           if request_dev.n_minor > 1 | use_default then do; /* must check further for the request type(s) */
 615                do i = 1 to request_dev.n_minor;             /* for multiple minor devices we must ask for each dvc */
 616                     if ^use_default | request_dev.minor (i).dvc_index = 0 then do;
 617                                                             /* no default? */
 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                                                             /* invoke remote runout spacing */
 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;                /* ignore blank lines */
 630 
 631                          input.max = 4;                     /* most tokens allowed */
 632                          call iodd_parse_$command (substr (line, 1, nchars), addr (input), code);
 633                                                             /* see what he said */
 634                          if code ^= 0 then do;
 635                               if code = error_table_$noarg then
 636                                    go to get_dvc;           /* try again if line was blank */
 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                                                             /* try for a clean start */
 642                                    request_dev.minor (i).dvc_index = 0;
 643                                                             /* not sure if it is the default any more */
 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; /* be sure there is a default */
 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;                           /* have to search for the specified dvc */
 659 
 660                               call find_device_class (request_type, j, dev_class, queue_type, code);
 661                                                             /* use internal proc */
 662                               if code ^= 0 then
 663                                    go to bad_dvc;           /* let him try again...msg has been sent */
 664 
 665                               request_dev.minor (i).dvc_index = j;
 666                                                             /* store the returned index */
 667                          end;
 668                     end;
 669 
 670 /*                  Now check to be sure it is legal for this process. */
 671 
 672                     call validate_request (i, code);        /* use the internal proc */
 673                     if code ^= 0 then
 674                          go to bad_dvc;                     /* error has been printed already */
 675                end;
 676           end;                                              /* end of dvc request loop for multiple minor devices */
 677 
 678           else do;                                          /* we have a single device and a given request_type arg */
 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;                      /* the message has already been printed */
 683 
 684                request_dev.minor (1).dvc_index = j;         /* store the dvc index returned */
 685 
 686                call validate_request (1, code);             /* check it out */
 687                if code ^= 0 then
 688                     go to ask_for_dev;                      /* if bad, start over */
 689           end;
 690 
 691 /*        WHEW...Now request_dev contains all the information needed to communicate to the coordinator */
 692 %page;
 693 
 694 re_init_junction:
 695 
 696 /* This is the point of entry for re-initialization of the driver after a
 697    "no-coord" or "re_init" signal.  We can proceed on the assumption that the
 698    same major and minor devices and device classes will be used. */
 699 
 700           iodd_static.major_device = request_dev.major_name;/* this gets cleared by kill_device, so reset in case */
 701           iodd_static.admin_ec_name = rtrim (request_dev.major_name) || "_admin.ec";
 702                                                             /* define x cmd ec name */
 703           iodd_static.coord_proc_id = iodc_data.proc_id;    /* save coordinators process id */
 704           iodd_static.driver_proc_id = get_process_id_ ();  /* and the drivers */
 705           iodd_static.no_coord_flag = "1"b;                 /* accept a no_coord signal now */
 706           iodd_static.recursion_flag = "0"b;                /* be sure this is reset for reinit */
 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;             /* default to no auto logout, must be set by command */
 717           iodd_static.assigned_devices = 0;                 /* no devices at this point */
 718           iodd_static.current_devices = 0;
 719           iodd_static.output_device = "Undefined";
 720           iodd_static.auto_start_delay = 60;                /* wait 60 seconds after quit before auto-start */
 721           if iodd_static.attach_type ^= ATTACH_TYPE_VARIABLE_LINE then do;
 722                                                             /* assume attachment good for variable line */
 723                iodd_static.slave_in, iodd_static.slave_out = null;
 724                                                             /* for now */
 725                iodd_static.slave.active = "0"b;             /* slave must be re-defined */
 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;      /* we are done with this now */
 730                iodd_static.slave_input = null_stream;
 731           end;
 732           iodd_static.slave.log_msg = "0"b;                 /* must ask for log messages */
 733           iodd_static.slave.echo_cmd = "0"b;                /* don't echo cmds by default */
 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,                      /* be ready to publish the list */
 740                list_ptr = addr (driver_list);
 741 
 742           iodd_static.chan_list_ptr = addr (ev_chan_list);  /* wait list for ipc_$block */
 743           iodd_static.segptr = null;                        /* signal_handler cannot rely on segptr */
 744 
 745           call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat); /* reset error_output */
 746 
 747           call ios_$detach ("broadcast_errors", "", "", io_stat); /* avoid multiple attachments for sure */
 748 
 749           call ios_$attach ("broadcast_errors", "broadcast_", "error_i/o", "", io_stat); /* put back error stream */
 750 
 751           iodd_static.master_output = "master_output";      /* incase they got clobbered */
 752           iodd_static.master_input = "master_input";        /* save the default stream names */
 753           iodd_static.log_stream = "log_output";
 754 
 755           call iox_$look_iocb ("master_output", iodd_static.master_out, code);
 756                                                             /* reset the important iocb ptrs */
 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 /*        check to see if the table has changed on us since we last looked */
 762 
 763           on seg_fault_error begin;
 764                ithp = null;                                 /* indicate that we need to initiate */
 765                go to get_tables;                            /* and go back and get new indices */
 766           end;
 767 
 768           table_time = iod_tables_hdr.date_time_compiled;   /* reference through ptr to verify it */
 769 
 770           revert seg_fault_error;                           /* don't special case the condition any longer */
 771 
 772 
 773 /*        With all the static data initialized, get ready to request the devices */
 774 
 775           rqt_string = "";                                  /* build this as devices are initialized */
 776           driver_dir = rtrim (sys_dir) || ">" || request_dev.major_name;
 777           init_ev_chan = iodc_data.init_event_channel;      /* copy the coord's ipc chan */
 778           ev_chan_list.number = 2;                          /* initially 2 channels in the wait list */
 779           ev_chan_list.channel (1) = 0;                     /* this one is empty for now */
 780           ev_chan_list.channel (2) = iodd_static.timer_chan;/* timer is second priority */
 781 
 782           driver_ptr_list.number = 0;                       /* assume that no driver status segs exist */
 783 
 784           new_driver_msg_p = addr (driver_message);         /* this is where we build the request */
 785           driver_message.lock_id = "0"b;                    /* this will ensure that set_lock works */
 786 
 787           call set_lock_$lock (driver_message.lock_id, 0, code);
 788                                                             /* store process lock id */
 789 %page;
 790 
 791 /* At this point we will loop through the requested minor devices, asking the
 792    IO coordinator to establish this process as the driver.  There is a lot of
 793    work to do for the initialization of each driver, so, the main loop will
 794    take a few pages of listing */
 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;                  /* once around for each minor dev */
 800 
 801                call ipc_$create_ev_chn (driver_message.wakeup_chan, code);
 802                                                             /* get a channel for the coord to use */
 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;                       /* drop any device assigned */
 807                     go to out;                              /* thats all she wrote! */
 808                end;
 809 
 810                ev_chan_list.channel (1) = driver_message.wakeup_chan;
 811                                                             /* get ready to block for coord */
 812                driver_message.device_index = request_dev.minor (i).index;
 813                                                             /* fill in the rest of the request */
 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);                      /* send off the request */
 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;                       /* drop any we have */
 823                     if iodd_static.test_entry then
 824                          call early_quit;                   /* give programmer a look */
 825                     go to out;                              /* then bug out */
 826                end;
 827 
 828                unspec (event_message) = message_id;         /* give coord the message id in an event message */
 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;                        /* on error assume the coord is gone */
 833 
 834 /*        now block until the coordinator gives us the device (up to 5 min max) */
 835 
 836                call ipc_$drain_chn (iodd_static.timer_chan, code);
 837                                                             /* clear the timer...in case */
 838                call timer_manager_$alarm_wakeup (300, RELATIVE_SECONDS, iodd_static.timer_chan);
 839                                                             /* start the clock */
 840                call ipc_$block (addr (ev_chan_list), addr (event_info), code);
 841                                                             /* and wait */
 842                call timer_manager_$reset_alarm_wakeup (iodd_static.timer_chan);
 843                                                             /* reset the clock */
 844                if code ^= 0 then do;                        /* bad news, and dumb code */
 845                     call convert_ipc_code_ (code);
 846                     call iodd_msg_ (error, both, code, id, "Fatal error: from  ipc_$block .");
 847                     call kill_device;                       /* flush any previous devices */
 848                     if iodd_static.test_entry then
 849                          call early_quit;                   /* take a peek, */
 850                     go to out;                              /* then forget it */
 851                end;
 852 
 853 /*        It was a legal wakeup, who sent it? */
 854 
 855                if event_info.wait_list_index = 2 then do;   /* bad news if it was the timer */
 856                     call iodd_msg_ (normal, both, 0, id, "Coordinator did not respond to new driver wakeup.");
 857                     signal no_coord;                        /* don't bother to flush devices */
 858                end;
 859 
 860                code = addr (event_info.message) -> ev_msg.code;
 861                                                             /* see what the coord said */
 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;                    /* already assigned */
 869                          call iodd_msg_ (normal, both, 0, id, "Device ^a assigned to another process", dev_label);
 870                          go to ask_for_dev;                 /* don't bother to flush */
 871                     end;
 872                     else if code = 7 then do;               /* already assigned to us, huh? */
 873                          call iodd_msg_ (normal, both, 0, id, "Device ^a already assigned to this process.", dev_label);
 874                     end;                                    /* tell the operator, but, keep on truckin' */
 875                     else do;                                /* otherwise it is very bad */
 876                          call iodd_msg_ (error, both, 0, id, "Coordinator could not initialize ^a driver. Code = ^d",
 877                               dev_label, code);
 878                          call kill_device;                  /* we may have had some devices assigned */
 879                          go to ask_for_dev;                 /* start all over again */
 880                     end;
 881 
 882                end;                                         /* when we pass here, we are almost home free */
 883 %page;
 884 
 885 /*        The coord gave the OK....so find the driver status segment */
 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;                       /* drop it */
 892                     go to ask_for_dev;                      /* and start all over...UGH! */
 893                end;
 894 
 895                driver_ptr_list.number = driver_ptr_list.number + 1; /* add one to the list */
 896                driver_ptr_list.stat_segp (driver_ptr_list.number) = driver_status_ptr; /* save the driver ptr */
 897                driver_status.driver_chan = ev_chan_list.channel (1); /* and the event channel */
 898                driver_status.last_wake_time = 0;            /* havn't asked for work yet */
 899                driver_status.list_index = driver_ptr_list.number; /* for the future */
 900                string (driver_status.status_flags) = "0"b;  /* clear the flags */
 901                driver_status.dev_ctl_ptr = null;            /* don't leave uninitialized pointers around */
 902 
 903 /*        Now find the accounting procedure we will use for this driver */
 904 /*        It can be different for each minor device driver */
 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                                                             /* record generic type for minor dev */
 911 
 912                if return_string (qgte.accounting) = "nothing" then /* no accounting routine */
 913                     driver_status.have_accounting = "0"b;   /* so indicate that */
 914                else do;                                     /* otherwise it is more trouble */
 915                     driver_status.have_accounting = "1"b;   /* so indicate that */
 916                     if return_string (qgte.accounting) = "system" then /* use our special procedure */
 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;            /* again */
 930                          end;
 931                     end;
 932                end;
 933 
 934 /*        set up the line_charge prices for this logical driver */
 935 
 936                call io_daemon_account_$set_line_prices (driver_ptr_list.number, qgtep, code);
 937                if code ^= 0 then do;                        /* OOPS */
 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 /*        now see if there is a request type info seg specified for the driver */
 946 
 947                entry_name = qgte.rqti_seg_name;             /* get the entry name from the iod_tables */
 948                if entry_name ^= "" then do;                 /* must find the rqti seg */
 949                     call init_seg (rqti_dir, entry_name, driver_status.rqti_ptr, try_0_times, code);
 950                                                             /* don't wait */
 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;          /* be sure of no mistake */
 958 
 959                rqt_name = before (rtrim (driver_status.req_type_label), ".");
 960                                                             /* get the real request type name */
 961 
 962                if index (rqt_string, rtrim (rqt_name)) = 0 then /* look for duplicates */
 963                     rqt_string = rqt_string || " " || rtrim (rqt_name); /* add to the string */
 964 
 965 /* associate minor device with rqt name for x command */
 966                call set_iod_val (rtrim (driver_status.device_id), rtrim (rqt_name));
 967 
 968 /*        Go back and look for the next minor device driver to be assigned */
 969 
 970           end;                                              /* That's all for the big loop */
 971 
 972 /*        Time for final initialization */
 973 
 974           idtep = addr (iod_device_tab.entries (request_dev.major_index)); /* locate major device data */
 975           iodd_static.major_args = idte.args;
 976 
 977 /* if user says single sheet then set it, else force to continuous forms */
 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; /* start with the first in the list */
 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 /*        call the coord again and ask for the special command IPC channel (for drivers only) */
 987 
 988           event_message = 0;                                /* clear the event message of trash */
 989           msgp = addr (event_message);                      /* setup event message */
 990           msgp -> ev_msg.code = 5;                          /* code 5: requesting cmd channel */
 991           msgp -> ev_msg.minor_dev_index =                  /* name a minor device so coord can release */
 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 /* get request chan */
 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;                             /* on error assume the coord is gone */
1000 
1001           call ipc_$drain_chn (iodd_static.timer_chan, code);
1002                                                             /* clear the timer...in case */
1003           call timer_manager_$alarm_wakeup (300, RELATIVE_SECONDS, iodd_static.timer_chan);
1004 
1005 /* start the clock */
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                                                             /* and wait */
1011 
1012           call timer_manager_$reset_alarm_wakeup (iodd_static.timer_chan);
1013                                                             /* reset the clock */
1014           if code ^= 0 then do;                             /* bad news, and dumb code */
1015                call convert_ipc_code_ (code);
1016                call iodd_msg_ (error, both, code, id, "Fatal error: from  ipc_$block .");
1017                call kill_device;                            /* flush any previous devices */
1018                if iodd_static.test_entry then
1019                     call early_quit;                        /* take a peek, */
1020                go to out;                                   /* then forget it */
1021           end;
1022 
1023           if event_info.wait_list_index = 2 then do;        /* bad news if it was the timer */
1024                call iodd_msg_ (normal, both, 0, id, "Coordinator did not respond to standard wakeup.");
1025                signal no_coord;                             /* don't bother to flush devices */
1026           end;
1027 
1028           iodd_static.coord_cmd_chan = event_info.message;  /* save the returned ev chan */
1029 
1030 /*        Set the entry variables for calling the driver module */
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;                        /* we can handle one error only */
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;                   /* perish the thought! */
1062                end;
1063           end;
1064 
1065 /* set the entry variables for the head_sheet entries.  If not supplied in
1066    iod_tables, use default of head_sheet_ */
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;                /* ... and that head sheet printer can find printer_notice */
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 /* set the entry variables for the tail_sheet entries */
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 /*        Set up the wait list for blocking, except for the ctl_term entry */
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;     /* save the master console event channel in first position */
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;                                              /* leave the timer chan in position 2 for now */
1125           ev_chan_list.number = driver_ptr_list.number + 2;
1126 
1127           if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then /* for line variable, device is the slave */
1128                ev_chan_list.channel (2) = iodd_static.slave_ev_chan; /* the slave is defined as station device */
1129 
1130 /*        Check on the control terminal. If we have one, its ev_chan will go into position 2 after attachment */
1131 /*        unless this is a line variable type device.  Then allow ctl term, but not as the slave. */
1132 
1133           if iodd_static.ctl_term.attached then do;         /* check to see if it is still dialed */
1134                call check_for_dialup (code);
1135 
1136                if code = 0 then
1137                     go to set_ctl_streams;                  /* if still there, finish attachments */
1138 
1139                if code = 5 then do;                         /* this signals we are changing ctl terminals */
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 /* ready for dial_manager_ */
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 /* do what we can to drop it */
1157                     call ipc_$delete_ev_chn (iodd_static.ctl_dial_chan, code);
1158                                                             /* no longer needed */
1159                end;
1160                call ios_$detach (iodd_static.ctl_io, "", "", io_stat);
1161                                                             /* drop the dead terminal */
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;        /* all clear now */
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);                   /*  must ask answering service for terminal line or for dial */
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                                                             /* we want the message coordinator */
1182                iodd_static.ctl_dev_dim = "mrd_";
1183                iodd_static.ctl_device = idte.ctl_attach_name;
1184                                                             /* attach name was the device */
1185           end;
1186           else do;                                          /* otherwise, no ctl_term is required */
1187                iodd_static.ctl_input = null_stream;         /* be sure all variables are cleared */
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;                 /* this means the timer chan will be a dummy */
1193                                                             /* in the event wait list...it avoids errors */
1194                go to call_driver;                           /* ready to pass this process along */
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;                          /* couldn't attach? */
1199                if st.code = error_table_$ionmat then
1200                     go to set_ctl_streams;                  /* already attached, ??? */
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;                           /* might be better to ask operator what to do */
1206           end;
1207 
1208 set_ctl_streams:                                            /* set the input, output, and error streams */
1209           iodd_static.ctl_term.attached = "1"b;             /* this must be true in all cases */
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_";                          /* use the paging dim for simulating forms */
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;   /* let it ride if attached */
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 /*        Put the control terminal event channel in the wait list */
1233 
1234           call ios_$order (iodd_static.ctl_io, "read_status", addr (read_info), io_stat);
1235           if st.code ^= 0 then do;                          /* did someone lie?  this should always work */
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;      /* save here for other uses */
1241 
1242           if ^iodd_static.slave.active then do;             /* if active, it was a line variable type */
1243                                                             /* so don't make the control terminal the salve */
1244                ev_chan_list.channel (2) = read_info.ev_chan;/* slave term is lower priority than master */
1245                iodd_static.slave_ev_chan = read_info.ev_chan;
1246 
1247 /*        Set the ctl_term as the slave device. */
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:                                                /* call the init entry of the driver module */
1269           call set_iod_val ("device", rtrim (request_dev.major_name));
1270                                                             /* set values for iod_val active function */
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 = "";                           /* define request type if only one */
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));    /* define all the request types for iod_admin.ec */
1278 
1279           if ^iodd_static.slave.active then do;             /* set slave control modes if ctl term active */
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;       /* send log msgs to slave if not the ctl terminal */
1301           end;
1302 
1303           if iodd_static.test_entry then                    /* see if we are testing in one process */
1304                if iodd_static.coord_proc_id = iodd_static.driver_proc_id then /* make them different for locking */
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);       /* be sure these related procs are initialized */
1308           call iodd_quit_handler_$init (stat_p);
1309 
1310           call write_control_form_$init (stat_p);
1311 
1312           iodd_static.initialized = "1"b;                   /* tell the signal handler we are initialized */
1313 
1314 
1315           call iodd_static.driver_init (stat_p);            /* take it away */
1316 
1317 
1318 /*        if we return, the driver was not able to initialize.  so try again */
1319 
1320           call iodd_msg_ (error, both, 0, id, "Unable to initialize driver.^/");
1321 
1322           go to start_new_device_cleanup;                   /* let the handler do the work */
1323 %page;
1324 
1325 out:
1326           if iodd_static.test_entry then do;                /* make a clean return if testing */
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 /* put it back where we found it */
1336                call ios_$detach ("broadcast_errors", "", "", io_stat);
1337                call ios_$order ("user_i/o", "start", null (), io_stat);
1338 
1339 /* in case tty dim bug gives trouble */
1340                return;                                      /* thereby going away */
1341           end;
1342           else call logout;                                 /* in normal mode must log out explicitly */
1343 
1344 start_new_device_cleanup:
1345 
1346 /* the transfer to here will invoke all cleanup handlers */
1347           call ios_$attach ("error_output", "syn", "error_i/o", "", io_stat);
1348                                                             /* put it back in case it was changed */
1349 
1350           if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then
1351                call hangup_station;
1352 
1353           call kill_device;                                 /* inform the coordinator that current device is gone */
1354           go to new_device;                                 /* now go back and start over */
1355 
1356 driver_logout_label:
1357           if iodd_static.ctl_term.attached then do;         /* we may have a new ctl_term */
1358                call ipc_$delete_ev_chn (iodd_static.ctl_dial_chan, code);
1359                                                             /* tell initializer */
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                                                             /* now free the tty chan */
1365                call ios_$detach (iodd_static.ctl_io, "", "", io_stat);
1366           end;
1367           call kill_device;                                 /* tell the coord if we can */
1368           call hangup_station;                              /* this will tell iox_ we don't have the terminal */
1369           go to out;                                        /* this will correct for test mode */
1370 
1371 re_init_driver:
1372 
1373 /* this will invoke all cleanup handlers */
1374           call kill_device;
1375           if iodd_static.re_init_in_progress then           /* Only way to get here with this set... */
1376                if iodd_static.logout_on_hangup then do;     /* is in case of a hangup */
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;                /* clear incase of signal during attachment */
1381           iodd_static.re_init_in_progress = "0"b;           /* anyone who cares already knows */
1382           if iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE then do;
1383                                                             /* re-validate the station if line variable type */
1384                if ^iodd_static.initialized then
1385                     call hangup_station;                    /* in case remote_driver_ couldn't hangup */
1386                iodd_static.initialized = "0"b;
1387                iodd_static.no_coord_flag = "0"b;
1388                call timer_manager_$sleep (10, RELATIVE_SECONDS);      /* let answering service clean up */
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);      /* let answering service clean up */
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 /* this will invoke all cleanup handlers then wait for a new coordinator */
1401           call kill_device;                                 /* this is to terminate the segs */
1402           iodd_static.recursion_flag = "0"b;
1403           iodd_static.initialized = "0"b;
1404           iodd_static.re_init_in_progress = "0"b;           /* all who care have seen this */
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                                                             /* see if there is a new process id */
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 /*                  not changed yet, wait 30 seconds and try again */
1418 
1419           times = times + 1;                                /* record the number of times we sleep */
1420           if times > 10 then do;                            /* only wait 5 minutes */
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;                   /* nothing else left to do */
1425 
1426           end;
1427           call timer_manager_$sleep (30, RELATIVE_SECONDS);           /* sleep for 30 seconds, then... */
1428           go to check_proc_id;                              /* try again */
1429 %page;
1430 
1431 
1432 /* ---------INTERNAL PROCEDURES ------------ */
1433 
1434 
1435 early_quit: proc;
1436 
1437 /* If we get a quit before regular handler is set up */
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;                                /* give an auto start unless something happens */
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);          /* let this go through */
1453 
1454           on any_other begin;
1455                give_start = "0"b;                           /* stop the auto start proc */
1456                call timer_manager_$reset_alarm_call (try_auto_start);
1457                                                             /* in case this frame goes away */
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                                                             /* get a command line */
1465           if give_start then do;                            /* expecting to give an auto start? */
1466                give_start = "0"b;                           /* we got something, so cancel the auto_start */
1467                call timer_manager_$reset_alarm_call (try_auto_start);
1468                                                             /* don't use a bad frame */
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;                              /* be nice about blank lines */
1476 
1477           if line = "start" then do;
1478 auto_start:
1479                call ios_$order ("user_i/o", "start", null, stat);
1480                                                             /* be sure we don't lose a wakeup */
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;                   /* assume he really means it */
1490           end;
1491 
1492           else if line = "return" then do;                  /* return to the caller of iodd_$iodd_init */
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                                                             /* let him know what we are doing */
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                                                             /* let him know what we are doing */
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;                         /* in case it returns */
1519                end;
1520           end;
1521 
1522           else if line = "." | line = "hold" then
1523                go to get_line;                              /* we just cancelled the auto start */
1524 
1525           else if line = "help" then do;                    /* tell what commands can be used */
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;                                      /* otherwise forget it */
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 /* Little procedure to initiate segments */
1552 
1553 dcl  seg_name char (*);
1554 dcl  segp ptr;
1555 dcl  dir_name char (*);
1556 dcl  num_times fixed bin;                                   /* number of times we should try to initiate */
1557 dcl  ec fixed bin (35);
1558 dcl  times fixed bin;
1559 
1560           times = 0;                                        /* haven't tried at all yet */
1561 try_again:                                                  /* be sure to set reference name */
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;                                 /* all attempts have failed */
1569                end;
1570                else if ec = error_table_$noentry then do;
1571 
1572 /* wait a bit and try again (coordinator may create seg. when it comes up) */
1573                     times = times + 1;                      /* count the number of times we try */
1574                     if times > num_times then
1575                          return;                            /* after num_times give up */
1576                     call timer_manager_$sleep (30, RELATIVE_SECONDS);
1577                     go to try_again;
1578                end;
1579                else return;                                 /* unrecoverable error */
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,                                 /* structure for the "hangup_proc" control order */
1597        2 entry entry,                                       /* entry to be called */
1598        2 data_ptr ptr,                                      /* pointer to be passed to entry */
1599        2 priority fixed bin;                                /* ipc_ call chan priority */
1600 
1601           code = 0;
1602           tries = 0;                                        /* count the attach attempts, allow up to five */
1603 
1604 /* make attach description */
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;                                /* increment the attempt count */
1609           if tries > 5 then do;                             /* over 5, give up */
1610                code = error_table_$no_operation;            /* be sure we abort this device */
1611                call iodd_msg_ (error, master, 0, id, "All attach attempts failed.");
1612                                                             /* sound beeper */
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);            /* pause to allow answering service to catch up */
1619 
1620           iodd_static.major_device = "";                    /* no station defined at this point */
1621           iodd_static.attach_type = 0;                      /* nothing really attached yet either */
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                                                             /* very bad */
1630                     call iodd_msg_ (normal, master, code, id, "Unable to attach line.");
1631                     call hangup_station;                    /* just to be sure */
1632                     go to attach_chan;                      /* now try again */
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;                    /* just to be sure */
1640                     go to attach_chan;                      /* now try again */
1641                end;
1642 
1643           iodd_static.slave.active = "1"b;                  /* got a live one */
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;     /* they are both the same */
1647           iodd_static.slave_input, iodd_static.slave_output = "teleprinter";
1648           iodd_static.attach_type = ATTACH_TYPE_VARIABLE_LINE;
1649                                                             /* tell all what we did */
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;                           /* now try again */
1657           end;
1658 
1659           iodd_static.slave_ev_chan = read_info.ev_chan;    /* save this for later */
1660 
1661           hangup_info.entry = iodd_hangup_$iodd_hangup_;    /* in case answering service detects a 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                                                             /* start a new page */
1674           if code ^= 0 then
1675                go to drop_station;
1676 
1677           tries = 0;                                        /* attempt counter is now used for station IDs */
1678           cmd_msg = "Enter station command:" || NL;
1679           go to ask_for_station;
1680 
1681 clear_input_buffer:                                         /* flush all input buffers */
1682           call iox_$control (iodd_static.slave_in, "resetread", null, code);
1683 
1684 ask_for_station:
1685           tries = tries + 1;                                /* increment the count of station ids requested */
1686           if tries > 10 then
1687                go to drop_station;                          /* over the limit, hangup the intruder */
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;                                   /* reset the attach counter for new station */
1694                call timer_manager_$sleep (10, RELATIVE_SECONDS);      /* let the line settle or operator send quit */
1695                go to attach_chan;
1696           end;
1697 
1698           call iox_$control (iodd_static.slave_out, "runout", null, code);
1699                                                             /* force out the message */
1700 
1701 /*        Look for the command line:  station <station_id> <station_password>    */
1702 
1703           line = "";                                        /* clear the input buffer */
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);                   /* strip any new line chars */
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                     /* ... left off password: ask for it */
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                    /* ... user really wants a blank password */
1725                station_password = "";
1726 
1727           if station_password ^= "" then do;
1728                temp_password = station_password;
1729                station_password = scramble_ (temp_password);
1730                temp_password = "";                          /* Security */
1731           end;
1732           call validate_card_input_$station (station_id, station_password, err_msg, code);
1733           station_password = "";                            /* Security */
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 /*        assume the station_id and major device are the same */
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));   /* use new ptr for easy reference */
1746                if idte.dev_id = request_dev.major_name then
1747                     request_dev.major_index = i;            /* record the index */
1748           end;
1749           if request_dev.major_index = 0 then do;           /* not found */
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;                    /* let him try again....or quit */
1753           end;
1754 
1755           if substr (lte.maj_dev_list, request_dev.major_index, 1) ^= "1"b then do;
1756                                                             /* OOPS */
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;                                         /* all was well, say so */
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 /* Internal procedure to search the queue group table and the device class
1774    table to find the device class index for the specified input string.
1775    The string is in the form of request_type.dev_class with the dev_class part
1776    being optional, thus assuming request_type.request_type.  */
1777 
1778 dcl  string char (*);                                       /* input can be no more than 64 chars */
1779 dcl  ind fixed bin;                                         /* the device class index - output */
1780 dcl  dev_class char (32);                                   /* device class name used - output */
1781 dcl  request_type char (32);                                /* queue group name used - output */
1782 dcl  ec fixed bin (35);                                     /* error code returned */
1783 dcl  i fixed bin;                                           /* random fixed bin variable */
1784 dcl  qgt_index fixed bin;                                   /* index of the queue group entry in the table */
1785 
1786 
1787           ec = 0;                                           /* clear the error code */
1788 
1789 /* break it into two components, if there.  If only one component, make
1790    device_class the same as request_type */
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;                    /* first char was ".", naughty */
1798                call iodd_msg_ (normal, slave, 0, "", "Illegal form of request_type: ^a", string);
1799                return;
1800           end;
1801 
1802 /*        search the queue group table for the requested entry */
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                                                             /* for easy reference */
1815           qgt_index = i;                                    /* save the index for the next test */
1816 
1817 /*        Now look in the device class table for the entry which matches the dev_class and request_type */
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          /* must belong to the request_type */
1821                     if dcte.id = dev_class then do;         /* and be the right name */
1822                          ind = i;                           /* return the index of the entry */
1823                          return;
1824                     end;
1825           end;
1826 
1827           ec = error_table_$badopt;                         /* no entry found */
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 /* Internal procedure to check that the device class index for the minor
1837    device in the request_dev structure specified by "ind" is valid for this
1838    process at its current access authorization.  The IO coordinator will make
1839    the same checks,  this check is made so we can properly respond to the
1840    operator at the right time if an error occurs. */
1841 
1842 dcl  ind fixed bin;                                         /* minor device index in the request_dev structure */
1843 dcl  code fixed bin (35);                                   /* error code to be returned */
1844 dcl  ec fixed bin (35);                                     /* local error code */
1845 dcl  i fixed bin;                                           /* index variables */
1846 dcl  authorization bit (72) aligned;                        /* access authorization of process */
1847 dcl  dev_label char (32);                                   /* name for messages */
1848 dcl  allowed_name char (24);                                /* driver's name max of 22 char */
1849 dcl  allowed_proj char (12);                                /* driver's project...max of 9 char */
1850 dcl  driver_name char (24);                                 /* driver's name max of 22 char */
1851 dcl  driver_proj char (12);                                 /* driver's project...max of 9 char */
1852 dcl  userid char (32);                                      /* copy of the required driver userid */
1853 
1854           i = ind;                                          /* copy the argument */
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;                 /* indicate an error */
1862                return;                                      /* nothing more we can check */
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;                                           /* initialize the failure indicator */
1868 
1869 /*        First check that this minor device is allowed for this device class */
1870           if ^(substr (dcte.device_list, request_dev.minor (i).index, 1)) then do;
1871                                                             /* if the device bit is off...too bad */
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;                   /* flag the error */
1875                                                             /* then keep going to give all possible errors */
1876           end;
1877 
1878 /*        Now check that the process access authorization is high enough to handle all requests */
1879 
1880           authorization = get_authorization_ ();            /* get current authorization */
1881 
1882           if ^aim_check_$greater_or_equal (authorization, dcte.max_access) then do;
1883                                                             /* fail if authorization is not greater or equal */
1884                                                             /* to highest request driver is to handle */
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;             /* set the failure flag */
1888                                                             /* this error should be error_table_$ai_restricted */
1889 
1890           end;
1891 
1892 /*        Now check for the correct process group id of the driver */
1893 
1894           userid = get_group_id_ ();                        /* get id of driver */
1895           driver_name = before (userid, ".");               /* and break into components */
1896           driver_proj = before (after (userid, "."), ".");
1897 
1898 /*                  get ready to look at the q_group_tab entry */
1899 
1900           qgtep = addr (iodd_static.qgtp -> q_group_tab.entries (dcte.qgte_index));
1901 
1902           userid = qgte.driver_id;                          /* get id of allowed drivers */
1903           allowed_name = before (userid, ".");              /* and break into components */
1904           allowed_proj = before (after (userid, "."), ".");
1905 
1906           if allowed_name ^= driver_name then               /* name must be equal or "*" to be accepted */
1907                if allowed_name ^= "*" then
1908                     go to name_err;                         /* too bad for him */
1909 
1910           if allowed_proj ^= driver_proj then do;           /* project must match */
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);   /* tell the operator */
1914                ec = error_table_$user_not_found;            /* indicate failure */
1915           end;
1916 
1917 /*        If all was well give back the device class name */
1918           if ec = 0 then
1919                request_dev.minor (i).dev_class = dcte.id;   /* save the dvc name */
1920           code = ec;                                        /* report any errors */
1921 
1922           return;
1923 
1924 
1925      end validate_request;
1926 %page;
1927 
1928 kill_device: proc;
1929 
1930 /* internal procedure to tell the IO coordinator that the device and all
1931    minor devices which have been assigned to this process should be released */
1932 
1933 dcl  coord_chan fixed bin (71);                             /* place for copy of coord ev chan */
1934 dcl  send bit (1);                                          /* flag to abort sending a wakeup */
1935 dcl  recursion_flag bit (1);
1936 dcl  i fixed bin;                                           /* local index variable */
1937 dcl  (p, p1) ptr;                                           /* temp ptr for easy reading */
1938 dcl  code fixed bin (35);
1939 
1940           recursion_flag = "0"b;
1941 
1942           on command_error ;
1943           on any_other begin;                               /* in case driver_status is gone */
1944                send = "0"b;                                 /* abort the wakeup */
1945                if recursion_flag then
1946                     go to forget_it;
1947                recursion_flag = "1"b;
1948                go to term_seg;                              /* but try to clean up address space */
1949           end;
1950 
1951           if driver_ptr_list.number = 0 then do;            /* see if any have been assigned */
1952                send = "0"b;                                 /* if not, abort wakeup */
1953                go to term_seg;                              /* try to terminate the parent dir */
1954           end;
1955           else send = "1"b;
1956 
1957           event_message = 0;                                /* clear the event message of trash */
1958           msgp = addr (event_message);                      /* setup event message */
1959           msgp -> ev_msg.code = 4;                          /* code 4: we are about to logout */
1960           msgp -> ev_msg.minor_dev_index =                  /* name a minor device so coord can release */
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 /* save this in temp because we must terminate status seg before using it */
1965 term_seg:
1966           do i = 1 to driver_ptr_list.number;               /* first terminate all driver status segs */
1967                p = driver_ptr_list.stat_segp (i);
1968                if send then do;                             /* can we still reference a driver status seg ? */
1969                     call ipc_$delete_ev_chn (p -> driver_status.driver_chan, code);
1970                     p1 = p -> driver_status.rqti_ptr;       /* get rqti ptr */
1971                     if p1 ^= null then
1972                          call hcs_$terminate_noname (p1, code);
1973                                                             /* try to terminate */
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 = "";                    /* the device is gone */
1987           driver_ptr_list.number = 0;                       /* assume all driver stat segs are gone */
1988           if send then                                      /* inform the coord only after all terminations are done */
1989                call hcs_$wakeup (iodd_static.coord_proc_id, coord_chan, event_message, code);
1990 
1991 /* forget error code....can't do anything about it */
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;         /* when defined, drop it */
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;                  /* slave must be re-defined */
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;                 /* must ask for log messages */
2016           iodd_static.slave.echo_cmd = "0"b;                /* don't echo cmds by default */
2017           iodd_static.slave.priv1 = "0"b;                   /* driver module defined privleges */
2018           iodd_static.slave.priv2 = "0"b;                   /* " */
2019           iodd_static.slave.priv3 = "0"b;                   /* " */
2020           iodd_static.slave_output = null_stream;           /* we are done with this now */
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 /* Internal procedure to wait for a control terminal to be dialed to the driver
2031    process.  We have failed badly if a non-zero value is returned in "ec".  */
2032 
2033 dcl  ec fixed bin (35);                                     /* error code */
2034 dcl  n_dev fixed bin;                                       /* dummy for number of dialed dev arg */
2035 dcl  1 dial_wait aligned,                                   /* wait list for dial wakeup */
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;                                /* we will wait on one channel */
2046           dial_wait.chan = iodd_static.ctl_dial_chan;       /* this one */
2047           dial_arg.version = dial_manager_arg_version_2;    /* use the constant */
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                                                             /* this is the tty we want */
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                                                             /* 1 is priv attach, 2 is dial */
2057 
2058                call dial_manager_$privileged_attach (addr (dial_arg), ec);
2059                                                             /* ask for it */
2060                if ec ^= 0 then
2061                     return;                                 /* if all is well we will wait */
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);           /* tell operator */
2065           end;
2066           else do;                                          /* this is the dial case */
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                                                             /* tell operator we are waiting */
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;                  /* someone sent a hangup?? */
2086                call iodd_hangup_$iodd_hangup_ (addr (event_info));
2087                go to wait;                                  /* in case it returns */
2088           end;
2089           if ^status_flags.dialed_up then
2090                go to wait;                                  /* we wait until a "dial" is received */
2091 
2092           iodd_static.ctl_device = dev_name;                /* save the device name here */
2093           iodd_static.ctl_dev_dim = dim_name;               /* and the dim */
2094 
2095           call hcs_$make_ptr (ref_ptr, "iodd_hangup_", "iodd_hangup_", temp_ptr, ec);
2096                                                             /* for ipc_ call chan */
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 /* This internal procedure checks to be sure the control terminal is in the
2114    dialed up state.  The driver can do I/O to the terminal only when it is in
2115    the dialed up state.  Otherwise com_err_ and ioa_ will signal "io_error"
2116    when trying to write on the control terminal.  That causes nasty things to
2117    happen.
2118 
2119    Due to insufficient data from the standard tty dim, we have to call the
2120    hardcore tty interface directly.  This should be a temporary measure
2121    until a new order call can be defined.   (JCW - Jan 1975)
2122 
2123    Note, due to the use of the hardcore tty interface, this procedure cannot
2124    be used for a control terminal attached through mrd_.
2125 */
2126 
2127 dcl  ec fixed bin (35);                                     /* error code to be returned */
2128 dcl  tw_index fixed bin;                                    /* device index of the tty channel */
2129 dcl  state fixed bin;                                       /* device state that we are after */
2130                                                             /* 1 = inactive  - this cannot happen (they say) */
2131                                                             /* 2 = waiting   - terminal is not there */
2132                                                             /* 5 = dialed up - on this state we can go */
2133 
2134           ec = 0;                                           /* start clean */
2135 
2136           if iodd_static.ctl_attach_name ^= idte.ctl_attach_name
2137                | iodd_static.ctl_attach_type ^= idte.ctl_attach_type then do; /* same device? */
2138                ec = 5;                                      /* the changing device code for caller */
2139                return;
2140           end;
2141 
2142           if iodd_static.ctl_dev_dim = "mrd_" then
2143                return;                                      /* this is never a problem */
2144 
2145           call hcs_$tty_index (iodd_static.ctl_device, tw_index, state, ec);
2146           if ec ^= 0 then
2147                return;                                      /* let caller handle all errors */
2148 
2149           if state ^= 5 then
2150                ec = 10;                                     /* if not dialed up, drop the terminal */
2151 
2152           return;
2153 
2154      end check_for_dialup;
2155 %page;
2156 
2157 return_string: proc (target) returns (char (*));
2158 
2159 /* little procedure to return a string from text_strings.chars given the
2160    first char index and total number of chars in the string */
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_;