Старые секреты быстрой отладки: анимация исходного кода

program EightQueens(output);
{ Place 8 hostile queens on a chessboard, such that none can be captured. }
{ From Wirth:  Algorithms + Data Structures = Programs, page 146. }
  var
    i: integer;
    RowFree: array [1..8] of boolean;
    UpDiag: array [2..16] of boolean; { diagonal to upper right }
    DownDiag: array [-7..7] of boolean; { diagonal to lower right }
    QueenIn: array [1..8] of integer;


  procedure print;
  { Write out one solution }
    var
      k: integer;
    begin { print }
      for k := 1 to 8 do
        write(QueenIn[k]: 4);
      writeln;
    end { print };


  procedure try(col: integer);
  { Try to place a queen in this column }
    var
      row: integer;
    begin { try }
      for row := 1 to 8 do
        if RowFree[row] and UpDiag[col+row] and DownDiag[col-row] then
          begin
            QueenIn[col] := row;
            RowFree[row] := false;
            UpDiag[col+row] := false;
            DownDiag[col-row] := false;
            if col < 8
              then try(col+1)
              else print;
            RowFree[row] := true;
            UpDiag[col+row] := true;
            DownDiag[col-row] := true;
          end;
    end { try };

  begin { EightQueens }
    for i := 1 to 8 do
      RowFree[i] := true;
    for i := 2 to 16 do
      UpDiag[i] := true;
    for i := -7 to 7 do
      DownDiag[i] := true;
    try(1)
  end { EightQueens }.

{%F- no reformatting }
{%O+}
program Pas1 (input,output,paskey,pasksy,spsfile,enterf,symsetf{,textf});

const
   nkw = 27;     (*no. of key words*)
   alng =  10;   (*no. of significant chars in identifiers*)
type
   symbol = (intcon,realcon,charcon,string,
                  notsy,plus,minus,times,idiv,rdiv,imod,andsy,orsy,
                  eql,neq,gtr,geq,lss,leq,
                  lparent,rparent,lbrack,rbrack,comma,semicolon,period,
                  colon,becomes,constsy,typesy,varsy,functionsy,
                  proceduresy,arraysy,recordsy,programsy,ident,
                  beginsy,ifsy,casesy,repeatsy,whilesy,forsy,
                  endsy,elsesy,untilsy,ofsy,dosy,tosy,downtosy,thensy);
       alfa = packed array [1..alng] of char;
       object = (konstant,variable,type1,prozedure,funktion);
       types = (notyp,ints,reals,bools,chars,arrays,records);
  keytype = array [1..nkw] of alfa;
  ksytype = array [1..nkw] of symbol;
  spstype = array [char] of symbol;
  symset = set of symbol;
  entertype = record
               fx0: alfa; fx1: object;
               fx2: types; fx3: integer;
              end;

   var
       key: keytype;
       ksy: ksytype;
       sps: spstype; (*special symbols*)
       syset : symset;
       pasksy  : file of ksytype;
       paskey  : file of keytype;
       spsfile : file of spstype;
       enterf  : file of entertype;
       symsetf : file of symset;
{       textf   : text;}

procedure enter(x0: alfa; x1: object;
                x2: types; x3: integer);

var
  EnterRec : EnterType;

begin
  with EnterRec do
     begin  fx0 := x0; fx1 := x1;
        fx2 := x2;  fx3 := x3
     end;
  write ( enterf, EnterRec );
end (*enter*) ;

