(*------------------------------------------------------------------------*)
(*    procedures for frame and data block header checking                 *)
(*------------------------------------------------------------------------*)
unit mHeader;
interface
  uses Common;
  procedure h_check_frame
   (var Frame:TeleFrame; var Off,Sts,Reg,Typ,Ra,FrFa:byte;var Err: boolean);
  procedure h_init_tables(Reg,Typ,Ra : byte);
  procedure h_check_first_bh(var Off: byte; bh,Reg,Typ,Ra,FrFa: byte;
    var BlFa,BlNo,LaBlFa,LaBlNo: byte; var Err: boolean);
  procedure h_check_next_bh(var Off: byte; bh,Typ,FrFa: byte;
    var BlFa,BlNo,LaBlFa,LaBlNo : byte; var Err: boolean);

(*------------------------------------------------*)
(* Hdr : HdrParam = gets pmeters of triplet timing
         HdrInit  = prepares table HdrCycle
                    of the whole cycle of possible BH
         HdrBadBh = prints bad part of the frame
         HdrFirst = tests first BH in the frame
         HdrNext  = tests next BH

(*------------------------------------------------*)


(*--------------------------------------------------------------------*)
implementation

const
     hEnd = 127  (* oznaceni konce dat v TeleFrame *);
     hMinTask = 11  (* minimal technol task number (TEST) *);
     hMaxTask = 17  (* maximal technol task number (WRIT) *);
type
     hTab16x1 = array [0..15] of byte;
const
     hTypes : hTab16x1 =
              (0,1,2,2,3,4,4,0,0,3,3,3,3,4,4,5);
var
     hPnt, hTrEx : byte;
     hCycle: array [0..100] of byte;

(*................................................*)
procedure h_check_frame
(var Frame:TeleFrame; var Off,Sts,Reg,Typ,Ra,FrFa:byte;var Err: boolean);
(*.................................................*)
  begin
    (* handle header *)
    Sts:= Frame.Sts;
    Reg:= (Sts and 240)div 16;
    Typ:= hTypes[Reg];
    Ra:= Sts mod 4;
    (* 0= ana off, 1=AA, 2=PP, 3=AP *)
    FrFa:= Frame.FrFa;
    Off:= Frame.Off;
    (* check header *)
    Err:= false;
    if (Off<7) or (Off>119) then Typ:= 0;
    if FrFa>127 then Typ:= 0;
    if Typ=0 then Err:= true
  end; (* h_check_frame *)

(*................................................*)
procedure h_init_tables(Reg,Typ,Ra: byte);
(*   prepares array hCycle of FA or NB
     out: hCycle, hTrEx  *)
(*................................................*)

  var j: integer;

  procedure h_cycle_lov_ana;
    begin
      hCycle[hPnt]:= 0;
      hPnt:= hPnt+1;
      if Ra>0 then begin
        hCycle[hPnt]:= 1;
        hPnt:= hPnt+1
      end;
    end; (* h_cycle_lov_ana *)

  begin  (* h_init_tables *)
    case Typ of    (*  mdr  bdr  rrb  rrt  tr *)
     1 : begin     (* mdr *)
           for hPnt:= 1 to 5 do
             hCycle[hPnt]:= 32*(hPnt-1)
         end;
     2 : begin     (* bdr *)
           for hPnt:= 1 to 8 do
             hCycle[hPnt]:= 2*(hPnt-1);
           for hPnt:= 9 to 22 do
             hCycle[hPnt]:= 8*hPnt-56;
           hPnt:= 23
         end;
     3 : begin      (* rrb =fast regime without trip *)
           hPnt:= 1;
           h_cycle_lov_ana;
         end;
     4 : begin      (* rrt=fast regime with trip *)
           hPnt:= 1;
           h_cycle_lov_ana;
           for j:= 2 to 33 do begin
             hCycle[hPnt]:= j;
             hPnt:= hPnt+1
           end;
           if (Reg=5) or (Reg=13) then
                hTrEx:= TriEx1
           else hTrEx:= TriEx2;
           for j:= 1 to (hTrEx-1) do
             h_cycle_lov_ana
         end;
     5 : begin       (* tr=technological regime *)
           hPnt:= 0
         end;
    end; (* case *)

    (*  set sentinels *)
    hCycle[hPnt]:= 129;
    hCycle[0]:= 127+hPnt
  end; (* h_init_tables *)


(*................................................*)
procedure h_check_first_bh(var Off: byte; bh,Reg,Typ,Ra,FrFa: byte;
  var BlFa,BlNo,LaBlFa,LaBlNo: byte; var Err: boolean);

(*   in : hCycle
     out: hPnt  *)
(*................................................*)
  var
       b, i : byte;

  begin
    Err:= false;
    BlFa:= FrFa;
    b:= bh and 127;
    if b=bh then Err:= true
    else  case Typ of    (*  mdr  bdr  rrb  rrt  tr *)
     1..2 : begin        (* mdr,bdr *)
              if b<>0 then Err:= true
              else
                begin
                  hPnt:= hCycle[0]-128;
                  while (hPnt>0) and
                        (hCycle[hPnt]<>FrFa) do
                    hPnt:= hPnt-1;
                  if hPnt=0 then Err:= true
                  else
                    begin
                      i:= hPnt-1;
                      if i=0 then i:= hCycle[0]-128;
                      LaBlFa:= hCycle[i]
                    end;
                end;
            end;
     3..4 : begin      (* rrb,rrt *)
              if (b and 1)<>0 then Err:= true
              else
                begin
                  BlNo:= b div 2;
                  if Ra=0 then hPnt:= 1
                  else hPnt:= 2;
                  if Typ=4 then
                    hPnt:= 32+hPnt*(1+FrFa mod hTrEx);
                  while (hPnt>0) and (hCycle[hPnt]<>BlNo) do
                    hPnt:= hPnt-1;
                  if hPnt=0 then Err:= true
                  else
                    begin
                      i:= hPnt-1;
                      if i=0 then i:= hCycle[0]-128;
                      LaBlNo:= hCycle[i];
                      if BlNo>LaBlNo then LaBlFa:= FrFa
                      else LaBlFa:= (FrFa+127) mod 128
                    end;
                end;
            end;
     5    : begin       (* tr *)
              BlNo:= b div 2;
              LaBlNo:= BlNo;
              LaBlFa:= FrFa;
              if ((BlNo>hMaxTask) or (BlNo<hMinTask)) then Err:= true;
            end;
    end; (* case *)
  end; (* h_check_first_hdr *)

(*................................................*)
procedure h_check_next_bh(var Off: byte; bh,Typ,FrFa: byte;
  var BlFa,BlNo,LaBlFa,LaBlNo : byte; var Err: boolean);

(*   in : hCycle
     out: hPnt   *)
(*................................................*)

  var
       b, f, n, i : byte;

  begin
    Err:= false;
    LaBlFa:= BlFa;
    LaBlNo:= BlNo;
    if bh=hEnd then Off:= Over
    else begin
      b:= bh and 127;
      if bh<128 then Err:= true
      (* increment pnt, test *)
      else  case Typ of    (*  mdr  bdr  rrb  rrt  tr *)
      1..2 : begin     (* mdr,bdr *)
               BlFa:= (FrFa+b) mod 128;
               hPnt:= hPnt+1;
               f:= HCycle[hPnt];
               if f>127 then begin
                 hPnt:= 1; f:= HCycle[1]
               end;
             if BlFa<>f then Err:= true;
             end;
      3..4 : begin      (* rrb,rrt *)
               f:= b and 1;
               BlFa:= (FrFa+f) mod 128;
               BlNo:= b div 2;
               i:= HCycle[hPnt];
               hPnt:= hPnt+1;
               n:= HCycle[hPnt];
               if n>127 then begin
                 hPnt:= 1; n:= HCycle[1]
               end;
               if n>i then i:= 0 else i:= 1;
               (* i = phase increment *)
               if ((LaBlFa +i)mod 128 <>BlFa) or (BlNo<>n) then
                 Err:= true
             end;
      5    : begin       (* tr=technological regime *)
               Err:= true
             end;
      end; (* case *)
    end; (* else *)
  end; (* h_check_next_bh *)

begin
end.
(*------------------------------------------------*)