1 /* ***********************************************************
   2    *                                                         *
   3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   4    *                                                         *
   5    * Copyright (c) 1972 by Massachusetts Institute of        *
   6    * Technology and Honeywell Information Systems, Inc.      *
   7    *                                                         *
   8    *********************************************************** */
   9 
  10 
  11 g115_: proc;
  12 
  13           return;                                           /* not a legal entry */
  14 
  15 
  16 /* Rewritten by D. Vinograd, 11/77, to make the G115 an iox based module for MR 6.1 */
  17 /* Modified by J. Nicholls 7/78 to change full_cc to rr_cnt to use reocrd counting instead of character counting */
  18 /* Modified by D. Vinograd, 10/78, for compatibility with MCS 3.3 and above */
  19 /* Modified by J. C. Whitmore, 11/78, to make all attach options consistent with the remote_xxx_ dims */
  20 /* Modified by J. C. Whitmore, 3/79, to correct size and initialization of delay variable */
  21 /* Modified by J. C. Whitmore, 8/79, grossley changed to accept binary output mode and multiple channels per process */
  22 
  23 
  24 
  25 
  26 /*        Parameters          */
  27 
  28 dcl  a_code fixed bin (35) parameter;
  29 dcl (a_new_mode, a_old_mode) char (*) parameter;
  30 dcl  a_nelem fixed bin (21) parameter;
  31 dcl  a_nelemt fixed bin (21) parameter;
  32 dcl  a_devx fixed bin parameter;
  33 dcl  a_ddp ptr parameter;
  34 dcl  a_adp ptr parameter;
  35 dcl  a_bufp ptr parameter;
  36 dcl  a_iocbp ptr parameter;
  37 dcl  a_option (*) char (*) var parameter;
  38 dcl  a_comerr_sw bit (1) parameter;
  39 dcl  a_open_mode fixed bin parameter;
  40 dcl  a_order char (*) parameter;
  41 dcl  a_infop ptr parameter;
  42 
  43 /*        Automatic           */
  44 
  45 dcl  attach_description char (256) var;
  46 dcl  bufp ptr;
  47 dcl  chn fixed bin (71);
  48 dcl  code fixed bin (35);
  49 dcl  comerr_sw bit (1) init ("0"b);
  50 dcl  comm char (32);
  51 dcl  delay fixed bin (35);
  52 dcl  device char (32);
  53 dcl  device_type fixed bin;
  54 dcl  dial_msg_chan char (32);                               /* Variables for dial manager */
  55 dcl  dial_msg_module char (32);
  56 dcl  dial_msg_ndialed fixed bin;
  57 dcl  dummy_arg char (32);
  58 dcl  i fixed bin;
  59 dcl  ignore fixed bin (35);
  60 dcl  infop ptr;
  61 dcl  iocbp ptr;
  62 dcl  level fixed bin;
  63 dcl  mask bit (36);
  64 dcl  max_length fixed bin;
  65 dcl  open_mode fixed bin;
  66 dcl  order char (32);
  67 dcl  state fixed bin;
  68 dcl  temp_ptr ptr;
  69 dcl  terminal_type char (32);
  70 dcl  tty char (32);
  71 
  72 /*        Internal Static     */
  73 
  74 dcl  attach_areap ptr int static init (null);               /* pointer to attach_area */
  75 dcl  first_device_data_p ptr int static init (null);        /* head of chain of device data structures */
  76 dcl  last_device_data_p ptr int static init (null);         /* tail of this chain */
  77 dcl  static_comerr_sw bit (1) int static init ("0"b);       /* to force error messages during debug */
  78 
  79 /*        Based variables     */
  80 
  81 dcl  attach_area area (262144) based (attach_areap);        /* space for device_data and attach data structures */
  82 dcl  info_string char (32) based (infop);                   /* for the control entry */
  83 
  84 /*        External Entries    */
  85 
  86 dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
  87 dcl  timer_manager_$sleep entry (fixed bin (71), bit (2));
  88 dcl  get_process_id_ entry () returns (bit (36));
  89 dcl  get_ttt_info_ entry (ptr, fixed bin (35));
  90 dcl  hcs_$tty_abort entry (fixed bin, fixed bin, fixed bin, fixed bin (35));
  91 dcl  ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35));
  92 dcl  ipc_$decl_ev_wait_chn entry (fixed bin (71), fixed bin (35));
  93 dcl  ipc_$decl_ev_call_chn entry (fixed bin (71), entry, ptr, fixed bin, fixed bin (35));
  94 dcl  ipc_$block entry (ptr, ptr, fixed bin (35));
  95 dcl  hcs_$tty_attach entry (char (*), fixed bin (71), fixed bin, fixed bin, fixed bin (35));
  96 dcl  ioa_ entry options (variable);
  97 dcl  iox_$control entry (ptr, char (*), ptr, fixed bin (35));
  98 dcl  hcs_$tty_detach entry (fixed bin, fixed bin, fixed bin, fixed bin (35));
  99 dcl  g115_io_$read_status entry (ptr, ptr, fixed bin (35));
 100 dcl  g115_io_$write entry (ptr, ptr, fixed bin (35));
 101 dcl  hcs_$tty_order entry (fixed bin, char (*), ptr, fixed bin, fixed bin (35));
 102 dcl  ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35));
 103 dcl  convert_ipc_code_ entry (fixed bin (35));
 104 dcl  dial_manager_$privileged_attach entry (ptr, fixed bin (35));
 105 dcl  dial_manager_$release_channel entry (ptr, fixed bin (35));
 106 dcl  dial_manager_$dial_out entry (ptr, fixed bin (35));
 107 dcl  convert_dial_message_ entry (bit (72) aligned, char (*), char (*), fixed bin, 1 like dial_msg_flags aligned,
 108      fixed bin (35));
 109 dcl  com_err_ entry options (variable);
 110 dcl  get_temp_segment_ entry (char (*), ptr, fixed bin (35));
 111 dcl  release_temp_segment_ entry (char (*), ptr, fixed bin (35));
 112 dcl  continue_to_signal_ entry (fixed bin (35));
 113 dcl  iox_$err_no_operation entry;
 114 dcl  hcs_$set_ips_mask entry (bit (36), bit (36));
 115 dcl  iox_$propagate entry (ptr);
 116 dcl  hcs_$reset_ips_mask entry (bit (36), bit (36));
 117 dcl  g115_protocol_$write entry (ptr, ptr, ptr, fixed bin (21), fixed bin (35));
 118 dcl  g115_protocol_$read entry (ptr, ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
 119 
 120 /*        Builtins and Conditions       */
 121 
 122 dcl (null, addr, hbound, length, rtrim, ltrim, unspec, empty) builtin;
 123 
 124 dcl  cleanup condition;
 125 dcl  any_other condition;
 126 
 127 /*        Error Table Entries           */
 128 
 129 dcl  error_table_$bad_conversion fixed bin (35) ext;
 130 dcl  error_table_$noarg fixed bin (35) ext;
 131 dcl  error_table_$line_status_pending ext fixed bin (35);
 132 dcl  error_table_$action_not_performed ext fixed bin (35);
 133 dcl  error_table_$ionmat ext fixed bin (35);
 134 dcl  error_table_$wrong_no_of_args ext fixed bin (35);
 135 dcl  error_table_$badopt ext fixed bin (35);
 136 dcl  error_table_$bad_mode ext fixed bin (35);
 137 dcl  error_table_$multiple_io_attachment ext fixed bin (35);
 138 dcl  error_table_$invalid_read ext fixed bin (35);
 139 dcl  error_table_$invalid_write ext fixed bin (35);
 140 dcl  error_table_$not_attached fixed bin (35) ext;
 141 dcl  error_table_$not_detached fixed bin (35) ext;
 142 dcl  error_table_$not_open fixed bin (35) ext;
 143 dcl  error_table_$not_closed fixed bin (35) ext;
 144 dcl  error_table_$no_operation fixed bin (35) ext;
 145 dcl  error_table_$io_no_permission fixed bin (35) ext;
 146 dcl  error_table_$resource_attached fixed bin (35) ext;
 147 
 148 /*        Constants            */
 149 
 150 dcl  devices (4) char (32) static options (constant) init ("reader", "printer", "teleprinter", "punch");
 151 
 152 /* Line Control and Status Values */
 153 
 154 dcl  set_g115_remote_mode fixed bin int static init (3) options (constant);
 155 dcl  test_for_fnp_output fixed bin int static init (5) options (constant);
 156 dcl  reset_g115_remote_mode fixed bin int static static init (6) options (constant);
 157 dcl  fnp_output_pending fixed bin int static init (8) options (constant);
 158 ^L
 159 /*        Structures          */
 160 
 161 dcl 1 line_status aligned,                                  /* for the Ring 0 line_status order */
 162    (2 value,
 163     2 mbz1,
 164     2 mbz2,
 165     2 mbz3) fixed bin unal;
 166 
 167 dcl 1 hangup_proc aligned based (infop),                    /* Data for hangup_proc order */
 168     2 entry_var entry variable,
 169     2 data_ptr ptr,
 170     2 prior fixed bin;
 171 
 172 dcl 1 info_structure aligned based (infop),                 /* for the read_status control order */
 173     2 ev_chan fixed bin (71),
 174     2 input_available bit (1);
 175 
 176 dcl 1 modes aligned,                                        /* for the Ring 0 tty modes order */
 177     2 len fixed bin,
 178     2 str char (256);
 179 
 180 dcl 1 event_info aligned,                                   /* data returned by ipc_$block */
 181     2 channel_id fixed bin (71),                            /* event channel which signalled this wakeup */
 182     2 message fixed bin (71),                               /* 72 bit event message from sender */
 183     2 sender bit (36),                                      /* process id of sending process */
 184     2 origin,
 185       3 dev_signal bit (18) unal,
 186       3 ring bit (18) unal,
 187     2 channel_index fixed bin (17);                         /* index of channel_id in the wait list we blocked on */
 188 
 189 dcl 1 dial_msg_flags aligned,                               /* data returned from convert_dial_message_ */
 190     2 dialed_up bit (1) unal,
 191     2 hung_up bit (1) unal,
 192     2 control bit (1) unal,
 193     2 pad bit (33) unal;
 194 
 195 dcl 1 dma aligned,                                          /* data for dial_manager_ to attach, dial_out or allow dials */
 196     2 version fixed bin,                                    /* this is the version 1 structure */
 197     2 dial_qual char (22),                                  /* phone number for dial_out, qualifier for allow dials */
 198     2 dial_mgr_ev_chan fixed bin (71),                      /* IPC chan for Ans. Serv. to notify us on */
 199     2 device_name char (32);                                /* name of the tty channel we want to have assigned */
 200 
 201 dcl 1 dial_wait_list aligned,                               /* IPC wait list for blocking after calling dial_manager_ */
 202     2 nchan fixed bin init (1),                             /* number of channels in this list: always 1 */
 203     2 dummy_word fixed bin,                                 /* so the next will be on even word */
 204     2 dial_mgr_ev_chan fixed bin (71);
 205 
 206 ^L
 207 %include iocb;
 208 ^L
 209 %include iox_modes;
 210 ^L
 211 %include io_call_info;
 212 ^L
 213 %include g115_attach_data;
 214 ^L
 215 %include g115_device_data;
 216 ^L
 217 %include g115_message;
 218 ^L
 219 %include G115;
 220 ^L
 221 %include remote_ttt_info;
 222 ^L
 223 g115_attach: entry (a_iocbp, a_option, a_comerr_sw, a_code);
 224 
 225           comerr_sw = static_comerr_sw | a_comerr_sw;       /* print error messages if either switch is on */
 226 
 227           adp, device_data_p = null;                        /* no attach data or device data structures defined yet */
 228           terminal_type, tty, comm, device = "";
 229           delay, code, a_code = 0;
 230           iocbp = a_iocbp;                                  /* copy the input iocb pointer */
 231 
 232           if iocbp -> iocb.attach_descrip_ptr ^= null then do; /* already used? */
 233                code = error_table_$not_detached;
 234                call abort_attach ("Already attached", "");
 235           end;
 236 
 237           if hbound (a_option, 1) < 1 then do;
 238                code = error_table_$wrong_no_of_args;
 239                call abort_attach ("No attach description", "");
 240           end;
 241 
 242           if attach_areap = null then do;                   /* make an area for attach data structures */
 243                call get_temp_segment_ ("g115_attach", attach_areap, code);
 244                if code ^= 0 then call abort_attach ("Unable to create temp segment", "");
 245                attach_area = empty;                         /* initialize the area */
 246           end;
 247 
 248           on cleanup call clean_up_handler;
 249 
 250           dma.dial_qual = "";                               /* prepare for call to dial manager */
 251           attach_description = "g115_";                     /* start building att desc which we will tell iox_ about */
 252           do i = 1 to hbound (a_option, 1);
 253                attach_description = attach_description || " " || a_option (i);
 254                if a_option (i) = "-device" then device = get_option_arg (i);
 255                else if a_option (i) = "-tty" then tty = get_option_arg (i);
 256                else if a_option (i) = "-comm" then comm = get_option_arg (i);
 257                else if a_option (i) = "-auto_call" then dma.dial_qual = get_option_arg (i);
 258                else if a_option (i) = "-ascii" then;        /* ignore ascii/ebcdic specification */
 259                else if a_option (i) = "-physical_line_length" | a_option (i) = "-pll" then dummy_arg = get_option_arg (i);
 260                                                             /* ignore -pll N but no error */
 261                else if a_option (i) = "-terminal_type" | a_option (i) = "-ttp" then terminal_type = get_option_arg (i);
 262                else if a_option (i) = "-delay" then do;
 263                     delay = cv_dec_check_ ((get_option_arg (i)), code);
 264                     if code ^= 0 | delay < 0 then do;
 265                          code = error_table_$bad_conversion;
 266                          call abort_attach ("Invalid delay value", (a_option (i)));
 267                     end;
 268                end;
 269                else do;
 270                     code = error_table_$badopt;
 271                     call abort_attach ("Invalid attach description option", (a_option (i)));
 272                end;
 273           end;
 274 
 275           if comm ^= "rci" then do;
 276                code = error_table_$badopt;                  /* indicate bad, but not which one???? */
 277                call abort_attach ("Invalid or missing -comm option", (comm));
 278           end;
 279 
 280           if tty = "" then do;
 281                code = error_table_$badopt;
 282                call abort_attach ("No ""-tty"" option given", "");
 283           end;
 284 
 285           do i = 1 to hbound (devices, 1) while (device ^= devices (i));
 286           end;
 287           if i > hbound (devices, 1) then do;
 288                code = error_table_$badopt;
 289                call abort_attach ("Invalid device specified", (device));
 290           end;
 291           else device_type = i;
 292 
 293           do temp_ptr = first_device_data_p repeat (temp_ptr -> g115_device_data.fwd_ptr)
 294                     while (temp_ptr ^= null & device_data_p = null);
 295                if temp_ptr -> g115_device_data.tty_name = tty then /* channel already defined ? */
 296                     device_data_p = temp_ptr;               /* then grab the ptr and exit loop */
 297           end;
 298 
 299           if device_data_p = null then do;                  /* first init for this device */
 300                call ipc_$create_ev_chn (dial_wait_list.dial_mgr_ev_chan, code);
 301                if code ^= 0 then call abort_attach ("Unable to create dial event channel", "");
 302 
 303                dma.version = 1;                             /* Setup dial manager request structure */
 304                dma.dial_mgr_ev_chan = dial_wait_list.dial_mgr_ev_chan;
 305                dma.device_name = tty;                       /* say which tty channel we want */
 306 
 307                if dma.dial_qual = ""                        /* normal attach or auto_call (dial_out) */
 308                then call dial_manager_$privileged_attach (addr (dma), code);
 309                else call dial_manager_$dial_out (addr (dma), code);
 310                if code = error_table_$action_not_performed | code = error_table_$resource_attached
 311                     then go to maybe_mine_already;
 312                if code ^= 0 then call abort_attach ("From dial_manager_ attaching ^a", (tty));
 313 
 314 dial_wait:     call ipc_$block (addr (dial_wait_list), addr (event_info), code);
 315                                                             /* wait for Answering Service to give us the device */
 316                if code ^= 0 then do;
 317                     call convert_ipc_code_ (code);
 318                     call abort_attach ("From ipc_$block waiting for ^a attachment.", (tty));
 319                end;
 320 
 321 /*        Call convert_dial_message_ so it can update it's table of attached channels */
 322 
 323                call convert_dial_message_ (unspec (event_info.message), dial_msg_chan, dial_msg_module,
 324                     dial_msg_ndialed, dial_msg_flags, code);
 325                if code ^= 0 then call abort_attach ("From dial_manager_ attaching ^a", (tty));
 326 
 327                if ^dial_msg_flags.dialed_up then do;        /* OOPS - we got a wakeup for some other event - PUNT */
 328                     call com_err_ (0, "g115_", "Dial message received: ^[HANGUP^;CONTROL^] on channel: ^a",
 329                          dial_msg_flags.hung_up, dial_msg_chan);
 330                     go to dial_wait;                        /* wait for our channel */
 331                end;
 332 
 333 maybe_mine_already:
 334 
 335                call create_device_data (device_data_p);     /* allocate structure and link it */
 336 
 337                call init_g115_device_data (device_data_p, code); /* then initialize it for this tty device */
 338 
 339                if code ^= 0 then call abort_attach ("Unable to initialize device data", "");
 340 
 341                g115_device_data.tty_name = tty;             /* save name for future attaches */
 342                g115_device_data.dial_mgr_ev_chan = dial_wait_list.dial_mgr_ev_chan;
 343                g115_device_data.delay = delay;              /* use the value from attach options */
 344 
 345 /*        set up IPC wait list to use for input/output blocking:  two channels, tty and timeout */
 346 
 347                call ipc_$create_ev_chn (g115_device_data.tty_ev_channel, code); /* create ring 0 tty event channel */
 348                if code ^= 0 then call abort_attach ("Unable to create tty event channel", "");;
 349 
 350                call ipc_$create_ev_chn (g115_device_data.timeout_ev_channel, code);
 351                if code ^= 0 then call abort_attach ("Unable to create timeout event channel", "");;
 352 
 353                g115_device_data.nchan = 2;
 354 
 355                call hcs_$tty_attach (tty, g115_device_data.tty_ev_channel, g115_device_data.devx, state, code);
 356                if state ^= 5 then code = error_table_$io_no_permission;
 357                if code ^= 0 then call abort_attach ("Unable to attach communications channel.", "");
 358 
 359                modes.str = "rawo,rawi,^hndlquit";
 360                modes.len = length (modes.str);              /* set the max size for return info */
 361 
 362                call hcs_$tty_order (g115_device_data.devx, "modes", addr (modes), state, code);
 363                if state ^= 5 then code = error_table_$io_no_permission;
 364                if code ^= 0 then call abort_attach ("Unable to set initial modes", "");
 365 
 366                max_length = G115.max_msg_len + 10;          /* tell ring 0 the largest msg we will see */
 367 
 368                call hcs_$tty_order (g115_device_data.devx, "set_input_message_size", addr (max_length), state, code);
 369                if state ^= 5 then code = error_table_$io_no_permission;
 370                if code ^= 0 then call abort_attach ("Unable to set input message size", "");
 371           end;
 372 
 373           allocate g115_attach_data in (attach_area) set (adp); /* get a place for the attach data structure */
 374 
 375           unspec (g115_attach_data) = "0"b;                 /* initialize the attach data structure */
 376           g115_attach_data.device_type = device_type;       /* record the device type code (fixed bin) */
 377           g115_attach_data.device = device;                 /* set device name in here (char) */
 378           g115_attach_data.attach_description = attach_description;
 379           g115_attach_data.device_ptr = device_data_p;      /* point it back to the device block */
 380 
 381 /*         define the media code for this attachment */
 382 
 383           if device_type = teleprinter then g115_attach_data.media_code = G115.teleprinter_mc;
 384           else if device_type = printer then g115_attach_data.media_code = G115.printer_mc;
 385           else if device_type = punch then g115_attach_data.media_code = G115.punch_bcd_mc; /* default data type */
 386           else g115_attach_data.media_code = "";            /* others are input devices */
 387 
 388 /*        set default ttt data  */
 389 
 390           g115_attach_data.terminal_type = terminal_type;
 391           g115_attach_data.kill_char = "@";
 392           g115_attach_data.erase_char = "#";
 393           g115_attach_data.ttt_bits = "1"b;
 394           g115_attach_data.ttt_ptrs = null;
 395 
 396           if g115_attach_data.device_type = reader then g115_attach_data.canonicalize_input = "0"b;
 397 
 398           if g115_attach_data.terminal_type ^= "" then do;
 399                call get_ttt_info_ (addr (g115_attach_data.ttt_info), code);
 400                if code ^= 0 then call abort_attach ("Unknown terminal type specified", "");
 401           end;
 402 
 403           mask = "0"b;
 404 
 405           on any_other call any_other_handler;
 406 
 407           call hcs_$set_ips_mask ("0"b, mask);
 408 
 409           iocbp -> iocb.attach_descrip_ptr = addr (g115_attach_data.attach_description);
 410           iocbp -> iocb.attach_data_ptr = adp;
 411           iocbp -> iocb.open = g115_open;
 412           iocbp -> iocb.detach_iocb = g115_detach;
 413           iocbp -> iocb.control = iox_$err_no_operation;
 414           iocbp -> iocb.position = iox_$err_no_operation;
 415           iocbp -> iocb.modes = iox_$err_no_operation;
 416           iocbp -> iocb.put_chars = iox_$err_no_operation;
 417           iocbp -> iocb.get_chars = iox_$err_no_operation;
 418           iocbp -> iocb.get_line = iox_$err_no_operation;
 419           iocbp -> iocb.read_record = iox_$err_no_operation;
 420           iocbp -> iocb.write_record = iox_$err_no_operation;
 421 
 422           g115_device_data.attach_count = g115_device_data.attach_count + 1; /* count up attaches */
 423 
 424           call iox_$propagate (iocbp);
 425 
 426           revert cleanup;
 427 
 428           call hcs_$reset_ips_mask (mask, mask);
 429 
 430           revert any_other;
 431 
 432           code = 0;
 433 
 434 attach_return:
 435 
 436           a_code = code;                                    /* pass back any error codes */
 437 
 438           return;
 439 ^L
 440 g115_open: entry (a_iocbp, a_open_mode, a_comerr_sw, a_code);
 441 
 442           a_code, code = 0;                                 /* be sure to initialize */
 443           iocbp = a_iocbp -> iocb.actual_iocb_ptr;
 444           adp = iocbp -> iocb.attach_data_ptr;
 445           device_data_p = g115_attach_data.device_ptr;
 446 
 447           if adp = null | device_data_p = null then do;
 448                a_code = error_table_$not_attached;
 449                return;
 450           end;
 451 
 452           if g115_device_data.hangup_signalled then do;     /* Illegal if we sent a hangup to the device */
 453                a_code = error_table_$io_no_permission;
 454                return;
 455           end;
 456 
 457           open_mode = a_open_mode;
 458 
 459           if ^((open_mode = Stream_input) | (open_mode = Stream_output) | (open_mode = Stream_input_output)) then do;
 460                a_code = error_table_$bad_mode;
 461                return;
 462           end;
 463 
 464           g115_attach_data.open_description = rtrim (iox_modes (open_mode));
 465 
 466           mask = "0"b;
 467 
 468           on any_other call any_other_handler;
 469 
 470           call hcs_$set_ips_mask ("0"b, mask);
 471 
 472           if ((open_mode = Stream_input) | (open_mode = Stream_input_output)) then do;
 473                iocbp -> iocb.get_chars = g115_get_chars;
 474                iocbp -> iocb.get_line = g115_get_chars;
 475           end;
 476           if ((open_mode = Stream_output) | (open_mode = Stream_input_output)) then do;
 477                iocbp -> iocb.put_chars = g115_put_chars;
 478           end;
 479           iocbp -> iocb.read_record = iox_$err_no_operation;
 480           iocbp -> iocb.write_record = iox_$err_no_operation;
 481           iocbp -> iocb.control = g115_control;
 482           iocbp -> iocb.modes = g115_modes;
 483           iocbp -> iocb.close = g115_close;
 484           iocbp -> iocb.open_descrip_ptr = addr (g115_attach_data.open_description);
 485 
 486           call iox_$propagate (iocbp);
 487 
 488           call hcs_$reset_ips_mask (mask, mask);
 489 
 490           revert any_other;
 491 
 492           return;
 493 ^L
 494 g115_close: entry (a_iocbp, a_code);
 495 
 496           a_code, code = 0;                                 /* be sure to initialize */
 497           iocbp = a_iocbp -> iocb.actual_iocb_ptr;
 498           adp = iocbp -> iocb.attach_data_ptr;
 499           device_data_p = g115_attach_data.device_ptr;
 500 
 501           if adp = null | device_data_p = null then do;
 502                a_code = error_table_$not_attached;
 503                return;
 504           end;
 505 
 506           if iocbp -> iocb.open_descrip_ptr = null then do;
 507                a_code = error_table_$not_open;
 508                return;
 509           end;
 510 
 511           mask = "0"b;
 512 
 513           on any_other call any_other_handler;
 514 
 515           call hcs_$set_ips_mask ("0"b, mask);
 516 
 517           iocbp -> iocb.open_descrip_ptr = null;
 518           iocbp -> iocb.open = g115_open;
 519           iocbp -> iocb.detach_iocb = g115_detach;
 520           iocbp -> iocb.control = iox_$err_no_operation;
 521           iocbp -> iocb.position = iox_$err_no_operation;
 522           iocbp -> iocb.modes = iox_$err_no_operation;
 523           iocbp -> iocb.put_chars = iox_$err_no_operation;
 524           iocbp -> iocb.get_chars = iox_$err_no_operation;
 525           iocbp -> iocb.get_line = iox_$err_no_operation;
 526           iocbp -> iocb.read_record = iox_$err_no_operation;
 527           iocbp -> iocb.write_record = iox_$err_no_operation;
 528 
 529           call iox_$propagate (iocbp);
 530 
 531           call hcs_$reset_ips_mask (mask, mask);
 532 
 533           return;
 534 ^L
 535 g115_get_chars: entry (a_iocbp, a_bufp, a_nelem, a_nelemt, a_code);
 536 
 537 /* This is an entry to get the next record from an input message block.
 538    The data is written into a_bufp -> buffer without any G115 media codes or record separators.
 539    The calling procedure must add on a trailing NL char if desired.
 540 */
 541 
 542           a_code, code = 0;                                 /* be sure to initialize */
 543           iocbp = a_iocbp -> iocb.actual_iocb_ptr;
 544           adp = iocbp -> iocb.attach_data_ptr;
 545           device_data_p = g115_attach_data.device_ptr;
 546 
 547           if adp = null | device_data_p = null then do;
 548                a_code = error_table_$not_attached;
 549                return;
 550           end;
 551 
 552           if g115_device_data.hangup_signalled then do;     /* Illegal if we sent a hangup to the device */
 553                a_code = error_table_$io_no_permission;
 554                return;
 555           end;
 556 
 557           if g115_attach_data.device_type = printer |       /* not a readable device */
 558           g115_attach_data.device_type = punch then do;
 559                a_code = error_table_$invalid_read;
 560                return;
 561           end;
 562 
 563           call g115_protocol_$read (adp, device_data_p, a_bufp, a_nelem, a_nelemt, a_code); /* pass on read */
 564 
 565           return;
 566 ^L
 567 g115_put_chars: entry (a_iocbp, a_bufp, a_nelem, a_code);
 568 
 569 /* This is an entry to write a record which may be a partial or complete G115 message block.
 570    The record format is a string of ASCII characters without any media code or record separator
 571    characters.  If the attachment is for the printer device, the last character of the input
 572    record is a slew control character.
 573 */
 574 
 575           a_code, code = 0;                                 /* be sure to initialize */
 576           iocbp = a_iocbp -> iocb.actual_iocb_ptr;
 577           adp = iocbp -> iocb.attach_data_ptr;
 578           device_data_p = g115_attach_data.device_ptr;
 579 
 580           if adp = null | device_data_p = null then do;
 581                a_code = error_table_$not_attached;
 582                return;
 583           end;
 584 
 585           if g115_device_data.hangup_signalled then do;     /* Illegal if we sent a hangup to the device */
 586                a_code = error_table_$io_no_permission;
 587                return;
 588           end;
 589 
 590           if g115_attach_data.device_type = reader then do;
 591                a_code = error_table_$invalid_write;
 592                return;
 593           end;
 594 
 595 
 596           call g115_protocol_$write (adp, device_data_p, a_bufp, a_nelem, a_code);
 597 
 598           return;
 599 ^L
 600 g115_modes: entry (a_iocbp, a_new_mode, a_old_mode, a_code);
 601 
 602           a_code, code = 0;                                 /* be sure to initialize */
 603           iocbp = a_iocbp -> iocb.actual_iocb_ptr;
 604           adp = iocbp -> iocb.attach_data_ptr;
 605           device_data_p = g115_attach_data.device_ptr;
 606 
 607           if adp = null | device_data_p = null then do;
 608                a_code = error_table_$not_attached;
 609                return;
 610           end;
 611 
 612           if g115_device_data.hangup_signalled then do;     /* Illegal if we sent a hangup to the device */
 613                a_code = error_table_$io_no_permission;
 614                return;
 615           end;
 616 
 617           a_old_mode = "";                                  /* initialize return string */
 618 
 619           if a_new_mode = "non_edited" then g115_attach_data.edited = "0"b;
 620           else if a_new_mode = "default" then g115_attach_data.edited = "1"b;
 621           else do;
 622                modes.str = a_new_mode;
 623                modes.len = length (modes.str);              /* set the max size for return info */
 624 M_1:
 625                call hcs_$tty_order (g115_device_data.devx, "modes", addr (modes), state, code);
 626                if state ^= 5 then code = error_table_$io_no_permission;
 627                if line_status_pending (code) then go to M_1;
 628                a_old_mode = modes.str;                      /* copy back the old value */
 629           end;
 630 
 631           a_code = code;
 632 
 633           return;
 634 ^L
 635 g115_control: entry (a_iocbp, a_order, a_infop, a_code);
 636 
 637           a_code, code = 0;                                 /* be sure to initialize */
 638           iocbp = a_iocbp -> iocb.actual_iocb_ptr;
 639           adp = iocbp -> iocb.attach_data_ptr;
 640           device_data_p = g115_attach_data.device_ptr;
 641 
 642           if adp = null | device_data_p = null then do;
 643                a_code = error_table_$not_attached;
 644                return;
 645           end;
 646 
 647           if g115_device_data.hangup_signalled then do;     /* Illegal if we sent a hangup to the device */
 648                a_code = error_table_$io_no_permission;
 649                return;
 650           end;
 651 
 652           order = a_order;                                  /* get the order name */
 653           infop = a_infop;                                  /* and the data pointer */
 654 
 655           if order = "io_call" then do;                     /* check this first so we can redefine the order */
 656 
 657                if infop = null then do;
 658 bad_call:           a_code = error_table_$no_operation;     /* say we didn't do it */
 659                     return;
 660                end;
 661 
 662                order = infop -> io_call_info.order_name;    /* get the new order name */
 663                infop = null;                                /* make this cheap, only a few orders accepted */
 664           end;
 665 
 666           if order = "hangup" then do;
 667                dma.version = 1;                             /* make structure for call to dial_manager_ */
 668                dma.dial_mgr_ev_chan = g115_device_data.dial_mgr_ev_chan;
 669                dma.device_name = g115_device_data.tty_name;
 670                dma.dial_qual = "";
 671 
 672                call ipc_$decl_ev_wait_chn (g115_device_data.dial_mgr_ev_chan, code);
 673                                                             /* in case a hangup_proc order was given */
 674                call dial_manager_$release_channel (addr (dma), code);
 675                if code ^= 0 then
 676                     call hcs_$tty_order (g115_device_data.devx, order, infop, state, (0)); /* pass it on */
 677 
 678                g115_device_data.hangup_signalled = "1"b;    /* this will end all but close and detach */
 679                code = 0;                                    /* say it was good, since they MUST close and detach */
 680           end;
 681           else if order = "select_device" then do;          /* order to set device type for next write */
 682                if infop = null then go to bad_call;         /* this order requires this pointer */
 683                if info_string = "teleprinter" then do;
 684                     g115_attach_data.media_code = G115.teleprinter_mc;
 685                end;
 686                else if info_string = "punch" then do;
 687 
 688 /*                  g115_attach_data.media_code = G115.punch_bcd_mc; */
 689                end;
 690                else if info_string = "printer" then do;
 691                     g115_attach_data.media_code = G115.printer_mc;
 692                end;
 693                else if info_string = "reader" then do;
 694                     g115_attach_data.media_code = G115.bcd_input_mc; /* character only */
 695                end;
 696                else do;                                     /* not a legal value, tell the caller */
 697                     code = error_table_$action_not_performed;
 698                end;
 699           end;
 700           else if order = "runout" then do;
 701                msgp = g115_device_data.outp (g115_device_data.level + 1); /* buffer we would write into */
 702                if msgp = null then return;                  /* in case it was not allocated yet */
 703                if g115_message.text_char_count = 0 then return; /* make it fast if nothing to runout */
 704 
 705                if ^g115_message.being_changed then          /* only write consistent messages */
 706                     call g115_io_$write (device_data_p, msgp, code);
 707 
 708                g115_message.text_char_count = 0;            /* mark this as written */
 709                g115_message.fmt_code = ""b;
 710                g115_message.being_changed = "0"b;
 711 
 712                call timer_manager_$sleep ((g115_device_data.delay), "10"b);
 713           end;
 714           else if order = "hangup_proc" then do;
 715                if infop = null then go to bad_call;         /* this order requires this pointer */
 716                call ipc_$decl_ev_call_chn (g115_device_data.dial_mgr_ev_chan, hangup_proc.entry_var, hangup_proc.data_ptr,
 717                     hangup_proc.prior, code);
 718                if code ^= 0 then call convert_ipc_code_ (code);
 719           end;
 720           else if order = "reset" then do;
 721                if g115_attach_data.device_type = punch then
 722                     g115_attach_data.media_code = G115.punch_bcd_mc;
 723           end;
 724           else if order = "binary_punch" then do;
 725                if g115_attach_data.device_type ^= punch then go to bad_call;
 726                g115_attach_data.media_code = G115.punch_bin_mc; /* all future records will be binary coded */
 727           end;
 728           else if order = "read_status" then do;            /* order to get read status */
 729                if infop = null then go to bad_call;         /* this order requires this pointer */
 730                info_structure.ev_chan = g115_device_data.tty_ev_channel; /* return ev chn on which read will return */
 731                info_structure.input_available = "0"b;       /* none yet */
 732                msgp = g115_device_data.first_bp;            /* set auto reference ptr */
 733 follow_chain:  if g115_message.rec_count > 0 then do;       /* input is ready */
 734                     info_structure.input_available = "1"b;  /* go to it daemons */
 735                     return;
 736                end;
 737                if g115_message.next_bp ^= null then do;     /* if a chain exists, check it out */
 738                     msgp = g115_message.next_bp;
 739                     go to follow_chain;
 740                end;
 741 
 742                call g115_io_$read_status (device_data_p, infop, code); /* check for any ring-0 data */
 743           end;
 744           else if order = "end_write_mode" then do;
 745                call iox_$control (iocbp, "runout", null, code);
 746                if code ^= 0 then return;
 747                line_status.value = fnp_output_pending;
 748                do while (line_status.value = fnp_output_pending);
 749 C_1:                line_status.value = test_for_fnp_output;
 750                     call hcs_$tty_order (g115_device_data.devx, "line_control", addr (line_status), state, code);
 751                     if state ^= 5 then code = error_table_$io_no_permission;
 752                     if line_status_pending (code) then go to C_1;
 753                     call timer_manager_$sleep (1, "11"b);   /* give fnp a chance to digest line_control */
 754                     call hcs_$tty_order (g115_device_data.devx, "line_status", addr (line_status), state, code);
 755                     if state ^= 5 then code = error_table_$io_no_permission;
 756                     if line_status_pending (code) then go to C_1;
 757                     if line_status.value = fnp_output_pending then
 758                          call timer_manager_$sleep (10, "11"b);
 759                end;
 760           end;
 761           else if order = "resetread" then do;
 762                msgp = g115_device_data.first_bp;
 763                bufp = g115_message.next_bp;                 /* find next input buffer in chain */
 764                unspec (g115_message) = "0"b;                /* clear out everything */
 765                g115_message.next_bp = null;                 /* mark as chain end */
 766                g115_device_data.last_bp = msgp;             /*    "    "        */
 767                do while (bufp ^= null);
 768                     msgp = bufp;
 769                     bufp = g115_message.next_bp;            /* walk the chain */
 770                     free msgp -> g115_message in (buffer_area); /* Poof, it's gone */
 771                end;
 772 C_2:           call hcs_$tty_abort (g115_device_data.devx, 1, state, code);
 773                if state ^= 5 then code = error_table_$io_no_permission;
 774                if line_status_pending (code) then go to C_2;
 775           end;
 776           else if order = "resetwrite" then do;
 777                msgp = g115_device_data.outp (g115_device_data.level);
 778                g115_message.text_char_count = 0;
 779                g115_message.fmt_code = "0"b;
 780 C_3:           call hcs_$tty_abort (g115_device_data.devx, 2, state, code);
 781                if state ^= 5 then code = error_table_$io_no_permission;
 782                if line_status_pending (code) then go to C_3;
 783           end;
 784           else if order = "set_remote_mode" then do;        /* order to tell control tables to act as L6 */
 785 C_4:           line_status.value = set_g115_remote_mode;    /* set the proper value */
 786                call hcs_$tty_order (g115_device_data.devx, "line_control", addr (line_status), state, code);
 787                if state ^= 5 then code = error_table_$io_no_permission;
 788                if line_status_pending (code) then go to C_4;
 789           end;
 790           else if order = "reset_remote_mode" then do;      /* order to tell control tables to act as host */
 791 C_5:           line_status.value = reset_g115_remote_mode;
 792                call hcs_$tty_order (g115_device_data.devx, "line_control", addr (line_status), state, code);
 793                if state ^= 5 then code = error_table_$io_no_permission;
 794                if line_status_pending (code) then go to C_5;
 795           end;
 796           else do;
 797 C_6:           call hcs_$tty_order (g115_device_data.devx, order, infop, state, code); /* pass it on */
 798                if state ^= 5 then code = error_table_$io_no_permission;
 799                if line_status_pending (code) then go to C_6;
 800           end;
 801 
 802           a_code = code;
 803 
 804           return;
 805 ^L
 806 g115_detach: entry (a_iocbp, a_code);                       /* entry to detach device */
 807 
 808           a_code, code = 0;                                 /* be sure to initialize */
 809           iocbp = a_iocbp -> iocb.actual_iocb_ptr;
 810           adp = iocbp -> iocb.attach_data_ptr;
 811           device_data_p = g115_attach_data.device_ptr;
 812 
 813           if adp = null | device_data_p = null then do;
 814                a_code = error_table_$not_attached;
 815                return;
 816           end;
 817 
 818           if iocbp -> iocb.open_descrip_ptr ^= null then do;
 819                a_code = error_table_$not_closed;
 820                return;
 821           end;
 822 
 823           mask = "0"b;
 824 
 825           on any_other call any_other_handler;
 826 
 827           call hcs_$set_ips_mask ("0"b, mask);
 828 
 829           iocbp -> iocb.attach_descrip_ptr = null;
 830 
 831           call iox_$propagate (iocbp);
 832 
 833           g115_device_data.attach_count = g115_device_data.attach_count - 1; /* count down for detach */
 834 
 835           call cleanup_and_detach (a_code);
 836 
 837           call hcs_$reset_ips_mask (mask, mask);
 838 
 839           return;
 840 ^L
 841 as_init:  entry (a_devx, a_ddp, a_adp, a_code);
 842 
 843           if attach_areap = null then do;
 844                call get_temp_segment_ ("g115_attach", attach_areap, a_code);
 845                if a_code ^= 0 then return;
 846                attach_area = empty;
 847           end;
 848 
 849           call create_device_data (device_data_p);          /* make a new block for AS */
 850 
 851           call init_g115_device_data (device_data_p, a_code);
 852           if a_code ^= 0 then return;
 853 
 854           g115_device_data.tty_name = "as_tty";             /* make up a dummy name for now */
 855           g115_device_data.devx = a_devx;
 856           g115_device_data.dial_mgr_ev_chan = 0;
 857           g115_device_data.tty_ev_channel = 0;
 858           g115_device_data.timeout_ev_channel = 0;
 859           g115_device_data.as_priv_no_block = "1"b;         /* this is the answering service! */
 860 
 861           allocate g115_attach_data in (attach_area) set (adp);
 862 
 863           g115_attach_data.media_code = G115.teleprinter_mc; /* answering service is only a teleprinter */
 864           g115_attach_data.device = "teleprinter";
 865           g115_attach_data.device_type = teleprinter;
 866           g115_attach_data.attach_description = "AS_direct_attach";
 867           g115_attach_data.open_description = "stream_input_output";
 868           g115_attach_data.device_ptr = device_data_p;
 869           g115_attach_data.terminal_type = "";
 870           g115_attach_data.kill_char = "@";
 871           g115_attach_data.erase_char = "#";
 872           g115_attach_data.ttt_bits = "1"b;
 873           g115_attach_data.ttt_ptrs = null;
 874 
 875           a_ddp = device_data_p;
 876           a_adp = adp;
 877 
 878           return;
 879 
 880 
 881 
 882 as_detach: entry (a_devx, a_ddp, a_adp, a_code);
 883 
 884           adp = a_adp;
 885           device_data_p = a_ddp;
 886 
 887           free adp -> g115_attach_data in (attach_area);
 888 
 889           call release_temp_segment_ ("g115_io_buffer", g115_device_data.buffer_areap, a_code);
 890 
 891           call delete_device_data (device_data_p);          /* remove from the chain */
 892 
 893           return;
 894 ^L
 895 flip_comerr_sw: entry;
 896 
 897           static_comerr_sw = ^static_comerr_sw;             /* change the bit */
 898 
 899           call ioa_ ("g115_: Static com_err_ switch is ^[on^;off^]", static_comerr_sw);
 900 
 901           return;
 902 
 903 
 904 cleanup_and_detach: proc (ec);
 905 
 906 dcl  ec fixed bin (35);
 907 dcl  ignore fixed bin (35);
 908 
 909                if adp ^= null then
 910                     free adp -> g115_attach_data in (attach_area);
 911 
 912                if device_data_p ^= null then                /* check on deleting the device data */
 913                     if g115_device_data.attach_count < 1 then do; /* no more streams attached, free block */
 914                          if ^g115_device_data.hangup_signalled then do; /* hang up the line if caller didn't */
 915                               dma.version = 1;              /* make structure for call to dial_manager_ */
 916                               dma.dial_mgr_ev_chan = g115_device_data.dial_mgr_ev_chan;
 917                               dma.device_name = g115_device_data.tty_name;
 918                               dma.dial_qual = "";
 919 
 920                               call ipc_$decl_ev_wait_chn (g115_device_data.dial_mgr_ev_chan, ignore);
 921                                                             /* in case a hangup_proc order was given */
 922                               call dial_manager_$release_channel (addr (dma), ignore);
 923                               if code ^= 0 then
 924                                    call hcs_$tty_order (g115_device_data.devx, order, infop, state, ignore); /* pass it on */
 925                          end;
 926                          do chn = g115_device_data.tty_ev_channel, g115_device_data.timeout_ev_channel,
 927                                    g115_device_data.dial_mgr_ev_chan;
 928                               call ipc_$delete_ev_chn (chn, ignore);
 929                          end;
 930 
 931                          call hcs_$tty_detach (g115_device_data.devx, 0, state, ec);
 932 
 933                          call release_temp_segment_ ("g115_io_buffer", g115_device_data.buffer_areap, ignore);
 934 
 935                          call delete_device_data (device_data_p); /* remove from the chain */
 936 
 937                     end;
 938 
 939           end cleanup_and_detach;
 940 
 941 
 942 
 943 get_option_arg: proc (idx) returns (char (*) var);
 944 
 945 /* this proc is used to do multiple tests and assignments within  a one line then clause of an if statement */
 946 
 947 dcl  idx fixed bin;
 948 
 949                idx = idx + 1;                               /* bump the current option index, to find the option arg */
 950                if idx > hbound (a_option, 1) then do;       /* still in range? */
 951                     code = error_table_$noarg;              /* tell process it left out an arg */
 952                     call abort_attach ("No argument after ", (a_option (i - 1)));
 953                end;
 954 
 955                attach_description = attach_description || " " || a_option (idx); /* include the arg in attach description */
 956 
 957                return (a_option (idx));
 958 
 959           end get_option_arg;
 960 ^L
 961 abort_attach: proc (control_string, arg_value);             /* this proc handles attach errors */
 962 
 963 dcl (control_string, arg_value) char (*) aligned;
 964 dcl  saved_code fixed bin (35);
 965 
 966                if comerr_sw then call com_err_ (code, "g115_", control_string, arg_value);
 967 
 968                saved_code = code;                           /* keep a copy */
 969 
 970                call cleanup_and_detach (code);
 971                if saved_code ^= 0 then code = saved_code;   /* use former reason if any */
 972 
 973                go to attach_return;                         /* non local transfer to finish off the abort */
 974 
 975           end abort_attach;
 976 
 977 
 978 
 979 any_other_handler: proc;
 980 
 981 /* this is the any_other handler to protect us while masked against IPS signals */
 982 
 983                if mask then call hcs_$reset_ips_mask (mask, mask);
 984                mask = ""b;
 985 
 986                call continue_to_signal_ (code);
 987 
 988                return;
 989 
 990           end any_other_handler;
 991 
 992 
 993 
 994 
 995 clean_up_handler: proc;
 996 
 997 /* this is the cleanup condition handler for errors during the attach entry */
 998 
 999                call cleanup_and_detach (ignore);
1000 
1001                return;
1002 
1003           end clean_up_handler;
1004 ^L
1005 init_g115_device_data: proc (ddp, ec);
1006 
1007 dcl  ddp ptr;
1008 dcl  ec fixed bin (35);
1009 dcl  msgp ptr;
1010 dcl  bp ptr;
1011 
1012                ddp -> g115_device_data.tty_name = "";       /* let the main proc define this */
1013                ddp -> g115_device_data.fmt_code.control = G115.special_nc;
1014                ddp -> g115_device_data.fmt_code.data = G115.info_s_c; /* data will be compressed and split */
1015                ddp -> g115_device_data.write_split, ddp -> g115_device_data.write_compress = "1"b; /* for easy test */
1016                ddp -> g115_device_data.delay = 50000;       /* default to 50 msec for AS */
1017                ddp -> g115_device_data.level = 0;           /* the write invocation level */
1018                ddp -> g115_device_data.outp (*) = null;
1019                ddp -> g115_device_data.process_id = get_process_id_ (); /* record our process id for wakeups */
1020 
1021 /* make an area for allocation of input/output buffers */
1022 
1023                call get_temp_segment_ ("g115_io_buffer", ddp -> g115_device_data.buffer_areap, ec);
1024                if ec ^= 0 then return;
1025 
1026                bp = ddp -> g115_device_data.buffer_areap;   /* get short pointer name */
1027                bp -> buffer_area = empty;                   /* initialize the area */
1028 
1029                allocate g115_message in (bp -> buffer_area) set (ddp -> g115_device_data.template_ptr); /* OUTPUT buffer */
1030 
1031                msgp = ddp -> g115_device_data.template_ptr; /* for easy structure reference */
1032 
1033 /*                  set up the template output buffer for speed later */
1034 
1035                unspec (msgp -> g115_message) = "0"b;        /* set everything to zero */
1036                msgp -> g115_message.next_bp = null;         /* output buffers are not chained */
1037                msgp -> g115_message.soh = G115.soh_char;
1038                msgp -> g115_message.addr_code = G115.addr_code_char;
1039                msgp -> g115_message.op_code.use = "1"b;
1040                msgp -> g115_message.id_code = G115.id_code_char;
1041                msgp -> g115_message.stx = G115.stx_char;
1042                msgp -> g115_message.etx = G115.etx_char;
1043 
1044                allocate g115_message in (bp -> buffer_area) set (ddp -> g115_device_data.first_bp); /* INPUT buffer */
1045 
1046                msgp, ddp -> g115_device_data.last_bp = ddp -> g115_device_data.first_bp; /* set the chain */
1047                unspec (msgp -> g115_message) = "0"b;        /* make it clean */
1048                msgp -> g115_message.next_bp = null;
1049 
1050                return;
1051 
1052           end init_g115_device_data;
1053 ^L
1054 create_device_data: proc (ddp);
1055 
1056 /* this proc allocates a copy of g115_device_data and threads it into the list */
1057 
1058 dcl  ddp ptr;
1059 
1060                allocate g115_device_data in (attach_area) set (ddp);
1061 
1062                unspec (ddp -> g115_device_data) = "0"b;     /* set everything to zero */
1063 
1064                ddp -> g115_device_data.back_ptr = last_device_data_p; /* point back to previous tail */
1065                ddp -> g115_device_data.fwd_ptr = null;      /* this is the new tail of the chain */
1066                if last_device_data_p ^= null                /* if tail already exists */
1067                then last_device_data_p -> g115_device_data.fwd_ptr = ddp; /* link it to this block */
1068                else first_device_data_p = ddp;              /* otherwise start the chain */
1069                last_device_data_p = ddp;                    /* record the new tail */
1070 
1071                return;
1072 
1073 delete_device_data: entry (ddp);
1074 
1075 /* this entry removes a link in the chain and frees the data block */
1076 
1077                if ddp -> g115_device_data.back_ptr = null then /* was this the head of the chain? */
1078                     first_device_data_p = ddp -> g115_device_data.fwd_ptr; /* make the next one the head */
1079                else ddp -> g115_device_data.back_ptr -> g115_device_data.fwd_ptr = ddp -> g115_device_data.fwd_ptr;
1080                                                             /* move our fwd ptr to previous block */
1081 
1082                if ddp -> g115_device_data.fwd_ptr = null then /* was this the tail of the chain */
1083                     last_device_data_p = ddp -> g115_device_data.back_ptr; /* make previous the new tail */
1084                else ddp -> g115_device_data.fwd_ptr -> g115_device_data.back_ptr = ddp -> g115_device_data.back_ptr;
1085                                                             /* move our back ptr to next block */
1086 
1087                free ddp -> g115_device_data in (attach_area);
1088 
1089                ddp = null;                                  /* just to be sure */
1090 
1091                return;
1092 
1093           end create_device_data;
1094 ^L
1095 line_status_pending: proc (ec) returns (bit (1));
1096 
1097 dcl  ec fixed bin (35);
1098 
1099 /* this proc returns true if there was a line status code and we cleared the line, ready for a retry */
1100 
1101                if ec = 0 then return ("0"b);                /* avoid a loop for normal case */
1102 
1103                do while (ec = error_table_$line_status_pending);
1104                     call hcs_$tty_order (g115_device_data.devx, "line_status", addr (line_status), state, ec);
1105                     if state ^= 5 then ec = error_table_$io_no_permission;
1106                end;
1107 
1108                if ec = 0 then return ("1"b);                /* OK to retry */
1109 
1110                return ("0"b);                               /* Do not retry */
1111 
1112           end line_status_pending;
1113 
1114 
1115 
1116 
1117      end g115_;