Merged revisions 6905,6908,6916,6921-6922,6924-6925,6927-6928,6930,6943-6946,6952,6954,6956,6974,6976,6996-6997,7002,7007,7016,7020-7021,7033,7037,7040,7042,7045,7068-7069,7075-7079,7087,7094,7098-7099,7101,7103,7109,7115-7119,7128,7136-7137,7139,7150,7160-7162,7175,7179,7190-7195,7198,7202,7205-7206,7208-7217,7220-7222,7225-7228,7230,7232-7233,7239-7241,7244,7246,7263,7275,7277,7279-7281,7285,7288-7289,7291-7293,7296,7300,7303,7310,7318,7340-7341,7343,7345,7372-7373,7375-7376,7379,7381,7383-7388,7391-7392,7400,7404-7406,7411,7422,7425,7436,7441-7442,7444-7445,7450,7456,7458-7459,7463,7467,7475,7479,7482,7486,7504,7506-7509,7522,7527,7534-7536,7558-7559,7563-7565,7567,7570-7571,7573-7576,7579-7580,7586,7589,7592-7594,7607,7612,7615,7619-7620,7622-7623,7626,7628,7631,7633,7636 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r6905 | jonas | 2007-03-17 23:00:18 +0100 (Sat, 17 Mar 2007) | 2 lines
  
    * test the (previously) working parts of this test
........
  r7232 | peter | 2007-05-01 15:19:48 +0200 (Tue, 01 May 2007) | 2 lines
  
    * clean also installer
........
  r7458 | micha | 2007-05-24 22:16:14 +0200 (Thu, 24 May 2007) | 1 line
  
  * make blists1 bench more detailed
........
  r7459 | micha | 2007-05-24 22:16:49 +0200 (Thu, 24 May 2007) | 1 line
  
  * make bansi1 bench multi threaded, in bansi1mt
........
  r7482 | daniel | 2007-05-26 16:56:09 +0200 (Sat, 26 May 2007) | 2 lines
  
    * Make it work under Linux.
........
  r7579 | daniel | 2007-06-05 09:06:01 +0200 (Tue, 05 Jun 2007) | 2 lines
  
    + Pascal conversion of Stream benchmark.
........
  r7580 | daniel | 2007-06-05 09:53:55 +0200 (Tue, 05 Jun 2007) | 2 lines
  
    * Minor changes.
........
  r7636 | daniel | 2007-06-13 00:20:24 +0200 (Wed, 13 Jun 2007) | 3 lines
  
    * 12345678901234567890>high(int64), therefore int64var=12345678901234567890 always
      evaluates to false. Remove 1 digit to get the value below high(int64).
........

git-svn-id: branches/fixes_2_2@8542 -

.gitattributes

@@ -5559,7 +5559,9 @@ rtl/x86_64/x86_64.inc svneol=native#text/plain
 tests/MPWMake -text
 tests/Makefile svneol=native#text/plain
 tests/Makefile.fpc svneol=native#text/plain
+tests/bench/bansi1.inc svneol=native#text/plain
 tests/bench/bansi1.pp -text
+tests/bench/bansi1mt.pp svneol=native#text/plain
 tests/bench/blists1.inc svneol=native#text/plain
 tests/bench/blists1.pp svneol=native#text/plain
 tests/bench/dmisc.pas svneol=native#text/plain
@@ -5631,6 +5633,7 @@ tests/bench/shootout/src/simple_hash.pp svneol=native#text/plain
 tests/bench/shootout/src/spectralnorm.pp svneol=native#text/plain
 tests/bench/shootout/src/sumcol.pp svneol=native#text/plain
 tests/bench/shortbench.pp svneol=native#text/plain
+tests/bench/stream.pp svneol=native#text/x-pascal
 tests/bench/timer.pas svneol=native#text/plain
 tests/bench/whet.pas svneol=native#text/plain
 tests/dbdigest.cfg.example -text

Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/08/29]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/09/12]
 #
 default: help
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-embedded
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded
 BSDs = freebsd netbsd openbsd darwin
 UNIXs = linux $(BSDs) solaris qnx
 LIMIT83fs = go32v2 os2 emx watcom
@@ -492,6 +492,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
 override TARGET_DIRS+=compiler rtl utils fv packages ide installer
 endif
+ifeq ($(FULL_TARGET),powerpc64-darwin)
+override TARGET_DIRS+=compiler rtl utils fv packages ide installer
+endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
 override TARGET_DIRS+=compiler rtl utils fv packages ide installer
 endif
@@ -2171,6 +2174,15 @@ TARGET_DIRS_PACKAGES=1
 TARGET_DIRS_IDE=1
 TARGET_DIRS_INSTALLER=1
 endif
+ifeq ($(FULL_TARGET),powerpc64-darwin)
+TARGET_DIRS_COMPILER=1
+TARGET_DIRS_RTL=1
+TARGET_DIRS_UTILS=1
+TARGET_DIRS_FV=1
+TARGET_DIRS_PACKAGES=1
+TARGET_DIRS_IDE=1
+TARGET_DIRS_INSTALLER=1
+endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
 TARGET_DIRS_COMPILER=1
 TARGET_DIRS_RTL=1
