From 5cc03ac9b9d5d4fde407d85fdc8656758b369379 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Mon, 24 Sep 2012 17:13:22 +0000 Subject: [PATCH] 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 --- harbour/ChangeLog | 35 ++++++++++ harbour/src/rtl/Makefile | 1 - harbour/src/rtl/fieldbl.prg | 74 --------------------- harbour/src/rtl/hbgtcore.c | 6 +- harbour/src/vm/macro.c | 125 ++++++++++++++++++++++++++++++++++++ 5 files changed, 163 insertions(+), 78 deletions(-) delete mode 100644 harbour/src/rtl/fieldbl.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 32391b4696..313bd0cb15 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -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. diff --git a/harbour/src/rtl/Makefile b/harbour/src/rtl/Makefile index 234a6fa851..fb7ac79004 100644 --- a/harbour/src/rtl/Makefile +++ b/harbour/src/rtl/Makefile @@ -229,7 +229,6 @@ PRG_SOURCES := \ einstvar.prg \ einstvau.prg \ errsys.prg \ - fieldbl.prg \ getlist.prg \ getsys.prg \ getsys53.prg \ diff --git a/harbour/src/rtl/fieldbl.prg b/harbour/src/rtl/fieldbl.prg deleted file mode 100644 index eab95adfa3..0000000000 --- a/harbour/src/rtl/fieldbl.prg +++ /dev/null @@ -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 diff --git a/harbour/src/rtl/hbgtcore.c b/harbour/src/rtl/hbgtcore.c index 00b1bb0bba..de6ef34412 100644 --- a/harbour/src/rtl/hbgtcore.c +++ b/harbour/src/rtl/hbgtcore.c @@ -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 ); diff --git a/harbour/src/vm/macro.c b/harbour/src/vm/macro.c index 38852764b5..0e8fdf5a1d 100644 --- a/harbour/src/vm/macro.c +++ b/harbour/src/vm/macro.c @@ -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 :=¯o() * and creating memvar variables using PUBLIC/PRIVATE command * PUBLIC ¯o