HMG 3.4.3

HMG Unicode versions 3.1.x related

Moderator: Rathinagiri

huiyi_ch
Posts: 172
Joined: Sat May 21, 2016 5:27 am

Re: HMG 3.4.3

Post by huiyi_ch »

Thanks!
User avatar
srvet_claudio
Posts: 2193
Joined: Thu Feb 25, 2010 8:43 pm
Location: Uruguay
Contact:

Re: HMG 3.4.3

Post by srvet_claudio »

KDJ wrote: Sat Feb 18, 2017 10:20 pm Claudio

Thank you very much for the patch.
srvet_claudio wrote: Sat Feb 18, 2017 2:50 pm Hi all,
please test this patch:

Code: Select all

   ...
   - Fixed leak memory in HMG_UPPER and HMG_LOWER functions (reported by KDJ)
   ...
This has been fixed at one-third, because in HMG_UPPER function are used three buffers allocated on the heap, and only one has been released:
1. "Text" buffer returned by HMG_parc(1) - not released,
2. "Buffer" buffer - this is released,
3. buffer returned by hb_osStrU16Decode(Buffer) in HMG_retc(Buffer) - not released.

My solutions are the following:

Code: Select all

   HB_FUNC (HMG_UPPER1)
   {  
      TCHAR *Text   = (TCHAR*)  HMG_parc(1);

      if (Text == NULL)
      {   HMG_retc (NULL);
          return;
      }

      INT   nLen    = (INT)     lstrlen(Text) + 1;
      TCHAR *Buffer = (TCHAR *) hb_xgrab (nLen * sizeof(TCHAR));

      if (Buffer != NULL)
      {   lstrcpy (Buffer, Text);
          CharUpper (Buffer);

          LPSTR RetStr = hb_osStrU16Decode(Buffer);
          hb_retc (RetStr);
          hb_xfree (RetStr);

          hb_xfree (Buffer);
      }
      else
         HMG_retc (NULL);

      hb_xfree (Text);
   }
or with two buffers only (works faster and involves less memory):

Code: Select all

   HB_FUNC (HMG_UPPER2)
   {  
      TCHAR *Text   = (TCHAR*)  HMG_parc(1);

      if (Text == NULL)
      {   HMG_retc (NULL);
          return;
      }

      CharUpper (Text);

      LPSTR RetStr = hb_osStrU16Decode(Text);
      hb_retc (RetStr);
      hb_xfree (RetStr);

      hb_xfree (Text);
   }
Program to test:

Code: Select all

// Press 'Test: ...' and observe memory usage at status bar

#include 'hmg.ch'


FUNCTION Main()

  SET FONT TO 'MS Shell Dlg', 8

  DEFINE WINDOW MainWnd;
    COL    200;
    ROW    100;
    WIDTH  180;
    HEIGHT 210;
    TITLE  'Memory usage test';
    MAIN;
    MINBUTTON .F.;
    MAXBUTTON .F.;
    NOSIZE

    DEFINE BUTTON Test1_BU
      COL      10
      ROW      20
      WIDTH   150
      HEIGHT   25
      CAPTION 'Test: HMG_Upper'
      ACTION  DoTest(@HMG_Upper())
    END BUTTON

    DEFINE BUTTON Test2_BU
      COL      10
      ROW      50
      WIDTH   150
      HEIGHT   25
      CAPTION 'Test: HMG_Upper1'
      ACTION  DoTest(@HMG_Upper1())
    END BUTTON

    DEFINE BUTTON Test3_BU
      COL      10
      ROW      80
      WIDTH   150
      HEIGHT   25
      CAPTION 'Test: HMG_Upper2'
      ACTION  DoTest(@HMG_Upper2())
    END BUTTON

    DEFINE BUTTON Test4_BU
      COL      10
      ROW     110
      WIDTH   150
      HEIGHT   25
      CAPTION 'Test: Upper'
      ACTION  DoTest(@Upper())
    END BUTTON

    DEFINE STATUSBAR
      STATUSITEM ''
    END STATUSBAR

    DEFINE TIMER MainWnd_TI;
      INTERVAL 1000;
      ACTION   UpdateStatus()

    ON KEY ESCAPE ACTION MainWnd.RELEASE

  END WINDOW

  UpdateStatus()
  MainWnd.ACTIVATE

RETURN NIL


FUNCTION DoTest(sFunc)
  LOCAL cLowerStr := 'abcdefghijklmnop'
  LOCAL cUpperStr
  LOCAL nSeconds
  LOCAL cTime
  LOCAL n

  nSeconds := Seconds()

  FOR n := 1 TO 100000
    cUpperStr := sFunc:exec(cLowerStr)
  NEXT

  cTime := Str((Seconds() - nSeconds) * 1000, 5)

  UpdateStatus()
  MsgBox('Lower: ' + cLowerStr + CRLF + 'Upper: ' + cUpperStr + CRLF + 'Time: ' + cTime + ' ms', sFunc:name + '()')

