!ECCExx:    Implementation of ECCE for VAX, EMAS and MOUSES
!  Revised specification (1981) including video support.
!  Files addressed directly in virtual memory.
!  Most of the main part of the program (routine EDI) is common
!  to both VAX and EMAS versions.  The procedures for opening
!  and closing files are distinct.  Upper-case is used for those
!  sections of program text which are peculiar to one version.
!
!      ECCE00 (09/02/81): initial test release
!
!      ECCE01 (04/06/81): VT52/Bantam/hard-copy support

!      ECCE02  (23/03/82): VT100 support added
!
!
!
!
!
!
!
!
!
!
!
!
!
!
!
!
!
!
!
%OPTION "NOOPEN"
%constinteger  line insert = x'8000 0000',
              inverse video = x'4000 0000'

%constinteger  Hard Copy   = 0,
               Bantam      = 1,   {P-E 550 old model}
               VT52        = 2+line insert+inverse video,
               VT100       = 3+line insert+inverse video,
               VC404       = 4

!
%BEGIN;                            !MOUSES version (program not routine)
%constinteger rt=13, esc=27, dle=x'10'; !ISO control characters
%CONSTINTEGER MAXNAME=31;          !max file-name length
%RECORDFORMAT FILE(%STRING(MAXNAME) NAME, %C
                    %INTEGER TOP,LIM,VMTOP,VMLIM,FLAG)
!
%ROUTINESPEC MOVE(%INTEGER LENGTH,FROM,TO);  !bulk move
!
%routinespec connect input(%record(file)%name f)
%BYTEINTEGERMAPSPEC BYTEINTEGER(%INTEGER PSEUDO ADDR);  !*MOUSES*

!!!!!!!!!!!!!!!!!!!  Start of Editor proper !!!!!!!!!!!!!!!!!!!
!
%routine edi(%record(file)%name old,sec,new, %integer video,rows,cols)
! Only the TOP and LIM components of the file info records
!  OLD, SEC and NEW are relevant for editing (except when
!  referencing secondary input).
!  In the EMAS version the original file is not copied into the
!  working space (NEW) prior to entry, so that OLD_LIM is not
!  equal to NEW_LIM: on VAX, OLD_LIM is equal to NEW_LIM (except
!  when just 'showing' in which case NEW_TOP = NEW_LIM = 0).
!  The parameter VIDEO defines terminal characteristics:
!    sign-bit: can DELETE-LINE & INSERT-LINE
!    4000000:  can reverse/reduce/underline arbitrary character
!          4:  VC404
!          3:  VT100
!          2:  VT52
!          1:  Bantam
!    all zero: hard-copy
%constinteger cbound=50;        !command cell array bound
%constinteger tbound=120;       !quoted text array bound
%constinteger stopper=-10000;   !loop stop
%constinteger casebit=32
%integer cmax;                  !command cell max
%integer ci;                    !command index
%integer ti;                    !text index
%integer code;                  !command code
%integer ref;                   !text or bracket pointer
%integer scope;                 !search limit
%integer num;                   !repetition number
%integer sym,sym1,pend
%integer casemask;              !\0[\CASEBIT] to respect[ignore] case
%integer width;                 !line width (default 80)
%integer dir;                   !current direction of movement
%integer sin;                   !0[1] for main[secondary] input
%integer macpos;                !macro index values (3-byte nest)
!File pointers (byte addresses)
%integer lbeg;                  !line start position
%integer fp;                    !current file position
%integer lend;                  !line end position
%integer flim;                  !limit of current infile
%integer gaptop;                !start of gap
%integer gaplim;                !limit of gap
%integer mstart,msize;          !match start/size
%integer sfp,slim;              !saved FP & LIM for switching
%integer newtop,newlim;         !copies of NEW_TOP,NEW_LIM
! Video control variables
%integer line;                  !line number of current line
%integer winline;               !line number of top line on screen
%integer limline;               !limit line number (if known)
%integer breaks,joins;          !count of lines added/removed
%integer vrow,vcol;             !video cursor position
%owninteger zrow=0
%owninteger mon=1
%integer fprow
%owninteger printline=0,printed=0
%integer wintop,winbot;         !first/last window row
                                !the variable size window extends
                                !from floating WINTOP to fixed WINBOT
%integer winlim;                != WINBOT+1
%integer minwin;                !minimum window size
%integer changemin,changelbeg;  !alteration positions
%integer vp
%integer endon
!
{ ^ stands for ESC in below }
%conststring(11)%array  proms(0:7) =  ">",   {hardcopy}
                                     "^X  ^I >",   {Bantam}
                                     "^Y  ^x>",    {VT52}
                                     "^[rrH^[2K>",  {VT100}
                                     "see below",  {VC404}
                                     ""(*)
!%OWNSTRING(3)%ARRAY GPROM(0:3) = ":", "^A ", "^A", "^A";  !*VAX*
!%OWNSTRING(1)%ARRAY GPROM(0:3) = ":", " ", "", "";  !*EMAS*
%constSTRING(3)%ARRAY GPROMS(0:7) = ":", "^A ", "^A", "^M", " ", ""(*)

%byteintegerarray macstore(0:255)
%recordformat commandcell(%byteinteger code,ref, %c
                     %SHORTinteger scope, %integer count)
%record(commandcell) %array r(1:cbound)
%byteintegerarray text(1:tbound); !text strings
!
! V i d e o   c o n t r o l   r o u t i n e s


{Pre-computed video control strings}
%string(15)   prom,
             gprom
%string(7)    video invert,
              video restore

