(Message 209)
Subject:  Ecce.pas MTS version
From:     Harry_Whitfield  <CL11 @ UK.AC.NEWCASTLE.MTS>
Date:     Thu, 25 Jun 87 15:50:49 GMT
To:       P.D.Stephens @ UK.AC.EDINBURGH
Via:      UK.AC.EDINBURGH.EMAS-A  ; (to uk.ac.edinburgh.emas-b) 25 Jun 87  15:51:36 bst
Via:      UK.AC.NEWCASTLE.MTS  ; (to uk.ac.edinburgh.emas-a) 25 Jun 87  15:51:16 bst
Msg ID:   <sent 25 Jun 87 15:50:49 GMT via NCL.MTS>

{*****************************************************************************}
{**                                                                         **}
{**    Title:   Edinburgh Editor Ecce for MTS                               **}
{**    Author:  H.Whitfield                                                 **}
{**    Date:    17 November 1985                                            **}
{**             Copyright (c) H.Whitfield 1985                              **}
{**                                                                         **}
{*****************************************************************************}
 
 
PROGRAM Ecce( input, output, InFile, OutFile );
 
LABEL 
  999;   { stop }
 
CONST 
  cmax = 121;
  stop = -5000;
  inv  = -5001;
  lmax = 2048;  { maximum line length }
 
  FirstCol   =  1;
  LastCol    = 80;
  LineLength = 80;
  ParsLength = 20;
 
TYPE 
  ComIndex  = 0..cmax;
  ComBuff   = ARRAY [ ComIndex ] OF integer;
 
  ColIndex  = FirstCol..Lastcol;
  Lines     = PACKED ARRAY [ ColIndex ] OF char;
 
VAR 
  InFile, OutFile : text;
 
  InFileName, OutFileName : Lines;
 
  nl, lastsymbol, prompt, sym : char;
 
  mon : integer;
 
  clim : ComIndex;
 
  prompted : boolean;
 
  C : ComBuff;
 
 
FUNCTION FNnextsymbol : char;
BEGIN 
  IF ( lastsymbol = nl ) AND ( NOT prompted ) THEN
  BEGIN
    IF prompt <> ' ' THEN writeln( prompt );
    prompted := true; get( input )
  END;
  IF eoln THEN FNnextsymbol := nl ELSE FNnextsymbol := input@
END; { FNnextsymbol }
 
 
FUNCTION FNreadsymbol : char;
VAR 
  sym : char;
BEGIN 
  sym := FNnextsymbol;
  lastsymbol := sym; IF sym = nl THEN prompted := false ELSE get( input );
  FNreadsymbol := sym
END; { FNreadsymbol }
 
 
PROCEDURE PROCskipsymbol;
VAR 
  sym : char;
BEGIN 
  sym := FNreadsymbol
END; { PROCskipsymbol }
 
 
PROCEDURE PROCreadcommand;
CONST
  tbase = 1;
TYPE
  itemtype = -1..10;
VAR 
  itype, i : itemtype;
  code, quote : char;
  num, matchlim, chain : integer;
  done, again, error : boolean;
  Ti, Ci, txt : ComIndex;
 
FUNCTION FNlower( ch : char ) : char; { Ascii and Ebcdic }
BEGIN 
  IF ( ( 'a' <= ch ) AND ( ch <= 'i' ) ) OR
     ( ( 'j' <= ch ) AND ( ch <= 'r' ) ) OR
     ( ( 's' <= ch ) AND ( ch <= 'z' ) )
  THEN FNlower := chr( ord(ch)-ord('a')+ord('A') ) ELSE
  IF ch = '`' THEN FNlower := '@' ELSE
  IF ch = '{' THEN FNlower := '[' ELSE
  IF ch = '|' THEN FNlower := '\' ELSE
  IF ch = '}' THEN FNlower := ']' ELSE
  IF ch = '~' THEN FNlower := '^' ELSE FNlower := ch
END; { FNlower }
 