RETURN NIL


FUNCTION UpdateStatus()

  MainWnd.STATUSBAR.Item(1) := 'Memory usage: ' + LTrim(Str(GetProcessMemoryInfo()[3] / 1024, 10, 0) + ' KB')

RETURN NIL


#pragma BEGINDUMP

  #include "SET_COMPILE_HMG_UNICODE.ch"
  #include "HMG_UNICODE.h"
  #include <windows.h>
  #include "hbapi.h"

   HB_FUNC (HMG_UPPER1)
   {  
      TCHAR *Text   = (TCHAR*)  HMG_parc(1);

      if (Text == NULL)
      {   HMG_retc (NULL);
          return;
      }

      INT   nLen    = (INT)     lstrlen(Text) + 1;
      TCHAR *Buffer = (TCHAR *) hb_xgrab (nLen * sizeof(TCHAR));

      if (Buffer != NULL)
      {   lstrcpy (Buffer, Text);
          CharUpper (Buffer);

          LPSTR RetStr = hb_osStrU16Decode(Buffer);
          hb_retc (RetStr);
          hb_xfree (RetStr);

          hb_xfree (Buffer);
      }
      else
         HMG_retc (NULL);

      hb_xfree (Text);
   }


   HB_FUNC (HMG_UPPER2)
   {  
      TCHAR *Text   = (TCHAR*)  HMG_parc(1);

      if (Text == NULL)
      {   HMG_retc (NULL);
          return;
      }

      CharUpper (Text);

      LPSTR RetStr = hb_osStrU16Decode(Text);
      hb_retc (RetStr);
      hb_xfree (RetStr);

      hb_xfree (Text);
   }

#pragma ENDDUMP
-----
PS:
Unresolved is the question of the HMG_parc, HMG_retc and HMG_storc, HMG_itemPutC macros in other functions and HMG_GetUnicodeCharacter, HMG_UNICODE_TO_ANSI, HMG_ANSI_TO_UNICODE.
I wrote about it here:
viewtopic.php?f=20&t=4884&p=48854#p48854
viewtopic.php?f=20&t=4884&p=49045#p49045
Yes you are right, to fix the buffet reserved by HMG_xx string functions is necessary to implement a native garbage collection in HMG (this is quite simple but requires a great work of modification in the source code), otherwise a not very elegant way is to call the garbage collection of Harbour. I wrote in my todo list.
Best regards.
Dr. Claudio Soto
(from Uruguay)
http://srvet.blogspot.com
User avatar
esgici
Posts: 4543
Joined: Wed Jul 30, 2008 9:17 pm
DBs Used: DBF
Location: iskenderun / Turkiye
Contact:

Re: HMG 3.4.3

Post by esgici »

srvet_claudio wrote: Sat Feb 18, 2017 2:50 pm Hi all,
please test this patch:
...
Thank you very much Doc.

Viva HMG :D
Viva INTERNATIONAL HMG :D
User avatar
srvet_claudio
Posts: 2193
Joined: Thu Feb 25, 2010 8:43 pm
Location: Uruguay
Contact:

Re: HMG 3.4.3

Post by srvet_claudio »

srvet_claudio wrote: Sun Feb 19, 2017 12:51 am
KDJ wrote: Sat Feb 18, 2017 10:20 pm Claudio

Thank you very much for the patch.
srvet_claudio wrote: Sat Feb 18, 2017 2:50 pm Hi all,
please test this patch:

Code: Select all

   ...
   - Fixed leak memory in HMG_UPPER and HMG_LOWER functions (reported by KDJ)
   ...
This has been fixed at one-third, because in HMG_UPPER function are used three buffers allocated on the heap, and only one has been released:
1. "Text" buffer returned by HMG_parc(1) - not released,
2. "Buffer" buffer - this is released,
3. buffer returned by hb_osStrU16Decode(Buffer) in HMG_retc(Buffer) - not released.

My solutions are the following:

Code: Select all

   HB_FUNC (HMG_UPPER1)
   {  
      TCHAR *Text   = (TCHAR*)  HMG_parc(1);

      if (Text == NULL)
      {   HMG_retc (NULL);
          return;
      }

      INT   nLen    = (INT)     lstrlen(Text) + 1;
      TCHAR *Buffer = (TCHAR *) hb_xgrab (nLen * sizeof(TCHAR));

      if (Buffer != NULL)
      {   lstrcpy (Buffer, Text);
          CharUpper (Buffer);

          LPSTR RetStr = hb_osStrU16Decode(Buffer);
          hb_retc (RetStr);
          hb_xfree (RetStr);

          hb_xfree (Buffer);
      }
      else
         HMG_retc (NULL);

      hb_xfree (Text);
   }
