change hash function gives up to 22% speedup

examplescripts/perfect5000.js

@@ -0,0 +1,42 @@
+
+// Some simple testing of new, eval and some string stuff.
+
+// constructor -- expression array initialization
+function ExprArray(n,v)
+{
+    // Initializes n values to v coerced to a string.
+    for (var i = 0; i < n; i++) {
+	this[i] = "" + v;
+    }
+}
+
+
+// Print the perfect numbers up to n and the sum expression for n's divisors.
+function perfect(n)
+{
+    trace("The perfect numbers up to " +  n + " are:");
+
+    // We build sumOfDivisors[i] to hold a string expression for
+    // the sum of the divisors of i, excluding i itself.
+    var sumOfDivisors = new ExprArray(n+1,1);
+    for (var divisor = 2; divisor <= n; divisor++) {
+	for (var j = divisor + divisor; j <= n; j += divisor) {
+	    sumOfDivisors[j] += " + " + divisor;
+	}
+	// At this point everything up to 'divisor' has its sumOfDivisors
+	// expression calculated, so we can determine whether it's perfect
+	// already by evaluating.
+	if (eval(sumOfDivisors[divisor]) == divisor) {
+	    trace("" + divisor + " = " + sumOfDivisors[divisor]);
+	}
+    }
+    trace("That's all.");
+}
+
+
+trace("\nA number is 'perfect' if it is equal to the sum of its");
+trace("divisors (excluding itself).\n");
+var st=(new Date()).valueOf();
+perfect(5000); 
+  var et=(new Date()).valueOf();
+  trace(et-st,' milliseconds');

src/BESENConstants.pas

@@ -31,6 +31,12 @@
 unit BESENConstants;
 {$i BESEN.inc}
 
+
+{$define THRhash}
+{$define THRhash2}
+
+
+
 interface
 
 uses Math;

src/BESENDateUtils.pas

@@ -632,7 +632,7 @@ function BESENParseISOTime(s:TBESENString):TBESENDate;
    result:=double(pointer(@BESENDoubleNaN)^);
    exit;
   end;
-  result:=BESENMakeDay(StrToIntDef(copy(ss,1,4),0),StrToIntDef(copy(ss,5+(1*Offset),2),0),StrToIntDef(copy(ss,7+(2*Offset),2),0));
+  result:=BESENMakeDay(StrToIntDef(copy(ss,1,4),0),StrToIntDef(copy(ss,5+(Offset),2),0),StrToIntDef(copy(ss,7+(Offset+Offset),2),0));
  end;
  function ParseTime(const ss:TBESENString):TBESENDate;
  var s,ms:TBESENString;
@@ -667,9 +667,10 @@ function BESENParseISOTime(s:TBESENString):TBESENDate;
    exit;
   end;
   Hours:=StrToIntDef(copy(s,1,2),100);
-  Minutes:=StrToIntDef(copy(s,3+(1*Offset),2),100);
+  //Minutes:=StrToIntDef(copy(s,3+(1*Offset),2),100);
+  Minutes:=StrToIntDef(copy(s,3+(Offset),2),100);
   if WithSeconds then begin
-   Seconds:=StrToIntDef(copy(s,5+(2*Offset),2),100);
+   Seconds:=StrToIntDef(copy(s,5+(Offset+Offset),2),100);
   end else begin
    Seconds:=0;
    if length(ms)>0 then begin

src/BESENDeclarativeEnvironmentRecord.pas

