program TstCan2;

uses
  _CrtWin,
  DebWin,
  ChnVirt,
  NumToStr,
  StopW,
  Dos,
  HwSyst,
  Tick,
  ChnCan1,
  Crt;

const
  cVer = 'v1.00 ';

{$I sets.inc}

const
 {$ifNdef VerMC}
{  ParamStr = 'NAM=CAN1 ADD=$0300 CIS=0 SJA=1 IRQ=5 BTR=1000 LRB=40 LTB=5 LOM=0 AER=0';}
                                                {5}
  ParamStr = 'NAM=CAN1 ADD=$0310 CIS=0 SJA=1 IRQ=5 BTR=250 LRB=300 LTB=5 BER=0 LOM=0 AER=0';
 {$else}
  {LOM=0, test rychlosti odberu }
  ParamStr = 'NAM=CAN1 ADD=$2300 CIS=0 SJA=0 IRQ=5 BTR=250 LRB=300 LTB=5 BER=0 LOM=0  AER=0'{1};
 {$endif}

const
  RecChnCanCt  : longint = 0; {pocitadlo prijatych zprav}
  RecErrCanCt  : longint = 0; {pocitadlo chyb pri prijmu zprav}

  pMyCAN        : pChnVirt = nil;

var
  RecCanFrame: tCanFrame; {prijimaci buffer}

function  CanComOpen : tChResult; forward;    {inicializace kanalu a nastaveni stavu Connect}
procedure CanComClose;            forward;    {zruseni Connect a deinicializace kanalu}



{$S-,R-}
var
  OldInt08:Pointer;
procedure NewInt08; far; assembler;
asm
{ Stack:
         ++++++++++++++++
         | CS:IP, Flags |
         ++++++++++++++++
         | RETF         |
         ++++++++++++++++
         | AX           |
         ++++++++++++++++
         | BX           |
         ++++++++++++++++
         | DS           |
         ++++++++++++++++
}
         SUB	SP, 4

         PUSH   AX
         PUSH   BX
         PUSH   DS

         MOV    AX, SEG @DATA
         MOV    DS, AX

         CLD

	 CALL	IncMSCounter

         mov    AX, SEG @DATA
         mov    DS, AX
         MOV    BX, SP
         MOV    AX, WORD PTR [OldInt08 + 0]
	 MOV	SS:[BX + 6 + 0], AX
         MOV    AX, WORD PTR [OldInt08 + 2]
         MOV	SS:[BX + 6 + 2], AX

         POP	DS
         POP	BX
         POP	AX

         { Volani puvodni obsluhy preruseni    }
         { -- provede NEOI a IRET              }
end;

{$S+,R+}


{--------------------------------------------------------}
function CanComOpen:tChResult; {inicializace komunikace CAN}
var W:tChResult;
begin
  pMyCAN:=New(pChnCan1,Init);    {dynamicke vytvoreni objektu}
  with pMyCAN^ do
  begin
    ChSetParam(ParamStr);
    W:=ChResult;
    if W<>res_OK then begin CanComOpen:=W; Exit; end;

    ChOpen;
    W:=ChResult;
    if W<>res_Ok then begin CanComOpen:=W; Exit; end;
    while ChReady<>CHS_Open do
    begin
      W:=ChResult;
      if W<>res_Ok then begin CanComOpen:=W; Exit; end;
    end;

    ChReceiveBuffer(@RecCanFrame,SizeOf(tCanFrame));
    W:=ChReceiveResult;
    if W<>Res_Ok then begin CanComOpen:=W; Exit; end;

    ChConnect;
    W:=ChResult;
    if W<>res_Ok then begin CanComOpen:=W; Exit; end;
    while ChReady<>CHS_Connect do
    begin
      W:=ChResult;
      if W<>res_Ok then begin CanComOpen:=W; Exit; end;
    end;
  end;
  CanComOpen:=Res_Ok;
end;

{--------------------------------------------------------}
procedure CanComClose; {zruseni komunikace CAN}
begin
  if pMyCAN<>nil then
  with pMyCAN^ do
  begin
    if ChState=CHS_Connect then
    begin
      ChDisConnect;
    end;
    if ChState=CHS_Open then
    begin
      ChClose;
    end;
    Dispose(pMyCAN,Done); pMyCAN:=nil;
  end;
