section "ECCE1"

get "Header"

let start (argc,argv,envp) be $(

   tty.in := input ()
   tty.out := output ()

   selectinput (tty.in)
   selectoutput (tty.out)

   if argc = 0 then $(
      writef ("%S: From To? Logfile? Buffersize?*N", argv!Program)
      stop (20)
   $)

   Main.in := findinput (argv!F)

   if Main.in = 0 then $(
      writef ("File *"%S*" not found*N",argv!F)
      stop (20)
   $)

   test (L > argc) | (argv!L = 0) then $(
      log.out := -1
   $) else $(
      log.out := findoutput (argv!L)
      if log.out = 0 then $(
         writef ("Ecce: Warning - can't create *"%S*"*N", argv!L)
         log.out := -1
      $)
   $)

   test (B > argc) | (argv!B) = 0 then $(
      buffer.size := 128*1024
   $) else $(
      let n = 0
      let buff.string = argv!B
      let c = buff.string%1
      let i = 1
      while i <= buff.string%0 & '0'<= c <= '9' do
      $( n := n*10+c-'0'
         i := i+1
         c := buff.string%i $)
      buffer.size := n $)

   if buffer.size = 0 then buffer.size := 20*1024

   init.globals ()

   a%0         := cr
   a%buffer.size := cr

   writes ("Ecce*N")

   if Main.in > 0 then load.file ()

   percent ('L')
   $(
      analyse ()
      if ok then $(
         printed := false
         execute ()
         command := 'P'
         repeat.count := 1
         if not printed then execute.command () 
      $)
   $) repeat
$)

let init.globals () be $(

   let diff, margin = ?, ?

   note.file := getvec (16 / bytesperword + 1)

   com  := getvec (max.size / bytesperword + 1)
   link := getvec (max.size / bytesperword + 1)
   text := getvec (max.size / bytesperword + 1)

   num := getvec (max.size)
   lim := getvec (max.size)

   com.prompt := getvec ( 4 / bytesperword + 1)

   a := getvec (buffer.size / bytesperword + 1)

   if a=0 | note.file=0 | com=0 |
      link=0 | text=0 | num=0 | lim=0 | com.prompt=0 then
   $( writes("Unable to claim buffer space*N")
      free.buffers()
      stop (20) $)

//   writef ("Buffer space = %N KBytes*N", buffer.size>>10)

   sym.type := table /* 0:127 */
   ext+termin,          //NL//
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   ext+termin,          /*NL*/
   err,             /* */
   ext+numb+7,      /*!*/
   delim,           /*"*/
   err,             /*#*/
   err,             /*$*/
   ext+1,           /*%*/
   err,             /*&*/
   delim,           /*'*/
   ext+2,           /*(*/
   ext+4,           /*)*/
   ext+numb+8,      /***/
   ext+5,           /*+*/
   ext+3,           /*,*/
   ext+6,           /*-*/
   delim,           /*.*/
   delim,           /*slash*/
   ext+numb+0,      /*0*/
   ext+numb+0,      /*1*/
   ext+numb+0,      /*2*/
   ext+numb+0,      /*3*/
   ext+numb+0,      /*4*/
   ext+numb+0,      /*5*/
   ext+numb+0,      /*6*/
   ext+numb+0,      /*7*/
   ext+numb+0,      /*8*/
   ext+numb+0,      /*9*/
   delim,           /*:*/
   ext+15,          /*;*/
   ext+2,           /*<*/
   delim,           /*=*/
   ext+4,           /*>*/
   0,               /*?*/
   err,             /*@*/
   scope,           /*A*/
   sign+rep,        /*B*/
   sign+rep,        /*C*/
   sign+scope+txt+rep,   /*D*/
   sign+rep,        /*E*/
   sign+scope+txt+rep,   /*F*/
   sign+rep,             /*G*/
   scope,           /*H*/
   sign+txt+rep,         /*I*/
   sign+rep,             /*J*/
   sign+rep,             /*K*/
   sign+rep,             /*L*/
   sign+rep,        /*M*/
   0,               /*N*/
   err,             /*O*/
   sign+rep,             /*P*/
   err,             /*Q*/
   sign+rep,             /*R*/
   sign+txt,             /*S*/
   sign+scope+txt+rep,   /*T*/
   sign+scope+txt+rep,   /*U*/
   sign+txt,             /*V*/
   err,             /*W*/
   err,             /*X*/
   err,             /*Y*/
   err,             /*Z*/
   ext+2,           /*[*/
   0,               /*\*/
   ext+4,           /*]*/
   ext+6,           /*^*/
   delim,           /*_*/
   err,             /*@*/
   err,             /*A*/
   sign+rep,        /*B*/
   sign+rep,        /*C*/
   sign+scope+txt+rep,   /*D*/
   sign+rep,        /*E*/
   sign+scope+txt+rep,   /*F*/
   sign+rep,             /*G*/
   err,             /*H*/
   sign+txt+rep,         /*I*/
   sign+rep,             /*J*/
   sign+rep,             /*K*/
   sign+rep,             /*L*/
   sign+rep,        /*M*/
   err,             /*N*/
   err,             /*O*/
   sign+rep,             /*P*/
   err,             /*Q*/
   sign+rep,             /*R*/
   sign+txt,             /*S*/
   sign+scope+txt+rep,   /*T*/
   sign+scope+txt+rep,   /*U*/
   sign+txt,             /*V*/
   err,             /*W*/
   err,             /*X*/
   err,             /*Y*/
   err,             /*Z*/
   ext+2,           /*[*/
   0,               /*\*/
   ext+4,           /*]*/
   ext+6,           /*^*/
   delim            /*_*/

   fbeg := 1
   lbeg := fbeg
   pp := lbeg
   fp := buffer.size
   lend := fp
   fend := lend
   ms := -1
   ms.back := -1
   stopper := -buffer.size
   max.unit := -1
   pending.sym := cr
   blank.line := true
   copy.string( "Note0", note.file )
   noted := -1
   changes := 0
   in.second := false
   copy.string ( ">", com.prompt )
$)

