!!This version of ECCE, derived from a paper copy believed to
!!date from 1975, removes PDP9/15 machine code, and other
!!IMP9/15 system dependencies, and I'm hopeful that as a result
!!it might well work if compiled with a generic Imp compiler.

!!RWT Feb 2002

!!Code slightly rearranged to fit the model of Peter Stephen's Imp to C
!!translator.  This now compiles and runs exactly as on the pdp9/15
!!Remember to run it with redirected input, eg ecce < file.txt > file2.txt

!!The I/O library currently assumes you are running on Unix.
!!NOTE: There IS a bug in this implementation.  Lines of more
!!than 120 characters have a newline inserted at the 120th character
!!on output.  This *may* be an original bug rather than an artifact
!!of the translation or run-time library..

!!GT 02 Mar 2002

%external %integer outstream

%owninteger in=1;                           !current input stream
%constinteger min=1;                        !main input stream
%constinteger mout=1;                       !main output stream
%constinteger sin=2;                        !secondary input stream
%constinteger sextra=122;                   !extra buff for sin
%constinteger size=30000;                   !of edit buffer (bytes)
%owninteger mon=0;                          !monitor indic
%owninteger print1=0,print2=0;              !print indicators
%constinteger stop=-5000;                   !loop stop (const)
%owninteger i,j,k,pp1,sym
%owninteger code;                              !command code letter
%owninteger text;                              !text pointer
%owninteger num;                               !repetition number
%ownintegername mainfp;                        ! == fp or mfp (for sin)
%constinteger cbase=1,tbase=120
%ownintegerarray c(cbase:tbase);            !command -> <- text
! each command unit -- letter, parenthesis or comma -- is
! represented by a trio:  code(+lim)  text  num
! in the case of parentheses and commas 'text' is a pointer
! to another command unit (not to a text string)
%owninteger ci;                                !command index (ad)
%owninteger ti;                                !text index (ad)
%owninteger cmax=0;                         !command max (ad)
%ownintegerarray stored(1:192);                !defs of x,y,z
%owninteger pos1=0, pos2=0, pos3=0
%ownbyteintegerarray byte(1:size)
%owninteger top = 2;                     !top of buff (index)
%owninteger bot = size-sextra;           !bottom of buff (index)
%owninteger lbeg;                              !line start (index)
%owninteger pp;                                !previous pointer (index)
%owninteger fp=0;                           !file pointer (index)
%owninteger lend;                              !line end (index)
%owninteger fend;                           !end of file in buff (index)
%owninteger ms=0;                           !match start (index)
%owninteger ml=0;                           !match limit (index)
! significance of file pointers:
! [nl] o n e nl t w . . . o nl n e x t nl . . nl l a s t nl [nl]
!      !        !   !     !  !                                !
!      t        l   p     f  l                                f
!      o        b   p     p  e                                e
!      p        e            n                                n
!               g            d                                d

%owninteger type,chain;                        !command input vars
%owninteger pend=0;                         !ditto

%routine prompt(%string(1) s); ! Emulating pdp9/15 routine
  %integer oldstream, c
  c = charno(s, 1)
  %if c # 0 %then %start  ; ! c = 0 is supposed to flush output on the 9/15
    oldstream = outstream
    select output(0)
    print symbol(c)
    select output(oldstream)
  %finish
%end

%routine load pp(%integer k);               !!!also increments pp
    byte(pp) = k;  pp = pp+1
%end

%routine load fp(%integer k)
    byte(fp) = k
%end

%routine left star
    %cycle
       %return %if pp = lbeg
       fp = fp-1;  pp = pp-1
       load fp(byte(pp))
    %repeat
%end

%routine right star
    %cycle
       %return %if fp = lend
       load pp(byte(fp))
       fp = fp+1
    %repeat
%end

%ownintegerarray symtype(33:95) = %c
     64, 3, 3, 3, 2, 3, 3,11, 9,64, 3,12, 2, 3, 3,
   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 1, 3, 3, 3,64,
   3, 2,10,18, 5, 8,52,10, 2, 6,10,10,10,56, 2, 2,
  10,50,10,22, 5, 5, 6, 2,32,32,32, 3,10, 3, 3, 3