FUNCTION FNnextitemtype : itemtype;
VAR 
  result : itemtype;
 
PROCEDURE PROCreadnum;
VAR 
  ch : char;
BEGIN 
  num := ord(sym)-ord('0'); ch := FNnextsymbol;
  WHILE ( '0' <= ch ) AND ( ch <= '9' ) DO
  BEGIN
    num := 10*num + ord(ch) - ord('0');
    PROCskipsymbol;
    ch := FNnextsymbol
  END 
END; { PROCreadnum }
 
BEGIN { FNnextitemtype }
  REPEAT sym := FNreadsymbol UNTIL sym <> ' ';
  sym := FNlower( sym );
 
  IF sym < ' ' THEN result := 1 ELSE
  CASE sym OF
    ';' : result := 1;
    '(' : result := 2;
    ',' : BEGIN IF FNnextsymbol=nl THEN PROCskipsymbol; result := 3 END;
    ')' : result := 4;
    'I', 'S' : result :=5;
    'D' : result := 6;
    'F', 'T', 'U' : result := 7;
    'V' : result := 8;
    'E', 'M' : BEGIN
                 IF FNnextsymbol = '-' THEN
                 BEGIN
                   PROCskipsymbol;
                   IF sym = 'E' THEN sym := 'O' ELSE sym := 'W'
                 END;
                 result := 9
               END;
    'B', 'G', 'J', 'K', 'L', 'P', 'R' : result :=9;
    'A', 'C', 'H', 'N', 'O', 'Q', '-', 'W', 'X', 'Y', 'Z' : result := 10;
    '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' :
      BEGIN PROCreadnum; result := 0 END;
    '*' : BEGIN num := 0; result := 0 END;
    '?' : BEGIN num := stop + 1; result := 0 END;
    '\', '^' : BEGIN num := inv + 1; result := 0 END;
    '!', '"', '#', '$', '%', '&', '''', '+', '.', '/', ':', '<','=','>',
    '@', '[', ']', '_' : result := -1
  END; { CASE }
 
  FNnextitemtype := result
END; { FNnextitemtype }
 
 
PROCEDURE PROCunchain;
VAR 
  finished : boolean;
BEGIN 
  txt := chain;
  IF txt <> 0 THEN
  BEGIN
    finished := false;
    REPEAT
      chain := C[ txt ]; C[ txt ] := Ci;
      IF C[ txt + 1 ] <> ord( 'Y' ) THEN txt := chain ELSE finished := true
    UNTIL ( txt = 0 ) OR finished
  END 
END; { PROCunchain }
 
 
PROCEDURE PROCstack( v : integer );
BEGIN 
  Ci := Ci - 1; C[ Ci ] := v
END; { PROCstack }
 
 
PROCEDURE PROCpush;
BEGIN 
  PROCstack( 256*matchlim + ord(code) ); PROCstack( txt ); PROCstack( num )
END; { PROCpush }
 
 
PROCEDURE PROCerror( n : integer );
BEGIN 
  IF n <> 6 THEN
  BEGIN
    CASE n OF
    0 : BEGIN write( ' ', code ); code := sym END;
    1 : code := sym;
    2 : code := '(';
    3 : write( ' Text for' );
    5 : ;
    END; { CASE }
    writeln( ' ', code, '?' )
  END ELSE writeln( ' Too Long' );
  IF Ci <> cmax THEN clim := 0;
  WHILE sym <> nl DO sym := FNreadsymbol;
  error := true
END; { PROCerror }
 
 
PROCEDURE PROCqstring;
BEGIN 
  IF ( itype >= 0 ) OR ( txt <> 0 ) THEN PROCerror( 3 ) ELSE
  BEGIN
    quote := sym; txt := Ti;
    WHILE ( FNnextsymbol <> quote ) AND ( FNnextsymbol <> nl ) AND
          ( NOT error ) DO
    BEGIN
      sym := FNreadsymbol; C[ Ti ] := ord( sym ); Ti := Ti+1;
      IF Ti = Ci THEN PROCerror( 6 );
    END;
    IF NOT error THEN
    BEGIN
      IF FNnextsymbol = nl THEN
      BEGIN
        IF ( code <> 'I' ) AND ( code <> 'S' ) THEN PROCerror( 3 )
      END ELSE sym := FNreadsymbol;
      IF NOT error THEN
      BEGIN
        IF ( Ti = txt ) AND ( code <> 'S' ) THEN PROCerror( 3 ) ELSE
        BEGIN
          C[ Ti ] := 0; Ti := Ti+1;
          itype := FNnextitemtype;
          IF itype = 0 THEN itype := FNnextitemtype;
          PROCpush
        END
      END
    END
  END 
END; { PROCqstring }
 
 
BEGIN { PROCreadcommand }
  done := false;
  REPEAT
    again := false; error := false;
    prompt := '>';
    REPEAT itype := FNnextitemtype UNTIL itype <> 1;
    Ci := cmax; Ti := tbase; chain := 0;
 
    IF ( itype = 0 ) AND ( clim <> 0 ) THEN { repeat last command }
    BEGIN
      C[ clim ] := num;
      IF FNnextitemtype = 1 THEN done := true ELSE PROCerror( 1 )
    END ELSE
 
    IF sym = '%' THEN
    BEGIN
      sym := FNlower( FNreadsymbol ); code := sym; matchlim := 0;
      itype := FNnextitemtype;
      IF itype <> 1 THEN PROCerror( 1 ) ELSE
      IF code = 'C' THEN PROCpush ELSE
      IF ( code = 'Q' ) OR ( code = 'M' ) OR ( code = 'F' ) THEN
        BEGIN mon := ord('M')-ord(code); again := true END ELSE PROCerror( 1)
    END ELSE
 
    REPEAT
      IF itype <= 0 THEN PROCerror( 1 ) ELSE
      IF Ci-4 <= Ti THEN PROCerror( 6 ) ELSE
      BEGIN
        code := sym; matchlim :=0; txt := 0;
        IF code = 'F' THEN num := 0 ELSE num := 1;
        i := itype; itype := FNnextitemtype;
        CASE i OF
 
        2 : BEGIN                                     { left bracket }
              code := 'Y';
              txt := chain; chain := Ci - 2;
              PROCpush
            END;
 
        3 : BEGIN                                     { comma }
              num := inv; code := 'Z';
              txt := chain; chain := Ci - 2;
              PROCpush
            END;
 
        4 : BEGIN                                     { right bracket }
              PROCunchain;
              IF txt = 0 THEN PROCerror( 5 ) ELSE
              BEGIN
                C[ txt ] := Ci - 3; txt := txt -1;
                C[ txt ] := num; code := 'Z';
                IF itype = 0 THEN itype := FNnextitemtype;
                PROCpush
              END
            END;
 
        5 :   PROCqstring;                            { insert,substitute }
 
        6 ,                                           { delete }
        7 : BEGIN                                     { find,traverse,uncover }
              matchlim := num; num := 1;
              IF itype = 0 THEN itype := FNnextitemtype;
              PROCqstring
            END;
 
        8 : PROCqstring;                              { verify }
 
        9 : IF itype < 0 THEN PROCerror( 0 ) ELSE     { all the others }
            BEGIN
              IF itype = 0 THEN itype := FNnextitemtype;
              PROCpush
            END;
 
        10: PROCerror( 5 )                            { invalid letters }
 
        END { CASE }
      END
 
    UNTIL  ( itype = 1 ) OR error;
 
    IF ( NOT done ) AND ( NOT again ) AND ( NOT error ) THEN
    BEGIN
      PROCunchain;
      IF txt <> 0 THEN PROCerror ( 2 ) ELSE
      BEGIN
        PROCstack( ord('Z') ); PROCstack( cmax ); PROCstack( 1 );
        clim := Ci; PROCstack( 0 ); done := true
      END
    END
  UNTIL done
END; { PROCreadcommand }
 
 
PROCEDURE PROCedit;
LABEL 
  99; { return }
CONST
  amax = 65535;
TYPE
  BuffIndex = 0..amax;
  Buffer    = PACKED ARRAY [ BuffIndex ] OF char;
VAR 
  top, pe, pp, fp, bottom, pp1, ms, ml, lim, p : BuffIndex;
  Ci, txt, i : Comindex;
  num, codelim, matchlim, k : integer;
  code, last, term, ch : char;
  printed, ok, done, failed : boolean;
  A : Buffer;
 
PROCEDURE  PROCmakespace;
VAR
  k : char;
  p1, p2 : BuffIndex;
BEGIN
  IF fp-pp-240 <= 0 THEN
  BEGIN
    p1 := top;
    IF code = 'C' THEN p2 := pe ELSE p2 := (p1+pe) DIV 2;
    IF p2 = top THEN
      BEGIN writeln( 'Fatal error in PROCmakespace' ); GOTO 999 END;
    REPEAT
      k := A[ p1 ];
      IF k <> nl THEN write( OutFile, k ) ELSE writeln( OutFile );
      p1 := p1+1
    UNTIL ( k = nl ) AND ( p1-p2 >= 0 );
    pe := top+pe-p1; p2 := pp; pp := top;
    WHILE p1 <> p2 DO
    BEGIN
      A[ pp ] := A[ p1 ]; pp := pp+1; p1 := p1+1
    END
  END
END; { PROCmakespace }
 
PROCEDURE PROCprintline;
VAR 
 p : BuffIndex;
BEGIN 
  printed := true;
  IF fp = bottom THEN writeln( '**END**' ) ELSE
  BEGIN
    IF pe = pp THEN p := fp ELSE p := pe;
    IF A[ p ] <> nl THEN write( A[ p ] ) ELSE writeln;
    WHILE A[ p ] <> nl DO
    BEGIN
      p := p + 1;
      IF ( p = pp ) AND ( num=0 ) THEN write ( '^' );
      IF p = pp THEN p := fp;
      IF A[ p ] <> nl THEN write( A[ p ] ) ELSE writeln;
    END
  END 
END; { PROCprintline }
 
PROCEDURE PROCreadline;
VAR 
  k : char;
BEGIN 
  printed := false;
  IF fp = bottom THEN
  BEGIN
    fp := lim - lmax; ms := 0;
    IF eof( InFile ) THEN
    BEGIN
      fp := lim; bottom := fp; A[ fp ] := nl
    END
    ELSE
    BEGIN
      REPEAT
        IF eoln( InFile ) THEN k := nl ELSE k := InFile@; get( InFile );
        A[ fp ] := k; fp :=fp + 1
      UNTIL ( k = nl ) OR eof( InFile ) OR ( fp = lim );
      IF k = nl THEN
      BEGIN
        bottom := fp; fp := lim - lmax
      END ELSE
      IF eof( InFile ) THEN
      BEGIN
        fp := lim; bottom := fp; A[ fp ] := nl
      END ELSE
      BEGIN
        IF eoln( InFile ) THEN get( InFile );
        A[ fp ] := nl; fp := fp + 1; bottom := fp; fp := lim - lmax
      END
    END
  END 
END; { PROCreadline }
 
 
PROCEDURE PROClefttab;
BEGIN 
  WHILE pp <> pe DO
  BEGIN
    fp := fp-1; pp := pp-1; A[ fp ] := A[ pp ]
  END 
END; { PROClefttab }
 
 
PROCEDURE PROCmove;
VAR 
  k : char;
BEGIN 
  PROCmakespace;
  REPEAT
    k := A[ fp ]; A[ pp] := k; pp := pp+1; fp := fp+1
  UNTIL k = nl;
  pe := pp;
  PROCreadline
END; { PROCmove }
 
PROCEDURE PROCmoveback;
VAR 
  k : char;
BEGIN 
  k := A[ pp-1 ];
  WHILE ( k <> nl ) OR ( pp = pe ) DO
  BEGIN
    fp := fp-1; pp := pp-1; A[ fp ] := k; k := A[ pp-1 ]
  END;
  pe := pp; ms := 0; printed :=false
END; { PROCmoveback }
 
FUNCTION FNmatched : boolean;
LABEL 
  1, 2, 5, 6, 7, 10, 15, 16, 99;
VAR 
  i, l, ind, t1 : integer;
  k : char;
  fp1 : Buffindex;
BEGIN 
    pp1 := pp; fp1 := fp; ind := matchlim; t1 := C[ txt ];
    IF ( fp <> ms ) OR ( ( code <> 'F' ) AND ( code <> 'U' ) ) THEN GOTO 2;
    k := A[ fp ];
1:  A[ pp ] := k; pp := pp+1; fp := fp+1;
2:  k := A[ fp ]; IF k = chr( t1 ) THEN GOTO 5;
    IF k <> nl THEN GOTO 1 ELSE GOTO 10;
5:  l := 1;
6:  i := C[ txt+l ]; IF i=0 THEN GOTO 7;
    IF A[ fp+l ] <> chr( i ) THEN GOTO 1;
    l := l+1; GOTO 6;
7:  ms := fp; ml := fp+l; FNmatched := true; GOTO 99;
10: ind := ind-1;
    IF ind = 0 THEN GOTO 15;
    IF fp = bottom THEN GOTO 16;
    IF code <> 'U' THEN
    BEGIN
      A[ pp ] := k; pp := pp+1; pe := pp
    END ELSE pp := pp1;
    fp := fp+1; PROCmakespace; PROCreadline; pp1 := pp; fp1 :=fp; GOTO 2;
15: pp := pp1; fp :=fp1;
16: FNmatched := false;
99: END; { FNmatched }
 
 
PROCEDURE PROCfail;
BEGIN 
  write( 'Failure: ');
  IF code = 'O' THEN BEGIN write( 'E' ); code := '-' END ELSE
  IF code = 'W' THEN BEGIN write( 'M' ); code := '-' END;
  IF code <> 'Z' THEN
  BEGIN
    write( code );
    IF txt > 0 THEN
    BEGIN
      write( '''' );
      WHILE C[ txt ] <> 0 DO
      BEGIN
        write( chr( C[ txt ] ) ); txt := txt+1
      END;
      write( '''' )
    END
  END;
  IF num = inv THEN write( '\' );
  writeln
END; { PROCfail }
 
 
PROCEDURE PROCinsert;
VAR 
  i : ComIndex;
BEGIN 
  PROCmakespace;
  IF ( pp-pe > 80 ) OR ( fp = bottom ) THEN ok := false ELSE
  BEGIN
    i := txt;
    WHILE C[ i ] <> 0 DO
    BEGIN
      A[ pp ] := chr( C[ i ] ); pp := pp+1; i := i+1
    END
  END 
END; { PROCinsert }
 
 
BEGIN { PROCedit }
  nl := chr( 13 ); lastsymbol := nl; prompted := false;
 
  mon := 0; printed := false;
  fp := 0; bottom := 0; ms := 0; ml := 0;
  top := 1; lim := amax; clim := 0;
  pp := top-1; A[ pp ] := nl; pp := pp+1; pe := pp;
 
  writeln( 'Ecce Editor' );
  PROCreadline;
 
  REPEAT
    failed := false;
    PROCreadcommand; term := sym;
    Ci := cmax; last := chr( 0 );
    codelim := C[ Ci-1 ];
 
    WHILE ( codelim <> 0 ) AND ( NOT failed ) DO
    BEGIN
      code := chr( codelim MOD 256 ); matchlim := codelim DIV 256;
      txt := C[ Ci-2 ]; num := C[ Ci-3 ]; Ci := Ci-3;
      done := false; ok := true;
      REPEAT
        num := num-1;
        CASE code OF { 'A' to 'Z' }
        'A' : { dummy };
        'B' : BEGIN
                A[ pp ] := nl; pp := pp+1; pe :=pp
              END;
        'C' : BEGIN
                WHILE fp <> bottom DO PROCmove;
                WHILE top <> pp DO
                BEGIN
                  ch := A[ top ];
                  IF ch <> nl THEN write( OutFile, ch ) ELSE writeln( OutFile );
                  top := top+1
                END;
                GOTO 99
              END;
        'D' : BEGIN
                ok := FNmatched; IF ok THEN fp := ml
              END;
        'E' : IF A[ fp ] = nl THEN ok := false ELSE fp := fp+1;
        'F' : ok := FNmatched;
        'G' : BEGIN
                IF prompt = '>' THEN prompt := ':' ELSE prompt := ' ';
                PROCmakespace; sym := FNreadsymbol;
                IF sym = ':' THEN ok := false ELSE
                BEGIN
                  PROClefttab;
                  A[ pp ] := sym; pp := pp+1; pe := pp;
                  WHILE sym <> nl DO
                  BEGIN
                    sym := FNreadsymbol;
                    A[ pp ] := sym; pp := pp+1; pe := pp
                  END
                END
              END;
        'H' : { dummy };
        'I' : PROCinsert;
        'J' : IF fp = bottom THEN ok := false ELSE
              BEGIN
                REPEAT
                  ch := A[ fp ]; A[ pp ] := ch; pp := pp+1; fp := fp+1
                UNTIL ch = nl;
                PROCreadline; pp := pp-1;
                IF ( pp-pe > 80 ) OR ( ( fp = bottom ) AND ( pp <> pe ) ) THEN
                BEGIN
                  pp := pp+1; pe := pp; ok := false
                END
              END;
        'K' : IF fp = bottom THEN ok := false ELSE
              BEGIN
                pp := pe; REPEAT fp := fp+1 UNTIL A[ fp-1 ] = nl;
                PROCreadline
              END;
        'L' : IF pp = pe THEN ok := false ELSE
              BEGIN
                fp := fp-1; pp := pp-1; A[ fp ] := A[ pp ]; ms := 0
              END;
        'M' : IF fp = bottom THEN ok := false ELSE PROCmove;
        'N' : { dummy };
        'O' : IF pp = pe THEN ok := false ELSE pp := pp-1;
        'P' : IF last <> 'P' THEN PROCprintline ELSE
              IF fp = bottom THEN ok := false ELSE
              BEGIN
                PROCmove; PROCprintline
              END;
        'Q' : { dummy };
        'R' : BEGIN
                ch := A[ fp ];
                IF ch = nl THEN ok := false ELSE
                BEGIN
                  A[ pp ] := ch; pp := pp+1; fp := fp+1
                END
              END;
        'S' : IF fp <> ms THEN ok := false ELSE
              BEGIN
                fp := ml; PROCinsert
              END;
        'T' : IF NOT FNmatched THEN ok := false ELSE
              BEGIN
                fp := ml; PROCinsert
              END;
        'U' : IF NOT FNmatched THEN ok := false ELSE pp := pp1;
        'V' : BEGIN
                p := fp; i := txt;
                k := C[ i ];
                WHILE ( k <> 0 ) AND ok DO
                BEGIN
                  IF A[ p ] <> chr( k ) THEN ok := false ELSE
                  BEGIN
                    p := p+1; i := i+1; k := C[ i ]
                  END
                END;
                IF ok THEN
                BEGIN
                  ms := fp; ml :=p
                END
              END;
        'W' : BEGIN
                PROCmakespace;
                IF pe = top THEN ok := false ELSE PROCmoveback
              END;
        'X' : { dummy };
        'Y' : BEGIN
                C[ txt ] := num+1; done := true
              END;
        'Z' : BEGIN
                IF num = inv THEN ok := false ELSE
                BEGIN
                  IF ( num <> 0 ) AND ( num <> stop ) THEN
                  BEGIN
                    C[ Ci ] := num; Ci := txt
                  END
                END;
                done := true
              END
        END; { CASE }
 
        IF ok AND ( NOT done ) THEN last := code;
 
      UNTIL ( num = 0 ) OR ( num = stop ) OR ( num = inv ) OR done OR NOT ok;
 
      IF ( ( ok <> done ) AND ( num = inv ) ) OR
         NOT ( done OR ok OR ( num < 0 ) ) THEN
      BEGIN
        REPEAT
          k := C[ Ci-1 ]; Ci := Ci-3;
          IF chr( k ) = 'Y' THEN Ci := C[ Ci+1 ]
        UNTIL ( k = 0 ) OR ( ( chr( k ) = 'Z' ) AND ( C[ Ci ] <= 0 ) );
        IF k = 0 THEN BEGIN PROCfail; failed := true END
      END;
 
      IF NOT failed THEN codelim := C[ Ci-1 ]
 
    END;
 
    IF term = nl THEN
    BEGIN
      num := 0;
      IF ( ( mon = 0 ) AND ( NOT printed ) ) OR
         ( ( mon > 0 ) AND ( last <> 'P' ) ) THEN PROCprintline
    END
 
  UNTIL false; { forever }
 
99: 
END; { PROCedit }
 
 
{*****************************************************************************}
{**                                                                         **}
{**   The procedures in this section are likely to be operating system      **}
{**   dependent.                                                            **}
{**                                                                         **}
{*****************************************************************************}
 
 
 PROCEDURE PROCcom( s : Lines );
 
 PROCEDURE CmdNoE( CONST s : Lines;  CONST len : integer );
  fortran;
 
 BEGIN
  CmdNoE( s, 80 );
 END;   { PROCcom }
 
 
 PROCEDURE OpenFiles;
 VAR
  Options : string(80);
  i : ColIndex;
  CmdStr : Lines;
 
 BEGIN
 
  InFileName := parms;
 
  OutFileName :=
            '-ecceecce                                                                       ';
 
  Options  :=
            '                                                                                ';
 
  FOR i := FirstCol TO LastCol DO Options[ i ] := InFileName[ i ];
  reset( InFile, 'File=' || Options );
 
  FOR i := FirstCol TO LastCol DO Options[ i ] := OutFileName[ i ];
  rewrite( OutFile, 'File=' || Options || ' Nocc' );
 
  reset( input, 'File=*MSOURCE* Interactive' );
  rewrite( output, 'File=*MSINK*' )
 
 END;   { OpenFiles }
 
 
 PROCEDURE CloseFiles( NormalEnd : boolean );
 VAR
  CmdStr : Lines;
  i : ColIndex;
 
 BEGIN
  close( InFile );   close( OutFile );
 
  IF NormalEnd THEN
  BEGIN
    Cmdstr :=
          'EMPTY 12345678901234567890 OK                                                   ';
    FOR i := FirstCol TO ParsLength DO Cmdstr[ i + 6 ] := InFileName[ i ];
    PROCCom( Cmdstr );
 
    Cmdstr :=
          'COPY 12345678901234567890 TO 12345678901234567890                               ';
    FOR i := FirstCol TO ParsLength DO Cmdstr[ i + 5 ] := OutFileName[ i ];
    FOR i := FirstCol TO ParsLength DO Cmdstr[ i + 29 ] := InFileName[ i ];
    PROCcom( Cmdstr );
 
    Cmdstr :=
          'DESTROY 12345678901234567890 OK                                                 ';
    FOR i := FirstCol TO ParsLength DO Cmdstr[ i + 8 ] := OutFileName[ i ];
    PROCCom( Cmdstr );
 
  END;
 
 END;   { CloseFiles }
 
 
BEGIN { main program }
 
  OpenFiles;
 
  PROCedit;
 
  CloseFiles( true );
 
999:
END. { main program }