{*****************************************************************************}
{** **}
{** Title: Edinburgh Editor Ecce **}
{** Author: H.Whitfield **}
{** Date: 17 November 1985, modified 11 January 1988 **}
{** Copyright (c) H.Whitfield 1985,1988 **}
{** **}
{*****************************************************************************}
PROGRAM Ecce( input, output, InFile, OutFile );
%include argx.pas
LABEL
999;
{ stop }
CONST
argmax = 64;
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
arg : integer;
argstring : PACKED ARRAY [1..argmax] OF char;
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
write( prompt );
prompted := true
END;
IF eoln THEN
FNnextsymbol := nl
ELSE
FNnextsymbol := input@
END;
{ FNnextsymbol }
FUNCTION FNreadsymbol : char;
VAR
sym : char;
BEGIN
sym := FNnextsymbol;
get(input);
lastsymbol := sym;
IF sym = nl THEN
prompted := false;
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;
num := 0;
txt := 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 OpenFiles;
BEGIN
argv( 1, argstring );
reset( InFile, argstring);
argv( 2, argstring );
rewrite( OutFile, argstring )
END;
{ OpenFiles }
PROCEDURE CloseFiles( NormalEnd : boolean );
BEGIN
close( InFile );
close( OutFile )
END;
{ CloseFiles }
BEGIN
{ main program }
if argc = 3 then begin
OpenFiles;
PROCedit;
CloseFiles( true )
end
else
writeln ( 'wrong number of arguments' );
999:
END.
{ main program }