Personal tools
You are here: Home Projects SETL LITTLE Source code UPD: Source maintenance program. By David Shields.
Document Actions

UPD: Source maintenance program. By David Shields.

by Paul McJones last modified 2021-03-17 19:56

UPD: Source maintenance program. By David Shields.

       1 .=member  intro
       2 $     !$&'()*+,-./0123456789:;<=>abcdefghijklmnopqrstuvwxyz^_
       3 $    the above line contains, in order of ascii codes, the 56
       4 $    characters of the little language, starting in column 7.
       5
       6
       7
       8
       9 /*
      10
      11   $$          $$$$$$$$$$  $$$$$$$$$$  $$$$$$$$$$  $$          $$$$$$$$$
      12   $$          $$$$$$$$$$  $$$$$$$$$$  $$$$$$$$$$  $$          $$$$$$$$$
      13   $$              $$          $$          $$      $$          $$
      14   $$              $$          $$          $$      $$          $$
      15   $$              $$          $$          $$      $$          $$$$$$
      16   $$              $$          $$          $$      $$          $$$$$$
      17   $$              $$          $$          $$      $$          $$
      18   $$              $$          $$          $$      $$          $$
      19   $$$$$$$$$$  $$$$$$$$$$      $$          $$      $$$$$$$$$$  $$$$$$$$$
      20   $$$$$$$$$$  $$$$$$$$$$      $$          $$      $$$$$$$$$$  $$$$$$$$$
      21
      22                     $$      $$  $$$$$$$$$   $$$$$$$$$
      23                     $$      $$  $$$$$$$$$$  $$$$$$$$$$
      24                     $$      $$  $$      $$  $$      $$
      25                     $$      $$  $$      $$  $$      $$
      26                     $$      $$  $$$$$$$$$$  $$      $$
      27                     $$      $$  $$$$$$$$$   $$      $$
      28                     $$      $$  $$          $$      $$
      29                     $$      $$  $$          $$      $$
      30                     $$$$$$$$$$  $$          $$$$$$$$$$
      31                      $$$$$$$$   $$          $$$$$$$$$
      32
      33
      34     this software is part of the little programming system.
      35              address queries and comments to
      36
      37                       little project
      38               department of computer science
      39                    new york university
      40         courant institute of mathematical sciences
      41                     251 mercer street
      42                    new york,  ny  10012
      43
      44      this is the source maintenance program upd, written
      45      by david shields of nyu.
      46
      47
      48
      49 */
      50
      51
      52
      53
       1 .=member mods
       2 $ - - - all changes are to include self-description after mods.2
dsj    1
dsj    2 $    dsj       d. shields          26-sep-80           level 80270
dsj    3 $
dsj    4 $    add option 'shink=0/1' such that shrink=1 causes upd to not
dsj    5 $    write out lines which are all blank or begin with blanks followed
dsj    6 $    by dollar sign (comments).
dsj    7 $    decks affected - putlin, shrink (new)
dsj    8
dsi    1
dsi    2 $    dsi       d. shields          21-jul-80           level 80203
dsi    3 $
dsi    4 $    fix bug (fr2.3.140) that caused problems if opl identifier
dsi    5 $    specified in lower case.
dsi    6 $    deck affected - moveto.
dsi    7
dsh    1
dsh    2 $    dsh       d. shields          10-jul-80           level 80192
dsh    3 $
dsh    4 $    1.  fix problem (fr135) in setting of termination code.
dsh    5 $        now issue code 0 if no warnings or errors, code 4 if warnings
dsh    6 $        and no errors, code 8 if any errors detected.
dsh    7 $    2.  add conditional symbol -unix- for the unix operating system.
dsh    8 $        use iset=unix to obtain unix variant.
dsh    9 $
dsh   10 $    decks affected - macros, updini, updexi.
dsh   11
dsg    1
dsg    2 $    dsg       d. shields          20-may-80           level 80141
dsg    3 $
dsg    4 $    1.  fix bug (fr2.3.133) that caused problems if member name
dsg    5 $        given in lower case in opl.
dsg    6 $    2.  fix bug (fr2.3.134) that caused errors in second arg to
dsg    7 $        -del to go unreported.
dsg    8 $    decks affected - scncmd, chkmem.
dsg    9
dsf    1
dsf    2 $    dsf       d. shields          25-mar-80           level 80085
dsf    3 $
dsf    4 $    on error, copy current command line to terminal (term=).
dsf    5 $    delete call to ltlxtr on abnormal termination.
dsf    6 $    decks affected - docmd, upderr
dsf    7
dse    1
dse    2 $    dse       d. shields          21-dec-79           level 79355
dse    3 $
dse    4 $    1.  fix error that caused looping in some cases if member
dse    5 $        not present.
dse    6 $    2.  fix error in ucs option with -note commands.
dse    7 $    decks affected - docmd, movmem.
dse    8 $
dsd    1
dsd    2 $    dsd       d. shields          23-nov-79           level 79327
dsd    3 $
dsd    4 $    add option ucs (u-pdate c-orrection s-et) with default
dsd    5 $    'ucs=/'.  if 'ucs=name' specified, upd writes out to named
dsd    6 $    file the correction set in cdc update format.  this assists
dsd    7 $    converting upd correction sets developed in the field.
dsd    8 $    decks affected - updini, docmd, uscid(new), doalt, insert.
dsd    9
dsc    1 $    dsc       d. shields          21-sep-79           level 79264
dsc    2
dsc    3 $    fix bug that caused .=member line to be recognized only if in
dsc    4 $    upper case (fr2.3.123).
dsc    5 $    deck affected - chkmem.
dsc    6
dsb    1
dsb    2 $    dsb       d. shields          07-aug-79           level 79220
dsb    3 $
dsb    4 $    1.  revise to use string search primtives provided by lib
dsb    5 $        level 79200.
dsb    6 $    2.  provide support for lower-case if available and also
dsb    7 $        permit available 'separators' to be used where blank
dsb    8 $        previously required.
dsb    9 $    3.  for s10, issue standard prefix character in warning
dsb   10 $        and error messages.
dsb   11 $    decks affected - most. decks containing original definition
dsb   12 $        of string primitives have been deleted, as this material now
dsb   13 $        in little lib.
dsb   14
dsa    1
dsa    2 $    dsa       d. shields          18 may 79           level 79138
dsa    3 $
dsa    4 $    fix error (fr2.3.106) in listing -ps- and -ns- program paramters.
dsa    5 $    deck affected - updini.
dsa    6
       3
       4 $    (none)    d. shields          05 feb 79           level 79036
       5 $
       6 $    release first, preliminary version (v1.0).  this version
       7 $    has been tested on s32 (dec vax) and s66 (cdc 6000).
       8
       1 .=member macros
       2
       3 $    set cupd to recognize cdc update directives
       4 $    during creation run.
       5 .+set cupd
dsb   15
dsh   12 $    set mc if lower-case characters available.
dsh   13 $    if mixed-case available, default primary case is upper.
dsh   14 $    obtain lower primary case by defining mcl.
dsb   17
dsh   15 .+set  mc  $ mc set by default
dsb   19
dsb   23 .+s66.
dsh   16 .-set  mc  $ s66 is upper-case only.
dsb   25 ..s66
dsb   26
       6 /*
       7      commands
       8
       9      alter   l1,/old/new/
      10      before  l1
      11      copy    n1,n2,n3..n4
      12      edit    n1
      13      end
      14      delete  l1
      15      delete  l1,l2
      16      insert  l1
      17      modname n1
      18      note    arbitrary text
      19
      20 */
      21
      22
      23      +*  programlevel =  $ date of last change.
dsj    9          'upd(80270)'  $ 26-sep-80
      25          **
      26
dsja   1 .+s32.
dsja   2 .+set s32v  $ assume vms.
dsja   3 ..s32
dsja   4
dsja   5 .+s32u.
dsja   6 .+s32.
dsja   7 .-set s32v  $ do not want vms.
dsja   8 .+set s32u  $ want unix os.
dsja   9 ..s32
dsja  10 .+set mcl   $ want primary case to be lower.
dsja  11 ..s32u
dsja  12 .+s47.
dsh   19 $    configure for unix, set primary case lower.
dsh   20 .+set mcl
dsja  13 ..s47
dsh   22
dsh   23 .+mc.
dsh   24 .+mcl.   $ if mixed-case to be lower
dsh   25      +*  ctpc(x) = ctlc(x) **  $ primary case is lower.
dsh   26      +*  stpc(x) = stlc(x) **  $ primary case is lower.
dsh   27 .-mcl.
dsh   28      +*  ctpc(x) = ctuc(x) **  $ primary case is upper.
dsh   29      +*  stpc(x) = stuc(x) **  $ primary case is upper.
dsh   30 ..mcl
dsh   31 ..mc
dsh   32
      27      +*  terml(n) = call contlpr(27, n); **  $ terminal control.
      28
      29      +*  error(txt) = call upderr(txt); ** $ report error.
      30
      31      +*  filenamlen = 20  **  $ length of file name.
vaxa   1 .+s32 +*  filenamlen = 64  **  $ length of file name.
dsjb   1 .+s47 +*  filenamlen = 64  **  $ length of file name.
      32
