1 /* ***********************************************************
   2    *                                                         *
   3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   4    *                                                         *
   5    * Copyright (c) 1972 by Massachusetts Institute of        *
   6    * Technology and Honeywell Information Systems, Inc.      *
   7    *                                                         *
   8    *********************************************************** */
   9 
  10 
  11 edm: proc;
  12 
  13 /* recoded to take advantage of eis and to be less memory intensive: RMullen 1/74 */
  14 /* move request added: RMullen Autumn '75 */
  15 /* Sept 1983 C Spitzer: bug fixes applied.
  16              phx2205: terminate segs when cleaning up.
  17              phx3368, phx13842: use terminate_file_ to zero chars in last word
  18              phx6041: use check_entryname_ on requested path on command line.
  19              phx6407: move data then truncate so don't get rqo in ring 0.
  20 */
  21 
  22 %include set_wakeup_table_info;
  23 %include access_mode_values;
  24 %include terminate_file;
  25 
  26 dcl 1 swt aligned static like swt_info;
  27 dcl  iox_$modes entry (ptr, char (*), char (*), fixed bin (35));
  28 dcl  iox_$user_io ptr ext;
  29 dcl  error_table_$bad_mode fixed bin (35) ext;
  30 dcl  waketable_is_set bit (1) init (""b);
  31 
  32 dcl  readysw bit (1) aligned init ("0"b);
  33 dcl  cv_dec_check_ entry (char (*)aligned, fixed bin (35)) returns (fixed bin);
  34 dcl (M, N) fixed bin (21);
  35 dcl  ready ext entry;
  36 
  37 dcl 1 edata aligned,                                        /* info about state of temp files */
  38     2 upper,                                                /* these items sometimes saved seperately */
  39       3 fptr ptr,                                           /* points to base of fromfile */
  40       3 indf fixed bin (21) init (0),                       /* current position in fromfile */
  41       3 iflag bit (1) aligned init ("1"b),                  /* "1" => nothing is in fromfile yet */
  42       3 csize1 fixed bin (24) init (0),                     /* offset of last char in fromfile */
  43       3 pad1 fixed bin,
  44     2 tptr ptr,                                             /* points to base of tofile */
  45     2 indt fixed bin (21) init (0),                         /* current position in tofile */
  46     2 eof_ bit (1) aligned init ("0"b),                     /* "1"b => at end of fromfile */
  47     2 changed bit (1) aligned init ("0"b),                  /* "1"b => text changed since last write */
  48     2 lngth fixed bin (17) init (0),                        /* length of current line in chars */
  49     2 curlino fixed bin (21) init (1),                      /* if not -1, is current line number */
  50     2 isok fixed bin (17) init (0);                         /* if not -1, is number of chars in tofile ident to fromfile */
  51 dcl  line char (152) aligned;
  52 
  53 dcl 1 Edata_pi like edata aligned;                          /* edata placed here, in case of pi */
  54 
  55 dcl  pi_allowed bit (1) aligned init ("0"b);
  56 
  57 dcl  Line_pi char (152) aligned;
  58 
  59 dcl 1 move_data aligned,                                    /* info to undo move at pi-time */
  60     2 (x1, x2, xlen, y1, y2, ylen) fixed bin (21);
  61 
  62 dcl  did_move bit (1) aligned init ("0"b);
  63 
  64 dcl  buffer char (152) aligned;
  65 dcl  bufp ptr;
  66 dcl  sptr ptr init (null),
  67 
  68      orig_ptr ptr;
  69 
  70 dcl  b168cu char (168) unal based;
  71 dcl  b32cu char (32) unal based;
  72 
  73 dcl  scanlen fixed bin (17);
  74 
  75 dcl (g_lines, g_chars, mg_lines, mg_chars) fixed bin (21);
  76 
  77 dcl (mc_skip, mc_chars) fixed bin (21);
  78 dcl  chunk fixed bin (21) init (512);                       /* try to deal with about this many chars */
  79 dcl (bkover, cgscanlen, xxxx, tnx) fixed bin (21);
  80 
  81 dcl (bklen, nbk, nxlen) fixed bin (21);
  82 
  83 dcl  printing fixed bin;
  84 dcl  locating fixed bin;
  85 
  86 dcl  locstring char (152) aligned init ("
  87 ");
  88 dcl (loclen, locend) fixed bin;
  89 dcl  skipblank fixed bin;
  90 dcl  where_found fixed bin;
  91 dcl  locp pointer;
  92 dcl  trick_ptr ptr;
  93 dcl  me char (4) static aligned init ("edm ");
  94 dcl  active fixed bin static init (0);                      /* Are there active invocations of edm */
  95 
  96 dcl  status bit (72) aligned,
  97     (m, ij, ii) fixed bin (21),
  98      error_message char (33) aligned init ("Line too long. Max length is 152.") static,
  99      string char (262144) aligned based,
 100      arg char (lname) based (np) unaligned,                 /* input argument */
 101      xarg char (lprinam) based (np) unal,                   /* pathname arg of merge, write, or split request */
 102     (error_table_$noentry, error_table_$noarg) fixed bin (35) ext,
 103      error_table_$no_w_permission fixed bin(35) ext static,
 104     (iox_$user_input, iox_$user_output) ptr ext,
 105      code fixed bin (35),
 106      type fixed bin (2),
 107     (edct, num_err, cm1) fixed bin (17),
 108     (i, j, k, n) fixed bin (21),
 109      l fixed bin (17),
 110      sw_pi bit (1) aligned init ("0"b),
 111      gotlino fixed bin (21),
 112      prc fixed bin (17),
 113      count fixed bin (17),
 114     (lname, lprinam) fixed bin (17),
 115      located bit (1),
 116      temp1 bit (1),
 117      brief bit (1),
 118      break char (1) aligned,
 119      cwd char (1) aligned,
 120     (rrs init ("^N"), brs init ("^O"), nl init ("
 121 ")) char (1) aligned static,                                /* Color-shift, <NL> chars */
 122      saveflag fixed bin (17),
 123      tlin char (152),
 124      olin char (456) aligned,
 125                                                             /* TEDLIN char (152), */
 126      int_lab label init (pedit);                            /* non_local go to from program interrupt handler */
 127 dcl  np ptr;
 128 
 129 dcl (ptr1 init (null),
 130      ptr2) int static ptr;
 131 
 132 dcl
 133      iox_$get_line entry (ptr, ptr, fixed bin (17), fixed bin (17), fixed bin (35)),
 134      hcs_$truncate_seg entry (ptr, fixed bin (21), fixed bin (35)),
 135      cu_$cp entry (ptr, fixed bin (17), fixed bin (35)),
 136      hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)),
 137      cu_$arg_ptr entry (fixed bin (17), ptr, fixed bin (17), fixed bin (35)),
 138     (com_err_, command_query_) entry options (variable),
 139      iox_$control entry (ptr, char (*) aligned, ptr, fixed bin (35)),
 140      ioa_ entry options (variable),
 141      initiate_file_ entry (char(*), char(*), bit(*), ptr, fixed bin(24), fixed bin(35)),
 142      terminate_file_ entry (ptr, fixed bin(24), bit(*), fixed bin(35)),
 143      expand_pathname_ entry (char(*), char(*), char(*), fixed bin(35)),
 144      check_entryname_ entry (char (*), fixed bin (35)),
 145      hcs_$status_mins entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35)),
 146      iox_$put_chars entry (ptr, ptr, fixed bin (17), fixed bin (35));
 147 
 148 dcl  segsize fixed bin (21);
 149 dcl  merge_bc fixed bin (24);
 150 
 151 dcl (cleanup, program_interrupt) condition;
 152 
 153 dcl (addr, divide, fixed, index, min, mod, null, reverse, substr, unspec, verify) builtin;
 154 
 155 dcl 1 query_info static aligned,
 156     2 version fixed bin init (2),
 157     2 yes_no bit (1) unal init ("1"b),
 158     2 suppress_name bit (1) unal init ("0"b),
 159     2 status fixed bin init (0),
 160     2 query fixed bin init (0);
 161 
 162 dcl  answer char (4) varying;
 163 
 164 dcl  com_line char (cm1) aligned based (bufp);
 165 dcl (dnp, enp) ptr;                                         /* to point at dirname(o), ename(o) */
 166 
 167 dcl (ename, enameo) char (32),
 168     (dirname, dirnameo) char (168);
 169 
 170 dcl pad_count fixed bin;                                    /* number of pad zeros that go in last word */
 171 
 172 /* ^L */
 173 
 174           lname = 0;
 175           brief = "0"b;
 176           prc = 152;
 177 
 178           bufp = addr (buffer);
 179 
 180 /* Now get pointers to the buffers */
 181 
 182           Edata_pi.changed = "0"b;
 183 
 184           if ptr1 = null then do;                           /* First time, get permanent pointers */
 185                call hcs_$make_seg ("", "temp1_", "", 1010b, ptr1, code);
 186                call hcs_$make_seg ("", "temp2_", "", 1010b, ptr2, code);
 187           end;
 188           else if active ^= 0 then do;
 189                call command_query_ (addr (query_info), answer, me,
 190                     "Pending work in previous invocation will be lost if you proceed;^/do you wish to proceed?");
 191                if answer ^= "yes" then go to return;
 192                else go to truncate_temp;
 193           end;
 194           else do;
 195 truncate_temp: call clean;
 196           end;
 197 
 198           active = active + 1;                              /* Set flag saying we're now working */
 199 
 200 /* Now establish a handler for cleanup condition */
 201 
 202           on cleanup call clean;
 203 
 204 /* ^L */
 205 /* Now check to see if an input argument was given */
 206 
 207           call cu_$arg_ptr (1, np, lname, code);
 208           if code ^= 0 then if code = error_table_$noarg then go to finput; /* if no arguments, go to input mode */
 209                else do;
 210                     call com_err_ (code, me);
 211                     go to exit;
 212                end;
 213 
 214           if lname = 0 then go to finput;                   /* If none given, go to input mode */
 215 
 216 /* Now get a pointer to the segment to be edited */
 217 
 218           call expand_pathname_ (arg, dirnameo, enameo, code);
 219           if code ^= 0 then do;
 220 
 221                call com_err_ (code, me, "^a", arg);
 222                go to exit;
 223           end;
 224 
 225 /* Is it a valid entry name? */
 226 
 227           call check_entryname_ (enameo, code);
 228           if code ^= 0 then do;
 229                call com_err_ (code, me, "^a", enameo);
 230                goto exit;
 231                end;
 232 
 233           call initiate_file_ (dirnameo, enameo, RW_ACCESS, sptr, edata.csize1, code); /* Initiate the segment */
 234 
 235 /* Check to see that the segment is there */
 236 
 237           if sptr = null then do;
 238                if code = error_table_$no_w_permission then do;
 239                     call initiate_file_ (dirnameo, enameo, R_ACCESS, sptr, edata.csize1, code);
 240                     if sptr ^= null then goto have_seg_ptr;
 241                     end;
 242                if code = error_table_$noentry then do;
 243                     call ioa_ ("Segment not found.");
 244                     orig_ptr = null;
 245                     go to finput;
 246                end;
 247                else do;                                     /* bad news indeed */
 248                     dnp = addr (dirnameo);
 249                     enp = addr (enameo);
 250                     call COM_DE;
 251                     go to exit;
 252                end;
 253           end;
 254 
 255 have_seg_ptr:
 256           edata.csize1 = divide (edata.csize1, 9, 24, 0);   /* change bit count to char count */
 257           if edata.csize1 ^= 0 then if substr (sptr -> string, edata.csize1, 1) ^= nl
 258                then call com_err_ (0, me, "Warning --- ^a does not end in newline.", enameo);
 259 
 260 /* ^L */
 261 /* Dispatch on the command character */
 262 
 263           edata.fptr, orig_ptr = sptr;
 264           edata.tptr = ptr1;
 265           edata.iflag = "0"b;
 266           on program_interrupt call interrupt;
 267           sw_pi = "1"b;                                     /* note pi_handler set up */
 268 
 269 pedit:                                                      /* here from input,comment,pi */
 270           call SAVE;                                        /* save info about buffers */
 271           call ioa_ ("Edit.");
 272 next:
 273 
 274 
 275 /* DEBUGGING
 276    if readysw then call ready ();
 277    if cklinsw then call CKLINO;
 278    if ckisoksw then call CKISOK;
 279    if dumpsw then call EDUMP;                     /* END DEBUGGING */
 280           call iox_$get_line (iox_$user_input, bufp, prc, count, code);
 281           cm1 = count - 1;
 282           if cm1 = 0 then go to next;                       /* if null line then get another line, don't print error */
 283                                                             /* pi can undo last request until SAVE */
 284           call SAVE;                                        /* save info about buffers */
 285           if substr (buffer, 1, 1) = "E" then go to callms;
 286 
 287           i = verify (substr (buffer, 2, count - 1), " ");  /* find first nonblank char */
 288           if i = 0 then i = 152;                            /* SIMULATE old edm */
 289 
 290           if substr (buffer, 1, 1) = "w" then do;
 291                edct = i;                                    /* if w then all else is path */
 292                go to wsave;
 293           end;
 294 
 295           num_err = 0;                                      /* Set flag saying number OK */
 296 
 297           if cm1 = 1                                        /* If single character line, numeric value is 1 */
 298           then go to got_num_1;                             /* End of line, no number, set it to 1 */
 299 
 300           n = 0;                                            /* this section looks for and converts numbers after the */
 301                                                             /* command letter.  It leaves edct pointing to the first non- */
 302                                                             /* blank, non-numeric character.  First we initialize the value */
 303 
 304           num_err = num_err + 1;                            /* Increment it, will be cleared if # OK */
 305                                                             /* now we do the numeric conversion */
 306 num_loop: j = fixed (unspec (substr (buffer, i + 1, 1)), 9) - 110000b /* ASCII value of "0" */;
 307           if j<0 then go to got_num;                        /* if not "0-9" then end of numeric field */
 308           if j>9 then go to got_num;
 309           n = 10 * n + j;                                   /* add value found to 10*number so far */
 310           i = i + 1;
 311           if i<count-1 then go to num_loop;                 /* increment counter, and loop if not past NL */
 312           num_err = 0;                                      /* Nothing but numeric chars in line */
 313 got_num:  if n = 0 then                                     /* default is 1 not 0 */
 314 got_num_1:     n = 1;                                       /* (Here if no numeric field, eg "d<NL>") */
 315                                                             /* ^L */
 316           edct = i - 1 + verify (substr (buffer, i+1, count - i), " "); /* find first nonblank after numbers */
 317           cwd = substr (buffer, 1, 1);                      /* cmd char in col 1 */
 318 
 319           if cwd = "i" then go to insert;
 320           if cwd = "r" then go to retype;
 321           if cwd = "l" then go to locate;                   /*  */
 322           if cwd = "p" then go to print;                    /*  */
 323           if cwd = "n" then go to nexlin;
 324           if cwd = "-" then go to backup;
 325           if cwd = "c" then go to change;
 326           if cwd = "d" then go to dellin;                   /*  */
 327           if cwd = "t" then go to top;
 328           if cwd = "b" then go to bottom;
 329           if cwd = "f" then go to find;                     /*  */
 330           if cwd = "s" then go to change;
 331           if cwd = "v" then go to veron;
 332 
 333 /* DEBUGGING
 334    if cwd = "o" then go to otize;                 /* DEBUGGING */
 335           if cwd = "k" then go to veroff;
 336           if cwd = "." then do;
 337                if cm1 = 1 then go to pinput;
 338                go to request_err;
 339           end;
 340           if cwd = "=" then go to equals;                   /*  */
 341           if cwd = "," then go to comment_init;
 342 
 343           if count >= 3
 344           then if substr (buffer, 1, 2) = "qf"
 345                then go to q_force;
 346 
 347           if cwd = "q" then go to quit;
 348 
 349           if count >= 6
 350           then if substr (buffer, 1, 5) = "merge"
 351                then go to insert_file;
 352 
 353           if count >= 5 then
 354                if substr (buffer, 1, 4) = "move" then
 355                     go to move_;                            /* MOVE */
 356 
 357           if count >= 8
 358           then if substr (buffer, 1, 7) = "upwrite"
 359                then go to save_top;
 360 
 361           if count >= 9
 362           then if substr (buffer, 1, 8) = "updelete"
 363                then go to delete_top_init;
 364 
 365           call com_err_ (0, me, "Not a request: ^a", com_line);
 366 reset_io:
 367           call iox_$control (iox_$user_input, "resetread", null (), code);
 368           go to next;
 369 numeric_err:
 370           call com_err_ (0, me, "Non-numeric characters in numeric argument: ^a", com_line);
 371           go to reset_io;
 372 request_err:
 373           call com_err_ (0, me, "Text follows logical end of request, request ignored: ^a", com_line);
 374           go to reset_io;
 375                                                             /* ^L */
 376 
 377 /* ********* verify -- on and off ********* */
 378 
 379 veron:    if cm1 ^= 1 then go to request_err;
 380           else do;
 381                brief = "0"b;
 382                go to next;
 383           end;
 384 
 385 veroff:   if cm1 ^= 1 then go to request_err;
 386           else do;
 387                brief = "1"b;
 388                go to next;
 389           end;
 390 
 391 /* ********* input mode ********* */
 392 
 393 finput:   edata.fptr = ptr1; edata.tptr = ptr2;
 394           call SAVE;                                        /* save info about buffers */
 395           if ^sw_pi then do;
 396                on program_interrupt call interrupt;
 397                sw_pi = "1"b;
 398           end;
 399 pinput:   call ioa_ ("Input.");                             /* print word "Input" */
 400           call INPUT;
 401           go to pedit;                                      /* retn to editing */
 402 
 403 /* ********** comment ******************* */
 404 
 405 comment_init:
 406           if cm1 ^= 1 then go to request_err;
 407 
 408 comment:  if edata.eof_ then go to eof;                     /* stop commenting at end of file */
 409           if edata.lngth = 1 then go to cnoline;            /* don't print blank lines */
 410           if edata.lngth = 0 then go to cnoline;            /* ignore no lines */
 411           call iox_$put_chars (iox_$user_output, addr (line), edata.lngth-1, code); /* write line minus NL */
 412           call iox_$get_line (iox_$user_input, bufp, prc, count, code); /* read addition to line */
 413           if count = 2 then                                 /* check for mode change */
 414                if substr (buffer, 1, 1) = "." then go to pedit;
 415           if count > 1 then do;
 416                edata.changed = "1"b;
 417                edata.isok = -1;
 418           end;
 419           substr (line, edata.lngth, count) = substr (buffer, 1, count); /* add new part to line */
 420           edata.lngth = edata.lngth + count - 1;            /* update count */
 421 cnoline:  call PUT;                                         /* add to main file */
 422           call GET;                                         /* get next line for commenting */
 423           go to comment;                                    /* repeat */
 424                                                             /* ^L */
 425 
 426 /* ********** print line number ********* */
 427 
 428 equals:   if cm1 ^= 1 then go to request_err;               /* = alone on line */
 429           if edata.curlino = -1 then do;                    /* ! */
 430                call GET_LINO;                               /* ! */
 431 GET_LINO:      proc;
 432                     if edata.isok ^= -1 then trick_ptr = edata.fptr; /* touch from file preferentially */
 433                     else trick_ptr = edata.tptr;            /* unless tofile is different from fromfile */
 434                     i = 1;
 435                     k = edata.indt;
 436                     do gotlino = 1 by 1 while (k ^= 0);     /* count number of nls */
 437                          k = index (substr (trick_ptr -> string, i, edata.indt-i), nl);
 438                          i = i + k;
 439                     end;
 440                     if edata.indt = 0 then if edata.indf ^= 0 then gotlino = 1; /* begining of file */
 441                end GET_LINO;
 442                edata.curlino = gotlino;                     /* ! */
 443           end;                                              /* ! */
 444           else do;                                          /* ! */
 445                gotlino = edata.curlino;                     /* ! */
 446                if gotlino = 0 then gotlino = 1;             /* ! */
 447           end;                                              /* ! */
 448           call ioa_ ("^d", gotlino);
 449           go to next;                                       /* ! */
 450 
 451 
 452 /* ^L */
 453 /* ********* delete ********* */
 454 dellin:   if num_err ^= 0 then go to numeric_err;           /* use getlines, dont move to tofile */
 455           if edata.eof_ then go to eof;
 456           if edata.lngth ^= 0 then do;
 457                edata.changed = "1"b;
 458                edata.isok = -1;
 459                edata.lngth = 0;                             /* leave him at Noline. */
 460           end;
 461           if n - 1 > 0 then do;                             /* if more than current line to delete */
 462                mg_lines = n-1;                              /* delete this many more */
 463                mg_chars = edata.csize1 - edata.indf;        /* up to eof */
 464                call GET_LINES;                              /* setting g_chars, g_lines */
 465                if g_chars = 0 then g_chars = mg_chars;      /* no newlines found */
 466                if g_chars ^= 0 then do;                     /* actually deleted something */
 467                     edata.changed = "1"b;
 468                     edata.isok = -1;
 469                end;
 470                if g_lines ^= mg_lines then do;              /* wanted more than got */
 471                     edata.indf = edata.csize1;              /* swallow rest of fromfile */
 472                     edata.eof_ = "1"b;
 473                     go to eof;
 474                end;
 475                else edata.indf = edata.indf + g_chars;
 476           end;
 477           go to next;                                       /* else keep quiet */
 478 
 479 /* ********* insert ********* */
 480 
 481 insert:   call PUT;                                         /* add current line to file */
 482 retype:                                                     /* doubles as retype com. without above */
 483           if substr (buffer, 2, 1) = " " then skipblank = 1;else skipblank = 0;
 484           edata.lngth = count - skipblank - 1;
 485           if edata.lngth ^= 0 then
 486                substr (line, 1, edata.lngth) = substr (buffer, skipblank + 2, edata.lngth); /* add replaced (inserted) line */
 487           edata.changed = "1"b;                             /* text changed */
 488           edata.eof_ = "0"b;                                /* not EOF now */
 489           edata.isok = -1;
 490           go to next;
 491 
 492 /* ^L */
 493 /* ********* next + print ********* */
 494 
 495 nexlin:   printing = 0;go to NPSET;                         /* go to nth follwing line */
 496 print:    printing = 1;                                     /* print curline + n-1 following lines */
 497                                                             /* There are two obvious strategies. */
 498                                                             /* One is to move the lines to tofile as */
 499                                                             /* they are counted.  That way we never have */
 500                                                             /* to double back and touch the same text twice. */
 501                                                             /* The other way is to count ahead n lines, */
 502                                                             /* and then move them all at once to the tofile. */
 503                                                             /* That way the move part of the operation is faster. */
 504                                                             /* On balance the first way is cheaper, at least for */
 505                                                             /* large n.  However it uses measurably more cpu */
 506                                                             /* and so the following compromise was devised which */
 507                                                             /* has the advantages of both, taking the  */
 508                                                             /* lesser working set of the first method */
 509                                                             /* and the increased speed of the second. */
 510                                                             /* This is basicaly the first method, taking */
 511                                                             /* account of the fact that an "mlr" of one line */
 512                                                             /* (say 8 words) is about half as efficent */
 513                                                             /* as a long "mlr", by moving approx chunk chars */
 514                                                             /* when possible. */
 515 NPSET:
 516           if num_err ^= 0 then go to numeric_err;           /* p, n take number only */
 517           if printing ^= 0 then do;
 518                if n = 1 then go to NPFIN;                   /* just print current line */
 519                else do;
 520                     if edata.eof_ then go to eof;           /* make wure not at eof already */
 521                     n = n - 1;                              /* print 10 touches one less line than next 10 */
 522                     call PRINT_CURLINE;                     /* because it prints and counts the curline */
 523                end;
 524           end;
 525 
 526           call PUT;                                         /* put away curline */
 527           mg_lines = n - 1;
 528           tnx = edata.csize1 - edata.indf;                  /* max num of chars to move */
 529           g_chars = 0;                                      /* this many done so far */
 530           g_lines = 0;                                      /*        "         */
 531 NPLOOP:
 532           mg_lines = mg_lines - g_lines;                    /* find num of lines left to move */
 533           if mg_lines = 0 then go to NPGET;                 /* have done all lines requested, less one */
 534           mg_chars = min (chunk, tnx);                      /* max num to move at once is chunk */
 535           if mg_chars = 0 then go to NPGET;
 536 
 537           call GET_LINES;                                   /* get up to mg_lines, totaling <= mg_chars */
 538           if g_chars = 0 then g_chars = mg_chars;           /* no more <nl>, take all */
 539           if printing ^= 0 then
 540                call iox_$put_chars (iox_$user_output, addr (substr (edata.fptr -> string, edata.indf+1, 1)), (g_chars), code);
 541           call MOVE_CHARS;                                  /* moves these lines, step ptrs & curlino */
 542           tnx = tnx - g_chars;
 543           go to NPLOOP;
 544 
 545 NPGET:    call GET;                                         /* always get line, except for p1 */
 546 NPFIN:
 547           if edata.eof_ then go to eof;
 548           else if printing ^= 0 then call PRINT_CURLINE;    /* print req, must print */
 549           else if ^brief then call PRINT_CURLINE;           /* next req, maybe print */
 550           go to next;
 551 
 552 /* ^L */
 553 /* ********* locate & find ********* */
 554 
 555 find:     locating = 0; go to FLSET;
 556 locate:   locating = 1;
 557                                                             /* locstring has last string specified for */
 558                                                             /* find or locate, with a newline tacked on the */
 559                                                             /* front of the string.  If we are to do a */
 560                                                             /* locate, we just set a pointer and a length */
 561                                                             /* so as to not see that newline. */
 562                                                             /* After we have tried to locate the string */
 563                                                             /* the idea is to move as little text around */
 564                                                             /* as possible. Clearly when the search fails */
 565                                                             /* no text need be moved at all. */
 566 
 567 FLSET:
 568           if count ^= 2 then do;                            /* new string given to be located */
 569                if substr (buffer, 2, 1) = " " then skipblank = 1; else skipblank = 0;
 570                locend = count - 1 - skipblank;              /* not counting cmd char, <nl>, or poss blank */
 571                                                             /* but counting the canned newline */
 572                substr (locstring, 2, locend - 1)            /* follow canned leading newline in locstring */
 573                     = substr (buffer, 2 + skipblank, locend - 1); /* with string to be found */
 574           end;
 575           else if locend = 1 then go to incmplt;            /* has never been set evidently */
 576 
 577           locp = addr (substr (locstring, 1 + locating, 1)); /* no leading <nl> for locate */
 578           loclen = locend - locating;                       /* so string is one char shorter for now */
 579 
 580           call FIND_LOCATE;
 581           if where_found = 0 then do;                       /* not found */
 582                call com_err_ (0, me, "Search failed.");
 583                go to reset_io;
 584           end;
 585 
 586           if where_found = 1 then do;                       /* found in fromfile */
 587                call PUT;                                    /* put away curline */
 588                if k ^= 0 then do;
 589                     g_chars = k;                            /* set arg for move */
 590                     edata.curlino = -1;                     /* lose track of line num */
 591                     call MOVE_CHARS;
 592                end;
 593           end;
 594           else do;                                          /* found in tofile */
 595                edata.curlino = -1;                          /* lose line num */
 596                if edata.isok ^= -1 then do;                 /* tofile identical to fromfile, dont move text */
 597                     edata.indf, edata.indt = k;             /* presto, changeo */
 598                     go to FLFIN;                            /* where we pick up new curline */
 599                end;
 600                bkover = edata.indt - k;                     /* compute amount to back up over */
 601                if edata.fptr ^= orig_ptr then               /* not users file */
 602                     if bkover + edata.lngth < edata.indf then /* and will fit in fromfile */
 603                          if bkover < edata.csize1 - edata.indf + k /* and cheaper */
 604                          then do;                           /* then take shortcut */
 605                               call COPY_BACK;
 606                               go to FLFIN;
 607                          end;
 608                call COPY;
 609                call SWITCH;
 610                g_chars = k;                                 /* set arg for move */
 611                call MOVE_CHARS;
 612           end;
 613 FLFIN:
 614           call GET;                                         /* pick up new current line */
 615           if ^brief then call PRINT_CURLINE;
 616           go to next;
 617 
 618 /* ^L */
 619 /* ********* change ********* */
 620 
 621 change:
 622           located = "0"b;
 623           if edct = cm1
 624           then do;
 625 incmplt:       call com_err_ (0, me, "Incomplete request: ^a", com_line);
 626                go to reset_io;
 627           end;
 628           break = substr (buffer, edct + 1, 1);
 629           i = index (substr (buffer, edct+2, count-edct-2), break);
 630           if i = 0 then go to incmplt;
 631           j = index (substr (buffer, i+edct+2, count-edct-i-2), break);
 632           if j = 0 then j = count-i-edct-1;                 /* Final break char not required */
 633           else if (edct + i + j + 2) ^= count
 634           then go to request_err;
 635                                                             /* Extra stuff in request line */
 636           if edata.lngth = 0 then go to chnoline;           /* no current line */
 637 ch1:      temp1 = "0"b;                                     /* to indicate if anything was c'd on line */
 638           m, ij, l = 1;                                     /* indexes to strings */
 639 
 640           if i = 1 then do;                                 /* add to begining of line */
 641                ij = j + edata.lngth -1;
 642                if ij > 152 then do;
 643 LONG_ERROR:
 644                     call com_err_ (0, me, "Change would result in too long a line. Max length is 152. Request ignored:^/ ^a",
 645                          com_line);
 646                     go to reset_io;
 647                end;
 648                temp1, located = "1"b;
 649                if j ^= 1 then substr (tlin, 1, j-1) = substr (buffer, edct+i+2, j-1); /* copy part to be added */
 650                substr (tlin, j, edata.lngth) = substr (line, 1, edata.lngth); /* copy old line */
 651                if ^brief then do;
 652                     substr (olin, 1, 1) = rrs;              /* shift to red for printed line */
 653                     if j ^= 1 then substr (olin, 2, j-1) = substr (buffer, edct+i+2, j-1); /* copy */
 654                     substr (olin, j+1, 1) = brs;            /* black */
 655                     substr (olin, j+2, edata.lngth) = substr (line, 1, edata.lngth);
 656                     l = j + edata.lngth +1;
 657                end;
 658           end;
 659           else do;                                          /* string to other string */
 660 ch2:           if edata.lngth = m then k = 0;
 661                else k = index (substr (line, m, edata.lngth-m), substr (buffer, edct+2, i-1)); /* locate what is to be changed */
 662                if k ^= 0 then do;
 663                     if (ij+k-2) > 152 then go to LONG_ERROR;
 664                     if k ^= 1 then substr (tlin, ij, k-1) = substr (line, m, k-1); /* copy line up to change */
 665                     if j ^= 1 then substr (tlin, ij+k-1, j-1) = substr (buffer, edct+i+2, j-1); /* put in change */
 666                     if ^brief then do;
 667                          if k ^= 1 then substr (olin, l, k-1) = substr (line, m, k-1);
 668                          substr (olin, l+k-1, 1) = rrs;     /* red */
 669                          if j ^= 1 then substr (olin, l+k, j-1) = substr (buffer, edct+i+2, j-1);
 670                          substr (olin, l+k+j-1, 1) = brs;   /* black */
 671                          l = l + k + j;
 672                     end;
 673                     m = m + k + i - 2;                      /* increment indexes */
 674                     ij = ij + k + j - 2;
 675                     temp1, located = "1"b;                  /* indicate that you did someting */
 676                     go to ch2;
 677                end;
 678                ii = ij + edata.lngth - m;
 679                if ii > 152 then go to LONG_ERROR;
 680                if temp1 then do;
 681                     if edata.lngth-m+1 ^= 0 then
 682                          substr (tlin, ij, edata.lngth-m+1) = substr (line, m, edata.lngth-m+1); /* copy rest of line */
 683                     ij = ii;
 684                     if ^brief then do;
 685                          if edata.lngth-m+1 ^= 0 then
 686                               substr (olin, l, edata.lngth-m+1) = substr (line, m, edata.lngth-m+1);
 687                          l = l + edata.lngth - m;
 688                     end;
 689                end;
 690           end;
 691           if temp1 then do;
 692                substr (line, 1, ij) = substr (tlin, 1, ij);
 693                edata.lngth = ij;
 694                edata.changed = "1"b;                        /* the text has been changed */
 695                edata.isok = -1;                             /* tofile ^= fromfile anymore */
 696                if ^brief then call iox_$put_chars (iox_$user_output, addr (olin), l, code);
 697           end;
 698 chnoline: if n = 1 then do;                                 /* finished */
 699                if ^located then do;
 700                     call com_err_ (0, me, "Substitution failed.");
 701                     go to reset_io;
 702                end;
 703                go to next;
 704           end;
 705           n = n-1;
 706           call PUT;
 707                                                             /* NEW FAST CODE */
 708           if ^temp1 then do;                                /* Dual purpose test: always fails for s//string/ */
 709                                                             /* and prevents bad performance in case where change */
 710 CGLOOP:                                                     /* will be made on more than half the lines of a group. */
 711                if n > 1 then                                /* If not line to be stopped on */
 712                     if edata.csize1 - edata.indf > 0 then do; /* If not impending eof */
 713                          cgscanlen = min (edata.csize1 - edata.indf, chunk);
 714                          xxxx = index (substr (edata.fptr -> string, edata.indf + 1, cgscanlen), substr (buffer, edct +2, i -1));
 715                          if xxxx ^= 0 then mg_chars = xxxx;
 716                          else mg_chars = cgscanlen;
 717                          mg_lines = n - 1;
 718 
 719                          call GET_LINES;
 720                          if g_chars = 0 then                /* if no <nl> between here and xxxx */
 721                               if xxxx ^= 0 then             /* and not just flushing along */
 722                                    go to CGGET;             /* then better pick up line */
 723                          call MOVE_CHARS;
 724 
 725                          n = n - g_lines;
 726                          if xxxx = 0 then go to CGLOOP;
 727                     end;
 728           end;
 729 CGGET:                                                      /* END NEW FAST CODE */
 730           call GET;
 731           if edata.eof_ then go to eof;
 732           go to ch1;
 733                                                             /* ^L */
 734 
 735 /* ******** quit ********* */
 736 
 737 quit:
 738           if cm1 ^= 1 then go to request_err;
 739                                                             /* if user has made changes ask */
 740           if edata.changed then do;                         /* if he really wants to quit   */
 741                call command_query_ (addr (query_info), answer, me,
 742                     "Changes to text since last ""w"" request will be lost if you quit;^/do you wish to quit?");
 743                if answer ^= "yes" then go to pedit;
 744           end;
 745 
 746 q_force:  if cm1 > 2 then go to request_err;
 747           call clean;
 748 exit:     active = 0;                                       /* Reset flag */
 749           go to return;
 750                                                             /* ^L */
 751 
 752 /* ********* top ********* */
 753 
 754 top:
 755           if cm1 ^= 1 then go to request_err;               /* must be only a "t" */
 756 
 757           if edata.isok >= 0 then do;
 758                edata.indt, edata.indf = 0;
 759                go to TSET;
 760           end;
 761           if edata.indf >= edata.indt + edata.lngth         /* poss to copy back */
 762           then if edata.indt < edata.csize1 - edata.indt    /* worth copying back */
 763                then if edata.fptr ^= orig_ptr               /* and not back to users file */
 764                     then do;
 765                          bkover = edata.indt;               /* backup over whole to file */
 766                          call COPY_BACK;                    /* copy top of to to from */
 767 TSET:                    edata.lngth = 0;                   /* we're at Noline */
 768                          edata.eof_ = "0"b;                 /* no way at eof */
 769                          edata.curlino = 1;
 770                          go to next;
 771                     end;
 772 
 773           call COPY;
 774           call SWITCH;
 775           edata.curlino = 1;
 776           go to next;
 777 
 778 /* ********* bottom ********* */
 779 
 780 bottom:
 781           if cm1 ^= 1 then go to request_err;
 782           edata.curlino = -1;
 783 
 784           call COPY;
 785           edata.lngth = 0;
 786           go to pinput;
 787 
 788 /* ^L */
 789 
 790 /* ********* backup ********* */
 791 
 792 backup:                                                     /* backup n lines */
 793           if num_err ^= 0 then go to numeric_err;           /* b takes a number only */
 794 
 795           edata.eof_ = "0"b;                                /* no way to remain at eof */
 796           scanlen = edata.indt - 1;                         /* nchars in tofile, less last nl */
 797 
 798           if edata.curlino ^= -1 then do;                   /* if we know current line num */
 799                if edata.curlino <= n then do;               /* if we are sure to hit top-Noline */
 800                     bklen = 0;
 801                     scanlen = -1;                           /* so  new indt = 0, bkover = edata.indt */
 802                     nbk = edata.curlino - 1;
 803                     go to BKDO;                             /* that was easy */
 804                end;
 805           end;
 806 
 807           if edata.isok ^= -1                               /* if files the same */
 808           then trick_ptr = edata.fptr;                      /* then touch pages of fromfile */
 809           else trick_ptr = edata.tptr;                      /* else must touch tofile pages */
 810 
 811           do nbk = 0 to n - 1;                              /* see how far back to go */
 812                if scanlen <= 0 then do;                     /* at first line, its a newline only */
 813                     bklen = scanlen + 1;
 814                     if bklen = 0 then go to BKDO;           /* can't back up any further */
 815                end;
 816                else do;                                     /* there is more to scan back */
 817                     bklen = index (reverse (substr
 818                          (trick_ptr -> string, 1, scanlen)), nl); /* if nl found, line is this long */
 819                     if bklen = 0 then bklen = scanlen + 1;  /* length is what we scanned plus one */
 820                end;
 821                scanlen = scanlen - bklen;                   /*  start next scan before it */
 822           end;                                              /* unless we've backed up enough already */
 823 BKDO:                                                       /* note, line stopped on has length of bklen */
 824           g_chars = scanlen + 1;                            /* will be new indt */
 825           bkover = edata.indt - g_chars;                    /* chars between curlne and start of new curline */
 826 
 827           if edata.isok >= 0 then do;                       /* must be >= edata.indt ... */
 828                edata.indt, edata.indf = g_chars;            /* no copying needed, top of tofile is identical to fromfile */
 829                go to BKFIN;                                 /* go to load line */
 830           end;
 831 
 832           if edata.fptr ^= orig_ptr                         /* if not copying back to users file */
 833           then if edata.indf >= bkover + edata.lngth        /* if possible to copy back to fromfile */
 834                then if edata.csize1 - edata.indf + edata.indt - bkover > bkover /* and a shorter move */
 835                     then do;                                /* then ok to take shortcut */
 836                          call COPY_BACK;                    /* use bkover to modify edata, do job */
 837                          go to BKFIN;
 838                     end;
 839                                                             /* must do it the hard way */
 840           call COPY;                                        /* copy the rest of fromfile to tofile */
 841           call SWITCH;                                      /* switch buffers */
 842           call MOVE_CHARS;                                  /* load new tofile, mung line num */
 843 BKFIN:
 844           if bklen = 0 then edata.lngth = 0;                /* at top/Noline. */
 845           else call GET;                                    /* go thr GET for new curline */
 846           if Edata_pi.curlino ^= -1 then do;                /* update line number if possible */
 847                edata.curlino = Edata_pi.curlino - nbk;
 848           end;
 849           if ^brief then call PRINT_CURLINE;
 850           go to next;
 851 
 852 /* ^L */
 853 
 854 /* ********** move ********** */
 855 
 856 move_:                                                      /* code to do "move M N */
 857 
 858           if count = 5 then go to incmplt;
 859                                                             /* set i to be chars gone by */
 860           i = 4;
 861           call GET_NUM;                                     /* pickup starting linno */
 862           M = N;                                            /* subr sets N */
 863 
 864           i = i + j;
 865           if i = count - 1 then N = 1;
 866           else do;
 867                call GET_NUM;
 868                if j ^= count - i - 1 then go to request_err;
 869           end;
 870 
 871 
 872 /* Determine if move is legal */
 873 
 874           if edata.curlino = -1 then do;
 875                call GET_LINO;
 876                edata.curlino = gotlino;
 877           end;
 878 
 879           if M <= edata.curlino then
 880                if M+N > edata.curlino then do;
 881                     call com_err_ (0b, me, "Text overlaps current line.");
 882                     go to reset_io;
 883                end;
 884 
 885           Edata_pi.isok = -1;                               /* soon buffers no longer match */
 886           call CHECK_ORIG;                                  /* must not store into orig */
 887 
 888           if edata.curlino > M then do;
 889                                                             /* move from above */
 890                                                             /* copy tail of fromfile to tofile */
 891                                                             /* (will replace if pi taken) */
 892                                                             /* switch buffers */
 893                                                             /* set up the new tofile, rearranged */
 894                i = GET_BLOCK (edata.tptr, 0, edata.indt, M-1);
 895                j = GET_BLOCK (edata.tptr, i, edata.indt - i, N);
 896                k = edata.indt - i - j;
 897 
 898                substr (edata.tptr -> string, edata.indt+edata.lngth+1, edata.csize1- edata.indf)
 899                     = substr (edata.fptr -> string, edata.indf+1, edata.csize1-edata.indf);
 900                move_data.x1 = edata.indf;
 901                move_data.x2 = edata.indt + edata.lngth;
 902                move_data.xlen = edata.csize1 - edata.indf;
 903                move_data.y1, move_data.y2, move_data.ylen = 0; /* nothing else to note */
 904                did_move = "1"b;
 905 
 906 /* now can start clobbering fromfile */
 907 
 908                if edata.isok < 0 then                       /* else >indt so >i so no copy needed */
 909                     substr (edata.fptr -> string, 1, i) = substr (edata.tptr -> string, 1, i);
 910                substr (edata.fptr -> string, i+1, k) = substr (edata.tptr -> string, i+j+1, k);
 911                substr (edata.fptr -> string, i+k+1, edata.lngth) = substr (line, 1, edata.lngth);
 912                substr (edata.fptr -> string, edata.lngth+i+k+1, j) = substr (edata.tptr -> string, i+1, j);
 913 
 914                edata.indt, edata.indf = i+j+k+edata.lngth;
 915                edata.csize1 = edata.indf + move_data.xlen;
 916                edata.fptr = Edata_pi.tptr;
 917                edata.tptr = Edata_pi.fptr;
 918           end;
 919           else do;
 920                                                             /* move from below */
 921                                                             /* let tofile have block A, line has L, from has XYZ */
 922                                                             /* assume we want to move block of lines Y */
 923                                                             /*                  to        line      from */
 924                                                             /* current state is  A        L         XYZ */
 925                                                             /* change to        ALY(X)    -         XYZ */
 926                                                             /* change to        ALY(X)    -          XZ */
 927                                                             /* (use Y & X in tofile to restor fromfile if pi) */
 928                                                             /* this has been optimized by nudging Z instead */
 929                                                             /* of X when Z is much smaller. Since X has just been */
 930                                                             /* referenced and since shortening fromfile */
 931                                                             /* will tend to prevent COPY_BACK, moving X is */
 932                                                             /* favored unless Z is half as large as X. */
 933                                                             /* note that the existance of (X) is known only */
 934                                                             /* by the pi-handler.  note that we needed (X) */
 935                                                             /* for the nudge of X anyway. */
 936 
 937 /* at noline => go further */
 938                i = GET_BLOCK (edata.fptr, edata.indf, edata.csize1-edata.indf, M-edata.curlino-min (1, edata.lngth));
 939                if i < 0 then do;
 940 nonesuch:
 941                     call com_err_ (0, me, "Specified lines do not exist.");
 942                     go to reset_io;
 943                end;
 944                if edata.csize1 - edata.indf - i <= 0 then go to nonesuch; /* nothing left */
 945                j = GET_BLOCK (edata.fptr, edata.indf+i, edata.csize1-edata.indf-i, N);
 946                if j < 0 then do;
 947                     j = edata.csize1 - edata.indf - i;      /* take all for "move 75 9999" */
 948                     edata.curlino = -1;                     /* dunno how many lines */
 949                end;
 950                else edata.curlino = edata.curlino + N;      /* N lines inserted above us */
 951                substr (edata.tptr -> string, edata.indt+1, edata.lngth)
 952                     = substr (line, 1, edata.lngth);
 953                edata.indt = edata.indt + edata.lngth;
 954 
 955                move_data.y1 = edata.indf + i;
 956                move_data.y2 = edata.indt;
 957                move_data.ylen = j;
 958 
 959                move_data.x2 = edata.indt + j;
 960                k = edata.csize1 - edata.indf - i - j;       /* get len of Z block */
 961                if i < 2 * k then do;                        /* if clearly cheaper to nudge X .. */
 962 
 963                     move_data.x1 = edata.indf;
 964                     move_data.xlen = i;
 965                     edata.indf = edata.indf + j;
 966                     i = 0;
 967                end;
 968 
 969                else do;
 970                     move_data.x1 = edata.indf + i + j;
 971                     move_data.xlen = k;
 972                     edata.csize1 = edata.csize1 - j;
 973                end;
 974 
 975 
 976                substr (edata.tptr -> string, move_data.x2 + 1, move_data.xlen)
 977                     = substr (edata.fptr -> string, move_data.x1 + 1, move_data.xlen);
 978                substr (edata.tptr -> string, move_data.y2 + 1, move_data.ylen)
 979                     = substr (edata.fptr -> string, move_data.y1 + 1, move_data.ylen);
 980                did_move = "1"b;
 981 
 982 /* now can start clobbering fromfile */
 983 
 984                substr (edata.fptr -> string, edata.indf + i + 1, move_data.xlen)
 985                     = substr (edata.tptr -> string, move_data.x2 + 1, move_data.xlen);
 986 
 987                edata.indt = move_data.y2 + move_data.ylen;
 988 
 989           end;
 990 
 991 /* now set items in control structure */
 992 
 993           if edata.curlino ^= -1 then
 994                if edata.lngth ^= 0 then
 995                     edata.curlino = edata.curlino + 1;      /* have PUT ^noline */
 996           edata.isok = -1;
 997           edata.lngth = 0;                                  /* leave him at noline */
 998           edata.changed = "1"b;                             /* remind him to write this opus */
 999           go to next;
