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