@@ -2569,6 +2581,7 @@ endif
 	$(MAKE) utils_clean $(CLEANOPTS)
 ifdef IDE
 	$(MAKE) ide_clean $(CLEANOPTS)
+	$(MAKE) installer_clean $(CLEANOPTS)
 endif
 	$(MAKE) rtl_$(ALLTARGET) $(BUILDOPTS)
 	$(MAKE) packages_base_$(ALLTARGET) $(BUILDOPTS)

Makefile.fpc

@@ -268,6 +268,7 @@ endif
         $(MAKE) utils_clean $(CLEANOPTS)
 ifdef IDE
         $(MAKE) ide_clean $(CLEANOPTS)
+        $(MAKE) installer_clean $(CLEANOPTS)
 endif
 # build everything
         $(MAKE) rtl_$(ALLTARGET) $(BUILDOPTS)

tests/bench/bansi1.inc

@@ -0,0 +1,341 @@
+{$APPTYPE CONSOLE}
+{$ifdef fpc}
+{$Mode Objfpc}
+{$endif}
+{$H+}
+
+uses
+{$ifdef NEXUS}
+   nxReplacementMemoryManager,
+{$endif}
+{$if defined(UNIX) and defined(THREAD)}
+   cthreads,
+{$ifend}
+   sysutils,
+   classes;
+
+const
+  BenchCount = 1;
+
+  cTimes = 1000000;
+   Number1: array [0..19] of string = (
+   'zero', 'one', 'two', 'three', 'four', 'five',
+   'six', 'seven', 'eight', 'nine', 'ten', 'eleven',
+   'twelve', 'thirteen', 'fourteen', 'fifteen', 'sixteen',
+   'seventeen', 'eighteen', 'nineteen');
+    Number9: array [0..9] of string = (
+   '', ' one', ' two', ' three', ' four', ' five',
+   ' six', ' seven', ' eight', ' nine');
+
+   Number10: array [0..9] of string = (
+   'zero', 'ten', 'twenty', 'thirty', 'fourty', 'fifty',
+   'sixty', 'seventy', 'eighty', 'ninety');
+
+
+    function GetTickCount : Cardinal;
+      var
+         h,m,s,s1000 : word;
+      begin
+         decodetime(time,h,m,s,s1000);
+         result:=h*3600000+m*60000+s*1000+s1000;
+      end;
+
+
+procedure StartLog(var StartTick: Cardinal);
+begin
+   StartTick:= GetTickCount;
+end;
+
+procedure EndLog(const Text: string; StartTick: Cardinal; Count: Integer);
+begin
+   writeln(Text, ': ', Count, ' done in ', (GetTickCount - StartTick) / 1000.0: 0: 3, ' sec');
+end;
+
+type
+ TFastStringRec = record
+   l: Cardinal;
+   s: string;
+ end;
+
+procedure FS_Clear(var AFS: TFastStringRec); {$ifdef FPC}inline;{$endif}
+begin
+ AFS.L:= 0;
+ AFS.S:= '';
+end;
+
+procedure FS_Assign(var AFS: TFastStringRec; const s: string); {$ifdef FPC}inline;{$endif}
+begin
+ AFS.l:= Length(s);
+ SetLength(AFS.s, (AFS.l and not 63) + 64);
+ if AFS.l > 0 then
+   Move(s[1], AFS.s[1], AFS.l);
+end;
+
+procedure FS_Append(var AFS: TFastStringRec; const s: string); overload;
+{$ifdef FPC}inline;{$endif}
+var
+ L, ls: Cardinal;
+begin
+ ls:= Length(s);
+ if ls > 0 then begin
+   L:= AFS.l;
+   AFS.l:= L + ls;
+   SetLength(AFS.s, (AFS.l and not 63) + 64);
+   Move(s[1], AFS.s[1 + L], ls);
+ end;
+end;
+
+procedure FS_Append(var AFS, S: TFastStringRec); overload; {$ifdef FPC}inline;{$endif}
+var
+ L: Cardinal;
+begin
+ if S.L > 0 then begin
+   L:= AFS.l;
+   AFS.l:= L + S.L;
+   SetLength(AFS.s, (AFS.l and not 63) + 64);
+   Move(S.S[1], AFS.S[1 + L], S.L);
+ end;
+end;
+
+function FS_ToStr(var AFS: TFastStringRec): string; {$ifdef FPC}inline;{$endif}
+begin
+ if AFS.L >  0 then begin
+   SetLength(Result, AFS.L);
+   Move(AFS.S[1], Result[1], AFS.L);
+ end else
+   Result:= '';
+end;
+
+procedure NumberToText_V1(out s: string; n: Integer);
+
+ procedure TensToText(var s: TFastStringRec; dig: Integer);
+ var
+   x: Integer;
+ begin
+     if dig > 0 then begin
+         if dig >= 20 then begin
+           x:= dig mod 10;
+           FS_Assign(s, Number10[dig div 10]);
+             if x <> 0 then
+              FS_Append(s, Number9[x]);
+         end else begin
+             FS_Assign(s, Number1[dig]);
+         end;
+     end else
+       FS_Clear(s);
+ end;
+
+ procedure HundredsToText(var s: TFastStringRec; dig: Integer);
+ var
+     h, t: Integer;
+     s1: TFastStringRec;
+ begin
+   if dig > 0 then begin
+       t:= dig mod 100;
+       h:= dig div 100;
+       if h > 0 then begin
+       TensToText(s, h);
+         if t > 0 then begin
+           FS_Append(s, ' houndred ');
+         TensToText(s1, t);
+         FS_Append(s, s1);
+         end else
+           FS_Append(s, ' houndred');
+       end else
+         TensToText(s, t);
+     end else
+       FS_Clear(s);
+ end;
+
+var
+   dig, h: Integer;
+   s0, s1: TFastStringRec;
+begin
+   if n > 0 then begin
+       dig:= n div 1000;
+       h:= n mod 1000;
+       if dig > 0 then begin
+         HundredsToText(s0, dig);
+         if h > 0 then begin
+       FS_Append(s0, ' thousand ');
+             HundredsToText(s1, h);
+       FS_Append(s0, s1);
+         end else
+           FS_Append(s0, ' thousand');
+       end else
+         HundredsToText(s0, h);
+       s:= FS_ToStr(s0);
+   end else
+       s:= Number1[0];
+end;
+
+
+procedure NumberToText_V2(out s: string; n: Integer);
+
+ procedure TensToText(out s: string; dig: Integer);
+ var
+   x: Integer;
+ begin
+     if dig > 0 then begin
+         if dig >= 20 then begin
+           x:= dig mod 10;
+             if x <> 0 then begin
+                 s:= Number10[dig div 10] + Number9[x]
+             end else
+               s:= Number10[dig div 10];
+         end else begin
+             s:= Number1[dig];
+         end;
+     end else
+       s:= '';
+ end;
+
+ procedure HundredsToText(out s: string; dig: Integer);
+ var
+     h, t: Integer;
+     s1: string;
+ begin
+   if dig > 0 then begin
+       t:= dig mod 100;
+       h:= dig div 100;
+       if h > 0 then begin
+       TensToText(s, h);
+         if t > 0 then begin
+           s:= s + ' houndred ';
+         TensToText(s1, t);
+         s:= s + s1;
+         end else
+           s:= s + ' houndred';
+       end else
+         TensToText(s, t);
+     end else
+       s:= '';
+ end;
+
+var
+   dig, h: Integer;
+   s1: string;
+begin
+   if n > 0 then begin
+       dig:= n div 1000;
+       h:= n mod 1000;
+       if dig > 0 then begin
+         HundredsToText(s, dig);
+         if h > 0 then begin
+       s:= s + ' thousand ';
+             HundredsToText(s1, h);
+       s:= s + s1;
+         end else
+           s:= s + ' thousand';
+       end else
+         HundredsToText(s, h);
+   end else
+       s:= Number1[0];
+end;
+
+function NumberToText_V3(n: Integer): string;
+
+   function TensToText(dig: Integer): string;
+ var
+   x: Integer;
+ begin
+     if dig > 0 then begin
+         if dig >= 20 then begin
+           x:= dig mod 10;
+             if x <> 0 then begin
+                 Result:= Number10[dig div 10] + Number9[x]
+             end else
+               Result:= Number10[dig div 10];
+         end else begin
+             Result:= Number1[dig];
+         end;
+     end else
+       Result:= '';
+ end;
+
+   function HundredsToText(dig: Integer): string;
+ var
+     h, t: Integer;
+ begin
+   if dig > 0 then begin
+       t:= dig mod 100;
+       h:= dig div 100;
+       if h > 0 then begin
+         if t > 0 then
+           Result:= TensToText(h) + ' houndred ' + TensToText(t)
+         else
+           Result:= TensToText(h) + ' houndred';
+       end else
+         Result:= TensToText(t);
+     end else
+       Result:= '';
+ end;
+
+var
+   dig, h: Integer;
+begin
+   if n > 0 then begin
+       dig:= n div 1000;
+       h:= n mod 1000;
+       if dig > 0 then begin
+         if h > 0 then
+       Result:= HundredsToText(dig) + ' thousand ' + HundredsToText(h)
+         else
+           Result:= HundredsToText(dig) + ' thousand';
+       end else
+         Result:= HundredsToText(h);
+   end else
+       Result:= Number1[0];
+end;
+
+procedure Test1;
+var
+   StartTick: Cardinal;
+   i: Integer;
+   s: string;
+begin
+   StartLog(StartTick);
+   for i:= 1 to cTimes do begin
+     NumberToText_V1(s, i);
+   end;
+   EndLog('Test 1', StartTick, cTimes);
+end;
+
+procedure Test2;
+var
+   StartTick: Cardinal;
+   i: Integer;
+   s: string;
+begin
+   StartLog(StartTick);
+   for i:= 1 to cTimes do begin
+     NumberToText_V2(s, i);
+   end;
+   EndLog('Test 2', StartTick, cTimes);
+end;
+
+procedure Test3;
+var
+   StartTick: Cardinal;
+   i: Integer;
+   s: string;
+begin
+   StartLog(StartTick);
+   for i:= 1 to cTimes do begin
+     s:= NumberToText_V3(i);
+   end;
+   EndLog('Test 3', StartTick, cTimes);
+end;
+
+procedure Benchmark;
+var
+  I: integer;
+begin
+  for I := 1 to BenchCount do
+  begin
+    Test1;
+    Test2;
+    Test3;
+  end;
+end;
+

