fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2012-09-24 19:13 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)

Browse Source 
* harbour/src/rtl/Makefile
  - harbour/src/rtl/fieldbl.prg
    - removed old PRG level implementation of FIELDBLOCK() and
      FIELDWBLOCK() functions

  * harbour/src/vm/macro.c
    + created new implementation of FIELDBLOCK() and FIELDWBLOCK()
      functions in C. This implementation is strictly Clipper compatible
      and allows to create field blocks only for symbols already
      registered in HVM so it does not create new symbols in HVM.
      When table is open then all field symbols are registered in HVM.
      It means that new functions may not create field block if table
      is not open yet and field name was never used explicitly in
      whole compiled application. It's possible to easy change it
      and automatically register new symbols if we decide it's real
      limitation and we should drop strict Cl*pper compatibility.
      Anyhow it may cause that some code will register big number
      of completely unnecessary symbols in HVM so it should be well
      thought decision.
      This implementation makes exactly the same fied name conversions
      as default implementation of ADDFIELD() workarea method so exactly
      the same set of symbols is accepted. It means that after opening
      table which has field names with spaces or other characters
      which are not accepted as PRG identifiers it's possible to create
      field blocks for them.
      It should be also noticable faster because macrocompiler is not
      used at all and is many times faster in codeblock evaluation then
      implementation like in xHarbour which uses
         fieldget( fieldpos( cFieldName ) )
      to support fields with embeded spaces.

  * harbour/src/rtl/hbgtcore.c
    % small optimization in INKEY() code
This commit is contained in:
Przemyslaw Czerpak
2012-09-24 17:13:22 +00:00
parent b29024a898
commit 5cc03ac9b9
5 changed files with 163 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
harbour/ChangeLog
View File

@@ -16,6 +16,41 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-09-24 19:13 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)
* harbour/src/rtl/Makefile
- harbour/src/rtl/fieldbl.prg
- removed old PRG level implementation of FIELDBLOCK() and
FIELDWBLOCK() functions
* harbour/src/vm/macro.c
+ created new implementation of FIELDBLOCK() and FIELDWBLOCK()
functions in C. This implementation is strictly Clipper compatible
and allows to create field blocks only for symbols already
registered in HVM so it does not create new symbols in HVM.
When table is open then all field symbols are registered in HVM.
It means that new functions may not create field block if table
is not open yet and field name was never used explicitly in
whole compiled application. It's possible to easy change it
and automatically register new symbols if we decide it's real
limitation and we should drop strict Cl*pper compatibility.
Anyhow it may cause that some code will register big number
of completely unnecessary symbols in HVM so it should be well
thought decision.
This implementation makes exactly the same fied name conversions
as default implementation of ADDFIELD() workarea method so exactly
the same set of symbols is accepted. It means that after opening
table which has field names with spaces or other characters
which are not accepted as PRG identifiers it's possible to create
field blocks for them.
It should be also noticable faster because macrocompiler is not
used at all and is many times faster in codeblock evaluation then
implementation like in xHarbour which uses
fieldget( fieldpos( cFieldName ) )
to support fields with embeded spaces.
* harbour/src/rtl/hbgtcore.c
% small optimization in INKEY() code
2012-09-24 11:26 UTC+0200 Viktor Szakats (harbour syenar.net)
* contrib/hbplist
* disabled HBQT, HBXBP and HBIDE components.

1
harbour/src/rtl/Makefile
View File

@@ -229,7 +229,6 @@ PRG_SOURCES := \
einstvar.prg \
einstvau.prg \
errsys.prg \
fieldbl.prg \
getlist.prg \
getsys.prg \
getsys53.prg \

74
harbour/src/rtl/fieldbl.prg
View File

