home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / DOS / Programa / PCL4P51.ZIP / SELFTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-05  |  10.3 KB  |  303 lines
  1. (*******************************************************************)
  2. (*                                                                 *)
  3. (*            SELFTEST.PAS                         June 1996       *)
  4. (*                                                                 *)
  5. (*  SELFTEST requires two serial ports on the same computer. The   *)
  6. (*  program transmits a test string on one port (FirstCOM) and     *)
  7. (*  receives on a second port (SecondCOM), where the two ports are *)
  8. (*  connected via a null modem adapter. The received string is     *)
  9. (*  tested against the transmit string (they should be idenical).  *)
  10. (*                                                                 *)
  11. (*  Connect the two serial ports (on a single computer) together   *)
  12. (*  using a null modem cable. Be sure to modify the configuration  *)
  13. (*  section for non-standard PC ports or to setup your multiport   *)
  14. (*  board. Note that many multiport boards are either Digiboard or *)
  15. (*  BOCA board compatible.                                         *)
  16. (*                                                                 *)
  17. (*******************************************************************)
  18.  
  19.  
  20. program selftest;
  21. uses crt, PCL4P;
  22.  
  23. const
  24.    PC = 1;
  25.    DB = 2;
  26.    BB = 3;
  27.    TestSize = 63;
  28.    NbrRuns = 16;
  29. var
  30.    BaudCode  : Integer;
  31.    BaudText  : String;
  32.    RetCode   : Integer;
  33.    Version   : Integer;
  34.    C         : Char;
  35.    I, N      : Integer;
  36.    Port      : Integer;
  37.    Reset1st  : Boolean;
  38.    Reset2nd  : Boolean;
  39.    BufPtr    : Pointer;
  40.    BufSeg    : Integer;
  41.    TestSet: array[0..62] of Char;
  42.    FirstCOM  : Integer;
  43.    SecondCOM : Integer;
  44.    TheSwitch : Integer;
  45.    ComLimit  : Integer;
  46.    TestLength: Integer;
  47.    RxBase    : Integer;
  48.    TxBase    : Integer;
  49.  
  50. procedure SayError( Code : Integer );
  51. var
  52.    RetCode : Integer;
  53. begin
  54.    if Code < 0 then RetCode := SioError( Code )
  55.    else if (Code and (FramingError or ParityError or OverrunError)) <> 0 then
  56.       begin (* Port Error *)
  57.          if (Code and FramingError) <> 0 then WriteLn('Framing Error');
  58.          if (Code and ParityError)  <> 0 then WriteLn('Parity Error');
  59.          if (Code and OverrunError) <> 0 then WriteLn('Overrun Error')
  60.       end
  61. end;
  62.  
  63. function ErrorCheck(Code : Integer) : Integer;
  64. begin
  65.   (* trap PCL error codes *)
  66.   if Code < 0 then
  67.      begin
  68.        WriteLn;
  69.        Write('ERROR: ');
  70.        SayError( Code );
  71.        if Reset1st then RetCode := SioDone(FirstCOM);
  72.        if Reset2nd then RetCode := SioDone(SecondCOM);
  73.        WriteLn('*** HALTING ***');
  74.        Halt;
  75.      end;
  76.  ErrorCheck := Code;
  77. end;
  78.  
  79. procedure SetFIFO(Port : Integer);
  80. begin
  81.    if SioFIFO(Port, LEVEL_8) > 0
  82.       then WriteLn('***     COM',1+Port,': [16550]')
  83.       else WriteLn('***     COM',1+Port,': [8250/16450]');
  84. end;
  85.  
  86. begin   (* main program *)
  87.    Reset1st := FALSE;
  88.    Reset2nd := FALSE;
  89.    BaudCode := Baud115200;
  90.    BaudText := '115200';
  91.    TheSwitch := 0;
  92.    (* build TestSet[] array *)
  93.    for i := 0 to 25 do TestSet[i]    := chr(ord('A')+i);
  94.    for i := 0 to 25 do TestSet[26+i] := chr(ord('a')+i);
  95.    for i := 0 to 9  do TestSet[52+i] := chr(ord('0')+i);
  96.    TestSet[62] := chr(10);
  97.    (* fetch PORT # from command line *)
  98.    if ParamCount <> 3 then
  99.       begin
  100.          WriteLn('USAGE: "SELFTEST {PC|DB|BB} 1stCom 2ndCom"');
  101.          halt;
  102.       end;
  103.    (* determine port type *)
  104.    if (ParamStr(1)='pc') OR (ParamStr(1)='PC') then TheSwitch := PC;
  105.    if (ParamStr(1)='db') OR (ParamStr(1)='DB') then TheSwitch := DB;
  106.    if (ParamStr(1)='bb') OR (ParamStr(1)='BB') then TheSwitch := BB;
  107.    (* check switch value *)
  108.    if TheSwitch = 0 then
  109.      begin
  110.        WriteLn('Must specify "PC", "DB" or "BB" as 1st argument');
  111.        WriteLn('EG:  SELFTEST PC 1 4');
  112.        Halt
  113.      end;
  114.    (* set port limits *)
  115.    if TheSwitch = PC then ComLimit := COM4;
  116.    if TheSwitch = DB then ComLimit := COM8;
  117.    if TheSwitch = BB then ComLimit := COM16;
  118.    (* get FirstCom *)
  119.    Val( ParamStr(2),FirstCom, RetCode );
  120.    if RetCode <> 0 then
  121.       begin
  122.          WriteLn('1st COM port must be 1 to 20');
  123.          Halt;
  124.       end;
  125.    FirstCom := FirstCom - 1;
  126.    if (FirstCom<COM1) or (FirstCom>COM20) then
  127.       begin
  128.          WriteLn('1st COM port must be 1 to 20');
  129.          Halt
  130.       end;
  131.    WriteLn('FirstCOM =',1+FirstCOM);
  132.    (* get SecondCOM *)
  133.    Val( ParamStr(3),SecondCom, RetCode );
  134.    if RetCode <> 0 then
  135.       begin
  136.          WriteLn('2nd COM port must be 1 to 20');
  137.          Halt;
  138.       end;
  139.    SecondCom := SecondCom - 1;
  140.    if (SecondCom<COM1) or (SecondCom>COM20) then
  141.       begin
  142.          WriteLn('2nd COM port must be 1 to 20');
  143.          Halt
  144.       end;
  145.    WriteLn('SecondCOM =',1+SecondCOM);
  146.    (* check range limits *)
  147.    if FirstCOM < COM1 then
  148.      begin
  149.        WriteLn('1stCom must be >= COM1');
  150.        Halt;
  151.      end;
  152.    if SecondCOM > ComLimit then
  153.      begin
  154.        WriteLn('2ndCom must be <= COM',1+ComLimit);
  155.        Halt;
  156.      end;
  157.    if FirstCOM >= SecondCOM then
  158.      begin
  159.        WriteLn('1stCom must be < 2ndCom');
  160.        Halt;
  161.      end;
  162.    (* configure ports as necessary *)
  163.    if TheSwitch = DB then
  164.      begin
  165.        (*** Custom Configuration: DigiBoard PC/8 ***)
  166.        WriteLn('[ Configuring for DigiBoard PC/8 (IRQ5) ]');
  167.        SioPorts(8,COM1,$140,DIGIBOARD);
  168.        for Port := COM1 to COM8 do
  169.          begin
  170.             (* set DigiBoard UART addresses *)
  171.             ErrorCheck( SioUART(Port,$100+8*Port) );
  172.             (* set DigiBoard IRQ *)
  173.             ErrorCheck( SioIRQ(Port,IRQ5) );
  174.          end;
  175.        end;
  176.    if TheSwitch = BB then
  177.      begin
  178.         (*** Custom Configuration: BOCA BB2016 ***)
  179.         WriteLn('[ Configuring for BOCA Board BB2016 (IRQ15) ]');
  180.         SioPorts(16,COM1,$107,BOCABOARD);
  181.         for Port := COM1 to COM16 do
  182.           begin
  183.             (* set BOCA Board UART addresses *)
  184.             ErrorCheck( SioUART(Port,$100+8*Port) );
  185.             (* set BOCA Board IRQ *)
  186.             ErrorCheck( SioIRQ(Port,IRQ15) );
  187.           end;
  188.        end;
  189.    if TheSwitch = PC then
  190.      begin
  191.        WriteLn('[ Configuring for standard PC ports]');
  192.      end;
  193.    (* setup 1K receive buffers *)
  194.    GetMem(BufPtr,1024+16);
  195.    BufSeg := Seg(BufPtr^) + ((Ofs(BufPtr^)+15) SHR 4);
  196.    RetCode := ErrorCheck( SioRxBuf(FirstCOM, BufSeg, Size1024) );
  197.    GetMem(BufPtr,1024+16);
  198.    BufSeg := Seg(BufPtr^) + ((Ofs(BufPtr^)+15) SHR 4);
  199.    RetCode := ErrorCheck( SioRxBuf(SecondCOM, BufSeg, Size1024) );
  200.    (* using transmit interrupts ? *)
  201.    if SioInfo('I') > 0 then
  202.       begin
  203.          (* setup 1K transmit buffers *)
  204.          WriteLn('Setting up transmit buffers');
  205.          GetMem(BufPtr,1024+16);
  206.          BufSeg := Seg(BufPtr^) + ((Ofs(BufPtr^)+15) SHR 4);
  207.          RetCode := ErrorCheck( SioTxBuf(FirstCOM, BufSeg, Size1024) );
  208.          GetMem(BufPtr,1024+16);
  209.          BufSeg := Seg(BufPtr^) + ((Ofs(BufPtr^)+15) SHR 4);
  210.          RetCode := ErrorCheck( SioTxBuf(SecondCOM, BufSeg, Size1024) );
  211.       end;
  212.    (* reset FirstCOM *)
  213.    RetCode := SioReset(FirstCOM,BaudCode);
  214.    (* if error then try one more time *)
  215.    if RetCode <> 0 then RetCode := ErrorCheck( SioReset(FirstCOM,BaudCode) );
  216.    Reset1st := TRUE;
  217.    (* Port successfully reset *)
  218.    WriteLn('COM',1+FirstCOM,' reset @ ',BaudText);
  219.    (* reset SecondCOM *)
  220.    RetCode := SioReset(SecondCOM,BaudCode);
  221.    (* if error then try one more time *)
  222.    if RetCode <> 0 then RetCode := ErrorCheck( SioReset(SecondCOM,BaudCode) );
  223.    (* SecondCOM successfully reset *)
  224.    WriteLn('COM',1+SecondCOM,' reset @ ',BaudText);
  225.    Reset2nd := TRUE;
  226.    (* set port parmameters *)
  227.    RetCode := ErrorCheck( SioParms(FirstCOM, NoParity, OneStopBit, WordLength8) );
  228.    RetCode := ErrorCheck( SioParms(SecondCOM, NoParity, OneStopBit, WordLength8) );
  229.    WriteLn('*** SELFTEST: 06/05/96 ');
  230.    Version := SioInfo('V');
  231.    WriteLn('***  Library: ',Version SHR 4,'.',15 AND Version);
  232.    (* set FIFO level if have INS16550 *)
  233.    SetFIFO(FirstCOM);
  234.    SetFIFO(SecondCOM);
  235.    if SioInfo('I') > 0
  236.      then WriteLn('***  TX Intr: Enabled')
  237.      else WriteLn('***  TX Intr: Disabled');
  238.    WriteLn;
  239.    (* flush ports *)
  240.    RetCode := ErrorCheck( SioRxClear(FirstCOM) );
  241.    RetCode := ErrorCheck( SioRxClear(SecondCOM) );
  242.    (* get base interrupt counts *)
  243.    RxBase := SioInfo('R');
  244.    TxBase := SioInfo('T');
  245.    (* send string *)
  246.    WriteLn('Test Set: ',TestSet);
  247.    Write('  Sending set: ');
  248.    for I := 1 to NbrRuns do
  249.      begin
  250.        Write(I,' ');
  251.        for N := 0 to TestSize-1 do
  252.          begin
  253.            C := TestSet[N];
  254.            RetCode := ErrorCheck( SioPutc(FirstCOM,C) );
  255.          end;
  256.      end;
  257.    WriteLn;
  258.    (* receive string *)
  259.    Write('Receiving set: ');
  260.    for I:= 1 to NbrRuns do
  261.      begin
  262.         Write(I,' ');
  263.         for N := 0 to TestSize-1 do
  264.           begin
  265.             RetCode := ErrorCheck( SioGetc(SecondCOM,18) );
  266.             (* compare character *)
  267.             if chr(RetCode) <> TestSet[N] then
  268.                begin
  269.                  WriteLn; WriteLn;
  270.                  Write('   ERROR: Expecting ',TestSet[N],' received ',chr(RetCode));
  271.                  WriteLn(' @ index ',N,' in set ',I);
  272.                  Write(SioInfo('R')-RxBase,' RX interrupts, ');
  273.                  WriteLn(SioInfo('T')-TxBase,' TX interrupts.');
  274.                  WriteLn(SioRxQue(Port),' characters in RX queue.');
  275.                  if Reset1st then SioDone(FirstCOM);
  276.                  if Reset2nd then SioDone(SecondCOM);
  277.                  Halt;
  278.                end;
  279.           end;
  280.      end;
  281.    WriteLn;
  282.    (* check FIFO performance *)
  283.    WriteLn;
  284.    TestLength := NbrRuns * TestSize;
  285.    I := SioInfo('R');
  286.    Write(I-RxBase:3,' RX interrupts on ',TestLength,' incoming bytes: ');
  287.    if I-RxBase < TestLength
  288.      then WriteLn('RX FIFO operational')
  289.      else WriteLn('RX FIFO not operational [or not 16550 UART]');
  290.    if SioInfo('I') > 0 then
  291.      begin
  292.        (* check TX FIFO *)
  293.        I := SioInfo('T');
  294.        Write(I-TxBase:3,' TX interrupts on ',TestLength,' outgoing bytes: ');
  295.        if I-TxBase < TestLength
  296.          then WriteLn('TX FIFO operational')
  297.          else WriteLn('TX FIFO not operational [or not 16550 UART]');
  298.        WriteLn; WriteLn('SUCCESS: Test AOK !');
  299.        RetCode := SioDone(FirstCOM);
  300.        RetCode := SioDone(SecondCOM);
  301.      end;
  302.    end.
  303.