1000 
1001 /* ^L */
1002 
1003 /* ********** write save ********** */
1004 
1005 wsave:
1006           saveflag = 0;
1007           go to scan_path;
1008 
1009 /* ********** delete top ********** */
1010 
1011 delete_top_init:
1012           if cm1 ^= 8
1013           then go to request_err;
1014 
1015 delete_top:
1016           edata.indt = 0;
1017           edata.changed = "1"b;                             /* text edata.changed */
1018           edata.isok = -1;
1019           edata.curlino = 1;                                /* set line number */
1020           go to next;
1021 
1022 /* ********** save the top of the file ********** */
1023 
1024 save_top:
1025           saveflag = 2;
1026           edct = 7;                                         /* Set scan pointer */
1027           go to long_scan;
1028 
1029 /* ********** insert a file after the current line ********** */
1030 
1031 insert_file:
1032           saveflag = 3;
1033           edct = 5;                                         /* .. */
1034           go to long_scan;
1035 
1036 ret_insert:
1037           call initiate_file_ (dirname, ename, RW_ACCESS, sptr, merge_bc, code);
1038           if sptr = null
1039           then do;                                          /* try for just r access */
1040                call initiate_file_ (dirname, ename, R_ACCESS, sptr, merge_bc, code);
1041                if sptr = null then go to new_error;         /* Now print message */
1042                end;
1043 
1044 ret_insert_default:
1045           segsize = divide (merge_bc+ 8, 9, 21, 0);
1046           call PUT;
1047           edata.lngth = 0;
1048           if segsize ^= 0 then do;
1049                substr (edata.tptr -> string, edata.indt + 1, segsize)
1050                     = substr (sptr -> string, 1, segsize);
1051                edata.indt = edata.indt + segsize;
1052                edata.changed = "1"b;                        /* text edata.changed */
1053                edata.isok = -1;
1054                edata.curlino = -1;
1055           end;
1056           go to next;
1057 
1058 /* ********* save ********* */
1059 
1060 long_scan:
1061           edct = edct - 1 + verify (substr (buffer, edct + 1, count - edct), " ");
1062 
1063 /*
1064    do edct = edct to cm1 while (ed.lin (edct) = " ");
1065    end;
1066    */
1067 
1068 scan_path:                                                  /* Code used to be here to guarantee no blanks in pathname */
1069           lprinam = cm1 - edct;                             /* Derive length of rest of line (from first non-blank) */
1070 
1071           if (lname + lprinam) = 0 then do;                 /* no default name, no given name => lose */
1072                call com_err_ (0, me, "No segment name given in ^a request.", com_line);
1073                go to reset_io;
1074           end;
1075           if lprinam ^= 0 then do;                          /* use name given in this request */
1076                np = addr (substr (buffer, edct + 1, 1));    /* get ptr to segname */
1077                call expand_pathname_ (substr (buffer, edct+1, lprinam), dirname, ename, code);
1078                if code ^= 0 then do;                        /* funny path => lose */
1079 badname:            call com_err_ (code, me, "^a", xarg);
1080                     go to reset_io;
1081                end;
1082                call check_entryname_ (ename, code);         /* Is good name? */
1083                if code ^= 0 then go to badname;
1084                if saveflag = 3 then go to ret_insert;       /* "merge" request, initiate it above */
1085                else do;                                     /* write or upwrite */
1086                     call hcs_$make_seg (dirname, ename, "", 01010b, sptr, code); /* create if not found */
1087                     if sptr = null then go to new_error;    /* can't do it => lose */
1088                end;
1089           end;
1090           else do;                                          /* use default name */
1091                sptr = orig_ptr;                             /* see about default pointer */
1092                if sptr = null then do;                      /* not good */
1093                     if saveflag = 3 then do;                /* merge */
1094                          call com_err_ (0, me, "No default segment for merge request."); /* nothing there */
1095                          go to reset_io;                    /* lose */
1096                     end;
1097                     else do;                                /* write or upwrite */
1098                          call hcs_$make_seg (dirnameo, enameo, "", 01010b, sptr, code); /* create if not found */
1099                          if sptr = null then go to error;   /* can't do it -> lose */
1100                     end;
1101                end;
1102                else if saveflag = 3 then do;                /* merge, pointer good, check access */
1103                     call hcs_$status_mins (sptr, type, merge_bc, code); /* and get bit count */
1104                     if code ^= 0 then go to error;          /* no bit count, no editing */
1105                     else go to ret_insert_default;          /* good news */
1106                end;
1107           end;
1108 
1109           edata.curlino = -1;                               /* safety: assume line number is lost */
1110 
1111           if saveflag = 0 then do;
1112                i = edata.indt;                              /* remember where we were */
1113                call COPY;                                   /* "w" request, note syntax check before copy */
1114           end;
1115           else do;                                          /* saveflag = 2, "upwrite" case */
1116                i = 0;                                       /* forget where we were */
1117                if sptr = edata.fptr then                    /* if about to write into fromfile */
1118                     call CHECK_ORIG;                        /* must not use orig as fromfile */
1119           end;                                              /* "w" always does COPY so check not needed */
1120 
1121           if edata.indt > i then substr (sptr -> string, i + 1, edata.indt - i) = /* first write block just COPY'd */
1122                substr (edata.tptr -> string, i + 1, edata.indt - i);
1123 
1124           if i > 0 then substr (sptr -> string, 1, i) =     /* now write the head */
1125                substr (edata.tptr -> string, 1, i);
1126 
1127           call terminate_file_ (sptr, edata.indt*9, TERM_FILE_TRUNC_BC, code);
1128           if code ^= 0 then go to test_error;
1129 
1130           if saveflag = 2 then go to delete_top;
1131           edata.changed = "0"b;                             /* no unsaved changes after "w" */
1132           Edata_pi.changed = "0"b;                          /* if "w" completes then pi won't undo it */
1133           if edata.isok >= 0 then edata.isok = edata.indt;  /* now have two identical buffers, and a file */
1134                                                             /* which is also identical.  This is only possible */
1135                                                             /* with a virtual memory */
1136           go to next;
1137 
1138 /* ********** call the command processor ********** */
1139 
1140 callms:
1141           substr (buffer, 1, 1) = " ";                      /* no E */
1142           call cu_$cp (addr (buffer), count, code);
1143           if active = 0                                     /* Did it get reset while we were out */
1144           then call com_err_ (0, me, "Working buffers have been destroyed.");
1145           active = active + 1;                              /* In any case, say we are still active */
1146           go to pedit;
1147 
1148 /* ********* eof ********* */
1149 
1150 eof:      call ioa_ ("EOF");
1151           go to next;
1152 
1153 /* ********** FILE SYSTEM ERROR ********** */
1154 
1155 test_error: if lprinam = 0 then do;                         /* see which name got error */
1156 error:         dnp = addr (dirnameo);
1157                enp = addr (enameo);
1158           end;
1159           else do;
1160 new_error:     dnp = addr (dirname);
1161                enp = addr (ename);
1162           end;
1163           call COM_DE;                                      /* print the error message */
1164           go to reset_io;
1165 
1166 /* ********** return ********** */
1167 
1168 return:   return;
1169 
1170 /* ^L
1171    ********* " I N T E R N A L   P R O C E D U R E S " ********* */
1172 
1173 
1174 
1175 FIND_LOCATE: proc;                                          /* locate string, wraparound if necess */
1176 
1177 dcl  lptr ptr;
1178 dcl  indl fixed bin (21);
1179 dcl  lscan fixed bin (21);
1180                lptr = edata.fptr;                           /* search fromfile */
1181                indl = edata.indf;
1182                lscan = edata.csize1 - edata.indf;
1183                where_found = 1;                             /* assume found in fromfile */
1184 FLLOOP:                                                     /* try to find the string */
1185                if locating = 0 then do;                     /* if finding */
1186                     if substr (lptr -> string, indl + 1, loclen - 1) /* then  at top or next line */
1187                     = substr (locp -> string, 2, loclen - 1) then do; /* do not expect a prceeding newline */
1188                          i = 0;
1189                          go to FLGOT;
1190                     end;
1191                end;
1192                i = index (substr (lptr -> string, indl + 1, lscan), substr (locp -> string, 1, loclen));
1193                if i = 0 then do;
1194                     if where_found = 1 then do;
1195                          where_found = -1;
1196 
1197                          if edata.isok ^= -1                /* if fromfile = tofile */
1198                          then lptr = edata.fptr;            /* touch pages of fromfile */
1199                          else lptr = edata.tptr;            /* must touch tofile */
1200 
1201                          indl = 0;
1202                          lscan = edata.indt;
1203                          go to FLLOOP;
1204                     end;
1205                     else do;                                /* nowhere else to look */
1206                          where_found = 0;                   /* found nowhere */
1207                          return;
1208                     end;
1209                end;
1210 FLGOT:
1211                if locating = 1 then do;                     /* if locating, we must get start of line */
1212                     k = index (reverse (substr (lptr -> string, indl + 1, i)), nl);
1213                     if k ^= 0 then k = i - k + 1;           /* chars to kopy */
1214                end;
1215                else do;                                     /* find */
1216                     k = i;                                  /* kopy up to & inclding <nl> at start of found string */
1217                end;
1218 
1219           end FIND_LOCATE;
1220 
1221 /* ^L */
1222 
1223 CHECK_ORIG: proc;
1224 
1225                if edata.fptr = orig_ptr                     /* if we are still using orig seg as fromfile */
1226                then do;                                     /* use a real fromfile in pdir */
1227                     edata.fptr = ptr2;                      /* note: at entry edata.tptr = ptr1, thus use other */
1228                     substr (edata.fptr -> string, 1, edata.csize1) /* now fill the new fromfile */
1229                          = substr (orig_ptr -> string, 1, edata.csize1); /* from his orig segment */
1230                     Edata_pi.fptr = ptr2;                   /* dont pi back to other */
1231                end;
1232 
1233           end CHECK_ORIG;
1234 
1235 GET_BLOCK: proc (xp, xo, xc, xl) returns (fixed bin (21));
1236 
1237 dcl  xp ptr;                                                /* points to base of some seg */
1238 dcl  xo fixed bin (21);                                     /* offset where we start looking */
1239 dcl  xc fixed bin (21);                                     /* is max nchars to examine */
1240 dcl  xl fixed bin (21);                                     /* is number of lines to scan past */
1241 dcl  xx fixed bin (21);                                     /* returned: is number of chars in block */
1242 
1243 dcl (i, j, k) fixed bin (21);                               /* keep these real local */
1244 
1245                if xl = 0 then return (0);                   /* not want any */
1246 
1247                xx = 0;
1248 
1249                i = 0;
1250 
1251                do while (i < xl & xc-xx>0);
1252                     j = index (substr (xp -> string, xo+xx+1, xc-xx), nl);
1253 
1254                     if j = 0 then xx = xc;                  /* take all the rest */
1255                     else xx = xx + j;
1256                     i = i + 1;
1257 
1258                end;
1259 
1260                if i < xl then return (-1);
1261                else return (xx);
1262 
1263           end GET_BLOCK;
1264 
1265 GET_NUM:  proc;                                             /* called by move_ to get extents */
1266                i = i + verify (substr (buffer, i + 1, count - i), " ") -1;
1267                j = index (substr (buffer, i+1, count-i), " ") -1;
1268                if j < 0 then j = count - i - 1;
1269                N = cv_dec_check_ (substr (buffer, i+1, j), code);
1270                if code ^= 0 then go to numeric_err;
1271                if N < 0 then go to numeric_err;
1272                if N = 0 then go to nonesuch;
1273           end GET_NUM;
1274 
1275 /* ^L */
1276 
1277 clean:    proc;                                             /* cleanup handler for edm */
1278                                                             /* invoked when quit is done in edm and not started */
1279 
1280 /* handler just truncates temporary segments */
1281 /* in order to conserve pdir space */
1282 /* and terminates input segment */
1283 /* also used when exiting from edm */
1284 
1285 dcl  code fixed bin (35);
1286                call hcs_$truncate_seg (ptr1, 0, code);
1287                call hcs_$truncate_seg (ptr2, 0, code);
1288                if sptr ^= null then call terminate_file_ (sptr, 0, TERM_FILE_TERM, code);
1289                active = 0;                                  /* Clear flag */
1290 
1291           end clean;
1292 
1293 
1294 interrupt: proc;                                            /* program interrupt handler */
1295 
1296 /* if ^pi_allowed then user quit while Edata_pi being filled in, */
1297 /* so we cant use Edata_pi, so we leave at state defined by edata.  Note we were */
1298 /* in the process of making a pi impossible anyway (since we were */
1299 /* filling Edata_pi from edata) so the user has only lost the ability */
1300 /* to quit/pi during a few microsec interval when the results would have been */
1301 /* indeterminate anyway. */
1302 /* Otherwise we use the Edata_pi to undo the last edit request.  */
1303 /* If did_move is on, then the last request was a move and we must */
1304 /* put some text back where we got it.  did_move is */
1305 /* turned on AFTER move_data is safe to use, but BEFORE move_data is */
1306 /* necessary to use for recovery.  Further note that the moves made here */
1307 /* using move_data are to locations which do not overlap sending locations */
1308 /* which means that quit/pi occuring in this procedure */
1309 /* are as so many NOP's */
1310 
1311                if pi_allowed then do;
1312                     edata = Edata_pi;
1313                     if edata.lngth ^= 0 then
1314                          substr (line, 1, edata.lngth) = substr (Line_pi, 1, edata.lngth);
1315                     if did_move then do;                    /* restor buffs needed */
1316                          if move_data.xlen > 0 then
1317                               substr (edata.fptr -> string, move_data.x1 +1, move_data.xlen)
1318                               = substr (edata.tptr -> string, move_data.x2 +1, move_data.xlen);
1319 
1320                          if move_data.ylen > 0 then
1321                               substr (edata.fptr -> string, move_data.y1 +1, move_data.ylen)
1322                               = substr (edata.tptr -> string, move_data.y2 +1, move_data.ylen);
1323                          did_move = ""b;
1324                     end;
1325                end;
1326 
1327                go to int_lab;                               /* go to pedit in initial invocation */
1328           end interrupt;
1329                                                             /* ^L */
1330 COM_DE:   proc;                                             /* errprint for truncate & bitcount errs */
1331 
1332                call com_err_ (code, me, "^a>^a", dnp -> b168cu, enp -> b32cu);
1333 
1334           end COM_DE;
1335 
1336 /* ^L */
1337 
1338 /* FOLLOWING IP's are at end of pgm to be near pile of constants */
1339 
1340 COPY:     proc;                                             /* copy rest of from file into to file */
1341 
1342                call PUT;
1343                edata.lngth = 0;
1344                if ^edata.iflag then do;                     /* else new input, nothing to copy */
1345                     ij = edata.csize1 - edata.indf;
1346                     if ij > 0 then do;
1347                          if edata.isok >= 0 then do;
1348                               mc_chars = edata.csize1 - edata.isok;
1349                               edata.isok = edata.isok + mc_chars;
1350                          end;
1351                          else mc_chars = ij;
1352                          mc_skip = ij - mc_chars;
1353 
1354                          if mc_chars > 0 then
1355                               substr (edata.tptr -> string, edata.indt + mc_skip + 1, mc_chars)
1356                               = substr (edata.fptr -> string, edata.indf + mc_skip + 1, mc_chars);
1357 
1358                          edata.indt = edata.indt + ij;
1359                          edata.indf = edata.indf + ij;
1360                     end;
1361                end;
1362 
1363           end COPY;
1364 
1365 COPY_BACK: proc;
1366 
1367                if edata.lngth ^= 0 then do;
1368                     edata.indf = edata.indf - edata.lngth;
1369                     substr (edata.fptr -> string, edata.indf + 1, edata.lngth)
1370                          = substr (line, 1, edata.lngth);   /* put current line back in from */
1371                end;
1372 
1373                if bkover > 0 then do;                       /* move from tofile to fromfile */
1374                     edata.indf = edata.indf - bkover;       /* set pointers */
1375                     edata.indt = edata.indt - bkover;
1376                     substr (edata.fptr -> string, edata.indf + 1, bkover)
1377                          = substr (edata.tptr -> string, edata.indt + 1, bkover);
1378                end;
1379 
1380           end COPY_BACK;
1381 
1382 /* ^L */
1383 SWITCH:   proc;                                             /* make from-file to-file, and v.v. */
1384                if edata.tptr = ptr1 then
1385                     do;
1386                     edata.tptr = ptr2;
1387                     edata.fptr = ptr1;
1388                end; else
1389                do;
1390                     edata.tptr = ptr1;
1391                     edata.fptr = ptr2;
1392                end;
1393                edata.csize1 = edata.indt;
1394                edata.isok, edata.lngth, edata.indt, edata.indf = 0;
1395                edata.iflag, edata.eof_ = "0"b;
1396                return;
1397           end SWITCH;
1398 
1399 PRINT_CURLINE: proc;                                        /* print the current line or "Noline." */
1400 
1401                if edata.lngth = 0 then call ioa_ ("No line.");
1402                else call iox_$put_chars (iox_$user_output, addr (line), edata.lngth, code);
1403 
1404           end PRINT_CURLINE;
1405 
1406 /* ^L */
1407 GET_LINES: proc;                                            /* get not more than mg_lines totalling <= mg_chars */
1408                g_chars = 0;
1409                g_lines = 0;
1410 GLOOP:
1411                nxlen = index (substr
1412                     (edata.fptr -> string, edata.indf + 1 + g_chars, mg_chars - g_chars), nl);
1413                if nxlen ^= 0 then do;
1414                     g_chars = g_chars + nxlen;
1415                     g_lines = g_lines + 1;
1416                     if g_lines < mg_lines then go to GLOOP;
1417                end;
1418 
1419           end GET_LINES;
1420 
1421 MOVE_CHARS: proc;                                           /* move block of lines, keep linno if possible */
1422 
1423                if g_chars ^= 0 then do;
1424                     if edata.isok >= 0 then do;             /* if not -1 then >= edata.indt */
1425                          mc_chars = edata.indf + g_chars - edata.isok;
1426                          if mc_chars < 0 then mc_chars = 0;
1427                          else edata.isok = edata.isok + mc_chars;
1428                     end;
1429                     else mc_chars = g_chars;
1430 
1431                     mc_skip = g_chars - mc_chars;
1432 
1433                     if mc_chars >0 then
1434                          substr (edata.tptr -> string, edata.indt + mc_skip + 1, mc_chars)
1435                          = substr (edata.fptr -> string, edata.indf + mc_skip + 1, mc_chars);
1436                     edata.indt = edata.indt + g_chars;
1437                     edata.indf = edata.indf + g_chars;
1438                end;
1439 
1440                if edata.curlino ^= -1 then do;
1441                     edata.curlino = edata.curlino + g_lines;
1442                end;
1443 
1444           end MOVE_CHARS;
1445 
1446 INPUT:    proc;                                             /* IP for input mode, near PUT to save pageflts */
1447 
1448                if ^waketable_is_set then do;                /* first time input */
1449                     unspec (swt) = ""b;
1450                     swt.version = swt_info_version_1;
1451                     swt.new_table.wake_map (46) = "1"b;     /* octal 56 a period */
1452                     call iox_$control (iox_$user_io, "set_wakeup_table", addr (swt), code);
1453                     waketable_is_set = "1"b;
1454                end;
1455                call iox_$modes (iox_$user_io, "wake_tbl", "", (0));
1456 input:         call iox_$get_line (iox_$user_input, bufp, prc, count, code); /* read a line */
1457                if count = 2 then                            /* check for mode change */
1458                     if substr (buffer, 1, 1) = "." then do; /* ret to caller, thence editing */
1459                          call iox_$modes (iox_$user_io, "^wake_tbl", "", code);
1460                          return;                            /* from internal proc */
1461                     end;
1462                call PUT;                                    /* pseudo call */
1463                edata.changed = "1"b;
1464                edata.isok = -1;
1465                edata.eof_ = "0"b;
1466                edata.lngth = count;
1467                substr (line, 1, edata.lngth) = substr (buffer, 1, edata.lngth); /* move line inputted into intermediate storage */
1468                go to input;                                 /* repeat 'til "." */
1469 
1470           end INPUT;
1471 
1472 
1473 PUT:      proc;                                             /* put current "line" into to-file */
1474 
1475                if edata.lngth ^= 0 then do;                 /* ignore Nolines. */
1476                     if edata.curlino ^= -1 then do;
1477                          if index (substr (line, 1, edata.lngth), nl) ^= edata.lngth
1478                          then edata.curlino = -1;           /* we could try harder here */
1479                          else edata.curlino = edata.curlino + 1;
1480                     end;
1481                     if edata.indt >= edata.isok then do;
1482                          substr (edata.tptr -> string, edata.indt+1, edata.lngth)
1483                               = substr (line, 1, edata.lngth);
1484                     end;
1485                     edata.indt = edata.indt + edata.lngth;  /* set counters */
1486                     if edata.isok >= 0 then
1487                          if edata.isok < edata.indt then
1488                               edata.isok = edata.indt;
1489                end;
1490                return;
1491           end PUT;
1492 
1493 GET:      proc;                                             /* load next line from from-file into "line" */
1494 
1495                scanlen = edata.csize1 - edata.indf;
1496                if scanlen = 0 then do;
1497                     edata.eof_ = "1"b;
1498                     edata.lngth = 0;
1499                     return;
1500                end;
1501                else if scanlen > 152 then scanlen = 152;
1502 
1503                edata.eof_ = "0"b;
1504 
1505                edata.lngth = index (substr (edata.fptr -> string, edata.indf + 1, scanlen), nl);
1506 
1507                if edata.lngth = 0 then do;
1508                     edata.lngth = min (151, scanlen);       /* leave room to for user to add newline */
1509                     if scanlen = 152 then                   /* were >= 152 chars but no newline */
1510                          call com_err_ (0, me, error_message); /* complain */
1511                end;
1512 
1513                substr (line, 1, edata.lngth) = substr (edata.fptr -> string, edata.indf + 1, edata.lngth);
1514                edata.indf = edata.indf + edata.lngth;       /* now set indf */
1515 
1516           end GET;
1517 
1518 /* ^L */
1519 
1520 
1521 SAVE:     proc;                                             /* IP to make pi possible */
1522                pi_allowed = ""b;                            /* dont allow while munging data  */
1523 
1524                Edata_pi = edata;
1525                substr (Line_pi, 1, edata.lngth) = substr (line, 1, edata.lngth);
1526                did_move = ""b;                              /* edata, Edata_pi do not differ by a move to undo */
1527                                                             /* In fact they dont differ at all */
1528                                                             /* did_move ^= ""b when a move must */
1529                                                             /* be undone to make Edata_pi come true */
1530                pi_allowed = "1"b;                           /* now pi is ok, a NOP until edata changes */
1531 
1532           end SAVE;
1533 
1534 
1535 /* ^L */
1536 
1537 
1538 
1539 /* DEBUGGING CODE -- better to rob a pyramid than delete this code -- REM
1540    CKLINO:          proc;
1541    call GET_LINO;
1542    if edata.curlino = -1 then do;
1543    edata.curlino = gotlino;
1544    end;
1545    else do;
1546    if edata.curlino ^= gotlino then do;
1547    call ioa_ ("curlino ^d should be ^d", edata.curlino, gotlino);
1548    edata.curlino = gotlino;
1549    end;
1550 
1551    end;
1552 
1553    end CKLINO;
1554 
1555    CKISOK:          proc;
1556 
1557    if edata.isok < -1 then call ioa_ ("isok = ^d", edata.isok);
1558    else if edata.isok ^= -1 then do;
1559 
1560    if edata.indt + edata.lngth ^= edata.indf then call ioa_
1561    ("indt = ^d, lngth = ^d, indf = ^d",
1562    edata.indt, edata.lngth, edata.indf);
1563    else do;
1564    if substr (edata.tptr -> string, 1, edata.indt)
1565    ^= substr (edata.fptr -> string, 1, edata.indt)
1566    then call ioa_ ("files differ, but isok = ^d", edata.isok);
1567    if substr (line, 1, edata.lngth) ^=
1568    substr (edata.fptr -> string, edata.indf + 1 - edata.lngth, edata.lngth)
1569    then call ioa_ ("line and fromfile differ, edata.isok = ^d", edata.isok);
1570    end;
1571    end;
1572    end CKISOK;
1573 
1574    EDUMP: proc;
1575 
1576    call ioa_ (
1577    "fptr  ^p,
1578    indf   ^d,
1579    iflag  ^w,
1580    csize1 ^d,
1581    tptr   ^p,
1582    indt   ^d,
1583    eof    ^w,
1584    changed          ^w,
1585    lngth  ^d,
1586    curlino          ^d,
1587    isok   ^d",
1588    edata.fptr, edata.indf, edata.iflag, edata.csize1, edata.tptr, edata.indt, edata.eof_, edata.changed, edata.lngth,
1589    edata.curlino, edata.isok);
1590    end EDUMP;
1591 
1592    otize: if num_err ^= 0 then go to numeric_err;
1593    dcl (cklinsw, ckisoksw, dumpsw) bit (1) aligned init ("0"b);
1594 
1595    if n = 1 then do; readysw = "1"b; cklinsw = "0"b; ckisoksw = "0"b; dumpsw = "0"b;end;
1596    else if n = 2 then readysw = "0"b;
1597    else if n = 3 then do; cklinsw = "1"b; readysw = "0"b; end;
1598    else if n = 4 then cklinsw = "0"b;
1599    else if n = 5 then do; ckisoksw = "1"b; readysw = "0"b; end;
1600    else if n = 6 then ckisoksw = "0"b;
1601 
1602    else if n = 7 then do ; dumpsw = "1"b; readysw = "0"b; end;
1603    else if n = 8 then dumpsw = "0"b;
1604    else if n > 9 then do;
1605    if n < 64 then chunk = divide (chunk, 4, 17, 0);
1606    else chunk = n;
1607    call ioa_ ("^d word chunks", chunk);
1608    chunk = chunk * 4;
1609    end;
1610 
1611    go to next;
1612    /* END DEBUGGING CODE */
1613      end edm;