{.PL72}
program parser(input,output,grammar_file);

label start,next_sym,backtrack,abort,exit;

const symbol_laenge = 3;
      nonterm_max = 28;
      term_max = 6;
      prod_max = 59;
      alter_max = 7;
      input_max = 21;
      ss_max = 20;
      bts_max = 5;
      buffer_max = 64; {=input_max * symbol_laenge + 1}
      x_max = 79;
      y_max = 23;

const quad_marker = '++ ';
      blanks = '   ';
      empty = '... ';

type input_index = 0..input_max;
     buffer_index = 1..buffer_max;
     ss_index = 0..ss_max;
     bts_index = 0..bts_max;
     alter_index = 0..alter_max;
     x_index = 0..x_max;
     y_index = 0..y_max;


type symbol = string[symbol_laenge];
     production = string[30];
     prod_nummer = string[4];

type backtrack_entry = record
                       rest_alter,mom_alter : alter_index;
                       mom_symbol : symbol;
                       mom_input_pos : input_index;
                       mom_ss_pos : ss_index
                       end;

var step: boolean;

var nonterm_anz,term_anz,prod_anz : integer;

var nue : array[1..nonterm_max] of symbol;
    sigma : array[1..term_max] of symbol;
    prod_nr : array[1..prod_max] of prod_nummer;
    prod : array[1..prod_max] of production;
    table : array[1..nonterm_max,1..term_max,1..alter_max] of prod_nummer;
    alter_anz : array[1..nonterm_max] of alter_index;
    alter : alter_index;

var input_buffer : string[buffer_max];
    buffer_pos : buffer_index;
    input_pos,input_ende : input_index;
    top_of_ss : ss_index;
    top_of_bts : bts_index;
    ss_x,in_x,bts_x,ex_x : x_index;
    ss_y,in_y,bts_y,ex_y : y_index;

var input_string : array[1..input_max] of symbol;
    symbol_stack : array[1..ss_max] of symbol;
    backtrack_stack : array[1..bts_max] of backtrack_entry;

var input_symbol,stack_symbol : symbol;
    p_nr : prod_nummer;
    bts_entry : backtrack_entry;
    alter_flag,found,error : boolean;
    i,j,k,l,m,n : integer;
    inpch : char;

var grammar_file : text;
{.PA}
{ Prozedur - Deklarationen }

procedure primin;
{ initialisiert die Eingabe }
var i : integer;

begin { Einlesen des Input-Buffers }
write('PRIMIN - Input: ');
for i:=1 to buffer_max do
  write('_');
for i:=1 to buffer_max do
  write(chr(8)); { backspace }
readln(input_buffer);
buffer_pos := 1;
end;

procedure primex(var term_symbol : symbol; var error : boolean);
{ liefert das naechste Input-Symbol aus dem Input-Buffer
  bzw. error = true, falls keins mehr existiert }
type term_anz = 1..term_max;
var i : term_anz;

begin
if buffer_pos > length(input_buffer) then error:=true
else
  begin
  term_symbol := copy(input_buffer,buffer_pos,symbol_laenge);
  buffer_pos := buffer_pos + symbol_laenge;
  insert(blanks,term_symbol,length(term_symbol)+1);
  error:=true; i:=1;
  while error and (i<=term_max) do
    if term_symbol=sigma[i] then error:=false
    else
    i:=i+1;
  end;
if error then writeln('   PRIMEX-Error ')
end;

