1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Bull Inc., 1988                *
   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 
  13 
  14 /****^  HISTORY COMMENTS:
  15   1) change(88-06-10,Berno), approve(88-07-13,MCR7928),
  16      audit(88-06-10,Parisek), install(88-07-19,MR12.2-1061):
  17      Add support of the uncp multiplexer interface for DSA login protocol.
  18   2) change(89-02-24,Parisek), approved(89-02-24,MECR0008),
  19      audit(89-02-28,Farley), install(89-02-28,MR12.3-1016):
  20      Reinitialize the uncp_buf data when performing a load on the UNCP FNP.
  21                                                    END HISTORY COMMENTS */
  22 
  23 /* format: style4,delnl,insnl,^ifthendo */
  24 uncp_multiplexer:
  25      proc;
  26 
  27 /* This is the called multiplexer module for FNP channels. It calls uncp
  28    *  to pass mailboxes on to the FNP. Important data structures are:
  29    *      fnp_info (in dn355_data) : info about the FNP as a whole
  30    *      pcb (physical channel block) : allocated in tty_buf. Contains per-channel info
  31    *
  32 */
  33 
  34 /* Written 08/15/78 by Robert Coren */
  35 /* Modified 04/11/79 by Robert Coren to handle all modes at once */
  36 /* Modified 06/29/79 by Bernard Greenberg for FNP echo negotiation */
  37 /* Modified 79 Aug 21 by Art Beattie to support 64K DN6670s. */
  38 /* Modified various times in 1980 by Robert Coren to add metering */
  39 /* Modified May 1981 by Robert Coren to keep get_meters order from using user-supplied
  40    pointer while FNP channel is locked */
  41 /* Modified late summer 1981 by Robert Coren to handle tandd_attach order and COLTS channel */
  42 /* Modified fall 1981 by Robert Coren to assign smaller buffer sizes */
  43 /* Modified November 1981 by Robert Coren to fix bug whereby terminate_multiplexer
  44    didn't initialize ttybp */
  45 /* Modified June 1982 by Robert Coren to correct precision of FNP addresses. */
  46 
  47 /* THE FOLLOWING HISTORY COMMENTS REFER TO THE CONVERSION TO THE UNCP
  48    MULTIPLEXER SOFTWARE FOR DSA CONNECTIONS.  fnp_multiplexer.pl1 WAS THE
  49    TEMPLATE FOR THIS PROGRAM.  */
  50 
  51 /* Reported in February 1982 modifications for the connection of the DN7100
  52    - Added the orders: load, dump, dial
  53    - Added the hpriv_control for management of the fnp_info.active_bit
  54      for dials.
  55    - Eliminate all the ineffective orders for the DN7100.
  56 
  57    - Correction of a Multics crash. In the process mode for "breakall"
  58      it must initialize alter_type. (31 March 1983).
  59 
  60    Report in this module the improvments for MR10.1 in June 1983
  61    Installed for MR11 in August 1985.
  62    Installed for MR12.0 in January 1987.
  63 
  64    Date of the last modification: 07/01/87.
  65 */
  66 
  67 
  68 /* PARAMETERS */
  69 
  70 dcl  a_devx fixed bin;                                      /* devx of FNP channel */
  71 dcl  a_init_info_ptr ptr;
  72 dcl  a_fnpp ptr;
  73 dcl  a_subchan fixed bin;
  74 dcl  a_chainp ptr;
  75 dcl  a_mi_flag bit (1) aligned;
  76 dcl  a_code fixed bin (35);
  77 dcl  a_output_ptr ptr;
  78 dcl  a_order char (*);
  79 dcl  a_data_ptr ptr;
  80 dcl  a_mode_list_ptr ptr;
  81 dcl  a_modes char (*);
  82 
  83 
  84 /* AUTOMATIC */
  85 
  86 dcl  code fixed bin (35);                                   /* standard system error code */
  87 dcl  devx fixed bin;                                        /* of FNP channel */
  88 dcl  my_chan_name char (1);
  89 dcl  dno fixed bin;                                         /* FNP number */
  90 dcl  pcb_space fixed bin;
  91 dcl  space_needed fixed bin;
  92 dcl  output_ptr ptr;                                        /* pointer to caller's output data */
  93 dcl  chanx fixed bin;                                       /* index of PCB */
  94 dcl  output_length fixed bin;                               /* number of output characters */
  95 /*dcl  sourcep ptr;*/
  96 dcl  (i/*, j*/) fixed bin;
  97 dcl  lastp ptr;                                             /* pointer to last buffer in already-exisitng chain */
  98 
  99 dcl  order char (32);
 100 dcl  data_ptr ptr;                                          /* pointer to order info structure */
 101 dcl  set_write_status bit (1);
 102 dcl  locked bit (1);
 103 dcl  queue_locked bit (1);
 104 dcl  mylock bit (1);
 105 dcl  opcode fixed bin (8);                                  /* mailbox opcode */
 106 dcl  alter_type fixed bin (8);                              /* alter parameters subop */
 107 dcl  check bit (1);
 108 dcl  mbx_data_len fixed bin;                                /* in bits */
 109 dcl  mbx_data bit (4 * 36) based (addr (mbx_data_long));
 110 dcl  mbx_data_long bit (8 * 36);
 111 dcl  alter_data bit (4 * 36) varying;
 112 dcl  dumpin bit (1);
 113 dcl  dumpout bit (1);
 114 dcl  get_meters bit (1);
 115 dcl  temp_saved_meters_ptr ptr;
 116 /*dcl  meter_ptr ptr;*/
 117 /*dcl  lcmp ptr;*/
 118 /*dcl  fnp_meters_ptr ptr;*/
 119 /*dcl  ret_meters_ptr ptr;*/
 120 dcl  local_line_type fixed bin;
 121 /*dcl  phone_no_len fixed bin;*/                                      /* in bits */
 122 /*dcl  phone_digits (32) bit (6);*/
 123 /*dcl  next_digit fixed bin (6) unsigned;*/                           /* value of next dialout digit */
 124 /*dcl  digit_pos fixed bin;*/                               /* how far along we are in phone number */
 125 dcl  opend bit (1);                                         /* whether or not output is pending */
 126 
 127 dcl  modex fixed bin;
 128 dcl  mode_name char (8);
 129 dcl  mode_on bit (1);                                       /* mode to be turned on or off */
 130 dcl  mode_set (36) bit (1);
 131 dcl  hndlquit_set bit (1);
 132 dcl  base_len fixed bin;
 133 dcl  block_len fixed bin;
 134 /*dcl  chars_per_buf fixed bin;*/
 135 dcl  chars_per_sec fixed bin;
 136 
 137 /*dcl  wire_arg fixed bin (71);
 138 dcl  wire_ptr ptr;*/
 139 dcl  hsla_flag bit (1);
 140 dcl  old_flag bit (1);
 141 dcl  pcb_space_ptr ptr;
 142 dcl  prev_la_no fixed bin;
 143 dcl  la_no fixed bin;
 144 dcl  subchan fixed bin;
 145 dcl  his_fnp_no fixed bin;                                  /* FNP number in supplied channel name */
 146 dcl  pcbx fixed bin;
 147 /*dcl  found bit (1);*/
 148 /*dcl  past bit (1);*/
 149 /*dcl  n_fnp_words fixed bin;*/
 150 /*dcl  ignore bit (1);*/
 151 dcl  name char (32);
 152 /*dcl  temp_addr fixed bin;*/
 153 /*dcl  fnp_dump_ptr ptr;*/
 154 /*dcl  dump_patch_space fixed bin;*/                        /* amount of space required by an fnp_(dump patch) order */
 155 /*dcl  dump_patch_time fixed bin (71);*/                              /* clock time when a dump or patch order was initiated */
 156 
 157 
 158 /*dcl  1 dump_fnp_data aligned,*/                                     /* command data for dump_fnp & patch_fnp */
 159 /*       2 abs_addr fixed bin (24),*/                       /* absolute address of ring-zero buffer */
 160 /*       2 fnp_addr fixed bin (18) unsigned unaligned,*/    /* address in FNP */
 161 /*       2 fnp_len fixed bin (18) unsigned unaligned;*/     /* number of 18-bit words */
 162 
 163 /*dcl  1 fnp_break_data aligned,*/                          /* command data for fnp_break order */
 164 /*       2 lineno fixed bin (17) unal,*/                              /* line number, derived from tty name */
 165 /*       2 fnp_addr fixed bin (18) unsigned unal,
 166        2 action fixed bin (17) unal,
 167        2 flags bit (18) unal;*/
 168 
 169 /*dcl  1 echnego_break_table aligned,
 170        2 words (0:15) unaligned,
 171          3 bits bit (16) unaligned,
 172          3 pad bit (2) unaligned;*/
 173 
 174 /* BASED */
 175 
 176 dcl  based_fb_word fixed bin based;
 177 dcl  based_bit2 bit (2) based;
 178 /*dcl  based_bit18 bit (18) based;*/
 179 dcl  based_bit72 bit (72) based;
 180 /*dcl  based_bit108 bit (108) based;*/
 181 /*dcl  fnp_data (n_fnp_words) bit (18) based;*/
 182 
 183 
 184 /*dcl  phone_chars char (32) varying based;*/               /* phone number passed with dial_out order */
 185 
 186 dcl  1 wr_stat aligned based,                               /* for write_status */
 187        2 ev_chan fixed bin (71),
 188        2 output_pending bit (1);
 189 
 190 dcl  1 rd_stat aligned based,                               /* for read_status */
 191        2 ev_chan fixed bin (71),
 192        2 input_available bit (1);
 193 
 194 /*dcl  1 dump_fnp_info based (data_ptr) aligned,*/                    /* structure passed for dump_fnp and patch_fnp */
 195 /*       2 fnp_address fixed bin (24),*/
 196 /*       2 fnp_len fixed bin,*/                                       /* number of 18=bit words */
 197 /*       2 bufp ptr,*/                                                /* pointer to caller's buffer */
 198 /*       2 old_value_ptr ptr;*/                                       /* pointer to previous values (patch only) */
 199 
 200 /*dcl  1 fnp_break_info aligned based (data_ptr),*/                   /* structure passed on fnp_break order */
 201 /*       2 chan_name char (6),*/                                      /* tty name, optional */
 202 /*       2 fnp_addr fixed bin,*/                                      /* addr in fnp to set break */
 203 /*       2 action fixed bin,*/                                        /* request type */
 204 /*       2 flags bit (36);*/                                /* special action flags */
 205 
 206 /*dcl  1 echo_start_data aligned based (data_ptr),*/                  /* Echo starting data */
 207 /*       2 ctr fixed bin (35),*/                                      /* Synchronization counter */
 208 /*       2 screenleft fixed bin (35);*/                     /* Length left on screen */
 209 
 210 /* BUILTINS & CONDITIONS */
 211 
 212 dcl  (addr, addrel, bin, bit, /*clock,*/ divide, lbound, hbound, length, null,
 213      ptr, rel, rtrim, size, /*stac, stacq,*/ string, substr, unspec) builtin;
 214 
 215 dcl  area condition;
 216 
 217 
 218 /* ENTRIES */
 219 
 220 /*dcl  pxss$notify entry (fixed bin);*/
 221 dcl  uncp$send_wcd entry (ptr, ptr, fixed bin (8), fixed bin, bit (*));
 222 dcl  uncp$send_global_wcd entry (ptr, fixed bin (8), fixed bin, bit (*));
 223 dcl  uncp$hangup_fnp_lines entry (fixed bin);
 224 dcl  uncp$process_interrupt_queue entry (fixed bin);
 225 
 226 dcl  uncp$interrupt entry;
 227 dcl  uncp_util$fill_page_table entry (fixed bin, fixed bin (35));
 228 dcl  uncp_util$free_page_table entry (fixed bin);
 229 /*dcl  uncp_util$unwire entry (fixed bin, fixed bin (35));*/
 230 dcl  tty_lock$lock_lcte entry (ptr, fixed bin (35));
 231 dcl  tty_area_manager$allocate entry (fixed bin, ptr);
 232 dcl  tty_area_manager$free entry (fixed bin, ptr);
 233 dcl  lock$lock_fast entry (pointer);
 234 dcl  lock$unlock_fast entry (pointer);
 235 dcl  syserr entry options (variable);
 236 dcl  syserr$error_code entry options (variable);
 237 
 238 dcl  parse_tty_name_ entry (char (*), fixed bin, bit (1), fixed bin, fixed bin);
 239 dcl  parse_fnp_name_ entry (char (*), fixed bin);
 240 /*dcl  pxss$addevent entry (fixed bin);
 241 dcl  pxss$delevent entry (fixed bin);
 242 dcl  pxss$wait entry;*/
 243 dcl  uncp_util$abort entry (fixed bin, fixed bin (35));
 244 dcl  uncp_util$load entry (fixed bin, ptr, fixed bin (35));
 245 dcl  uncp_util$fdump entry (fixed bin, fixed bin, fixed bin, ptr, fixed bin (35));
 246 
 247 /* EXTERNAL STATIC */
 248 
 249 dcl  (
 250      error_table_$noalloc,
 251      error_table_$undefined_order_request,
 252      error_table_$bad_mode,
 253      error_table_$bad_channel,
 254 /*     error_table_$buffer_big,
 255      error_table_$invalid_write,
 256      error_table_$dev_offset_out_of_bounds,
 257      error_table_$seglock,*/
 258      error_table_$fnp_down,
 259 /*     error_table_$timeout,*/
 260      error_table_$unimplemented_version,
 261 /*     error_table_$no_channel_meters,
 262      error_table_$resource_not_free,*/
 263      error_table_$action_not_performed,
 264      error_table_$io_assigned,
 265      error_table_$io_not_assigned,
 266      error_table_$io_not_configured,
 267      error_table_$io_not_available,
 268      error_table_$invalid_state
 269      ) ext static fixed bin (35);
 270 
 271 dcl  pds$processid ext static bit (36) aligned;
 272 /*dcl  pds$process_group_id ext static char (32) aligned;*/
 273 /*dcl  tty_area$ external static fixed bin;*/
 274 
 275 /* INTERNAL STATIC */
 276 
 277 /* The following are declared here because syserr_constants.incl.pl1 cannot
 278    be used, owing to a naming conflict with mcs_interrupt_info.incl.pl1.
 279 */
 280 
 281 dcl  ANNOUNCE fixed bin internal static options (constant) init (0);
 282 dcl  CRASH_SYSTEM fixed bin internal static options (constant) init (1);
 283 dcl  UNCP_CQ_SIZE fixed bin int static options (constant) init (2000);
 284 /*dcl  DUMP_PATCH_LIMIT fixed bin (35) int static options (constant) init (10000000);*/
 285                                                             /* i.e., 10 seconds */
 286 dcl  DCW_LIST_SIZE fixed bin int static options (constant) init (16);
 287 dcl  PCB_SIZE_INCR fixed bin int static options (constant) init (8);
 288 dcl  LA_7 fixed bin int static options (constant) init (7);
 289 dcl  TWO_WORD_LTH fixed bin int static options (constant) init (18);
 290 dcl  BASE_LTH fixed bin int static options (constant) init (56);
 291 dcl  CHAR_72 fixed bin int static options (constant) init (72);
 292 
 293 /* The following facts about the the lists of modes below are IMPORTANT.
 294    *  The modes which have corresponding alter_parameters subtypes are the same as the modes
 295    *  that are valid for asynchronous lines only, and no data is associated with the
 296    *  alter_parameters other than on/off, with the following exceptions:
 297    *      blk_xfer and iflow require additional data (buffer sizes)
 298    *      hndlquit is valid for any line, but is expressed by alter_parameters
 299    *
 300    *  Therefore, hndlquit is handled explicitly, and blk_xfer and iflow must come after those modes having alter_paramters
 301    *  subop types. Anyone modifying these lists should be aware of this circumstance.
 302 */
 303 
 304 dcl  good_modes (1) char (8) int static options (constant)  /* modes recognized for all lines */
 305           init ("hndlquit");
 306 
 307 dcl  async_only_modes (15) char (8) int static options (constant)
 308                                                             /* modes recognized for async lines only */
 309           init ("crecho", "tabecho", "lfecho", "echoplex", "fulldpx", "replay", "polite", "breakall", "prefixnl",
 310           "no_outp", "8bit", "oddp", "oflow", "iflow", "blk_xfer");
 311 
 312 dcl  IFLOW_INDEX fixed bin internal static options (constant) init (14);
 313 dcl  BLK_XFER_INDEX fixed bin internal static options (constant) init (15);
 314 
 315 dcl  full_dpx_modes (7) char (8) int static options (constant)
 316                                                             /* modes requiring full duplex line type */
 317           init ("crecho", "tabecho", "lfecho", "echoplex", "fulldpx", "iflow", "oflow");
 318 
 319 dcl  mode_alter_types (13) fixed bin (8) int static options (constant)
 320                                                             /* alter_paramters subops corresponding to modes */
 321           init (8,                                          /* crecho */
 322           14,                                               /* tabecho */
 323           9,                                                /* lfecho */
 324           20,                                               /* echoplex */
 325           3,                                                /* fulldpx */
 326           23,                                               /* replay */
 327           24,                                               /* polite */
 328           27,                                               /* breakall */
 329           28,                                               /* prefixnl */
 330           33,                                               /* no_outp */
 331           32,                                               /* 8bit */
 332           31,                                               /* oddp */
 333           30);                                              /* oflow */
 334 ^L
 335 /* INCLUDE FILES */
 336 
 337 %page;
 338 %include tty_buf;
 339 %page;
 340 %include tty_buffer_block;
 341 %page;
 342 %include lct;
 343 %page;
 344 %include dn355_data;
 345 %page;
 346 %include pcb;
 347 %page;
 348 %include mailbox_ops;
 349 %page;
 350 %include tty_space_man_dcls;
 351 %page;
 352 %include line_types;
 353 %page;
 354 %include mux_init_info;
 355 %page;
 356 %include io_chnl_util_dcls;
 357 %include mcs_modes_change_list;
 358 %include flow_control_info;
 359 %include channel_manager_dcls;
 360 %include mcs_interrupt_info;
 361 %include fnp_meters;
 362 %include fnp_channel_meters;
 363 %include get_comm_meters_info;
 364 %include io_manager_dcls;
 365 %include mcs_echo_neg_sys;
 366 %include uncp_buf;
 367 ^L
 368 init_multiplexer:
 369      entry (a_devx, a_init_info_ptr, a_fnpp, a_code);
 370 
 371 /* This entry is called to initialize data bases preparatory to loading an FNP
 372    *  In particular, it initializes the appropriate entry in fnp_info,
 373    *  uncp_buf, and allocates and initializes PCBs
 374 */
 375 
 376 
 377           devx = a_devx;
 378           miip = a_init_info_ptr;
 379           mii_chan_count = mux_init_info.no_channels;
 380           pcb_space_ptr = null ();                          /* make cleanup safe */
 381           infop = addr (dn355_data$);
 382           ttybp = addr (tty_buf$);
 383           uncpbp = datanet_info.uncp_bufp;                  /* UNCP's circular queue */
 384           lctp = tty_buf.lct_ptr;
 385 
 386           lcntp = lct.lcnt_ptr;                             /* get channel name */
 387           if length (rtrim (lcnt.names (devx))) ^= 1
 388           then go to bad_channel;
 389           my_chan_name = rtrim (lcnt.names (devx));
 390           call parse_fnp_name_ (my_chan_name, dno);
 391           if dno < 0                                        /* unreasonable name */
 392           then do;
 393 bad_channel:
 394                a_code = error_table_$bad_channel;
 395                go to init_exit;
 396           end;
 397 
 398           fnpp = addr (datanet_info.per_datanet (dno));
 399           call TRACE ("init_multiplexer");                  /* only error trace if bad devx */
 400 
 401           if my_chan_name ^= fnp_info.fnp_tag
 402           then go to bad_channel;
 403           if ^tty_buf.fnp_config_flags (dno)
 404           then go to bad_channel;
 405 
 406           call lock$lock_fast (addr (datanet_info.configuration_lock));
 407                                                             /* noone else can configure */
 408           if uncpbp ^= null then do;
 409                unspec (uncp_buf) = ""b;                     /* start by zeroing out everything */
 410                uncp_buf.cq_max_size = UNCP_CQ_SIZE;
 411                uncp_buf.cq_free = uncp_buf.cq_max_size;     /* Start of the free space */
 412                uncp_buf.cq_hbound = uncp_buf.cq_max_size - 1;
 413                                                             /* The circular queue is a table (0:cq_max_size - 1) */
 414           end;
 415 
 416           fnp_info.lcte_ptr = addr (lct.lcte_array (devx));
 417 
 418           if fnp_info.t_and_d_in_progress                   /* lcte will be invalid, but still */
 419           then do;
 420                code = error_table_$io_not_available;
 421                go to init_abort;
 422           end;
 423 
 424           call assign_channel (code);                       /* under config lock */
 425           if code ^= 0
 426           then go to init_abort;                            /* it may have been deconfigured while we were farting around */
 427 
 428           call uncp_util$fill_page_table ((fnp_info.fnp_number), code);
 429           if code ^= 0
 430           then go to init_abort;                            /* IOI has problems? */
 431 
 432           do i = lbound (fnp_info.hsla_idx, 1) to hbound (fnp_info.hsla_idx, 1);
 433                                                             /* initialize line-number indexes for HSLA */
 434                fnp_info.hsla_idx (i) = -1;
 435           end;
 436           do i = lbound (fnp_info.lsla_idx, 1) to hbound (fnp_info.lsla_idx, 1);
 437                                                             /* now for LSLAs */
 438                fnp_info.lsla_idx (i) = -1;
 439           end;
 440 
 441 
 442           pcb_space = size (pcb) * mii_chan_count;          /* get enough space for an array of PCBs */
 443           space_needed = pcb_space + PCB_SIZE_INCR * DCW_LIST_SIZE;
 444           call tty_space_man$get_space (space_needed, pcb_space_ptr);
 445           if pcb_space_ptr = null                           /* this would be unfortunate */
 446           then do;
 447                a_code = error_table_$noalloc;
 448                go to init_abort;
 449           end;
 450           n_pcbs, fnp_info.no_of_channels = mii_chan_count;
 451           pcb_space_ptr -> pcb_array (*).saved_meters_ptr = null ();
 452 
 453           fnp_info.pcb_array_ptr = pcb_space_ptr;
 454           fnp_info.dcw_list_array_ptr = addrel (pcb_space_ptr, pcb_space);
 455 
 456           string (fnp_info.flags) = "0"b;
 457           prev_la_no = -1;                                  /* so test will work right the first time */
 458           old_flag = "1"b;                                  /* HSLA channels (if any) are always first */
 459 
 460 /*
 461    * The following code assigns line numbers and sets the adapter indexes
 462    * It assumes that channels in mux_init_info are sorted in ascending order
 463 */
 464 
 465           do pcbx = 1 to n_pcbs;
 466                pcbp = addr (pcb_space_ptr -> pcb_array (pcbx));
 467                unspec (pcb) = "0"b;
 468                pcb.saved_meters_ptr = null ();              /* for cleanup dept */
 469                pcb.devx = mux_init_info.channels (pcbx).devx;
 470                lctep = addr (lct.lcte_array (pcb.devx));
 471                lcte.subchannel = pcbx;
 472                name = mux_init_info.channels (pcbx).name;
 473                call parse_tty_name_ (name, his_fnp_no, hsla_flag, la_no, subchan);
 474                if his_fnp_no ^= dno
 475                then do;
 476                     code = error_table_$bad_channel;
 477                     go to init_abort;
 478                end;
 479                if la_no = LA_7
 480                then fnp_info.tandd_pcbx = pcbx;
 481                else if (la_no ^= prev_la_no | hsla_flag ^= old_flag)
 482                                                             /* first subchannel on this adapter */
 483                then do;
 484                     if hsla_flag
 485                     then fnp_info.hsla_idx (la_no) = pcbx;
 486                     else fnp_info.lsla_idx (la_no) = pcbx;
 487                     prev_la_no = la_no;
 488                     old_flag = hsla_flag;
 489                end;
 490 
 491                pcb.subchan = subchan;
 492                pcb.is_hsla = hsla_flag;
 493                pcb.la_no = bit (bin (la_no, 3), 3);
 494                if hsla_flag
 495                then pcb.slot_no = bit (bin (subchan, 6), 6);
 496 
 497 /*             * lsla slot number has to wait for baud rate supplied at bootload time */
 498 
 499                on area
 500                     begin;
 501                          code = error_table_$noalloc;
 502                          go to init_abort;
 503                     end;
 504 
 505                call tty_area_manager$allocate (size (fnp_channel_meters), temp_saved_meters_ptr);
 506                pcb.saved_meters_ptr = temp_saved_meters_ptr;
 507           end;
 508 
 509           call lock$unlock_fast (addr (datanet_info.configuration_lock));
 510 
 511 
 512           a_fnpp = fnpp;                                    /* pass this back */
 513           a_code = 0;
 514 init_exit:
 515           return;
 516 
 517 init_abort:
 518           call TRACE_ERROR ("init_multiplexer", code);
 519           call lock$unlock_fast (addr (datanet_info.configuration_lock));
 520           if pcb_space_ptr ^= null
 521           then do;
 522                do pcbx = 1 to n_pcbs;
 523                     pcbp = addr (pcb_space_ptr -> pcb_array (pcbx));
 524                     if pcb.saved_meters_ptr ^= null ()
 525                     then call tty_area_manager$free (size (fnp_channel_meters), (pcb.saved_meters_ptr));
 526                end;
 527                call tty_space_man$free_space (space_needed, pcb_space_ptr);
 528           end;
 529           a_code = code;
 530           return;
 531 ^L
 532 terminate_multiplexer:
 533      entry (a_fnpp, a_code);
 534 
 535 /* This entry is called after FNP crash or shutdown in order to free PCBs */
 536 
 537           fnpp = a_fnpp;
 538           ttybp = addr (tty_buf$);
 539           infop = addr (dn355_data$);
 540           locked = "0"b;
 541           call TRACE ("terminate_multiplexer");
 542           call lock;
 543           if code ^= 0
 544           then go to terminate_return;
 545 
 546           if fnp_info.bootloading | fnp_info.wired | fnp_info.running
 547                                                             /* bad time to terminate */
 548           then code = error_table_$invalid_state;
 549 
 550           else do;
 551                do i = 1 to fnp_info.no_of_channels;
 552                     pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (i));
 553                     if pcb.write_first ^= 0
 554                     then call tty_space_man$free_chain ((pcb.devx), OUTPUT, ptr (ttybp, pcb.write_first));
 555                     if pcb.read_first ^= 0
 556                     then call tty_space_man$free_chain ((pcb.devx), INPUT, ptr (ttybp, pcb.read_first));
 557                     call tty_area_manager$free (size (fnp_channel_meters), (pcb.saved_meters_ptr));
 558                     if pcb.copied_meters_offset ^= 0        /* free this if it's there */
 559                     then do;
 560                          call tty_space_man$free_space (size (fnp_channel_meters), ptr (ttybp, pcb.copied_meters_offset));
 561                          pcb.copied_meters_offset = 0;
 562                     end;
 563                end;
 564 
 565                string (fnp_info.flags) = "0"b;
 566                call tty_space_man$free_space (size (pcb) * fnp_info.no_of_channels + PCB_SIZE_INCR * DCW_LIST_SIZE,
 567                     fnp_info.pcb_array_ptr);
 568                fnp_info.pcb_array_ptr = null;
 569                code = 0;
 570           end;
 571           if fnp_info.io_manager_assigned
 572           then call unassign_channel (code);                /* not deconfigured on us */
 573           call uncp_util$free_page_table ((fnp_info.fnp_number));
 574                                                             /* even if we lost the assignment ... */
 575 
 576           call unlock;
 577 
 578 terminate_return:
 579           if code ^= 0
 580           then call TRACE_ERROR ("terminate_multiplexer", code);
 581           a_code = code;
 582           return;
 583 ^L
 584 start:
 585      entry (a_fnpp, a_code);
 586 
 587 /* entry to enable an FNP by sending "accept_calls" order */
 588 
 589           fnpp = a_fnpp;
 590           infop = addr (dn355_data$);
 591           call TRACE ("start");
 592           chanx = 1;                                        /* this is irrelevant, but will make setup happy */
 593           call setup;
 594           if code = 0
 595           then do;
 596 
 597 /*             call dn355$send_global_wcd (fnpp, accept_calls, 18,
 598    bit (bin (bin (rel (addr (tty_buf.free_space)), 18) + tty_buf.absorig, 18), 18));  */
 599 /*   Le Datanet n aime plus les a-call.
 600    call uncp$send_global_wcd (fnpp, accept_calls, 0, ""b);
 601 */
 602                call unlock;                                 /* setup locked and masked */
 603           end;
 604           if code ^= 0
 605           then call TRACE_ERROR ("start", code);
 606           a_code = code;
 607           return;
 608 
 609 
 610 stop:
 611      entry (a_fnpp, a_code);
 612 
 613 /* entry to disable an FNP from further dialups (by sending dont_accept_calls order) */
 614 
 615           fnpp = a_fnpp;
 616           infop = addr (dn355_data$);
 617           call TRACE ("stop");
 618           chanx = 1;                                        /* as for start entry */
 619           call setup;
 620           if code = 0
 621           then call unlock;                                 /* setup masked and locked */
 622 
 623           if code ^= 0
 624           then call TRACE_ERROR ("stop", code);
 625           a_code = code;
 626           return;
 627 
 628 
 629 shutdown:
 630      entry (a_fnpp, a_code);
 631 
 632 /* This entry simulates an FNP crash; if the FNP is up, all lines will be hung up */
 633 
 634           infop = addr (dn355_data$);
 635           fnpp = a_fnpp;
 636           if fnpp = null ()
 637           then do;
 638                if datanet_info.trace
 639                then call syserr (ANNOUNCE, "uncp_multiplexer$shutdown: Called with null fnp_ptr");
 640                go to shutdown_return;
 641           end;
 642           call TRACE ("shutdown");
 643           infop = addr (dn355_data$);
 644 
 645 
 646 /* ****************************************************************************************
 647 
 648    if fnp_info.bootloading | fnp_info.wired       [* stop any pending load *]
 649    then call uncp_util$abort ((fnp_info.fnp_number));
 650    else do;
 651    ************************************************************************* */
 652 
 653           fnp_info.bootloading = "0"b;                      /* ajouter pour dn 7100 */
 654           locked = "0"b;
 655           if fnp_info.running                               /* if it's up now */
 656           then do;
 657                call lock;
 658                call uncp$hangup_fnp_lines ((fnp_info.fnp_number));
 659                fnp_info.running = "0"b;
 660                call unlock;
 661           end;
 662 
 663 /*        end;  dn 7100     */
 664 
 665 shutdown_return:
 666           a_code = 0;
 667           return;
 668 ^L
 669 
 670 read:
 671      entry (a_fnpp, a_subchan, a_chainp, a_mi_flag, a_code);
 672 
 673 /* this is a dummy entry, uncp never holds input at interrupt time */
 674 
 675           a_chainp = null;
 676           a_mi_flag = "0"b;
 677           a_code = 0;
 678           return;
 679 
 680 
 681 write:
 682      entry (a_fnpp, a_subchan, a_output_ptr, a_code);
 683 
 684           fnpp = a_fnpp;
 685           chanx = a_subchan;
 686           output_ptr = a_output_ptr;
 687 
 688           call setup;
 689           if code ^= 0
 690           then do;
 691                a_code = code;
 692                return;
 693           end;
 694 
 695 /* figure out length of chain */
 696 
 697           blockp = output_ptr;
 698           output_length = buffer.tally;                     /* to start with */
 699 
 700           do while (buffer.next ^= 0);
 701                blockp = ptr (ttybp, buffer.next);
 702                output_length = output_length + buffer.tally;
 703           end;
 704 
 705           if pcb.write_last ^= 0                            /* existing write chain */
 706           then do;
 707                lastp = ptr (ttybp, pcb.write_last);
 708                lastp -> buffer.next = bin (rel (output_ptr));
 709           end;
 710 
 711           else pcb.write_first = bin (rel (output_ptr));
 712 
 713           pcb.write_last = bin (rel (blockp));              /* in any case */
 714           pcb.write_cnt = pcb.write_cnt + output_length;
 715 
 716           if pcb.send_output                                /* if the FNP is ready for it */
 717           then call uncp$send_wcd (fnpp, pcbp, accept_direct_output, 0, ""b);
 718 
 719           code = 0;
 720 write_exit:
 721           call unlock;
 722           if code = 0
 723           then a_output_ptr = null ();                      /* so caller will know we took it all */
 724           a_code = code;
 725           return;
 726 ^L
 727 control:
 728      entry (a_fnpp, a_subchan, a_order, a_data_ptr, a_code);
 729 
 730           fnpp = a_fnpp;
 731           chanx = a_subchan;
 732           order = a_order;
 733           data_ptr = a_data_ptr;
 734 
 735           dumpin, dumpout, set_write_status, get_meters = "0"b;
 736                                                             /* initialize local variables */
 737           opcode, alter_type = -1;
 738           check = "0"b;
 739 
 740           if order = "read_status"                          /* there's never any at this level */
 741           then do;
 742                data_ptr -> rd_stat.input_available = "0"b;
 743                a_code = 0;
 744                return;
 745           end;
 746 
 747           else if order = "hangup"
 748           then do;
 749                mbx_data_len = 0;
 750                mbx_data = ""b;
 751                opcode = disconnect_this_line;
 752           end;
 753 
 754 
 755 /*   supprimer pour le dn7100     *****************************************************************
 756 
 757 
 758    else if order = "wru"
 759    then do;
 760    alter_type = Wru;
 761    alter_data = ""b;
 762    end;
 763 
 764    else if order = "interrupt"
 765    then do;
 766    alter_type = Break;
 767    alter_data = ""b;
 768    end;
 769 
 770    else if order = "start_xmit_hd" | order = "stop_xmit_hd"
 771    then do;
 772    alter_type = Xmit_hold;
 773    alter_data = "00000000"b || (order = "start_xmit_hd");
 774    end;
 775 
 776    else if order = "set_input_message_size"
 777    then do;
 778    mbx_data = bit (bin (data_ptr -> based_fb_word, 18), 18);
 779    opcode = sync_msg_size;
 780    end;
 781 
 782    else if order = "line_control"
 783    then do;
 784    mbx_data_len = 72;
 785    mbx_data = data_ptr -> based_bit72;
 786    opcode = line_control;
 787    end;
 788 
 789    else if order = "set_framing_chars"
 790    then do;
 791    mbx_data_len = TWO_WORD_LTH;
 792    mbx_data = data_ptr -> based_bit18;  ** two characters are packed in halfword **
 793    opcode = set_framing_chars;
 794    end;
 795 
 796    else if order = "set_delay"
 797    then do;
 798    mbx_data_len = TWELVE_WORD_LTH;
 799    mbx_data = data_ptr -> based_bit108; ** 6 18-bit values **
 800    opcode = set_delay_table;
 801    end;
 802 
 803    ******************************************************************** */
 804 
 805 
 806           else if order = "abort"                           /* i.e., resetread or resetwrite */
 807           then do;
 808                dumpin = substr (data_ptr -> based_bit2, 2, 1);
 809                                                             /* we'll simply save this info for later */
 810                dumpout = substr (data_ptr -> based_bit2, 1, 1);
 811           end;
 812 
 813           else if order = "set_line_type"
 814           then do;
 815                mbx_data_len = TWO_WORD_LTH;
 816                local_line_type = data_ptr -> based_fb_word;
 817                if local_line_type <= 0 | local_line_type > max_line_type
 818                then go to order_error;
 819                check = "1"b;                                /* we'll have to look at PCB (after locking) */
 820                opcode = set_line_type;
 821           end;
 822 
 823 
 824 /*    ************************************************************************
 825 
 826 
 827    else if order = "dial_out"
 828    then do;                                                 ** we have to convert digits (in char. form) to 6-bit BCD **
 829    digit_pos = 0;
 830    do i = 1 to length (data_ptr -> phone_chars);** should never see "X" in phone number **
 831    next_digit = index ("0123456789XXX!", substr (data_ptr -> phone_chars, i, 1)) - 1;
 832    ** a value of 13 tells autocall unit to wait for a **
 833    ** dial tone before asking for another dialing digit **
 834    if next_digit >= 0
 835    then if next_digit < REAL_DIGITS | next_digit = SPECIAL_DIGIT
 836    then do;                             ** it's actually a digit **
 837    digit_pos = digit_pos + 1;
 838    phone_digits (digit_pos) = bit (next_digit, 6);
 839    end;
 840    end;
 841 
 842    phone_no_len = PHONENO_LTH_X * digit_pos;
 843    opcode = dial;
 844    check = "1"b;                                  ** special stuff required here too **
 845    end;
 846 
 847 
 848    *********************************************************** */
 849 
 850 
 851           else if order = "listen"
 852           then do;
 853                alter_type = Listen;
 854                alter_data = "000000001"b;
 855           end;
 856 
 857           else if order = "write_status"
 858           then set_write_status = "1"b;
 859 
 860           else if order = "enter_receive"
 861           then do;
 862                mbx_data_len = 0;
 863                mbx_data = ""b;
 864                opcode = enter_receive;
 865           end;
 866 
 867 /* ****      ***************************************************************
 868 
 869 
 870    else if order = "start_negotiated_echo"
 871    then do;
 872    mbx_data_len = 36;
 873    mbx_data =
 874    bit (fixed (data_ptr -> echo_start_data.ctr, 18), 18)
 875    || bit (fixed (data_ptr -> echo_start_data.screenleft, 18), 18);
 876    opcode = start_negotiated_echo;
 877    end;
 878    else if order = "set_echnego_break_table"
 879    then do;
 880    mbx_data_len = length (unspec (echnego_break_table));
 881    unspec (echnego_break_table) = ""b;  ** Get pads **
 882    do i = 0 to 7;
 883    echnego_break_table.bits (i) = substr (data_ptr -> based_bit128, 1 + 16 * i, 16);
 884    end;
 885    mbx_data = unspec (echnego_break_table);
 886    opcode = set_echnego_break_table;
 887    end;
 888    else if order = "init_echo_negotiation"
 889    then do;
 890    mbx_data_len = 0;
 891    mbx_data = ""b;
 892    opcode = init_echo_negotiation;
 893    end;
 894    else if order = "stop_negotiated_echo"
 895    then do;
 896    mbx_data_len = 0;
 897    mbx_data = ""b;
 898    opcode = stop_negotiated_echo;
 899    end;
 900    else if order = "input_flow_control_chars"
 901    then do;
 902    mbx_data_len = 36;
 903    if data_ptr -> input_flow_control_info.resume_seq.count = 0
 904    ** turning it all off **
 905    then mbx_data = ""b;
 906    else do;
 907    mbx_data =
 908    unspec (substr (data_ptr -> input_flow_control_info.suspend_seq.chars, 1, 1))
 909    || unspec (substr (data_ptr -> input_flow_control_info.resume_seq.chars, 1, 1))
 910    || data_ptr -> input_flow_control_info.timeout;
 911    if data_ptr -> input_flow_control_info.suspend_seq.count = 0
 912    then substr (mbx_data, 1, 9) = "0"b; ** don't send suspend char if there isn't one **
 913    end;
 914    opcode = input_fc_chars;
 915    end;
 916    else if order = "output_flow_control_chars"
 917    then do;
 918    mbx_data_len = 36;
 919    if data_ptr -> output_flow_control_info.suspend_or_etb_seq.count = 0
 920    ** no chars **
 921    then mbx_data = "0"b;
 922    else mbx_data =
 923    unspec (substr (data_ptr -> output_flow_control_info.suspend_or_etb_seq.chars, 1, 1))
 924    || unspec (substr (data_ptr -> output_flow_control_info.resume_or_ack_seq.chars, 1, 1))
 925    || data_ptr -> output_flow_control_info.block_acknowledge;
 926    opcode = output_fc_chars;
 927    end;
 928 
 929    else if order = "copy_meters"
 930    then do;
 931    opcode = report_meters;
 932    check = "1"b;
 933    end;
 934 
 935    else if order = "get_meters"
 936    then do;
 937    ret_meters_ptr = data_ptr -> get_comm_meters_info.parent_ptr;
 938    if ret_meters_ptr = null ()
 939    then return;
 940    else if ret_meters_ptr -> fnp_chan_meter_struc.version ^= FNP_CHANNEL_METERS_VERSION_1
 941    then do;
 942    a_code = error_table_$unimplemented_version;
 943    return;
 944    end;
 945 
 946    else get_meters = "1"b;
 947    end;
 948 
 949    else if order = "tandd_attach"
 950    then do;                                                 ** simulate a dialup without bothering the FNP (channel is hung up already) **
 951    call setup;
 952    if code ^= 0
 953    then do;
 954    a_code = code;
 955    return;
 956    end;
 957 
 958    if pcb.listen | pcb.dialed           ** can't have this **
 959    then do;
 960    call unlock;
 961    a_code = error_table_$resource_not_free ;
 962    return;
 963    end;
 964 
 965    pcb.dialed = "1"b;
 966    pcb.tandd_attached = "1"b;
 967    unspec (dialup_info) = ""b;
 968    dialup_info.baud_rate = BAUD_1200;             ** just so it's something **
 969    dialup_info.line_type = LINE_ASCII;  ** make everyone's life easier **
 970    dialup_info.max_buf_size = DIAL_BUF;           ** COLTS wants small buffers **
 971    call channel_manager$interrupt ((pcb.devx), DIALUP, unspec (dialup_info));
 972    call unlock;
 973    a_code = 0;
 974    return;
 975    end;
 976 
 977 
 978    **************************************************************** */
 979 
 980 
 981           else do;
 982 order_error:
 983                a_code = error_table_$undefined_order_request;
 984                return;
 985           end;
 986 
 987           code = 0;
 988           call setup;
 989           if code ^= 0
 990           then do;
 991                a_code = code;
 992                return;
 993           end;
 994 
 995           if opcode = disconnect_this_line                  /* hangup */
 996           then do;
 997                pcb.listen, pcb.tandd_attached = "0"b;
 998           end;
 999 
