From 20a5e7c24b53db4b75e3d630c8985a7e5524106d Mon Sep 17 00:00:00 2001
From: Przemyslaw Czerpak <druzus@priv.onet.pl>
Date: Tue, 11 Aug 2009 22:16:01 +0000
Subject: [PATCH] 2009-08-12 00:15 UTC+0200 Przemyslaw Czerpak
 (druzus/at/priv.onet.pl)   * harbour/contrib/xhb/xcstr.prg     % fixed fatal
 for performance code used to serialize hash arrays       in ValToPrg()
 functions. I know that xHarbour does not have native       support for hash
 array iteration in FOR EACH statements so it's       necessary to make some
 hacks but even there serialization can be       quite easy done by simple
 FOR/NEXT loop and function calls to       access given keys and values.      
 Please remember that sending :keys or :values messages to hash       arrays
 is very expensive in both languages because each time       new array is
 created with copy of all key or values items.       In the old code :values
 message was send inside a loop so to serialize       hash array with 1000
 items it was created 1000 arrays with 1000       items inside each of them.
 It means 1000000 unnecessary item copy       calls. Modern computers are very
 fast but such code can kill the       performance on any hardware. It's also
 classic example when forcing       FOR EACH usage in all places can give code
 thousands times slower       then code using simple FOR/NEXT.     % few minor
 optimizations

---
 harbour/ChangeLog             | 20 ++++++++++++++++
 harbour/contrib/xhb/xcstr.prg | 44 ++++++++++++++---------------------
 2 files changed, 38 insertions(+), 26 deletions(-)

diff --git a/harbour/ChangeLog b/harbour/ChangeLog
index 879319d703..cabb52465d 100644
--- a/harbour/ChangeLog
+++ b/harbour/ChangeLog
@@ -17,6 +17,26 @@
    past entries belonging to author(s): Viktor Szakats.
 */
 
+2009-08-12 00:15 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
+  * harbour/contrib/xhb/xcstr.prg
+    % fixed fatal for performance code used to serialize hash arrays
+      in ValToPrg() functions. I know that xHarbour does not have native
+      support for hash array iteration in FOR EACH statements so it's
+      necessary to make some hacks but even there serialization can be
+      quite easy done by simple FOR/NEXT loop and function calls to
+      access given keys and values.
+      Please remember that sending :keys or :values messages to hash
+      arrays is very expensive in both languages because each time
+      new array is created with copy of all key or values items.
+      In the old code :values message was send inside a loop so to serialize
+      hash array with 1000 items it was created 1000 arrays with 1000
+      items inside each of them. It means 1000000 unnecessary item copy
+      calls. Modern computers are very fast but such code can kill the
+      performance on any hardware. It's also classic example when forcing
+      FOR EACH usage in all places can give code thousands times slower
+      then code using simple FOR/NEXT.
+    % few minor optimizations
+
 2009-08-12 00:07 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
   - tests/bldtest/bldtest.hbp
   + tests/bldtest/Makefile
diff --git a/harbour/contrib/xhb/xcstr.prg b/harbour/contrib/xhb/xcstr.prg
index f20891cea8..06def005ae 100644
--- a/harbour/contrib/xhb/xcstr.prg
+++ b/harbour/contrib/xhb/xcstr.prg
@@ -136,12 +136,11 @@ RETURN "[" + cString + "]"
 //--------------------------------------------------------------//
 FUNCTION ValToPrg( xVal, cName, nPad, aObjs )
 
-   LOCAL cType := ValType( xVal )
    LOCAL aVar, cRet, cPad, nObj
 
    //TraceLog( xVal, cName, nPad, aObjs )
 
-   SWITCH cType
+   SWITCH ValType( xVal )
       CASE 'C'
          RETURN StringToLiteral( xVal )
 
@@ -152,7 +151,7 @@ FUNCTION ValToPrg( xVal, cName, nPad, aObjs )
          RETURN IIF( xVal, ".T.", ".F." )
 
       CASE 'N'
-         RETURN Str( xVal )
+         RETURN hb_nToS( xVal )
 
       CASE 'A'
          IF cName == NIL
@@ -184,22 +183,23 @@ FUNCTION ValToPrg( xVal, cName, nPad, aObjs )
          RETURN cRet
 
       CASE 'H'
-         IF Len( xVal ) == 0
-            RETURN "hb_Hash()"
+         IF Empty( xVal )
+            cRet := "hb_Hash()"
          ELSE
             cRet := "{ "
-
-            FOR EACH aVar IN xVal:Keys
-               cRet += ValToPrg( aVar ) + " => "
-               cRet += ValToPrg( xVal:Values[ aVar:__EnumIndex() ] ) + ", "
+            FOR EACH aVar IN xVal
+               IF aVar:__enumIndex() != 1
+                  cRet += ", "
+               ENDIF
+               cRet += ValToPrg( aVar:__enumKey() )
+               cRet += " => "
+               cRet += ValToPrg( aVar )
             NEXT
-
-            /* We know for sure xVal isn't empty, and a last ',' is here */
-            cRet = SubStr( cRet, 1, Len( cRet ) - 2 ) + " }"
-
-            RETURN cRet
+            cRet += " }"
          ENDIF
 
+         RETURN cRet
+
 /* There is no support for codeblock serialization */
 #if 0
       CASE 'B'
@@ -286,9 +286,7 @@ RETURN LTrim( CStr( xVal ) )
 //--------------------------------------------------------------//
 FUNCTION ValToDate( xVal )
 
-   LOCAL cType := ValType( xVal )
-
-   SWITCH cType
+   SWITCH ValType( xVal )
       CASE 'A'
       CASE 'H'
       CASE 'L'
@@ -334,9 +332,7 @@ RETURN { ValToCharacter( xVal ) => xVal }
 //--------------------------------------------------------------//
 FUNCTION ValToLogical( xVal )
 
-   LOCAL cType := ValType( xVal )
-
-   SWITCH cType
+   SWITCH ValType( xVal )
       CASE 'A'
       CASE 'D'
       CASE 'H'
@@ -373,9 +369,7 @@ RETURN .F.
 //--------------------------------------------------------------//
 FUNCTION ValToNumber( xVal )
 
-   LOCAL cType := ValType( xVal )
-
-   SWITCH cType
+   SWITCH ValType( xVal )
       CASE 'A'
       CASE 'H'
          RETURN Len( xVal )
@@ -413,9 +407,7 @@ RETURN 0
 //--------------------------------------------------------------//
 FUNCTION ValToObject( xVal )
 
-   LOCAL cType := ValType( xVal )
-
-   SWITCH cType
+   SWITCH ValType( xVal )
       CASE 'A'
          ENABLE TYPE CLASS ARRAY
          EXIT