dsd   11          +*  getapp_len = 128 **  $ length of parameter string.
dsd   12 .+s32    +*  getapp_len = 240 **
dsjb   2 .+s47    +*  getapp_len = 240 **
dsd   13
      33      +*  ws = .ws. **  +*  ps = .ps. **  +*  cs = .cs. **
      34
      35      +*  countup(ptr, lim, msg) = $ increment table pointer.
      36          ptr = ptr + 1;
      37          if  (ptr>lim)  then  error(msg); end if;
      38          **
      39
      40      $   codes for new sequence option.
      41      +*  seq_n = 0 **    $ no sequence.
      42      +*  seq_l = 1 **    $ left sequence.
      43      +*  seq_r = 2 **    $ right sequence.
      44
      45      $   codes for commands.
      46
      47      +*  c_alt = 1 **    $  alter
      48      +*  c_bef = 2 **    $  before
      49      +*  c_cop = 3 **    $  copy
      50      +*  c_del = 4 **    $  delete
      51      +*  c_edi = 5 **    $  edit
      52      +*  c_end = 6 **    $  end
      53      +*  c_ins = 7 **    $  insert
      54      +*  c_mod = 8 **    $  modname
      55      +*  c_not = 9 **    $  note
      56      +*  n_cmd = 9 **    $  number of commands.
      57
      58      +*  charofdig(d) = (d+1r0) **  $ digit to character.
      59      +*  digofchar(c) = (c-1r0) **  $ character to digit.
      60
      61      +*  oldfile = 3 **  +*  newfile = 4 **  $ file numbers.
dsd   14      $   unit 5 is used if produced update correction set format.
      62
dsb   28      $   codes for standard string sets.
dsb   29
dsb   30      +*  ss_blank =   1 **
dsb   31      $   ss_separ matches blank and other characters (such as tab and
dsb   32      $   form feed for ascii environments) which are by convention
dsb   33      $   considered equivalent to blanks.
dsb   34      +*  ss_separ =    2 **
dsb   35      +*  ss_digit =    4 **  $ digits.
dsb   36      +*  ss_ucltr =    8 **  $ upper case letters a..z
dsb   37      +*  ss_lcltr =   16 **  $ lower case letters a..z
dsb   38      +*  ss_break =   32 **  $ underline, break '_'
dsb   39
dsb   40      $   additional string sets.
dsb   41
dsb   42      +*  ss_al    =  (ss_ucltr ! ss_lcltr) **  $ alphabetics.
dsb   43      +*  ss_aprpbl =   64 **  $ string set for ''') '.
dsb   44      +*  ss_cm    =   128 **  $ search set for ','.
dsb   45      +*  ss_lpap  =   256 **  $ search set for '('''.
dsb   46      +*  ss_period =  512 **  $ search set for '.'.
dsb   47
      67      +*  yes = 1 **  +* no = 0 **
      68
dsh   33      +*  openchk(f, t) =  $ check that file open.
dsh   34          if  filestat(f,access)=0  then  $ if not open
dsh   35              put ,'open error, unit ' :f,i ,', file ' :t,a ,skip;
dsh   36              error('cannot open file');
dsh   37              end if;
dsh   38          **
dsh   39
       1 .=member start
vaxb   1      prog start;   $ upd main program.
       3      size  af(ps);           $ index of start of command argument
       4      size  al(ps);           $ length of command argument.
       5      size  altnew(.sds. 72); $ new string for alter.
       6      size  altold(.sds. 72); $ old string for alter.
       7      size  cl(.sds. 72);     $ command line.
       8      size  cmdend(1);        $ on at end of command input file.
       9      data  cmdend = no;
      10      size  cmdi(ps);         $  index of current command.
      11      size  cmdlisted(1);     $ on when command line listed.
      12      $   cmdnames gives names of commands.
      13      size  cmdnames(.sds.8);  dims cmdnames(n_cmd);
      14      data
      15          cmdnames(c_alt) = 'alter':
      16          cmdnames(c_bef) = 'before':
      17          cmdnames(c_cop) = 'copy':
      18          cmdnames(c_del) = 'delete':
      19          cmdnames(c_edi) = 'edit':
      20          cmdnames(c_end) = 'end':
      21          cmdnames(c_ins) = 'insert':
      22          cmdnames(c_mod) = 'modname':
      23          cmdnames(c_not) = 'note';
      24
      25      +*  copymax = 60 **  $ maximum copy members in command.
      26      size  copylist(.sds.8); $ list of names of copy members.
      27      size  copyptr(ps);      $ number of elements in copy list.
      28      size  copytype(ps);     $ list of types of copy members.
      29      dims  copylist(copymax);
      30      dims  copytype(copymax);
      31      size  cpyall(1);        $ on to copy all members.
      32      size  cpydef(ps);       $ on to copy definition lines.
      33 .+cupd.
      34      size  cueors(ps);       $ number of *cweor or *weor lines.
      35      data  cueors = 0;
      36 ..cupd
      37      size  curact(ps);       $ activity status of current line.
dsia   1      data  curact = no;
      38      size  curid(.sds.8);    $ identifier of current line.
      39      size  curseq(.sds.8);   $ sequence part of current line.
      40      size  cursn(ws);        $ sequence number of current line.
dsia   2      data  cursn = 0;
      41      size  curtxt(.sds.72);  $ text part of current line.
      51      size  delsev(1);        $ on if deleting several lines.
dsj   10      size shrink_opt(ps);   $ on to discard blank lines,comments
dsia   3      data  delsev = no;
      52      size  docopy(1);        $ on to do copy.
      53      size  editname(.sds.8); $ name from edit command.
      54      data  editname = ''.pad.8;
      55      size  editing(1);       $ on if editing member.
      56      data  editing=no;
      57      size  getrc(ws);        $ getlin return code.
      58      data  getrc = 0;
      59      size  id1(.sds.8), id2(.sds.8);  $ sequence fields.
      60      size  im_c(1);          $ on if im option for copied members.
      61      size  im_e(1);          $ on if im option for edited members.
      62      size  im_f(1);          $ on if im option for all members.
      63      size  im_l(ps);         $ im option length.
      64      size  im_name(.sds.8);  $ im option name.
      65      data  im_name = '';
      66      size  keepcmd(1);       $ on to reread command.
dsia   4      data  keepcmd = no;
      67      size  list_a(1);        $ on to list altered lines.
      68      size  list_c(1);        $ on to list names of members copied.
      69      size  list_d(1);        $ on to list lines deleted.
      70      size  list_u(1);        $ on to list upd commands.
      71      size  list_i(1);        $ on to list lines inserted.
      72      size  list_p(1);        $ on to list parameters, statistics.
      73      size  modname(.sds.8);  $ name from modname command.
      74      data  modname = ''.pad.8; .len. modname = 0;
      75      size  ndelete(ws); data ndelete = 0;  $ lines deleted.
      76      size  nerrors(ps);  data nerrors = 0;  $ error count.
      77      size  newfilename(.sds. filenamlen);  $ name of new file.
      78      size  newlines(ws);     $ number of lines read from new file.
dsia   5      data  newlines = 0;
      79      size  ninsert(ws); data ninsert = 0;  $ lines insertd.
      80      size  nmem(ps);         $ number of members in creation mode.
      81      size  nseq(ps);         $ new sequence option.
      82      size  nwarnings(ps);  data nwarnings = 0;  $ warning count.
      83      size  oldend(1);        $ on at end of old file.
dsia   6      data  oldend = no;
      84      size  oldfilename(.sds. filenamlen);  $ name of old file.
      85      size  oldlines(ws);     $ number of lines read from old file.
dsia   7      data  oldlines = 0;
      86      size  pseq(ps);         $ old sequence option.
      87      size  seqno(ws);        $ sequence number.
      88      size  sn1(ws), sn2(ws); $ sequence numbers.
      89      size  umode(ps);        $ run mode.
dsd   15      size  ucsfile(ps);      $ nonzero if producing update format.
      90
      91      call updini;  $ initialize.
      92      call updcon;  $ call control program.
      93      call updexi(0);  $ exit.
vaxb   2      end prog start;
       1 .=member updini
       2      subr updini;  $ upd initialization.
       3 $    read program parameter for mode, read other parameters
       4 $    according to mode setting.
       6      size  spn(ps);          $ span function.
       7      size  pseqstr(.sds.filenamlen);  $ pseq option.
       8      size  nseqstr(.sds.filenamlen);  $ nseq option string.
       9      size  defopt(ps);       $ copy definitions (d) option.
      10      size  foptstr(.sds.filenamlen);  $ option string for 'f' option.
      11      size  lstopt(.sds.filenamlen);  $ option string for lo option.
      12      size  imopt(.sds.filenamlen);   $ option string for im option.
dsia   8      data  imopt = 0;  $ initially null.
dsd   16      size  ucsname(.sds. filenamlen);   $ name for ucs file.
dsd   17      size  app(.sds. getapp_len);  $ actual parameter string.
      13      size  i(ps);            $ index.
      14      size  l(ps);            $ index.
      16
      17      $   build global character vectors for spn and brk.
dsb   48      call blds(',', ss_cm);
dsb   49      call blds('.', ss_period);
dsb   50      call blds('(''', ss_lpap);
dsb   51      call blds(')'' ', ss_aprpbl);
      27
      33
dsj   11      call getipp(shrink_opt, 'shrink=0/1');
      34      call getspp(oldfilename, 'p=old/');
      35      call getspp(newfilename, 'n=new/');
