Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/QCOM.ZIP/COMBAR.PAS

Pascal/Delphi Source File | 1989-08-23 | 10.3 KB | 334 lines

{ Copyright (C) 1989 by Alpac Systems
                        Finn J. R. Nielsen
                        1741 W. Orchid Lane
                        Phoenix, AZ 85021 }
Program ComBar; uses QCom, Crt, Dos;

Const
  minSize = 256;          { Limits for various size queues }
  medSize = 3000;
  maxSize = 6000;

  Full_block = 219;       { graphics character values }
  Low_block = 221;
  Esc = 27;
  Cr = 13;

  baud_labels: array[ord(B110)..ord(B38400)] of word =
               (110,150,300,600,1200,2400,4800,9600,19200,38400);
  protocol_labels: array[ord(XoffProtocol)..ord(DsrProtocol)] of string[13] =
                   ('Xoff Protocol','Dsr Protocol ');

Var
  Comm1, Comm2: ^CommPort;
  Config: commConfig;
  testBaud: BaudRates;
  testProtocol: ProtocolType;
  done, completely_done: boolean;
  origVideo: byte;
  msgLimit, inLimit, outLimit: word;
  inCurMsgNo, outCurMsgNo, inErr: word;
  curQ1, curQ2: word;
  ch: char;
  testStart: longint;

{ Get a time stamp with resolution to nearest second for elapsed time
  calculations }
Function timeStamp: longint;
Var
  hour, min, sec, hund: word;
Begin
  GetTime(hour,min,sec,hund);
  if hund > 50 then inc(sec);
  timeStamp := sec + min*60 + hour*3600;
End;

{ Display a text string at specified screen coordinates }
Procedure Display(X,Y: integer; msg: string255);
Begin
  GotoXY(X,Y);
  Write(msg);
End;

{ Show a status message in upper right corner of screen - update elapsed
  time display }
Procedure Status(statColor: byte; Msg: string255);
Var
  oldAttr: byte;

Begin
  oldAttr := textAttr;
  gotoXY(68,2);
  textBackground(statColor);
  textColor(White);
  highVideo;
  write(Msg);
  textAttr := oldAttr;
  gotoXY(35,16); write(timeStamp - testStart,'  ');
End;

{ Produce a bar graph, which approximates the occupancy rate of a
  specified queue. In this case, the display is VERY "approximate".}
Procedure UpdGraf(Var prevVal: word; Y, qCount, qSize: word);
Var
  oldAttr: byte;
  longTemp: longInt;
  bar_ch: char;
  newInc, newQ: integer;
  ix: word;

Begin
  oldAttr := textAttr;
  textBackground(Black);
  textColor(Red);
  longTemp := qCount * longint(150);
  newQ := longTemp div qSize;
  newInc := newQ - ((prevVal shr 1) shl 1);
  bar_ch := char(Full_block);
  if newInc > 0 then gotoXY(4+(prevval shr 1),Y)
  else
  begin
    bar_ch := char(Low_block);
    textColor(Green);
    gotoXY(4+(newQ shr 1),Y);
    write(bar_ch);
  end;
  if (newInc shr 1) <> 0 then
    for ix := 0 to (abs(newInc) shr 1) do write(bar_ch);
  if (newInc mod 2) <> 0 then write(bar_ch);
  textAttr := oldAttr;
  prevVal := newQ;
End;

Procedure UpdQueueGraf;
Begin
  UpdGraf(curQ1,11,Comm1^.oCount,Comm1^.oSize);
  UpdGraf(curQ2,14,Comm2^.iCount,Comm2^.iSize);
End;

Procedure FinishScreen;
Begin
  Status(Black,'Finished ...');
  textAttr := origVideo;
  gotoXY(1,23);
End;

{ Initialize the test screen }
Procedure InitScreen;
Begin
  clrScr;
  origVideo := textAttr;
  textAttr := 7;
  highVideo;
  display(4,3,'Turnaround Cable Test (COM1: and COM2:)');
  lowVideo;
  textColor(Cyan);
  display(4,18,'Protocol:');
  display(40,18,'Baud rate:');
  display(4,22,'(Press any key for next test, <esc> to exit)');
  display(4,5,'Writing COM1: until >       bytes in output queue');
  display(4,6,'Reading COM2: until <      bytes in input queue');
  display(4,8,'Input msg:');
  display(4,10,'COM1: output queue (6,000 bytes):');
  display(4,13,'COM2: input queue (3,000 bytes):');
  display(4,16,'Elapsed seconds for this test:');
  textColor(Blue);
  display(4,20,
  'Program material Copyright (C) 1989 by Alpac Systems and Finn J. Nielsen');
  textAttr := 7;
  inErr := 0;
  curQ1 := 0;
  curQ2 := 0;
End;

{ Initialize the comm ports to default configurations }
Procedure InitPorts;
Begin
  Comm1 := Connect(1,minSize,maxSize);
  Comm2 := Connect(2,medSize,minSize);
  Config := DeflCfg;
End;

{ Assign random values to queue char limits }
Procedure ChooseParams;
Begin
  inLimit := random(medSize div 2);
  gotoXY(26,6); write(inLimit:4);
  outLimit := random(maxSize * 3 div 4);
  gotoXY(26,5); write(outLimit:5);
End;

{ Generate some output messages. Stop when the output queue fills beyond
  the limit specified in "outLimit" variable }
Procedure FillOutQ;
Var
  outMsg: string255;

Begin
  Status(Red,'Writing ... ');
  while (Comm1^.oCount < outLimit) and (not keypressed) do
  begin
    inc(outCurMsgNo);
    str(outCurMsgNo:6,outMsg);
    outMsg := 'Test message (34 bytes) no:'+outMsg+#13;
    PutString(Comm1,outMsg);
    updQueueGraf;
  end;
End;

{ Idle routine - waits for some data to be received in the input queue.
  If the transmitter doesn't have anything to send, then idle is also
  terminated. }
Procedure Idle;
Begin
  Status(Cyan,'Idling ...  ');
  repeat
    updQueueGraf;
  until
    ((Comm1^.CommFlags and XmitOn) = 0) or
    (Comm1^.oCount = 0) or
    keypressed;
End;

{ Read input messages until the input queue has fewer characters left than
  specified by "inLimit" variable.}
Procedure GetMessages;
Var
  inMsg, tempMsg: string255;
  convNo, convCode: word;
  oldVideo: byte;

Begin
  Status(Green,'Reading ... ');
  while (Comm2^.iCount > inLimit) and not keypressed do
  begin
    inc(inCurMsgNo);
    inMsg := GetString(Comm2,nil);
    tempMsg := copy(inMsg,28,6);
    val(tempMsg,convNo,convCode);
    tempMsg := copy(inMsg,1,27);
    if (length(inMsg) <> 34) or    { check input message integrity }
       (convCode <> 0) or
       (inMsg[34] <> #13) or
       (convNo <> inCurMsgNo) or
       (tempMsg <> 'Test message (34 bytes) no:') then
    begin
      inc(inErr);                  { lost some data, count errors and show }
      gotoXY(50,8);
      write('Lost data on ',inErr:4,' messages');
    end;
    tempMsg := copy(inMsg,1,34);
    oldVideo := textAttr;
    textBackground(Blue);
    display(15,8,tempMsg);
    textAttr := oldVideo;
    updQueueGraf;
  end;
End;

{ Flush both input and output queues by reading on the input side. The
  bargraph is interesting during this test section. Since updating the
  bargraph is relatively time consuming, and the update is done once
  for every character read, characters are received faster than they
  can be processed. The output buffer often has more data than can be
  contained in the smaller input queue. As a result, the bargraph visually
  shows the effect of transmission throttling by the protocol transfer }
Procedure FlushQueues;
Var
  ch: char;

Begin
  if keypressed then
  begin
    ch := readkey;
    done := (ch = char(Esc));
  end;
  if not done then
  begin
    Status(Blue,'Flushing ...');
    repeat
      while (Comm1^.oCount > 0) or (Comm2^.iCount > 0) do
      begin
        ch := GetChar(Comm2,nil);
        updQueueGraf;
      end;
      delay(10); {catch characters in transit - not in outq and not in inq }
    until (Comm1^.oCount = 0) and (Comm2^.iCount = 0);
  end;
  gotoXY(15,8); write(' ':34); { erase displayed input message }
End;

{ Main program

    Displays a screen showing progress of the test. The test itself is
    intended to do the following:

    1. Loop through various baud rates (starting with the high ones - so
       test can be aborted when boredom sets in at lower rates).

    2. For each baud rate loop through the available protocols.

    3. For each configuration of baud rate and protocol run a test
       consisting of some output and input messages. The number of
       messages used depends on the line speed assigned for the current
       test.

    4. Each test generates a sequence of output messages. These messages
       are inserted in the COM1: output queue. Output is suspended when
       a random upper limit is reached in the output queue (notice that
       the output queue is larger than the COM2: receiving queue).

    5. When output is suspended, enter an idle loop to wait for an
       appropriate amount of data to be received into the COM2: input
       queue. The amount of data to be received during the idle is
       either the amount required to empty the sending (COM1: output)
       queue or the amount required to trigger COM1: output suspension
       due to queue congestion in the COM2: input queue. Input queue
       congestion is signalled differently, depending on the active
       protocol.

    6. After the idle loop is finished, read some of the COM2: input
       data. The amount read is determined by a random character count.
       For each message read, check for message integrity. If any bad
       messages are found, the screen will be updated to show a count
       of bad messages.

    7. Before changing configuration (line speed or protocol), flush
       all queues on both the input and the output side. Queues are
       flushed by reading on the input side. Protocol handling is active
       during the flush.

    8. During the entire testing process, display two bargraphs showing
       the relative occupancy of the two queues. }
Begin
  Randomize;
  InitScreen;
  InitPorts;
  done := false;
  repeat
    For testBaud := B38400 downto B1200 do {skip really slow rates }
      For testProtocol := XoffProtocol to DsrProtocol do
        if not done then
        begin
          testStart := timeStamp;
          msgLimit := sqr(ord(testBaud)+1) * 8; { no of msgs in this test }
          outCurMsgNo := 0;                     { init message counters }
          inCurMsgNo := 0;
          Config.Baud := testBaud;
          Config.Protocol := testprotocol;
          SetConfig(Comm1,Config);
          SetConfig(Comm2,Config);
          repeat
            ChooseParams;                       { set buffer parametrs }
            display(14,18,protocol_labels[ord(testProtocol)]);
            gotoXY(51,18); write(baud_labels[ord(testBaud)],' ');
            FillOutQ;                           { generate some output }
            Idle;                               { idle until input received }
            GetMessages;                        { retrieve the input }
          until keypressed or (outCurMsgNo > msgLimit);
          FlushQueues;                          { flush both queues }
        end;
  until done;                                   { until <esc> is typed }
  FinishScreen;                                 { clean up screen }
End.