tests/bench/bansi1.pp

@@ -1,334 +1,5 @@
-program Bench2;
-{$APPTYPE CONSOLE}
-{$Mode Objfpc}
-{$H+}
+{$i bansi1.inc}
 
-uses
-   sysutils;
-
-const
- cTimes = 999999;
-   Number1: array [0..19] of string = (
-   'zero', 'one', 'two', 'three', 'four', 'five',
-   'six', 'seven', 'eight', 'nine', 'ten', 'eleven',
-   'twelve', 'thirteen', 'fourteen', 'fifteen', 'sixteen',
-   'seventeen', 'eighteen', 'nineteen');
-    Number9: array [0..9] of string = (
-   '', ' one', ' two', ' three', ' four', ' five',
-   ' six', ' seven', ' eight', ' nine');
-
-   Number10: array [0..9] of string = (
-   'zero', 'ten', 'twenty', 'thirty', 'fourty', 'fifty',
-   'sixty', 'seventy', 'eighty', 'ninety');
-
-
-    function GetTickCount : Cardinal;
-      var
-         h,m,s,s1000 : word;
-      begin
-         decodetime(time,h,m,s,s1000);
-         result:=h*3600000+m*60000+s*1000+s1000;
-      end;
-
-
-var
-   StartTick: Cardinal;
-
-procedure StartLog(const Text: string; Count: Integer);
-begin
-   if Count > 0 then
-       write(Text, ': ', Count, ' ... ')
-   else
-       write(Text, ' ... ');
-   StartTick:= GetTickCount;
-end;
-
-procedure EndLog(const Text: string);
-begin
-   writeln(Text, ' done in ', (GetTickCount - StartTick) / 1000.0: 0: 3, ' sec');
-end;
-
-type
- TFastStringRec = record
-   l: Cardinal;
-   s: string;
- end;
-
-procedure FS_Clear(var AFS: TFastStringRec); inline;
 begin