or with two buffers only (works faster and involves less memory):

Code: Select all

   HB_FUNC (HMG_UPPER2)
   {  
      TCHAR *Text   = (TCHAR*)  HMG_parc(1);

      if (Text == NULL)
      {   HMG_retc (NULL);
          return;
      }

      CharUpper (Text);

      LPSTR RetStr = hb_osStrU16Decode(Text);
      hb_retc (RetStr);
      hb_xfree (RetStr);

      hb_xfree (Text);
   }
Program to test:

Code: Select all

// Press 'Test: ...' and observe memory usage at status bar

#include 'hmg.ch'


FUNCTION Main()

  SET FONT TO 'MS Shell Dlg', 8

  DEFINE WINDOW MainWnd;
    COL    200;
    ROW    100;
    WIDTH  180;
    HEIGHT 210;
    TITLE  'Memory usage test';
    MAIN;
    MINBUTTON .F.;
    MAXBUTTON .F.;
    NOSIZE

    DEFINE BUTTON Test1_BU
      COL      10
      ROW      20
      WIDTH   150
      HEIGHT   25
      CAPTION 'Test: HMG_Upper'
      ACTION  DoTest(@HMG_Upper())
    END BUTTON

    DEFINE BUTTON Test2_BU
      COL      10
      ROW      50
      WIDTH   150
      HEIGHT   25
      CAPTION 'Test: HMG_Upper1'
      ACTION  DoTest(@HMG_Upper1())
    END BUTTON

    DEFINE BUTTON Test3_BU
      COL      10
      ROW      80
      WIDTH   150
      HEIGHT   25
      CAPTION 'Test: HMG_Upper2'
      ACTION  DoTest(@HMG_Upper2())
    END BUTTON

    DEFINE BUTTON Test4_BU
      COL      10
      ROW     110
      WIDTH   150
      HEIGHT   25
      CAPTION 'Test: Upper'
      ACTION  DoTest(@Upper())
    END BUTTON

    DEFINE STATUSBAR
      STATUSITEM ''
    END STATUSBAR

    DEFINE TIMER MainWnd_TI;
      INTERVAL 1000;
      ACTION   UpdateStatus()

    ON KEY ESCAPE ACTION MainWnd.RELEASE

  END WINDOW

  UpdateStatus()
  MainWnd.ACTIVATE

RETURN NIL


FUNCTION DoTest(sFunc)
  LOCAL cLowerStr := 'abcdefghijklmnop'
  LOCAL cUpperStr
  LOCAL nSeconds
  LOCAL cTime
  LOCAL n

  nSeconds := Seconds()

  FOR n := 1 TO 100000
    cUpperStr := sFunc:exec(cLowerStr)
  NEXT

  cTime := Str((Seconds() - nSeconds) * 1000, 5)

  UpdateStatus()
  MsgBox('Lower: ' + cLowerStr + CRLF + 'Upper: ' + cUpperStr + CRLF + 'Time: ' + cTime + ' ms', sFunc:name + '()')

RETURN NIL


FUNCTION UpdateStatus()

  MainWnd.STATUSBAR.Item(1) := 'Memory usage: ' + LTrim(Str(GetProcessMemoryInfo()[3] / 1024, 10, 0) + ' KB')

RETURN NIL


#pragma BEGINDUMP

  #include "SET_COMPILE_HMG_UNICODE.ch"
  #include "HMG_UNICODE.h"
  #include <windows.h>
  #include "hbapi.h"

   HB_FUNC (HMG_UPPER1)
   {  
      TCHAR *Text   = (TCHAR*)  HMG_parc(1);

      if (Text == NULL)
      {   HMG_retc (NULL);
          return;
      }

      INT   nLen    = (INT)     lstrlen(Text) + 1;
      TCHAR *Buffer = (TCHAR *) hb_xgrab (nLen * sizeof(TCHAR));

      if (Buffer != NULL)
      {   lstrcpy (Buffer, Text);
          CharUpper (Buffer);

          LPSTR RetStr = hb_osStrU16Decode(Buffer);
          hb_retc (RetStr);
          hb_xfree (RetStr);

          hb_xfree (Buffer);
      }
      else
         HMG_retc (NULL);

      hb_xfree (Text);
   }


   HB_FUNC (HMG_UPPER2)
   {  
      TCHAR *Text   = (TCHAR*)  HMG_parc(1);

      if (Text == NULL)
      {   HMG_retc (NULL);
          return;
      }

      CharUpper (Text);

      LPSTR RetStr = hb_osStrU16Decode(Text);
      hb_retc (RetStr);
      hb_xfree (RetStr);

      hb_xfree (Text);
   }