1000 
1001 /* ************************************************************************
1002 
1003    if opcode = start_negotiated_echo & (pcb.write_first ^= 0
1004    ** We have queued output **
1005    | pcb.output_mbx_pending)
1006    then do;                                                 ** The FNP has not take the mbx. **
1007    ** handler re-do it when he sees this. **
1008    call unlock;
1009    a_code = error_table_$invalid_write;
1010    return;
1011    end;
1012 
1013 
1014    ************************************************************** */
1015 
1016 
1017           if alter_type ^= -1                               /* alter_parameters required */
1018           then do;
1019                if alter_type = Listen
1020                then do;                                     /* need to tell it buffer size */
1021 
1022 /*                  alter_data = alter_data || fnp_buf_size ();  pour le dn 7100      */
1023 
1024                     pcb.listen = "1"b;
1025                end;
1026 
1027                mbx_data_len = length (alter_data) + 9;      /* 9 bits for subop type */
1028                mbx_data = bit (bin (alter_type, 9), 9) || alter_data;
1029                opcode = alter_parameters;
1030           end;
1031 
1032           if opcode ^= -1                                   /* we do have to send the FNP something */
1033           then do;
1034                if check                                     /* anything special about it */
1035                then do;
1036                     if opcode = set_line_type               /* make sure this is OK */
1037                     then if pcb.listen
1038                          then do;                           /* it isn't */
1039                               call unlock;
1040                               go to order_error;
1041                          end;
1042 
1043                          else do;
1044                               mbx_data = bit (bin (local_line_type, 18), 18);
1045                               do i = 1 to n_sync_line_types while (local_line_type ^= sync_line_type (i));
1046                               end;
1047 
1048                               pcb.sync_line = (i <= n_sync_line_types);
1049                               opcode = alter_parameters;
1050                          end;
1051 
1052 
1053 /* **************************************************************************
1054 
1055 
1056    else if opcode = dial                ** in this case we have to supply buffer size first **
1057    then do;                                       ** because no listen was done **
1058    mbx_data_len = 36;
1059    alter_data = bit (bin (Set_buffer_size, 9), 9) || "000000001"b;
1060    mbx_data = alter_data || fnp_buf_size ();
1061    call dn355$send_wcd (fnpp, pcbp, alter_parameters, mbx_data_len, mbx_data);
1062 
1063    mbx_data_len = phone_no_len;
1064    mbx_data_long = string (phone_digits);
1065    end;
1066    else if opcode = report_meters
1067    then do;
1068    call tty_space_man$get_space (size (fnp_channel_meters), meter_ptr);
1069    ** get a buffer for the FNP meters **
1070    if meter_ptr = null ()               ** couldn't get it **
1071    then do;
1072    call unlock;
1073    a_code = error_table_$noalloc;
1074    return;
1075    end;
1076 
1077    pcb.copied_meters_offset = bin (rel (meter_ptr), 18);
1078    mbx_data = bit (bin (tty_buf.absorig + pcb.copied_meters_offset, 18), 18);
1079    mbx_data_len = 18;
1080    end;
1081 
1082    ********************************************************************** */
1083 
1084 
1085                end;
1086                if opcode ^= alter_parameters
1087                then call uncp$send_wcd (fnpp, pcbp, opcode, mbx_data_len, mbx_data);
1088           end;
1089 
1090           else do;
1091 
1092 /*             if dumpin
1093    then call uncp$send_wcd (fnpp, pcbp, alter_parameters, 9, bit (bin (Dumpinput, 9), 9)); pour le dn 7100  */
1094 
1095                if dumpout
1096                then do;                                     /* first get rid of any ring 0 output */
1097                     if pcb.write_first ^= 0
1098                     then do;
1099                          call tty_space_man$free_chain ((pcb.devx), OUTPUT, ptr (ttybp, pcb.write_first));
1100                          pcb.write_first, pcb.write_last, pcb.write_cnt = 0;
1101                     end;
1102 
1103 
1104 /*                  call uncp$send_wcd (fnpp, pcbp, alter_parameters, 9, bit (bin (Dumpoutput, 9), 9));   pour le dn 7100     */
1105 
1106 
1107                     if pcb.end_frame
1108                     then do;
1109                          pcb.end_frame = "0"b;
1110                          if pcb.send_output
1111                          then call channel_manager$interrupt ((pcb.devx), SEND_OUTPUT, ""b);
1112                     end;
1113                end;
1114 
1115                if set_write_status
1116                then opend = (pcb.write_first ^= 0);         /* this has to be in automatic, return structure isn't wired */
1117 
1118 /* **************************************************************************
1119 
1120    if get_meters
1121    then do;
1122    call get_fnp_meters ("0"b);
1123    call unlock;
1124 
1125    if code = 0
1126    then ret_meters_ptr -> fnp_chan_meter_struc.synchronous = pcb.sync_line;
1127    if unspec (fnp_meters_ptr -> fnp_channel_meters) = "0"b
1128    then code = error_table_$no_channel_meters;
1129    else do;
1130    ret_meters_ptr -> fnp_chan_meter_struc.current_meters = fnp_meters_ptr -> fnp_channel_meters;
1131    ret_meters_ptr -> fnp_chan_meter_struc.saved_meters = pcb.saved_meters_ptr -> fnp_channel_meters;
1132 
1133    call tty_space_man$free_space (size (fnp_channel_meters), fnp_meters_ptr);
1134    end;
1135    end;
1136    ********************************************************************* */
1137           end;
1138 
1139           call unlock;
1140           if set_write_status
1141           then data_ptr -> wr_stat.output_pending = opend;
1142           a_code = code;
1143 
1144           return;
1145 ^L
1146 check_modes:
1147      entry (a_fnpp, a_subchan, a_mode_list_ptr, a_code);
1148 
1149 /* this entry is used to determine if this multiplexer understands or accepts a given set of modes */
1150 
1151           fnpp = a_fnpp;
1152           chanx = a_subchan;
1153           mclp = a_mode_list_ptr;
1154           if mcl.version ^= mcl_version_2
1155           then do;
1156                a_code = error_table_$unimplemented_version;
1157                return;
1158           end;
1159 
1160           call setup;                                       /* now we need PCB pointer */
1161           if code ^= 0
1162           then do;
1163                a_code = code;
1164                return;
1165           end;
1166 
1167           do modex = 1 to mcl.n_entries;
1168                mclep = addr (mcl.entries (modex));
1169 
1170                mode_name = substr (mcle.mode_name, 1, 8);
1171                mode_on = mcle.mode_switch;
1172 
1173                do i = 1 to hbound (good_modes, 1) while (mode_name ^= good_modes (i));
1174                end;
1175 
1176                if i <= hbound (good_modes, 1)               /* tree */
1177                                                             /* it's one of the ones we always recognize */
1178                then mcle.mpx_mode = "1"b;
1179                else do;
1180                     do i = 1 to hbound (async_only_modes, 1) while (mode_name ^= async_only_modes (i));
1181                     end;
1182 
1183                     if i > hbound (async_only_modes, 1)     /* we've never heard of this one at all */
1184                     then mcle.mpx_mode = "0"b;
1185                     else do;
1186                          mcle.mpx_mode = ^pcb.sync_line;    /* this mode is meaningful for asynchronous lines only */
1187 
1188                          do i = 1 to hbound (full_dpx_modes, 1) while (mode_name ^= full_dpx_modes (i));
1189                          end;
1190 
1191                          if (mode_name = "no_outp" | mode_name = "8bit" | mode_name = "oddp") & mode_on
1192                          then if ^pcb.is_hsla
1193                               then go to bad_mode;
1194 
1195                          if i <= hbound (full_dpx_modes, 1) /* if this was a mode requiring full duplex capability */
1196                          then if mode_on
1197                               then if pcb.line_type ^= LINE_ASCII & pcb.line_type ^= LINE_ASYNC1
1198                                         & pcb.line_type ^= LINE_ASYNC2 & pcb.line_type ^= LINE_ASYNC3
1199                                    then do;
1200 bad_mode:
1201                                         if mcle.force
1202                                         then mcle.mpx_mode = "0"b;
1203                                         else do;
1204                                              code = error_table_$bad_mode;
1205                                              mcle.error = "1"b;
1206                                         end;
1207                                    end;
1208 
1209                     end;
1210                end;
1211           end;
1212 
1213           call unlock;                                      /* setup locked */
1214           a_code = code;
1215           return;
1216 ^L
1217 set_modes:
1218      entry (a_fnpp, a_subchan, a_mode_list_ptr, a_code);
1219 
1220 /* this entry sets a specified set of mode (probably by calling uncp$send_wcd) */
1221 
1222           fnpp = a_fnpp;
1223           chanx = a_subchan;
1224           mclp = a_mode_list_ptr;
1225           if mcl.version ^= mcl_version_2
1226           then do;
1227                a_code = error_table_$unimplemented_version;
1228                return;
1229           end;
1230 
1231           call setup;
1232           if code ^= 0
1233           then do;
1234                a_code = code;
1235                return;
1236           end;
1237 
1238           hndlquit_set = "0"b;
1239           string (mode_set) = "0"b;                         /* nothing set yet */
1240 
1241           do modex = 1 to mcl.n_entries;
1242                mclep = addr (mcl.entries (modex));
1243                if mcle.mpx_mode                             /* if this is one we're interested in */
1244                then call process_mode (mcle.mode_name, mcle.mode_switch);
1245           end;
1246 
1247           if mcl.init
1248           then do;                                          /* if "init" we must turn off the ones that weren't mentioned */
1249                if ^hndlquit_set
1250                then call process_mode ("hndlquit", "0"b);
1251 
1252                do modex = 1 to hbound (async_only_modes, 1);
1253                     if ^mode_set (modex)
1254                     then call process_mode (async_only_modes (modex), "0"b);
1255                end;
1256           end;
1257 
1258           call unlock;
1259           a_code = code;
1260           return;
1261 
1262 
1263 
1264 get_modes:
1265      entry (a_fnpp, a_subchan, a_modes, a_code);
1266 
1267 /* this is a dummy, we don't keep records of modes at this level */
1268 
1269           a_modes = "";
1270           a_code = 0;
1271           return;
1272 ^L
1273 priv_control:
1274      entry (a_fnpp, a_order, a_data_ptr, a_code);
1275 
1276 /* entry for privileged global orders */
1277 
1278           fnpp = a_fnpp;
1279           order = a_order;
1280           data_ptr = a_data_ptr;
1281 
1282 
1283 /*  Supprimer pour DN_7100 *****************************************************
1284 
1285 
1286    if order = "dump_fnp"
1287    then do;
1288    call setup_fnp;
1289    if code ^= 0
1290    then do;
1291    a_code = code;
1292    return;
1293    end;
1294 
1295    locked = "0"b;
1296    call send_global (dump_mem);
1297    if code ^= 0
1298    then go to end_dump_mem;
1299 
1300    ** send_global will wait; come back here after notify **
1301 
1302    n_fnp_words = dump_fnp_info.fnp_len;
1303    dump_fnp_info.bufp -> fnp_data = fnp_dump_ptr -> fnp_data;
1304 
1305    end_dump_mem:
1306    if code ^= error_table_$timeout                          ** else we have to abandon the buffer **
1307    then call tty_space_man$free_space (dump_patch_space, fnp_dump_ptr);
1308    ** this was allocated by setup_fnp **
1309    ignore = stacq (fnp_info.dump_patch_lock, "0"b, pds$processid);
1310    end;
1311 
1312    else if order = "get_meters"
1313    then do;
1314    fnp_meterp = data_ptr -> get_comm_meters_info.subchan_ptr;
1315    if fnp_meterp ^= null
1316    then do;
1317    if fnp_meters.version ^= FNP_METERS_VERSION_1
1318    then code = error_table_$unimplemented_version;
1319    else do;
1320    ttybp = addr (tty_buf$);             ** we'll need this **
1321    call lock;
1322    call get_fnp_meters ("1"b);
1323 
1324    if code = 0
1325    then do;
1326    fnp_meters.n_channels = fnp_info.no_of_channels;
1327    fnp_meters.output_mbx_in_use_cum = fnp_info.cumulative_mbx_in_use;
1328    fnp_meters.output_mbx_updates = fnp_info.mbx_in_use_updated;
1329    fnp_meters.output_mbx_unavailable = fnp_info.mbx_unavailable;
1330    fnp_meters.max_output_mbx_in_use = fnp_info.max_mbx_in_use;
1331    fnp_meters.queue_entries_made = fnp_info.q_entries_made;
1332    fnp_meters.input_rejects = fnp_info.input_reject_count;
1333    fnp_meters.processed_from_q = fnp_info.processed_from_q;
1334    fnp_meters.fnp_channel_locked = fnp_info.fnp_channel_locked;
1335    fnp_meters.input_data_transactions = fnp_info.input_data_transactions;
1336    fnp_meters.output_data_transactions = fnp_info.output_data_transactions;
1337    fnp_meters.input_control_transactions = fnp_info.input_control_transactions;
1338    fnp_meters.output_control_transactions = fnp_info.output_control_transactions;
1339    fnp_meters.fnp_space_restricted_output = fnp_info.fnp_space_restricted_output;
1340    fnp_meters.fnp_mem_size = fnp_info.fnp_mem_size;
1341    fnp_meters.iom_number = fnp_info.iom_number;
1342    fnp_meters.iom_chan_no = fnp_info.iom_chan_no;
1343    end;
1344 
1345    call unlock;
1346    if unspec (fnp_meters_ptr -> fnp_global_meters) = "0"b
1347    then code = error_table_$no_channel_meters;
1348    else data_ptr -> get_comm_meters_info.subchan_ptr -> fnp_meters.from_fnp =
1349    fnp_meters_ptr -> fnp_global_meters;
1350 
1351    call tty_space_man$free_space (size (fnp_global_meters), fnp_meters_ptr);
1352 
1353    lctep = fnp_info.lcte_ptr; ** since we don't call channel_manager, **
1354    lcmp = data_ptr -> get_comm_meters_info.logical_chan_ptr;
1355    ** we have to copy logical channel data ourselves **
1356    if lcmp ^= null ()
1357    then do;
1358    lcmp -> logical_chan_meters.current_meters = lcte.meters;
1359    unspec (lcmp -> logical_chan_meters.saved_meters) = "0"b;
1360    ** no saved meters for an FNP **
1361    end;
1362    end;
1363    end;
1364    end;
1365 
1366    *********************************************************************** */
1367 
1368 
1369           code = error_table_$undefined_order_request;
1370 
1371           a_code = code;
1372           return;
1373 ^L
1374 hpriv_control:
1375      entry (a_fnpp, a_order, a_data_ptr, a_code);
1376 
1377 /* entry for highly-privileged global orders */
1378 
1379 dcl  1 arg_dump aligned based (data_ptr),
1380        2 seg_ptr ptr,
1381        2 uncp_no fixed bin,
1382        2 uncp_type fixed bin,
1383        2 uncp_mem_size fixed bin;
1384 
1385           fnpp = a_fnpp;
1386 
1387           order = a_order;
1388           data_ptr = a_data_ptr;
1389           locked = "0"b;
1390           code = 0;
1391 
1392 
1393           if order = "load"
1394           then call uncp_util$load ((fnp_info.fnp_number), data_ptr, code);
1395 
1396           else if order = "dump"
1397           then call uncp_util$fdump (arg_dump.uncp_no, arg_dump.uncp_type, arg_dump.uncp_mem_size, arg_dump.seg_ptr, code);
1398 
1399           else if order = "abort"
1400           then call uncp_util$abort ((fnp_info.fnp_number), code);
1401 
1402           else if order = "dial"
1403           then do;
1404                call lock;
1405                if code ^= 0
1406                then go to hpriv_exit;
1407                mbx_data = data_ptr -> based_bit72;
1408                call uncp$send_global_wcd (fnpp, dial, CHAR_72, mbx_data);
1409                call unlock;
1410                code = 0;
1411           end;
1412 
1413 
1414 
1415 /*      Supprimer pour le DN_7100 *******************************************
1416 
1417    if order = "patch_fnp"
1418    then do;
1419    call setup_fnp;
1420    if code ^= 0
1421    then do;
1422    a_code = code;
1423    return;
1424    end;
1425    n_fnp_words = dump_fnp_data.fnp_len;
1426    sourcep = dump_fnp_info.bufp;
1427 
1428    fnp_dump_ptr -> fnp_data = sourcep -> fnp_data;
1429    call syserr (LOG_AND_PRINT, "patching FNP ^a for ^a:", fnp_info.fnp_tag, pds$process_group_id);
1430    ** tell operator about it **
1431 
1432    temp_addr = dump_fnp_data.fnp_addr;
1433    do i = 1 to dump_fnp_data.fnp_len;
1434    call syserr (LOG_AND_PRINT, "^6w from ^6.3b to ^6.3b", temp_addr,
1435    dump_fnp_info.old_value_ptr -> fnp_data (i), dump_fnp_info.bufp -> fnp_data (i));
1436    temp_addr = temp_addr + 1;
1437    end;
1438 
1439    call send_global (patch_mem);                  ** send it off and wait **
1440    if code ^= error_table_$timeout                          ** else we have to abandon the buffer **
1441    then call tty_space_man$free_space (dump_patch_space, fnp_dump_ptr);
1442    ** this was allocated by setup_fnp **
1443    ignore = stacq (fnp_info.dump_patch_lock, "0"b, pds$processid);
1444    end;
1445 
1446    else if order = "fnp_break"
1447    then do;
1448    call setup_fnp;
1449    if code ^= 0
1450    then do;
1451    a_code = code;
1452    return;
1453    end;
1454    fnp_break_data.action = fnp_break_info.action;
1455    ** copy info **
1456    fnp_break_data.fnp_addr = fnp_break_info.fnp_addr;
1457    fnp_break_data.flags = substr (fnp_break_info.flags, 1, 18);
1458    name = fnp_break_info.chan_name;
1459    if name = ""
1460    then fnp_break_data.lineno = -1;               ** no line, i.e. any line **
1461    else do;
1462    call name_to_pcb (name);
1463    if code ^= 0
1464    then do;
1465    a_code = code;
1466    return;
1467    end;
1468    fnp_break_data.lineno = bin (string (pcb.line_number));
1469    end;
1470 
1471    mbx_data = addr (fnp_break_data) -> based_bit72;
1472    if ^locked
1473    then call lock;
1474    if code = 0
1475    then do;
1476    call dn355$send_global_wcd (fnpp, fnp_break, 72, mbx_data);
1477    call unlock;
1478    end;
1479    end;
1480 
1481    else if order = "enable_breakall_mode"
1482    then ;
1483 
1484    else if order = "disable_breakall_mode"
1485    then ;
1486 
1487    ******************************************************************** */
1488 
1489 
1490           else code = error_table_$undefined_order_request;
1491 
1492 hpriv_exit:
1493           a_code = code;
1494           return;
1495 ^L
1496 fnp_lock:
1497      entry (a_fnpp, a_code);                                /* Non-wired lock entry */
1498 
1499           fnpp = a_fnpp;
1500           call lock;
1501           a_code = code;
1502           return;
1503 
1504 fnp_unlock:
1505      entry (a_fnpp);
1506 
1507           fnpp = a_fnpp;
1508           mylock = "0"b;
1509           locked = "1"b;
1510           call unlock;
1511           return;
1512 ^L
1513 setup:
1514      proc;
1515 
1516 /* initial setup for per-channel stuff */
1517 
1518 
1519           code = 0;                                         /* innocent until proven guilty */
1520           ttybp = addr (tty_buf$);
1521           infop = addr (dn355_data$);
1522           locked, queue_locked = "0"b;
1523           call lock;
1524           if code ^= 0
1525           then return;
1526 
1527           if fnp_info.running
1528           then pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (chanx));
1529           else do;
1530                call unlock;
1531                code = error_table_$fnp_down;
1532                return;
1533           end;
1534 
1535           if pcb.copied_meters_ready                        /* dn355 left them for us */
1536           then if ^lcte.locked_for_interrupt                /* make sure we're on call side */
1537                then call save_copied_meters;
1538 
1539           return;
1540      end setup;
1541 
1542 /*   Supprimer pour l Datanet 7100.   *****************************************
1543 
1544    setup_fnp:
1545    proc;
1546 
1547    dcl  (fnp_address, fnp_len) fixed bin;
1548 
1549    [* this procedure is used instead of setup for privileged global orders *]
1550 
1551    if fnpp = null ()
1552    then go to setup_fnp_down;
1553    code = 0;
1554    if fnp_info.mbx_pt = null ()                             [* this one isn't configured *]
1555    | ^fnp_info.running                            [* or it isn't up *]
1556    then do;
1557    setup_fnp_down:
1558    code = error_table_$fnp_down;
1559    return;
1560    end;
1561 
1562    ttybp = addr (tty_buf$);
1563 
1564    if order = "fnp_break"
1565    then return;                                   [* done if break order *]
1566    if fnp_info.dump_patch_disabled
1567    then do;
1568    code = error_table_$timeout;
1569    return;
1570    end;
1571 
1572    fnp_address = dump_fnp_info.fnp_address;
1573    fnp_len = dump_fnp_info.fnp_len;
1574    if order = "dump_fnp"
1575    then do;                                                 [* check dump params *]
1576    if fnp_len <= 0 | fnp_len > 64
1577    then do;
1578    bad_fnp_len:
1579    code = error_table_$buffer_big;
1580    return;
1581    end;
1582    end;
1583    else if order = "patch_fnp"
1584    then if fnp_len <= 0 | fnp_len > 32
1585    then go to bad_fnp_len;
1586 
1587    if (fnp_address < 0) | ((fnp_address + fnp_len) > fnp_info.fnp_mem_size)
1588    then do;
1589    code = error_table_$dev_offset_out_of_bounds;
1590    return;
1591    end;
1592 
1593    if ^stac (addr (fnp_info.dump_patch_lock), pds$processid)
1594    [* lock the dump_patch function *]
1595    then do;                                                 [* if possible *]
1596    code = error_table_$seglock;
1597    return;
1598    end;
1599 
1600    dump_patch_space = divide (fnp_len + 1, 2, 17, 0);
1601    call tty_space_man$get_space (dump_patch_space, fnp_dump_ptr);
1602    if fnp_dump_ptr = null                         [* couldn't get the space *]
1603    then do;
1604    code = error_table_$noalloc;
1605    ignore = stacq (fnp_info.dump_patch_lock, "0"b, pds$processid);
1606    return;
1607    end;
1608 
1609    dump_patch_time = clock ();
1610    fnp_info.dump_patch_in_progress = "1"b;
1611    dump_fnp_data.abs_addr = bin (rel (fnp_dump_ptr)) + tty_buf.absorig;
1612    dump_fnp_data.fnp_addr = fnp_address;
1613    dump_fnp_data.fnp_len = fnp_len;
1614    return;
1615 
1616    end setup_fnp;
1617    **************************************************************** */
1618 ^L
1619 save_copied_meters:
1620      proc;
1621 
1622 /* internal procedure called  to pick up copied meters left in tty_buf by FNP */
1623 
1624 dcl  copied_meters_ptr ptr;
1625 
1626           if pcb.copied_meters_offset ^= 0                  /* make sure it's legit */
1627           then do;
1628                copied_meters_ptr = ptr (ttybp, pcb.copied_meters_offset);
1629 
1630 /* zero out pad fields, which contain random junk (possibly input) from the FNP */
1631 
1632                if pcb.sync_line
1633                then copied_meters_ptr -> fnp_sync_meters.pad (*) = 0;
1634                else copied_meters_ptr -> fnp_async_meters.pad (*) = 0;
1635                pcb.saved_meters_ptr -> fnp_channel_meters = copied_meters_ptr -> fnp_channel_meters;
1636                call tty_space_man$free_space (size (fnp_channel_meters), copied_meters_ptr);
1637                                                             /* through with buffer now */
1638                pcb.copied_meters_offset = 0;
1639                pcb.copied_meters_ready = "0"b;
1640           end;
1641 
1642           return;
1643      end save_copied_meters;
1644 ^L
1645 process_mode:
1646      proc (mode_name, mode_on);
1647 
1648 dcl  mode_name char (*);
1649 dcl  mode_on bit (1);
1650 dcl  mode_name_index fixed bin;
1651 
1652           alter_data = "00000000"b || mode_on;
1653 
1654           if mode_name = "hndlquit"
1655           then do;
1656                alter_type = Hndlquit;
1657                pcb.hndlquit = mode_on;
1658                hndlquit_set = "1"b;
1659           end;
1660 
1661           else if mode_name = "breakall"
1662           then do;
1663                alter_type = Breakall;
1664                pcb.extra_nl = ^mode_on;
1665           end;
1666 
1667           else if ^pcb.sync_line                            /* if we haven't already decided what to do */
1668           then do;
1669                if mode_name = "blk_xfer" | mode_name = "iflow"
1670                                                             /* special stuff here */
1671                then do;
1672                     if mode_name = "blk_xfer"
1673                     then do;
1674                          mode_name_index = BLK_XFER_INDEX;
1675                          alter_type = Block_xfer;
1676                     end;
1677                     else do;
1678                          mode_name_index = IFLOW_INDEX;
1679                          alter_type = Input_flow_control;
1680                     end;
1681 
1682                     if mode_on
1683                     then do;                                /* we have to tell it buffer sizes */
1684                          chars_per_sec = divide (pcb.baud_rate, 10, 17, 0);
1685                          base_len, block_len = divide (chars_per_sec, buf_per_second, 17, 0);
1686                                                             /* and 1/2 second thereafter */
1687                     end;
1688                     else do;
1689                          base_len = BASE_LTH;
1690                          block_len = 0;
1691                     end;
1692 
1693                     alter_data = alter_data || bit (bin (base_len, 18), 18) || bit (bin (block_len, 18), 18);
1694                     mode_set (mode_name_index) = "1"b;
1695                end;
1696 
1697                else do;
1698                     do i = 1 to hbound (mode_alter_types, 1) while (mode_name ^= async_only_modes (i));
1699                     end;                                    /* note that blk_xfer is the last async_mode */
1700 
1701                     if i > hbound (mode_alter_types, 1)
1702                     then code = error_table_$bad_mode;
1703 
1704                     else do;
1705                          alter_type = mode_alter_types (i);
1706                          mode_set (i) = "1"b;               /* this one is set now */
1707                     end;
1708                end;
1709           end;
1710 
1711           if code = 0
1712           then do;
1713                mbx_data = bit (bin (alter_type, 9), 9) || alter_data;
1714 
1715 /*   ajouter pour le Datanet 7100       */
1716 
1717                if alter_type = Lfecho
1718                then pcb.lfecho = mode_on;
1719 
1720                if alter_type = Fullduplex & mode_on = "0"b
1721                then code = error_table_$action_not_performed;
1722 
1723 /*   fin  d insertion        */
1724 
1725 /*             call uncp$send_wcd (fnpp, pcbp, alter_parameters, length (alter_data) + 9, mbx_data);    */
1726           end;
1727           return;
1728      end;
1729 ^L
1730 /*     Supprimer pour le Datanet 7100   *************************************************
1731 
1732 
1733    send_global:
1734    proc (opcode);
1735 
1736    [* this procedure calls dn355$send_global_wcd for the dump_fnp and patch_fnp orders *]
1737 
1738    dcl  opcode fixed bin (8);
1739 
1740    call pxss$addevent (FNP_DUMP_PATCH_EVENT);     [* so we'll be able to wait *]
1741    mbx_data = addr (dump_fnp_data) -> based_bit72;
1742    call lock;
1743    if code ^= 0
1744    then return;
1745 
1746    call uncp$send_global_wcd (fnpp, opcode, 72, mbx_data);
1747    call unlock;
1748 
1749    call pxss$wait;                                [* mustn't do anything till it's done *]
1750 
1751    do while (fnp_info.dump_patch_in_progress);    [* didn't complete yet *]
1752    if ^fnp_info.running                           [* FNP crashed out from under us *]
1753    then code = error_table_$fnp_down;
1754 
1755    else if clock () - dump_patch_time > DUMP_PATCH_LIMIT
1756    [* time's up! *]
1757    then do;
1758    code = error_table_$timeout;                             [* can this operation *]
1759    fnp_info.dump_patch_disabled = "1"b;
1760    fnp_info.dump_patch_in_progress = "0"b;
1761    call syserr (LOG_AND_PRINT, "fnp_multiplexer: ^[dump^;patch^]_fnp order to FNP ^a timed out.",
1762    opcode = dump_mem, fnp_info.fnp_tag);
1763    end;
1764 
1765    else do;                                       [* must be someone else's notify *]
1766    call pxss$addevent (FNP_DUMP_PATCH_EVENT);
1767    if fnp_info.dump_patch_in_progress   [* make sure it still hasn't happened *]
1768    then call pxss$wait;
1769    else call pxss$delevent (FNP_DUMP_PATCH_EVENT);
1770    [* never mind, it's done *]
1771    end;
1772 
1773    end;
1774 
1775    return;                                                  [* all right, we're done *]
1776 
1777    end send_global;
1778 
1779 
1780 ^L
1781    get_fnp_meters:
1782    proc (global);
1783 
1784    [* subroutine to issue request for meters from FNP and wait for them to arrive *]
1785 
1786    dcl  global bit (1) parameter;                           [* indicates whether subchannel or whole FNP *]
1787    dcl  space_size fixed bin;
1788    dcl  fnp_meter_wait_start fixed bin (71);
1789 
1790    if fnp_info.dump_patch_disabled
1791    then do;
1792    code = error_table_$timeout;                             [* don't even try *]
1793    return;
1794    end;
1795 
1796    if global
1797    then space_size = size (fnp_global_meters);
1798    else space_size = size (fnp_channel_meters);
1799 
1800    call tty_space_man$get_space (space_size, fnp_meters_ptr);
1801    if fnp_meters_ptr = null ()
1802    then do;
1803    code = error_table_$noalloc;
1804    return;
1805    end;
1806 
1807    mbx_data = bit (bin (tty_buf.absorig + bin (rel (fnp_meters_ptr)), 18), 18);
1808    call pxss$addevent (FNP_METER_EVENT);
1809    fnp_meter_wait_start = clock ();
1810 
1811    if global                                                [* it's for whole FNP *]
1812    then do;
1813    if fnp_info.get_meters_waiting
1814    then do;
1815    code = error_table_$seglock;                             [* can't have two going at once *]
1816    return;
1817    end;
1818 
1819    fnp_info.get_meters_waiting = "1"b;
1820    call dn355$send_global_wcd (fnpp, report_meters, 18, mbx_data);
1821    pcbp = fnpp;                                   [* to avoid faults in loop test *]
1822    end;
1823 
1824    else do;
1825    pcb.get_meters_waiting = "1"b;
1826    call dn355$send_wcd (fnpp, pcbp, report_meters, 18, mbx_data);
1827    end;
1828 
1829    call unlock;                                   [* while waiting *]
1830    call pxss$wait;
1831    call lock;                                     [* while checking *]
1832 
1833    do while ((global & fnp_info.get_meters_waiting) | (^global & pcb.get_meters_waiting));
1834    if ^fnp_info.running
1835    then do;
1836    code = error_table_$fnp_down;
1837    go to abort_get_meters;
1838    end;
1839 
1840    else if clock () - fnp_meter_wait_start > DUMP_PATCH_LIMIT
1841    then do;
1842    code = error_table_$timeout;
1843    fnp_info.dump_patch_disabled = "1"b;
1844    call syserr (LOG_AND_PRINT,
1845    "fnp_multiplexer: get_meters order for FNP ^a^[^s^;, line ^o,^] timed out.", fnp_info.fnp_tag,
1846    global, string (pcb.line_number));
1847    abort_get_meters:
1848    if global
1849    then fnp_info.get_meters_waiting = "0"b;
1850    else pcb.get_meters_waiting = "0"b;
1851    end;
1852 
1853    else do;
1854    call unlock;                         [* in case we wait some more *]
1855    call pxss$addevent (FNP_METER_EVENT);
1856    if (global & fnp_info.get_meters_waiting) | (^global & pcb.get_meters_waiting)
1857    [* check if it happened since we checked *]
1858    then call pxss$wait;
1859    else call pxss$delevent (FNP_METER_EVENT);
1860    call lock;
1861    end;
1862    end;
1863 
1864    return;
1865    end get_fnp_meters;
1866    ******************************************************************* */
1867 ^L
1868 /* Supprimer pour le datanet 7100. ******************************************************************
1869 
1870    name_to_pcb:
1871    proc (name);
1872 
1873    dcl  name char (*);
1874 
1875    code = 0;
1876    call parse_tty_name_ (name, his_fnp_no, hsla_flag, la_no, subchan);
1877    call lock;
1878    if code ^= 0
1879    then return;
1880 
1881    if his_fnp_no ^= fnp_info.fnp_number
1882    then go to bad_device;
1883 
1884    if hsla_flag
1885    then pcbx = fnp_info.hsla_idx (la_no);
1886    else pcbx = fnp_info.lsla_idx (la_no);
1887    if pcbx = -1
1888    then go to bad_device;
1889 
1890    found, past = "0"b;
1891    do j = pcbx to fnp_info.no_of_channels while (^past & ^found);
1892    pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (j));
1893    if pcb.la_no ^= bit (bin (la_no, 3), 3)
1894    then past = "1"b;
1895    else if pcb.slot_no = bit (bin (subchan, 6), 6)
1896    then found = "1"b;
1897    end;
1898 
1899    if ^found
1900    then do;
1901    bad_device:
1902    call unlock;
1903    code = error_table_$bad_channel;
1904    return;
1905    end;
1906 
1907    return;
1908    end name_to_pcb;
1909    ************************************************************************ */
1910 ^L
1911 lock:
1912      proc;
1913 
1914 /* subroutine to lock the mailbox lock (which incidentally protects PCBs too) */
1915 
1916           if fnpp = null ()
1917           then do;
1918                code = error_table_$fnp_down;
1919                return;
1920           end;
1921 
1922           code = 0;
1923 
1924           lctep = fnp_info.lcte_ptr;
1925 
1926           if lcte.lock = pds$processid                      /* called as result of our own interrupt? */
1927           then if lcte.locked_for_interrupt
1928                then mylock = "1"b;                          /* remember not to unlock it */
1929                else call syserr (CRASH_SYSTEM, "uncp_multiplexer: mylock error");
1930           else do;
1931                mylock = "0"b;
1932                call tty_lock$lock_lcte (lctep, code);
1933                locked = (code = 0);
1934           end;
1935 
1936 
1937           return;
1938      end lock;
1939 
1940 
1941 
1942 unlock:
1943      proc;
1944 
1945 /* subroutine to release mailbox lock and process queued interrupts */
1946 
1947           if locked
1948           then if ^mylock
1949                then do;
1950 
1951                     call uncp$process_interrupt_queue ((fnp_info.fnp_number));
1952                     locked = "0"b;                          /* it unlocks the channel lock when it's done */
1953 
1954                end;
1955           return;
1956 
1957      end unlock;
1958 ^L
1959 /*   Supprimer pour le Datanet 7100. ***********************************************
1960 
1961    fnp_buf_size:
1962    proc returns (bit (18));
1963 
1964    [* internal procedure returns correct buffer size for FNP to use, based on baud rate
1965    *  and synchronous/asynchronous
1966    *]
1967 
1968    do i = 1 to n_sync_line_types while (pcb.line_type ^= sync_line_type (i));
1969    end;
1970 
1971    if i <= n_sync_line_types
1972    then do;
1973    pcb.sync_line = "1"b;
1974    chars_per_buf = divide (divide (pcb.baud_rate, 8, 17, 0), buf_per_second, 17, 0);
1975    end;
1976 
1977    else do;
1978    pcb.sync_line = "0"b;
1979    chars_per_buf = BASE_LTH;                      [* always minimum for asynchronous *]
1980    end;
1981 
1982    return (bit (bin (chars_per_buf, 18), 18));
1983    end fnp_buf_size;
1984    ******************************************************************************** */
1985 
1986 /**** Wired entrypoints to talk to io_manager for both fnp_multiplexer
1987       and the fnp_util TandD code. These should be called under
1988       the FNP lcte lock. */
1989 
1990 declare  a_fnp_no fixed bin;
1991 declare  fnp_no fixed bin;
1992 
1993 assign:
1994      entry (a_fnp_no, a_code);
1995 
1996           infop = addr (dn355_data$);
1997           call TRACE ("assign");
1998           fnp_no = a_fnp_no;
1999           fnpp = addr (datanet_info.per_datanet (fnp_no));
2000           call assign_channel (code);
2001           a_code = code;
2002           return;
2003 ^L
2004 
2005 unassign:
2006      entry (a_fnp_no, a_code);
2007 
2008           fnp_no = a_fnp_no;
2009           infop = addr (dn355_data$);
2010           call TRACE ("unassign");
2011           fnpp = addr (datanet_info.per_datanet (fnp_no));
2012 
2013           call unassign_channel (code);
2014           a_code = code;
2015           return;
2016 
2017 
2018 assign_channel:
2019      procedure (code);
2020 declare  code fixed bin (35);
2021 
2022           code = 0;
2023           if ^fnp_info.available
2024           then do;
2025                code = error_table_$io_not_configured;       /* "not available" */
2026                go to assign_channel_return;
2027           end;
2028 
2029           if fnp_info.io_manager_assigned
2030           then do;
2031                code = error_table_$io_assigned;
2032                go to assign_channel_return;
2033           end;
2034 
2035           call io_manager$assign (fnp_info.io_manager_chx, fnp_info.io_chanid, uncp$interrupt, (fnp_info.fnp_number),
2036                (null ()), code);
2037           fnp_info.io_manager_assigned = (code = 0);
2038 assign_channel_return:
2039           if datanet_info.trace | datanet_info.debug_stop
2040           then call syserr (ANNOUNCE, "uncp_multiplexer$assign_channel: Assignment of FNP ^a ^[succeeded^;failed^].",
2041                     fnp_info.fnp_tag, (code = 0));
2042           if code ^= 0
2043           then call TRACE_ERROR ("assign_channel", code);
2044           return;
2045      end assign_channel;
2046 
2047 unassign_channel:
2048      procedure (code);
2049 declare  code fixed bin (35);
2050 
2051 
2052           if ^fnp_info.io_manager_assigned
2053           then do;
2054                code = error_table_$io_not_assigned;
2055                go to unassign_return;
2056           end;
2057           call io_manager$unassign (fnp_info.io_manager_chx, code);
2058           if code = 0
2059           then fnp_info.io_manager_assigned = "0"b;
2060 unassign_return:
2061           if datanet_info.trace | datanet_info.debug_stop
2062           then call syserr$error_code (ANNOUNCE, code,
2063                     "uncp_multiplexer$unassign_channel: Unassignment of FNP ^a ^[failed^;succeeded^].", fnp_info.fnp_tag,
2064                     (code ^= 0));
2065           if code ^= 0
2066           then call TRACE_ERROR ("unassign_channel", code);
2067           return;
2068      end unassign_channel;
2069 
2070 TRACE:
2071      procedure (Entry);
2072 
2073 declare  Entry char (32);
2074 
2075           if datanet_info.trace
2076           then call syserr (ANNOUNCE, "uncp_multiplexer$^a: Tracing call.", Entry);
2077           return;
2078 
2079 
2080 
2081 TRACE_ERROR:
2082      entry (Entry, Code);
2083 
2084 declare  Code fixed bin (35);
2085 
2086           if datanet_info.trace | datanet_info.debug_stop
2087           then call syserr$error_code (ANNOUNCE, Code, "uncp_multiplexer$^a: Tracing error.", Entry);
2088           if datanet_info.debug_stop
2089           then call syserr (CRASH_SYSTEM, "uncp_multiplexer: debugging stop (type go to continue).");
2090           return;
2091      end TRACE;
2092 ^L
2093 /* Begin message documentation invisible
2094 
2095    This message doc is classed "invisible" so it will not be added to the
2096    message documentation distribution for a software release.  The DSA login
2097    code will not be shipped.
2098 
2099 
2100    Message:
2101    patching FNP X for USER:
2102    ADDR from XXX to YYY
2103 
2104    S:     $info
2105 
2106    T:     $run
2107 
2108    M:     The memory of FNP X is being patched by the privileged
2109    user whose user_id is USER. ADDR is the absolute location in FNP memory that is being
2110    patched (in octal); XXX and YYY are the old and new values of the location
2111    respectively (also in octal).
2112    The second line may be repeated (with different values) if more than one word
2113    is being patched.
2114 
2115    A:     This information is for logging purposes.
2116 
2117 
2118    Message:
2119    uncp_multiplexer: mylock error
2120 
2121    S:     $crash
2122 
2123    T:     $run
2124 
2125    M:     An attempt has been made to lock an FNP channel lock to a process
2126    that already has it locked.
2127 
2128    A:     $inform
2129 
2130 
2131    Message:
2132    uncp_multiplexer: lock ^= processid
2133 
2134    S:     $crash
2135 
2136    T:     $run
2137 
2138    M:     An attempt has been made to unlock an FNP channel lock when it was
2139    locked to some other process.
2140 
2141    A:     $inform
2142 
2143    Message:
2144    uncp_multiplexer: attempted crawlout with FNP channel lock set
2145 
2146    S:     $crash
2147 
2148    T:     $run
2149 
2150    M:     An attempt was made to crawl out while an FNP channel
2151    lock (a processor lock) was locked.
2152 
2153    A:     $inform
2154 
2155    Message:
2156    uncp_multiplexer: NAME order to FNP X timed out.
2157 
2158    S:     $info
2159 
2160    T:     $run
2161 
2162    M:     NAME is "dump_fnp" or "patch_fnp". The named order to FNP X failed to
2163    complete within 30 seconds. The buffer space associated with the order has
2164    been abandoned, and dump and patch orders to that FNP are disabled until the
2165    the FNP is reloaded.
2166 
2167    A:     $inform
2168 
2169    End message documentation invisible */
2170 
2171 
2172 
2173      end uncp_multiplexer;