home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / PERFORM / GOODCHAR.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-28  |  5KB  |  147 lines
  1. {$IFDEF VER70}
  2. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V-,X+}
  3. {$ELSE}
  4. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S+,V-,X+}
  5. {$ENDIF}
  6. {$M 16384,0,655360}
  7. var TimerTick: Word absolute $0040:$006C;
  8.     StartTick: Word;
  9.     Normaliseer,Reps,Reps1,Reps2,Reps3,Reps4,Reps5: LongInt;
  10.  
  11.  
  12.   Type CharSet = Set of Char;
  13.   Var CSet: CharSet;
  14.       CStr: String;
  15.       C: Char;
  16.  
  17.   function GoodChar1(C: Char; S: CharSet): Boolean;
  18.   begin
  19.     GoodChar1 := C in S
  20.   end {GoodChar1};
  21.  
  22.   function GoodChar2(C: Char; var Str: String): Boolean;
  23.   begin
  24.     GoodChar2 := Pos(C,Str) > 0
  25.   end {GoodChar2};
  26.  
  27.   function GoodChar3(C: Char; Str: String): Boolean; Assembler;
  28.   ASM
  29.         cld
  30.         les    DI,Str
  31.         mov    AL,ES:[DI]
  32.         xor    AH,AH
  33.         inc    DI
  34.         mov    CX,AX         { If Length(s) = 0 Then Exit    }
  35.         jcxz   @1            { AX = 0 ==> AL = False         }
  36.         mov    AL,C          { Scan for first occurence of c }
  37.         INC    CX
  38.         repne  SCASB
  39.         mov    AL,False
  40.         jcxz   @1 { GoodChar is True if not at end of string }
  41.         mov    AL,True
  42.      @1:
  43.   end {GoodChar3};
  44.  
  45.   function GoodChar4(C: Char; Str: String): Boolean;
  46.   InLine(
  47.     $5F/            {   POP    DI      }
  48.     $07/            {   POP    ES      }
  49.     $FC/            {   CLD            }
  50.     $26/            {   ES:            }
  51.     $8A/$0D/        {   MOV    CL,[DI] }
  52.     $30/$ED/        {   XOR    CH,CH   }
  53.     $41/            {   INC    CX      }
  54.                     {   ;      Een verder dan Length(Str). }
  55.     $47/            {   INC    DI      }
  56.     $58/            {   POP    AX      }
  57.     $F2/$AE/        {   REPNE  SCASB   }
  58.     $91             {   XCHG   CX, AX  }
  59.     );              {   ;      als CX = 0, dan niet in Str }
  60.  
  61.     function GoodChar5(C: Char; var _Set): Boolean;
  62.     InLine(
  63.       $5F/         {   pop   DI                   }
  64.       $07/         {   pop   ES                   }
  65.       $58/         {   pop   AX                   }
  66.       $30/$E4/     {   xor   AH,AH                }
  67.       $89/$C3/     {   mov   BX,AX                }
  68.       $B1/$03/     {   mov   CL,3                 }
  69.       $D3/$EB/     {   shr   BX,CL                }
  70.       $88/$C1/     {   mov   CL,AL                }
  71.       $80/$E1/$07/ {   and   CL,$07               }
  72.       $B0/$01/     {   mov   AL,1                 }
  73.       $D2/$E0/     {   shl   AL,CL                }
  74.       $26/         {   ES:                        }
  75.       $22/$01/     {   and   AL,BYTE PTR [DI+BX]  }
  76.       $D2/$E8);    {   shr   AL,CL                }
  77.  
  78.  
  79. begin
  80.   CSet := ['a'..'z'];
  81.   CStr := 'abcdefghijklmnopqrstuvwxyz';
  82.   Reps1 := 0;
  83.   Reps2 := 0;
  84.   Reps3 := 0;
  85.   Reps4 := 0;
  86.   for C:='a' to 'z' do if (Ord(C) - ord('a')) mod 5 = 1 then
  87.   begin
  88.     write(C:2);
  89.  
  90.     Reps := 0;
  91.     StartTick := TimerTick;
  92.     while StartTick = TimerTick do {wait for end of TimerTick};
  93.     StartTick := TimerTick;
  94.     repeat
  95.       if GoodChar1(C,CSet) then Inc(Reps)
  96.                            else Dec(Reps);
  97.     until StartTick <> TimerTick;
  98.     Inc(Reps1,Reps);
  99.     Normaliseer := Reps;
  100.     write(100 * Reps / Normaliseer:6:0);
  101.  
  102.     Reps := 0;
  103.     StartTick := TimerTick;
  104.     while StartTick = TimerTick do {wait for end of TimerTick};
  105.     StartTick := TimerTick;
  106.     repeat
  107.       if GoodChar2(C,CStr) then Inc(Reps)
  108.                            else Dec(Reps);
  109.     until StartTick <> TimerTick;
  110.     Inc(Reps2,Reps);
  111.     write(100 * Reps / Normaliseer:6:0);
  112.  
  113.     Reps := 0;
  114.     StartTick := TimerTick;
  115.     while StartTick = TimerTick do {wait for end of TimerTick};
  116.     StartTick := TimerTick;
  117.     repeat
  118.       if GoodChar3(C,CStr) then Inc(Reps)
  119.                            else Dec(Reps);
  120.     until StartTick <> TimerTick;
  121.     Inc(Reps3,Reps);
  122.     write(100 * Reps / Normaliseer:6:0);
  123.  
  124.     Reps := 0;
  125.     StartTick := TimerTick;
  126.     while StartTick = TimerTick do {wait for end of TimerTick};
  127.     StartTick := TimerTick;
  128.     repeat
  129.       if GoodChar4(C,CStr) then Inc(Reps)
  130.                            else Dec(Reps);
  131.     until StartTick <> TimerTick;
  132.     Inc(Reps4,Reps);
  133.     write(100 * Reps / Normaliseer:6:0);
  134.  
  135.     Reps := 0;
  136.     StartTick := TimerTick;
  137.     while StartTick = TimerTick do {wait for end of TimerTick};
  138.     StartTick := TimerTick;
  139.     repeat
  140.       if GoodChar5(C,CSet) then Inc(Reps)
  141.                            else Dec(Reps);
  142.     until StartTick <> TimerTick;
  143.     Inc(Reps5,Reps);
  144.     writeln(100 * Reps / Normaliseer:6:0)
  145.   end
  146. end.
  147.