#pragma ENDDUMP
-----
PS:
Unresolved is the question of the HMG_parc, HMG_retc and HMG_storc, HMG_itemPutC macros in other functions and HMG_GetUnicodeCharacter, HMG_UNICODE_TO_ANSI, HMG_ANSI_TO_UNICODE.
I wrote about it here:
viewtopic.php?f=20&t=4884&p=48854#p48854
viewtopic.php?f=20&t=4884&p=49045#p49045
Yes you are right, to fix the buffet reserved by HMG_xx string functions is necessary to implement a native garbage collection in HMG (this is quite simple but requires a great work of modification in the source code), otherwise a not very elegant way is to call the garbage collection of Harbour. I wrote in my todo list.
The return functions is easy to fix, for example:

Change:
#define HMG_retc(c) hb_retc (HMG_WCHAR_TO_CHAR(c))

For:
#define HMG_retc(c) __p = HMG_WCHAR_TO_CHAR(c); hb_retc (__p); if(__p) hb_xfree(__p)

Where
__p is a global char pointer.
char * __p = NULL;

Or:

void HMG_retc( WCHAR * c )
{
char * __p = HMG_WCHAR_TO_CHAR(c);
hb_retc (__p);
if(__p) hb_xfree(__p);
}
Best regards.
Dr. Claudio Soto
(from Uruguay)
http://srvet.blogspot.com
KDJ
Posts: 243
Joined: Mon Sep 05, 2016 3:04 am
Location: Poland

Re: HMG 3.4.3

Post by KDJ »

So remains only to solve the problem of HMG_parc.
User avatar
srvet_claudio
Posts: 2193
Joined: Thu Feb 25, 2010 8:43 pm
Location: Uruguay
Contact:

Re: HMG 3.4.3

Post by srvet_claudio »

KDJ wrote: Sun Feb 19, 2017 3:33 pm So remains only to solve the problem of HMG_parc.
For example:


#define HMG_parc(n,var) __wc = HMG_CHAR_TO_WCHAR (hb_parc(n))
; WCHAR var [ lstrlen(__wc) + 1]; if(__wc) { lstrcpy(var, __wc); hb_xfree(__wc);} else var[0]=0

where __wc is a global WCHAR pointer, and instead of using:

WCHAR * str = HMG_parc(1) ;

use:

HMG_parc(1,str);
Best regards.
Dr. Claudio Soto
(from Uruguay)
http://srvet.blogspot.com
KDJ
Posts: 243
Joined: Mon Sep 05, 2016 3:04 am
Location: Poland

Re: HMG 3.4.3

Post by KDJ »

srvet_claudio wrote: Sun Feb 19, 2017 5:01 pm
#define HMG_parc(n,var) __wc = HMG_CHAR_TO_WCHAR (hb_parc(n))
; WCHAR var [ lstrlen(__wc) + 1]; if(__wc) { lstrcpy(var, __wc); hb_xfree(__wc);} else var[0]=0
It seems to me that here is possible stack overflow:
WCHAR var [ lstrlen(__wc) + 1];
User avatar
srvet_claudio
Posts: 2193
Joined: Thu Feb 25, 2010 8:43 pm
Location: Uruguay
Contact:

Re: HMG 3.4.3

Post by srvet_claudio »

KDJ wrote: Sun Feb 19, 2017 9:56 pm
srvet_claudio wrote: Sun Feb 19, 2017 5:01 pm
#define HMG_parc(n,var) __wc = HMG_CHAR_TO_WCHAR (hb_parc(n))
; WCHAR var [ lstrlen(__wc) + 1]; if(__wc) { lstrcpy(var, __wc); hb_xfree(__wc);} else var[0]=0
It seems to me that here is possible stack overflow:
WCHAR var [ lstrlen(__wc) + 1];
In practice it is rare, I never had problems in HMG with this type of code, in HMG rarely used huge strings. The default stack size is 1 MB.
Best regards.
Dr. Claudio Soto
(from Uruguay)
http://srvet.blogspot.com
KDJ
Posts: 243
Joined: Mon Sep 05, 2016 3:04 am
Location: Poland

Re: HMG 3.4.3

Post by KDJ »

Claudio

For example in EditBox a string may be much larger than 1 MB.
And it is not a rare case.
When using SetWindowText() with such string, will occur runtime error.
User avatar
srvet_claudio
Posts: 2193
Joined: Thu Feb 25, 2010 8:43 pm
Location: Uruguay
Contact:

Re: HMG 3.4.3

Post by srvet_claudio »

KDJ wrote: Mon Feb 20, 2017 9:43 pm Claudio

For example in EditBox a string may be much larger than 1 MB.
And it is not a rare case.
When using SetWindowText() with such string, will occur runtime error.
When you expect a huge string you can explicitly allocate and free the memory, but that is not the case for the vast majority of controls in HMG.
Best regards.
Dr. Claudio Soto
(from Uruguay)
http://srvet.blogspot.com
Post Reply