!! Generate digit strings for VT100 control sequences:  this should be
!  machine coded ??
%string(3)%fn  digits(%integer  N)
   %string(3)  S
   %integer    j
   S = ""
   %if N >= 100 %start
      S = "1";  N = N-100      {Can't be >= 1000}
   %finish
   %if N >= 10 %start
      j = N // 10
      S = S . to string(j+'0')
      N = N - (j*4 + j)*2
   %finish
   S = S . to string(N+'0')
   %result = S
%end
%routine  VT100 cmd 1(%integer  p1, cmd symbol)
   %string(15) S = tostring(ESC) . "["
   S = S . digits(p1) %if p1 # 0
   S = S . to string(cmd symbol)
   print string(S)
%end

%routine  VT100 cmd 2(%integer  p1, p2, cmd symbol)
   %string(15) S = to string(ESC)."["
   S = S . digits(p1) %if p1 # 0
   S = S . ";" . digits(p2) %if p2 # 0
   S = S . tostring(cmd symbol)
   print string(S)
%end

%routine  Clear Screen
   {Clear display screen on start up and termination}
   %if video = VT100 %start
      VT100 cmd 1(2,'J')    {clear}
      VT100 cmd 2(rows, 0, 'H')   {set cursor}
   %finish
%end


%routine at(%integer row,col)
! Set cursor to row ROW (0:ROWS-1) and column COL (0:COLS-1)
  %if video # 0 %start
{Note that the fiddle used on the older displays where ' ' counts as   }
{row/col 1 is not possible on VT100.  Must send row+1/col+1 explicitly }
    vrow = row;  vcol = col
    col = cols-1 %if col >= cols
   %if video = VT100 %start
      VT100 cmd2(row+1,col+1,'H')
      %return
    %else %if video = VT52;  !VT52
      print symbol (esc)
      print symbol('Y');  print symbol(' '+row)
    %finish %else %if video = VC404 %start; !VC404
      print symbol (dle);  print symbol (' '+row)
    %finish %else %start;  !Bantam
      print symbol (esc)
      print symbol('X');  print symbol(' '+row)
      print symbol(esc);  print symbol('Y')
    %finish
    print symbol(' '+col)
  %finish
%end
!
%routine clear line
! Clear rest of current row
  %if video # 0 %and vcol < cols %start
   %if video = VT100 %start
      VT100 cmd1(0,'K')
    %else %if video = VT52
      print symbol(ESC)
      print symbol ('x')
    %finish %else %if video = VC404 %start;  !VC404
      print symbol(ESC)
      print symbol (x'16')
    %finish %else %start;  !Bantam
      print symbol(ESC)
      print symbol ('I');  print symbol (0)
    %finish
  %finish
%end
!
%routine vnewline
  vrow = vrow+1;  vcol = 0
  newline
%end
!
%routine insert line(%integer row)
   %integer  from
  %if video < 0 %start
    at(row,0) %if vrow # row
    vcol = 0
   %if video = VT100 %start
      print symbol(ESC);  print symbol('7')   {save cursor position}
      VT100 cmd 2(row+1,0,'r')   {restrict scrolling area}
      print symbol(ESC);  print symbol('8')
      print symbol(ESC);  print symbol('M')   {force downward scroll}
      print string( tostring(ESC) . "[;r" )
      print symbol(ESC);  print symbol('8')      {restore cursor}
   %else
       print symbol(esc);  print symbol('L')
   %finish
  %finish
%end
!
%routine delete line(%integer row)
  %if video < 0 %start
    at(row,0) %if vrow # row
    vcol = 0
   %if video = VT100 %start
      print symbol(ESC);  print symbol('7')   {save cursor}
      VT100 cmd 2(row+1,0,'r')
      VT100 cmd 2(rows,0,'H')
      print symbol(ESC);  print symbol('D')
      print string( tostring(ESC) . "[;r" )
      print symbol(ESC);  print symbol('8')
   %else
       print symbol(esc);  print symbol('M')
   %finish
  %finish
%end
!
%constinteger clear=1, inc=2
%routine display line(%integer mode)
%integer k
  %if video<<1 > 0 %and vcol = 0 %start
    print symbol(' ');  vcol = 1
  %finish
  %cycle
    vp = gaplim %if vp = gaptop
    %if vp = flim %start
      %if endon = 0 %start
        print string(" **END**")
        limline = winline+vrow-wintop
      %finish
      endon = 1
      %exit
    %finish
    k = byteinteger(vp);  vp = vp+1
    %exit %if k = nl
    print symbol(k) %if vcol < cols
    vcol = vcol+1
  %repeat
  clear line %if mode&clear # 0
  vnewline %if mode&inc # 0
%end
!
%routine update
! If a change has been made to the file
!  update screen image, but only if current line is on screen
!  CHANGEMIN identifies the earliest point in the file affected
!  by alterations
%integer l,d,j,nop
  %return %if changemin = newlim;       !no change =>
  %return %if video = 0
  joins = joins-breaks;  l = line-winline+wintop-breaks
  %if l >= wintop %and l < winlim %start; !within window
    vp = changemin;  endon = 0
    changemin = changemin-1 %while changemin # newtop %c
            %and byteinteger(changemin-1) # nl
    %if video < 0 %then at(l,vp-changemin) %c
    %else at(l,vp-changemin+1)
    nop = 1
    %if changelbeg # lbeg %or vp # changemin %start
      nop = 0
      display line(clear+inc)
      l = l+1
    %finish
    -> done %if l = winlim
    %if joins < 0 %and video < 0 %start; !net expansion
      j = joins
      %cycle
        %if wintop > zrow %start
          delete line(zrow)
          wintop = wintop-1;  l = l-1
        %finish %else %start
          delete line(winbot)
        %finish
        j = j+1
      %repeat %until j = 0
      %cycle
        insert line(l)
        joins = joins+1
      %repeat %until joins = 0
    %finish
    %while vrow # winlim %c
      %and (newtop<=vp<gaptop %or (vp=gaptop %and nop=0)) %cycle
      display line(clear+inc)
      l = l+1
    %repeat
    %if joins # 0 %start
      d = winlim-l-joins
      %if d <= 0 %or video > 0 %start
        display line(clear+inc) %while vrow # winlim
      %finish %else %start
        j = joins
        %cycle
          delete line(vrow)
          j = j-1
        %repeat %until j = 0
        %cycle
          %cycle
            vp = gaplim %if vp = gaptop
            endon = 1 %and %exit %if vp = flim
            vp = vp+1
          %repeat %until byteinteger(vp-1) = nl
          d = d-1
        %repeat %until d = 0
        at(winlim-joins,0)
        %cycle
          insert line(vrow)
          display line(clear+inc)
        %repeat %until vrow = winlim
      %finish
    %finish
  %finish
done:
  changemin = newlim;  joins = 0;  breaks = 0
%end
!
%routine display
! Update screen & ensure that current line is on screen
%integer pre,k
!
%routine scanback
  %while pre > 0 %cycle
    vp = gaptop %if vp = gaplim
    %exit %if vp = newtop
    %cycle
      vp = vp-1
      vp = gaptop %if vp = gaplim
    %repeat %until vp = newtop %or byteinteger(vp-1) = nl
    pre = pre-1
  %repeat
%end
!
  update
  vp = lbeg;  endon = 0
  vp = vp-gaplim+gaptop %if vp < gaplim <= fp
  %if video = 0 %start
    vcol = 0;  printline = line;  printed = gaptop+fp
    %if vp # fp %and num = 1 %start
      %cycle
        print symbol(byteinteger(vp))
        vp = vp+1
        vp = gaplim %if vp = gaptop
      %repeat %until vp = fp
      print symbol('^')
    %finish
    display line(inc)
    %return
  %finish
  pre = line-winline
  %if pre < 0 %start;                   !before start of window
    %if pre > -minwin %and (video<0 %or wintop+pre>=zrow) %start
                                        !worth prefixing
      wintop = wintop+pre;              !decrease wintop (PRE neg)
      %while wintop < zrow %cycle
        delete line(winbot)
        insert line(zrow)
        wintop = wintop+1
      %repeat
      %if wintop > zrow %start
        at(wintop-1,0)
        print symbol('=');  clear line
      %finish
      at(wintop,0)
      %cycle
        display line(clear)
        pre = pre+1
        %exit %if pre >= 0
        vnewline
      %repeat
      winline = line
      %return
    %finish
  %finish %else %start
    pre = pre+wintop-winlim
    %return %if pre < 0;                !within window =>
    %if pre < minwin %start;            !worth appending
      k = pre
      scanback
      at(winlim,0) %if video > 0
      %cycle
        delete line(zrow)
        %if wintop > zrow %then wintop = wintop-1 %c
        %else winline = winline+1
        insert line(winbot)
        display line(clear+inc)
        k = k-1
      %repeat %until k < 0
!     NEWLINE %IF VIDEO > 0;  !*VAX*
      NEWLINE %AND NEWLINE %AND NEWLINE %IF VIDEO > 0;  !*emas*
      %return
    %finish
  %finish
  pre = minwin-1
  pre = pre//2 %if fp # flim
  winline = line-pre
  scanback
  winline = winline+pre
  wintop = winlim-minwin
  %if wintop > zrow %start
    at(wintop-1,0)
    print symbol('=');  clear line
    vnewline
  %finish %else %start
    at(zrow,0)
  %finish
  %cycle
    display line(clear)
    %exit %if vrow >= winbot
    vnewline
  %repeat
%end
!
! F i l e   m o d i f y i n g   r o u t i n e s
!
%routine split
! Create gap in file if gap is not at FP
%integer j,diff,unit
  %if newtop <= fp < gaptop %start;     !FP in upper half
    %if flim # newlim %start;           !lower half still in old
      j = flim-gaplim;                  !  so must now copy across
      ->abdn %if newlim-j < gaptop
      move(j,gaplim,newlim-j)
      gaplim = newlim-j
      flim = newlim
    %finish
    j = gaptop-fp;                      !amount to shift down
    diff = gaplim-gaptop
    %cycle;                             !shift in units <= gapsize
      unit = j;  unit = diff %if diff < unit
      gaptop = gaptop-unit;  gaplim = gaplim-unit
      move(unit,gaptop,gaplim)
      j = j-unit
    %repeat %until j = 0
    mstart = gaplim %if mstart = fp
    lbeg = lbeg+diff;  lend = lend+diff
    fp = gaplim
  %finish %else %start;                 !FP in lower half (old or new)
    j = fp-gaplim
    %if j > 0 %start
      ->abdn %if gaptop+j >= newlim
      move(j,gaplim,gaptop)
    %finish
    gaptop = gaptop+j;  gaplim = fp
  %finish
  %if gaptop < changemin %start
    changemin = gaptop;  changelbeg = lbeg
  %finish
  j = gaplim;  j = newlim %if flim # newlim
  %return %if gaptop+256 < j
abdn:
  print string(" ** File too big ")
  %stop
%end
!
%routine consolidate
! Ensure that the gap lies on a line boundary
!  by copying up the remainder of a split line
%integer diff
  %if gaptop # newtop %and byteinteger(gaptop-1) # nl %start
    %cycle
      byteinteger(gaptop) = byteinteger(gaplim)
      %if gaplim = fp %start
        diff = gaplim-gaptop
        lbeg = lbeg-diff;  fp = fp-diff
        lend = lend-diff;  mstart = fp %if mstart = gaplim
      %finish
      gaptop = gaptop+1;  gaplim = gaplim+1
    %repeat %until byteinteger(gaptop-1) = nl
  %finish
%end
!
%routine join
! Erase from FP to end of line AND the line terminator
!  (covers Kill, Join, Uncover)
!  NB LEND not revised
  split
  lbeg = lbeg+(lend-fp+1);  fp = lend+1
  changelbeg = lbeg
  gaplim = fp
  %if line >= winline %then joins = joins+1 %c
  %else winline = winline-1
  limline = limline-1
%end
!
%routine switch
! Switch between main and secondary input
!  Create false bottom if switching from main and lower half is in NEW
%integer i
  split
  newlim = gaplim %if flim = newlim;    !create false bottom
  i = sfp;  sfp = fp;  fp = i
  i = slim;  slim = flim;  flim = i
  sin = sin!!1
  lbeg = lbeg-sfp+fp;  gaplim = fp
  newlim = flim %if newlim = gaplim;    !remove false bottom
  lend = fp
  lend = lend+1 %while lend # flim %and byteinteger(lend) # nl
  joins = 999
  limline = 99999
%end
!
! C o m m a n d   i n p u t   routines
!
%integer type,chain,hold,echo
!
%routine print code(%integer k)
! Print command letter (mapping 'minus' values)
  print symbol(k-casebit) %and k='-' %if k >= 'a'
  print symbol(k)
%end
!
%routine read sym
! Read next command symbol to SYM (maybe from macro def)
  %on %event 9 %start
  %finish
  %if pend # 0 %start
    sym = pend;  pend = 0
  %finish %else %start
    %while macpos # 0 %cycle;           !expanding macro
      sym = macstore(macpos&255)
      macpos = macpos+1
      %return %unless sym = nl;         !(NL is definition terminator)
      macpos = macpos>>8
    %repeat
    read symbol(sym)
    print symbol(sym) %if echo # 0 %and sym >= ' '
  %finish
%end
!
%routine ignore
  echo = 0
  read sym %while sym # nl
%end
!
!Symbol types:-
!   0:numeric  1:terminator 2:illegal  3:quote
!   4:DU       5:IS         6:E        7:KJBGC@$
!   8:F        9:TV        10:M       11:LR
!  12:( [     13:,         14:) ]     15:? \
!High order bits relevant following percent
%constbyteintegerarray symtype(32:95) = %c
   16_03,16_03,16_03,16_03,16_07,16_02,16_03,16_03,
   16_0C,16_0E,16_00,16_03,16_0D,16_02,16_03,16_03,
   16_00,16_00,16_00,16_00,16_00,16_00,16_00,16_00,
   16_00,16_00,16_03,16_01,16_02,16_02,16_02,16_0F,
   16_07,16_07,16_07,16_17,16_54,16_06,16_08,16_07,
   16_02,16_05,16_07,16_07,16_6B,16_4A,16_02,16_02,
   16_0B,16_02,16_0B,16_25,16_09,16_34,16_49,16_70,
   16_70,16_70,16_70,16_0C,16_0F,16_0E,16_03,16_03
!     sp     !     "     #     $     %     &     '
!      (     )     *     +     ,     -     .     /
!      0     1     2     3     4     5     6     7
!      8     9     :     ;     <     =     >     ?
!      @     A     B     C     D     E     F     G
!      H     I     J     K     L     M     N     O
!      P     Q     R     S     T     U     V     W
!      X     Y     Z     [     \     ]     ^     _
!
%routine read item
! Read symbol to SYM and codify in TYPE
! intercept macro letters ('W', 'X', 'Y', 'Z')
! assemble numeric items in NUM
  %cycle
    type = 1;                           !for terminator
    read sym %until sym # ' ';          !ignore spaces
    %return %if sym < ' ';              !terminator (any control) =>
    sym = sym&95 %if sym >= 96;         !ensure upper case (and more)
    type = symtype(sym)&15
    %return %if type # 0;               !not numeric or macro =>
    %exit %if sym < 'W'
    %if macpos>>24 # 0 %then macpos = 0 %c
    %else macpos = (macpos<<2+(sym-'W'))<<6+1; !push down any existing calls
  %repeat
  num = 0
  %return %if sym = '*'
  %cycle
    num = num*10+sym-'0'
    read sym
  %repeat %until %not '0' <= sym <= '9'
  pend = sym
%end
!
%routine minus
! Test for minus: map CODE if so
  %if sym = '-' %start
    code = code+casebit;                !lower-case
    read item
  %finish
%end
!
%routine unchain
! Insert forward references in left bracket and comma cells
  %cycle
    ref = chain
    %return %if ref = 0
    chain = r(ref)_ref
    r(ref)_ref = ci
  %repeat %until r(ref)_code = '['
%end
!
!
%switch c(4:15), pc(0:7), s('$':'p')
%integer i,j,p,fp1
!
! I n i t i a l i s a t i o n
!
  mstart = 0;  cmax = 0
  r(cbound-1) = 0;                      !'immediate-action' cell
  r(cbound-1)_count = 1
  r(cbound) = 0;                        !'i-a' terminating cell
  r(cbound)_code = ']'
  r(cbound)_count = stopper+1
  macpos = 0
  macstore(1) = nl;  macstore(65) = nl
  macstore(129) = nl;  macstore(192) = nl
  casemask = \casebit;                  !ignore case distinctions (default)
  width = 80;  dir = 0
  newtop = new_top;  gaptop = newtop
  newlim = new_lim
  fp = old_top
  gaplim = fp;  lbeg = fp;  lend = fp
  flim = old_lim
  lend = lend+1 %while lend # flim %and byteinteger(lend) # nl
  sin = 0;  sfp = sec_top;  slim = sec_lim
  changemin = newlim;  changelbeg = 0
  joins = 0;  breaks = 0
  line = 1;  winline = 0;  limline = 999999
  WINLIM = ROWS-4;  !*EMAS*
!  WINLIM = ROWS-2;  !*VAX*
  winbot = winlim-1;  wintop = winbot
  MINWIN = 20{ 3?} %AND WINLINE = -99
  vrow = 99
  newlines(rows-winlim-1) %if video # 0

!!!  %for i = 0,1,3 %cycle
!!!    %for j = 1,1,length(prom(i)) %cycle
!!!      charno(prom(i),j) = esc %if charno(prom(i),j) = '^'
!!!    %repeat
!!!    charno(prom(i),3) = ' '+winlim %if i > 0
!!!    CHARNO(GPROM(I),1) = ESC %IF I > 0;  !*VAX*
!!!  %repeat
!!!  charno(prom(1),4) = rt;  charno(prom(1),7) = rt

%begin         {***** Initialise PROMPT strings *****}
   %string(15)  S
   p = video & 7
   prom = proms(p)
   gprom = gproms(p);  charno(gprom,1) = ESC %if charno(gprom,1) = '^'
   %for j = 1,1,length(prom) %cycle
      charno(prom,j) = ESC %if charno(prom,j) = '^'
   %repeat
   %if video = VT52 %or video = BANTAM %start
      charno(prom,3) = ' '+winlim
      video invert = to string(ESC)."4"      {reduced intensity}
      video restore = to string(ESC)."3"     {normal}
      %if video = BANTAM %start
         charno(prom,4) = rt;  charno(prom,7) = rt
      %finish
   %else %if video = VT100
      S = digits(winlim+2)  {*** This must be TWO digits ***}
      charno(prom,3) = charno(S,1)
      charno(prom,4) = charno(S,2)
      video invert = tostring(ESC)."[1;7m"   {inverse video}
      video restore = tostring(ESC)."[m"   {normal}
   %else %if video = VC404
      prom = to string(DLE) . "4" . to string(' '+winlim)  %c
                                  . to string(x'16') . ">"
   %finish
%end      {PROMPT initialisation}

   clear screen

  sym = nl
!
! R e a d   n e w   c o m m a n d   l i n e
!
read:
  %if sin = 0 %then prompt(prom) %c
  %else prompt(prom.">")
  pend = 0;  sym1 = sym
  %if sym = nl %start
    %if video = 0 %start
      num = 1
      display %if (mon=0 %and printline#line) %c
          %or (mon>0 %and printed#gaptop+fp)
    %finish %else %start
      display
     ! Show position of pointer
      fprow = line-winline+wintop
      at(fprow,fp-lbeg)
      %if video > 0 %start
        %IF video = BANTAM  %THEN PRINT SYMBOL(ESC) %AND PRINT SYMBOL(127) %C
        %ELSE PRINT SYMBOL('^');      !ESC+127 IS BANTAM SPLODGE
        sym1 = ' '
        %if fp # lbeg %start
          %if fp # gaplim %then sym1 = byteinteger(fp-1) %c
          %else sym1 = byteinteger(gaptop-1)
        %finish
      %finish %else %start
        print string(video invert)      {change display mode for one char}
        sym1 = ' ';  sym = '|'
        %if fp # lend %and byteinteger(fp) # ' ' %start
         sym1 = byteinteger(fp);  sym = sym1
        %finish
        print symbol(sym)
        print string(video restore)
      %finish
      NEWLINE;                            !*VAX* to flush
    %finish
  %finish %else %start
    read sym
    pend = sym %if sym # nl;            !NL not significant
  %finish
! Deal with special cases
  ci = 0;  ti = 0;  chain = 0
  echo = 0
  %cycle
    read item
    %exit %if sym # '-'
    dir = dir!!casebit;                 !toggle direction
  %repeat
  %if type = 1 %start;                  !plain RETURN
    r(cbound-1)_code = 'M'+dir;         !M/M-
    ci = cbound-2
    -> restore
  %finish
  %if type = 0 %and cmax # 0 %start;    !repetition
    r(cmax)_count = num
    read item;  -> er1 %if type # 1
    -> restore
  %finish
  %if sym = '%' %start
    read sym;  -> erq %if sym < 'A'
    code = sym&95;                      !upper-case
    read sym
    -> pc(symtype(code)>>4&7)
  %finish
  dir = 0
  %if video > 0 %start
    clear line;  print symbol('=')
    print symbol(sym)
    echo = 1
  %finish
! C o m m a n d   i n p u t:  m a i n   l o o p
more:                                   !(command code has been read)
  hold = type;  -> er2 %if hold < 4
  -> er0 %if hold < 8 %and newtop = 0;  !no changes when Showing
  ci = ci+1;  -> er6 %if ci >= cbound-3
  code = sym;                           !command letter
  ref = 0;  num = 1;  scope = 1;        !default values
  read item
  -> c(hold)
c(8):                                   !Find
  minus
  scope = 0
c(4):                                   !+ Delete, Uncover
c(9):                                   !+ Traverse, Verify
  %if type = 0 %start;                  !followed by number
    scope = num
    read item
  %finish
  num = 0;                              !as indicator (not I,S)
c(5):                                   !+ Insert, Substitute
  hold = sym;  -> er4 %if type # 3;     !not valid quote mark ->
  ti = ti+1;  ref = ti;                 !REF indexes first quoted symbol
  %cycle
    read sym
    %if sym = nl %start;                !closing quote omitted
      -> er4 %if num = 0;               !allowed only for I,S
      pend = sym;  sym = hold
    %finish
    %exit %if sym = hold
    -> er6 %if ti > tbound-2
    sym = sym&casemask %if 'a' <= sym <= 'z' %and num = 0
    text(ti) = sym;  ti = ti+1
  %repeat
  -> er4 %if ti = ref %and num = 0;     !null allowed only for I,S
  text(ti) = 0;                         !end-marker
  num = 1;                              !restore default
  read item
  -> nput
c(6):                                   !Erase
c(10):                                  !+ Move, Print
  minus
c(7):                                   !+ Get, Kill, etc
c(11):                                  !+ Left, Right, etc
  -> er1 %if type = 3;                  !(redundant, but better report)
  -> nput
c(12):                                  !open bracket
  code = '['
  -> comma
c(13):                                  !comma
  code = '^'
! read item %if type = 1;               !permit line break (better not?)
comma:
  ref = chain;  chain = ci
  -> put
c(14):                                  !close bracket
  unchain;  -> er3 %if ref = 0
  code = ']';  r(ref)_count = num
nput:
  read item %if type = 0;               !get next item if number
c(15):                                  !invert, query
put:
  r(ci)_code = code;  r(ci)_ref = ref
  r(ci)_scope = scope;  r(ci)_count = num
  -> more %unless type = 1
  ci = ci+1;  cmax = ci
  unchain;  -> er3 %if ref # 0
  r(ci)_code = ']'; r(ci)_ref = 0
  r(ci)_count = 1
  ci = 0
  insert line(winlim);                  !preserve command line
restore:
  %if sym1 # nl %start
    at(fprow,fp-lbeg)
    print symbol(sym1)
  %finish
  -> next
!
er0:print symbol(' ');  print code(sym)
    print string(" when Showing")
    -> erq
er1:print symbol(' ');  print symbol(code)
er2:code = sym
    -> er5
er3:printstring(" Brackets")
    -> erq
er4:printstring(" Text for")
pc(0):
er5:print symbol(' ');  print code(code)
    -> erq
er6:printstring(" Size")
erq:print symbol('?')
    %if video # 0 %then clear line %else newline
    cmax = 0 %if ci > 1
    ignore
    -> read
!
! Percent commands
pc(1):                                  !%C: close
  switch %if sin # 0
  new_flag = 1 %if changelbeg # 0
  new_lim = gaptop
  old_top = gaplim;  old_lim = flim
  clear screen
  %return
pc(2):                                  !%S: secondary input
  switch %if sin # 0
  %if sym = '=' %start
    i = 0
    %cycle
      read sym
      %exit %if sym = ';' %or sym = nl
      -> er6 %if i = maxname
      i = i+1;  charno(sec_name,i) = sym
    %repeat
    length(sec_name) = i
    connect input(sec)
  %finish
  sfp = sec_top;  slim = sec_lim
  -> erq %if sec_top = sec_lim
  switch
  -> read
pc(3):                                  !%U: ignore/respect case
  casemask = \casebit
  casemask = \0 %and read sym %if sym = '-'
  -> read
pc(4):                                  !%M (%V)
  %if code = 'M' %start
    mon = 0
    mon = 1 %and read sym %if sym = '+'
    mon = -1 %and read sym %if sym = '-'
  %finish %else %start
    read item
    -> erq %if type # 0
    video = (num&x'C')<<28+num&7
    winline = -99
  %finish
  -> read
pc(5):                                  !%D: define window size
  %if sym = '=' %start
    read item
    -> erq %if type # 0
    -> er6 %unless num <= winlim
    minwin = num
    video = 0 %if num <= 0
  %finish
  winline = -99
  -> read
pc(6):                                  !%L: define line width
  -> erq %if sym # '='
  read item
  -> erq %if type # 0
  -> er6 %unless 5 <= num <= 256
  width = num
  -> read
pc(7):                                  !%W, %X, %Y, %Z
  i = (code-'W')<<6+1;                  !64-byte increments
  %if sym = '=' %start;                 !definition
    %cycle
      read sym
      macstore(i) = sym
      %exit %if sym = nl
      i = i+1 %if i # 255
    %repeat
  %finish %else %start;                 !enquiry
    -> er1 %if sym # nl
    print symbol(code);  print symbol('=')
    %cycle
      sym = macstore(i)
      %exit %if sym = nl
      print symbol(sym)
      i = i+1
    %repeat
    %if video # 0 %then clear line %else newline
  %finish
  -> read
!
! C o m m a n d   e x e c u t i o n
!
%integerfn matched
%integer i,j,k
  i = fp-1; j = ref-1
  %cycle
    i = i+1;  j = j+1
    k = byteinteger(i)
    k = k&casemask %if 'a' <= k <= 'z'
  %repeat %until k # text(j)
  %result = 0 %if text(j) # 0
  mstart = fp;  msize = i-fp
  %result = 1
%end
!
! Extract next command
!
next: s('?'):
  ci = ci+1
  code = r(ci)_code;  ref = r(ci)_ref
  num = r(ci)_count
  -> s(code)
!
! Successful return after Move etc
!   FP has been advanced into next line, new LEND to be determined
lok:
  lend = fp
  %if lend # flim %start
    lend = lend+1 %while byteinteger(lend) # nl
  %finish
! Successful return from execution
ok:
  num = num-1
  -> next %if num = 0
  -> s(code)
fail:
  num = 1
! Failure return
no: s('\'):
  %cycle
    -> next %if num <= 0;               !indefinite repetition ->
    ci = ci+1;                          !check following cell:-
    -> next %if r(ci)_code = '\';       !invert  ->
    -> next %if r(ci)_code = '?';       !query  ->
    %while r(ci)_code # ']' %cycle
      -> next %if r(ci)_code = '^';     !comma ->
      ci = r(ci)_ref %if r(ci)_code = '['
      ci = ci+1
    %repeat
    num = r(ci)_count
  %repeat %until ci >= cmax
  -> read %if num <= 0
!
!E x e c u t i o n   e r r o r
!
  at(winlim+1,40)
  printstring(" Failure: ")
  print code(code)
  %if ref # 0 %start
    print symbol('''')
    %while text(ref) # 0 %cycle
      print symbol(text(ref))
      ref = ref+1
    %repeat
    print symbol('''')
  %finish
  %if video # 0 %then clear line %else newline
  ignore
  -> read

!
!I n d i v i d u a l   c o m m a n d s
!
s('['):                                 !open bracket
  r(ref)_count = num;                   !restore count on ']'
  -> next
!
s(']'):                                 !close bracket
  num = num-1
  %if num # 0 %and num # stopper %start
    r(ci)_count = num;                  !update
    ci = ref;                           !position of '['
  %finish %else %start
    -> read %if ci >= cmax
  %finish
  -> next
!
s('^'):                                 !comma
  ci = ref-1;                           !position of ']' - 1
  -> next
!
s('P'):
  display
  -> ok %if num = 1
s('M'):                                 !Move
  -> no %if fp = flim
  update
  fp = lend+1
  fp = gaplim %if fp = gaptop
  line = line+1
  fp = flim %and line = limline %if num = 0 %and code = 'M'
  lbeg = fp
  -> lok
!
s('m'):                                 !Move back
  -> no %if lbeg = newtop %or sin # 0
  update
  consolidate
  mstart = 0
  %if num = 0 %start;                   !M-*
    lbeg = newtop
    lbeg = gaplim %if lbeg = gaptop
    fp = lbeg
    line = 1;  num = 1
    -> lok
  %finish
  %if lbeg = gaplim %start
    -> no %if gaptop = newtop
    lbeg = gaptop
  %finish
  line = line-1;                    !there is a line there
  lend = lbeg-1
  lbeg = lbeg-1 %until lbeg=gaplim %or lbeg=newtop %or byteinteger(lbeg-1)=nl
  fp = lbeg
  -> ok
!
s('C'):                                 !Case-change with right-shift
  -> no %if fp = lend
  %if 'A' <= byteinteger(fp)&95 <= 'Z' %start
    split
    byteinteger(gaptop) = byteinteger(fp)!!casebit
    gaptop = gaptop+1;  gaplim = gaplim+1
  %finish
!
s('R'):                                 !Right-shift
  -> no %if fp = lend
  fp = fp+1
  -> ok
!
s('L'):                                 !Left-shift
  -> no %if fp = lbeg %or sin # 0
  consolidate %if fp = gaplim
  mstart = 0
  fp = fp-1
  -> ok
!
s('E'):                                 !Erase
  -> no %if fp = lend
  split
  lbeg = lbeg+1;  fp = fp+1
  gaplim = fp
  -> ok
!
s('e'):                                 !Erase back
  -> no %if fp = lbeg
  split
  lbeg = lbeg+1;  gaptop = gaptop-1
  changemin = gaptop %if gaptop < changemin
  -> ok
!
s('V'):                                 !Verify
  -> no %if fp = lend
  -> no %if (byteinteger(fp)!!text(ref))&casemask # 0; !quick check
  -> no %if matched = 0
  -> next
!
s('D'):                                 !Delete
s('T'):                                 !+ Traverse
  fp1 = fp
  -> find
!
s('F'):                                 !Find
s('U'):                                 !+ Uncover
  fp1 = fp
  fp = fp+1 %if fp = mstart
find:
  scope = r(ci)_scope;                  !number of lines to search
  sym1 = text(ref);                     !first symbol of quoted text
  %while fp # flim %cycle
    %while byteinteger(fp) # nl %cycle
      %if (byteinteger(fp)!!sym1)&casemask = 0 %start
        -> found %if matched # 0
      %finish
      fp = fp+1
    %repeat
    lend = fp
    scope = scope-1
    %exit %if scope = 0
    %if code # 'U' %start
      update
      fp = fp+1
      fp = gaplim %if fp = gaptop
      lbeg = fp
      line = line+1
    %finish %else %start
      fp = fp1;  join
    %finish
    fp1 = fp
  %repeat
  lend = fp;  fp = fp1
  -> no
found:
  %if code = 'D' %start
    split
    lbeg = lbeg+msize;  fp = fp+msize
    gaplim = fp
  %finish
  fp = fp+msize %if code = 'T'
  %if code = 'U' %start
    i = fp-fp1;  fp = fp1
    split
    lbeg = lbeg+i;  fp = fp+i
    gaplim = fp
  %finish
  -> lok
!
s('f'):                                 !Find back
  scope = r(ci)_scope
  update
  consolidate
  %cycle
    %while fp # lbeg %cycle
      fp = fp-1
      -> ok %if matched # 0
    %repeat
    scope = scope-1
    -> no %if scope = 0 %or fp = newtop
    %if fp = gaplim %start
      -> no %if gaptop = newtop
      fp = gaptop
    %finish
    lbeg = fp
    fp = fp-1;  lend = fp
    line = line-1
    lbeg = lbeg-1 %until lbeg=gaplim %or lbeg=newtop %or byteinteger(lbeg-1)=nl
  %repeat
!
s('S'):                                 !Substitute
  -> no %if fp # mstart
  split
  lbeg = lbeg+msize;  fp = fp+msize
  gaplim = fp
!
s('I'):                                 !+Insert
  -> ok %if text(ref) = 0
  -> no %if fp-lbeg > width %or fp = flim
  split
  j = ref
  %cycle
    byteinteger(gaptop) = text(j)
    gaptop = gaptop+1;  j = j+1
  %repeat %until text(j) = 0
  lbeg = lbeg-(j-ref)
  -> ok
!
s('G'):                                 !Get (line from terminal)
  -> no %if sin # 0 %and fp # lbeg
  consolidate
  fp = lbeg
  split
  %if video # 0 %start
    %if video < 0 %start
      display
      fprow = line-winline+wintop
      delete line(winlim)
      insert line(fprow)
    %finish %else %start
      byteinteger(gaptop) = nl;  gaptop = gaptop+1
      breaks = breaks+1
      line = line+1;  limline = limline+1
      update
      fp = gaptop-1;  lbeg = fp
      line = line-1
      display
      fprow = line-winline+wintop
      gaptop = gaptop-1
      fp = gaplim;  lbeg = fp
      limline = limline-1
      at(fprow,0)
    %finish
    NEWLINE;                              !*VAX*
  %finish
  prompt(gprom)
  read sym
  vrow = 999
  %if sym = ':' %start
    read sym %until sym = nl
    %if video # 0 %start
      %if video < 0 %start
        delete line(fprow)
        insert line(winlim)
      %finish %else %start
        changemin = gaptop;  changelbeg = lbeg
        joins = joins+1
      %finish
    %finish
    -> no
  %finish
  line = line+1;  limline = limline+1
  %cycle
    byteinteger(gaptop) = sym;  gaptop = gaptop+1
    %exit %if sym = nl
    read sym
  %repeat
  %if video < 0 %and fprow = winbot %start; !bring back
    delete line(zrow)
    %if wintop > zrow %then wintop = wintop-1 %c
    %else winline = winline+1
    insert line(winlim)
  %finish
  -> ok
!
s('B'):                                 !Break
  num = 66 %if num = 0 %or num > 66
  split
break:
  byteinteger(gaptop) = nl;  gaptop = gaptop+1
  breaks = breaks+1
  line = line+1;  limline = limline+1
  lbeg = fp
  -> ok
!
s('K'):                                 !Kill
  -> no %if fp = flim
  fp = lbeg
  join
  -> lok
!
s('J'):                                 !Join
  fp = lend
  -> no %if fp = flim %or fp-lbeg > width
  join
  -> lok
!
s('A'):                                 !Adjust
  -> s('M') %if lend = lbeg
  consolidate
  %while lend-lbeg <= width %cycle
    fp = lend+1
    %if fp = gaptop %start
      fp = gaplim;  lbeg = lbeg+(gaplim-gaptop)
    %finish
    lend = fp
    lend = lend+1 %while lend # flim %and byteinteger(lend) # nl
    %if fp = lend %or byteinteger(fp) = ' ' %start
      update
      lbeg = fp;  line = line+1
      ->no
    %finish
    split
    byteinteger(gaptop-1) = ' '
    changemin = gaptop-1 %if changemin >= gaptop
    joins = joins+1;  limline = limline-1
  %repeat
  consolidate
  fp = lbeg+width+1
  %cycle
    fp = fp-1
    -> no %if fp = lbeg
  %repeat %until byteinteger(fp) = ' '
  split
  fp = fp+1
  gaplim = fp
  -> break
!
!
s('@'):                                 !'at' Column NUM
  -> fail %if lend = flim
  i = width-(lend-fp)
  num = i %if i < num
  i = fp-lbeg-num
  -> next %if i = 0
  split
  %cycle
    %if i < 0 %start;                   !left of it
      byteinteger(gaptop) = ' ';  gaptop = gaptop+1
      lbeg = lbeg-1;  i = i+1
    %finish %else %start
      -> fail %if fp = lbeg %or byteinteger(gaptop-1) # ' '
      gaptop = gaptop-1;  lbeg = lbeg+1
      changemin = gaptop %if gaptop < changemin
      i = i-1
    %finish
  %repeat %until i = 0
  -> next
s('$'):                                 !switch inputs
  switch
  -> next
%end;                                   !END OF EDI

!*MOUSES* System-specific stuff
%include "sysinc:command.inc"      {to access user command line}

  %RECORD %FORMAT PARM FM (%SHORT DSNO,DACT,SSNO,SACT,
                           %INTEGER P1,P2,P3,P4,P5,P6)
  %RECORD(PARM FM) P
  %CONST %INTEGER TT NO WIDTH = X'80';  !INHIBIT LINE BREAK PATTERN
  %CONST %INTEGER TT NO PAGE = X'40';   !INHIBIT PAGE WAIT PATTERN
  %CONST %INTEGER TT ERASE = X'20';     !VIDEO DELETE ENABLED?
  %CONST %INTEGER TT TABS = X'40000';   !TAB STOPS OR 3-SPACES?
  %INTEGER OLD TT;                      !HOLD CONSOLE STATE BITS DURING EDIT
  %CONST %INTEGER CACHE SIZE = 12;       !BLOCKS
  %CONST %INTEGER PAGING FILE = 1;      !DA CHANNEL
  %OWN %STRING(31) PAGE FILE NAME
  %STRING(3) %FN UNIQUE EXTENSION
    %RECORD(PARMFM) P
    %STRING(31)%NAME SN
    P_DACT = 25;  SVC (20,P);   !PACKED UNIQUE FILENAME
    P_P4 = P_P4&X'FFFF';        !LEAVE EXTENSION
    SVC (18,P);                 !UNPACK
    SN == STRING(ADDR(P_SACT)); ! => STRING RESULT
    %RESULT = SUBSTRING(SN,2,LENGTH(SN));  !KILL "."
  %END
  PAGE FILE NAME = "$ECCE.".UNIQUE EXTENSION
  %OWN %INTEGER MAX BLOCK  = 400;       !DEFAULT SIZE OF DA FILE

  %RECORD %FORMAT BLOCKFM(%BYTE %ARRAY B(0:511))
  %EXTERNAL %PREDICATE %SPEC   EXISTS (%STRING(31) FILENAME)
  %EXTERNAL %ROUTINE %SPEC OPEN DA (%INTEGER CHAN,PROT,%STRING(31) FILENAME)
  %EXTERNAL %ROUTINE %SPEC RENAME FILE (%STRING(31) OLDNAME, NEWNAME)
  %EXTERNAL %ROUTINE %SPEC CREATE FILE (%STRING(31) FILENAME, %INTEGER BLOCKS,
                                        %INTEGERNAME ACTUAL); !RETURN ALLOC
  %EXTERNAL %ROUTINE %SPEC DELETE FILE (%STRING(31) FILENAME)
  %EXTERNAL %ROUTINE %SPEC READ  DA(%INTEGER CHAN,BLOCK, %NAME BUFFER)
  %EXTERNAL %ROUTINE %SPEC WRITE DA(%INTEGER CHAN,BLOCK, %NAME BUFFER)
  %EXTERNAL %ROUTINE %SPEC EXTENDDA(%INTEGER CHAN,BLOCKS,%INTEGERNAME NEW SIZE)
  %EXTERNAL %ROUTINE %SPEC CLOSE DA(%INTEGER CHAN)


  %RECORD %FORMAT BUF FM (%INTEGER BLOCK,
                          %RECORD(BUF FM)%NAME LINK,
                          %RECORD(BLOCK FM) BLK)

  %RECORD(BUF FM) %ARRAY BUFFER(1:CACHE SIZE)
  %RECORD(BUF FM) %NAME  BUF

  %ROUTINE FLUSH BUFFERS
    %RECORD(BUFFM)%NAME B
    %INTEGER J
    %FOR J = 1,1,CACHE SIZE %CYCLE
      B == BUFFER(J)
      %IF B_BLOCK >= 0 %START;   !VALID?
        WRITE DA (PAGING FILE,B_BLOCK,B_BLK)
        B_BLOCK = -1;   !INVALIDATE
      %FINISH
    %REPEAT
  %END

  !INITIALISATION

  DELETE FILE(PAGE FILE NAME) %IF EXISTS(PAGE FILE NAME)
  CREATE FILE(PAGE FILE NAME,MAX BLOCK,MAX BLOCK)
  OPEN DA (PAGING FILE,1,PAGE FILE NAME)
  SELECT INPUT (0);  SELECT OUTPUT (0)

  %INTEGER WHICH
  %FOR WHICH = 1,1,CACHE SIZE %CYCLE;   !INITIALISE CACHE LIST
    BUF == BUFFER(WHICH)
    BUF_BLOCK = -1;                     !MARK AS NOT IN USE
    %IF WHICH # 1 %THEN BUF_LINK == BUFFER(WHICH-1) %C
    %ELSE BUF_LINK == BUFFER(CACHE SIZE); !SET UP CIRCULAR LIST
  %REPEAT

  %OWN %INTEGER FREE = 1;               !FIRST USABLE PSEUDO-ADDRESS

  %INTEGERFN TERMTYPE      { *** configuration dependent ***}
    %CONST %INTEGER CONSOLES = 15
    %CONST %INTEGER %ARRAY TT TYPE(0:CONSOLES) =
      HARDCOPY(9),; !0..8
      VC404,;       !9  (In machine room)
      VC404,;       !10 (John's VC404)
      VT100 {PE550},;       !11 (Chris's Bantam)
      HARDCOPY(*)
    %RECORD(PARM FM) P
    %INTEGER TT
    P_P1 = 0;                           !ME
    SVC (14,P);                         !GET PROCESS INFO
    TT = TT TYPE(P_P6)
!!    P_P2 = 0;                           !MY TTY
!!    P_P1 = 10
!!    P_P3 = TT NO PAGE + TT ERASE + TT NO WIDTH + TT TABS
!!    SVC (29,P)
!!    OLD TT = P_P4;                      !REMEMBER WHAT IT WAS BEFORE
    %RESULT = TT
  %END

  %BYTEINTEGERMAP BYTEINTEGER(%INTEGER PSADDR);  !PSEUDO ADDRESS
    ! Map pseudo address into a <block,byte> pair.  (Block
    ! may be in a DA file or in an LRU cache list).
    PSADDR = PSADDR-1;               !SO THAT FIRST BYTE IN FILE IS USED
    %INTEGER BLOCK = PSADDR>>9, OFFSET = PSADDR&511
    %RECORD(BUFFM)%NAME PREV,P
    P == BUF_LINK;                      !HEAD OF CACHE LIST
    %CYCLE
      %IF P_BLOCK = BLOCK %START;       !REQUIRED BYTE MAPPED IN THIS BLOCK?
        !YES: PROMOTE THIS BUFFER TO HEAD OF THE LIST
        %IF P == BUF %START;            !TAIL BECOMES HEAD (CIRCULAR LIST)
          BUF == PREV
        %ELSE %IF P ## BUF_LINK;        !ALREADY HEAD?
          PREV_LINK == P_LINK
          P_LINK == BUF_LINK
          BUF_LINK == P
        %FINISH
        %RESULT == P_BLK_B(OFFSET)
      %FINISH
      %EXIT %IF P == BUF
      PREV == P
      P == P_LINK
    %REPEAT
    !BLOCK NOT IN THE CACHE - REPLACE LRU BLOCK (TAIL OF LIST)
    %IF BUF_BLOCK >= 0 %START;          !LAST BUFFER IN USE ALREADY?
      WRITE DA (PAGING FILE, BUF_BLOCK, BUF_BLK);  !WRITE OUT TO DISC
    %FINISH
    !PROMOTE LAST BUFFER (NOW MRU).
    BUF == PREV
    P_BLOCK = BLOCK
    READ DA (PAGING FILE, BLOCK, P_BLK)
    %RESULT == P_BLK_B(OFFSET)
  %END

  %ROUTINE MOVE(%INTEGER LENGTH,FROM,TO)
    %RETURN %IF FROM = TO
    %IF TO <= FROM %START
      %WHILE LENGTH > 0 %CYCLE
        BYTEINTEGER(TO) = BYTEINTEGER(FROM)
        FROM = FROM+1
        TO = TO+1
        LENGTH = LENGTH-1
      %REPEAT
    %ELSE;                                       !MOVE FROM BACK TO FRONT
      FROM = FROM+LENGTH
      TO = TO+LENGTH
      %WHILE LENGTH > 0 %CYCLE
        FROM = FROM-1
        TO = TO-1
        BYTEINTEGER(TO) = BYTEINTEGER(FROM)
        LENGTH = LENGTH-1
      %REPEAT
    %FINISH
  %END

  %ROUTINE CONNECT INPUT(%RECORD(FILE)%NAME F)
    %RECORD(BLOCKFM) BLOCK
    %INTEGER BUFFER = ADDR(BLOCK), SYM, J, KEY
    %RECORD(PARMFM) P
    %ON 9 %START
      ->EOF
    %FINISH
    FREE = F_VMTOP %IF F_VMTOP # 0;     !REUSE SECONDARY FILE SPACE
    FREE = FREE-1;                      !PSADDR => BYTE ADDR IN FILE
    FREE = FREE+1 %WHILE FREE&511 # 0;  !=> BLOCK BOUNDARY
    J = FREE>>9;                        !REMEMBER BLOCK NO
    FREE = FREE+1;                      !FILE BYTE ADDR (0-N) => PSADDR
    F_VMTOP = FREE
    FREE = FREE+512*F_FLAG;  J = J + F_FLAG
    F_TOP = FREE
    F_FLAG = 0;  !OK
    -> EOF %IF F_NAME = ""
    %IF EXISTS(F_NAME) %START;          !QUICK LOAD FROM DISC
      FLUSH BUFFERS;                    !MAKE CHANGES TO FILE VALID
      STRING(ADDR(P_SACT)) = F_NAME
      SVC (17,P);                       !PACK
      P_DACT = 4;  SVC (20,P);          !OPEN SEQUENTIAL INPUT
      KEY = P_P5
      %CYCLE
        P_P5 = KEY;  P_P4 = BUFFER
        P_DACT = 7;  SVC(20,P);         !READ SEQUENTIAL BLOCK
        WRITE DA (PAGING FILE,J,RECORD(BUFFER))
        FREE = FREE+512;  J = J + 1
      %REPEAT %UNTIL P_P6 # 0;          !LAST BLOCK?
      P_P5 = KEY;  P_DACT = 11;         !CLOSE FILE
      SVC (20,P)
    %ELSE
      %IF EXISTS(F_NAME) %START
         OPEN INPUT(3,F_NAME)
      %ELSE
        F_FLAG = -1
        F_TOP = 0;  F_LIM = 0
        %RETURN
      %FINISH
      SELECT INPUT(3)
      %CYCLE;   !READ FILE INTO PSEUDO-VM
        READ SYMBOL (SYM)
        BYTEINTEGER(FREE) = SYM
        FREE = FREE+1
      %REPEAT
      CLOSE INPUT
    %FINISH
EOF:
    F_LIM = FREE
    F_LIM = F_LIM-1 %WHILE F_LIM # F_TOP %AND BYTEINTEGER(F_LIM-1) # NL
    FREE = FREE+40; !CAUTIOUS
    F_VMLIM = FREE-1
    CLOSE INPUT
    SELECT INPUT(0)
  %END

!*VAX* !system-specific stuff
!*VAX* !
!*VAX* ! External system routines
!*VAX* !
!*VAX* %EXTERNALINTEGERFNSPEC CHECKQUOTA(%STRING(127) FILENAME)
!*VAX* %EXTERNALSTRING(72)%FNSPEC SYSMESS(%INTEGER I)
!*VAX* %EXTERNALSTRING(255)%FNSPEC CLIPARAM
!*VAX* !
!*VAX* ! Special routines from PMM to handle file referencing and i/o
!*VAX* !
!*VAX* %EXTERNALINTEGERFNSPEC READIN(%STRING(MAXNAME)%NAME FILE,
!*VAX*    %INTEGER EXTRA, %INTEGERNAME BASE,TOP,FEND,LIMIT)
!*VAX* %EXTERNALINTEGERFNSPEC WRITEOUT(%STRING(MAXNAME)%NAME FILE,
!*VAX*    %INTEGER BASE,TOP,FEND,LIMIT)
!*VAX* %EXTERNALROUTINESPEC DELETEVM(%INTEGER BASE,LIMIT)
!*VAX* !
!*VAX* %ROUTINE CONNECT INPUT(%RECORD(FILE)%NAME F)
!*VAX* ! Reference file specified by F_NAME
!*VAX* !  allocate store to hold it + extra blocks specified by F_FLAG
!*VAX* !  place the file in store (as near the end as possible)
!*VAX* !  Return store addresses in F_VMTOP/F_VMLIM
!*VAX* !         file addresses in F_TOP/F_LIM
!*VAX* !             ( VMTOP <= TOP <= LIM <= VMLIM )
!*VAX* !  (The area from LIM to VMLIM is not used; it exists only because
!*VAX* !   it is not possible to predict precisely how much space the file
!*VAX* !   will occupy when converted from VAX/VMS record format to a
!*VAX* !   sanitary form, viz. straight ASCII with NLs at end of lines)
!*VAX* !
!*VAX* !Discard any previous secondary input file
!*VAX*   DELETEVM(F_VMTOP,F_VMLIM) %IF F_VMTOP # 0
!*VAX* !Read the file in
!*VAX*   F_FLAG = READIN(F_NAME,F_FLAG,F_VMTOP,F_TOP,F_LIM,F_VMLIM)
!*VAX*   %IF F_FLAG # 0 %START
!*VAX*     PRINT STRING(" *".SYSMESS(F_FLAG).": ".F_NAME)
!*VAX*     F_VMTOP = 0;  F_TOP = 0;  F_LIM = 0
!*VAX*   %FINISH
!*VAX* ! Ensure that file does not end with partial line
!*VAX*   F_LIM = F_LIM-1 %WHILE F_LIM # F_TOP %AND BYTEINTEGER(F_LIM-1)#NL
!*VAX* %END
!*VAX* !
!*VAX* %INTEGERFN TERMTYPE
!*VAX* %CONSTINTEGER VT52=16_40
!*VAX* %RECORDFORMAT DEVINFO(%INTEGER GEN, %BYTE CLASS,TYPE, %SHORT WIDTH,
!*VAX*                   %BYTE A,B,C,COLS,D,E,F,G,H,I,J,K)
!*VAX* %RECORDFORMAT DESC(%INTEGER L,A)
!*VAX* %SYSTEMINTEGERFNSPEC GETDEV(%RECORD(DESC)%NAME DEV, %INTEGERNAME Z,
!*VAX*                             %RECORD(DESC)%NAME RES, %INTEGERNAME X, %INTEGER Y)
!*VAX*
!*VAX* %INTEGER F,X
!*VAX* %RECORD(DEVINFO) TT
!*VAX* %RECORD(DESC) DEV,RES
!*VAX* %OWNSTRING(2) DEVNAME="TT"
!*VAX*
!*VAX*   DEV_L = 2;  DEV_A = ADDR(DEVNAME)+1
!*VAX*   RES_L = 20;  RES_A = ADDR(TT)
!*VAX*   X = 0
!*VAX*   F = GETDEV(DEV,X,RES,X,0)
!*VAX*   %IF F&1 = 0 %START
!*VAX*     PRINTSTRING(SYSMESS(F))
!*VAX*     NEWLINE
!*VAX*     %STOP
!*VAX*   %FINISH
!*VAX*   %RESULT = 16_C0000002 %IF TT_TYPE = VT52
!*VAX*   %RESULT = 0
!*VAX* %END
!*VAX*
%INTEGER I,F,L,SYM,DEFAULT
%RECORD(FILE) IN,SEC,OUT
!*VAX* %STRING(255) PARM=CLIPARAM

!*VAX* %routine getname(%string(maxname)%name s)
!*VAX* ! Extract next name from PARM, leaving terminator in SYM
!*VAX* %integer j
!*VAX*   j = 0
!*VAX*   %cycle
!*VAX*     sym = nl
!*VAX*     l = l+1 %and sym = charno(parm,l) %if l < length(parm)
!*VAX*     %exit %if sym = ',' %or sym = '/' %or sym < ' '
!*VAX*     %if sym = ' ' %start
!*VAX*       %exit %if j # 0
!*VAX*     %finish %else %start
!*VAX*       sym = sym-32 %if sym >= 96
!*VAX*       j = j+1 %if j # maxname;  charno(s,j) = sym
!*VAX*     %finish
!*VAX*   %repeat
!*VAX*   length(s) = j
!*VAX*   s = ".N" %if s = ".NULL"
!*VAX* %end
!*VAX* !
  in = 0;  sec = 0;  out = 0
!*VAX*   %if parm = "" %start
!*VAX*     prompt("File: ")
!*VAX*     l = 0
!*VAX*     %cycle
!*VAX*       read symbol(sym)
!*VAX*       %exit %if sym = nl
!*VAX*       l = l+1;  charno(parm,l) = sym
!*VAX*     %repeat
!*VAX*     length(parm) = l
!*VAX*   %finish
  l = 0
  %STRING(31)%NAME IN1 == COMMAND_IN1,
                   IN2 == COMMAND_IN2,
                  OUT1 == COMMAND_OUT1
  IN_NAME = IN1
  IN_NAME = "" %IF IN_NAME = "N:" %OR IN_NAME = "NULL:"
  SEC_NAME = IN2
  OUT_NAME = OUT1
  %IF OUT_NAME = "" %THEN OUT_NAME = IN_NAME %AND DEFAULT = 1 %C
  %ELSE DEFAULT = 0
  OUT_NAME = "" %IF OUT_NAME = "N:" %OR OUT_NAME = "NULL:"
!*VAX*  getname(in_name)
!*VAX*  GETNAME(SEC_NAME) %IF SYM = ','
!*VAX*  in_name = "" %if in_name = ".N"
!*VAX*  out_name = in_name;  default = 1
!*VAX*  %if sym = ' ' %or sym = '/' %start
!*VAX*    getname(out_name);  default = 0
!*VAX*    OUT_NAME = "" %IF OUT_NAME = ".N"
!*VAX*  %finish
!*VAX*  %if sym # nl %start
!*VAX*    print string(" Faulty parameters: ".parm)
!*VAX*    newline
!*VAX*    spaces(19+l);  print symbol('^');  newline
!*VAX*    %STOP
!*VAX*  %finish
  %IF OUT_NAME = "" %START
    CONNECT INPUT(IN);                  !without extra
    %STOP %IF IN_FLAG # 0
    PRINT STRING("= Showing  ".IN_NAME)
  %FINISH %ELSE %START
!*VAX*     F = CHECKQUOTA(OUT_NAME)
!*VAX*     -> ER %IF F&1 = 0
    IN_FLAG = 20;                       !extra blocks
    IN_FLAG = 100 %IF command_modifier = '!';
    !*MOUSES* USE E <FILE>! FOR BIG BUFFER
    CONNECT INPUT(IN)
    %STOP %IF IN_FLAG # 0
    %IF SEC_NAME # "" %START
      CONNECT INPUT(SEC)
      %STOP %IF SEC_FLAG # 0
    %FINISH
    OUT_TOP = IN_VMTOP;  OUT_LIM = IN_LIM
    %if in_name # "" %start
      print string("= Editing  ".in_name)
      %if default = 0 %start
        print string("  to  ")
        print string(out_name)
      %finish
    %finish %else %start
      print string("= Creating  ".out_name)
    %finish
  %finish
  newline
  edi(in,sec,out,termtype,24,80)
  %if default # 0 %and out_flag = 0 %start
    print string(" File unchanged");  newline
    out_top = 0
    DELETE FILE (PAGE FILE NAME)
  %finish
  %if out_top # 0 %start
    i = in_lim-in_top;  move(i,in_top,out_lim)
    out_lim = out_lim+i
    STRING(ADDR(P_SACT)) = OUT_NAME
    SVC (17,P);  !PACK FILENAME
!    %IF P_P2 = 0 %START;            !FILE IN OWN DIR (NOT DEVICE)
!      %WHILE OUT_LIM&511 # 0 %CYCLE;!SUBSYS STANDARD: LAST BLOCK EOT PADDED
!        BYTEINTEGER(OUT_LIM) = 4;   !ASCII EOT
!        OUT_LIM = OUT_LIM+1
!      %REPEAT
!      !JUST TRUNCATE THE WORKFILE
!      FLUSH BUFFERS;                !MAKE DISC CONSISTENT
!      EXTEND DA (PAGING FILE, (OUT_LIM-OUT_TOP)>>9 - P_P2, I)
!      CLOSE DA (PAGING FILE)
!      DELETE FILE (OUT_NAME)
!      RENAME FILE (PAGE FILE NAME,OUT_NAME)
!    %ELSE;                          !QUEUE (LP:) OR DEVICE (OUT:)
      OPEN OUTPUT (3,OUT_NAME)
      SELECT OUTPUT (3)
      PRINT SYMBOL (BYTEINTEGER(I)) %FOR I = OUT_TOP, 1, OUT_LIM-1
      CLOSE OUTPUT
      CLOSE DA (PAGING FILE)
      DELETE FILE (PAGE FILE NAME)
!*VAX*     F = WRITEOUT(OUT_NAME,OUT_TOP,OUT_TOP,OUT_LIM,IN_VMLIM)
!*VAX*     %IF F # 0 %START
!*VAX* ER:   PRINT STRING(" *".SYSMESS(F).": ".OUT_NAME)
!*VAX*     %FINISH
!*VAX*   %FINISH %ELSE %START
!*VAX*     DELETEVM(IN_VMTOP,IN_VMLIM)
!    %FINISH
  %FINISH %ELSE %START;  !SHOWING
     DELETE FILE (PAGE FILE NAME)
  %FINISH
!*VAX*  DELETEVM(SEC_VMTOP,SEC_VMLIM) %IF SEC_VMTOP # 0
!!  P_P1 = 2;  P_P2 = 10;  P_P3 = OLD TT; !RESTORE TTY STATE FROM BEFORE EDIT
!!  SVC (29,P)
%ENDOFPROGRAM