end;

var
  SaveExit:Pointer;
  Key:char;

{$S-}
procedure MyExitProc; far;
begin
  ExitProc:=SaveExit;
  if (ExitCode<>0) then writeln('Prg - code: ', ExitCode, ' -- addr: $',
                   WordStrHex(Seg(ErrorAddr^)),':$',WordStrHex(Ofs(ErrorAddr^)));
 {$ifdef VerMC}
  asm sti end;
  repeat
  until false;
 {$endif}
end;
{$S+}

{--------------------------------------------------------}
var
  ch:Char;
  msg:tCanFrame;
  wLen:Word;
  i:Byte;
  bCnt:Byte;
  res:tChResult;
  bOldDLC:Byte;
  bOldData:Byte;
  bOldDataCnt:Byte;
  lnTickDivider:Longint;
  FO:Text;
Begin
  InitDebVyp;

  { inicializace exit procedury }
  SaveExit:=ExitProc;
  ExitProc:=@MyExitProc;

 {$ifdef LogToFile}
  {  AssignCrt(FO);}
  Assign(FO, 'Can2.txt');
  Rewrite(FO);
 {$else}
  AssignCrt(FO);
  Rewrite(FO);
 {$endif}

  { Nastaveni nove obsluhy preruseni casovace }
  {!!!!! nastavovat po spusteni ReTOS a volani InitTick }
  fnGetMS:=GetMSCounter;
{  fnGetMS:=GetMS;}
  GetIntVec($08, OldInt08);
  SetIntVec($08, @NewInt08);

  { Vypocet nastaveni Timer }
  cIRQTime:=2;
  lnTickDivider := Trunc( (cIRQTime*1e-3 * ITimerClk) {+ 0.5} );
  SetTimer( $FFFF and lnTickDivider );

  if CanComOpen<>Res_Ok then
  begin
    Writeln('Nepodarilo se otevrit komunikaci: ', pMyCan^.ChGetParam(''));
    RunError(255);
  end;

  if pMyCan=nil then RunError(255);

  res:=Res_Ok;
  bCnt:=0;
  bOldData:=$FF;
  bOldDLC:=$FF;
  bOldDataCnt:=1;
  repeat
    pError^.LockWin;
     with gCanStsArr[pChnCan1(pMyCan)^.CH_SJA] do
     begin
       gotoxy(1,1);
       write  ('IRQCnt:', WordStrHex(wIRQCnt),
               ',IRQProc:', WordStrHex(wIRQProcCnt),
               ',ITx:', WordStrHex(wITxCnt),
               ',IRx:', WordStrHex(wIRxCnt));
       ClrEol; writeln;
       write  ('IWL:', wIWarnLimitCnt, ',IBusOff:', wIBusOffCnt,
               ',IDO:', wIDataOverCnt, ',IES:', wIErrStateCnt,
               ',IAL:', wIArbitLostCnt, ',IBE:', wIBusErrCnt);
       ClrEol; writeln;
       write  ('TxReq:', wTxReqCnt, ',BusOff:', wBusOffCnt,
               ',DO:', wDataOverCnt, ',RxCnt:', wRxCnt,
               ',TxCnt:', wTxCnt, ',TxFlush:', wTxFlushCnt,
               ',BuffOverCnt:',wBuffOverCnt);
       ClrEol; writeln;
     end;
    pError^.UnlockWin;

    if pMyCan^.ChReceiveReady=CHS_ReceiveReady then
    begin
      { nevraci chybove kody - lze vynechat ChReceiveResult }

      pMyCan^.ChReceive(wLen);
      res:=pMyCan^.ChReceiveResult;

      { v prijimacim bufferu je vzdy ulozena nejaka zprava }
      with pCanFrame(pMyCan^.CH_RMess)^ do
      begin
       {$ifdef Deb}
        { pokud doslo k chybe -> nesmi byt platna zprava,
          kontrola nastavovani podminek }
        if (res<>Res_Ok) and ((STATUS and fs_Valid)<>0) then
        begin
         pReceive^.LockWin;
          Write(FO, '+++ Res:', ByteStrHex(res), ', Status:', ByteStrHex(STATUS));
         pReceive^.UnLockWin;

          RunError(255);
        end;
       {$endif}
        if res<>Res_Ok then
        begin
          { detekovana chyba }

         pReceive^.LockWin;
          if ((STATUS and fs_DataOver)=0) and
             ((STATUS and fs_BuffOver)=0) then
          begin
            with tErrorInfo(Addr(Data)^) do
            begin
              Write(FO, '>> STATUS: ', ByteStrHex(STATUS), ' --- ');
              Write(FO, 'ArbitLost:', ByteStrHex(bArbitLost),
                    ', ErrCode:', ByteStrHex(bErrCode),
                    ', ErrWarn:', bErrWarn,
                    ', RxErr:', bRxErrCnt,
                    ', TxErr:', bTxErrCnt);
              ClrEol; Writeln(FO);
              write(FO, '>> ErrorCode: ');
              case (bErrCode and sja_MskErrCode) shr sja_ShlErrCode of
              0: write(FO, ' BitError');
              1: write(FO, ' FormError');
              2: write(FO, ' StuffError');
              3: write(FO, ' OtherType');
              else
                write(FO, ' Chyba');
              end;
              case (bErrCode and sja_MskDir) shr sja_ShlDir of
              0: write(FO, ' TX');
              1: write(FO, ' RX');
              else
                write(FO, ' Chyba');
              end;
              case (bErrCode and sja_MskSeg) of
              $00: write(FO, ' XXXXX');
              $03: write(FO, ' StartOfFrame');
              $02: write(FO, ' ID.28 to ID.21');
              $04: write(FO, ' SRTR');
              $05: write(FO, ' IDE');
              $07: write(FO, ' ID.17 to ID.13');
              $0F: write(FO, ' ID.12 to ID.5');
              $0C: write(FO, ' RTR');
              $0D: write(FO, ' Reserved bit1');
              $09: write(FO, ' Reserved bit0');
              $0B: write(FO, ' DataLenCode');
              $0A: write(FO, ' DataField');
              $08: write(FO, ' CRC sequence');
              $18: write(FO, ' CRC delimiter');
              $19: write(FO, ' ACK slot');
              $1B: write(FO, ' ACK delimiter');
              $1A: write(FO, ' End of frame');
              $12: write(FO, ' Intermission');
              $11: write(FO, ' ActiveError flag');
              $16: write(FO, ' PassiveError flag');
              $13: write(FO, ' TolerateDominant flag');
              $17: write(FO, ' Error delimiter');
              $1C: write(FO, ' Overload flag');
              else
                write(FO, ' Chyba');
              end;
            end;
            ClrEol; writeln(FO);
          end
          else
          begin
            if (STATUS and fs_DataOver)<>0 then
            begin
              write(FO, '>>  DataOverrun - MsgLost');
              ClrEol; writeln(FO);
            end;
            if (STATUS and fs_BuffOver)<>0 then
            begin
              write(FO, '>>  BufferOver - preplneny buffer');
              ClrEol; writeln(FO);
            end;
            if (STATUS and fs_BusOff)<>0 then
            begin
              pChnCan1(pMyCan)^._BusOffRecovery;
            end;
          end;
         pReceive^.UnlockWin;
        end
        else { if <Res_Ok> }
        begin
         { zprava bez chyb }

         pReceive^.LockWin;
         {$ifdef ONLY_NMT}
          if IDENT = $0 then
          begin
           {$ifdef USE_TIME}
            write('RecTime:', dwRecTime, ', ');
           {$endif}
            Write('Sts:', WordStrHex(STATUS), ', ID:', LongintStrHex(IDENT),
                  ', RTR:', RTR, ', Len:', DLC, ', Data:');
            i:=0;
            while (i<DLC) do
            begin
              write(ByteStrHex(Data[i]));
              Inc(i);
              if i<>DLC then write(',');
            end;
            if (Data[0]=bOldData) and (DLC=bOldDLC) then
              Inc(bOldDataCnt)
            else
            begin
              bOldDataCnt:=1;
              bOldDLC:=DLC;
              bOldData:=Data[0];
            end;
            write(', Cnt:', bOldDataCnt);
            ClrEol; writeln;
         {$else}
          begin
         {$endif}
           {$ifdef USE_TIME}
            write(FO, 'RecTime:', dwRecTime, ', ');
           {$endif}
            Write(FO, 'Sts:', WordStrHex(STATUS), ', ID:', LongintStrHex(IDENT),
                  ', RTR:', RTR, ', Len:', DLC, ', Data:');
            i:=0;
            while (i<DLC) do
            begin
              write(FO, ByteStrHex(Data[i]));
              Inc(i);
              if i<>DLC then write(FO, ',');
            end;
            if (Data[0]=bOldData) and (DLC=bOldDLC) then
              Inc(bOldDataCnt)
            else
            begin
              bOldDataCnt:=1;
              bOldDLC:=DLC;
              bOldData:=Data[0];
            end;
            write(FO, ', Cnt:', bOldDataCnt);
            ClrEol; writeln(FO);
          end; { if IDENT }

         pReceive^.UnlockWin;

         pError^.LockWin;
          gotoxy(1,5);
          ClrEol; writeln;
          ClrEol; writeln;
         pError^.UnlockWin;
        end; { if <Res_Ok> }

      end; { with }
    end; { if <CHS_ReceiveReady> }
  (*
   { vyvolani chyby zaplneni HW bufferu }
   asm
     cli
   end;
     Delay(100);
   asm
     sti
   end;
  *)
  (*
   { vyvolani chyby preteceni SW bufferu }
   if bCnt=10 then asm cli end; Delay(100); asm sti end;
  *)

    { pri prijmu byla detekovana chyba }
   pError^.LockWin;
    gotoxy(1,4);
    if res<>Res_Ok then
    begin
      write  ('Receive: ', WordStrHex(res),
              ', Channel: ', ByteStrHex(Byte(gCanStsArr[pChnCan1(pMyCan)^.CH_SJA].ChannelState)),
              ', Status:', ByteStrHex(pCanFrame(pMyCan^.CH_RMess)^.STATUS));
    end
    else
      write  ('Receive: ', WordStrHex(res),
              ', Channel: ', ByteStrHex(Byte(gCanStsArr[pChnCan1(pMyCan)^.CH_SJA].ChannelState))
              );
    ClrEol;
   pError^.UnlockWin;


    if res=res_ErrCan1_canBusOff then pChnCan1(pMyCan)^._BusOffRecovery;

    Inc(bCnt);

    MainWin^.LockWin;
     gotoxy(1,3);
     write  ('Cnt: ', bCnt,
             ', Status: ', ByteStrHex(gCanStsArr[pChnCan1(pMyCan)^.CH_SJA].bSjaSts),
             ', IntReg: ', ByteStrHex(gCanStsArr[pChnCan1(pMyCan)^.CH_SJA].bSjaIntReg));
     ClrEol;
    MainWin^.UnlockWin;

 {$ifNdef VerMC}
    if keypressed then
    begin
      ch:=readkey;
      case ch of
      '1':
        bCnt:=bCnt;
      '2':
        Delay(6000);
      end;
    end;
  until Upcase(ch)='X';
 {$else}
  until FALSE;
 {$endif}

  pError^.LockWin;
   with gCanStsArr[pChnCan1(pMyCan)^.CH_SJA] do
   begin
     gotoxy(1,1);
     write  ('IRQCnt:', WordStrHex(wIRQCnt),
             ',IRQProc:', WordStrHex(wIRQProcCnt),
             ',ITx:', WordStrHex(wITxCnt),
             ',IRx:', WordStrHex(wIRxCnt));
     ClrEol; writeln;
     write  ('IWL:', wIWarnLimitCnt, ',IBusOff:', wIBusOffCnt,
             ',IDO:', wIDataOverCnt, ',IES:', wIErrStateCnt,
             ',IAL:', wIArbitLostCnt, ',IBE:', wIBusErrCnt);
     ClrEol; writeln;
     write  ('TxReq:', wTxReqCnt, ',BusOff:', wBusOffCnt,
             ',RxCnt:', wRxCnt, ',TxCnt:', wTxCnt,
             ',TxFlush:', wTxFlushCnt, ',BuffOverCnt:',wBuffOverCnt);

     ClrEol; writeln;
   end;
  pError^.UnlockWin;

  CanComClose;

  Flush(FO);
  Close(FO);
End.