@@ -108,7 +108,9 @@ constructor TBESENDeclarativeEnvironmentRecord.Create(AInstance:TObject);
  FillChar(HashBuckets,sizeof(TBESENDeclarativeEnvironmentRecordHashBuckets),#0);
  First:=nil;
  Last:=nil;
+
  HashSize:=256;
+
  HashSizeMask:=HashSize-1;
  HashedItems:=0;
  HashBucketsUsed:=0;
@@ -155,7 +157,9 @@ procedure TBESENDeclarativeEnvironmentRecord.Clear;
  First:=nil;
  Last:=nil;
  LastUsedItem:=nil;
+
  HashSize:=256;
+
  HashSizeMask:=HashSize-1;
  HashedItems:=0;
  HashBucketsUsed:=0;
@@ -215,7 +219,9 @@ procedure TBESENDeclarativeEnvironmentRecord.GrowAndRehashIfNeeded;
   HashBucketsUsed:=0;
   Item:=First;
   while assigned(Item) do begin
+
    Hash:=BESENHashKey(Item^.Key) and HashSizeMask;
+
    Item^.Hash:=Hash;
    if assigned(HashBuckets[Hash].HashLast) then begin
     HashBuckets[Hash].HashLast^.HashNext:=Item;

src/BESENHashMap.pas

@@ -176,7 +176,9 @@ procedure TBESENHashMap.GrowAndRehashIfNeeded;
 
 function TBESENHashMap.GetKey(const Key:TBESENString;Hash:TBESENHash=0):PBESENHashMapItem;
 begin
+
  if assigned(LastUsedItem) and (LastUsedItem^.Key=Key) then begin
+
   result:=LastUsedItem;
   Hash:=result^.Hash;
  end else begin
@@ -185,9 +187,12 @@ function TBESENHashMap.GetKey(const Key:TBESENString;Hash:TBESENHash=0):PBESENHa
   end;
   Hash:=Hash and HashSizeMask;
   result:=HashBuckets[Hash].HashFirst;
+
   while assigned(result) and (result^.Key<>Key) do begin
    result:=result^.HashNext;
   end;
+
+
  end;
  if assigned(result) then begin
   LastUsedItem:=result;

src/BESENHashUtils.pas

@@ -33,14 +33,24 @@
 
 interface
 
-uses BESENConstants,BESENTypes;
+uses BESENConstants,BESENTypes
+{$ifdef THRhash}
+,thrHashUtils
+{$endif}
+;
+
 
 function BESENHashKey(const Key:TBESENString):TBESENHash;
 function BESENDoubleHash(Hash:TBESENHash):TBESENHash;
 
 implementation
 
 function BESENHashKey(const Key:TBESENString):TBESENHash;
+{$ifdef THRhash}
+begin  
+ result:=thrHashKey(key);
+end;
+{$else}
 {$ifdef PurePascal}
 var i,h:longword;
 begin
@@ -146,6 +156,7 @@ function BESENHashKey(const Key:TBESENString):TBESENHash;
 {$endif}
 {$endif}
 {$endif}
+{$endif}
 
 function BESENDoubleHash(Hash:TBESENHash):TBESENHash;
 begin

src/BESENLexer.pas

@@ -161,13 +161,18 @@      TBESENLexer=class(TBESENBaseObject)
 
 implementation
 
-uses {$ifdef BESENEmbarcaderoNextGen}System.Character,{$endif}BESEN,BESENRegExp,BESENErrors,BESENNumberUtils;
+uses {$ifdef BESENEmbarcaderoNextGen}System.Character,{$endif}BESEN,BESENRegExp,BESENErrors,BESENNumberUtils
+{$ifdef THRhash}
+,thrHashUtils
+{$endif}
+;
 
 type TKeywordToken=ltkBREAK..ltkYIELD;
 
      TKeyword=TKeywordToken;
 
      TKeywords=array of TKeyword;
+     TKeywordsHash=array of TBESENHash;
 
 const KeywordNames:array[TKeywordToken] of TBESENUTF16STRING=
        (// Used keywords
@@ -189,6 +194,10 @@ implementation
 
       Keywords:TKeywords=nil;
 
+{$ifdef THRhash2}
+      KeywordsHash:TKeywordsHash=nil;
+{$endif}
+
 constructor TBESENLexer.Create(AInstance:TObject);
 begin
  inherited Create(AInstance);
@@ -550,12 +559,61 @@ procedure TBESENLexer.GetToken(var AResult:TBESENLexerToken);
 
   s:='';
  end;
+
+
  function FindKeyword(const Name:TBESENUTF16STRING):TBESENLexerTokenType;
  var LowIndex,HighIndex,MiddleIndex:integer;
+ {$ifdef THRhash2}
+ aHash: TBESENHash;
+ aHash1: TBESENHash;
+ {$endif}
  begin
   result:=lttIDENTIFIER;
   LowIndex:=0;
   HighIndex:=length(Keywords)-1;
+
+  {$ifdef THRhash2}
+  aHash:=thrHashKey(Name);
+  while LowIndex<=HighIndex do begin
+   case (HighIndex-LowIndex)+1 of
+    1:begin
+     if KeywordsHash[
+     Keywords[LowIndex]
+     ]=aHash then begin
+      result:=Keywords[LowIndex];
+     end;
+    end;
+    2:begin
+     if KeywordsHash[
+     Keywords[LowIndex]
+     ]=aHash then begin
+      result:=Keywords[LowIndex];
+     end else if KeywordsHash[
+     Keywords[HighIndex]
+     ]=aHash then begin
+      result:=Keywords[HighIndex];
+     end;
+    end;
+    else begin
+     MiddleIndex:=(LowIndex+HighIndex) div 2;
+
+	 aHash1 :=KeywordsHash[ Keywords[MiddleIndex] ];
+
+     if aHash1=aHash then begin
+      result:=Keywords[MiddleIndex];
+     end else if LowIndex<>HighIndex then begin
+      if aHash1>aHash then begin
+       HighIndex:=MiddleIndex-1;
+      end else begin
+       LowIndex:=MiddleIndex+1;
+      end;
+      continue;
+     end;
+    end;
+   end;
+   break;
+  end;
+  {$else}
   while LowIndex<=HighIndex do begin
    case (HighIndex-LowIndex)+1 of
     1:begin
@@ -586,6 +644,8 @@ procedure TBESENLexer.GetToken(var AResult:TBESENLexerToken);
    end;
    break;
   end;
+
+  {$endif}
  end;
 begin
  AResult.Name:='';
@@ -1370,13 +1430,47 @@ procedure InitKeywords;
 var kt:TKeywordToken;
     i:integer;
     k:TKeyword;
+	sz:integer;
 begin
- SetLength(Keywords,(integer(high(TKeywordToken))-integer(low(TKeywordToken)))+1);
+ sz:=(integer(high(TKeywordToken))-integer(low(TKeywordToken)))+1;
+
+ SetLength(Keywords,sz);
+
+{$ifdef THRhash2} 
+ //tigra: add hash calc of keys
+ SetLength(KeywordsHash,sz);
+{$endif}
+
  i:=0;
  for kt:=low(TKeywordToken) to high(TKeywordToken) do begin
   Keywords[i]:=kt;
+
+{$ifdef THRhash2}  
+  //tigra: calc hash and store
+  KeywordsHash[i]:=thrHashKey(KeywordNames[kt]);
+ {$endif} 
   inc(i);
  end;
+
+ //sort keywords by keywordNames
+
+ {$ifdef THRhash2}
+ i:=0;
+ while (i+1)<length(Keywords) do begin
+  if KeywordsHash[Keywords[i]]>KeywordsHash[Keywords[i+1]] then begin
+   k:=Keywords[i];
+   Keywords[i]:=Keywords[i+1];
+   Keywords[i+1]:=k;
+   if i>0 then begin
+    dec(i);
+   end else begin
+    inc(i);
+   end;
+  end else begin
+   inc(i);
+  end;
+ end;
+ {$else}
  i:=0;
  while (i+1)<length(Keywords) do begin
   if KeywordNames[Keywords[i]]>KeywordNames[Keywords[i+1]] then begin
@@ -1392,11 +1486,16 @@ procedure InitKeywords;
    inc(i);
   end;
  end;
+ {$endif}
+
 end;
 
 procedure DoneKeywords;
 begin
  SetLength(Keywords,0);
+{$ifdef THRhash2}       
+ SetLength(KeywordsHash,0);
+{$endif}
 end;
 
 procedure InitBESEN;

src/BESENObject.pas

@@ -496,7 +496,9 @@ constructor TBESENObjectPropertyContainer.Create(AInstance:TObject;ASorted:boole
  Last:=nil;
  EnumeratorFirst:=nil;
  EnumeratorLast:=nil;
+
  HashSize:=256;
+
  HashSizeMask:=HashSize-1;
  HashedItems:=0;
  HashBucketsUsed:=0;
@@ -544,7 +546,9 @@ procedure TBESENObjectPropertyContainer.Clear;
  end;
  First:=nil;
  Last:=nil;
+
  HashSize:=256;
+
  HashSizeMask:=HashSize-1;
  HashedItems:=0;
  HashBucketsUsed:=0;

src/BESENParser.pas

@@ -295,7 +295,9 @@ function TBESENParser.Parse(IsFunction,IsJSON:boolean):TBESENASTNode;
     OldToken:=CurrentToken;
     NextToken;
     if NextIsSemicolon then begin
-     if (length(OldToken.StringValue)=10) and (copy(Lexer.Source,OldToken.OldPosition,10)='use strict') then begin
+     if (length(OldToken.StringValue)=10) then begin
+
+	 if (copy(Lexer.Source,OldToken.OldPosition,10)='use strict') then begin
       if UseStrictAlreadyParsed then begin
        AddWarning('"use strict"/''use strict'' already seen!');
       end else begin
@@ -311,6 +313,8 @@ function TBESENParser.Parse(IsFunction,IsJSON:boolean):TBESENASTNode;
        end;
       end;
      end;
+
+     end;
      FirstDirective:=false;
     end else begin
      IsDirectivePrologue:=false;