(******************************************************************* * * TTCalc.Pas 1.2 * * Arithmetic and Vectorial Computations (specification) * * Copyright 1996 David Turner, Robert Wilhelm and Werner Lemberg * * This file is part of the FreeType project, and may only be used * modified and distributed under the terms of the FreeType project * license, LICENSE.TXT. By continuing to use, modify or distribute * this file you indicate that you have read the license and * understand and accept it fully. * * NOTES : All vector operations were moved to the interpreter * ******************************************************************) unit TTCalc; interface {$I TTCONFIG.INC} type (* IntN types : *) (* *) (* These types are used as a way to guarantee the size of some *) (* specific integers. *) (* *) (* Of course, they are equivalent to Short, UShort, Long, etc .. *) (* but parts of this unit could be used by different programs. *) (* *) (* Define the 16-bit type *) {$IFDEF BORLANDPASCAL} Int16 = Integer; Word16 = Word; (* 16-bits unsigned *) {$ENDIF} {$IFDEF DELPHI16} Int16 = Integer; Word16 = Word; (* 16-bits unsigned *) {$ENDIF} {$IFDEF DELPHI32} Int16 = SmallInt; Word16 = Word; (* 16-bits unsigned *) {$ENDIF} {$IFDEF FPC} Int16 = SmallInt; Word16 = Word; (* 16-bits unsigned *) {$ENDIF} Int32 = Longint; (* 32 bits integer *) Word32 = Cardinal; (* 32 bits 'unsigned'. Note that there's *) (* no unsigned long in Pascal.. *) (* As cardinals are only 31 bits !! *) // No need to define our own type, just use the build-in one { Int64 = record (* 64 "" *) Lo, Hi : LongInt; end;} function MulDiv( A, B, C : Int32 ): Int32; function MulDiv_Round( A, B, C : Int32 ): Int32; procedure MulTo64( X, Y : Int32; out Z : Int64 ); function Div64by32( X : Int64; Y : Int32 ) : Int32; function Order64( Z : Int64 ) : integer; function Order32( Z : Int32 ) : integer; function Sqrt32( L : Int32 ): LongInt; function Sqrt64( L : Int64 ): LongInt; {$IFDEF TEST} procedure Neg64( var x : Int64 ); procedure DivMod64by32( X : Int64; Y : Int32; out Q, R : Int32 ); {$ENDIF} implementation (* add support for Virtual Pascal inline assembly *) {$IFDEF VIRTUALPASCAL} {$I TTCALC2.INC} {$ENDIF} (* add support for Delphi 2 and 3 inline assembly *) {$IFDEF DELPHI32} {$I TTCALC3.INC} {$ENDIF} (* add support for Borland Pascal and Turbo Pascal inline assembly *) {$IFDEF BORLANDPASCAL} {$I TTCALC1.INC} {$ENDIF} (* Delphi 16 uses the same inline assembly than Borland Pascal *) {$IFDEF DELPHI16} {$I TTCALC1.INC} {$ENDIF} (* add support for Free Pascal inline assembly *) {$IFDEF FPC} {$I TTCALC4.INC} {$ENDIF} (*****************************************************************) (* *) (* MulDiv : computes A*B/C with an intermediate 64 bits *) (* precision. *) (* *) (*****************************************************************) function MulDiv( a, b, c : Int32 ) : Int32; {$IFDEF INLINE} inline; {$ENDIF} begin {$ifdef CPUI386} {$asmmode intel} asm mov eax, a imul b idiv c mov result, eax end; {$else} MulDiv := int64(a)*int64(b) div c; {$endif} end; (*****************************************************************) (* *) (* MulDiv : computes A*B/C with an intermediate 64 bits *) (* _Round precision and rounding. *) (* *) (*****************************************************************) function MulDiv_Round( a, b, c : Int32 ) : Int32; var temp: Int64; begin temp := int64(a)*int64(b); if temp >= 0 then temp += c shr 1 else temp -= c shr 1; result := temp div c; end; (**********************************************************) (* MSB index ( return -1 for 0 ) *) function Order64( Z : Int64 ) : integer; var b : integer; begin b := 0; while Z <> 0 do begin Z := Z shr 1; inc( b ); end; Result := b-1; end; (**********************************************************) (* MSB index ( return -1 for 0 ) *) function Order32( Z : Int32 ) : integer; var b : integer; begin b := 0; while Z <> 0 do begin Z := Z shr 1; inc( b ); end; Order32 := b-1; end; const Roots : array[0..62] of LongInt = ( 1, 1, 2, 3, 4, 5, 8, 11, 16, 22, 32, 45, 64, 90, 128, 181, 256, 362, 512, 724, 1024, 1448, 2048, 2896, 4096, 5892, 8192, 11585, 16384, 23170, 32768, 46340, 65536, 92681, 131072, 185363, 262144, 370727, 524288, 741455, 1048576, 1482910, 2097152, 2965820, 4194304, 5931641, 8388608, 11863283, 16777216, 23726566, 33554432, 47453132, 67108864, 94906265, 134217728, 189812531, 268435456, 379625062, 536870912, 759250125, 1073741824, 1518500250, 2147483647 ); (**************************************************) (* Integer Square Root *) function Sqrt32( L : Int32 ): LongInt; var R, S : LongInt; begin if L<=0 then result:=0 else if L=1 then result:=1 else begin R:=Roots[ Order32(L) ]; Repeat S:=R; R:=( R+ L div R ) shr 1; until ( R <= S ) and ( R*R <= L ); result:=R; end; end; (**************************************************) (* Integer Square Root *) function Sqrt64( L : Int64 ): LongInt; begin Result := Round(sqrt(L)); end; {var L2 : Int64; R, S : LongInt; begin if L.Hi < 0 then Sqrt64:=0 else begin S := Order64(L); if S = 0 then Sqrt64:=1 else begin R := Roots[S]; Repeat S := R; R := ( R+Div64by32(L,R) ) shr 1; if ( R > S ) then continue; MulTo64( R, R, L2 ); Sub64 ( L, L2, L2 ); until ( L2.Hi >= 0 ); Sqrt64 := R; end end end;} end.