!     !  "  #  $  %  &  '  (  )  *  +  ,  -  .  /
!  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 sym
    %if pend # 0 %then sym=pend %and pend=0 %else %start
       %while pos3 # 0 %cycle
          sym = stored(pos3);  pos3 = pos3+1
          %return %unless sym = nl
          pos3 = pos2; pos2 = pos1; pos1 = 0
       %repeat
       read symbol(sym)
    %finish
%end

%routine read item
    type = 1
    %cycle
       read sym %until sym # ' '
       %return %if sym < 32;                !nl
       sym = sym-32 %if sym >= 96;          !ensure upper case
       type = symtype(sym)
       %return %unless type&15 = 0
       %exit %unless type=32
       pos1 = pos2;  pos2 = pos3
       pos3 = (sym-'X')<<6+1
    %repeat
    %if type = 0 %start
       num = sym-'0'
       %cycle
          read symbol(pend)
          %exit %unless '0' <= pend <= '9'
          num = (num<<2+num)<<1-'0'+pend
       %repeat
    %finish %else %start
       type = 0
       num = 0;   %return %if sym = '*'
       num = stop+1;  %return %if sym = '?'
       num = stop;                          ! '!'
    %finish
%end

%routine unchain
    %cycle
       text = chain;  %return %if text = 0
       chain = c(text+1);  c(text+1) = ci
    %repeat %until c(text) = 'X'
%end

%routine stack(%integer v)
    c(ci) = v;  ci = ci+1
%end

%routine make space
%integer k,p1,p2
    %return %if mainfp-pp-240 > 0
    select output(mout)
    p1 = top;  p2 = (p1+lbeg)>>1;           !output about half
    p2 = lbeg %if code = 'C';               !but all if closing
    %monitor %and %stop %if p2 = top;               !!!logical error
    %cycle
       k = byte(p1);  print symbol(k);  p1 = p1+1
    %repeat %until k = nl %and p1-p2 >= 0
    select output(0)
    lbeg = top+lbeg-p1;  p2 = pp;  pp = top
    %cycle
       %return %if p1 = p2
       load pp(byte(p1));  p1 = p1+1
    %repeat
%end

%routine read line
%integer k
!    %on %event 9 %start
!       ->eof
!    %finish
    %if fp # fend %start
       lend = fp
       lend = lend+1 %while byte(lend) # nl
       %return
    %finish
    ms = 0;  print1 = 0;  print2 = 0
    select input(in)
    fp = bot-sextra+1
    %cycle
       %if fp # bot %then read symbol(k) %else k = nl
       ->eof %if k<0
       load fp(k);  fp = fp+1
    %repeat %until k = nl
    fend = fp; lend = fend-1
    fp = bot-sextra+1
    select input(0)
    %return
eof:fp = bot;  lend = fp;  fend = lend
    load fp(nl)
    select input(0)
%end

%routine switch inputs
%owninteger mfp,mlend,mend,sfp,send
    %if in = min %start
       left star
       in = sin
       mfp = fp;  mlend = lend;  mend = fend
       mainfp == mfp
       bot = bot+sextra;  fp = sfp; fend = send
       read line
    %finish %else %start
       pp = lbeg
       in = min
       bot = bot-sextra;  sfp = fp;  send = fend
       fp = mfp;  lend = mlend;  fend = mend
       mainfp == fp
    %finish
%end

%routine print line
%integer p
    print1 = lend;  print2 = fp+pp
    p = lbeg
    %cycle
       %if p = pp %start
          print symbol('^') %if p # lbeg %and num = 0
          p = fp
       %finish
       %exit %if p = lend
       print symbol(byte(p))
       p = p+1
    %repeat
    print string("**END**") %if p = fend
    newline
%end

%integerfn matched
%integer i,j,k,l,t1,fp1,lim
    lim = c(ci-3)&(\127);  t1 = c(text)
L1:  pp1 = pp;  fp1 = fp
    ->L3 %unless fp = ms %and (code='F' %or code='U')
    k = byte(fp)
L2:  load pp(k); fp = fp+1
L3:  ->L10 %if fp = lend
    k = byte(fp)
    ->L2 %unless k = t1
    i = fp;  j = text
