1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Bull Inc., 1987                *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   6         *                                                         *
   7         * Copyright (c) 1972 by Massachusetts Institute of        *
   8         * Technology and Honeywell Information Systems, Inc.      *
   9         *                                                         *
  10         *********************************************************** */
  11 
  12 
  13 
  14 
  15 /****^  HISTORY COMMENTS:
  16   1) change(88-06-20,Berno), approve(88-07-13,MCR7928),
  17      audit(88-06-20,Parisek), install(88-07-19,MR12.2-1061):
  18      Removed reference to wtcb.prompt_len and "enter_receive" order call as
  19      part of the UNCP multiplexer (DSA gateway) implementation.
  20                                                    END HISTORY COMMENTS */
  21 
  22 
  23 /* format: style4,delnl,insnl,^ifthendo */
  24 tty_read:
  25      proc (twx, a_readp, a_offset, a_nelem, a_nelemt, state, ercode);
  26                                                             /* to convert from read chain */
  27 
  28 /* Read portion of the ring 0 ttydim
  29    Rewritten by Robert S. Coren, 2/12/76
  30    Modified 04/22/77 by J. Stern to introduce TCBs and WTCBs
  31    Modified 12/29/77 by Robert Coren to use tty_space_man
  32    Modified 05/05/78 by Robert Coren to add get_line entry
  33    Modified August 78 by J. Nicholls to use channel_manager$ to get data to process for multiplexer implementation
  34    Modified June 29 1979 by B. Greenberg for Multiplexer-Echo Negotiation.
  35    Modified 18 September 1980 by G. Palter to fix MCS bug #203
  36    Modified: 11 November 1980 by G. Palter to support can_type mode
  37    Modified February 1981 by Robert Coren to add read_with_mark entry
  38    Modified May 1981 by J. Bongiovanni for response time metering
  39    Modified May 1981 by Robert Coren to make sure fblock and lblock always consistent
  40    Modified 19 March 1982 by W. York to add tty_read_echoed entry as replacement
  41    for echo_negotiate_get_chars, and fix bug in mark handling in
  42    procedure get_more_data.
  43    Modified November 1982 by Robert Coren to return wtcb.error_code.
  44    Report on June 83 - modifications for the Datanet 7100.fd
  45    Date of the last modification 04/17/84 */
  46 
  47 /* PARAMETERS */
  48 
  49 dcl  twx fixed bin;                                         /* device index */
  50 dcl  a_readp ptr;                                           /* pointer to caller's buffer */
  51 dcl  a_offset fixed bin (24);                               /* offset in buffer to start at */
  52 dcl  a_buffer char (*);                                     /* caller's buffer (used by read_with_mark entry) */
  53 dcl  a_nelem fixed bin (24);                                /* maximum number of chars to return */
  54 dcl  a_nelemt fixed bin (24);                               /* actual number of characters returned */
  55                                                             /* (OUTPUT) */
  56 dcl  a_screen_left fixed bin;                               /* Space left on line, negotiate entry */
  57 dcl  a_echoed fixed bin (24);                               /* Chars echoed by interrupt side */
  58                                                             /* (OUTPUT) */
  59 dcl  nl_found bit (1);                                      /* whether get_line found newline (OUTPUT) */
  60 dcl  a_mark_index fixed bin (21);                           /* index in returned string of "mark" (OUTPUT) */
  61 dcl  state fixed bin;                                       /* current state of channel (OUTPUT) */
  62 dcl  ercode fixed bin (35);                                 /* status code (OUTPUT) */
  63 
  64 
  65 /* AUTOMATIC */
  66 
  67 dcl  devx fixed bin;                                        /* local copy of twx */
  68 dcl  output_ptr ptr;                                        /*  "      "   " readp */
  69 dcl  offset fixed bin (24);                                 /*  "      "   " a_offset */
  70 dcl  nelem fixed bin (24);                                  /*  "      "   " a_nelem */
  71 dcl  nelemt fixed bin (24);                                 /*  "      "   " a_nelemt */
  72 dcl  echoed fixed bin (24);                                 /*  "      "   " a_echoed */
  73 dcl  screen_left fixed bin;                                 /*  "      "   " a_screen_left */
  74 
  75 dcl  ttytp ptr;                                             /* pointer to tty_tables segment */
  76 dcl  special_ptr ptr;
  77 dcl  mvtp ptr;
  78 dcl  tctp ptr;
  79 dcl  get_line_entry bit (1);                                /* "1"b if get_line entry called, otherwise "0"b */
  80 dcl  negotiate_entry bit (1);                               /* "1"b if negotiate entry called, otherwise "0"b */
  81 dcl  obsolete_negotiate_entry bit (1);                      /* "1"b if echo_negotaite_get_chars, otherwise tty_read_echoed */
  82 dcl  mark_entry bit (1);                                    /* "1"b if read_with_mark entry called, otherwise "0"b */
  83 dcl  break_found bit (1);
  84 dcl  convert bit (1);                                       /* used to indicate copying from converted buffers */
  85 dcl  throw_away bit (1);                                    /* indicates last char was hardware esc */
  86 dcl  have_more_data bit (1) aligned;                        /* lower level mux has another buffer chain he didnt give us this time */
  87 dcl  unconverted_break bit (1);
  88 dcl  no_break_anywhere bit (1);                             /* no break anywhere in current input chain */
  89 dcl  orig_output_ptr ptr;                                   /* first set value of output_ptr */
  90 dcl  source_ptr ptr;
  91 dcl  target_ptr ptr;
  92 dcl  old_sourcep ptr;
  93 dcl  old_targetp ptr;
  94 dcl  source_len fixed bin;
  95 dcl  target_len fixed bin;
  96 
  97 dcl  new_blockp ptr;
  98 dcl  data_ptr ptr;
  99 dcl  new_block fixed bin (18);
 100 dcl  room_left fixed bin;
 101 dcl  first_char fixed bin;
 102 dcl  old_fblock fixed bin (18);
 103 dcl  last_block fixed bin (18);
 104 dcl  new_tally fixed bin;
 105 dcl  temp_buf char (60) aligned;                            /* automatic copy of data from tty buffer */
 106 dcl  orig_fchar fixed bin;
 107 dcl  mark_index fixed bin;
 108 dcl  pmark_index fixed bin;                                 /* mark index used for preconverted input */
 109 
 110 dcl  time_spent fixed bin (71);
 111 dcl  start_time fixed bin (71);                             /* clock time at entry */
 112 dcl  max_len fixed bin;
 113 dcl  break char (1);                                        /* break character from device_defaults */
 114 dcl  chars_in_buf fixed bin;
 115 dcl  next_break fixed bin;
 116 
 117 dcl  xr fixed bin;                                          /* used for result of index builtin */
 118 dcl  can_called bit (1);                                    /* indicates whether canon_procedure called */
 119 dcl  canon_procedure variable
 120           entry (pointer, fixed binary, fixed binary, character (1) aligned, character (1) aligned, fixed binary (35));
 121 dcl  code fixed bin (35);
 122 
 123 dcl  tempp ptr;
 124 
 125 dcl  kill_char char (1) aligned;
 126 dcl  erase_char char (1) aligned;
 127 dcl  bx fixed bin;                                          /* used in verify of white space */
 128 dcl  i fixed bin;                                           /* temporary work variable */
 129 dcl  next_char char (1) aligned;
 130 dcl  uncp_flag bit (1);                                     /* designate UNCP mpx */
 131 
 132 dcl  1 octal aligned,
 133        2 pad bit (27) unal,
 134        2 result fixed bin (8) unal;                         /* so arithmetic value can be easily addressed as char */
 135 
 136 dcl  1 echo_start_data aligned,
 137        2 ctr fixed bin (35),
 138        2 screenleft fixed bin (35);
 139 
 140 dcl  digit fixed bin;
 141 dcl  rawcnt fixed bin;
 142 dcl  old_rawcnt fixed bin;
 143 dcl  raw_mode bit (1);
 144 
 145 dcl  1 util aligned,                                        /* structure passed to tty_util_$tct */
 146                                                             /* first 3 items in this structure are */
 147                                                             /* also used as general automatic variables */
 148        2 stringp ptr,
 149        2 stringl fixed bin,
 150        2 ctally fixed bin,
 151        2 tablep ptr,
 152        2 indicator fixed bin,
 153        2 pad (3) fixed bin;                                 /* workspace for tty_util_ */
 154 
 155 dcl  buffer_1 char (720) aligned;
 156 dcl  buffer_2 char (720) aligned;
 157 ^K
 158 /* INTERNAL STATIC CONSTANTS */
 159 
 160 dcl  crash fixed bin int static options (constant) init (1);/* for crashing system with syserr */
 161 dcl  BSIZE fixed bin int static options (constant) init (16);
 162                                                             /* word size for preconverted buffers */
 163 dcl  BREAK_CHAR fixed bin int static options (constant) init (1);
 164 dcl  ESCAPE_CHAR fixed bin int static options (constant) init (2);
 165 dcl  THROW_AWAY fixed bin int static options (constant) init (3);
 166 dcl  FORM_FEED fixed bin int static options (constant) init (4);
 167 dcl  HARDWARE_CONTROL fixed bin int static options (constant) init (5);
 168 dcl  DIALED_UP fixed bin int static options (constant) init (5);
 169 
 170 /* various strange-looking character strings */
 171 
 172 dcl  left_motion char (2) aligned int static options (constant) init ("^H^M");
 173                                                             /* BS, CR */
 174 
 175 dcl  right_motion char (2) aligned int static options (constant) init ("         ");
 176                                                             /* HT, SP */
 177 
 178 dcl  vertical_motion char (2) aligned int static options (constant) init
 179                                                             /* FF, VT */
 180           ("^L^K");
 181 
 182 dcl  all_white char (6) aligned int static options (constant) init
 183                                                             /* NUL, BS, HT, NL, CR, SP */
 184           ("^@^H
 185 ^M ");
 186 
 187 dcl  nl char (1) aligned int static options (constant) init ("
 188 ");                                                         /* NL */
 189 
 190 dcl  bs char (1) aligned int static options (constant) init ("^H");
 191                                                             /* BS */
 192 
 193 dcl  nul_char char (1) aligned int static options (constant) init ("^@");
 194                                                             /* NUL */
 195 
 196 dcl  no_control_input (16) bit (1) int static options (constant) init ("0"b, (2) (1)"1"b, (13) (1)"0"b);
 197 
 198 dcl  nocontrol (128) bit (9) int static options (constant)
 199           init ("000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "010"b3, "011"b3, "012"b3,
 200           "013"b3, "014"b3, "015"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3, "000"b3,
 201           "000"b3, "000"b3, "000"b3, "000"b3, "033"b3, "000"b3, "000"b3, "000"b3, "000"b3, "040"b3, "041"b3, "042"b3,
 202           "043"b3, "044"b3, "045"b3, "046"b3, "047"b3, "050"b3, "051"b3, "052"b3, "053"b3, "054"b3, "055"b3, "056"b3,
 203           "057"b3, "060"b3, "061"b3, "062"b3, "063"b3, "064"b3, "065"b3, "066"b3, "067"b3, "070"b3, "071"b3, "072"b3,
 204           "073"b3, "074"b3, "075"b3, "076"b3, "077"b3, "100"b3, "101"b3, "102"b3, "103"b3, "104"b3, "105"b3, "106"b3,
 205           "107"b3, "110"b3, "111"b3, "112"b3, "113"b3, "114"b3, "115"b3, "116"b3, "117"b3, "120"b3, "121"b3, "122"b3,
 206           "123"b3, "124"b3, "125"b3, "126"b3, "127"b3, "130"b3, "131"b3, "132"b3, "133"b3, "134"b3, "135"b3, "136"b3,
 207           "137"b3, "140"b3, "141"b3, "142"b3, "143"b3, "144"b3, "145"b3, "146"b3, "147"b3, "150"b3, "151"b3, "152"b3,
 208           "153"b3, "154"b3, "155"b3, "156"b3, "157"b3, "160"b3, "161"b3, "162"b3, "163"b3, "164"b3, "165"b3, "166"b3,
 209           "167"b3, "170"b3, "171"b3, "172"b3, "173"b3, "174"b3, "175"b3, "176"b3, "000"b3);
 210 
 211 
 212 /* ENTRIES */
 213 
 214 dcl  meter_response_time entry (bit (36) aligned, fixed bin),
 215      syserr ext entry options (variable),
 216      tty_lock$lock_channel entry (fixed bin, fixed bin (35)),
 217      tty_lock$unlock_channel entry (fixed bin);
 218 
 219 dcl  tty_index$initialize_tcb entry (ptr, ptr);
 220 dcl  tty_util_$mvt entry (ptr);
 221 dcl  tty_util_$tct entry (ptr);
 222 dcl  tty_overstrike_canon
 223           entry (pointer, fixed binary, fixed binary, character (1) aligned, character (1) aligned, fixed binary (35));
 224 dcl  tty_replace_canon
 225           entry (pointer, fixed binary, fixed binary, character (1) aligned, character (1) aligned, fixed binary (35));
 226 dcl  tty_write$locked entry (fixed bin, ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (35));
 227 
 228 
 229 /* EXTERNAL STATIC */
 230 
 231 dcl  tty_tables$ ext static;
 232 dcl  error_table_$invalid_write ext static fixed bin (35);
 233 dcl  error_table_$badcall ext static fixed bin (35);
 234 dcl  error_table_$improper_data_format ext static fixed bin (35);
 235 dcl  error_table_$io_no_permission ext static fixed bin (35);
 236 dcl  error_table_$invalid_device ext static fixed bin (35);
 237 dcl  error_table_$line_status_pending ext static fixed bin (35);
 238 dcl  error_table_$echnego_awaiting_stop_sync ext static fixed bin (35);
 239 dcl  error_table_$no_table ext static fixed bin (35);
 240 dcl  pds$processid ext static bit (36) aligned;
 241 
 242 
 243 /* BASED */
 244 
 245 dcl  based_buf char (60) based;
 246 dcl  based_chars (0:10) char (1) unal based;
 247 dcl  based_one_char char (1) unal based;
 248 dcl  based_string char (stringl) based (stringp);
 249 dcl  based_source char (source_len) based (old_sourcep);
 250 dcl  based_target char (target_len) based (old_targetp);
 251 dcl  table (0:127) fixed bin (8) unaligned based;
 252 
 253 
 254 dcl  1 mvt_args aligned based (addr (util)),                /* overlay of util structure for tty_util_$mvt */
 255        2 stringptr ptr,
 256        2 stringlen fixed bin,
 257        2 pad fixed bin,
 258        2 tablep ptr,
 259        2 targetp ptr;
 260 
 261 /* BUILTINS */
 262 
 263 dcl  (addr, bin, clock, divide, fixed, index, length, min, null, ptr, rank, rel, reverse, search, substr, verify) builtin;
 264 
 265 dcl  cleanup condition;                                     /*^L                                                        */
 266 %include tty_convert;
 267 /*^L*/
 268 %include tty_buf;
 269 ^L
 270 %include tty_buffer_block;
 271 ^L
 272 %include wtcb;
 273 ^L
 274 %include tcb;
 275 
 276 %include tty_can_types;
 277 ^L
 278 %include lct;
 279 ^L
 280 %include tty_space_man_dcls;
 281 ^L
 282 %include channel_manager_dcls;
 283 ^L
 284 %include mcs_echo_neg_sys;
 285 ^L
 286 %include response_transitions;
 287 ^L
 288 %include multiplexer_types;
 289 /*^L*/
 290           get_line_entry = "0"b;                            /* regular entry */
 291           negotiate_entry = "0"b;
 292           go to join;
 293 
 294 
 295 tty_get_line:
 296      entry (twx, a_readp, a_offset, a_nelem, a_nelemt, nl_found, state, ercode);
 297 
 298           get_line_entry = "1"b;
 299           negotiate_entry = "0"b;
 300           go to join;
 301 
 302 tty_read_with_mark:
 303      entry (twx, a_buffer, a_nelemt, a_mark_index, state, ercode);
 304 
 305           negotiate_entry, get_line_entry = "0"b;
 306           output_ptr = addr (a_buffer);
 307           nelem = length (a_buffer);
 308           mark_entry = "1"b;
 309           mark_index = 0;
 310           go to mark_join;
 311 
 312 
 313 /* new entrpoint to return proper code in awaiting_stop_sync case */
 314 tty_read_echoed:
 315      entry (twx, a_readp, a_offset, a_nelem, a_nelemt, a_echoed, a_screen_left, state, ercode);
 316 
 317           get_line_entry = "0"b;
 318           negotiate_entry = "1"b;
 319           obsolete_negotiate_entry = "0"b;
 320           screen_left = a_screen_left;
 321           echoed = 0;
 322           goto join;
 323 
 324 /* obsolete entry left in to allow time for switchover */
 325 echo_negotiate_get_chars:
 326      entry (twx, a_readp, a_offset, a_nelem, a_nelemt, a_echoed, a_screen_left, state, ercode);
 327 
 328           get_line_entry = "0"b;
 329           negotiate_entry = "1"b;
 330           obsolete_negotiate_entry = "1"b;
 331           screen_left = a_screen_left;
 332           echoed = 0;
 333           goto join;
 334 
 335 join:
 336           mark_entry = "0"b;
 337           output_ptr = a_readp;
 338           nelem = a_nelem;
 339 mark_join:
 340           start_time = clock ();
 341           ttybp = addr (tty_buf$);                          /* get ptrs to tty_buf, tty_data */
 342           call meter_response_time (pds$processid, CALL_RING_0_TTY);
 343 
 344           devx = twx;                                       /* copy device index */
 345           lctp = tty_buf.lct_ptr;                           /* init pointer to lct */
 346           if devx < 1 | devx > lct.max_no_lctes
 347           then do;
 348                ercode = error_table_$invalid_device;
 349                call clean_up;
 350                return;
 351           end;
 352 
 353           uncp_flag = is_parent_mpx (UNCP_MPX);
 354 
 355           call tty_lock$lock_channel (devx, ercode);        /* lock the channel lock */
 356           if ercode ^= 0
 357           then do;
 358                call clean_up;
 359                return;
 360           end;
 361 
 362           on cleanup call tty_lock$unlock_channel (devx);
 363           lctep = addr (lct.lcte_array (devx));             /* get pointer to lcte of interest */
 364           if lcte.channel_type ^= 0                         /* don't talk to strangers */
 365           then go to no_permission;
 366           wtcbp = lcte.data_base_ptr;                       /* get pointers to control blocks */
 367           if ^wtcb.flags.dialed                             /* if not dialed up */
 368           then do;
 369 no_permission:
 370                call tty_lock$unlock_channel (devx);         /* unlock channel lock */
 371                ercode = error_table_$io_no_permission;
 372                call clean_up;
 373                return;
 374           end;
 375           state = DIALED_UP;
 376 
 377           tcbp = wtcb.tcb_ptr;
 378           if ^wtcb.tcb_initialized
 379           then call tty_index$initialize_tcb (wtcbp, tcbp);
 380 
 381           if wtcb.hproc ^= pds$processid                    /* if not boss */
 382           then if (wtcb.uproc ^= pds$processid) | ^tcb.uproc_attached
 383                                                             /* if not user */
 384                then do;
 385                     call tty_lock$unlock_channel (devx);    /* unlock channel lock */
 386                     call clean_up;
 387                     ercode = error_table_$io_no_permission;
 388                     return;
 389                end;
 390 
 391           if wtcb.flags.line_status_present
 392           then do;
 393                call clean_up;
 394                ercode = error_table_$line_status_pending;
 395                call tty_lock$unlock_channel (devx);
 396                return;
 397           end;
 398 
 399           if wtcb.error_code ^= 0
 400           then do;
 401                ercode = wtcb.error_code;
 402                wtcb.error_code = 0;
 403                call tty_lock$unlock_channel (devx);
 404                return;
 405           end;
 406 
 407 
 408 /*^L*/
 409           tcb.cumulative_meters.read_calls = tcb.cumulative_meters.read_calls + 1;
 410           tty_buf.read_calls = tty_buf.read_calls + 1;
 411           nelemt = 0;
 412           if negotiate_entry
 413           then do;
 414                if wtcb.echdp = "000000"b3
 415                then do;                                     /* Can't negotiate with no table! */
 416                     ercode = error_table_$no_table;
 417                     go to all_done;
 418                end;
 419                echo_datap = ptr (ttybp, wtcb.echdp);
 420                if screen_left = 0                           /* Force stop echo magic */
 421                     & (wtcb.negotiating_echo | echo_data.awaiting_start_sync)
 422                then do;
 423 
 424                     echo_data.echo_start_pending_sndopt = "0"b;
 425                     if ^echo_data.awaiting_stop_sync
 426                     then do;
 427                          call channel_manager$control (devx, "stop_negotiated_echo", null (), code);
 428                          if code = 0
 429                          then echo_data.awaiting_stop_sync = "1"b;
 430                          else wtcb.negotiating_echo = "0"b;
 431                     end;
 432                     if echo_data.awaiting_stop_sync
 433                     then do;
 434                          call tty_lock$unlock_channel (devx);
 435                          call clean_up;
 436                          a_echoed = 0;
 437                          ercode = error_table_$echnego_awaiting_stop_sync;
 438 
 439 /* echo_negotiate_get_chars returns the wrong error code in this case
 440    and must continue to do so for compatability for at least one release,
 441    at which point the entry and this code can be flushed and everyone
 442    will have switched to using tty_read_echoed */
 443                          if obsolete_negotiate_entry
 444                          then ercode = error_table_$line_status_pending;
 445 
 446                          return;
 447                     end;
 448                end;
 449           end;
 450           if nelem = 0
 451           then do;
 452                if ^negotiate_entry
 453                then wtcb.negotiating_echo = "0"b;
 454 
 455 /* Magic kludge to turn off echoing on ring-4 detected break conditions */
 456 /* This is "clean" because all non-negotiating calls are supposed to turn it off. */
 457 
 458                ercode = 0;
 459                go to all_done;
 460           end;
 461 
 462           if ^mark_entry
 463           then offset = a_offset;
 464           else offset = 0;
 465           target_len = 0;
 466           rawcnt = 0;
 467           have_more_data = "0"b;
 468           if offset ^= 0
 469           then output_ptr = addr (output_ptr -> based_chars (offset));
 470           orig_output_ptr = output_ptr;                     /* in case we need this later */
 471 
 472           if ^tcb.rawim
 473           then do;
 474                if mark_entry                                /* only supposed to be called in rawi */
 475                then do;
 476                     ercode = error_table_$badcall;
 477                     go to all_done;
 478                end;
 479 
 480                ttytp = addr (tty_tables$);
 481                if tcb.input_mvtrp = ""b
 482                then mvtp = null;
 483                else mvtp = ptr (ttytp, tcb.input_mvtrp);
 484                if tcb.input_tctrp = ""b
 485                then tctp = null;
 486                else tctp = ptr (ttytp, tcb.input_tctrp);
 487                if tcb.specialrp = ""b
 488                then special_ptr = null;
 489                else special_ptr = ptr (ttytp, tcb.specialrp);
 490           end;
 491 
 492           if wtcb.fblock = 0
 493           then do;                                          /* go get some data to process */
 494                call get_more_data (blockp);                 /* find more input_data */
 495                if ercode ^= 0
 496                then go to all_done;                         /* if problem get out */
 497           end;
 498           else blockp = ptr (ttybp, wtcb.fblock);           /* get pointer to buffer left from last time */
 499                                                             /*^L                                                        */
 500           if wtcb.fblock ^= 0
 501           then do;                                          /* yes, process it */
 502                target_ptr = output_ptr;
 503 
 504                if tcb.rawim                                 /* raw input mode */
 505                then do;                                     /* just copy data */
 506                     break_found = "0"b;                     /* we'll need this if get_line called */
 507                     do while (wtcb.fblock ^= 0 & nelemt < nelem & ^break_found);
 508 
 509                          source_ptr = addr (buffer.chars (wtcb.fchar));
 510                          ctally = min (buffer.tally - wtcb.fchar, nelem - nelemt);
 511                          if get_line_entry                  /* want to stop at NL */
 512                          then do;
 513                               next_break = index (substr (source_ptr -> based_buf, 1, ctally), wtcb.line_delimiter);
 514                               if next_break ^= 0            /* there is one in this buffer */
 515                               then do;
 516                                    ctally = next_break;     /* stop at it */
 517                                    break_found = "1"b;      /* and don't go around again */
 518                               end;
 519                          end;
 520 
 521                          if mark_entry
 522                          then if buffer.mark
 523                               then mark_index = target_len + 1;
 524 
 525                          call copy_chars;
 526 
 527                          nelemt = target_len;
 528 
 529                          if ctally < buffer.tally - wtcb.fchar
 530                                                             /* if this is last buffer we're copying */
 531                          then do;
 532                               wtcb.fchar = wtcb.fchar + ctally;
 533                               buffer.mark = "0"b;           /* we've picked up the mark */
 534                          end;
 535 
 536                          else do;
 537                               wtcb.fchar = 0;               /* not in the middle of a buffer now */
 538                               new_block = buffer.next;
 539 
 540                               call tty_space_man$free_buffer (devx, INPUT, blockp);
 541                                                             /* free buffer just copied from */
 542 
 543                               wtcb.fblock = new_block;      /* next buffer (if any) is now head of chain */
 544                               blockp = ptr (ttybp, new_block);
 545                               if (new_block = 0 & wtcb.input_available)
 546                               then do;                      /* see if more to do, finished with this chain */
 547                                    call get_more_data (blockp);
 548                                                             /* go try to get a buffer */
 549                                    if ercode ^= 0
 550                                    then go to all_done;     /* if problem get out */
 551                               end;
 552                          end;
 553                     end;
 554 
 555                     rawcnt = nelemt;                        /* that's how many we really picked up */
 556                end;                                         /*^L                                                        */
 557                else do;                                     /* not raw input */
 558                     if tcb.erklm
 559                     then do;                                /* make local copies of erase and kill characters */
 560                          erase_char = tcb.erase;
 561                          kill_char = tcb.kill;
 562                     end;
 563                     else erase_char, kill_char = " ";       /* so canon_procedure won't see erases & kills */
 564 
 565                     if (tcb.can_type = CAN_TYPE_OVERSTRIKE)
 566                     then canon_procedure = tty_overstrike_canon;
 567                     else if (tcb.can_type = CAN_TYPE_REPLACE)
 568                     then canon_procedure = tty_replace_canon;
 569                     else canon_procedure = tty_overstrike_canon;
 570                                                             /* can't happen, but just in case */
 571 
 572                     call pickup_preconverted;
 573 
 574                     nelemt = target_len;                    /* total returned so far */
 575                     throw_away = "0"b;
 576 
 577 /* CONVERSION STARTS HERE */
 578 /* if there's any to do */
 579 
 580                     if wtcb.fblock = 0
 581                     then do;                                /* finished with preconvertedand no none converted pending */
 582                          call get_more_data (blockp);       /* try to get a buffer */
 583                          if ercode ^= 0
 584                          then go to all_done;               /* if error get out */
 585                     end;
 586                     max_len = 1;                            /* init so loop starts */
 587                     do while ((^break_found | ^get_line_entry) & nelemt < nelem & wtcb.fblock ^= 0 & max_len > 0);
 588                          old_rawcnt = rawcnt;               /* in case we have to do retry */
 589                          break = wtcb.line_delimiter;       /* this is untranslated break, which we will search for */
 590                          output_ptr = target_ptr;           /* allows for possible already-converted chars */
 591                          max_len = length (buffer_1);
 592                          orig_fchar = wtcb.fchar;           /* so we can restore this */
 593 
 594 /* come here if canon_procedure overflows */
 595 retry:
 596                          if max_len > 0
 597                          then do;                           /* only continue if we have something to do it into */
 598                               target_ptr = addr (buffer_1);
 599                               room_left = max_len;
 600                               target_len = 0;
 601                               last_block = 0;
 602                               wtcb.fchar = orig_fchar;      /* in case we started over */
 603                               call copy_loop;
 604                               if ^break_found & get_line_entry & room_left > 0
 605                               then do;                      /* there's no break anywhere in chain */
 606                                    no_break_anywhere = "1"b;
 607                                    wtcb.fchar = orig_fchar; /* copy_loop might have changed this */
 608                                    go to no_line;           /* get out of conversion loop */
 609                               end;
 610 
 611                               no_break_anywhere = "0"b;
 612                               call translation;
 613 
 614 /* ** CANONICALIZATION ** */
 615 
 616                               can_called = "0"b;
 617                               if tcb.canm
 618                               then do;
 619                                    call canonicalization;
 620                                    if code ^= 0             /* overflowed the space */
 621                                    then do;                 /* have to start again */
 622                                         max_len = divide (2 * max_len, 3, 17, 0);
 623                                         if max_len > 0
 624                                         then do;
 625                                              blockp = ptr (ttybp, wtcb.fblock);
 626                                              rawcnt = old_rawcnt;
 627                                              break_found = "0"b;
 628                                                             /* start clean */
 629                                              tty_buf.input_restart = tty_buf.input_restart + 1;
 630                                              go to retry;
 631                                         end;
 632                                    end;
 633                               end;
 634                          end;
 635 
 636 /* ** FREE BUFFERS NOW ** */
 637 
 638                          if last_block ^= 0                 /* if there are any to free */
 639                          then do;                           /* this was the first chance we had to release some buffer space in the buffer */
 640                               tempp = ptr (ttybp, last_block);
 641                                                             /* point to last one */
 642                               tempp -> buffer.next = 0;     /* cut off chain here */
 643                               call tty_space_man$free_chain (devx, INPUT, ptr (ttybp, wtcb.fblock));
 644                               wtcb.fblock = fixed (rel (blockp), 17);
 645                          end;
 646 
 647                          if (wtcb.fblock = 0 & wtcb.input_available)
 648                          then do;                           /* see if more to do, finished with this chain */
 649                               call get_more_data (blockp);  /* get the buffer of interest */
 650                               if ercode ^= 0
 651                               then go to all_done;
 652                               wtcb.fchar = 0;               /* we can update this now too */
 653                          end;                               /* we'll get back to this buffer after we finish the rest of the present buffer we have */
 654 
 655 /* set up for rest of conversion */
 656 
 657                          source_len = stringl;
 658                          stringp = source_ptr;
 659                          target_len = 0;
 660 
 661 /* if tty_canon wasn't called, we have to eliminate NULs by hand */
 662 
 663                          if ^can_called & (^tcb.control | no_control_input (wtcb.line_type))
 664                          then call strip_nulls;
 665 
 666 /* ** ERASE/KILL PROCESSING ** */
 667 
 668                          if tcb.erklm
 669                          then call process_erase_kill;
 670 
 671 /* ** ESCAPE AND BREAK PROCESSING ** */
 672 
 673                          if tctp ^= null                    /* can't do this without input conversion table */
 674                          then call process_escape_break;
 675 
 676                          if target_len ^= 0
 677                          then do;
 678                               source_ptr = old_targetp;
 679                               source_len = target_len;
 680                          end;
 681 
 682                          target_len = nelemt;               /* number of characters in caller's buffer so far */
 683                          target_ptr = output_ptr;           /* place to put the rest */
 684                          ctally = min (nelem - nelemt, source_len);
 685                                                             /* copy as many more as we can hold */
 686                          if ctally > 0
 687                          then call copy_chars;
 688 
 689                          nelemt = nelemt + source_len;
 690 
 691 /* if we have to convert any more, we will now go back to top and copy some more */
 692 
 693                     end;
 694 ^L
 695 /* we've converted all we're going to convert. Do we have any */
 696 /* that wouldn't fit in caller's buffer? */
 697 
 698                     if nelemt > nelem
 699                     then do;                                /* yes */
 700 
 701                          source_len = nelemt - nelem;
 702                          if mark_entry
 703                          then if mark_index > nelem         /* we didn't get up to the mark */
 704                               then pmark_index = mark_index - nelem;
 705                               else pmark_index = 0;
 706                          call copy_to_preconverted;
 707                     end;
 708 
 709                     else if (get_line_entry & ^break_found) /* don't have a complete line */
 710                     then do;
 711 no_line:
 712                          if target_len > 0                  /* if there's anything at all */
 713                          then do;                           /* search through buffers to see if he'll get a break sooner or later */
 714                               if wtcb.fblock = 0 | no_break_anywhere
 715                               then unconverted_break = "0"b;/* we know there aren't any breaks */
 716                               else if tcb.break_char_pending
 717                               then unconverted_break = "1"b;/* we dont have to search */
 718 
 719                               else do;                      /* scan buffer to see what we can find */
 720                                    blockp = ptr (ttybp, wtcb.fblock);
 721                                    next_break = 0;          /* init the "while" variable */
 722 
 723                                    break = wtcb.line_delimiter;
 724                                                             /* make sure it is set, may have fallen through to here */
 725                                    do while (next_break = 0);
 726                                         source_ptr = addr (buffer.chars (wtcb.fchar));
 727                                         next_break =
 728                                              index (substr (source_ptr -> based_buf, 1, buffer.tally - wtcb.fchar), break)
 729                                              ;              /* look for break in next buffers */
 730                                         if next_break ^= 0
 731                                         then unconverted_break = "1"b;
 732                                                             /* we found one */
 733                                         else if buffer.next = 0
 734                                         then do;            /* nothing else to look at so give up */
 735                                              unconverted_break = "0"b;
 736                                              next_break = 1;/* to break out of loop */
 737                                         end;
 738 
 739                                         else blockp = ptr (ttybp, buffer.next);
 740                                    end;
 741                               end;
 742 
 743                               if /* tree */ unconverted_break
 744                               then tcb.break_char_pending = "1"b;
 745 
 746                               else if ^no_break_anywhere
 747                                    then do;
 748                                         source_ptr = orig_output_ptr;
 749                                                             /* we will save everything the caller would have gotten */
 750                                         source_len = target_len;
 751                                                             /* this is the total in the caller's buffer */
 752                                         call copy_to_preconverted;
 753                                         nelemt = 0;         /* he will get nothing till we know for sure */
 754                                    end;
 755                          end;
 756                     end;
 757                end;                                         /* whether rawi or not */
 758           end;                                              /* whether a read chain or not */
 759 ^L
 760 /* we always end up here */
 761 /* if no read chain or no space we will ask for wakeup since
 762    nelemt will be 0 */
 763 
 764           nelemt = min (nelemt, nelem);
 765           if nelemt = 0
 766           then do;
 767                if negotiate_entry
 768                then do;                                     /* OK, flip on echoing. */
 769                     echo_data.horiz_room_left = screen_left;/* Indicate room left. */
 770                     echo_data.chars_echoed = 0;             /* Didn't echo anything */
 771                     if screen_left = 0
 772                     then wtcb.negotiating_echo = "0"b;
 773                     else if tty_buf.echo_neg_mux_inhibit
 774                     then wtcb.negotiating_echo = "1"b;
 775                     else if wtcb.write_first ^= 0
 776                     then do;
 777                          wtcb.negotiating_echo = "1"b;
 778                          if echo_data.synchronized
 779                          then echo_data.echo_start_pending_sndopt = "1"b;
 780                     end;                                    /* If output sits in ring 0, only ring 0 can append logically to it, not mux. */
 781                     else if echo_data.synchronized
 782                     then do;                                /* mux _^Hd_^Ho_^He_^Hs echnego */
 783                          wtcb.negotiating_echo = "1"b;      /* Tell tty_interrupt to echo. */
 784                          echo_start_data.ctr = echo_data.sync_ctr;
 785                                                             /* Tell MUX to echo, */
 786                                                             /* Sending counters as part of protocol game. */
 787                          echo_start_data.screenleft = echo_data.horiz_room_left;
 788                          call channel_manager$control (devx, "start_negotiated_echo", addr (echo_start_data), code);
 789                          if code = 0
 790                          then ;
 791                          else if code = error_table_$invalid_write
 792                          then echo_data.echo_start_pending_sndopt = "1"b;
 793 
 794 /* This little bit of obscurity means that the mux had output queued in r0, */
 795 /* and tty_interrupt is to try sending this again when a SEND_OUTPUT */
 796 /* indicates that this is no longer the case. */
 797                     end;
 798                     else do;                                /* Not synchronized */
 799                          call channel_manager$control (devx, "init_echo_negotiation", null (), code);
 800                          if code = 0
 801                          then do;
 802                               echo_data.awaiting_start_sync = "1"b;
 803                               echo_data.mux_will_echnego = "1"b;
 804                          end;
 805                          else wtcb.negotiating_echo = "1"b; /* Ring zero will do it */
 806                     end;
 807                     if wtcb.negotiating_echo
 808                     then tty_buf.echo_neg_entries = tty_buf.echo_neg_entries + 1;
 809                end;
 810                else do;                                     /* Regular call turns off */
 811                     if wtcb.negotiating_echo
 812                     then do;
 813                          wtcb.negotiating_echo = "0"b;      /* This really really should not happen -- should we cm$control (echoff) here */
 814                     end;
 815                end;
 816 
 817                if (uncp_flag & ^wtcb.flags.rflag) |
 818                     (^uncp_flag & ^wtcb.flags.rflag & wtcb.prompt_len > 0)
 819 
 820                then do;
 821                     raw_mode = tcb.rawom;
 822                     tcb.rawom = "1"b;                       /* write prompt in rawo mode */
 823                     call tty_write$locked (devx, addr (wtcb.prompt), 0, (wtcb.prompt_len), 0, 0, code);
 824                     tcb.rawom = raw_mode;
 825                end;
 826 
 827                wtcb.flags.rflag = "1"b;                     /* we want a wakeup */
 828                tty_buf.readblocked = tty_buf.readblocked + 1;
 829                                                             /* blocked again */
 830                if ^uncp_flag then do;
 831                     if ^wtcb.flags.wru                      /* if not reading answerback */
 832                          then if wtcb.receive_mode_device   /* must we tell multiplexer to turn line around? */
 833                          then call channel_manager$control (devx, "enter_receive", null, ercode);
 834                                                             /* yes, do it */
 835                     else ;
 836 
 837                     else wtcb.flags.wru = "0"b;             /* won't be reading answerback again */
 838                end;
 839           end;
 840 
 841           else do;
 842                wtcb.flags.rflag, wtcb.flags.wru = "0"b;
 843                wtcb.negotiating_echo = "0"b;
 844                if negotiate_entry
 845                then do;                                     /* Return echoed count. */
 846                     echoed = min (nelem, echo_data.chars_echoed);
 847                     echo_data.chars_echoed = echo_data.chars_echoed - echoed;
 848                end;
 849                tcb.cumulative_meters.read_chars = tcb.cumulative_meters.read_chars + nelemt;
 850                tty_buf.ninchars = tty_buf.ninchars + nelemt;/* count input chars */
 851                tty_buf.nrawread = tty_buf.nrawread + rawcnt;/* count raw chars input */
 852 
 853                if (tcb.modes.scroll & (tcb.linemax > 0))
 854                then wtcb.actline = 0;                       /* scroll by resetting the line count */
 855                                                             /* that is if we care about the line count in the first place */
 856 
 857           end;
 858 
 859           ercode = 0;
 860           if get_line_entry
 861           then nl_found = break_found;                      /* report this to caller */
 862 all_done:
 863           if wtcb.fblock = 0
 864           then do;
 865                wtcb.lblock = 0;
 866                wtcb.flags.allow_wakeup = "0"b;
 867           end;
 868 
 869           if ercode ^= 0
 870           then do;
 871                call clean_up;                               /* don't give him anything extra */
 872                wtcb.negotiating_echo = "0"b;
 873           end;
 874           time_spent = clock () - start_time;
 875           tcb.cumulative_meters.read_time = tcb.cumulative_meters.read_time + time_spent;
 876           tty_buf.read_time = tty_buf.read_time + time_spent;
 877           call tty_lock$unlock_channel (devx);              /* unlock channel lock */
 878           a_nelemt = nelemt;
 879           if nelemt > 0
 880           then call meter_response_time (pds$processid, RETURN_RING_0_TTY);
 881           if negotiate_entry
 882           then a_echoed = echoed;
 883           if mark_entry
 884           then if mark_index <= nelemt
 885                then a_mark_index = mark_index;
 886                else a_mark_index = 0;
 887           return;                                           /*^L                                                        */
 888 
 889 /* ** INTERNAL PROCEDURES ** */
 890 
 891 copy_chars:
 892      proc;
 893 
 894 /* this procedure copies ctally characters from source_ptr to target_ptr. It updates both pointers */
 895 /* and increments target_len by ctally */
 896 
 897 dcl  tally_chars char (ctally) based;
 898 
 899           target_ptr -> tally_chars = source_ptr -> tally_chars;
 900 
 901           source_ptr = addr (source_ptr -> based_chars (ctally));
 902           target_ptr = addr (target_ptr -> based_chars (ctally));
 903           target_len = target_len + ctally;
 904 
 905           return;
 906 
 907      end /* copy_chars */;
 908 ^L
 909 clean_up:
 910      proc;
 911 
 912 /*
 913    This procedure is to insure that the user does not get returned
 914    any values that might convey any information to hime that he should not have
 915 */
 916 
 917           nelemt, a_nelemt = 0;
 918           nl_found = "0"b;
 919           state = 0;
 920           return;
 921 
 922      end clean_up;
 923 ^L
 924 
 925 get_more_data:
 926      proc (new_blockp);
 927 
 928 /* this proc calls channel_manager$read to get more buffers of data and set the buffer pointer (blockp)
 929    and the the first block (wtcb.fblock) if it si not already set.  Both are set to null values if no data is pending */
 930 
 931 dcl  new_blockp ptr;
 932 dcl  prev_blockp ptr;
 933 dcl  orig_blockp ptr;
 934 
 935           if wtcb.input_available
 936           then do;                                          /* If there is input, go get it. */
 937                call channel_manager$read (devx, blockp, have_more_data, ercode);
 938                                                             /* get the buffer of interest */
 939                if ercode ^= 0
 940                then nelemt = 0;                             /* reset to zero */
 941                wtcb.input_available = have_more_data;
 942           end;
 943           else blockp = null;                               /* else nothing there or physical channel and he puts everything he has into fblock on interrupt */
 944 
 945           if blockp ^= null
 946           then do;
 947                if wtcb.fblock = 0                           /* if there's not a pending chain */
 948                then wtcb.fblock = fixed (rel (blockp), 17, 0);
 949                                                             /* break pointer back into an offset */
 950                else do;                                     /* attach new stuff to existing chain */
 951                     prev_blockp = ptr (ttybp, wtcb.lblock);
 952                     prev_blockp -> buffer.next = fixed (rel (blockp), 17, 0);
 953                end;
 954 
 955                orig_blockp = blockp;
 956 
 957                do while (buffer.next ^= 0);                 /* find end of chain to set wtcb.lblock */
 958                     blockp = ptr (blockp, buffer.next);
 959                end;
 960 
 961                wtcb.lblock = bin (rel (blockp), 17);
 962                blockp = orig_blockp;
 963 
 964                if wtcb.mark_set
 965                then do;
 966                     buffer.mark = "1"b;                     /* set mark in first block */
 967                     wtcb.mark_set = "0"b;
 968                end;
 969           end;
 970           new_blockp = blockp;
 971           return;
 972      end;                                                   /* get_more_data */
 973 
 974 /*^L*/
 975 insert_char:
 976      proc (i_char);
 977 
 978 /* this procedure inserts one character at target_ptr, and increments target_ptr and target_len by one character */
 979 
 980 dcl  i_char char (1) aligned;
 981 
 982           target_ptr -> based_one_char = i_char;
 983           target_ptr = addr (target_ptr -> based_chars (1));
 984           target_len = target_len + 1;
 985           return;
 986 
 987      end /* insert_char */;                                 /*^L                                                        */
 988 skip:
 989      proc (to_skip);
 990 
 991 /* this procedure discards a specified number of characters from stringp */
 992 
 993 dcl  to_skip fixed bin;
 994 
 995           stringp = addr (stringp -> based_chars (to_skip));/* skip over character */
 996           if source_len = stringl                           /* if it's first character in the string */
 997           then source_len = source_len - to_skip;           /* then make sure it doesn't get picked up */
 998           stringl = stringl - to_skip;
 999 
1000           return;
1001 
1002      end /* skip */;
1003 ^L
1004 escaped:
1005      proc returns (bit (1) aligned);
1006 
1007 /* this procedure returns "1"b if the character at index xr in the string based on stringp */
1008 /* is preceded by a non-overstruck escape character; otherwise it returns "0"b */
1009 
1010           if ^tcb.escm
1011           then return ("0"b);
1012 
1013           if xr <= 1                                        /* no preceding character */
1014           then return ("0"b);
1015 
1016           if tctp = null                                    /* no conversion table so no escapes */
1017           then return ("0"b);
1018 
1019           if tctp -> table (rank (substr (based_string, xr - 1, 1))) ^= 2
1020                                                             /* not preceded by an escape */
1021           then return ("0"b);
1022 
1023           if xr = 2                                         /* escape can't be overstruck, it's first char */
1024           then return ("1"b);
1025 
1026           if substr (based_string, xr - 2, 1) = bs          /* escape is overstruck */
1027           then return ("0"b);
1028 
1029           else return ("1"b);
1030 
1031      end /* escaped */;                                     /*^L                                                        */
1032 char_value:
1033      proc (a_char) returns (fixed bin);
1034 
1035 /* this procedure returns the numeric equivalent of an ASCII character if the character is 0 to 7; */
1036 /* otherwise it returns -1 */
1037 
1038 dcl  a_char char (1) aligned;
1039 dcl  numeric fixed bin;
1040 
1041           numeric = rank (a_char);
1042           if numeric >= 48                                  /* i.e., "0" */
1043                & numeric <= 55                              /* i.e., "7" */
1044           then return (numeric - 48);
1045 
1046           else return (-1);
1047 
1048      end /* char_value */;
1049 ^L
1050 copy_to_preconverted:
1051      proc;
1052 
1053 /* This procedure copies source_len characters from source_ptr to buffers marked "preconverted" */
1054 
1055 dcl  mark_next_buffer bit (1);
1056 
1057           tty_buf.preconverted = tty_buf.preconverted + source_len;
1058 
1059           old_fblock = wtcb.fblock;
1060 
1061 /* we will copy extra ones into tty_buf "converted" buffers */
1062 
1063           call tty_space_man$get_buffer (devx, BSIZE, INPUT, new_blockp);
1064           if new_blockp = null
1065           then go to no_space;
1066 
1067           wtcb.fblock = bin (bin (rel (new_blockp), 18), 17);
1068 
1069           target_len = 0;
1070           mark_next_buffer = "0"b;
1071 
1072           do while (source_len > 0);
1073                blockp = new_blockp;
1074                buffer.converted = "1"b;
1075 
1076                ctally = min (source_len, bsizec);
1077                if mark_entry
1078                then do;
1079                     if /* tree */ mark_next_buffer          /* we broke previous buffer at mark */
1080                     then do;
1081                          buffer.mark = "1"b;
1082                          mark_next_buffer = "0"b;
1083                     end;
1084 
1085                     else if pmark_index > 0
1086                          then if pmark_index = target_len + 1
1087                                                             /* it's exactly here */
1088                               then do;
1089                                    buffer.mark = "1"b;
1090                                    pmark_index = 0;         /* we've done it now */
1091                               end;
1092                               else if pmark_index <= target_len + ctally
1093                                                             /* it's due to be in this buffer */
1094                                    then do;
1095                                         ctally = pmark_index - target_len - 1;
1096                                                             /* break so mark will be at start of next buffer */
1097                                         mark_next_buffer = "1"b;
1098                                                             /* and remember to do it */
1099                                         pmark_index = 0;    /* taken care of now */
1100                                    end;
1101                end;
1102 
1103                buffer.tally = ctally;
1104                target_ptr = addr (buffer.chars (0));
1105                call copy_chars;
1106 
1107                source_len = source_len - ctally;
1108                if source_len > 0                            /* more to do? */
1109                then do;
1110 
1111 /* get another buffer */
1112 
1113                     call tty_space_man$get_buffer (devx, BSIZE, INPUT, new_blockp);
1114                     if new_blockp = null
1115                     then do;
1116 no_space:
1117                          call syserr (crash, "tty_read: No buffers available for preconverted input.");
1118                          return;
1119                     end;
1120 
1121                     buffer.next = bin (bin (rel (new_blockp), 18), 17);
1122                                                             /* set forward pointer in previous block */
1123                end;
1124           end;
1125 
1126 /* done filling "converted" buffers */
1127 
1128           buffer.next = old_fblock;                         /* set forward pointer in last one */
1129           if break_found
1130           then buffer.break, tcb.flags.break_char_pending = "1"b;
1131                                                             /* had we found a break earlier? */
1132           break_found = "0"b;                               /* we're not sending the NL to the caller or else we wouldn't be here */
1133 
1134           if old_fblock = 0
1135           then wtcb.lblock = fixed (rel (blockp), 17);
1136 
1137           return;
1138 
1139      end /* copy_to_preconverted */;
1140 ^L
1141 pickup_preconverted:
1142      proc;
1143 
1144 /* check for already-converted input left over from last call and use it up first */
1145 
1146           break_found = "0"b;
1147           convert = buffer.converted;
1148 
1149           do while (wtcb.fblock ^= 0 & convert);            /* scan chain of converted buffers */
1150                data_ptr, source_ptr = addr (buffer.chars (0));
1151                ctally = min (buffer.tally, nelem - target_len);
1152                call copy_chars;
1153 
1154                if ctally < buffer.tally                     /* didn't take whole buffer, no room left for the rest */
1155                then do;
1156                     new_tally = buffer.tally - ctally;
1157                     buffer.tally = new_tally;
1158 
1159 /* copy remaining characters to beginning of buffer */
1160 
1161                     substr (temp_buf, 1, new_tally) = substr (data_ptr -> based_buf, ctally + 1, new_tally);
1162                     substr (data_ptr -> based_buf, 1, new_tally) = substr (temp_buf, 1, new_tally);
1163 
1164                     convert = "0"b;                         /* so we'll stop copying */
1165                     tcb.flags.break_char_pending = "0"b;    /* if end clear any pending flag will reset later if called for */
1166                end;
1167 
1168                else do;                                     /* copied whole buffer */
1169                     break_found = buffer.break;
1170                     new_block = buffer.next;
1171 
1172                     call tty_space_man$free_buffer (devx, INPUT, blockp);
1173                                                             /* free the buffer just copied from */
1174                     wtcb.fblock = new_block;
1175 
1176                     if wtcb.fblock ^= 0                     /* there's more */
1177                     then do;
1178                          blockp = ptr (ttybp, wtcb.fblock);
1179                          if break_found | target_len >= nelem
1180                                                             /* have we got enough? */
1181                          then convert = "0"b;               /* yes, no more copying */
1182                          else convert = buffer.converted;
1183                     end;
1184                     else wtcb.lblock = 0;                   /* just to be safe */
1185 
1186                     if break_found
1187                     then tcb.flags.break_char_pending = "0"b;
1188                                                             /* assume this is the one we flaged */
1189                end;
1190           end;                                              /* end of copy-converted loop */
1191 
1192           return;
1193 
1194      end pickup_preconverted;
1195 ^L
1196 copy_loop:
1197      proc;
1198 
1199 /*
1200    This procedure copies data from the available input buffer and places
1201    it into an internal working buffer
1202 */
1203 
1204 dcl  new_blockp ptr;
1205 dcl  orig_blockp ptr;
1206 
1207           first_char = wtcb.fchar;                          /* keep in automatic for convenience */
1208           if ^get_line_entry
1209           then break_found = "0"b;                          /* so we're not fooled by preconverted break */
1210           do while (^break_found & rel (blockp) ^= "0"b & room_left > 0);
1211                chars_in_buf = buffer.tally - first_char;
1212                source_ptr = addr (buffer.chars (first_char));
1213 
1214                ctally = index (substr (source_ptr -> based_buf, 1, chars_in_buf), break);
1215                if ctally = 0
1216                then ctally = chars_in_buf;
1217                else break_found = "1"b;
1218 
1219                if ctally > room_left                        /* there has to be room internally */
1220                then ctally = room_left;
1221 
1222                call copy_chars;                             /* get the data */
1223 
1224                room_left = room_left - ctally;
1225                rawcnt = rawcnt + ctally;
1226 
1227                if ctally < chars_in_buf                     /* we reached some limit */
1228                then first_char = first_char + ctally;       /* this buffer will be around later */
1229                else do;
1230                     last_block = fixed (rel (blockp), 17);
1231                     first_char = 0;                         /* next buffer begins at beginning */
1232                     blockp = ptr (ttybp, buffer.next);
1233                end;
1234 
1235                if rel (blockp) = "0"b                       /* if we reached end */
1236                then if ^break_found                         /* without finding break */
1237                     then if wtcb.input_available            /* but lower level has more data */
1238                          then do;                           /* get it now */
1239                               orig_blockp = blockp;
1240                               call get_more_data (new_blockp);
1241                               if ercode ^= 0
1242                               then go to all_done;
1243                               if new_blockp ^= null         /* if there really was some */
1244                               then blockp = new_blockp;
1245                               else blockp = orig_blockp;    /* get_more_data probably changed it */
1246                          end;
1247           end;
1248 
1249           wtcb.fchar = first_char;                          /* update this now */
1250 
1251           return;
1252 
1253      end copy_loop;                                         /*^L                                                        */
1254 translation:
1255      proc;
1256 
1257 /*
1258    This procedure sets up the necessary variables and then calls the move and translate
1259    operation
1260 */
1261 
1262           source_ptr = addr (buffer_1);
1263           target_ptr = addr (buffer_2);
1264 
1265           if throw_away
1266           then do;                                          /* remove first character */
1267                source_ptr = addr (source_ptr -> based_chars (1));
1268                target_len = target_len - 1;
1269                throw_away = "0"b;
1270           end;
1271 
1272           stringl = target_len;                             /* the number of chars in buffer_1 now */
1273           stringp = source_ptr;
1274 
1275           if mvtp ^= null
1276           then do;
1277                mvt_args.tablep = mvtp;
1278                mvt_args.targetp = target_ptr;
1279 
1280                call tty_util_$mvt (addr (util));            /* this does the translation */
1281 
1282                source_ptr = addr (buffer_2);
1283                target_ptr = addr (buffer_1);
1284                stringp = source_ptr;
1285           end;
1286 
1287           if ^tcb.control                                   /* get rid of invisible characters if appropriate */
1288           then if ^no_control_input (wtcb.line_type)        /* and necessary */
1289                then do;
1290                     mvt_args.tablep = addr (nocontrol);
1291                     mvt_args.targetp = target_ptr;
1292 
1293                     call tty_util_$mvt (addr (util));
1294 
1295                     stringp = target_ptr;                   /* switch buffers back */
1296                     target_ptr = source_ptr;
1297                     source_ptr = stringp;
1298                end;
1299 
1300           return;
1301 
1302      end translation;
1303 ^L
1304 canonicalization:
1305      proc;
1306 
1307 /*
1308    This procedure sets up the necessary variables then calls the cannonicalizer
1309 */
1310 /* search for cr and bs */
1311 
1312           code = 0;
1313           xr = 1;                                           /* to make sure we do loop at least once */
1314           do while (xr = 1);
1315 
1316                xr = search (based_string, left_motion);
1317 
1318                if xr = 1                                    /* at left margin, skip over it */
1319                then do;
1320                     stringp = addr (stringp -> based_chars (1));
1321                     stringl = stringl - 1;
1322                end;
1323 
1324                else if search (based_string, vertical_motion) ^= 0
1325                then go to MUST_CALL_CANONICALIZE;           /* FF or HT in string: must call canonicalize routine to
1326                                                                insure that whitespace before the HT or FF is stripped */
1327 
1328                else if xr ^= 0                              /* we found one somewhere else */
1329                then do;                                     /* find out if at end */
1330 
1331                     if (tcb.can_type ^= CAN_TYPE_REPLACE) & (verify (substr (based_string, xr), all_white) = 0)
1332                                                             /* rest of string white: not significant unless
1333                                                                can_type=replace where trailing whitespace can replace
1334                                                                prior characters on the line */
1335                     then do;
1336                          if substr (based_string, stringl, 1) = nl
1337                          then do;                           /* copy newline if any */
1338                               substr (based_string, xr, 1) = nl;
1339                               stringl = xr;
1340                          end;
1341 
1342                          else stringl = xr - 1;
1343 
1344                          source_ptr = stringp;              /* so we won't get leading bs/cr back */
1345                     end;
1346 
1347                     else do;                                /* left motion in middle, must call tty_canon */
1348 MUST_CALL_CANONICALIZE:
1349                          if stringp ^= source_ptr           /* did we skip over leading bs/cr? */
1350                          then do;                           /* copy so tty_canon can use whole buffer */
1351                               target_ptr -> based_string = stringp -> based_string;
1352                               data_ptr = target_ptr;
1353                               target_ptr = source_ptr;
1354                               source_ptr = data_ptr;
1355                          end;
1356 
1357                          can_called = "1"b;
1358                          call canon_procedure (source_ptr, stringl, length (buffer_1), erase_char, kill_char, code);
1359                     end;
1360                end;
1361 
1362                else source_ptr = stringp;                   /* update for possible skipped leading left motion */
1363           end;
1364 
1365           return;
1366 
1367      end canonicalization;                                  /* end of canonicalization */
1368 ^L
1369 strip_nulls:
1370      proc;
1371 
1372 /*
1373    This procedure eliminates nulls from an input buffer.  It is used if tty_cannon
1374    was not called earlier for some reason or another
1375 */
1376           old_sourcep = source_ptr;
1377           old_targetp = target_ptr;
1378 
1379           xr = index (based_string, nul_char);
1380 
1381           do while (xr ^= 0 & stringl > 0);
1382                if xr = 1                                    /* NUL at beginning of string */
1383                then do;
1384                     stringl = stringl - 1;
1385                     source_len = source_len - 1;
1386                end;
1387 
1388                else do;
1389                     ctally = xr - 1;                        /* copy characters from before NUL */
1390                     call copy_chars;
1391                     stringl = stringl - xr;
1392                end;
1393 
1394                if stringl > 0
1395                then do;                                     /* search remainder for further nulls */
1396                     source_ptr, stringp = addr (stringp -> based_chars (xr));
1397                     xr = index (based_string, nul_char);
1398                end;
1399 
1400           end;
1401 
1402           if target_len > 0                                 /* if we moved any at all */
1403           then do;
1404                if stringl > 0                               /* any more that we didn't move? */
1405                then do;
1406                     ctally = stringl;
1407                     call copy_chars;                        /* move 'em */
1408                end;
1409                source_len = target_len;                     /* source for next pass */
1410                source_ptr = old_targetp;                    /* switch buffers */
1411                target_ptr = old_sourcep;
1412           end;
1413 
1414           stringp = source_ptr;
1415 
1416           return;
1417 
1418      end strip_nulls;
1419 ^L
1420 process_erase_kill:
1421      proc;
1422 
1423 /*
1424    This procedure does the erase and kill processing by killing all characters
1425    to the left of the kill character, and erasing the character (or specified
1426    number of characters) to the left of the erase character.
1427 */
1428           old_sourcep = source_ptr;
1429           old_targetp = target_ptr;
1430           stringl = source_len;
1431 
1432 /* kill first */
1433 
1434           xr = 0;
1435 
1436           do while (xr < stringl);
1437 
1438 /* search from the right, only last kill is interesting */
1439 
1440                xr = stringl - index (reverse (based_string), kill_char);
1441 
1442                if xr < stringl                              /* found one */
1443                then do;
1444                     xr = xr + 1;                            /* makes xr actual index of kill */
1445 
1446                     if ^escaped ()                          /* it's a real kill */
1447                     then do;
1448                          source_ptr, stringp = addr (stringp -> based_chars (xr));
1449                                                             /* point to char after kill */
1450                          source_len = source_len - xr;
1451                          xr = stringl;                      /* so as not to index again */
1452                     end;
1453 
1454                     else do;                                /* it was escaped, we must scan rest of string */
1455                          stringl = xr - 2;
1456                          xr = 0;
1457                     end;
1458                end;
1459           end;                                              /* finished with kills */
1460 
1461 
1462 /*^L*/
1463 /* now erase */
1464 
1465           stringl = source_len;
1466           target_len = 0;
1467           xr = 1;
1468 
1469           do while (xr ^= 0 & stringl > 0);
1470                xr = index (based_string, erase_char);       /* look for first erase */
1471 
1472                if xr = 1                                    /* first char */
1473                then do;
1474                     if target_len ^= 0                      /* if not first char in whole string */
1475                     then do;                                /* we have to erase some already copied chars */
1476                          bx = verify (reverse (based_target), right_motion);
1477                                                             /* skip white space */
1478                          if bx = 0                          /* all white */
1479                          then do;
1480                               target_ptr = old_targetp;     /* wipe it all out */
1481                               target_len = 0;
1482                          end;
1483 
1484                          else do;
1485                               if bx ^= 1                    /* there's some white space */
1486                               then ctally = bx - 1;         /* we'll erase it all */
1487                                                             /* no white, check for overstrikes */
1488                               else do ctally = 1 to target_len - 2 by 2
1489                                         while (substr (based_target, target_len - ctally, 1) = bs);
1490                               end;
1491 
1492                               target_len = target_len - ctally;
1493                               target_ptr = addr (old_targetp -> based_chars (target_len));
1494                          end;
1495                     end;
1496 
1497                     if target_len <= 0                      /* we erased whole target string */
1498                     then source_len = stringl - 1;
1499                end;
1500 
1501 /* not first char, see if it's escaped */
1502 
1503                else if xr ^= 0
1504                then do;
1505                     if escaped ()
1506                     then ctally = xr;                       /* copy everything */
1507 
1508                     else do;
1509                          bx = verify (reverse (substr (based_string, 1, xr - 1)), right_motion);
1510 
1511                          if bx = 0                          /* all white */
1512                          then ctally = 0;                   /* copy nothing */
1513 
1514                          else if bx ^= 1                    /* some white */
1515                          then ctally = xr - bx;             /* which will not be copied */
1516                          else do ctally = xr - 2 to 2 by -2 while (substr (based_string, ctally, 1) = bs);
1517                          end;
1518 
1519                     end;
1520                     if ctally > 0
1521                     then call copy_chars;
1522                     else source_len = source_len - xr;
1523                end;
1524 
1525                if xr > 0                                    /* if we're going around again */
1526                then do;
1527                     source_ptr, stringp = addr (stringp -> based_chars (xr));
1528                                                             /* point past erase */
1529                     stringl = stringl - xr;
1530                end;
1531           end;                                              /* end of erase search */
1532 
1533           if target_len > 0                                 /* if we moved any */
1534           then do;
1535                if stringl > 0                               /* if there are any more */
1536                then do;
1537                     ctally = stringl;
1538                     call copy_chars;
1539                end;
1540 
1541                source_len = target_len;
1542                source_ptr = old_targetp;
1543                target_ptr = old_sourcep;                    /* switch buffers */
1544           end;
1545 
1546           return;
1547 
1548      end process_erase_kill;                                /* end of erase-kill phase */
1549 ^L
1550 process_escape_break:
1551      proc;
1552 
1553 /*
1554    This procedure processes a break character if it was proceded by an escape character
1555    in which case, it is not counted as a real break character
1556 */
1557           old_targetp = target_ptr;
1558           target_len = 0;
1559           break_found = "0"b;
1560           stringp = source_ptr;
1561           stringl = source_len;
1562           util.tablep = tctp;
1563 
1564           do while (stringl > 0);
1565 
1566 /* scan for interesting char */
1567 
1568                call tty_util_$tct (addr (util));
1569 
1570                if util.indicator = 0 & stringl = 0 & target_len = 0
1571                                                             /* never no nothing */
1572                then ;
1573 
1574                else do;                                     /* there's work to do */
1575                     if ctally > 0                           /* copy uninteresting characters */
1576                     then do;
1577                          old_sourcep = source_ptr;
1578                          call copy_chars;
1579                     end;
1580 
1581                     if indicator = BREAK_CHAR               /* break char */
1582                     then call process_break_char;
1583 
1584                     else if indicator = ESCAPE_CHAR         /* escape char */
1585                     then do;
1586                          if ^tcb.escm                       /* we're not escaping */
1587                               | stringl <= 1                /* there's nothing after it */
1588                          then call insert_and_update;
1589                          else call process_escape_char;
1590                     end;
1591 
1592 
1593                     else if indicator = THROW_AWAY          /* throw away */
1594                     then call skip (1);
1595 
1596                     else if indicator = FORM_FEED           /* form feed */
1597                     then do;
1598                          if tcb.linemax > 0                 /* using page length */
1599                          then call skip (1);                /* so throw form feed away */
1600 
1601                          else call insert_and_update;
1602                     end;
1603 
1604                     else if indicator = HARDWARE_CONTROL    /* hardware control sequence */
1605                     then if ^tcb.modes.control              /* no control chars wanted */
1606                          then do;
1607                               call skip (2);                /* skip this and following char */
1608                               if stringl < 0                /* there wasn't another one */
1609                               then throw_away = "1"b;       /* we'll throw away first if we go around again */
1610                          end;
1611                          else call insert_and_update;
1612 
1613                     else if indicator ^= 0                  /* what else could it be? */
1614                     then do;
1615                          nelemt = 0;                        /* nothing for you, chief */
1616                          ercode = error_table_$improper_data_format;
1617                          go to all_done;
1618                     end;
1619 
1620                     source_ptr = stringp;
1621                end;
1622           end;
1623 
1624           return;
1625 
1626      end process_escape_break;                              /* of tct loop */
1627 ^L
1628 process_break_char:
1629      proc;
1630 
1631 /*
1632    This procedure processes the actual break character and manipulates the white space as necessary
1633 */
1634           break_found = "1"b;                               /* it can't be escaped or we'd have found the escape */
1635 
1636           if tcb.canm
1637           then if ctally > 0                                /* scan back for preceding white space */
1638                then do;
1639                     bx = verify (reverse (substr (based_source, 1, ctally)), right_motion) - 1;
1640 
1641                     if bx < 0                               /* all white */
1642                     then bx = ctally;
1643 
1644                     if bx > 0                               /* any white */
1645                     then do;
1646                          target_len = target_len - bx;
1647                          target_ptr = addr (old_targetp -> based_chars (target_len));
1648                     end;
1649                end;
1650 
1651 /* target_ptr shows where to put nl now in any case */
1652 
1653           call insert_and_update;
1654 
1655           return;
1656 
1657      end process_break_char;
1658 ^L
1659 process_escape_char:
1660      proc;
1661 
1662 /* This procedure does the processing of a character if it is proceded by
1663    an escape character
1664 */
1665           if ctally > 0                                     /* check for overstruck escape */
1666           then do;
1667                i = -1;                                      /* necessary to make compiler accept next statement */
1668                if stringp -> based_chars (i) = bs
1669                then do;
1670                     call insert_and_update;
1671                     return;
1672                end;
1673           end;
1674 
1675           next_char = stringp -> based_chars (1);
1676           if next_char = bs
1677           then do;
1678                call insert_and_update;
1679                return;
1680           end;
1681 
1682           if stringl > 2                                    /* check for following character overstruck */
1683           then if stringp -> based_chars (2) = bs
1684                then do;
1685                     call insert_and_update;
1686                     return;
1687                end;
1688 
1689           if tctp -> table (rank (next_char)) = 2 |         /* next char is escape */
1690                next_char = tcb.erase | next_char = tcb.kill
1691           then do;
1692 
1693                stringp = addr (stringp -> based_chars (1)); /* skip over escape */
1694                stringl = stringl - 1;
1695                call insert_and_update;                      /* put in following char as is */
1696                return;
1697           end;
1698 
1699 /*^L*/
1700 /* check for octal escape */
1701 
1702           digit = char_value (next_char);
1703           if digit >= 0
1704           then do;                                          /* we have octal digit(s) */
1705 
1706                octal.result = 0;
1707                stringp = addr (stringp -> based_chars (1)); /* look at next */
1708 
1709                do i = 1 to 3 while (digit >= 0);
1710                     octal.result = 8 * octal.result + digit;
1711 
1712                     if stringl > i & i < 3
1713                     then do;
1714                          digit = char_value ((stringp -> based_chars (i)));
1715                          if digit >= 0                      /* next char is digit, see if it's overstruck */
1716                          then if stringl > i + 1
1717                               then if stringp -> based_chars (i + 1) = bs
1718                                    then digit = -1;
1719                     end;
1720 
1721                     else digit = -1;                        /* no more chars, or we already have 3 */
1722                end;
1723 
1724                call insert_char ((addr (octal.result) -> based_one_char));
1725                stringp = addr (stringp -> based_chars (i - 1));
1726                                                             /* skip over octal digits */
1727                stringl = stringl - i;
1728           end;
1729 
1730 /*^L*/
1731 /* see if it's escaped newline (with possible intervening white space) */
1732 
1733           else if verify (substr (based_string, 2, stringl - 2), right_motion) = 0
1734                     & substr (based_string, stringl, 1) = nl
1735           then do;
1736                if stringl = source_len                      /* first thing in the string? */
1737                then source_len = 0;                         /* then nothing */
1738                stringl = 0;                                 /* we've reached end */
1739           end;
1740 
1741           else do;                                          /* look up next_char in input escape table */
1742                if special_ptr = null                        /* no table means no escapes */
1743                then call insert_and_update;
1744                else if special_ptr -> special_chars.input_escapes.len = 0
1745                then call insert_and_update;
1746 
1747                else do;
1748                     xr = index (special_ptr -> special_chars.input_escapes.str, next_char);
1749                     if xr ^= 0                              /* it's there */
1750                     then do;
1751                          call insert_char ((substr (special_ptr -> special_chars.input_results.str, xr, 1)));
1752                          stringp = addr (stringp -> based_chars (2));
1753                                                             /* point past escape sequence */
1754                          stringl = stringl - 2;
1755                     end;
1756 
1757                     else call insert_and_update;
1758                end;
1759           end;
1760 
1761           return;
1762 
1763      end process_escape_char;                               /* of escape character */
1764 ^L
1765 insert_and_update:
1766      proc;
1767 
1768 /*
1769    This procdure passes insert_char a character pointed to by stringp
1770    to be inserted, then it updates the string pointer and the
1771    string length
1772 */
1773 
1774           call insert_char ((stringp -> based_one_char));
1775           stringp = addr (stringp -> based_chars (1));
1776           stringl = stringl - 1;
1777 
1778           return;
1779 
1780      end insert_and_update;
1781 
1782 ^L
1783 is_parent_mpx:                                              /* Check match of channel's parent mpx type against input mpx type */
1784      proc (parent_mpx_type) returns (bit (1));
1785 
1786 dcl parent_mpx_type fixed bin;
1787 dcl temp_lctep ptr;
1788 
1789           lctep = addr (lct.lcte_array (devx));
1790           if lcte.major_channel_devx ^= 0 then do;
1791                temp_lctep = addr (lct.lcte_array (lcte.major_channel_devx));
1792                if temp_lctep->lcte.channel_type = parent_mpx_type then return ("1"b);
1793           end;
1794           else if lcte.channel_type = parent_mpx_type then return ("1"b);
1795           return ("0"b);
1796      end is_parent_mpx;
1797 
1798      end /* tty_read */;