@@ -1,74 +0,0 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* FIELDBLOCK() and FIELDWBLOCK() functions
*
* Copyright 1999-2001 Viktor Szakats (harbour syenar.net)
* www - http://harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
FUNCTION FIELDBLOCK( cFieldName )
LOCAL bField
BEGIN SEQUENCE WITH {|| BREAK() }
bField := &( "{|x| IIF( x == NIL, FIELD->" + cFieldName + ", " + ;
"FIELD->" + cFieldName + " := x ) }" )
END SEQUENCE
RETURN bField
FUNCTION FIELDWBLOCK( cFieldName, nWorkArea )
LOCAL bField, cAlias
BEGIN SEQUENCE WITH {|| BREAK() }
IF Int( nWorkArea ) != 0
cAlias := "(" + HB_NToS( Int( nWorkArea ) ) + ")->"
bField := &( "{|x| IIF( x == NIL, " + cAlias + cFieldName + ", " + ;
+ cAlias + cFieldName + " := x ) }" )
ENDIF
END SEQUENCE
RETURN bField

6
harbour/src/rtl/hbgtcore.c
View File

@@ -2856,7 +2856,7 @@ static int hb_gt_def_InkeyGet( PHB_GT pGT, HB_BOOL fWait, double dSeconds, int i
else
end_timer = 0;
do
for( ;; )
{
hb_gt_def_InkeyPollDo( pGT );
fPop = hb_gt_def_InkeyNextCheck( pGT, iEventMask, &pGT->inkeyLast );
@@ -2875,14 +2875,14 @@ static int hb_gt_def_InkeyGet( PHB_GT pGT, HB_BOOL fWait, double dSeconds, int i
}
/* immediately break if a VM request is pending. */
if( !fWait || hb_vmRequestQuery() != 0 )
if( !fWait || hb_vmRequestQuery() != 0 ||
( end_timer != 0 && end_timer <= hb_dateMilliSeconds() ) )
break;
HB_GTSELF_UNLOCK( pGT );
hb_idleState();
HB_GTSELF_LOCK( pGT );
}
while( end_timer == 0 || end_timer > hb_dateMilliSeconds() );
if( pKey )
hb_itemRelease( pKey );

125
harbour/src/vm/macro.c
View File

@@ -853,6 +853,131 @@ HB_FUNC( HB_MACROBLOCK )
}
}
HB_FUNC( FIELDBLOCK )
{
const char * szName = hb_parc( 1 );
if( szName )
{
char szFieldName[ HB_SYMBOL_NAME_LEN + 1 ];
/* Make the same conversion for field name as in default
* ADDFIELD() workarea method so exactly the same set of
* symbols is accepted. [druzus]
*/
while( HB_ISSPACE( *szName ) )
++szName;
hb_strncpyUpperTrim( szFieldName, szName, sizeof( szFieldName ) - 1 );
if( * szFieldName )
{
/* Cl*pper does not create new symbol in this function
* so only registered symbols are accepted. When table
* is open then all field symbols are registered in HVM.
* It means that this function may not create field block
* if table is not open yet and field name was never used
* explicitly in compiled application. It's possible to
* change hb_dynsymFind() to hb_dynsymGetCase() below
* to automatically register new symbol if we decide it's
* real limitation and we should drop strict Cl*pper
* compatibility. Anyhow it may cause that some code
* will register big number of completely unnecessary
* symbols. [druzus]
*/
PHB_DYNS pFieldSym = hb_dynsymFind( szFieldName );
if( pFieldSym )
{
HB_BYTE byBuf[ 13 + sizeof( PHB_DYNS ) + sizeof( PHB_DYNS ) ];
PHB_ITEM pItem = hb_stackReturnItem();
byBuf[ 0 ] = HB_P_PUSHLOCALNEAR;
byBuf[ 1 ] = 1;
byBuf[ 2 ] = HB_P_PUSHNIL;
byBuf[ 3 ] = HB_P_EXACTLYEQUAL;
byBuf[ 4 ] = HB_P_JUMPFALSENEAR;
byBuf[ 5 ] = ( HB_BYTE ) ( sizeof( PHB_DYNS ) + 4 );
byBuf[ 6 ] = HB_P_MPUSHFIELD;
HB_PUT_PTR( &byBuf[ 7 ], pFieldSym );
byBuf[ 7 + sizeof( PHB_DYNS ) ] = HB_P_ENDBLOCK;
byBuf[ 8 + sizeof( PHB_DYNS ) ] = HB_P_PUSHLOCALNEAR;
byBuf[ 9 + sizeof( PHB_DYNS ) ] = 1;
byBuf[ 10 + sizeof( PHB_DYNS ) ] = HB_P_PUSHUNREF;
byBuf[ 11 + sizeof( PHB_DYNS ) ] = HB_P_MPOPFIELD;
HB_PUT_PTR( &byBuf[ 12 + sizeof( PHB_DYNS ) ], pFieldSym );
byBuf[ 12 + sizeof( PHB_DYNS ) + sizeof( PHB_DYNS ) ] = HB_P_ENDBLOCK;
if( HB_IS_COMPLEX( pItem ) )
hb_itemClear( pItem );
pItem->item.asBlock.value = hb_codeblockMacroNew( byBuf, sizeof( byBuf ) );
pItem->type = HB_IT_BLOCK;
pItem->item.asBlock.paramcnt = 1;
pItem->item.asBlock.lineno = 0;
pItem->item.asBlock.hclass = 0;
pItem->item.asBlock.method = 0;
}
}
}
}
HB_FUNC( FIELDWBLOCK )
{
const char * szName = hb_parc( 1 );
int iWorkArea = hb_parni( 2 );
if( szName && iWorkArea != 0 )
{
char szFieldName[ HB_SYMBOL_NAME_LEN + 1 ];
while( HB_ISSPACE( *szName ) )
++szName;
hb_strncpyUpperTrim( szFieldName, szName, sizeof( szFieldName ) - 1 );
if( * szFieldName )
{
PHB_DYNS pFieldSym = hb_dynsymFind( szFieldName );
if( pFieldSym )
{
HB_BYTE byBuf[ 23 + sizeof( PHB_DYNS ) + sizeof( PHB_DYNS ) ];
PHB_ITEM pItem = hb_stackReturnItem();
byBuf[ 0 ] = HB_P_PUSHLOCALNEAR;
byBuf[ 1 ] = 1;
byBuf[ 2 ] = HB_P_PUSHNIL;
byBuf[ 3 ] = HB_P_EXACTLYEQUAL;
byBuf[ 4 ] = HB_P_JUMPFALSENEAR;
byBuf[ 5 ] = ( HB_BYTE ) ( sizeof( PHB_DYNS ) + 9 );
byBuf[ 6 ] = HB_P_PUSHLONG;
HB_PUT_LE_UINT32( &byBuf[ 7 ], iWorkArea );
byBuf[ 11 ] = HB_P_MPUSHALIASEDFIELD;
HB_PUT_PTR( &byBuf[ 12 ], pFieldSym );
byBuf[ 12 + sizeof( PHB_DYNS ) ] = HB_P_ENDBLOCK;
byBuf[ 13 + sizeof( PHB_DYNS ) ] = HB_P_PUSHLOCALNEAR;
byBuf[ 14 + sizeof( PHB_DYNS ) ] = 1;
byBuf[ 15 + sizeof( PHB_DYNS ) ] = HB_P_PUSHUNREF;
byBuf[ 16 + sizeof( PHB_DYNS ) ] = HB_P_PUSHLONG;
HB_PUT_LE_UINT32( &byBuf[ 17 + sizeof( PHB_DYNS ) ], iWorkArea );
byBuf[ 21 + sizeof( PHB_DYNS ) ] = HB_P_MPOPALIASEDFIELD;
HB_PUT_PTR( &byBuf[ 22 + sizeof( PHB_DYNS ) ], pFieldSym );
byBuf[ 22 + sizeof( PHB_DYNS ) + sizeof( PHB_DYNS ) ] = HB_P_ENDBLOCK;
if( HB_IS_COMPLEX( pItem ) )
hb_itemClear( pItem );
pItem->item.asBlock.value = hb_codeblockMacroNew( byBuf, sizeof( byBuf ) );
pItem->type = HB_IT_BLOCK;
pItem->item.asBlock.paramcnt = 1;
pItem->item.asBlock.lineno = 0;
pItem->item.asBlock.hclass = 0;
pItem->item.asBlock.method = 0;
}
}
}
}
/* This function handles a macro function calls, e.g. var :=&macro()
* and creating memvar variables using PUBLIC/PRIVATE command
* PUBLIC &macro