L6:  i = i+1;  j = j-1
    l = c(j)
    ->L6 %if byte(i) = l
    ->L2 %if l # 0
    ms = fp;  ml = i
    %result = 1
L10: lim = lim-128
    %if lim # 0 %and fp # fend %start
       %if code # 'U' %start
          load pp(nl);  lbeg = pp
       %finish %else pp = pp1
       fp = fp+1;  make space;  read line
       ->L1
    %finish
    pp = pp1;  fp = fp1
    %result = 0
%end


%externalintegerfn main;                                     !edit15: ecce for pdp9/15
!initialise
%switch t(0:12)
%switch s('A':'\')

!%on %event 9 %start
!    printstring("Caught event"); newline
!    ->eof
!%finish

    select input(0)
    pp = top-1;  load pp(nl);               !for bouncing off
    lbeg = pp;  mainfp == fp
    stored(1) = nl;  stored(65) = nl;  stored(129) = nl
    select output(0); print string("EDIT
")
    read line

!read command line

L1:  prompt(">")
    read item; ->eof %if sym<0; ->L1 %if type = 1
    ci = cbase;  ti = tbase;  chain = 0
    %if type = 0 %and cmax # 0 %start
       c(cmax+2) = num
       read item;  ->er2 %if type # 1
       ->go
    %finish
    %if sym = '%' %start
       read sym; sym = sym-32 %if sym >= 96
       code = sym;  ->er5 %if code<=32
       read item
       ->t(symtype(code)>>4)
    %finish
L2:  i = type&15;  ->er2 %if i < 4
    code = sym;  text = 0;  num = 1;        !default values
    read item
    ->t(i)
t(2):                                       !%x, %y, %z
    ->er1 %if sym # '='
    i = (code-'X')<<6
    %cycle
       read sym
       i = i+1;  stored(i) = sym
       ->L1 %if sym = nl
    %repeat
t(3):                                       !%m, %f, %q
    mon = 'M'-code
    ->L1
t(4):                                       !find
    num = 0 %unless type = 0
t(5):                                       !+del,trav,uncover
    code = num<<7+code;  num = 1
    read item %if type = 0
t(6):                                       !+insert,subst,verify
    ->er4 %if type # 3
    text = ti;  i = sym
L61: read sym
    %if sym # nl %start
       %if sym # i %start
          ->er6 %if ti <= ci
          c(ti) = sym;  ti = ti-1
          ->L61
       %finish
    %finish %else %start
       pend = sym
       ->er4 %unless code = 'S' %or code = 'I'
    %finish
    ->er4 %if ti = text %and code # 'S'
    c(ti) = 0;  ti = ti-1
    ->L81
t(8):                                       !move,erase
    ->L100 %unless sym = '-'
    code = code+10
L81: read item
    ->L101
t(9):                                       !close bracket
    unchain;  ->er3 %if text = 0
    code = 'Z'; c(text+2) = num
    text = text+3
t(10):                                      !+get,kill,etc.
L100:->er1 %if type = 3
L101:read item %if type = 0
    ->put
t(11):                                      !open bracket
    code = 'X'
    ->L121
t(12):                                      !comma
    code = 'Y'
    read item %if type = 1
L121:text = chain;  chain = ci
    num = 0
put:stack(code);  stack(text);  stack(num)
    ->er6 %if ci+4 >= ti
    ->L2 %unless type = 1
    unchain;  ->er3 %if text # 0
    cmax = ci
    stack('Z');  stack(cbase);  stack(1);   !extra close b
    stack(0)
    ->go

!command input error reports

er1:space;  print symbol(code)
er2:code = sym
    ->er5
er3:print string(" ()")
    ->er7
er4:print string(" TEXT FOR")
t(0):
er5:space;  print symbol(code&127)
    ->er7
er6:print string(" SIZE")
er7:print symbol('?')
    newline;  cmax = 0 %if ci # cbase
L10: ->L1 %if sym<32
    read sym
    ->L10

!execute command line

go: ci = cbase
get:code = c(ci)&127;  ->L99 %if code = 0
    text = c(ci+1)
    num = c(ci+2)
    ci = ci+3
rep:num = num-1
    ->s(code)
ok: ->rep %unless num = 0 %or num = stop
    ->get
s('\'):                                     !invert
no: ->get %if num < 0
    ci = ci+3 %and ->get %if c(ci) = '\'
skp:i = c(ci);  ci = c(ci+1) %if i = 'X'
    ci = ci+3
    num = c(ci-1)-1 %and ->no %if i > 'X'
    ->skp %if i # 0

!execution error report

    print string("FAILURE: ")
    %if code='O' %or code='W' %start
       print symbol(code-10);  code = '-'
    %finish
    print symbol(code)
    %if text # 0 %start
       print symbol('''')
       %while c(text) # 0 %cycle
          print symbol(c(text))
          text = text-1
       %repeat
       print symbol('''')
    %finish
    newline
    print1 = 0

!end of command line

L99: ->L1 %if sym # nl
    ->L1 %unless (mon>=0 %and print1#lend) %or (mon>0 %and print2#fp+pp)
    num = 0; print line
    ->L1

!individual commands

s('X'):                                     !open bracket
    c(text+2) = num+1
    ->get
s('Z'):                                     !close bracket
    ->get %if num = 0 %or num = stop
    c(ci-1) = num
s('Y'):                                     !+comma
    ci = text
    ->get
s('R'):                                     !right shift
    ->no %if fp = lend
    load pp(byte(fp));  fp = fp+1
    ->ok
s('L'):                                     !left shift
    ->no %if in = sin %or pp = lbeg
    fp = fp-1;  pp = pp-1;  load fp(byte(pp))
    ms = 0
    ->ok
s('E'):                                     !erase
    ->no %if fp = lend
    fp = fp+1
    ->ok
s('O'):                                     !erase back
    ->no %if pp = lbeg
    pp = pp-1
    ->ok
s('V'):                                     !verify
    i = fp-1;  j = text+1
v1: i = i+1; j = j-1
    k = c(j)
    ->v1 %if byte(i) = k
    ->no %if k # 0
    ms = fp;  ml = i
    ->ok
s('F'):                                     !find
    ->no %if matched = 0
    ->ok
s('U'):                                     !uncover
    ->no %if matched = 0;  pp = pp1
    ->ok
s('D'):                                     !delete
    ->no %if matched = 0;  fp = ml
    ->ok
s('T'):                                     !traverse
    ->no %if matched = 0
s('S'):                                     !+substitute
    fp = ml %if fp = ms
s('I'):                                     !+insert
    make space
!!  ->no %if pp-lbeg+lend-fp > 80
    i = text
i1: ->ok %if c(i) = 0
    load pp(c(i));  i = i-1
    ->i1
s('G'):                                     !get (line from tt)
    prompt(":")
!!  make space
    read symbol(i)
    ->no %if i = ':'
    left star
    %while i # nl %cycle
       load pp(i)
       read symbol(i)
    %repeat
s('B'):                                     !+break (insert newline)
    make space
    load pp(nl);  lbeg = pp
    ->ok
s('P'):                                     !print
    print line
    ->get %if num = 0
s('M'):                                     !+move
    right star
    ->no %if fp = fend
    load pp(nl); lbeg = pp
m1: fp = fp+1;  make space;  read line
    ->ok
s('K'):                                     !kill (line)
    pp = lbeg;  fp = lend
k1: ->no %if fp = fend
    ->m1
s('J'):                                     !join (delete newline)
    right star
!!  ->no %if pp-lbeg > 80
    ->k1
s('W'):                                     !move back
    ->no %if in = sin
    make space
    ->no %if lbeg = top
    lend = fp-pp+lbeg-1
w1: k = byte(pp-1)
    ->w2 %if k = nl %and pp # lbeg
    fp = fp-1;  pp = pp-1;  load fp(k)
    ->w1
w2: lbeg = pp;  ms = 0
    ->ok
t(1):                                       !%s, %c ...
    ->eof %if code = 'C'
    switch inputs
    ->L99
eof:code = 'C';                             !+eof on command stream
    switch inputs %if in = sin
    %cycle
       right star
       %exit %if fp = fend
       load pp(nl);  lbeg = pp
       fp = fp+1;  make space;  read line
    %repeat
    select output(mout)
    %while top # pp %cycle
       print symbol(byte(top));  top = top+1
    %repeat
    select output(0)
    %if code # 'C' %then %monitor
    %result = 0
%end

%endoffile