- AFS.L:= 0;
- AFS.S:= '';
-end;
-
-procedure FS_Assign(var AFS: TFastStringRec; const s: string); inline;
-begin
- AFS.l:= Length(s);
- SetLength(AFS.s, (AFS.l and not 63) + 64);
- if AFS.l > 0 then
-   Move(s[1], AFS.s[1], AFS.l);
-end;
-
-procedure FS_Append(var AFS: TFastStringRec; const s: string); overload;
-inline;
-var
- L, ls: Cardinal;
-begin
- ls:= Length(s);
- if ls > 0 then begin
-   L:= AFS.l;
-   AFS.l:= L + ls;
-   SetLength(AFS.s, (AFS.l and not 63) + 64);
-   Move(s[1], AFS.s[1 + L], ls);
- end;
-end;
-
-procedure FS_Append(var AFS, S: TFastStringRec); overload; inline;
-var
- L: Cardinal;
-begin
- if S.L > 0 then begin
-   L:= AFS.l;
-   AFS.l:= L + S.L;
-   SetLength(AFS.s, (AFS.l and not 63) + 64);
-   Move(S.S[1], AFS.S[1 + L], S.L);
- end;
-end;
-
-function FS_ToStr(var AFS: TFastStringRec): string; inline;
-begin
- if AFS.L >  0 then begin
-   SetLength(Result, AFS.L);
-   Move(AFS.S[1], Result[1], AFS.L);
- end else
-   Result:= '';
-end;
-
-procedure NumberToText_V1(out s: string; n: Integer);
-
- procedure TensToText(var s: TFastStringRec; dig: Integer);
- var
-   x: Integer;
- begin
-     if dig > 0 then begin
-         if dig >= 20 then begin
-           x:= dig mod 10;
-           FS_Assign(s, Number10[dig div 10]);
-             if x <> 0 then
-              FS_Append(s, Number9[x]);
-         end else begin
-             FS_Assign(s, Number1[dig]);
-         end;
-     end else
-       FS_Clear(s);
- end;
-
- procedure HundredsToText(var s: TFastStringRec; dig: Integer);
- var
-     h, t: Integer;
-     s1: TFastStringRec;
- begin
-   if dig > 0 then begin
-       t:= dig mod 100;
-       h:= dig div 100;
-       if h > 0 then begin
-       TensToText(s, h);
-         if t > 0 then begin
-           FS_Append(s, ' houndred ');
-         TensToText(s1, t);
-         FS_Append(s, s1);
-         end else
-           FS_Append(s, ' houndred');
-       end else
-         TensToText(s, t);
-     end else
-       FS_Clear(s);
- end;
-
-var
-   dig, h: Integer;
-   s0, s1: TFastStringRec;
-begin
-   if n > 0 then begin
-       dig:= n div 1000;
-       h:= n mod 1000;
-       if dig > 0 then begin
-         HundredsToText(s0, dig);
-         if h > 0 then begin
-       FS_Append(s0, ' thousand ');
-             HundredsToText(s1, h);
-       FS_Append(s0, s1);
-         end else
-           FS_Append(s0, ' thousand');
-       end else
-         HundredsToText(s0, h);
-       s:= FS_ToStr(s0);
-   end else
-       s:= Number1[0];
-end;
-
-
-procedure NumberToText_V2(out s: string; n: Integer);
-
- procedure TensToText(out s: string; dig: Integer);
- var
-   x: Integer;
- begin
-     if dig > 0 then begin
-         if dig >= 20 then begin
-           x:= dig mod 10;
-             if x <> 0 then begin
-                 s:= Number10[dig div 10] + Number9[x]
-             end else
-               s:= Number10[dig div 10];
-         end else begin
-             s:= Number1[dig];
-         end;
-     end else
-       s:= '';
- end;
-
- procedure HundredsToText(out s: string; dig: Integer);
- var
-     h, t: Integer;
-     s1: string;
- begin
-   if dig > 0 then begin
-       t:= dig mod 100;
-       h:= dig div 100;
-       if h > 0 then begin
-       TensToText(s, h);
-         if t > 0 then begin
-           s:= s + ' houndred ';
-         TensToText(s1, t);
-         s:= s + s1;
-         end else
-           s:= s + ' houndred';
-       end else
-         TensToText(s, t);
-     end else
-       s:= '';
- end;
-
-var
-   dig, h: Integer;
-   s1: string;
-begin
-   if n > 0 then begin
-       dig:= n div 1000;
-       h:= n mod 1000;
-       if dig > 0 then begin
-         HundredsToText(s, dig);
-         if h > 0 then begin
-       s:= s + ' thousand ';
-             HundredsToText(s1, h);
-       s:= s + s1;
-         end else
-           s:= s + ' thousand';
-       end else
-         HundredsToText(s, h);
-   end else
-       s:= Number1[0];
-end;
-
-function NumberToText_V3(n: Integer): string;
-
-   function TensToText(dig: Integer): string;
- var
-   x: Integer;
- begin
-     if dig > 0 then begin
-         if dig >= 20 then begin
-           x:= dig mod 10;
-             if x <> 0 then begin
-                 Result:= Number10[dig div 10] + Number9[x]
-             end else
-               Result:= Number10[dig div 10];
-         end else begin
-             Result:= Number1[dig];
-         end;
-     end else
-       Result:= '';
- end;
-
-   function HundredsToText(dig: Integer): string;
- var
-     h, t: Integer;
- begin
-   if dig > 0 then begin
-       t:= dig mod 100;
-       h:= dig div 100;
-       if h > 0 then begin
-         if t > 0 then
-           Result:= TensToText(h) + ' houndred ' + TensToText(t)
-         else
-           Result:= TensToText(h) + ' houndred';
-       end else
-         Result:= TensToText(t);
-     end else
-       Result:= '';
- end;
-
-var
-   dig, h: Integer;
-begin
-   if n > 0 then begin
-       dig:= n div 1000;
-       h:= n mod 1000;
-       if dig > 0 then begin
-         if h > 0 then
-       Result:= HundredsToText(dig) + ' thousand ' + HundredsToText(h)
-         else
-           Result:= HundredsToText(dig) + ' thousand';
-       end else
-         Result:= HundredsToText(h);
-   end else
-       Result:= Number1[0];
-end;
-
-procedure Test1;
-var
-   i: Integer;
-   s: string;
-begin
-   StartLog('Test 1', cTimes + 1);
-   for i:= 0 to cTimes do begin
-     NumberToText_V1(s, i);
-   end;
-   EndLog('');
-end;
-
-procedure Test2;
-var
-   i: Integer;
-   s: string;
-begin
-   StartLog('Test 2', cTimes + 1);
-   for i:= 0 to cTimes do begin
-     NumberToText_V2(s, i);
-   end;
-   EndLog('');
-end;
-
-procedure Test3;
-var
-   i: Integer;
-   s: string;
-begin
-   StartLog('Test 3', cTimes + 1);
-   for i:= 0 to cTimes do begin
-     s:= NumberToText_V3(i);
-   end;
-   EndLog('');
-end;
-
-procedure Benchmark;
-begin
-   Test1;
-   Test2;
-   Test3;
-end;
-
-begin
-   Benchmark;
+  Benchmark;
 end.