begin   {main program}
   key[ 1] := 'and       '; key[ 2] := 'array     ';
   key[ 3] := 'begin     '; key[ 4] := 'case      ';
   key[ 5] := 'const     '; key[ 6] := 'div       ';
   key[ 7] := 'do        '; key[ 8] := 'downto    ';
   key[ 9] := 'else      '; key[10] := 'end       ';
   key[11] := 'for       '; key[12] := 'function  ';
   key[13] := 'if        '; key[14] := 'mod       ';
   key[15] := 'not       '; key[16] := 'of        ';
   key[17] := 'or        '; key[18] := 'procedure ';
   key[19] := 'program   '; key[20] := 'record    ';
   key[21] := 'repeat    '; key[22] := 'then      ';
   key[23] := 'to        '; key[24] := 'type      ';
   key[25] := 'until     '; key[26] := 'var       ';
   key[27] := 'while     ';
   ksy[ 1] := andsy;         ksy[ 2] := arraysy;
   ksy[ 3] := beginsy;       ksy[ 4] := casesy;
   ksy[ 5] := constsy;       ksy[ 6] := idiv;
   ksy[ 7] := dosy;          ksy[ 8] := downtosy;
   ksy[ 9] := elsesy;        ksy[10] := endsy;
   ksy[11] := forsy;         ksy[12] := functionsy;
   ksy[13] := ifsy;          ksy[14] := imod;
   ksy[15] := notsy;         ksy[16] := ofsy;
   ksy[17] := orsy;          ksy[18] := proceduresy;
   ksy[19] := programsy;     ksy[20] := recordsy;
   ksy[21] := repeatsy;      ksy[22] := thensy;
   ksy[23] := tosy;          ksy[24] := typesy;
   ksy[25] := untilsy;       ksy[26] := varsy;
   ksy[27] := whilesy;
   rewrite (paskey);
   write (paskey, key);

   ksy[ 1] := andsy;         ksy[ 2] := arraysy;
   ksy[ 3] := beginsy;       ksy[ 4] := casesy;
   ksy[ 5] := constsy;       ksy[ 6] := idiv;
   ksy[ 7] := dosy;          ksy[ 8] := downtosy;
   ksy[ 9] := elsesy;        ksy[10] := endsy;
   ksy[11] := forsy;         ksy[12] := functionsy;
   ksy[13] := ifsy;          ksy[14] := imod;
   ksy[15] := notsy;         ksy[16] := ofsy;
   ksy[17] := orsy;          ksy[18] := proceduresy;
   ksy[19] := programsy;     ksy[20] := recordsy;
   ksy[21] := repeatsy;      ksy[22] := thensy;
   ksy[23] := tosy;          ksy[24] := typesy;
   ksy[25] := untilsy;       ksy[26] := varsy;
   ksy[27] := whilesy;
   rewrite (pasksy);
   write (pasksy, ksy);

   sps['+'] := plus;         sps['-'] := minus;
   sps['*'] := times;        sps['/'] := rdiv;
   sps['('] := lparent;      sps[')'] := rparent;
   sps['='] := eql;          sps[','] := comma;
   sps['['] := lbrack;       sps[']'] := rbrack;
   sps['#'] := neq;          sps['&'] := andsy;
   sps[';'] := semicolon;
   rewrite (spsfile);
   write (spsfile, sps);

  rewrite (enterf);
  enter('          ', variable, notyp, 0);  (*sentinel*)
  enter('false     ', konstant, bools, 0);
  enter('true      ', konstant, bools, 1);
  enter('real      ', type1, reals, 1);
  enter('char      ', type1, chars, 1);
  enter('boolean   ', type1, bools, 1);
  enter('integer   ', type1, ints , 1);
  enter('abs       ', funktion, reals,0);
  enter('sqr       ', funktion, reals,2);
  enter('odd       ', funktion, bools,4);
  enter('chr       ', funktion, chars,5);
  enter('ord       ', funktion, ints, 6);
  enter('succ      ', funktion, chars,7);
  enter('pred      ', funktion, chars,8);
  enter('round     ', funktion, ints, 9);
  enter('trunc     ', funktion, ints, 10);
  enter('sin       ', funktion, reals, 11);
  enter('cos       ', funktion, reals, 12);
  enter('exp       ', funktion, reals, 13);
  enter('ln        ', funktion, reals, 14);
  enter('sqrt      ', funktion, reals, 15);
  enter('arctan    ', funktion, reals, 16);
  enter('eof       ', funktion, bools, 17);
  enter('eoln      ', funktion, bools, 18);
  enter('read      ', prozedure, notyp, 1);
  enter('readln    ', prozedure, notyp, 2);
  enter('write     ', prozedure, notyp, 3);
  enter('writeln   ', prozedure, notyp, 4);
  enter('          ', prozedure, notyp, 0);

  rewrite (symsetf);
  syset := [plus,minus,intcon,realcon,charcon,ident];
  write ( symsetf, syset );
  syset := [ident,arraysy,recordsy];
  write ( symsetf, syset );
  syset := [constsy,typesy,varsy,proceduresy,functionsy,beginsy];
  write ( symsetf, syset );
  syset := [intcon,realcon,charcon,ident,lparent,notsy];
  write ( symsetf, syset );
  syset := [beginsy,ifsy,whilesy,repeatsy,forsy,casesy];
  write ( symsetf, syset );

end.

procedure init;
{%s-}

 var
  i : integer;
  EnterRec : EnterType;

begin
 writeln;
 reset (paskey);   read  (paskey, key);
 reset (pasksy);   read  (pasksy, ksy);
 reset (spsfile);  read  (spsfile, sps);
 reset (symsetf);
 read  (symsetf,constbegsys,typebegsys,blockbegsys,facbegsys,statbegsys);
 stantyps := [notyp,ints,reals,bools,chars];
  lc := 0; ll := 0; cc := 0; ch := ' ';
  errpos := 0; errs := []; insymbol;
  t := -1; a := 0; b := 1; sx := 0; c2 := 0;
  display[0] := 1;
 iflag := false; oflag := false;
 if sy <> programsy then freeze{3} else
  begin insymbol;
   if sy <> ident then freeze{2} else
    begin progname := id; insymbol;
     if sy <> lparent then freeze{9} else
      repeat insymbol;
 if sy <> ident then freeze{2} else
 begin if id = 'input     ' then iflag := true else
       if id = 'output    ' then oflag := true else freeze{0};
   insymbol;
 end
      until sy <> comma;
      if sy = rparent then insymbol else freeze{4};
      if not oflag then freeze{20};
    end
  end ;
  reset (enterf);
  while not eof (enterf) do
   begin
    read  (enterf,EnterRec );
    with EnterRec do
     enter (fx0,fx1,fx2,fx3);
   end;
  with btab[1] do
    begin last := t; lastpar := 1; psize := 0; vsize := 0
    end ;
end {init};

procedure finish;
{%s-}

 begin
  if sy <> period then freeze{22};
  {emit(31)};   {halt}
  if btab[2].vsize > stacksize then freeze{49};
 end {finish};