procedure select_window(nr : integer);
{ waehlt Bildschirm-Fenster nr an }
begin
case nr of
0: write(#$1B,'B ');
2: write(#$1B,'B"');
end
end;

{ Hauptprogramm }

begin
{ Grammatik einlesen }
{$I readgram.pas}

{ Input-Buffer einlesen }
start: primin;

{ Initialisierung der Datenstrukturen und des Bildschirms }
input_ende:=0 ; input_pos:=1;
top_of_ss:=1; symbol_stack[top_of_ss]:=nue[1];
top_of_bts:=0;

repeat
write('Step-Modus ? (Y/N) '); read(trm,inpch);
until inpch in ['Y','y','N','n'];
if inpch in ['Y','y'] then step:=true else step:=false;

ClrScr;
select_window(0); write(#$1B,'C  K7'); { Fenster 0  auf  0, 0  43,23 pos. }
select_window(2); write(#$1B,'CL o7'); { Fenster 2  auf 44, 0  79,23 pos. }
select_window(0);                      { Fenster 0 waehlen }

ss_x := 1; ss_y := 23;
in_x := 5; in_y := 1;
bts_x := 10; bts_y := 18;
ex_x := 43; ex_y := 22;

{ Parsing Algorithmus }
repeat

{ oberstes Stack-Symbol verarbeiten }
stack_symbol := symbol_stack[top_of_ss];
GotoXY(ss_x,ss_y-top_of_ss); write(stack_symbol);

{ Naechstes Input-Zeichen lesen }
GotoXY(in_x+(input_pos-1)*symbol_laenge,in_y+1); write(blanks);
if input_pos>input_ende then
  begin
  primex(input_symbol,error);
  if error then goto abort;
  input_ende:=input_ende+1;
  input_string[input_ende]:=input_symbol;
  end;

input_symbol:=input_string[input_pos];
GotoXY(in_x+input_pos*symbol_laenge,in_y); write(input_symbol);
GotoXY(in_x+input_pos*symbol_laenge,in_y+1); write('^'); if step then read;

{ Stack-Symbol terminal? }
i:=1; found:=false;
while not found and (i<=term_anz) do
  if stack_symbol=sigma[i] then found:=true
  else
  i:=i+1;
if found then
  if input_symbol = stack_symbol then
    begin
    if (input_symbol = quad_marker) then
      begin
      if (top_of_bts > 0) then
        begin
        GotoXY(bts_x,bts_y-top_of_bts); ClrEol;
        top_of_bts := top_of_bts - 1;
        end;
      GotoXY(in_x,in_y); ClrEol;
      GotoXY(in_x,in_y+1); ClrEol;
      input_ende := 0;
      input_pos := 0;
      end;
    GotoXY(ss_x,ss_y-top_of_ss); write(blanks);
    top_of_ss := top_of_ss - 1;
    input_pos:=input_pos+1;
    end
  else
    begin
    select_window(2);          { Fenster 2 waehlen }
    goto backtrack
    end
else  { Stack-Symbol ist nichtterminal }
  begin
  i:=1; found:=false;
  while not found and (i<=nonterm_anz) do
    if stack_symbol=nue[i] then found:=true
    else
    i:=i+1;
  if not found then goto abort;

  j:=1; found:=false;
  while not found and (j<=term_anz) do
    if input_symbol=sigma[j] then found:=true
    else
    j:=j+1;
  if not found then goto abort;

  { Symbol-Kombination mit Alternativen? }
  if alter_anz[i]=1 then alter:=1
  else
    begin
    if top_of_bts=0 then alter_flag:=false
    else
      if stack_symbol = backtrack_stack[top_of_bts].mom_symbol then
        alter_flag:=true
      else
        alter_flag:=false;
    if alter_flag then
      begin
      with backtrack_stack[top_of_bts] do
        begin
        rest_alter := rest_alter - 1;
        alter := mom_alter + 1;
        mom_alter := alter;
        GotoXY(bts_x,bts_y-top_of_bts);
        write(rest_alter:2,mom_alter:2,' ',
              mom_symbol,mom_input_pos:3,mom_ss_pos:3);
        end;
      end
    else
      begin
      alter := 1;
      top_of_bts := top_of_bts + 1;
      with backtrack_stack[top_of_bts] do
        begin
        rest_alter := alter_anz[i] - 1;
        mom_alter := alter;
        mom_symbol := stack_symbol;
        mom_input_pos := input_pos;
        mom_ss_pos := top_of_ss;
        GotoXY(bts_x,bts_y-top_of_bts);
        write(rest_alter:2,mom_alter:2,' ',
              mom_symbol,mom_input_pos:3,mom_ss_pos:3);
        end;
      end;

    end;

  { Table-Eintrag lesen }
  p_nr := table[i,j,alter];
  select_window(2);          { Fenster 2 waehlen }
  write(p_nr,' ');
  if p_nr=empty then goto backtrack;

  { oberstes Stack-Symbol durch rechte Prod'seite ersetzen }
  k:=1; found:=false;
  while not found and (k<=prod_anz) do
    if p_nr=prod_nr[k] then found:=true
    else
    k:=k+1;
  writeln(prod[k]); if step then read;
  select_window(0);          { Fenster 0 waehlen }
GotoXY(ss_x,ss_y-top_of_ss); write(blanks);
  top_of_ss := top_of_ss - 1;
  n := (length(prod[k])-1) div symbol_laenge + 1;
  for l:=n downto 3 do
    begin
    m := l*symbol_laenge - 2;
    top_of_ss := top_of_ss + 1;
    symbol_stack[top_of_ss] := copy(prod[k],m,symbol_laenge)+blanks;
    GotoXY(ss_x,ss_y-top_of_ss); write(symbol_stack[top_of_ss]);
    end;

  goto next_sym;

  backtrack:
  writeln(' Backtracking ');
  if top_of_bts=0 then goto abort;
  if step then read;
  write(#$1B,'I');           { Fenster 2 loeschen }
  select_window(0);          { Fenster 0 waehlen }
  with backtrack_stack[top_of_bts] do
    begin
    GotoXY(bts_x,bts_y-top_of_bts);
    write(rest_alter:2,mom_alter:2,' ',
          mom_symbol,mom_input_pos:3,mom_ss_pos:3);
    end;
 if backtrack_stack[top_of_bts].rest_alter = 0 then
    begin
    top_of_bts := top_of_bts - 1;
    goto backtrack
    end;
  with backtrack_stack[top_of_bts] do
    begin
    GotoXY(in_x,in_y+1); ClrEol;
    input_pos := mom_input_pos;
    for n:=top_of_ss downto mom_ss_pos do
      begin
      GotoXY(ss_x,ss_y-n); write(blanks);
      end;
    top_of_ss := mom_ss_pos;
    symbol_stack[top_of_ss] := mom_symbol;
    end;

  next_sym: ;

  end

until top_of_ss=0;
select_window(2);          { Fenster 2 waehlen }
write('Accepted');
goto exit;

abort: select_window(2);          { Fenster 2 waehlen }
writeln('Not accepted');

exit: select_window(0); write(#$1B,'C  o7'); { Fenster 0 waehlen und auf  0, 0  79,23 pos. }
GotoXY(ex_x,ex_y);

repeat
  write('Restart ? (Y/N) ');
  read(trm,inpch);writeln;
  if inpch in ['Y','y'] then goto start;
until inpch in ['N','n'];

end.