let copy.string (source, destination) be
$( for i= 0 to source%0 do destination%i := source%i $)

let free.buffers () be $(
   freevec (a)
   freevec (lim)
   freevec (num)
   freevec (text)
   freevec (link)
   freevec (com)
   freevec (com.prompt)
   freevec (note.file)
$)

let local.echo (sym) be $(1
   if blank.line then prompt (eprompt)
   !sym := rdch()
   if log.out > 0 then $(
      selectoutput (log.out)
      wrch (!sym)
      selectoutput (tty.out)
   $)
   blank.line := (!sym = cr)
$)1

let read.sym () be $(1
   test pending.sym = 0 then
      local.echo (@sym) repeatwhile sym = '*S'
   else $(2
      sym := pending.sym
      pending.sym := 0
   $)2
$)1

let fail.with (mess,culprit) be $(1
   let sign = ?
   test 'a' <= culprit <= 'z' then
      sign := '-'
   else 
     test (culprit & plusbit) \= 0 then
        sign := '+'
     else
        sign := '*S'
   culprit := culprit & \plusbit
   if 'A' <= culprit <= 'Z' then
      culprit := culprit | casebit
   writef ("** %S %C%C*N", mess, culprit, sign)
   read.sym () repeatuntil sym.type!sym = sym.type!';'
   ok := false
$)1

let read.item() be $(1
   let saved.digit = '?'
   read.sym ()
   if 'a' <= sym <= 'z' then
      sym := sym - casebit
   type := sym.type!sym
   if (type & ext) = 0 then return

   switchon type & 15 into $(2

      case star:
         number := 0
         return

      case pling:
         number := stopper-1
         return

      case dig:
         saved.digit := sym
         number := 0
         $(4
            number := number * 10 + sym - '0'
            read.sym()
         $)4 repeatwhile '0' <= sym <= '9'
         pending.sym := sym
         sym := saved.digit // for printing in errors
         return

      default:
         return
   $)2
$)1

let percent (Command.sym) be $(1
   static $( note.sec = '0' $)
   let Emergency = vec 256
   let P, sec.no = ?, ?
   ok := true
   if 'a' <= Command.sym <= 'z' then
      command.sym := command.sym - casebit
   unless 'A' <= command.sym <= 'Z' then $(2
      fail.with ("Letter for", '%')
      return
   $)2
   switchon command.sym into $(2

      case 'U':
//         to.upper.case := \0
//         to.lower.case := casebit
         to.lower.case := 0
         endcase

      case 'L':
//         to.upper.case := \casebit
//         to.lower.case := 0
         to.lower.case := casebit
         endcase

/*
      CASE 'N':
         to.upper.case := \0
         to.lower.case := 0
         ENDCASE
*/

      case 'V':
         writes ("Ecce V2.1 Sat May 19 20:53:02 BST 1984*N")  
         endcase

//      CASE 'W':
      case 'C':
         read.sym () repeatuntil sym.type!sym = sym.type!';'
   
         test argc = 1 then $(  // ARGC = 1 => "from" only
            p := F   // So use input file as output file
         $) else $(
            p := T
         $)
         Main.out := findoutput (argv!P)
         test Main.out = 0 then $(
            writef ("Can't create *"%S*" - supply alternative filename*N",
                                                                    argv!P)
//            $(
               eprompt := "File: "
               Copy.string ("ECCEBAK", Emergency)
               Main.out := findoutput (Emergency)
//               IF Main.out > 0 THEN BREAK
//            $) REPEAT
writef ("Writing to file %S instead of %S*N", Emergency, argv!P)
         $) else $(
            test p = T then $(
               writef ("Ecce %S to %S completing.*N", argv!F, argv!T)
            $) else $(
               writef ("Ecce %S completing.*N", argv!F)
            $)
         $)
         selectoutput (Main.out)
         p := fbeg
         $(4
            if p = pp then p := fp
            if p = fend then break
            wrch (a%p)
            p := p + 1
         $)4 repeat
         endwrite ()

//         IF Command.sym = 'W' THEN $(
//            selectoutput (tty.out)
//            pending.sym := cr
//            ENDCASE
//         $)

         if log.out > 0 then $(
            selectoutput (log.out)
            endwrite ()
         $)
         selectoutput (tty.out)
//         writes ("Ecce complete*N")
         free.buffers ()
         finish

      case 'A':
         if log.out > 0 then $(
            selectoutput (log.out)
            endwrite ()
         $)
         selectoutput (tty.out)
         writes ("Aborted!*N")
         free.buffers ()
         finish

      case 'S':
         local.echo (@sec.no)
         test sym.type!(sec.no) = sym.type!(';') then sec.no := 0
         else  $(
            test sec.no = '!' then sec.no := '?'
            else unless '0' <= sec.no <= '9' then $(
               fail.with ("%S", sec.no)
               return
            $)
            local.echo (@sym)
            if sym.type!(sym) \= sym.type!(';') then $(
               fail.with ("%S?", sym)
               return
            $)
         $)
         pending.sym := cr
         note.file%(note.file%0) := note.sec
         if in.second then $(
            let sec.out = findoutput (note.file)
            copy.string(">",com.prompt)
            if sec.out <= 0 then $(
               fail.with ("Cannot save context", ' ')
               return
            $)
            selectoutput (sec.out)
            p := fbeg
            $(4
               if p = pp then p := fp
               if p = fend then break
               wrch (a%p)
               p := p + 1
            $)4 repeat
            endwrite ()
            selectoutput (tty.out)
            pp := fbeg - 1
            fp := fend + 1
            fbeg := 1
            fend := buffer.size
            lbeg := pp
            lbeg := lbeg - 1 repeatuntil a%lbeg = cr
            lbeg := lbeg + 1
            lend := fp
            while a%lend \= cr do
               lend := lend + 1
            in.second := false
            if sec.no = 0 then $(
               return
            $)
         $)
         if sec.no = 0 then sec.no := '0'
         note.file%(note.file%0) := sec.no
         note.sec := sec.no
         $(
            let sec.in = findinput (note.file)
            if sec.in <= 0 then $(
               fail.with ("Unknown context", sym)
               return
            $)
            copy.string(" >",com.prompt)
            com.prompt%1 := sec.no
            in.second := true
            a%pp := cr

            fbeg := pp + 1
            fend := fp - 1
            pp := fbeg
            fp := fend
            a%fend := cr
            lbeg := pp
            selectinput (sec.in)
            p := pp
            $(
               sym := rdch ()
               if sym = endstreamch then break
               a%p := sym
               p := p + 1
               if p = fend then $(
                  fail.with ("%S corrupt - no room", ' ')
                  endread ()
                  selectinput (tty.in)
                  return
               $)
            $) repeat
            endread ()
            selectinput (tty.in)
            while p \= pp do $(
               p := p - 1
               fp := fp - 1
               a%fp := a%p
            $)
            lend := fp
            while a%lend \= cr do
               lend := lend + 1
         $)
         endcase

      default:
         fail.with ("Percent ", command.sym)
   $)2
   read.sym() repeatuntil sym.type!sym = sym.type!';'
$)1