dsd   18      call getapp(app, getapp_len);  $ get full parameter string.
dsd   19
dsd   20 $    ucs=name option requests that correction set be written out
dsd   21 $    to named file in cdc update format.
dsd   22      call getspp(ucsname, 'ucs=/');
dsd   23      ucsfile = 0;  $ assume no ucs file.
dsd   24      if  .len. ucsname  then  $ if want ucs format.
dsd   25          ucsfile = 5;
dsd   26          file  5 access=put, title=ucsname, linesize=80;
dsh   40          openchk(5, ucsname); $ see if open.
dsd   27          end if;
      36
      37      im_l = 0;  $ assume no im option.
      38      im_c = 0;  $ assume no im option.
      39      im_e = 0;  $ assume no im option.
      40      call getipp(umode, 'm=2/1');  $ get run mode.
      41      if  umode=0 ! umode>3  then error('invalid mode'); end if;
      42
      43      if  umode=1  then  $ if creation run.
      44          call getspp(pseqstr, 'ps=n/');
      45          call getspp(nseqstr, 'ns=l/r');
      46          call getspp(foptstr, 'f=f/f');
      47          call getipp(defopt,  'd=1/1');
      48      elseif  umode=2  then  $ if retrieval run.
      49          call getspp(pseqstr, 'ps=l/r');
      50          call getspp(nseqstr, 'ns=n/r');
      51          call getspp(foptstr, 'f=ec/f');
      52          call getipp(defopt,  'd=0/1');
ulst   1          call getspp(imopt, 'im=/ec6');  $ im option value.
      54          im_f = ('f'.in.imopt)>0;  $ full option.
      55          im_c = im_f ! (('c'.in.imopt)>0);  $ im for copied members.
      56          im_e = im_f ! (('e'.in.imopt)>0);  $ im for edited members.
      57          l = .len. imopt;
      58          if  l  then  $ if possible im optin.
      59              im_l = 6;
      60              until 1;  $ parse option.
dsb   52                  $   see if last is number.
dsb   53                  i = spn((.s.l,1,imopt), 1, ss_digit);
      62                  if  (i=0)  quit until;
      63                  i = digofchar((.ch.l,imopt));  $ convert to digit.
      64                  if  (i>6)  i = 6;
      65                  im_l = i;
      66                  end until;
      67              end if;
      68          .len. im_name = im_l;
      69          if  ((im_c=0)&(im_e=0))  im_l = 0;
      70      else  $ umode = 3, revision run.
      71          call getspp(pseqstr, 'ps=l/r');
      72          call getspp(nseqstr, 'ns=l/r');
      73          call getspp(foptstr, 'f=f/f');
      74          call getipp(defopt,  'd=1/1');
      75          end if;
      76
      77      call getspp(lstopt, 'lo=acdipu/adipu');
      78      list_a = ('a'.in.lstopt) > 0;
      79      list_c = ('c'.in.lstopt) > 0;
      80      list_d = ('d'.in.lstopt) > 0;
      81      list_i = ('i'.in.lstopt) > 0;
      82      list_p = ('p'.in.lstopt) > 0;
      83      list_u = ('u'.in.lstopt) > 0;
      84      pseq = pseqstr .in. 'nlr';  if  (pseq)  pseq = pseq - 1;
      85      nseq = nseqstr .in. 'nlr';  if  (nseq)  nseq = nseq - 1;
      86
      87      $   im only meaningful if new file sequenced.
      88      if  im_l>0 & nseq=seq_n  then  $ warn and quit.
dsb   54          error('im option requires that new file be sequenced');
      93          call updexi(1);
      94          end if;
      95
      96      cpydef = defopt>0;  $ on to copy member definition lines.
      97      cpyall = ('f'.in.foptstr) > 0;  $ on to copy all members.
      98      docopy = cpyall ! (('c'.in.foptstr)>0);  $ on to do copies.
      99      if  (cpyall)  list_c = no;
     100
     101      file  oldfile  access=get, title=oldfilename, linesize=80;
dsh   41      openchk(oldfile, oldfilename);
     102      file  newfile  access=put, title=newfilename, linesize=80;
dsh   42      openchk(newfile, newfilename);
     103
     104 .+s66    rewind oldfile; rewind newfile;
     105
     106
     107      $   list program parameters if list_p set.
     108      if  list_p  then
     109          call ltitlr(programlevel);
     110          call stitlr(0, 'upd - update source');
dsd   28      if  .len. app  then  $ if actual parameters given, list them.
dsd   29          put :app,a ,skip(2);
dsd   30          end if;
     111          put
dsa    8              ,'upd parameters: mode: m = ' :umode,i ,skip
     113              ,'old: p = ' :oldfilename,a
dsb   55              ,', new: n = ' :newfilename,a
dsb   56              ,', pseq: ps = ' :(.s. pseq+1, 1, 'nlr'),a
dsb   57              ,', nseq: ns = ' :(.s. nseq+1, 1, 'nlr'),a ,skip
dsd   31              ,'ucs: ucs =  ' :ucsname,a ,', '
dsb   58              ,'im: im = ' :imopt,a
dsa   11              ,', def: d = ' :cpydef,i
dsb   59              ,', f: f = ' :foptstr,a
dsb   60              ,', list option: lo = ' :lstopt,a ,skip(3);
     120          end if;
     121      end subr updini;
       1 .=member updcon
       2      subr updcon;    $ upd control procedure.
       3      size  rc(ws);           $ return code.
       4      size  drc(ws);          $ return code.
       5      size  l(ps);            $ string length.
       6      size  cmdn(.sds.8);     $ command name as given.
       7      size  i(ps);            $ loop index.
       8      size  t(.sds.72),s(.sds.8);  $ text, sequence parts of line.
       9      size  brk(ps);          $ break function.
      10      size  dl(ps);           $ command name length.
      11
      12
      13      if  umode=1  then  $ if creation run.
      14          call create;  return;
      15          end if;
      16      $   here for retrieval or revision run.
      17      while 1;
      18          call getcmd(drc, cl, s);  $ read command line.
      19          cmdlisted = no;
      20          if  (drc)  quit while;  $ if end or error.
      21          if  (.ch.1,cl ^= 1r-)  go to cmderr;
      22          if  list_u  then  $ if want command listed.
      23              put :cl,a ,skip;
      24              cmdlisted = yes;
      25              end if;
dsb   61          l = brk(cl, 2, ss_separ);  $ break to blank
      27          if  (l>8)  l =8;  $ only examine first eight characters.
      28          cmdi = 0;  $ assume not valid command.
      29          cmdn = .s. 2, l, cl;  $ get command name.