-

tests/bench/bansi1mt.pp

@@ -0,0 +1,42 @@
+program bansi1mt;
+{$define THREAD}
+{$i bansi1.inc}
+
+var
+  NumThreads: Integer = 4;
+
+type
+  TBenchThread = class(TThread)
+  public
+    procedure Execute; override;
+  end;
+
+procedure TBenchThread.Execute;
+begin
+  Benchmark;
+end;
+
+var
+  threads: array of TBenchThread;
+  I: integer;
+begin
+  if ParamCount > 0 then
+  begin
+    NumThreads := StrToIntDef(ParamStr(1), 0);
+    if NumThreads < 1 then
+    begin
+      writeln('Pass a valid number of threads, >= 1');
+      exit;
+    end;
+  end;
+  { main thread is also a thread }
+  setlength(threads, NumThreads-1);
+  for I := low(threads) to high(threads) do
+    threads[I] := TBenchThread.Create(false);
+  Benchmark;
+  for I := low(threads) to high(threads) do
+  begin
+    threads[I].waitfor;
+    threads[I].free;
+  end;
+end.

tests/bench/blists1.inc

@@ -5,6 +5,9 @@
     For I:=0 to Max-1 do
       L.Add(Pointer(I));
     L.Clear;
+    T2:=Now;
+    Writeln('Add/Clear  Time : ',FormatDateTime('hh:nn:ss.zzz',T2-T1));
+    T1:=Now;
     For I:=0 to Max-1 do
       L.Add(Pointer(I));
     // Hustle
@@ -14,16 +17,22 @@
       K:=Random(Max);
       L.Exchange(J,K);
       end;
+    T2:=Now;
+    Writeln('Add/Hustle Time : ',FormatDateTime('hh:nn:ss.zzz',T2-T1));
+    T1:=Now;
     // Simple search
     For I:=0 to Max-1 do
       begin
       J:=L.IndexOf(Pointer(I));
       end;
+    T2:=Now;
+    Writeln('Search     Time : ',FormatDateTime('hh:nn:ss.zzz',T2-T1));
+    T1:=Now;
     // Simple search and remove
     For I:=Max-1 downto 0 do
       L.Remove(Pointer(I));
     T2:=Now;
-    Writeln('Time : ',FormatDateTime('hh:nn:ss.zzz',T2-T1));
+    Writeln('Remove     Time : ',FormatDateTime('hh:nn:ss.zzz',T2-T1));
   Finally
     L.Free;
   end;

tests/bench/stream.pp

@@ -0,0 +1,431 @@
+program stream;
+
+{$ifdef unix}
+uses baseunix,unix;
+{$endif}
+
+{$ifdef windows}
+uses windows;
+{$endif}
+
+{-----------------------------------------------------------------------}
+{ Original code developed by John D. McCalpin                           }
+{ Programmers: John D. McCalpin                                         }
+{              Joe R. Zagar                                             }
+{ Pascal conversion: Daniel Mantione                                    }
+{                                                                       }
+{ This program measures memory transfer rates in MB/s for simple        }
+{ computational kernels coded in Pascal.                                }
+{-----------------------------------------------------------------------}
+{ Copyright 1991-2005: John D. McCalpin                                 }
+{-----------------------------------------------------------------------}
+{ License:                                                              }
+{  1. You are free to use this program and/or to redistribute           }
+{     this program.                                                     }
+{  2. You are free to modify this program for your own use,             }
+{     including commercial use, subject to the publication              }
+{     restrictions in item 3.                                           }
+{  3. You are free to publish results obtained from running this        }
+{     program, or from works that you derive from this program,         }
+{     with the following limitations:                                   }
+{     3a. In order to be referred to as "STREAM benchmark results",     }
+{         published results must be in conformance to the STREAM        }
+{         Run Rules, (briefly reviewed below) published at              }
+{         http://www.cs.virginia.edu/stream/ref.html                    }
+{         and incorporated herein by reference.                         }
+{         As the copyright holder, John McCalpin retains the            }
+{         right to determine conformity with the Run Rules.             }
+{     3b. Results based on modified source code or on runs not in       }
+{         accordance with the STREAM Run Rules must be clearly          }
+{         labelled whenever they are published.  Examples of            }
+{         proper labelling include:                                     }
+{         "tuned STREAM benchmark results"                              }
+{         "based on a variant of the STREAM benchmark code"             }
+{         Other comparable, clear and reasonable labelling is           }
+{         acceptable.                                                   }
+{     3c. Submission of results to the STREAM benchmark web site        }
+{         is encouraged, but not required.                              }
+{  4. Use of this program or creation of derived works based on this    }
+{     program constitutes acceptance of these licensing restrictions.   }
+{  5. Absolutely no warranty is expressed or implied.                   }
+{-----------------------------------------------------------------------}
+
+{ INSTRUCTIONS:
+ *
+ *	1) Stream requires a good bit of memory to run.  Adjust the
+ *          value of 'N' (below) to give a 'timing calibration' of 
+ *          at least 20 clock-ticks.  This will provide rate estimates
+ *          that should be good to about 5% precision.
+ }
+
+const N	        = 2000000;
+      NTIMES	= 10;
+      OFFSET	= 0;
+
+{
+ *	3) Compile the code with full optimization.  Many compilers
+ *	   generate unreasonably bad code before the optimizer tightens
+ *	   things up.  If the results are unreasonably good, on the
+ *	   other hand, the optimizer might be too smart for me!
+ *
+ *         Try compiling with:
+ *               cc -O stream_omp.c -o stream_omp
+ *
+ *         This is known to work on Cray, SGI, IBM, and Sun machines.
+ *
+ *
+ *	4) Mail the results to [email protected]
+ *	   Be sure to include:
+ *		a) computer hardware model number and software revision
+ *		b) the compiler flags
+ *		c) all of the output from the test case.
+ * Thanks!
+ *
+ }
+
+const HLINE = '-------------------------------------------------------------';
+
+      inf = 1/0;
+
+var a,b,c:array[0..N+OFFSET-1] of double;
+
+    avgtime:array[0..3] of double = (0,0,0,0);
+    maxtime:array[0..3] of double = (0,0,0,0);
+	mintime:array[0..3] of double = (inf,inf,inf,inf);
+
+    labels:array[0..3] of string[16]= ('Copy:',
+                                       'Scale:',
+                                       'Add:',
+                                       'Triad:');
+
+    bytes:array[0..3] of cardinal = (
+      2 * sizeof(double) * N,
+      2 * sizeof(double) * N,
+      3 * sizeof(double) * N,
+      3 * sizeof(double) * N
+    );
+
+const	M=20;
+
+function min(a,b:longint):longint;inline;
+
+begin
+  if a>b then
+    min:=b
+  else
+    min:=a;
+end;
+
+function max(a,b:longint):longint;inline;
+
+begin
+  if a>b then
+    max:=a
+  else
+    max:=b;
+end;
+
+function min(a,b:double):double;inline;
+
+begin
+  if a>b then
+    min:=b
+  else
+    min:=a;
+end;
+
+function max(a,b:double):double;inline;
+
+begin
+  if a>b then
+    max:=a
+  else
+    max:=b;
+end;
+
+procedure tuned_STREAM_Copy;
+
+var j:longint;
+
+begin
+  for j:=0 to N-1 do
+    c[j]:=a[j];
+end;
+
+procedure tuned_STREAM_Scale(scalar:double);
+
+var j:longint;
+
+begin
+  for j:=0 to N-1 do
+    b[j]:=scalar*c[j];
+end;
+
+procedure tuned_STREAM_Add;
+
+var j:longint;
+
+begin
+  for j:=0 to N-1 do
+   c[j]:=a[j]+b[j];
+end;
+
+procedure tuned_STREAM_Triad(scalar:double);
+
+var j:longint;
+
+begin
+  for j:=0 to N-1 do
+    a[j]:=b[j]+scalar*c[j];
+end;
+
+{$ifdef unix}
+{$define have_mysecond}
+function mysecond:double;
+
+var tp:timeval;
+    tzp:timezone;
+
+begin
+  fpgettimeofday(@tp,@tzp);
+  mysecond:=double(tp.tv_sec)+double(tp.tv_usec)*1e-6;
+end;
+{$endif}
+
+{$ifdef windows}
+{$define have_mysecond}
+function mysecond:double;
+
+begin
+  mysecond:=gettickcount*1e-3;
+end;
+{$endif}
+
+{$ifndef have_mysecond}
+{$error Please implement a mysecond for your platform.}
+{$endif}
+
+function checktick:longint;
+
+var i,minDelta,Delta:longint;
+    t1,t2:double;
+    timesfound:array[0..M-1] of double;
+
+begin
+  {  Collect a sequence of M unique time values from the system. }
+  for i:=0 to M-1 do
+    begin
+      t1:=mysecond;
+      t2:=t1;
+      while t2-t1<1E-6 do
+        t2:=mysecond;
+      t1:=t2;
+      timesfound[i]:=t1;
+    end;
+
+  {
+   * Determine the minimum difference between these M values.
+   * This result will be our estimate (in microseconds) for the
+   * clock granularity.
+  }
+
+   minDelta:=1000000;
+   for i:=1 to M-1 do
+     begin
+       Delta:=trunc(1E6*(timesfound[i]-timesfound[i-1]));
+       minDelta:=MIN(minDelta,MAX(Delta,0));
+     end;
+
+   checktick:=minDelta;
+end;
+
+procedure checkSTREAMresults;
+
+var aj,bj,cj,scalar:double;
+	asum,bsum,csum:double;
+	epsilon:double;
+	j,k:longint;
+
+begin
+    { reproduce initialization }
+	aj:=1;
+	bj:=2;
+	cj:=0;
+    { a[] is modified during timing check }
+	aj:=2*aj;
+    { now execute timing loop }
+	scalar:=3;
+    for k:=0 to NTIMES-1 do
+      begin
+        cj:=aj;
+        bj:=scalar*cj;
+        cj:=aj+bj;
+        aj:=bj+scalar*cj;
+       end;
+	aj:=aj*N;
+	bj:=bj*N;
+	cj:=cj*N;
+
+	asum:=0;
+	bsum:=0;
+	csum:=0;
+    for j:=0 to N-1 do
+      begin
+		asum:=asum+a[j];
+		bsum:=bsum+b[j];
+		csum:=csum+c[j];
+      end;
+{$ifdef VERBOSE}
+	writeln('Results Comparison: ');
+	writeln('        Expected  : ',aj,' ',bj,' ',cj);
+	writeln('        Observed  : ',asum,' ',bsum,' ',csum);
+{$endif}
+
+	epsilon:=1e-8;
+
+	if abs(aj-asum)/asum>epsilon then
+      begin
+        writeln('Failed Validation on array a');
+        writeln('        Expected  : ',aj);
+        writeln('        Observed  : ',asum);
+      end
+	else if abs(bj-bsum)/bsum>epsilon then
+      begin
+        writeln('Failed Validation on array b');
+        writeln('        Expected  : ',bj);
+        writeln('        Observed  : ',bsum);
+      end
+	else if abs(cj-csum)/csum>epsilon then
+      begin
+        writeln('Failed Validation on array c');
+        writeln('        Expected  : ',cj);
+        writeln('        Observed  : ',csum);
+      end
+	else
+      writeln('Solution Validates');
+end;
+
+var quantum:longint;
+    BytesPerWord:longint;
+    j,k:longint;
+    scalar,t:double;
+    times:array[0..3,0..NTIMES-1] of double;
+    
+begin
+    { --- SETUP --- determine precision and check timing --- }
+    writeln(HLINE);
+    writeln('STREAM version Revision: 5.6');
+    writeln(HLINE);
+    BytesPerWord:=sizeof(double);
+    writeln('This system uses ',BytesPerWord,' bytes per DOUBLE PRECISION word.');
+
+    writeln(HLINE);
+    writeln('Array size = ',N,', Offset = ',OFFSET);
+    writeln('Total memory required = ',3*BytesPerWord*(N/1048576),' MB.');
+    writeln('Each test is run ',NTIMES,' times, but only');
+    writeln('the *best* time for each is used.');
+
+    writeln(HLINE);
+    writeln('writelning one line per active thread....');
+
+    { Get initial value for system clock. }
+    for j:=0 to N-1 do
+      begin
+        a[j]:=1;
+        b[j]:=2;
+        c[j]:=0;
+      end;
+
+    writeln(HLINE);
+    
+    quantum:=checktick;
+    if quantum>=1 then 
+      writeln('Your clock granularity/precision appears to be ',quantum,
+	          ' microseconds.')
+    else
+      writeln('Your clock granularity appears to be '+
+              'less than one microsecond.');
+
+    t:=mysecond;
+    for j:=0 to N-1 do 
+	  a[j]:=2*a[j];
+    t:=1E6*(mysecond-t);
+
+    writeln('Each test below will take on the order of ',t,
+	        ' microseconds.');
+    writeln('   (= ',t/quantum,' clock ticks)');
+    writeln('Increase the size of the arrays if this shows that');
+    writeln('you are not getting at least 20 clock ticks per test.');
+
+    writeln(HLINE);
+
+    writeln('WARNING -- The above is only a rough guideline.');
+    writeln('For best results, please be sure you know the');
+    writeln('precision of your system timer.');
+    writeln(HLINE);
+    
+    {	--- MAIN LOOP --- repeat test cases NTIMES times --- }
+
+    scalar:=3;
+    for k:=0 to NTIMES-1 do
+      begin
+        times[0,k]:=mysecond();
+{$ifdef TUNED}
+        tuned_STREAM_Copy();
+{$else}
+        for j:=0 to N-1 do
+          c[j]:=a[j];
+{$endif}
+        times[0,k]:=mysecond-times[0,k];
+	
+        times[1,k]:=mysecond;
+{$ifdef TUNED}
+        tuned_STREAM_Scale(scalar);
+{$else}
+        for j:=0 to N-1 do
+	      b[j]:=scalar*c[j];
+{$endif}
+        times[1,k]:=mysecond-times[1,k];
+        times[2,k]:=mysecond;
+{$ifdef TUNED}
+        tuned_STREAM_Add();
+{$else}
+        for j:=0 to N-1 do
+          c[j]:=a[j]+b[j];
+{$endif}
+        times[2,k]:=mysecond-times[2,k];
+        times[3,k]:=mysecond;
+{$ifdef TUNED}
+        tuned_STREAM_Triad(scalar);
+{$else}
+        for j:=0 to N-1 do
+          a[j]:=b[j]+scalar*c[j];
+{$endif}
+        times[3,k]:=mysecond-times[3,k];
+      end;
+
+    {	--- SUMMARY --- }
+    for k:=1 to NTIMES-1 do { note -- skip first iteration }
+      for j:=0 to 3 do
+        begin
+          avgtime[j]:=avgtime[j] + times[j,k];
+          mintime[j]:=MIN(mintime[j], times[j,k]);
+          maxtime[j]:=MAX(maxtime[j], times[j,k]);
+        end;
+    
+    writeln('Function      Rate (MB/s)   Avg time     Min time     Max time');
+    for j:=0 to 3 do
+      begin
+        avgtime[j]:=avgtime[j]/(NTIMES-1);
+        writeln(labels[j]:11,
+                1E-6*bytes[j]/mintime[j]:11:4,
+                avgtime[j]:11:4,
+                mintime[j]:11:4,
+                maxtime[j]:11:4);
+      end;
+    writeln(HLINE);
+
+    { --- Check Results --- }
+    checkSTREAMresults;
+    writeln(HLINE);
+end.

tests/test/tprec8.pp

@@ -19,7 +19,7 @@ var
   r: tr;
 begin
   r.a := 2;
-  r.i := 12345678901234567890;
+  r.i := 1234567890123456789;
   r.c := true;
   r.d := 5;
   r.e := ed;
@@ -33,7 +33,7 @@ begin
   b := 0;
   t(r);
   if (r.a <> 2) or
-     (r.i <> 12345678901234567890) or
+     (r.i <> 1234567890123456789) or
      (not r.c) or
      (r.d <> 5) or
      (r.e <> ed) then