SECTION "E1"

GET ".ECCE-HDR"
GET ".SFO-HDR/3/S"

LET next_ch() = VALOF
/* RETURN next character from cmd_line and place it in 'SYM'.
   Return 'SYM' if successfull,
          '*N' if end of line.
*/
{1 sym:= cmd_pos>cmd_line!0 -> '*N', cmd_line!cmd_pos
   RESULTIS sym
}1


LET skip_ch() BE
   UNLESS cmd_pos>cmd_line!0 DO cmd_pos+:=1

LET read_ch() = VALOF
/* As for 'NEXT_CH' but advances cmd_pos by one character position.
*/
{1 IF next_ch()='*N' RESULTIS '*N'
   skip_ch()
   RESULTIS sym
}1

 
LET badsyntax(err, command, punctuation) BE
{1
     LET s = VALOF SWITCHON err INTO
     {    CASE 1: RESULTIS "Command "
          CASE 2: RESULTIS "Text for "
          CASE 3: RESULTIS "Too long"
          CASE 4: RESULTIS "Overflow"
          CASE 5: RESULTIS "Brackets"
          CASE 6: RESULTIS "Macro recursion"
          CASE 7: RESULTIS "Undefined: "
          CASE 8: RESULTIS "Failure: "
     }
     writes(s)
     UNLESS command=0 DO
        wrch(command<0 -> -command, command)
     UNLESS punctuation=0 DO wrch(punctuation)
     newline()

     UNTIL sym='*N' DO read_ch()         // skip to end of line
     resetmacros()
     condcode:=condcode|2
     longjump(pars.level, pars.return)      // RETURN to parse LOOP
}1


AND on.eof.DO() BE
{1 selectinput(withstream)
   endread()
   withstream:=findinput("WITH") REPEATUNTIL withstream>=0 
   IF null_stream(withstream) THEN
   {  close_down()
      stop(0)
   }
   selectinput(withstream)
}1

AND next_sym() = VALOF
{1 WHILE macroptr \= 0 & macroptr!0='*N' DO 
   {  mspos:=mspos-1
      macroptr:=macrostack!mspos
   }
   sym:= macroptr=0 -> next_ch(), macroptr!0 
   RESULTIS sym
}1

AND skip_sym() BE
     TEST macroptr=0 THEN skip_ch() 
     ELSE macroptr:=macroptr+1

AND read_sym() = VALOF
{1 next_sym()
   skip_sym()
   RESULTIS sym
}1

AND typemap(symbol) = 
     (symbol-'!')!table
     //   !  "  #  $  %  &  '  (  )  *  +  ,  -  .  /
     //   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  [  \
     //   ]  ^  _  `
          0, 0, 0, 0,15, 0, 1, 8, 9,12,16, 8,14, 0, 0,
         12,12,12,12,12,12,12,12,12,12, 0,10, 0, 0, 0,
         13, 0, 2, 2, 3, 6, 3, 7, 2, 2, 5, 2, 3, 2, 3,
          1, 4, 2, 0, 2, 4, 6, 6, 4,11,11,11,11, 0,13,
          0, 0, 0, 0

AND next_item() = VALOF
{1
     WHILE next_sym() <= ' ' DO skip_sym()
     IF sym='*N' THEN 
     {  type:=10
        RESULTIS type
     }

     sym:=upperCASE(sym)                          // convert to upper CASE

     type:=typemap(sym)
     RESULTIS type
}1

AND next_token(macro_e) = VALOF
{1 
   {  UNLESS next_item()=11 & macro_e  RESULTIS type
      skip_sym()
      macrocall(sym)
   } REPEAT
}1

AND read_token(macro_e) = VALOF
{1 next_token(macro_e)
   TEST 12<=type<=13
   THEN readnum()
   ELSE skip_sym()
   RESULTIS type
}1

AND checkeol() BE
{1
     IF next_sym() <= '*S' DO read_token(TRUE)
     UNLESS sym='*N' | SYM=';'
     DO badsyntax(1,0,'?')
}1


AND macrostart(sym) = (sym-'W')*mdefmax+macrodef

AND macrocall(name) BE
{1
     LET defn=macrostart(name)
     IF defn!0='*N' THEN badsyntax(7,name,0)
     IF mspos>=macromax THEN badsyntax(6,0,'!')

     macrostack!mspos:=macroptr
     mspos:=mspos+1
     macroptr:=defn
}1


AND resetmacros() BE
{1
     macrostack!0:=0                              // to terminate 'UNWIND'
     macroptr, mspos:= 0,1
}1


AND readstring(fspec) BE
{1 FOR i=1 to fspecmax DO
   {  IF read_sym()='*N' THEN
      {  fspec%0:=i-1
         RETURN
      }
      fspec%i:=sym
   }
}1

 
AND specialcom() BE
{1   LET ptr=0 
     LET c= ?

     skip_sym()
     read_token(FALSE)
     SWITCHON sym INTO
     {                                                                     
          CASE '%':
                    checkeol()
                    work_stats()
                    RETURN

          CASE 'A': 
                    condcode:=8
                    wind_up(abort_run)
                    RETURN

          CASE 'C': 
                    wind_up(close_run)
                    RETURN

          CASE 'E':
                    wind_up(exit_run)
                    RETURN

          CASE 'F': CASE 'M': CASE 'Q':           // monitoring control
          {    LET c=sym
               checkeol()
               monflag:=c
               RETURN
          }
          CASE 'H': 
               TEST read_token(FALSE) = 10 THEN
               {  checkeol()
                  horiz.start:=0
               }
               ELSE
               {  UNLESS (sym='=') &
                         next_token(FALSE)=12 DO badsyntax(1,0,'?') 
                  read_token(FALSE)
                  IF num>line_bsz THEN badsyntax(1,0,'?')
                  checkeol()
                  horiz.start:=num
               }
               RETURN
 
          CASE 'L':
               checkeol()
               uc_terminal := FALSE
               RETURN

          CASE 'O':                               // connect so_stream.
               TEST next_token(FALSE) = 10 THEN
               {  connect_so(0, 0)                // disconnect.
                  skip_sym()
               }
               ELSE
               {  LET fspec = VEC fspecmax/bytesperword
                  UNLESS sym = '=' DO badsyntax(1, 0, '?')
                  skip_sym()
                  readstring(fspec)
                  IF fspec%0 = 0 THEN badsyntax(1, 0, '?')
                  connect_so(fspec, page_buffs+page_csz)
               }
               RETURN
 
          CASE 'P':                               // prompt control
               checkeol()
               prompting := ~prompting
               RETURN
 
          CASE 'R':                               // remark (comment)
               until read_sym() = '*N' DO 
                  wrch(sym) 
               newline()
               RETURN

          CASE 'S':                               // secondary input
               TEST next_token(FALSE)=10 THEN
               {    UNLESS switch_sin() DO badsyntax(8,'%','S')
                    monitorline(TRUE)
                    skip_sym()
               }
               ELSE
               {  UNLESS sym = '=' DO badsyntax(1,0,'?')
                  {    LET fspec = VEC (fspecmax/bytesperword)+1
                       skip_sym()
                       readstring(fspec)
                       IF fspec%0 = 0 THEN badsyntax(1, 0, '?')
                       connect_sin(fspec, page_buffs) 
                  }
               }
               RETURN

          CASE 'U':
               checkeol()
               uc_terminal := TRUE
               RETURN

          CASE 'V':
               read_token(FALSE)
               SWITCHON sym INTO
               {    CASE 'W': CASE 'X': CASE 'Y': CASE 'Z': 
                    {    LET c=sym
                         checkeol()
                         ptr:=macrostart(c)
                         writef("Macro %C ",c)
                         TEST ptr!0 = '*N' THEN writes("is undefined")
                         ELSE
                         {  writes("= ")
                            UNTIL ptr!0 = '*N' DO
                                 {  wrch(ptr!0); ptr:=ptr+1 }
                         }
                         newline()
                         RETURN
                    }

                    CASE '=':
                         checkeol()
                         writef("Line: %N, character: %n", cur_line, cursor)
                         UNLESS cur_tag = null
                         DO writef(" tag: %c (%n)", cur_tag, tag_pos)
                         newline()
                         RETURN

 
                    CASE 'S':
                         writes("Secondary input file is ")
                         TEST sin_stream < 0 THEN writes("undefined*N")
                         ELSE print_filespec(sin_stream)
                         RETURN

                    CASE 'O':
                         writes("Secondary output file is ")
                         TEST so_stream < 0 THEN writes("undefined*N")
                         ELSE print_filespec(so_stream)
                         RETURN

                    CASE 'N':
                         value_n()   // display value of noted position.
                         RETURN

                    DEFAULT: badsyntax(1,0,'?')
               }

         CASE 'W': CASE 'X': CASE 'Y': CASE 'Z':  // macro definition
         {     LET c=sym
               read_token(FALSE)
               UNLESS sym = '=' DO badsyntax(1,0,'?')
               ptr:=macrostart(c)
               
               FOR i=0 to mdefmax-1 DO
               {  ptr!i:=read_sym()
                  IF sym='*N' THEN RETURN
               }
               ptr!0:='*N'
               badsyntax(3,0,'!')

          DEFAULT: badsyntax(1,0,'?')
     }
}1


AND unchain() = VALOF
{1
     LET old = 0
     {    IF chain=0 THEN badsyntax(5,0,'?')
          old:=chain
          chain:=chain!c.text
          old!c.text:=cptr                        // ptr to ')'
          IF old!c.code = 'X' THEN RESULTIS old
     } REPEAT
}1


AND builddesc (code, lim, text, rep, flags) BE 
{1
     IF cptr+c.size > tptr THEN badsyntax(3,0,'!')

     cptr!c.code, cptr!c.lim:=code, lim
     cptr!c.text, cptr!c.repno:=text,rep
     cptr!c.flags:=flags
     cptr:=cptr+c.size
     RETURN
}1


AND readnum() = VALOF
{1
     SWITCHON read_sym() INTO
     { 
          CASE '**': CASE '0': num:=star; ENDCASE 
          CASE '?': num:=1; ENDCASE
          CASE '\': num:=1; flags|:=sbit_invert; ENDCASE
          DEFAULT:
               num:=sym-'0'
               WHILE '0'<=next_sym()<='9' DO 
               { 
                    num:=num*10+sym-'0'
                    skip_sym()
                    UNLESS 0<=num<=max_no THEN badsyntax(4,0,'!')
               }
               RESULTIS num
     }
     flags |:= sbit_ignore  // set for ignore AND invert conditions.
     RESULTIS num
}1


AND accepttext() BE
{1
     LET term, ptr, count=sym, tptr, 0
     skip_sym()

     IF term = '"' THEN
     {  text := -1
        RETURN
     }

     IF term = '@' THEN
     {  text := read_sym()
        IF sym = '*N' THEN badsyntax(2, code, '?')
        flags |:= sbit_tag
        RETURN
     }

     {    TEST next_sym()='*N' THEN 
          { 
               IF cmd_type>5 THEN badsyntax(2,code,'?')
               BREAK
          }
          ELSE IF sym=term THEN 
          {  skip_sym()
             BREAK
          }

          tptr:=tptr-1
          tptr!0:=sym
          skip_sym()
          count:=count+1
     } REPEAT
     IF count=0 & cmd_type \= 4
     THEN badsyntax(2,code,'?')
     tptr:=tptr-1                                 // next free location
     ptr!0:=count
     text:=ptr
}1

AND acceptplus() BE
   IF next_token(TRUE) = 16 THEN
   {  code := -code
      skip_sym()
   }

AND acceptminus() BE
     IF next_token(TRUE) = 14 THEN
     {  code:=-code
        skip_sym()
     }
 
AND acceptnum(n) BE
   IF 12<=next_token(TRUE)<=13 THEN
   {  read_token(TRUE)
      !n:=num
   }

AND decodecommand () BE
{1   cmd_type:=read_token(TRUE)
     code:=sym
     SWITCHON cmd_type INTO
     { 
        CASE 9:
          text:=unchain()
          code:='Z'
          acceptnum(@(text!c.repno))
          RETURN

        CASE 8:
          code:= code='(' -> 'X', 'Y'
          text:=chain
          chain:=cptr
          RETURN

        CASE 7:
          acceptminus()
          searchlim:=0

        CASE 6:
          acceptnum(@searchlim)
          IF type=13 THEN badsyntax(1,0,'?')
          flags:=0       // in case '*' specified for searchspace.
  
        CASE 5: CASE 4:
          IF code = 'V' THEN acceptplus()
          UNLESS next_token(TRUE)=0 DO badsyntax(2,code,'?')
          accepttext()

        CASE 2:
          acceptnum(@repno)
          IF cmd_type=4 & type=12
          THEN badsyntax(1,0,'?')
          RETURN

        CASE 3:
          acceptminus()
          acceptnum(@repno)
          RETURN

          CASE 1:
                RETURN

          DEFAULT:
          badsyntax(1,code='*N' -> 0, code,'?')
     }
}1

AND system_call() BE
{1 LET v = VEC fspecmax/bytesperword
   skip_sym()
   readstring(v)
   TEST v%0 = 0 THEN sys_return()
   ELSE 
   {  TEST v%0 = 1  & typemap(v%1) = 11 THEN
      {  macrocall(v%1)
         readstring(v)    // macro expansion.
      }
      ELSE IF v%0 = 1 & v%1 = '!' THEN
      {  sys_command(sys_line)
         RETURN
      }
      copy_string(v, sys_line)
      sys_command(sys_line)
   }
}1
 
AND unwind() BE
{1 LET n = ?
   
   skip_sym()
   next_token(FALSE)
   TEST type = 10 THEN
   {  checkeol()
      n := 1
   }
   ELSE TEST type = 12 THEN
   {  read_token(FALSE)
      checkeol()
      n := num
   }
   ELSE badsyntax(1, 0, '?')
   
   UNLESS undo(n) DO writef("Undo incomplete*N")
}1
 
AND initcline(cline) BE
{1   cptr, tptr:= cline, cline+clinemax
     validlast:=FALSE
     chain:=cline
     builddesc('X',1,0,1,0)
}1

 
AND parseline(cmds, cline) = VALOF
{1   pars.level:=level()
     pars.return:=parsereturn         // 'badsyntax' uses longjump to here
     cmd_line:=!cmds
     IF cmd_line!0=0 & macroptr=0 RESULTIS FALSE 
     cmd_pos:=1
     {  next_token(TRUE)
        IF sym=',' | sym=';' THEN
        {  skip_sym()
           LOOP
        }

        IF sym = '!' THEN
        {  system_call()
           LOOP
        }

        IF sym = '%' THEN
        {  specialcom()
           LOOP
        }

        IF sym = '-' THEN
        {  unwind()
           LOOP
        }

        IF 12<=type<=13 THEN
        {    UNLESS validlast DO badsyntax(1,0,'?')
             read_token(TRUE)
             checkeol()
             cline!c.repno:=num
             BREAK
        }
        IF sym='*N' RESULTIS FALSE
     
        initcline(cline)
        {    text, searchlim, repno, flags := 0, 1, 1, 0
             decodecommand()
             builddesc(code,searchlim,text,repno,flags)
        } REPEATUNTIL next_token(TRUE)=10

        unchain() // result is 'CLINE' 
        UNLESS chain=0 DO badsyntax(5,0,'?')
        builddesc('Z',1,cline,1,0)
        builddesc(0)                       // tie off commands
        validlast:=TRUE
        BREAK
     } REPEAT

     cmd_line!(cmd_pos-1):=cmd_line!0-cmd_pos+1
     !cmds:=cmd_line+cmd_pos-1 
     RESULTIS TRUE
parseRETURN:
     RESULTIS FALSE
}1


/* debug++
AND displaycommandline(line) BE
{1
     LET cptr=line
     AND code=cptr!c.code
     until code=0 DO
     {    LET tptr=cptr!c.text
          wrch(code)
          writen(cptr!c.lim)
          wrch(' ')

          TEST tptr=0 | code='X' | CODE='Y' | CODE='Z' THEN
               writen(tptr)
          ELSE
          {    LET count=tptr!0
               tptr:=tptr-1
               wrch('*'')
               until count<=0 DO
               {    wrch(tptr!0)
                    tptr:=tptr-1
                    count:=count-1
               }
               wrch('*'')
          }
          wrch(' ')
          writen(cptr!c.repno)
          wrch(' ')
          cptr:=cptr+c.size
          code:=cptr!c.code
     }
     newline()
}1

=========== end of debug code ============ */

AND failmessage(fptr) BE
{1
     LET code, lim= fptr!c.code, fptr!c.lim
     LET text, rep= fptr!c.text, fptr!c.repno
     LET flags = fptr!c.flags
     writes("Failure: ")
     TEST code='Z' THEN writes("(..)\")
     ELSE
     { 
     TEST code<0 THEN
     {    code:=-code
          wrch(code)
          wrch(code = 'V' -> '+', '-')
     }
     ELSE wrch(code)
     UNLESS lim=1 & code\='F' DO
     TEST lim=star THEN WRCH('**')
     ELSE UNLESS code='F' & lim=0 DO writen(lim) 

     TEST text < 0 THEN wrch('"')
     ELSE UNLESS text=0 | code >='X' DO
     {    TEST (flags & sbit_tag) \= 0 THEN 
          {  wrch('@')
             wrch(text)
          }
          ELSE
          {
             wrch('*'')
             FOR i=1 to text!0 DO
                  wrch(text!-i)
             wrch('*'')
          }
     }

     TEST (flags & sbit_invert) \= 0 THEN wrch('\') 
     ELSE UNLESS rep=1 DO writen(rep)
     }
     newline()
     condcode|:=4
}1

AND wind_up(opt) BE
{1 checkeol()
   IF close_down(opt) = 0 THEN stop_prog(condcode)
}1
 
AND stop_prog(code) BE
{1 condcode := (code>8 | batch -> code, 0)
   longjump(stop_level, stop_lab)
}1

AND recover() BE
/* This is called by module "E3" on detecting either an error on the 
   workfile or cell overflow. It attempts to tidy up to a defined state
   and then jumps to a recovery label in order to return to command
   level.
*/
{1 // No need to worry if we were doing an abstract_in when overflow occured
   // since secondary input will be disabled anyway and 'switch_sin' will
   // restore the correct line.

   UNLESS w_space = 0 DO make_space(FALSE) 

   UNLESS sin DO cue := ">"     // in case failed during 'get'.

   IF file_in_stream = fromstream THEN
   {  close(fromstream) 
      file_in_stream := 0
      fromstream := errorvalue
      selectinput(withstream)
      selectoutput(outstream)
      print_byte_count()
   }
   disable_interrupt()  // else user will loose next char.
   longjump(stop_level, recover_lab)
}1
 
AND start() BE
{1 
   MANIFEST
   {  num.streams=3
      streams.space=num.streams*sfo.entrysize+maxstreamno
      page.buff.size = 11 // 10 pages for FROM & TO plus 1 page for LOG.
   }
   LET v = VEC mdefmax*macromax
   macrodef:=v
   { LET v = VEC fspecmax/bytesperword
     sys_line := v
   { LET v = VEC line_bsz
     quote_text := v
   { LET v = VEC 1000
     undo_stack := v
   { LET v = VEC macromax+1
     macrostack:=v
   { LET v = VEC (block_csz*3)+256+9     // three pages - page aligned
     work_space:=((v+256) >> 8) << 8
   { LET v = VEC 200
     proforma:=v
   { LET v = VEC line_bsz
     line:=v
   { LET cline = VEC clinemax 
     LET fspec = VEC 19
     LET streamvec = VEC streams.space
     LET v = VEC page.buff.size*page_csz+256
     LET cmds = VEC cmd_max
     LET p = "ECCE FROM 0 TO 0 [] WITH 0 [****] WORK 0 [/(S200)] *
             *OUT 0 [**M] LOG 0 [/(S20).ECCE-LOG] OPT 252 []" 
     {  LET R = INIT_PROFORMA(p, proforma, 200) 
        IF R<0 THEN stop_prog(8)
     }

     page_buffs := ((v+256)>>8)<<8
     stop_level := level()
     stop_lab := stoplabel
     recover_lab := recoverlabel

     monflag:='M'
     condcode:=0                                  // no errors yet!!!

     resetmacros()
     FOR i=0 to mdefmax*3 BY mdefmax DO macrodef!i:='*N'
     validlast:=FALSE

     cue := ">"
     horiz.start:=0
     sys_line%0 := 0     // initially empty.
     uc_terminal := FALSE  // assume a lower case terminal.
     
     init.sfo(num.streams,streamvec)
     find_args(fspec)
     prompting := vdu_stream(withstream)  // TRUE if interactive device.
     selectoutput(outstream)
     selectinput(withstream)

     {  LET today = VEC 5
        LET now = VEC 5

        date(today)
        timeofday(now)
        writef("ECCE Mk:%N Issue:%N%C on %S at %S*N", mark, issue,
                subissue, today, now)
     }
     //
     // The following order or calls for initialisation is important since
     // 'start_e2' may not return if a workfile error is detected and
     // if 'start_e6' were after then it would'nt be called.
     //
     start_e6(fromptr, page_buffs)  // connect secondary input to main.
     start_e2()

 
// Come here after call on 'recover' due to major system error.
recoverlabel:
     {    LET failptr, r = ?, ?
          LET cmd_ptr=cmds

          r:=get_line(cmds, cmd_max) 
          IF r = errorvalue THEN
             { on.eof.do(); LOOP }

          WHILE parseline(@cmd_ptr, cline) DO
          {
//debug++ displaycommandline(cline)
             failptr:=execute(cline)
             UNLESS failptr=0 DO failmessage(failptr)
             monitorline(FALSE)
          }
     } REPEAT
// Only come here on exit via procdure 'stop_prog'.
stoplabel:
     stop(condcode)
}1