dsh   43 .+mc     call stpc(cmdn);  $ convert to primary case.
      30          do  i = 1 to n_cmd;  $ loop to find which command.
      31              dl = .len. cmdnames(i);
      32              if  (dl>l)  dl = l;  $ set length for comparison.
      33              if  (dl1  then  $ if not starting first member.
      51                  put ,'member ' :mnow,a(8) ,' contains '
      52                      :oldlines-morg,i(8) ,' lines.' ,skip;
      53                  end if;
      54              morg = oldlines;  mnow = mnxt;
      55          else  $ not member line, advance sequence.
      56              $   check for first line in file not member line.
      57              if  oldlines=1  then  $ if first line not member.
      58                  put ,'first line not member, taken as  m.0' ,skip;
      59                  newlines = newlines + 1;
      60                  if  nseq=seq_l  then
      61                      put newfile :0,i(8) ,' .=member m' ,skip;
      62                  else  put newfile :' .=member m',a :0,i(8) ,skip;
      63                      end if;
      64                  seqno = 0;  morg = 0; nmem = 1;
      65                  end if;
      66
      67              seqno = seqno + 1;
      68              end if;
      69
      70          newlines = newlines + 1;
      71          if  nseq=seq_l  then  $ if left sequence.
      72              put newfile :seqno,i(8)  :t,a(72) ,skip;
      73          else
      74              put newfile :t,a(72) :seqno,i(8) ,skip;
      75              end if;
      76          end while;
      77
      78      put ,'member ' :mnow,a(8) ,' contains '
      79          :(oldlines-morg+1),i(8) ,' lines.' ,skip;
      80      return;
      81
      82 /err/
dsb   68      error('input/output error during creation run');
      87      call updexi(1);
      88      end subr create;
       1 .=member cdcupd
       2 .+cupd.
       3      subr cdcupd(isdeck, t);  $ check for cdc update directive.
       4      $   check for cdc update directive in string t.  if is *deck, then
       5      $   set isdeck and change t to little member definition.
       6      $   if other command, issue warning and proceed as follows:
       7      $   *weor     generate member eorn; e.g., eor1, eor2.
       8      $   *cweor    similar to eor.
       9      $   *comdeck  same as *deck
      10      $   *call     generate little include.
      11      $
      12      $   the *comdeck is used to define section of code that is later
      13      $   copied out by *call.  *cweor and *weor are used to denote
      14      $   record positions in text and generally indicate point at
      15      $   which file should be broken into separate files.
      16
      17      size  isdeck(1);        $ set if *deck line found.
      18      size  t(.sds. 72);      $ string to check.
      19      size  n(ws);            $ count.
      20      size  cui(ps);          $ command index.
      21      size  spn(ps);          $ span function.
      22      size  brk(ps);          $ break function.
      23      size  i(ps);            $ loop index.
      24      size  l(ps);            $ string length.
      25      size  us(.sds. 8);      $ name of update directive.
      26      $   codes for cdc update directives.
      27      +*  cu_call = 1  **  $ *call
      28      +*  cu_comd = 2  **  $ *comdeck
      29      +*  cu_cweo = 3  **  $ *cweor
      30      +*  cu_deck = 4  **  $ *deck
      31      +*  cu_weor = 5  **  $ *weor
      32      +*  n_cu    = 5  **  $ number of cdc update directives.
      33
      34      size  cunam(.sds.8); dims cunam(n_cu);  $ update names.
      35      data  cunam(cu_call) = 'call':
      36            cunam(cu_comd) = 'comdeck':
      37            cunam(cu_cweo) = 'cweor':
      38            cunam(cu_deck) = 'deck':
      39            cunam(cu_weor) = 'weor';
      40      size  cucod(ps);  dims  cucod(n_cu);  $ action codes.
      41      data  cucod(cu_call) = 3:
      42            cucod(cu_comd) = 1:
      43            cucod(cu_cweo) = 2:
      44            cucod(cu_deck) = 1:
      45            cucod(cu_weor) = 2;
      46
      47      isdeck = no;  $ assume not update directive.
      48      if  (.ch. 1, t ^= 1r*)  return;  $ if cannot be command.
dsb   69      l = brk(t, 1, ss_blank);  $ break to blank.
      50      if (l<4)  return;  $ if cannot be command.
      51      if (l>8)  return;  $ if cannot be command.
      52      us = .s. 2, 8, t;
      53      .len. us = l-1;
dsh   44 .+mc call stpc(us);  $ convert to primary case.
      54      cui = 0;  $ assume not command.
      55      do  i = 1 to n_cu;  $ search command list.
      56          if  (cunam(i).sne.us)  cont do;  $ if no match
      57          cui = i;  quit do;  $ if match.
      58          end do;
      59      if  (cui=0)  return;  $ if not command.
      60
      61      put ,'process cdc update directive ''' :cunam(cui),a
      62      ,''' at line ' :oldlines,i ,'.' ,skip;
      63      put ,' old line' ,column(17) :t,a ,skip;
      64
      65      go to l(cucod(cui)) in 1 to 3;
      66
      67 /l(1)/  $ turn *comdeck or *deck into .=member
      68      isdeck = yes;  $  flag as changed deck line.
      69      l = .len. cunam(cui) + 3;  $ length initial part.
      70      t = ' .=member ' .cc. .s. l, 40, t;
      71      go to ret;
      72
      73 /l(2)/  $ change *cweor or *cweor to member.
      74      cueors = cueors + 1;
      75      isdeck = yes;
      76      .s. 1, 15, t = ' .=member eor    ';
      77      n = cueors;
      78      i = 14+(n>9)+(n>99);
      79      until n=0;
      80          .ch. i, t = charofdig(mod(n,10));
      81          n = n / 10;  i = i - 1;
      82          end until;
      83     go to ret;
      84
      85 /l(3)/  $ change *call  to  .=include.
      86      t = ' .=include ' .cc. .s. 7, 61, t;
      87      go to ret;
      88 /ret/
      89      put ,' new line' ,column(17) :t,a ,skip;
      90      end subr cdcupd;
      91 ..cupd
       1 .=member scncmd
       2      subr scncmd(rc);  $ scan command.
       3 $    scan command line for valid command arguments.
       4      size  rc(ws);           $ return code.
       5      size  spn(ps);          $ span function.
       6      size  brk(ws);          $ break function.
       7      size  s1(.sds.1);       $ string temporary.
dsb   71      size  s8(.sds. 8);      $ temporary string with copy name.
dsb   72      size  l(ws);            $ string length.
       9      size  del(.sds.1);      $ delimiter string.
dsb   73      size  ch(cs);           $ character in alter strings.
dsb   74      size  anyc(ps);         $ function to match any character.
dsb   75      size  brkc(ws);         $ function to break to given character.
      11      size  dl(ps);           $ string length.
      12
      13      rc = 0;
dsb   76      af = brk(cl, 1, ss_separ);  $ brk to blank after command name.
dsb   77      $ span to start of arguments.
dsb   78      af = af + spn(cl, af+1, ss_separ) + 1;
      16
      17      go to l(cmdi) in 1 to n_cmd;
      18
      19 /l(c_alt)/  $ alter l1,/old/new/
      20      $   scan and verify line number, collect change strings.
dsb   79      al = brk(cl, af, ss_cm);  $ break to comma.
      22      call verlin(rc, cl, af, al, id1, sn1);  $ verify sequence spec.
      23      if  (rc)  go to vererr;
      24      af = af + al + 2;  $ break out old, new strings.
dsb   80      ch = .ch. af-1, cl;  if  (anyc(ch, ss_separ))  go to err;
dsb   81      l = brkc(cl, af, ch);  $ break to end of old.
dsb   82      if  (l<0)  l = 0;
      27      if  (l=0)  go to err;
      28      altold = .s. af, l, cl;  af = af + l + 1;
dsb   83      l = brkc(cl, af, ch);
dsb   84      if  (l<0)  l = 0;  $ if brkc failed, adjust length to zero.
dsb   85      al = l;
      30      altnew = .s. af, al, cl;
      31      go to ret;
      32
      33 /l(c_cop)/  $ copy n1,n2,n3.n4
      34      copyptr = 0;
      35      while  1;  $ scan member list.
dsb   86          $ get delimiter.
dsb   87          al = brk(cl, af, ss_blank ! ss_cm ! ss_period);
      37          if  (al=0)  go to err;
      38          del = .ch. af+al, cl;  $ get delimiter character.
      39          countup(copyptr, copymax, 'copy1');
      40          copytype(copyptr) = 0;  $ assume single member copy.
      41          l = al;  if  (l>8)  l =8;  $ truncate long name.
      42          copylist(copyptr) = .s. af, l, cl;  $ copy name.
dsh   45 .+mc.    $ convert to primary case.
dsb   89          s8 = copylist(copyptr);
dsh   46          call stpc(s8);
dsb   91          copylist(copyptr) = s8;
dsh   47 ..mc
      43          af = af + al + 1;  $ move to start of next argument.
      44          if  del=1r.  then  $ if range copy.
      45              af = af-1;
dsb   93              l = spn(cl, af, ss_period);  $ allow multiple periods.
      47              if  (l=0)  go to err;
      48              af = af + l;
dsb   94              $ break to end of argument.
dsb   95              al = brk(cl, af, ss_blank ! ss_cm);
      50              if  (al=0)  go to err;
      51              l = al;  if  (l>8)  l = 8;
      52              copytype(copyptr) = 1;  $ indicate multiple copy.
      53              countup(copyptr, copymax, 'copy2');
      54              copylist(copyptr) = .s. af, l, cl;  $ copy name.
dsh   48 .+mc.        $ convert to primary case.
dsb   97              s8 = copylist(copyptr);
dsh   49              call stpc(s8);
dsb   99              copylist(copyptr) = s8;
dsh   50 ..mc
      55              af = af + al + 1;
      56              del = .ch. af-1, cl;  $ retriev delimiter.
      57              end if;
      58          if  (del=1r )  quit while;  $ if end of list.
      59          end while;
      60
      61      go to ret;
      62
      63 /l(c_del)/  $ delete n1  or  delete n1,n2
dsb  101      $ break out first argument.
dsb  102      al = brk(cl, af, ss_blank ! ss_cm);
      65      call verlin(rc, cl, af, al, id1, sn1);  $ verify specifier.
      66      if  (rc)  go to vererr;
      67      delsev = no;  $ assume single delete.
      68      if  .ch. af+al, cl = 1r,  then  $ if possible multiple delete.
      69          af = af + al + 1;  $ position to start of second argument.
dsb  103          $ break to end of second argument.
dsb  104          al = brk(cl, af, ss_separ);
      71          call verlin(rc, cl, af, al, id2, sn2);  $ verify specifier.
dsg   11          if  (rc)  go to vererr;
      72          if  (sn1^=sn2 ! id1.sne.id2)  delsev = yes;
      73          end if;
      74      go to ret;
      75
      76 /l(c_edi)/  $ edit n1
dsb  105      al = brk(cl, af, ss_separ);  $ break out name.
      78      if  (al=0)  go to err;
      79      if  (al>8)  al = 8;  $ truncate long name.
      80      editname = .s. af, al, cl;  $ copy name.
dsh   51 .+mc call stpc(editname);  $ convert to primary case.
      81      if  list_u  then  $ if listing commands.
      82          put ,'editing' ,column(17) :editname,a ,'.' ,skip;
      83      end if;
      84      go to ret;
      85
      86 /l(c_end)/  $end
      87      go to ret;
      88
      89 /l(c_ins)/  $ insert l1
      90 /l(c_bef)/  $ before l1
dsb  107      al = brk(cl, af, ss_separ);  $ break out first argument.
      92      call verlin(rc, cl, af, al, id1, sn1);  $ verify specifier.
      93      if  (rc)  go to vererr;
      94      go to ret;
      95
      96 /l(c_mod)/  $ modname n1
dsb  108      al = spn(cl, af, ss_al);  $ span name (must be all alphabetics).
      98      if  (al=0)  go to err;
      99      if  (al>4)  al = 4;
     100      modname = .s. af, al, cl;  $ get modname.
dsh   52 .+mc call stpc(modname);  $ convert to primary case.
     101      if  list_u  then  $ if listing commands.
     102          put ,'modname' ,column(17) :modname,a ,'.' ,skip;
     103      end if;
     104      go to ret;
     105
     106 /l(c_not)/  $ note
     107      go to ret;
     108
     109 /ret/  $ here for normal return.
     110      rc = 0;  return;
     111 /err/  $ here if error.
     112      rc = 1;  return;
     113 /vererr/  $ here if cannot verify specifier.
dsb  110      error('invalid line specification ' !! cl);
     119      go to err;
     120      end subr scncmd;
       1 .=member verlin
       2      subr verlin(rc, s, sp, sl, id, sn);  $ verify specification.
       3 $    seek valid line specifier in the sl characters of string s
       4 $    starting at position sp.  if found, set id to identifier and
       5 $    sn to sequence number and return with rc of zero.  if invalid
       6 $    return with rc nonzero.  return identifier of null if supplied
       7 $    identifier is same as name of member being edited.
       8
       9      size  rc(ws);           $ return code.
      10      size  s(.sds. 8);       $ sequence field.
      11      size  sp(ps);           $ sarting position.
      12      size  sl(ps);           $ length of field.
      13      size  id(.sds.8);       $ identifier part.
      14      size  sn(ws);           $ sequence number.
      15      size  snf(ps);          $ starting index of sequence number.
      16      size  snl(ps);          $ length of sequence number part.
      17      size  idl(ps);          $ length of identifier.
      18      size  i(ps);            $ loop index.
      19      size  spn(ps);          $ span function.
      20      size  brk(ps);          $ break function.
      21
      22      if  (sl=0)  go to err;
      23      if  (sp>(.len.s))  go to err;
      24      .len. id = 0;  $ assume no identifier.
      25      $   see if only sequence number present, as this will be
      26      $   case for original line in member.
dsb  111      snl = spn(s, sp, ss_digit);  $ span numerics.
      28      if  snl=sl  then  $ if only number.
      29          snf = sp;  go to ret;
      30          end if;
dsb  112      idl = brk(s, sp, ss_period); $ break to end of identifier.
      32      if  ((idl=0)&(.ch.sp,s^=1r.))  go to err;
      33      i = idl;  if  (i>8)  i = 8;  $ copy identifier.
      34      id = .s. sp, i, s;
dsh   53 .+mc call stpc(id);  $ convert to primary case.
      35      if  (id.seq.editname)  .len. id = 0;  $ if same as editname.
      36      snf = sp + idl + 1;  $ point to start of sequence part.
dsb  114      snl = spn(s, snf, ss_digit);  $ span numerics.
      38      if  (snl=0)  go to err;
      39      if  ((idl+snl+1)^=sl)  go to err;  $ if all not matched.
      40
      41 /ret/ $ here to return after converting sequence number.
      42      sn = 0;  snf = snf - 1;
      43      do  i = 1 to snl;
      44          sn = sn*10 + digofchar((.ch. snf+i, s));
      45          end do;
      46      rc = 0;  return;
      47 /err/  $ here if error.
      48      rc = 1;
      49      end subr verlin;
       1 .=member docmd
       2      subr docmd(drc);  $ process command.
       3      size  i(ps);            $ loop index.
       4      size  n1(.sds.8), n2(.sds. 8), n(.sds.8);  $ member names.
       5      size  rc(ws);           $ return code.
       6      size  drc(ws);          $ return code.
       7      size  t(.sds.72),s(.sds.8);  $ text, sequence parts.
       8      size  mnext(.sds.8);    $ getlin member name.
       9      size  mthis(.sds.8);    $ member name.
dsd   32      size  ucsid(.sds. 8);  $ exands names for ucs format.
      10
      11      drc = 0;  rc = 0;
      12      go to l(cmdi) in 1 to n_cmd;
      13
      14 /l(c_alt)/  $ alter
      15      if  (editing=no)  go to err;
      16      call moveto(rc, id1, sn1, yes);  $ move to line.
      17      if  (rc)  go to moverr;
dsd   33      if  ucsfile  then  $ if want ucs format.
dsd   34          put ucsfile ,'*delete ' :ucsid(id1),a ,'.' :sn1,i ,skip;
dsd   35          end if;
      18      call doalt(rc);
      19      if  (rc)  go to err;
      20      call insert;
      21      go to ret;
      22
      23 /l(c_bef)/  $ before
      24      if  (editing=no)  go to err;
      25      call moveto(rc, id1, sn1, yes);  $ move to line.
      26      if  (rc)  go to moverr;
      27      i = curact;  curact = no;
dsd   36      if ucsfile  then  $ if want ucs format.
dsd   37          put ucsfile ,'*before ' :ucsid(id1),a ,'.' :sn1,i ,skip;
dsd   38          end if;
      28      call insert;
      29      curact = i;  $ restore state of saved line.
      30      go to ret;
      31
      32 /l(c_cop)/  $ copy
      33      call endedt;  $ end possible prior edit.
      34      if  (cpyall)  go to ret;  $ no need if copying all members.
      35      if  (docopy=no)  go to ret;  $ if not doing copies.
      36      do  i = 1 to copyptr;
      37      $   set last member to first unless range copy.
      38          n1 = copylist(i);
      39          n2 = n1;  $ assume single copy.
      40          if  copytype(i)  then  $ if multiple copy.
      41              i = i + 1;
      42              n2 = copylist(i);  $ get name of last member.
      43              end if;
      44          n = n1;
      45          while 1;  $ copy entries.
      46              call cpymem(rc, n, mnext);
      47              if  (rc>1)  quit do;  $ if end.
      48              if  (n.seq.n2)  quit while;  $ if copy done.
      49              n = mnext;
      50              end while;
      51          if  (rc>1)  then  go to enderr; end if; $ if end.
      52          if  (rc^=1)  go to moverr;  $ if not at end of member.
      53          end do;
      54      editing = no;
      55      if  (rc=2)  then  go to enderr; end if;  $ if end.
      56      go to ret;
      57
      58 /l(c_del)/  $ delete
      59      if  (editing=no)  go to err;
      60      call moveto(rc, id1, sn1, yes); $ move to first line.
      61      if  (rc)  go to moverr;
      62      curact = no;  $ delete line.
      63      if  (list_d)  call putlst(0, curtxt, curseq);
      64      if  delsev  then  $ if multiple delete.
      65          call moveto(rc, id2, sn2, no);  $ move to last line.
      66          if  (rc)  go to moverr;
      67          if  (list_d)  call putlst(0, curtxt, curseq);
      68          end if;
dsd   39
dsd   40      if  ucsfile  then  $ if want ucs format.
dsd   41          put ucsfile ,'*delete ' :ucsid(id1),a ,'.' :sn1,i;
dsd   42          if  delsev  then  $ if multiple delete.
dsd   43              put ucsfile ,',' :ucsid(id2),a ,'.' :sn2,i;
dsd   44              end if;
dsd   45          put ucsfile ,skip;
dsd   46          end if;
dsd   47
      69      call insert;
      70      go to ret;
      71
      72 /l(c_edi)/  $ edit
      73      call endedt;  $ end possible prior edit.
      74      call movmem(rc, editname);  $ move to member.
      75      if  (rc^=1)  go to enderr;
      76      call getlin(rc, 1, mnext, curtxt, curseq);  $ get definition line.
      77      if  (rc>1)  go to enderr;
      78      editing = yes;
      79      if  im_l  then  $ if identifying members.
      80          if  im_e  then  $ if want to identify this member.
      81              call seqnam(editname);
      82          else  call seqnam('');  $ else clear name.
      83              end if;
      84          end if;
      85      call brkseq(rc, curseq, curid, cursn);  $ break sequence field.
      86      curact = 2;  $ note at member definition line.
dsd   48      if  ucsfile  then  $ if want ucs format.
dsd   49          put ucsfile ,'*compile ' :editname,a ,skip;
dsd   50          end if;
      87      go to ret;
      88
      89 /l(c_end)/  $ end
      90      cmdend = yes;   go to ret;
      91
      92 /l(c_ins)/  $ insert
      93      if  (editing=no)  go to err;
      94      call moveto(rc, id1, sn1, yes);  $ move to line.
      95      if  (rc)  go to moverr;
dsd   51      if  ucsfile  then  $ if want ucs format.
dsd   52          put ucsfile ,'*insert ' :ucsid(id1),a ,'.' :sn1,i ,skip;
dsd   53          end if;
      96      call insert;
      97      go to ret;
      98
      99 /l(c_mod)/  $ modname
     100      seqno = 0;  $ reset sequence number.
dsd   54      if  ucsfile  then  $ if want ucs format.
dsd   55          put ucsfile ,'*ident ' :modname,a ,skip;
dsd   56          end if;
     101      go to ret;
     102
     103 /l(c_not)/  $ note
dsd   57      if  ucsfile  then  $ if want ucs format.
dse   10          put ucsfile ,'*' ,'/ ' :(.s. 1, 69, cl),a ,skip;
dsd   59          end if;
     104      go to ret;
     105
     106 /ret/  $ normal termination.
     107      drc = 0;  return;
     108 /enderr/  $ here if either end of file or error.
     109      if  (rc=3)  go to err;
     110      drc = 2;  return;
     111 /err/  $ here if error.
     112      terml(yes);
     113      put ,'error processing command' ,skip;
dsf    9      $  copy command line to terminal.
dsf   10      call contlpr(26, no); $ turn off listing, as line has been listed.
dsf   11      put ,x :cl,a ,skip;
dsf   12      call contlpr(26, yes);  $ resume listing.
     114      terml(no);
     115      drc = 1;
     116      return;
     117 /moverr/  $ here if error during move.
dsf   13      error('unable to find line in member ' .cc. editname);
     122      drc = 1;
     123      end subr docmd;
       1 .=member ucsid
       2      fnct ucsid(id);  $ return expanded ident name.
       3      size  id(.sds. 8);      $ ident name (null if current member)
       4      size  ucsid(.sds. 8);   $ expanded name
       5
       6      $   if id is null return current member name, else return id.
       7      if  .len. id = 0  then  $ if need member name.
       8          ucsid = editname;
       9      else  ucsid = id;
      10          end if;
      11      end fnct ucsid;
       1 .=member doalt
       2      subr doalt(rc);  $ do alter.
       3 $    change instance of oldalt (which must occur) to string
       4 $    given by newalt.  report error if line truncation.
       5 $    doalt is separate procedure to simplify addition of
       6 $    more powerful string editing/alteration facilities.
       7
       8      size  rc(ws);           $ return code.
       9      size  c(cs);            $ character temporary.
      10      size  i(ps);            $ loop index.
      11      size  nl(ps);           $ length of new line.
      12      size  newtxt(.sds.72);  $ new text.
      13      size  l(ps);            $ string length.
      14      size  rp(ps);           $ starting point of string remainder.
      15      size  rl(ps);           $ length of trailing part.
      16
      17      if  list_a  then  $ list line before alter
      18          call putlst(0, curtxt, curseq);
      19          end if;
      20      i = altold .in. curtxt;  $ look for instance of old.
      21      if  (i=0)  go to err;  $ if required instance not found.
      22      newtxt = curtxt;  $ copy current text.
      23      nl = i - 1;  $ set length new text.
      24      rp = i + (.len. altold);  $ starting position of string rest.
      25      l = .len. altnew;  $ set length of subsitution string.
      26      if  ((nl+l)>72)  go to err;  $ if new string too long.
      27      .s. nl+1, l, newtxt = altnew;  $ do substitution.
      28      nl = nl + l;  $ adjust new string length.
      29      if  nl+1>rp  then  $ if possible truncation.
      30          rl = 73 - rp;  $ trim trailing blanks.
      31          do  i = 72 to rp by -1;
      32              if  (.ch.i,curtxt ^= 1r )  quit do;
      33              rl = rl - 1;
      34              end do;
      35          if  ((nl+rl)>72)  go to err;  $ if truncation.
      36          end if;
      37      if  nl<72  then  $ if need to copy trailing part.
      38          .s. nl+1, 72-nl, newtxt = .s. rp, 73-rp, curtxt;  $ copy rest.
      39          end if;
      40      curtxt = newtxt;
      41      call genseq(curseq);  $ generate sequence field.
      42      call putlin(curtxt, curseq);
dsd   60      if  ucsfile  then  $ if want ucs format.
dsd   61          put ucsfile :curtxt,a ,skip;
dsd   62          end if;
      43      curact = no;
      44      if  list_a  then  $ list line after alter.
      45          call putlst(1, curtxt, curseq);
      46          end if;
      47      rc = 0;
      48      return;
      49 /err/
      50      rc = 1;
      51      end subr doalt;
       1 .=member brkseq
       2      subr brkseq(rc, s, id, sn);  $ break out sequence info.
       3 $    break out identifier id and sequence number sn from
       4 $    sequence field s.  set to rc to zero for normal return,
       5 $    else set rc nonzero if s not valid sequence field (in
       6 $    which case id and sn are not altered).
       7
       8      size  rc(ws);           $ return code.
       9      size  s(.sds. 8);       $ sequence field.
      10      size  id(.sds.8);       $ identifier part.
      11      size  sn(ws);           $ sequence number.
      12      size  idl(ps);          $ identifier length.
      13      size  sb(ps);           $ number of starting blanks.
      14      size  ib(ps);           $ number of intermediate blanks.
      15      size  tb(ps);           $ number of trailing blanks.
      16      size  snf(ps);          $ starting index of sequence number.
      17      size  snl(ps);          $ length of sequence number.
      18      size  i(ps);            $ loop index.
      19      size  brk(ps);          $ span function.
      20      size  spn(ps);          $ span function.
      21
      22      rc = 0;  $ assume normal return.
      23      idl = 0;  $ assume no identifier.
dsb  116      sb = spn(s, 1, ss_blank);  $ span initial blanks.
      25      if  (sb=8)  go to err;  $ error if all blanks.
      26      $   assume no identifier, see if just sequence.
dsb  117      snl = spn(s, sb+1, ss_digit);  $ span digits.
      28      if  snl  then  $ if number field.
      29          snf = sb+1;  $ starting index of sequence field.
      30          if  (sb+snl)<8  then  $ if required trailing blanks.
dsb  118              tb = spn(s, snf+snl, ss_blank);  $ span blanks.
      32              if  (snf+snl+tb ^= 9)  go to err;
      33              end if;
      34          go to ret;
      35          end if;
      36      $   here if identifier.
dsb  119      idl = spn(s, sb+1, ss_al);  $ span identifier.
      38      if  (idl=0)  go to err;
dsb  120      $ span possible intervening blanks.
dsb  121      ib = spn(s, sb+idl+1, ss_blank);
      40       snf = sb + idl + ib + 1;  $ $ set starting index.
      41      if  (snf>8)  go to err;
dsb  122      snl = spn(s, snf, ss_digit);  $ span digits.
      43      if  (snl=0)  go to err;  $ if no sequence field.
dsb  123      tb = spn(s, snf+snl, ss_blank);  $ span blanks.
      45      if  ((snf+snl+tb) ^= 9)  go to err;  $ if illformed.
      46
      47 /ret/  $ here to convert sequence number.
      48      if  idl  then  $ if identifier.
      49          id = .s. sb+1, idl, s;
      50      else  .len. id = 0;  $ if no identifier.
      51          end if;
      52      sn = 0;  snf = snf - 1;
      53      do  i = 1 to snl;
      54          sn = sn*10 + digofchar((.ch. snf+i, s));
      55          end do;
      56      return;
      57 /err/  $ here if error.
      58      rc = 3;
      59      end subr brkseq;
       1 .=member moveto
       2      subr moveto(rc, id, sn, act);  $ move to line.
       3 $    move edit file to line id.sn, copying intervening lines
       4 $    if act nonzero.  set status of line to act.
       5
       6      size  rc(ws);           $ return code.
       7      size  id(.sds. 8);      $ desired identifier.
dsi    9 .+mc size  idf(.sds. 8);     $ desired identifier (folded).
dsi   10 .+mc size  curidf(.sds. 8);  $ current identifier (folded).
       8      size  sn(ws);           $ sequence number.
       9      size  act(1);           $ on to copy lines.
      10      size  avail(ps);        $ on if line available.
      11      size  brc(ws);          $ return code.
      12      size  mname(.sds. 8);   $ next member name.
      13      size  gotline(1);       $ on if have line.
      14
      15      if  (editing=no)  return;
      16      avail = curact;  $ set if current line active.
dsi   11 .+mc.
dsi   12 $    convert to primary case for search.
dsi   13      idf  = id;
dsi   14      call stpc(idf);
dsi   15 ..mc
dsi   16
      17      gotline = (curact = 1);
      18      curact = no;  gotline = no;
      19      while 1;
      20          if  avail  then  $ if current line may be desired one.
      21              if  cursn=sn  then  $ if found.
dsi   17 .-mc             if  curid.seq.id  then  $ if same name.
dsi   18 .+mc.
dsi   19 $    if mixed case, fold non-null identifier from opl.
dsi   20                  if  .len. curid = 0  then $ if null
dsi   21                      .len. curidf = 0;  $ just reassign length.
dsi   22                  else  $ else convert to primary case.
dsi   23                      curidf = curid;
dsi   24                      call stpc(curidf);
dsi   25                      end if;
dsi   26                  if  curidf .seq. idf  then  $ if same name.
dsi   27 ..mc
      23                      curact = act;
      24                      rc = 0;
      25                      return;
      26                      end if;
      27                  end if;
      28              $   here if line at hand that may need writing.
      29              if  act  then
      30                  if  (avail=1)!(avail=2&cpydef)  then
      31                      call putlin(curtxt, curseq);
      32                      end if;
      33              else
      34                  if  gotline&list_d  then
      35                      call putlst(0, curtxt, curseq);
      36                      end if;
      37                  end if;
      38              end if;
      39          call getlin(rc, 0, mname, curtxt, curseq); $ get next line.
      40          if  (rc)  go to err;
      41          call brkseq(brc, curseq, curid, cursn);  $ get sequence.
      42          if  (brc)  go to err;
      43          gotline = yes;
      44          avail = 1;  $ note line available.
      45          end while;
      46      return;
      47 /err/  $ here if error.
      48      rc = 1;
      49      end subr moveto;
       1 .=member insert
       2      subr insert;  $ do text insertion.
       3 $    copy non-commands in command file as new text, adding
       4 $    generated sequence numbers.
       5
       6      size  rc(ws);           $ return code.
       7      size  t(.sds.72),s(.sds.8);  $ text, sequence part.
       8
       9      rc = 0;
      10      if  (.len.modname=0)  then  $ if no modname yet seen.
dsb  124          terml(yes);
dsb  125 .+s10    put :37,r(1); $ issue s10 percent warning character.
      11          put,'***warning*** missing modname, use -mo-',skip;
dsb  126          terml(no);
      12          modname = 'mo';
      13          end if;
      14
      15      if  editing=no  then $ if cannot insert.
      16          error('attempt insert while not editing.');
      17          $i  skip to next non-command.
      18          while 1;
      19              call getcmd(rc, t, s);
      20              if  (rc=2)  return;
      21              if  (rc)  go to err;
      22              if  (.ch. 1, t ^= 1r-)  cont while;
      23              keepcmd = yes;  $ keep command.
      24              end while;
      25          go to err;
      26          end if;
      27
      28      $   here to possibly write out current line if active.
      29      if  curact=1 ! (curact=2&cpydef)  then
      30          call putlin(curtxt, curseq);  $ put defining line.
      31          end if;
      32      curact = no;
      33
      34      while 1;  $ copy out non-commands.
      35          call getcmd(rc, t, s);
      36          if  (rc)  quit while;
      37          if  .ch. 1, t = 1r-  then  keepcmd=yes; quit while; end if;
      38          call genseq(s);  $ generate new sequence field.
dsd   63          if  ucsfile  then  $ if want ucs format.
dsd   64              put ucsfile :t,a ,skip;
dsd   65              end if;
      39          call putlin(t, s);  $ write new line.
      40          if  list_i  then  $ if listing inserts.
      41              call putlst(1, t, s);
      42              end if;
      43          end while;
      44      return;
      45 /err/    rc = 1;
      46      end subr insert;
       1 .=member genseq
       2      subr genseq(s);  $ generate new sequence field.
       3      $   generate new sequence field.
       4      size  s(.sds. 8);       $ sequence field.
       5      size  n(ws);            $ working value.
       6      size  d(ps);            $ temporary.
       7      size  i(ps);            $ position.
       8      size  l(ps);            $ position.
       9
      10      s = ''.pad. 8;  .s. 1, (.len. modname), s = modname;
      11      seqno = seqno + 1;  $ advance sequence number.
      12      n = seqno;  l = .len. modname;
      13      i = 8;  $ rightmost postion.
      14      until  n=0;  $ until sequence number converted.
      15          d = mod(n, 10);
      16          .ch. i, s = charofdig(d);  $ store converted char.
      17          i = i - 1;  n = n / 10;
      18          if  (i=0)  quit until;
      19          end until;
      20
      21      if  i8)  ml = 8;
      30      mnam = .s. mf, ml, t;  $ enter member name.
dsh   55 .+mc call stpc(mnam);  $ convert name to primary case.
      31      end subr chkmem;
       1 .=member getcmd
       2      subr getcmd(rc, t);  $ get command line.
       3 $    get next line from standard input file.
       4      size  rc(ws);           $ return code.
       5      size  t(.sds. 72), s(.sds.8);  $ text, sequence parts.
       6      size  cmds(.sds. 8);
       7      size  txt(.sds.72);     $ text string.
       8
       9      if  cmdend  then  rc = 2;  return;  end if;  $ if end seen.
      10      if  keepcmd  then  $ if previous line to be returned.
      11          t = txt;  s = cmds;  rc =0;  keepcmd = no;
      12          return;
      13          end if;
      14
      15      get ,skip :txt,a(72);  t = txt;
      16      cmds = '' .pad. 8;
      17      if  (filestat(1,end)!filestat(1,err))  then
      18          rc = 2;  cmdend = yes;
      19      else  rc = 0;  end if;
      20      end subr getcmd;
       1 .=member cpyrst
       2      subr cpyrst(rc);  $ copy rest of file if full mode.
       3      size  rc(ws);           $ return code.
       4      size  t(.sds.72),s(.sds.8);  $ sequence, text parts.
       5      size  mthis(.sds.8);    $ name of current member.
       6      size  mnext(.sds.8);    $ name of next member.
       7
       8      call endedt;
       9      if  (cpyall=no)  return;
      10      if  (oldend)  return;  $ if end of old already seen.
      11      call getlin(rc, 0, mthis, t, s); $ get member def. line.
      12      if  (rc^=1)  then  $ error if not at member line.
      13          error('cpyrst not at member line');
      14          rc = 3;  return;
      15          end if;
      16
      17      while 1;
      18          call cpymem(rc, mthis, mnext); $ copy member.
      19          if  (rc>1)  quit while;  $ if end seend.
      20          mthis = mnext;  $ set name of next member.
      21          end while;
      22      rc = 0;
      23      end subr cpyrst;
       1 .=member endedt
       2      subr endedt;  $ end edit if editing active.
       3 $    if editing, copy out rest of member.
       4      size  rc(ws);           $ return code.
       5      size  mnext(.sds.8);    $ name of next member.
       6
       7      if  (editing=no)  return;
       8      $   copy current line if active.
       9      if  (curact=1)!(curact=2 & cpydef)  then
      10          call putlin(curtxt, curseq);  $ put line.
      11          end if;
      12      call movend(rc, mnext, yes);  $ move to end of member.
      13      editing = no;
      14      end subr endedt;
       1 .=member cpymem
       2      subr cpymem(rc, mthis, mnext);  $ copy member mthis.
       3      $   copy member mthis and set mnext to name of next member.
       4      size  rc(ws);           $ return code.
       5      size  mthis(.sds. 8);   $ name of member to copy.
       6      size  mnext(.sds. 8);   $ name of next member.
       7      size  t(.sds. 72), s(.sds. 8);  $ text, sequence parts.
       8
       9      if  list_c  then  $ if listing copies.
      10          put ,'copying' ,column(17) :mthis,a ,'.' ,skip;
      11          end if;
      12      call movmem(rc, mthis);  $ move to member.
      13      if  (rc^=1)  return;
      14      if  im_c & (im_l>0)  then  $ if identifying this member.
      15          call seqnam(mthis);
      16          end if;
      17      call getlin(rc, 1, mnext, t, s);  $ get member name.
      18      if  (rc>1)  return;  $ if end or error.
      19      if  (cpydef)  call putlin(t, s); $ if want defining line.
      20      call movend(rc, mnext, yes);  $ copy rest of member.
      21      end subr cpymem;
       1 .=member movmem
       2      subr movmem(rc, mwant);  $ move to start of member.
       3      size  rc(ws);           $ return code.
       4      size  mwant(.sds. 8);   $ name of member.
       5      size  t(.sds. 72), s(.sds. 8); $ text, sequence parts.
       6      size  mnext(.sds. 8);   $ name of next member.
       7      size  mname(.sds. 8);   $ member name.
       8
       9      call movend(rc, mnext, cpyall);  $ copy to end of current member.
      10      if  (rc>1)  return;  $ if end or error.
      11
      12      while 1;
      13          if  mnext.seq.mwant  then  $ if desired member found.
      14              rc = 1;  return;
      15              end if;
      16          if  cpyall  then  $ if copying all members, copy this one.
      17              call getlin(rc, 1, mname, t, s);  $ get defining line.
      18              if  (im_l)  call seqnam('');  $ reset im name.
      19              if  (cpydef)  call putlin(t, s);  $ if want defining line.
      20              call movend(rc, mnext, yes);  $ copy rest.
dse   11              if  (rc>1)  quit while;  $ if end seen.
      21          else  $ here to skip to end of this member.
      22              call getlin(rc, 2, mnext, t, s);
      23              if  (rc^=1)  quit while;
      24              end if;
      25          end while;
      26      rc = 2;
dsb  134      error('unable to locate member ' !! mwant);
      31      end subr movmem;
       1 .=member movend
       2      subr movend(rc, mnext, cpy);  $ move to end of member.
       3      $   move to initial part of next member, copying intervening
       4      $   lines if cpy nonzero.  set mnext to name of next member.
       5
       6      size  rc(ws);           $ return code.
       7      size  mnext(.sds. 8);   $ name of next member.
       8      size  mname(.sds. 8);   $ member name.
       9      size  cpy(1);           $ on to copy.
      10
      11      size  t(.sds. 72), s(.sds. 8);  $ sequence, text parts.
      12
      13      size  grc(ws);          $ getlin return code.
      14      .len. mnext = 0;
      15      call getlin(grc, 0, mname, t, s); $ get line.
      16      if  (grc>1)  go to enderr;  $ if end or error.
      17      while  grc=0;  $ move to end of member.
      18          if  (cpy)  call putlin(t, s);  $ if copying member.
      19          call getlin(grc, 0, mname, t, s);
      20          if  (grc>1)  go to enderr;
      21          end while;
      22      assert grc=1;
      23      if  (im_l)  call seqnam('');  $ clear im name.
      24      mnext = mname;  rc = grc;
      25      return;
      26 /enderr/  $ here if end or error on old file.
      27      rc = grc;
      28      end subr movend;
       1 .=member getlin
       2      subr getlin(rc, fc, mname, t, s);  $ get line from old file.
       3 /*   read line from old file according to status of getrc and
       4      function code fc, as follows:
       5      getrc   fc      action
       6      0       0       read line, check for member line.
       7      0       1       set getrc=3 and return.
       8      0       2       skip to next line that begins member, then
       9                      set getrc=1 and return member name in mname.
      10
      11      1       0       return member name in mname.
      12      1       1       return saved t, s; set getrc=0.
      13      1       2       skip to next line that begins member, then
      14                      set getrc=1 and return member name in mname.
      15
      16      2       -       return getrc.
      17      3       -       return getrc.
      18
      19      for random files mode,
      20      (rc=1,fc=2) is request to set rc=1 and return name
      21      of next member; (rc=0,fc=2) returns name of next member.
      22
      23 */
      24      size  rc(ws);           $ return code.
      25      size  fc(ps);           $ function code.
      26      size  t(.sds. 72), s(.sds. 8);  $ text, sequence parts.
      27      size  nrc(ws);          $ getnxt return code.
      28      size  mnext(.sds. 8);   $ name of next member.
      29      size  mname(.sds. 8);   $ member name.
      30      size  ot(.sds. 72), os(.sds. 8);  $ saved text, sequence parts.
      31
      32      if  getrc>1  then  rc = getrc;  return; end if;
      33
      34      if  fc=0  then $ if normal read request.
      35          if  getrc=0  then $ if not at member line.
      36              call getnxt(nrc, mnext, t, s);  $ get next line.
      37              if  (nrc>1)  then  getrc=nrc; go to ret; end if;
      38              if  nrc=1  then  $ if member line.
      39                  ot = t;  os = s;  $ save line.
      40                  getrc = 1;  $ indicate at member line.
      41                  go to retmem;  $ return member name.
      42              else  getrc=0;  go to ret;  $ if not member line.
      43                  end if;
      44          else    go to retmem;  $ else return name of next member.
      45              end if;
      46      elseif  fc=1  then
      47          if  getrc=0  then  getrc=3;  go to ret;
      48          else  $ return saved line.
      49              t = ot;  s = os;  getrc = 0;  go to ret;
      50              end if;
      51      elseif  fc=2  then  $ if want to skip to next member.
      52          while 1;
      53              call getnxt(nrc, mnext, ot, os);  $ read line.
      54              if  nrc>1  then  getrc = nrc;  go to ret;  end if;
      55              if  (nrc=1)  go to retmem;
      56              end while;
      57      else  error('invalid getlin function code');
      58          getrc = 3;  go to ret;
      59          end if;
      60 /retmem/  $ here to return member name.
      61      getrc = 1;  rc = getrc;  $ set return codes.
      62      mname = mnext;  $ copy member name.
      63      return;
      64 /ret/ $ normal return.
      65      rc = getrc;  return;
      66 /err/
      67      error('getlin error');
      68      getrc = 3;  rc = getrc;
      69      end subr getlin;
       1 .=member getnxt
       2      subr getnxt(rc, mname, t, s);  $ get next line from old file.
       3      $   read next line from old file.  set t,s to text and
       4      $   sequence parts.  if line begins member, set rc to one and
       5      $   set mname to member name.
       6
       7      size  rc(ws);           $ return code.
       8      size  mname(.sds. 8);   $ member name.
       9      size  t(.sds. 72), s(.sds. 8);  $ sequence, text parts.
      10      size  ot(.sds. 72), os(.sds. 8);  $ saved sequence, text parts.
      11      size  mn(.sds. 8);      $ member name.
      12
      13      if  oldend  then  rc = 2;  return; end if;  $ if at end of old.
      14
      15      if  pseq=seq_l then  $ if sequence at left.
      16          get oldfile ,skip :s,a(8) :t,a(72);
      17      elseif  pseq=seq_r  then  $ if sequence at right.
      18          get oldfile ,skip :t,a(72) :s,a(8);
      19      else  $ if no sequence.
      20          get oldfile ,skip :t,a(72);  s = ''.pad.8;
      21          end if;
      22      if  filestat(oldfile,end)>0 ! filestat(oldfile,err)>0  then
      23          oldend = yes;  rc = 2;  return;
      24          end if;
      25
      26      oldlines = oldlines + 1;
      27      call chkmem(mn, t);  $ see if member line.
      28      if  .len. mn  then  $ if member line.
      29          mname = mn;  rc = 1;
      30      else  rc = 0;  end if;
      31      end subr getnxt;
       1 .=member putlin
       2      subr putlin(t, sa);  $ put line to new file.
       3      size  t(.sds. 72), sa(.sds. 8);  $ text, sequence parts.
       4      size  s(.sds. 8);           $ sequence field.
       5      size  spn(ps);                $ span function.
       6      size  l(ps);                  $ string length.
       7
dsj   12      size  shrink(1);       $ function to check for discard.
dsj   13
dsj   14      if  shrink_opt  then
dsj   15          if  (shrink(t))  return;
dsj   16          end if;
dsj   17
       8      s = sa;  $ copy sequence field.
       9      until 1;  $ process possible im option.
      10          if  (im_l=0)  quit until;  $ if no im option.
      11          if  ((.len. im_name) = 0)  quit until;
dsb  135          l = spn(s, 1, ss_blank);  $ count initial blanks.
      13          if  (l<3)  quit until;  $ if no room for name.
      14          if  (l=8)  quit until;  $ if no room for name.
      15          $  if first nonblank not numeric, is already identified.
dsb  136          if  (spn((.s. l+1, 1, s), 1, ss_digit) = 0)  quit until;
      17          .s. 1, l-1, s = im_name;  $ substitute name part.
      18          end until;
      19
      20      if  nseq=seq_n  then  $ if no sequence.
      21          put newfile :t,a ,skip;
      22      elseif  nseq=seq_l  then  $ if left sequence.
      23          put newfile :s,a(8) :t,a ,skip;
      24      else  $ if right sequence.
      25          put newfile :t,a(72) :s,a(8) ,skip;
      26          end if;
      27      newlines = newlines + 1;
      28      end subr putlin;
       1 .=member shrink
       2      fnct shrink(iline);
       3 $    determine if text can be discarded.
       4 $    lines to be ignored are indicated by returning 1.
       5 $
       6 $        discard blank lines
       7 $        discard comments (lines with dollar sign as first
       8 $        non-blank character)
       9 $
      10 $    input linesize of 72 is assumed.
      11 $
      12
      13
      14      size  iline(.sds. 72);  $ input line
      15      size  nlb(ws);          $ number of leading blanks.
      16      size  spns(ws);         $ character span function
      17      size  shrink(1);        $ return value, set for discard.
      18
      19
      20
      21
      22
      23      if  .len. iline = 0  then
      24          shrink = yes;
      25      elseif  .ch. 1, iline = 1r$  then  $ if initial comment
      26          shrink = yes;
      27      else
      28           nlb = spns(iline, 1, ss_separ);  $ count initial blanks.
      29          $   process all blank lines.
      30          if  nlb=-1  then $ if no leading separators.
      31          shrink=no;
      32          elseif  nlb=72  then
      33              shrink = yes;
      34          elseif  (.ch. nlb+1,iline = 1r$ )  then
      35                  shrink = yes;
      36          else  shrink = no;
      37              end if;
      38          end if;
      39      end fnct;
       1 .=member seqnam
       2      subr  seqnam(s);     $ generate identifying member name.
       3      $   if im option enabled, set im name to s.
       4      size  s(.sds. 8);       $ desired name.
       5      size  l(ps);            $ string length.
       6
       7      if  (im_l=0)  return;  $ if im option disabled.
       8      l = .len. s;  if  (l>im_l)  l = im_l;
       9      .len. im_name = 0;  if  (l=0)  return;
      10      im_name = .s. 1, l, s;
      11      end subr seqnam;
       1 .=member brk
dsb  137      fnct brk(s, sp, ss);  $ return span string length.
       3 $    return length of longest string of s, starting at sp-th
       4 $    character, which is followed by character in char vector cv.
       5      size  s(.sds. 10);      $ string to search.
       6      size  sp(ps);           $ starting position.
dsb  138      size  ss(ws);           $ character vector.
       8      size  brk(ps);          $ result.
dsb  139      size  brks(ws);         $ result.
      12
dsb  140      brk = brks(s, sp, ss);
dsb  141      if  (brk<0)  brk = 0;
      24      end fnct brk;
       1 .=member spn
dsb  142      fnct spn(s, sp, ss);
       3 $    return length of longest string of s, starting at sp-th
       4 $    character, which consists of characters in char vector cv.
       5      size  s(.sds. 10);      $ string to search
       6      size  sp(ps);           $ starting index
dsb  143      size  ss(ws);           $ character vector.
       8      size  spn(ps);          $ result.
dsb  144      size  spns(ps);         $ functin to span string.
      12
dsb  145      spn = spns(s, sp, ss);
dsb  146      if (spn<0)  spn = 0;
      22      end fnct spn;
       1 .=member upderr
       2      subr upderr(txt); $ report error.
dsb  147      size  txt(.sds. 120);    $ error message.
       4
       5      nerrors = nerrors + 1;
       6      terml(yes);
dsb  148 .+s10    put :63,r(1); $ issue s10 question mark error character.
       7      put ,'***error*** ' :txt,a ,skip;
dsf   14      call contlpr(26, no);  $ do not copy to listing.
dsf   15      put ,x :cl,a ,skip;
dsf   16      call contlpr(26, yes); $ resume listing.
       8      terml(no);
      10      call updexi(1);
      11      end subr upderr;
       1 .=member putlst
       2      subr putlst(act, txt, seq);
       3      size  act(ps);          $ nonzero if line inserted.
       4      size  txt(.sds. 72);     $ text part.
       5      size  seq(.sds. 8);      $ sequence part.
       6      size  acttyp(cs);  dims acttyp(2);   $ activity type.
       7      data  acttyp = 1r-, 1r+;
       8
       9      put ,x(2) :seq,a(8) :acttyp(act+1),r(1) :txt,a(72) ,skip;
      10      ninsert = ninsert + act;  $ increment if line added.
      11      ndelete = ndelete + (1-act);  $ increment if line deleted.
      12      end subr putlst;
       1 .=member updexi
       2      subr updexi(c);  $ upd exit procedure.
       3      size  c(ps);            $ completion code, nonzero if abnormal.
dsh   56      size  termcode(ws);     $ termination code.
       4 .+s66    rewind newfile;
       5      if  nerrors  then  $ if errors detected.
       6          terml(yes);
       7          put ,skip :nerrors,i ,' errors detected.' ,skip;
       8          terml(no);
       9          end if;
      10      if  list_p  then
      11          terml(yes);
      12          put ,skip;
      13          put ,'lines ';
      14          if  (oldlines)  put ,'  read=' :oldlines,i ;
      15          if  (newlines)  put ,'  written=' :newlines,i ;
      16          if  (ninsert)  put ,'  inserted=' :ninsert,i ;
      17          if  (ndelete)  put ,'  deleted=' :ndelete,i ;
      18          put ,'.' ,skip;
      19          terml(no);
      20          end if;
dsh   57 .-unix.
      21      put ,'end of upd run.' ,skip;
dsh   58 ..unix
dsh   59
dsh   60 $    determine termination code.
dsh   61
dsh   62      termcode = 0;
dsh   63      if  (nwarnings)  termcode = 4;
dsh   64      if  (nerrors)  termcode = 8;
dsh   65
dsh   66      call ltlfin(c, termcode);
      23      end subr updexi;

« March 2024 »
Su Mo Tu We Th Fr Sa
1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30
31
 

Powered by Plone CMS, the Open Source Content Management System

This site conforms to the following standards: