home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / QWIK21.ZIP / QBENCH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-12-09  |  7.7 KB  |  283 lines
  1. { Qbench.pas - produces a 'Screens/second' table for         ver 2.1 12-09-86 }
  2. {              Q screen utilities.                                            }
  3. { I'm not trying to support this program, so don't expect it to be perfect.
  4.   It will just give you a good feel for speed.  The time is adjusted for
  5.   an average 8 second test for each condition - total of 6 minutes.  For more
  6.   accurate results, change TestTime:=16.  I would appreciate anyone providing
  7.   me the results on their machine as a disk file including processor number,
  8.   processor Mhz and Video card. }
  9.  
  10. {$i qwik21.inc}
  11.  
  12. type  Waits = (NoWait,Wait);
  13.       Attrs = (Attr,NoAttr);
  14.  
  15. const
  16.   Procs = 11;
  17.   TestTime = 8;  { TestTime in seconds for each case.  8 gives +/- 1% }
  18.  
  19. var
  20.   Attrib, Count, Screens, WaitScreens, NoWaitScreens, OldCursor: integer;
  21.   Row, Col, Rows, Cols, ProcNumber: byte;
  22.   ScrPerSec: array [1..Procs] of array [NoWait..Wait]
  23.                               of array [Attr..NoAttr] of real;
  24.   Strng: string[80];
  25.   W: Waits;
  26.   A: Attrs;
  27.   ScrArray: array [1..4000] of byte;
  28.   Names: array [1..Procs] of String[80];
  29.   FV: text;
  30.   ToDisk: Boolean;
  31.   Ch: char;
  32.  
  33. { Timerj.inc placed here.  Accurate to 1/18.2... seconds. }
  34. type
  35.     StartStop = (Start, Stop);
  36.  
  37. var
  38.   t1,t2,ElapsedTime: real;
  39.   midword: Integer absolute $40:$6D;
  40.   lobyte:  Byte    absolute $40:$6C;
  41.  
  42. procedure Timer (SS: StartStop);
  43. begin
  44. case SS of
  45.   Start: begin
  46.            t1:= midword*256.0+lobyte;
  47.            ElapsedTime:=0
  48.          end;
  49.   Stop:  begin
  50.            t2:= midword*256.0+lobyte;
  51.            if t2<t1 then t2:=t2+1573040.0;     { max 1,573,040 tics/day }
  52.            ElapsedTime:= (t2-t1)/18.206481934  { units of seconds }
  53.          end
  54.   end;  { end case }
  55. end;
  56. { End of timerj.inc }
  57.  
  58. procedure CheckTime;
  59. begin
  60.   Strng:='TimerTest ';
  61.   for Col:=1 to 3 do Strng:=Strng+Strng;
  62.   Qfill  (1,1,25,80,14,' ');
  63.   timer (start);
  64.   for Count:=1 to Screens do
  65.   for row:=1 to 25 do QwriteV (Row,1,14,Strng);
  66.   timer (Stop);
  67.   Screens:=trunc(Screens*TestTime/ElapsedTime);
  68. end;
  69.  
  70. procedure AllProcs (ProcNumber: byte);
  71. begin
  72. case ProcNumber of
  73.   1: begin
  74.        timer (start);
  75.        for Count:=1 to Screens do
  76.        for Row:=1 to 25 do
  77.          QwriteLV (Row,1,Attrib,80,Strng[1]);
  78.        timer (Stop);
  79.      end;
  80.   2: begin
  81.        timer (start);
  82.        for Count:=1 to Screens do
  83.        for Row:=1 to 25 do
  84.          QwriteV (Row,1,Attrib,Strng);
  85.        timer (Stop);
  86.      end;
  87.   3: begin
  88.        timer (start);
  89.        for Count:=1 to Screens do
  90.        for Row:=1 to 25 do
  91.          Qwrite (Row,1,Attrib,Strng);
  92.        timer (Stop);
  93.      end;
  94.   4: begin
  95.        timer (start);
  96.        for Count:=1 to Screens do
  97.        for Row:=1 to 25 do
  98.          QwriteC (Row,1,80,Attrib,Strng);
  99.        timer (Stop);
  100.      end;
  101.   5: begin
  102.        timer (start);
  103.        for Count:=1 to Screens do
  104.        for Row:=1 to 25 do
  105.          QwriteCV (Row,1,80,Attrib,Strng);
  106.        timer (Stop);
  107.      end;
  108.   6: begin
  109.        timer (start);
  110.        for Count:=1 to Screens do
  111.          QfillC (1,1,80,25,80,Attrib,'C');
  112.        timer (Stop);
  113.      end;
  114.   7: begin
  115.        timer (start);
  116.        for Count:=1 to Screens do
  117.          Qfill (1,1,25,80,Attrib,'F');
  118.        timer (Stop);
  119.      end;
  120.    end;  { Case ProcNumber of }
  121.   if Attrib>=0 then
  122.   case ProcNumber of
  123.   8: begin
  124.        Qfill (1,1,25,80,Attrib,'a');
  125.        timer (start);
  126.        for Count:=1 to Screens do
  127.          Qattr (1,1,25,80,Attrib);
  128.        timer (Stop);
  129.      end;
  130.   9: begin
  131.        Qfill (1,1,25,80,Attrib,'c');
  132.        timer (start);
  133.        for Count:=1 to Screens do
  134.          QattrC (1,1,80,25,80,Attrib);
  135.        timer (Stop);
  136.      end;
  137.    end;  { Case ProcNumber of }
  138.    if ElapsedTime<>0.0 then
  139.    ScrPerSec[ProcNumber,W,A]:=Screens/ElapsedTime;
  140. end;
  141.  
  142. procedure TransProc (ProcNumber: byte);
  143. begin
  144. for Row:=1 to 25 do QwriteV (Row,1,Attrib,Strng);
  145. case ProcNumber of
  146.  10: begin
  147.        timer (start);
  148.        for Count:=1 to Screens do
  149.          QstoreToMem (1,1,25,80,ScrArray);
  150.        timer (Stop);
  151.      end;
  152.  11: begin
  153.        QstoreToMem (1,1,25,80,ScrArray);
  154.        timer (start);
  155.        for Count:=1 to Screens do
  156.          QstoreToScr (1,1,25,80,ScrArray);
  157.        timer (Stop);
  158.      end;
  159.    end;  { Case ProcNumber of }
  160.    if ElapsedTime<>0.0 then
  161.    ScrPerSec[ProcNumber,W,A]:=Screens/ElapsedTime;
  162. end;
  163.  
  164. procedure ExAllProc (At: Attrs; Scrs, Att:integer);
  165. begin
  166.   A:=At;
  167.   Screens:=Scrs;
  168.   Attrib:=Att;
  169.   for ProcNumber:=1 to 9 do
  170.   begin
  171.     Strng:=Names[ProcNumber];
  172.     if W=Wait then Strng:=Strng+' Wait    ' else Strng:=Strng+' No Wait ';
  173.     if A=Attr then Strng:=Strng+' w/Attr  ' else Strng:=Strng+' No Attr ';
  174.     FillChar (Strng[32],49,ProcNumber+48);
  175.     Strng[0]:=#80;
  176.     AllProcs (ProcNumber);
  177.   end;
  178. end;
  179.  
  180. procedure ExTransProc (At: Attrs; Scrs, Att:integer);
  181. begin
  182.   A:=At;
  183.   Screens:=Scrs;
  184.   Attrib:=Att;
  185.   for ProcNumber:=10 to 11 do
  186.   begin
  187.     Strng:=Names[ProcNumber];
  188.     if W=Wait then Strng:=Strng+' Wait    ' else Strng:=Strng+' No Wait ';
  189.     Strng:=Strng+' w/Attr  ';
  190.     FillChar (Strng[32],49,ProcNumber+48);
  191.     Strng[0]:=#80;
  192.     TransProc (ProcNumber);
  193.   end;
  194. end;
  195.  
  196. begin
  197.   Qinit;
  198.   CursorChange (8192,OldCursor);
  199.   GotoRC (1,1);
  200.   Qfill (1,1,25,80,14,' ');
  201.   Qwrite (1,1,-1,'Data to Screen or Disk [s/d]?');
  202.   GotoRC (1,29);
  203.   repeat
  204.     Read (Kbd,Ch);
  205.   until Ch in ['S','s','D','d',^M];
  206.   QwriteC (12,1,80,14,'Don''t worry about snow if you have CGA.');
  207.   QwriteC (13,1,80,14,'It''s testing as if you had and EGA.');
  208.   Delay (4000);
  209.  
  210.   For ProcNumber:=1 to Procs do
  211.   for W:= NoWait to Wait do
  212.   for A:= Attr to NoAttr do
  213.   ScrPerSec[ProcNumber,W,A]:=0.0;
  214.   Names[1]:= ' QwriteLV    ';
  215.   Names[2]:= ' QwriteV     ';
  216.   Names[3]:= ' Qwrite      ';
  217.   Names[4]:= ' QwriteC     ';
  218.   Names[5]:= ' QwriteCV    ';
  219.   Names[6]:= ' QfillC      ';
  220.   Names[7]:= ' Qfill       ';
  221.   Names[8]:= ' Qattr       ';
  222.   Names[9]:= ' QattrC      ';
  223.   Names[10]:= ' QstoreToMem ';
  224.   Names[11]:= ' QstoreToScr ';
  225.  
  226.  
  227.   Qwait:=false;
  228.   W:= NoWait;
  229.   Screens:=600;  { First guess for screens }
  230.   CheckTime;
  231.   NoWaitScreens:=Screens;
  232.   ExAllProc (Attr,NoWaitScreens, 14);
  233.   ExTransProc (Attr,NoWaitScreens, 14);
  234.   Qattr (1,1,25,80,7);
  235.   ExAllProc (NoAttr,NoWaitScreens, -1);
  236.  
  237.   if Vmode<>7 then
  238.   begin
  239.     Qwait:=true;
  240.     W:= Wait;
  241.     Screens:=90;  { First guess for screens }
  242.     CheckTime;
  243.     WaitScreens:=Screens;
  244.     ExAllProc (Attr,WaitScreens, 14);
  245.     ExTransProc (Attr,WaitScreens, 14);
  246.     Qattr (1,1,25,80,7);
  247.     ExAllProc (NoAttr,WaitScreens, -1);
  248.   end;
  249.  
  250.   Qfill (1,1,25,80,14,' ');
  251.   if upcase(ch)='D' then
  252.   begin
  253.     Assign (FV,'Qbench.dta');
  254.     ReWrite (FV);
  255.   end
  256.   else Assign (FV,'Con:');
  257.   GotoRC (1,1);
  258.   WriteLn (FV,'S C R E E N S / S E C O N D');
  259.   WriteLn (FV,'             Chng');
  260.   WriteLn (FV,'Procedure    Attr EGA    CGA');
  261.   WriteLn (FV,'---------    ---- -----------');
  262.   for ProcNumber:=1 to 7 do
  263.   for A:= Attr to NoAttr do
  264.     begin
  265.       if A=Attr then Write (FV,Names[ProcNumber]) else Write (FV,'             ');
  266.       if A=Attr then Write (FV,'Yes  ') else Write (FV,'No   ');
  267.       Write   (FV,ScrPerSec[ProcNumber,NoWait,A]:5:1);
  268.       Writeln (FV,ScrPerSec[ProcNumber,  Wait,A]:6:1);
  269.     end;
  270.   for ProcNumber:=8 to 11 do
  271.     begin
  272.       Write (FV,Names[ProcNumber]);
  273.       if ProcNumber<10 then Write (FV,'Yes  ') else Write (FV,'n/a  ');
  274.       Write   (FV,ScrPerSec[ProcNumber,NoWait,Attr]:5:1);
  275.       Writeln (FV,ScrPerSec[ProcNumber,  Wait,Attr]:6:1);
  276.     end;
  277.   GotoRC (23,1); writeLn (FV,'WaitScreens= ',WaitScreens);
  278.   WriteLn (FV,'NoWaitScreens= ',NoWaitScreens);
  279.   If upcase(ch)='D' then Close (FV);
  280.   GotoRC (24,1);
  281.   CursorChange (OldCursor,OldCursor);
  282. end.
  283.