home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 554 / JUILLET / SYS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  7KB  |  246 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 377 of 454
  3. From : Max Maischein                       2:244/1106.17        08 Jul 93  19:59
  4. To   : All
  5. Subj : Some 386 inline stuff
  6. ────────────────────────────────────────────────────────────────────────────────
  7. I took a dive into the wondrous world of the 386 and conditional compilation
  8. and came back with this :}
  9.  
  10. {FILE:sys.pas}
  11. (*
  12. Max Maischein                                Thursday,  8.07.1993
  13. 2:249/6.17                                         Frankfurt, GER
  14.  
  15.                             SYS.DOC
  16.  
  17. This unit contains some handy  type  definitions  and  some  very
  18. usefull  inline routines. Most of these routines are designed for
  19. the Intel 386  processor and up, but replacements in  pascal  are
  20. compiled using the conditional define c386.
  21.  
  22. The routine FillWord() works just like FillChar(),  but  takes  a
  23. word as a  parameter. Note that SizeOf() does not  work  anymore,
  24. since the destination is filled with words. Use  SizeOf()  shr  1
  25. instead !
  26. The Max() / Min() routines return the larger / smaller  value  of
  27. both  parameters. MinW() /  MaxW()  are  optimized  routines  for
  28. words, Max() and Min()  take LongInts as  parameters.  Min()  and
  29. Max() are inline 386 procedures,  but the ( not  so  optimized  )
  30. Pascal equvalents are compiled  if  "c386"  is  not  $DEFINEd.  A
  31. typical use for Min() would be :
  32.                 GetMem( Min( Bufsize, MaxAvail ))
  33.  
  34. The function BruteCompare() is a  crude  method  to  compare  two
  35. structures  by comparing each byte they consist of. It  is  in  (
  36. slightly optimized ) Pascal and thus slow, but it works !
  37.  
  38. The TUnsortedStringCollection  is  a  TCollection  that  collects
  39. strings but  does _not_ sort them. If you only want to store some
  40. strings, this is faster.
  41.  
  42. This piece of code  is  donated  to  the  public  domain,  but  I
  43. request that, if you use this code, you mention me  in  the  DOCs
  44. somewhere.
  45.  
  46.                                                              -max
  47. *)
  48. {$A-,B-,D+,E+,F-,G+,I+,L+,N+,O-,P-,Q+,R+,S+,T-,V-,X+,Y+}
  49. {$M 65520,0,655360}
  50. Unit Sys;
  51. Interface
  52. Uses Objects;
  53.  
  54. { global defines for CPU dependent compilation }
  55.  
  56. {$DEFINE c386}
  57. {.$DEFINE Overlays}
  58.  
  59. Const
  60. {$IFDEF c386}
  61. RTLVersion = '■ 386 Version';
  62. {$ELSE}
  63.   {$IFOPT G+}
  64.     RTLVersion = '■ 286 Version';
  65.   {$ELSE}
  66.     RTLVersion = '■ Borland RTL Version';
  67.   {$ENDIF}
  68. {$ENDIF}
  69.  
  70. Procedure FillWord(Var Ziel; Times, Datum : Word);
  71. Inline(
  72. $58/         { pop ax    }
  73. $59/         { pop cx    }
  74. $5F/         { pop di    }
  75. $07/         { pop es    }
  76. $FC/         { cld       }
  77. $F3/$AB      { rep stosw }
  78. );
  79.  
  80. Function MaxW( A,B : Word ) : Word;
  81. Inline(
  82. $58/                    { pop   ax      }
  83. $5B/                    { pop   bx      }
  84. $39/$D8/                { cmp   ax, bx  }
  85. $77/$02/                { ja    xx      }
  86. $89/$D8                 { mov   ax, bx  }
  87. );
  88.  
  89. Function MinW( A,B : Word ) : Word;
  90. Inline(
  91. $58/                    { pop   ax      }
  92. $5B/                    { pop   bx      }
  93. $39/$D8/                { cmp   ax, bx  }
  94. $72/$02/                { jb    xx      }
  95. $89/$D8                 { mov   ax, bx  }
  96. );
  97.  
  98. {$IFDEF c386}
  99. Function Max( a, b : LongInt ) : LongInt;
  100. Inline(
  101. $66/$5B/
  102. $66/$58/
  103. $66/$3B/$C3/$7D/$03/
  104. $66/$8B/$C3/
  105. $66/$50/$58/$5A );
  106.  
  107. Function Min( a, b : LongInt ) : LongInt;
  108. Inline(
  109. $66/$5B/
  110. $66/$58/
  111. $66/$3B/$C3/$7E/$03/
  112. $66/$8B/$C3/
  113. $66/$50/$58/$5A );
  114.  
  115. Function InRange( L : LongInt; UpperBound : LongInt ) : Boolean;
  116.   { This function returns true if the LongInt L is in the Range
  117. [0..Upperbound].
  118.     InRange is only defined for positive values of UpperBound, negative values
  119.     return altough predictable but meaningless results. If you are missing the
  120.     second compare, this is as designed, since a negative number can be treated
  121.     as a large unsigned number and thus the second compare is not needed.
  122.     This only works with 386 code, but it should work under any protected mode
  123.     environment.
  124.   }
  125. Inline(
  126. $66/$5B/                { pop   ebx      }
  127. $66/$59/                { pop   ecx      }
  128. $66/$39/$D9/            { cmp   ecx, ebx }
  129. $0F/$93/$C0             { setae al       }
  130. );
  131.  
  132. Function OutRange( L : LongInt; UpperBound : LongInt ) : Boolean;
  133.   { This function returns true if the LongInt L is greater than Upperbound or
  134.     a negative number. Just linke InRange, it is only defined for positive
  135. values
  136.     of UpperBound, negative values return meaningless results as well.
  137.     Only one compare is needed since a negative number can be treated
  138.     as a large unsigned number and thus the second compare is not needed.
  139.     This only works with 386 code, but it should work under any protected mode
  140.     environment.
  141.   }
  142. Inline(
  143. $66/$5B/                { pop   ebx      }
  144. $66/$59/                { pop   ecx      }
  145. $66/$39/$D9/            { cmp   ecx, ebx }
  146. $0F/$92/$C0             { setb  al       }
  147. );
  148. {$ELSE}
  149. Function Min( a, b : LongInt ) : LongInt;
  150. Function Max( a, b : LongInt ) : LongInt;
  151. Function InRange( L : LongInt; UpperBound : LongInt ) : Boolean;
  152. {$ENDIF}
  153. Function BruteCompare( const Buf1, Buf2; Size : Word ) : Integer;
  154.  
  155. Type TArray = Array[ 0..65534 ] of Byte;
  156.      PArray = ^TArray;
  157.  
  158. Type TLongRec = Record
  159.        wLo : Word;
  160.        wHi : Word;
  161.      End;
  162.  
  163. Type TPointerArray = Array[ 0..16382 ] of Pointer;
  164.      PPointerArray = ^TPointerArray;
  165.  
  166. Type TPStringArray = Array[ 0..16382 ] of PString;
  167.      PPStringArray = ^TPStringArray;
  168.  
  169. Type PText = ^Text;
  170.      TText = Text;
  171.  
  172. Type TUnsortedStringCollection = Object( TCollection )
  173.        Procedure FreeItem( P : Pointer ); virtual;
  174.        Function GetItem( Var S: TStream) : Pointer; virtual;
  175.        Procedure PutItem( Var S: TStream; Item: Pointer ); virtual;
  176.      End;
  177.      PUnsortedStringCollection = ^TUnsortedStringCollection;
  178.  
  179. Type TCharSet = Set of Char;
  180.  
  181. Type String1 = String[ 1 ]; String2 = String[ 2 ]; String3 = String[ 3 ];
  182.      ... write a small program to construct the table ...
  183.      String253 = String[ 253 ]; String254 = String[ 254 ]; String255 = String[ 
  184. 255 ];
  185.  
  186. Implementation
  187.  
  188. {$IFNDEF c386}
  189. Function Max (a,b: LongInt):LongInt;
  190. Begin
  191.    If a > b
  192.      then Max := a
  193.      else Max := b;
  194. End;
  195.  
  196. Function Min(a,b: LongInt):LongInt;
  197. Begin
  198.    If a < b
  199.      then Min := a
  200.      else Min := b;
  201. End;
  202.  
  203. Function InRange( L : LongInt; UpperBound : LongInt ) : Boolean;
  204. Begin
  205.   Inrange := ( L >= 0 ) and ( L <= UpperBound );
  206. End;
  207.  
  208. Function OutRange( L : LongInt; UpperBound : LongInt ) : Boolean;
  209. Begin
  210.   Outrange := ( L < 0 ) or ( L > UpperBound );
  211. End;
  212. {$ENDIF c386}
  213.  
  214. Function BruteCompare;
  215. Var W : Word;
  216.     I : Integer;
  217. Begin
  218.   W := 0;
  219.   I := 0;
  220.   While ( I = 0 ) and  ( W < Size ) do
  221.     Begin
  222.       I := TArray( Buf1 )[ W ] - TArray( Buf2 )[ W ];
  223.       Inc( W );
  224.     End;
  225.   If I = 0
  226.     then BruteCompare := 0
  227.     else BruteCompare := Pred( Ord( I and $8000 = 0 ) *2 ); { -1 für I < 0 }
  228. End;
  229.  
  230. Procedure TUnsortedStringCollection.FreeItem;
  231. Begin
  232.   If P <> nil
  233.     then DisposeStr( P );
  234. End;
  235.  
  236. Function TUnsortedStringCollection.GetItem( Var S: TStream ) : Pointer;
  237. Begin
  238.   GetItem := S.ReadStr;
  239. End;
  240.  
  241. Procedure TUnsortedStringCollection.PutItem( Var S: TStream; Item: Pointer );
  242. Begin
  243.   S.WriteStr( Item );
  244. End;
  245.  
  246. End.