let unchain() be $(1
   $(2
      pointer := last.unit
      if (pointer&(max.size+1)) \= 0 then pointer := pointer | (\#xff) // Sign extend
      if pointer < 0 then return
      last.unit := link%pointer
      if (last.unit&(max.size+1)) \= 0 then last.unit := last.unit | (\#xff)
                                       // perhaps un-necessary
      link%pointer := this.unit
   $)2 repeatuntil com%pointer = '('
$)1

let stack() be $(1
   com%this.unit  := command
   link%this.unit := pointer
   num!this.unit  := repeat.count
   lim!this.unit  := limit
   this.unit      := this.unit + 1
$)1
.  // End of ECCE1

section "ECCE2"

get "Header"

let execute.command() be $(1
   let i = ?
   let sym = ?
   ok := true
   switchon command & (\plusbit) into $(2

      case 'p':
      case 'P':
         printed := true
         i := lbeg
         $(4
            if i=noted then $(
               writes ("******Note******")
               if i=lbeg then newline ()
            $)
            if i=pp then $(5
               if i \= lbeg then wrch ('^')
               i := fp
            $)5
            if i = lend then break
            sym := a%i
            test (sym < 32) | (sym >= 127) then $(5
               wrch ('<')
               writen (sym)
               wrch ('>')
            $)5 else wrch (sym)
            i := i + 1
         $)4
         repeat
         if i = fend then writes ("******End******")
         newline()
         if repeat.count = 1 then return
         test (command & minusbit) \= 0 then
            move.back ()
         else
            move ()
         return

      case 'g':
      case 'G':
         local.echo (@sym)
         if sym=':' then $(4
            local.echo (@sym)
            pending.sym := sym
            if sym \= cr then
               printed := true
            ok := false
            return
         $)4
         left.star ()
         $(4
            a%pp := sym
            pp := pp + 1
            if sym = cr then break
            local.echo (@sym)
         $)4 repeat
         lbeg := pp
         if (command & minusbit) \= 0 then $(4
            move.back() 
            printed := true
         $)4
         return

      case 'E':
         if fp = lend then $(4
            ok := false
            return
         $)4
         test repeat.count = 0 then $(5
            fp := lend
            ok := false
         $)5 else fp := fp + 1
         return

      case 'e':
         if pp = lbeg then $(4
            ok := false
            return
         $)4
         test repeat.count = 0 then $(5
            pp := lbeg
            ok := false
         $)5 else pp := pp - 1
         return

      case 'C':
         if fp = lend then $(4
            ok := false
            return
         $)4
         sym := a%fp
         test 'a' <= (sym | casebit) <= 'z' then
            a%pp := sym neqv casebit
         else
            a%pp := sym
         pp := pp + 1
         fp := fp + 1
         return

      case 'c':
         if pp = lbeg then $(4
            ok := false
            return
         $)4
         pp := pp - 1
         fp := fp - 1
         sym := a%pp
         test 'a' <= (sym | casebit) <= 'z' then
            a%fp := sym neqv casebit
         else
            a%fp := sym
         return

      case 'l':
      case 'R':
         test repeat.count = 0 then $(
            right.star()
            ok := false
         $) else right()
         ms.back := -1
         return

      case 'r':
      case 'L':
         test repeat.count = 0 then $(
            left.star()
            ok := false
         $) else left()
         ms := -1
         return

      case 'B':
         a%pp := cr
         pp := pp + 1
         lbeg := pp
         return

      case 'b':
         fp := fp - 1
         a%fp := cr
         lend := fp
         return

      case 'J':
         right.star()
         if fp = fend then $(4
            ok := false
            return
         $)4
         fp := fp + 1
         lend := fp
         while a%lend \= cr do
            lend := lend + 1
         return

      case 'j':
         left.star()
         if pp = fbeg then $(4
            ok := false
            return
         $)4
         pp := pp - 1
         lbeg := pp
         lbeg := lbeg - 1 repeatuntil a%lbeg = cr
         lbeg := lbeg + 1
         return

      case 'M':
         test repeat.count = 0 then $(4
            move.star()
            ok := false
         $)4 else
            move()
         return

      case 'm':
         test repeat.count = 0 then $(4
            move.back.star()
            ok := false
         $)4 else $(
            move.back()
            left.star () // Compatability...
         $)
         return

      case 'k':
      case 'K':
         if (command & minusbit) \= 0 then $(4
            move.back()
            if not ok then return
         $)4
         pp := lbeg
         fp := lend
         if lend = fend then $(4
            ok := false
            return
         $)4
         fp := fp + 1
         lend := fp 
         while a%lend \= cr do
            lend := lend + 1
         return

      case 'V':
         verify ()
         return

      case 'v':
         verify.back ()
         return

      case 'F':
         find ()
         return

      case 'f':
         find.back ()
         return

      case 'U':
         find ()
         if not ok then return
         pp := pp.before
         lbeg := pp
         lbeg := lbeg - 1 repeatuntil a%lbeg = cr 
         lbeg := lbeg + 1
         return

      case 'u':
         find.back ()
         if not ok then return
         fp := fp.before
         lend := fp
         while a%lend \= cr do
            lend := lend + 1
         return

      case 'D':
         find ()
         if not ok then return
         fp := ml
         ms := fp
         return

      case 'd':
         find.back ()
         if not ok then return
         pp := ml.back
         ms.back := pp
         return

      case 'T':
         find ()
         if not ok then return
         while fp \= ml do $(4
            a%pp := a%fp
            pp := pp + 1
            fp := fp + 1 
         $)4
         return

      case 't':
         find.back ()
         if not ok then return
         while pp \= ml.back do $(4
            fp := fp - 1
            pp := pp - 1
            a%fp := a%pp
         $)4
         return

      case 'I':
         insert ()
         return

      case 'i':
         insert.back ()
         return

      case 's':
      case 'S':
         test fp = ms then
            fp := ml
         else test pp = ms.back then
            pp := ml.back
         else $(5
            ok := false
            return
         $)5
         test (command & minusbit) \= 0 then
            insert.back ()
         else
            insert ()
         return

      case '(':
         num!pointer := repeat.count
         repeat.count := 1
         return

      case ')':
         num!this.unit := num!this.unit - 1
         if 0 \= num!this.unit \= stopper then $(3
            this.unit := pointer
            if (this.unit&128) \= 0 then this.unit := this.unit | (\#xff)
         $)3
         repeat.count := 1
         return

      case '\':
         ok := false
         return

      case '?':
         return

      case ',':
         this.unit := pointer - 1
         return

      case 'N':
         noted := pp
         changes := fp-pp
         return

      case 'A':
         if (noted<0) | (noted>=pp) | (changes\=fp-pp) then $(
            ok := false
            return
         $)
         note.file%(note.file%0) := lim!(this.unit)+'0'
         $(
            let note.out = findoutput (note.file)
            let p = noted
            if note.out <= 0 then $(
               ok := false
               return
            $)
            selectoutput (note.out)
            $(
               wrch (a%p)
               p := p + 1
            $) repeatuntil p=pp
            endwrite ()
            selectoutput (tty.out)

            pp := noted
            lbeg := pp
            lbeg := lbeg - 1 repeatuntil a%lbeg = cr
            lbeg := lbeg + 1
         $)
         noted := -1
         return

      case 'H':
         note.file%(note.file%0) := lim!(this.unit)+'0'
         $(
            let note.in = findinput (note.file)
            if note.in <= 0 then $(
               ok := false
               return
            $)
            selectinput (note.in)
            $( let p = pp
               $(
                  sym := rdch ()
                  if sym = endstreamch then break
                  a%p := sym
                  p := p + 1
                  if p = fp then $(
                     endread ()
                     selectinput (tty.in)
                     ok := false
                     return
                  $)
               $) repeat
               pp := p
            $)
            lbeg := pp
            lbeg := lbeg - 1 repeatuntil a%lbeg = cr
            lbeg := lbeg + 1
            endread ()
            selectinput (tty.in)
         $)
         return

      default:
         fail.with ("Unrecognised command", command)
         return
   $)2
$)1

let scan.sign() be $(1
   read.sym ()
   test sym.type!sym = sym.type!'+' then
      command := command | plusbit
   else test (sym.type!sym = sym.type!'-') & ('A' <= command <= 'Z') then
      command := command | minusbit
   else
      pending.sym := sym
$)1

let Scan.scope() be $(1
   number := 1
   if 'D' \= (command & (\(minusbit | plusbit))) \= 'U' then number := 0
   read.item ()
   if (type & numb) = 0 then pending.sym := sym
   limit := number
   if ('H' = command) | (command = 'A') then $(
      unless (0 <= limit <= 9) then limit := '?'-'0'
   $)
$)1
 
let Scan.text() be $(1
   let last = ?
   read.sym ()
   last := sym
   if (sym.type!sym & delim) = 0 then $(2
      pending.sym := sym
      fail.with ("Text for", command)
      return
   $)2
   test 'a' <= command <= 'z' then $(2
      text%endpos := 0
      $(3
         local.echo (@sym)
         if sym = last then break
         if sym = cr then $(4
            pending.sym := cr
            break
         $)4
         endpos := endpos - 1
         text%endpos := sym
      $)3 repeat
      pointer := endpos
      endpos := endpos - 1
   $)2 else $(2
      pointer := pos
      $(3
         local.echo (@sym)
         if sym = last then break
         if sym = cr then $(4
            pending.sym := cr
            break
         $)4
         text%pos := sym
         pos := pos + 1
      $)3 repeat
      text%pos := 0
      pos := pos + 1
   $)2
   ok := true
$)1

let scan.repeat () be $(1
   number := 1
   read.item ()
   if (type & numb) = 0 then pending.sym := sym
   repeat.count := number
$)1

let analyse () be $(1
   let saved.type = ?
   ok := true
   pos := 0
   endpos := max.size
   this.unit := 0
   last.unit := -1
   eprompt := com.prompt
   read.item () repeatuntil type \= sym.type!';'
   command := sym
   if command = '%' then $(2
      read.sym()
      if sym.type!sym = sym.type!';' then $(3
         pending.sym := sym
         sym := 0
      $)3
      percent (sym)
      ok := false //to inhibit executio
      return
   $)2
   if (type & numb) \= 0 then $(2
      test max.unit > 0 then
         num!max.unit := number
      else $(3
         ok := false
         return
      $)3
      read.item()
      if type \= sym.type!';' then
         fail.with ("?", sym)
      pending.sym := sym
      return
   $)2
   $(2  //on items
      if (type & err) \= 0 then $(3
         fail.with ("Command", command)
         return
      $)3
      if (type & delim) \= 0 then $(3
         fail.with ("Command before", command)
         return
      $)3
      if (type & numb) \= 0 then $(
         fail.with ("Unexpected repetition count", command)
         return
      $)
      limit := 0
      pointer := 0
      repeat.count := 1
      test (type & ext) = 0 then $(3
         saved.type := type
         if (saved.type & sign) \= 0 then scan.sign ()
         if (saved.type & scope) \= 0 then scan.scope ()
         if (saved.type & txt) \= 0 then scan.text () 
         if not ok then return
         if (saved.type & rep) \= 0 then scan.repeat ()
         type := saved.type
      $)3 else $(3
         switchon (type & 15) into $(4

            case termin:
               pending.sym := cr  //for skipping on error
               unchain ()
               if pointer >= 0 then $(5
                  fail.with ("Missing", ')')
                  return
               $)5
               max.unit := this.unit
               repeat.count := 1
               command := ')'
               stack ()
               command := 0
               stack ()
               return

            case lpar:
               command := '('
               pointer := last.unit
               last.unit := this.unit
               endcase

            case comma:
               command := ','
               pointer := last.unit
               last.unit := this.unit
               endcase

            case rpar:
               command := ')'
               scan.repeat ()
               unchain ()
               if pointer < 0 then $(5
                  fail.with ("Missing", '(')
                  return
               $)5
               num!pointer := repeat.count
               endcase
         $)4
      $)3
      stack ()
      read.item ()
      command := sym
   $)2 repeat  //on items
$)1

let load.file () be $(
   let p = fbeg
   let sym = ?
   selectinput (Main.in)
   sym := rdch ()
   while sym \= endstreamch do $(
      a%p := sym
      p := p + 1
      if p = fend then $(
         writes ("******File too large!*N")
         percent ('A')
      $)
      sym := rdch ()
   $)
   endread ()
   selectinput (tty.in)

   while p \= fbeg do $(
      p := p - 1
      fp := fp - 1
      sym := a%p
      a%fp := sym
   $)
   lend := fp
   while a%lend \= cr do
      lend := lend + 1
$)
.  // End of ECCE2

section "ECCE3"

get "Header"

let execute.unit () be $(1
   let culprit = ?
   command := com%this.unit
   culprit := command
   pointer := link%this.unit
   if (pointer&128) \= 0 then pointer := pointer | (\#xff)
   repeat.count := num!this.unit
   $(2  //On repeats of this.unit
      execute.command ()
      repeat.count := repeat.count - 1
      if ok then $(3
         if repeat.count = 0 | repeat.count = stopper then return
         loop
      $)3
      ok := true
      $(3  //scanning for end of unit (e.g. ')')
         unless '\' \= com%(this.unit+1) \= '?' then $(4
            this.unit := this.unit + 1
            return
         $)4
         if repeat.count < 0  then return
//            indefinite repetition never fails
         $(4  //scanning for end of sequence
            this.unit := this.unit + 1
            command := com%this.unit
            switchon command into $(5

               case '(':
                  this.unit := link%this.unit
                  endcase

               case ',':
                  return

               case ')':
                  num!this.unit := num!this.unit - 1
                  repeat.count := num!this.unit
                  break
            $)5
            if com%this.unit = 0 then $(5
               fail.with ("Failure:", culprit)
               return
            $)5
         $)4 repeat  //end of seq
      $)3 repeat  //find() ')' without \ or ?
    $)2 repeat //executing repeats
$)1

let execute () be $(1
   eprompt := ":"
   this.unit := 0
   $(2
      execute.unit()
      if not ok then return
      this.unit := this.unit + 1
   $)2 repeatuntil com%this.unit = 0
   ok := true
$)1

let case.op (sym) = valof $(1
   if 'A' <= sym <= 'Z' then sym := sym | to.lower.case
   resultis sym
$)1

let right () be $(1
   ok := true
   if fp = lend then $(2
      ok := false
      return
   $)2
   a%pp := a%fp
   pp := pp + 1 
   fp := fp + 1
$)1

let left () be $(1
   ok := true
   if pp = lbeg then $(2
      ok := false
      return
   $)2
   fp := fp - 1
   pp := pp - 1
   a%fp := a%pp
$)1

let right.star() be $(
   until fp = lend do $(2
      a%pp := a%fp
      pp := pp + 1
      fp := fp + 1
   $)2
$)

let left.star() be $(
   until pp = lbeg do $(2
      fp := fp - 1
      pp := pp - 1
      a%fp := a%pp
   $)2
$)

let move () be $(1
   ok := true
   right.star ()
   if fp = fend then $(2
      ok := false
      return
   $)2
   a%pp := a%fp
   pp := pp + 1
   fp := fp + 1
   lbeg := pp
   lend := fp
   while a%lend \= cr do
      lend := lend + 1
   ms.back := -1
$)1

let move.back() be $(1
   ok := true
   left.star ()
   if pp = fbeg then $(2
      ok := false
      return
   $)2
   fp := fp - 1
   pp := pp - 1
   a%fp := a%pp
   lend := fp
   lbeg := pp
   lbeg := lbeg - 1 repeatuntil a%lbeg = cr
   lbeg := lbeg + 1
   ms := -1
$)1

let move.star () be $(1
   until fp = fend do $(2
      a%pp := a%fp
      pp := pp + 1
      fp := fp + 1
   $)2
   lend := fend
   lbeg := pp
   lbeg := lbeg - 1 repeatuntil a%lbeg = cr
   lbeg := lbeg + 1
   ms.back := -1
$)1

let move.back.star () be $(1
   until pp = fbeg do $(2
      fp := fp - 1
      pp := pp - 1
      a%fp := a%pp
   $)2
   lbeg := fbeg
   lend := fp
   while a%lend \= cr do
      lend := lend + 1
   ms := -1
$)1

let insert () be $(1
   let p = pointer
   ml.back := pp
   until text%p = 0 do $(2
      a%pp := text%p
      pp := pp + 1
      p := p+1
   $)2
   ms.back := pp
   ms := -1
$)1

let insert.back () be $(1
   let p = pointer
   ml := fp
   until text%p = 0 do $(2
      fp := fp - 1
      a%fp := text%p
      p := p + 1
   $)2
   ms := fp
   ms.back := -1
$)1

let verify() be $(1
   let x = ?
   let y = ?
   let test.sym = ?
   let sym = ?
   x := pointer - 1
   y := -1
   $(2
      x := x + 1
      y := y + 1
      sym := case.op (text%(x))
      test.sym := case.op (a%(fp + y))
   $)2 repeatwhile sym = test.sym
   unless sym = 0 then $(2
      ok := false
      return
   $)2
   ms := fp
   mlen := y
   ml := fp + mlen
   ok := true
   ms.back := -1
$)1

let verify.back () be $(1
   let x = ?
   let y = ?
   let test.sym = ?
   let sym = ?
   x := pointer - 1
   y := 0
   $(2
      x := x + 1
      y := y + 1
      sym := case.op (text%x)
      test.sym := case.op (a%(pp - y))
   $)2 repeatwhile sym = test.sym
   unless sym = 0 then $(2 
      ok := false
      return
   $)2
   ms.back := pp
   mlen := y - 1
   ml.back := pp - mlen
   ok := true
   ms := -1
$)1

let find() be $(1
   let sym = text%pointer | casebit
   pp.before := pp
   limit := lim!this.unit
   if fp = ms then $(2
      right ()
      unless ok then move()
   $)2
   $(2
      if (a%fp | casebit) = sym then $(3
         verify ()
         if ok then return
      $)3
      right ()
      if not ok then $(3
         limit := limit - 1
         if limit = 0 then break
         move ()
         if not ok then break
      $)3
   $)2 repeat
/*
   UNTIL pp = pp.before DO $(2
      left ()
      IF NOT ok THEN move.back()
   $)2
*/
   ok := false
$)1

let find.back () be $(1
   fp.before := fp
   limit := lim!this.unit
   if pp = ms.back then $(2
      left ()
      if not ok then move.back ()
   $)2
   $(2
      verify.back ()
      if ok then return
      left ()
      if not ok then $(3
         limit := limit - 1
         if limit = 0 then break
         move.back ()
         if not ok then break
      $)3
   $)2 repeat
/*
   UNTIL fp = fp.before DO $(2
      right ()
      IF NOT ok THEN move ()
   $)2
*/
   ok := false
$)1

.  // End of ECCE3