From 92e1ff661f6ca2e6394989456e814e60efa97624 Mon Sep 17 00:00:00 2001 From: Ryszard Glab Date: Sat, 4 Nov 2000 12:39:40 +0000 Subject: [PATCH] ChangeLog 2000-11-04 13:35 UTC+0100 --- harbour/ChangeLog | 53 ++++++++++++++++ harbour/hb_slex.bc | 8 +++ harbour/include/hbapi.h | 3 +- harbour/include/hbapiitm.h | 2 + harbour/include/hbexpra.c | 97 ++++++++++++++++++++++++++++++ harbour/include/hbrddcdx.h | 59 +++++++++++------- harbour/makefile.bc | 7 +++ harbour/makefile.vc | 1 + harbour/source/compiler/expropta.c | 2 +- harbour/source/compiler/harbour.l | 12 ---- harbour/source/compiler/harbour.y | 79 ++---------------------- harbour/source/macro/macroa.c | 2 +- harbour/source/pp/pptable.c | 2 +- harbour/source/rtl/Makefile | 1 + harbour/source/rtl/tget.prg | 36 ----------- harbour/source/rtl/tgetint.prg | 81 +++++++++++++++++++++++++ harbour/source/vm/codebloc.c | 78 +++++++++++++++--------- harbour/source/vm/itemapi.c | 72 ++++++++++++++++------ harbour/source/vm/memvars.c | 45 +++++++++++--- 19 files changed, 438 insertions(+), 202 deletions(-) create mode 100644 harbour/source/rtl/tgetint.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 02a203c1d4..a771c8970a 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,56 @@ +2000-11-04 13:35 UTC+0100 Ryszard Glab + + +source/rtl/tgetint.prg + *source/rtl/tget.prg + *hb_slex.bc + *makefile.bc + *makefile.vc + *source/rtl/Makefile + + tgetint.prg a new file with GetNew(), __GET() and __GETA() + functions moved here from tget.prg + * __GET() and __GETA() both create a set/get codeblock on the + fly with no macro compilation and with no memvar variables + * the first argument of __GET() have to be passed by a reference + if simple variable is used and set/get codeblock is not + specified + + *include/hbapi.h + *include/hbapiitm.h + * added hb_itemIncRef/hb_itemDecRef declarations + * added hb_codeblockIncRef/hb_codeblockDecRef + + *include/hbrddcdx.h + * added a few more comments + * added a forward declaration of _CDXTAG structure + + *source/vm/codebloc.c + *source/vm/itemapi.c + *source/vm/memvars.c + * fixed reference counting for detached local variables + (This should cure many random core dumps/GPFs) + + *source/compiler/harbour.l + *source/compiler/harbour.y + *removed the latest Ron's changes + + *source/compiler/expropta.c + *source/macro/macroa.c + *include/hbexpra.c + * added support for internal _GET_ -> __GET/__GETA translation + NOTE: The variable name passed to __GETA can be buggy in some + cases, for example: + @ 0,0 GET var(other[ i ]):name[ i, 1 ] + will pass "var(other" as a variable name (Clipper and Harbour + bug) - the correct behaviour will require some more work - + there is no simple workaround for this currently + + *source/pp/pptable.c + * removed a hard-coded set/get codeblock from _GET_() arguments + list - it is created in __GET/__GETA now + NOTE: This is how Clipper works (no variable names conflicts) + This will break current Simplex implementation !!! + + 2000-11-03 16:05 UTC+0800 Ron Pinkas * source/pp/pptable.c * Changed {|u| to {|_1| and := u to := _1 in bSetGet of _GET_(...) to avoid unexpected result with @ X,Y GET u diff --git a/harbour/hb_slex.bc b/harbour/hb_slex.bc index 306670bd4d..7014aa44af 100644 --- a/harbour/hb_slex.bc +++ b/harbour/hb_slex.bc @@ -313,6 +313,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\terror.obj \ $(OBJ_DIR)\text.obj \ $(OBJ_DIR)\tget.obj \ + $(OBJ_DIR)\tgetint.obj \ $(OBJ_DIR)\tgetlist.obj \ $(OBJ_DIR)\tlabel.obj \ $(OBJ_DIR)\tmenuitm.obj \ @@ -1621,6 +1622,13 @@ $(OBJ_DIR)\tget.obj : $(OBJ_DIR)\tget.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\tgetint.c : $(RTL_DIR)\tgetint.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\tgetint.obj : $(OBJ_DIR)\tgetint.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\tgetlist.c : $(RTL_DIR)\tgetlist.prg $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 0290967936..da75e17288 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -433,7 +433,8 @@ extern void hb_codeblockDelete( HB_ITEM_PTR pItem ); /* delete a codeblock * extern PHB_ITEM hb_codeblockGetVar( PHB_ITEM pItem, LONG iItemPos ); /* get local variable referenced in a codeblock */ extern PHB_ITEM hb_codeblockGetRef( PHB_ITEM pItem, PHB_ITEM pRefer ); /* get local variable passed by reference */ extern void hb_codeblockEvaluate( HB_ITEM_PTR pItem ); /* evaluate a codeblock */ -extern void hb_codeblockCopy( PHB_ITEM pDest, PHB_ITEM pSource ); /* copy a codeblock */ +extern void hb_codeblockIncRef( PHB_ITEM pItem ); +extern void hb_codeblockDecRef( PHB_ITEM pItem ); /* memvars subsystem */ extern HB_HANDLE hb_memvarValueNew( HB_ITEM_PTR pSource, BOOL bTrueMemvar ); /* create a new global value */ diff --git a/harbour/include/hbapiitm.h b/harbour/include/hbapiitm.h index c7025599ca..d9490b3969 100644 --- a/harbour/include/hbapiitm.h +++ b/harbour/include/hbapiitm.h @@ -107,6 +107,8 @@ extern PHB_ITEM hb_itemReturnPtr( void ); extern int hb_itemStrCmp ( PHB_ITEM pFirst, PHB_ITEM pSecond, BOOL bForceExact ); /* our string compare */ extern void hb_itemCopy ( PHB_ITEM pDest, PHB_ITEM pSource ); /* copies an item to one place to another respecting its containts */ extern void hb_itemClear ( PHB_ITEM pItem ); +extern PHB_ITEM hb_itemIncRef ( PHB_ITEM pItem ); /* increments internal reference counter */ +extern PHB_ITEM hb_itemDecRef ( PHB_ITEM pItem ); /* decrements internal reference counter */ extern PHB_ITEM hb_itemUnRef ( PHB_ITEM pItem ); /* de-references passed variable */ extern char * hb_itemStr ( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pDec ); /* convert a number to a string */ extern char * hb_itemString ( PHB_ITEM pItem, ULONG * ulLen, BOOL * bFreeReq ); /* Convert any scalar to a string */ diff --git a/harbour/include/hbexpra.c b/harbour/include/hbexpra.c index a766a6c329..af80853b59 100644 --- a/harbour/include/hbexpra.c +++ b/harbour/include/hbexpra.c @@ -307,6 +307,103 @@ HB_EXPR_PTR hb_compExprNewFunCall( HB_EXPR_PTR pName, HB_EXPR_PTR pParms ) HB_EXPR_PCODE1( hb_compExprDelete, pName ); } } + else if( ( strcmp( "_GET_", pName->value.asSymbol ) == 0 ) && iCount ) + { + /* Reserved Clipper function used to handle GET variables + */ + HB_EXPR_PTR pArg = pParms->value.asList.pExprList; + USHORT uiCount; + if( pArg->ExprType == HB_ET_ARRAYAT ) + { + HB_EXPR_PTR pIndex, pVar; + +#ifdef HB_MACRO_SUPPORT + HB_XFREE( pName->value.asSymbol ); + pName->value.asSymbol = hb_strdup( "__GETA" ); +#else + pName->value.asSymbol = hb_compIdentifierNew( "__GETA", TRUE ); +#endif + /* NOTE: a[ i, j ] is stored as: (pExprList)->(pIndex) + * ((a->[ i ])->[ j ]) + */ + pVar = HB_EXPR_USE( pArg->value.asList.pExprList, HB_EA_REDUCE ); + pIndex = HB_EXPR_USE( pArg->value.asList.pIndex, HB_EA_REDUCE ); + pIndex->pNext = NULL; + while( pVar->ExprType == HB_ET_ARRAYAT ) + { + /* traverse back to a leftmost expression and build a list + * of index expressions + */ + pVar->value.asList.pIndex->pNext = pIndex; + pIndex = pVar->value.asList.pIndex; + pVar = pVar->value.asList.pExprList; + } + + /* pVar will be the first argument now + */ + pParms->value.asList.pExprList = pVar; + /* link the rest of parameters + */ + pVar->pNext = pArg->pNext; + /* Delete an argument that was the first one + */ + pArg->value.asList.pIndex = NULL; + pArg->value.asList.pExprList = NULL; + hb_compExprClear( pArg ); + /* Create an array with index elements + */ + pIndex = hb_compExprNewArray( hb_compExprNewList( pIndex ) ); + /* The array with index elements have to be the sixth argument + * of __GETA() call + */ + uiCount = 1; + while( ++uiCount < 6 ) + { + if( pVar->pNext == NULL ) + pVar->pNext = hb_compExprNewNil(); + pVar = pVar->pNext; + } + if( pVar->pNext ) /* Delete 6-th argument if present */ + { + pIndex->pNext = pVar->pNext->pNext; + HB_EXPR_PCODE1( hb_compExprDelete, pVar->pNext ); + } + pVar->pNext = pIndex; /* Set a new 6-th argument */ + + /* Remove the index expression from a string representation + */ + pVar = pParms->value.asList.pExprList->pNext; + if( pVar->ExprType == HB_ET_STRING ) + { + USHORT i = 0; + char *szVar = pVar->value.asString.string; + + /* NOTE: Clipper strips a string at the first '[' character too + */ + while( ++i < pVar->ulLength ) + if( szVar[ i ] == '[' ) + { + szVar[ i ] = 0; + pVar->ulLength = i; + break; + } + } + } + else +#ifdef HB_MACRO_SUPPORT + HB_XFREE( pName->value.asSymbol ); + pName->value.asSymbol = hb_strdup( "__GET" ); +#else + pName->value.asSymbol = hb_compIdentifierNew( "__GET", TRUE ); + if( pArg->ExprType == HB_ET_VARIABLE ) + { + /* Change into a variable reference so a set/get codeblock + * will assign a new value correctly + */ + pArg->ExprType = HB_ET_VARREF; + } +#endif + } } else if( pName->ExprType == HB_ET_MACRO ) { diff --git a/harbour/include/hbrddcdx.h b/harbour/include/hbrddcdx.h index 6f163d1e78..94d15726d2 100644 --- a/harbour/include/hbrddcdx.h +++ b/harbour/include/hbrddcdx.h @@ -129,6 +129,7 @@ typedef MEMOROOT * LPMEMOROOT; /* CDX's */ +struct _CDXINDEX; /* forward declaration */ typedef struct _CDXTAG { char * szName; /* Name of tag */ @@ -194,38 +195,50 @@ typedef struct _CDXHEADER typedef CDXHEADER * LPCDXHEADER; ----- */ + +#define CDX_TYPE_UNIQUE 1 /* unique index */ +#define CDX_TYPE_FORFILTER 0x08 /* for expression present */ +#define CDX_TYPE_BITVECTOR 0x10 /* SoftC? */ +#define CDX_TYPE_COMPACT 0x20 /* FoxPro */ +#define CDX_TYPE_COMPOUND 0x40 /* FoxPro */ +#define CDX_TYPE_STRUCTURE 0x80 /* FoxPro */ + typedef struct _CDXTAGHEADER { - LONG lRoot; - LONG lFreeList; - LONG lChgFlag; //lLength; - USHORT uiKeySize; - BYTE bType; - BYTE bSignature; + LONG lRoot; /* offset of the root node */ + LONG lFreeList; /* offset of list of free pages or -1 */ + LONG lChgFlag; //lLength; /* Version number ? */ + USHORT uiKeySize; /* key length */ + BYTE bType; /* index options see CDX_TYPE_* */ + BYTE bSignature; /* index signature */ BYTE bReserved1[ 486 ]; - USHORT iDescending; - USHORT iFilterPos; - USHORT iFilterLen; - USHORT iExprPos; - USHORT iExprLen; + USHORT iDescending; /* 0 = ascending 1 = descending */ + USHORT iFilterPos; /* offset of filter expression */ + USHORT iFilterLen; /* length of filter expression */ + USHORT iExprPos; /* offset of key expression */ + USHORT iExprLen; /* length of key expression */ BYTE KeyPool[ CDX_PAGELEN ]; } CDXTAGHEADER; typedef CDXTAGHEADER * LPCDXTAGHEADER; +#define CDX_NODE_BRANCH 0 +#define CDX_NODE_ROOT 1 +#define CDX_NODE_LEAF 2 + typedef struct _CDXLEAFHEADER { - USHORT uiNodeType; - USHORT uiKeyCount; - LONG lLeftNode; - LONG lRightNode; - USHORT uiFreeSpace; - ULONG ulRecNumMask; - BYTE bDupByteMask; - BYTE bTrailByteMask; - BYTE bRecNumLen; - BYTE bDupCntLen; - BYTE bTrailCntLen; - BYTE bInfo; + USHORT uiNodeType; /* node type see CDX_NODE_* */ + USHORT uiKeyCount; /* number of keys */ + LONG lLeftNode; /* offset of left node or -1 */ + LONG lRightNode; /* offset of right node or -1 */ + USHORT uiFreeSpace; /* free space available in a page */ + ULONG ulRecNumMask; /* record number mask */ + BYTE bDupByteMask; /* duplicate bytes count mask */ + BYTE bTrailByteMask; /* trailing bytes count mask */ + BYTE bRecNumLen; /* number of bits for record number */ + BYTE bDupCntLen; /* number of bits for duplicate count */ + BYTE bTrailCntLen; /* number of bits for trailing count */ + BYTE bInfo; /* total number of bytes for recnn/dup/trail info */ BYTE bData[ CDX_LEAFFREESPACE ]; } CDXLEAFHEADER; typedef CDXLEAFHEADER * LPCDXLEAFHEADER; diff --git a/harbour/makefile.bc b/harbour/makefile.bc index fc6239abf8..7d0ab802f3 100644 --- a/harbour/makefile.bc +++ b/harbour/makefile.bc @@ -1618,6 +1618,13 @@ $(OBJ_DIR)\tget.obj : $(OBJ_DIR)\tget.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\tgetint.c : $(RTL_DIR)\tgetint.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\tgetint.obj : $(OBJ_DIR)\tgetint.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\tgetlist.c : $(RTL_DIR)\tgetlist.prg $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ diff --git a/harbour/makefile.vc b/harbour/makefile.vc index 349b44f97f..674db50bf5 100644 --- a/harbour/makefile.vc +++ b/harbour/makefile.vc @@ -327,6 +327,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\terror.obj \ $(OBJ_DIR)\text.obj \ $(OBJ_DIR)\tget.obj \ + $(OBJ_DIR)\tgetint.obj \ $(OBJ_DIR)\tgetlist.obj \ $(OBJ_DIR)\tlabel.obj \ $(OBJ_DIR)\tmenuitm.obj \ diff --git a/harbour/source/compiler/expropta.c b/harbour/source/compiler/expropta.c index a703fd09d8..84b50250b9 100644 --- a/harbour/source/compiler/expropta.c +++ b/harbour/source/compiler/expropta.c @@ -5,6 +5,6 @@ /* hbexpra.c is also included from ../macro/macro.c * However it produces a slighty different code if used in * macro compiler (there is an additional parameter passed to some functions) - * 1 - ignore this magic number - this is used to force compilation + * 2 - ignore this magic number - this is used to force compilation */ #include "hbexpra.c" diff --git a/harbour/source/compiler/harbour.l b/harbour/source/compiler/harbour.l index 891a40daef..3b0a7d5acf 100644 --- a/harbour/source/compiler/harbour.l +++ b/harbour/source/compiler/harbour.l @@ -456,18 +456,6 @@ Separator {SpaceTab} /* ************************************************************************ */ %} -%{ -/* ************************************************************************ */ -%} -"_get_(" { - yylval.string = hb_compIdentifierNew( "_PROCREQ_", TRUE ); - hb_comp_iState =IDENTIFIER; - return GET; - } -%{ -/* ************************************************************************ */ -%} - "decl"|"decla"|"declar"|"declare" { yylval.string = hb_compIdentifierNew( hb_strupr( yytext ), TRUE ); if( hb_comp_iState == DO ) diff --git a/harbour/source/compiler/harbour.y b/harbour/source/compiler/harbour.y index 7bd2ce31eb..2eaee6b43b 100644 --- a/harbour/source/compiler/harbour.y +++ b/harbour/source/compiler/harbour.y @@ -117,9 +117,6 @@ char * hb_comp_buffer; /* yacc input buffer */ static PTR_LOOPEXIT hb_comp_pLoops = NULL; static HB_RTVAR_PTR hb_comp_rtvars = NULL; -static HB_EXPR_PTR pArrayIndexAsList = NULL, pGetArgList = NULL, pBaseArrayName = NULL; -static BOOL bTrancuateBaseArray = FALSE; - char * hb_comp_szAnnounce = NULL; /* ANNOUNCEd procedure */ static void hb_compDebugStart( void ) { }; @@ -163,7 +160,7 @@ static void hb_compDebugStart( void ) { }; %token MACROVAR MACROTEXT %token AS_ARRAY AS_BLOCK AS_CHARACTER AS_CLASS AS_DATE AS_LOGICAL AS_NUMERIC AS_OBJECT AS_VARIANT DECLARE OPTIONAL DECLARE_CLASS DECLARE_MEMBER %token AS_ARRAY_ARRAY AS_BLOCK_ARRAY AS_CHARACTER_ARRAY AS_CLASS_ARRAY AS_DATE_ARRAY AS_LOGICAL_ARRAY AS_NUMERIC_ARRAY AS_OBJECT_ARRAY -%token PROCREQ GET +%token PROCREQ /*the lowest precedence*/ /*postincrement and postdecrement*/ @@ -232,7 +229,6 @@ static void hb_compDebugStart( void ) { }; %type DimIndex DimList %type FieldAlias FieldVarAlias %type PostOp -%type Get GetA GetArgList %% @@ -457,17 +453,8 @@ NilAlias : NilValue ALIASOP { $$ = $1; } /* Literal string value */ -LiteralValue : LITERAL { $$ = hb_compExprNewString( $1 ); - if( bTrancuateBaseArray ) - { char *pCopy = hb_strdup( $1 ), *pTmp = strchr( pCopy, '[' ); - if( pTmp ) - { - pCopy[ pTmp - pCopy ] = '\0'; - pBaseArrayName = hb_compExprNewString( pCopy ); - } - bTrancuateBaseArray = FALSE; -; } - } +LiteralValue : LITERAL { $$ = hb_compExprNewString( $1 ); } +; LiteralAlias : LiteralValue ALIASOP { $$ = $1; } ; @@ -626,8 +613,6 @@ VariableAtAlias : VariableAt ALIASOP { $$ = $1; } */ FunCall : IdentName '(' ArgList ')' { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( $1 ), $3 ); } | MacroVar '(' ArgList ')' { $$ = hb_compExprNewFunCall( $1, $3 ); } - | Get { $$ = $1 } - | GetA { $$ = $1 } ; ArgList : Argument { $$ = hb_compExprNewArgList( $1 ); } @@ -986,9 +971,9 @@ ArrayIndex : IndexList ']' { $$ = $1; } /* NOTE: $0 represents the expression before ArrayIndex * Don't use ArrayIndex in other context than as an array index! */ -IndexList : '[' Expression { $$ = hb_compExprNewArrayAt( $0, $2 ); pArrayIndexAsList = hb_compExprNewList( $2 ); } - | IndexList ',' Expression { $$ = hb_compExprNewArrayAt( $1, $3 ) ; pArrayIndexAsList = hb_compExprAddListExpr( pArrayIndexAsList, $3 ); } - | IndexList ']' '[' Expression { $$ = hb_compExprNewArrayAt( $1, $4 ) ; pArrayIndexAsList = hb_compExprAddListExpr( pArrayIndexAsList, $4 ); } +IndexList : '[' Expression { $$ = hb_compExprNewArrayAt( $0, $2 ); } + | IndexList ',' Expression { $$ = hb_compExprNewArrayAt( $1, $3 ); } + | IndexList ']' '[' Expression { $$ = hb_compExprNewArrayAt( $1, $4 ); } ; ElemList : Argument { $$ = hb_compExprNewList( $1 ); } @@ -1001,58 +986,6 @@ CodeBlock : '{' '|' { $$ = hb_compExprNewCodeBlock(); } BlockNoVar '|' BlockExpList '}' { $$ = $3; } ; -Get : GET Variable { pGetArgList = hb_compExprNewArgList( $2 ); } ',' GetArgList ')' - { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET"), pGetArgList ); pGetArgList = NULL; } - | GET AliasVar { pGetArgList = hb_compExprNewArgList( $2 ); } ',' GetArgList ')' - { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET"), pGetArgList ); pGetArgList = NULL; } - | GET ObjectData { pGetArgList = hb_compExprNewArgList( $2 ); } ',' GetArgList ')' - { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET"), pGetArgList ); pGetArgList = NULL; } - | GET ObjectData ArrayIndex { pGetArgList = hb_compExprNewArgList( $3 ); } ',' GetArgList ')' - { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET"), pGetArgList ); pGetArgList = NULL; } - | GET MacroVar { pGetArgList = hb_compExprNewArgList( $2 ); } ',' GetArgList ')' - { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET"), pGetArgList ); pGetArgList = NULL; } - | GET MacroExpr { pGetArgList = hb_compExprNewArgList( $2 ); } ',' GetArgList ')' - { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET"), pGetArgList ); pGetArgList = NULL; } - ; - -GetArgList : Argument { $$ = hb_compExprAddListExpr( pGetArgList, $1 ); } - | GetArgList ',' Argument { $$ = hb_compExprAddListExpr( pGetArgList, $3 ); } - ; - -GetA : GET Variable ArrayIndex { pGetArgList = hb_compExprNewArgList( $2 ); bTrancuateBaseArray = TRUE; } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, ( pBaseArrayName ? pBaseArrayName : $6 ) ); pBaseArrayName = NULL; /* Var Name */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, $9 ) ; /* Picture */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, $12 ); /* ValidBlock */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, $15 ); /* WhenBlock */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, hb_compExprNewArray( pArrayIndexAsList ) ); /* Array with Index Expressions as 6th parameter */ } - GetAExt ')' { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA"), pGetArgList ); pGetArgList = NULL; } - | GET AliasVar ArrayIndex { pGetArgList = hb_compExprNewArgList( $2 ); bTrancuateBaseArray = TRUE; } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, ( pBaseArrayName ? pBaseArrayName : $6 ) ); pBaseArrayName = NULL; /* Var Name */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, $9 ) ; /* Picture */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, $12 ); /* ValidBlock */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, $15 ); /* WhenBlock */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, hb_compExprNewArray( pArrayIndexAsList ) ); /* Array with Index Expressions as 6th parameter */ } - GetAExt ')' { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA"), pGetArgList ); pGetArgList = NULL; } - | GET MacroVar ArrayIndex { pGetArgList = hb_compExprNewArgList( $2 ); bTrancuateBaseArray = TRUE; } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, ( pBaseArrayName ? pBaseArrayName : $6 ) ); pBaseArrayName = NULL; /* Var Name */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, $9 ) ; /* Picture */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, $12 ); /* ValidBlock */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, $15 ); /* WhenBlock */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, hb_compExprNewArray( pArrayIndexAsList ) ); /* Array with Index Expressions as 6th parameter */ } - GetAExt ')' { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA"), pGetArgList ); pGetArgList = NULL; } - | GET MacroExpr ArrayIndex { pGetArgList = hb_compExprNewArgList( $2 ); bTrancuateBaseArray = TRUE; } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, ( pBaseArrayName ? pBaseArrayName : $6 ) ); pBaseArrayName = NULL; /* Var Name */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, $9 ) ; /* Picture */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, $12 ); /* ValidBlock */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, $15 ); /* WhenBlock */ } ',' - EmptyExpression { hb_compExprAddListExpr( pGetArgList, hb_compExprNewArray( pArrayIndexAsList ) ); /* Array with Index Expressions as 6th parameter */ } - GetAExt ')' { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA"), pGetArgList ); pGetArgList = NULL; } - ; - -GetAExt : { /* Nothing*/ } - | ',' GetArgList - ; - /* NOTE: This uses $-2 then don't use BlockExpList in other context */ BlockExpList : Expression { $$ = hb_compExprAddListExpr( $-2, $1 ); } diff --git a/harbour/source/macro/macroa.c b/harbour/source/macro/macroa.c index 02376f85f4..0e480c2c40 100644 --- a/harbour/source/macro/macroa.c +++ b/harbour/source/macro/macroa.c @@ -5,7 +5,7 @@ /* hbexpra.c is also included from ../compiler/expropta.c * However it produces a slighty different code if used in * macro compiler (there is an additional parameter passed to some functions) - * 1 - ignore this magic number - this is used to force compilation + * 2 - ignore this magic number - this is used to force compilation */ #define HB_MACRO_SUPPORT diff --git a/harbour/source/pp/pptable.c b/harbour/source/pp/pptable.c index c88aed6ea8..491d901b7d 100644 --- a/harbour/source/pp/pptable.c +++ b/harbour/source/pp/pptable.c @@ -211,7 +211,7 @@ void hb_pp_Table( void ) "if ( Empty(\1A30) ) ; SET FORMAT TO ; else ; __SetFormat( &('{||' + \1A30 + '()}') ) ; end",&sC___96 }; static COMMANDS sC___98 = {0,"SET","FORMAT TO","__SetFormat()",&sC___97 }; static COMMANDS sC___99 = {0,"@","\1A00, \1B00 GET \1C00 [PICTURE \1D00] [VALID \1E00] [WHEN \1F00] [SEND \1G00]", - "SetPos( \1A00, \1B00 ) ; AAdd( GetList, _GET_( \1C00, \1C20, \1D00, \1E40, \1F40,{|_1| If( PCount()==0,\1C00,\1C00:=_1 )} ):display() ) [; ATail(GetList):\1G00]",&sC___98 }; + "SetPos( \1A00, \1B00 ) ; AAdd( GetList, _GET_( \1C00, \1C20, \1D00, \1E40, \1F40, ):display() ) [; ATail(GetList):\1G00]",&sC___98 }; static COMMANDS sC___100 = {0,"@","\1A00, \1B00 SAY \1C00 [\1D10] GET \1E00 [\1F10]", "@ \1A00, \1B00 SAY \1C00 [\1D00] ; @ Row(), Col()+1 GET \1E00 [\1F00]",&sC___99 }; static COMMANDS sC___101 = {0,"@","\1A00, \1B00 GET \1C00 [\1D10] RANGE \1E00, \1F00 [\1G10]", diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index 4f55e061c2..0b9132b80a 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -142,6 +142,7 @@ PRG_SOURCES=\ terror.prg \ text.prg \ tget.prg \ + tgetint.prg \ tgetlist.prg \ tlabel.prg \ tmenuitm.prg \ diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index 530aa204e9..72f89a495a 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -1103,42 +1103,6 @@ METHOD DelWordRight() CLASS Get return Self -//---------------------------------------------------------------------------// - -Function GetNew( nRow, nCol, bVarBlock, cVarName, cPicture, cColor ) - -return Get():New( nRow, nCol, bVarBlock, cVarName, cPicture, cColor ) - -//---------------------------------------------------------------------------// - -FUNCTION __GET( uVar, cVarName, cPicture, bValid, bWhen, bSetGet ) - - LOCAL oGet := Get():New(,, bSetGet, cVarName, cPicture ) - - uVar := uVar // Suppress unused variable warning - - oGet:PreBlock := bWhen - oGet:PostBlock := bValid - -RETURN oGet - -FUNCTION __GETA( aBaseVar, cVarName, cPicture, bValid, bWhen, anIndex ) - - LOCAL bSetGet, oGet, cIndex := '', nLen := Len( anIndex ), Counter - - FOR Counter := 1 TO nLen - cIndex += "[" + LTrim( Str( anIndex[ Counter ] ) ) + "]" - NEXT - - bSetGet := {|x| M->__aArray := aBaseVar, IIF( x == NIL, M->&( "__aArray" + cIndex ), M->&( "__aArray" + cIndex ) := x ) } - - oGet := Get():New( , , bSetGet, cVarName, cPicture ) - - oGet:PreBlock := bWhen - oGet:PostBlock := bValid - oGet:SubScript := anIndex - -RETURN oGet /* Here for compatibility reason with previous version */ /* Not sure it should be keeped here ... (JFL) */ diff --git a/harbour/source/rtl/tgetint.prg b/harbour/source/rtl/tgetint.prg new file mode 100644 index 0000000000..b1676198f9 --- /dev/null +++ b/harbour/source/rtl/tgetint.prg @@ -0,0 +1,81 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Get Class + * + * Copyright 1999 Ignacio Ortiz de ZŁniga + * www - http://www.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 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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 program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbclass.ch" +#include "hbsetup.ch" + + +//---------------------------------------------------------------------------// + +Function GetNew( nRow, nCol, bVarBlock, cVarName, cPicture, cColor ) + +return Get():New( nRow, nCol, bVarBlock, cVarName, cPicture, cColor ) + +//---------------------------------------------------------------------------// + +FUNCTION __GET( uVar, cVarName, cPicture, bValid, bWhen, bSetGet ) + LOCAL oGet + + IF( bSetGet == NIL ) + bSetGet := {|xValue| IIF( PCOUNT()==0, uVar, uVar:=xValue)} + ENDIF + oGet := Get():New(,, bSetGet, cVarName, cPicture ) + + oGet:PreBlock := bWhen + oGet:PostBlock := bValid + + RETURN oGet + + +FUNCTION __GETA( aVar, cVarName, cPicture, bValid, bWhen, aIndex ) + LOCAL oGet + + oGet := Get():New(,, {|xValue| __GetAValue( aVar, aIndex, 1, xValue )}, ; + cVarName, cPicture ) + oGet:SubScript := aIndex + + oGet:PreBlock := bWhen + oGet:PostBlock := bValid + +RETURN oGet + +STATIC FUNCTION __GetAValue( aVar, aIndex, nIndex, xValue ) + + IF( nIndex == LEN(aIndex) ) + RETURN IIF( xValue==NIL, aVar[ aIndex[ nIndex ] ], ; + aVar[ aIndex[ nIndex ] ] := xValue ) + ENDIF + +RETURN __GetAValue( aVar[ aIndex[ nIndex ] ], aIndex, nIndex + 1, xValue ) diff --git a/harbour/source/vm/codebloc.c b/harbour/source/vm/codebloc.c index 7e9f1c7094..e4c76703af 100644 --- a/harbour/source/vm/codebloc.c +++ b/harbour/source/vm/codebloc.c @@ -107,7 +107,6 @@ HB_CODEBLOCK_PTR hb_codeblockNew( BYTE * pBuffer, pLocal->item.asMemvar.offset = 0; pLocal->item.asMemvar.value = hMemvar; - hb_memvarValueIncRef( pLocal->item.asMemvar.value ); memcpy( pCBlock->pLocals + ui, pLocal, sizeof( HB_ITEM ) ); } else @@ -118,9 +117,9 @@ HB_CODEBLOCK_PTR hb_codeblockNew( BYTE * pBuffer, /* Increment the reference counter so this value will not be * released if other codeblock will be deleted */ - hb_memvarValueIncRef( pLocal->item.asMemvar.value ); memcpy( pCBlock->pLocals + ui, pLocal, sizeof( HB_ITEM ) ); } + hb_memvarValueIncRef( pLocal->item.asMemvar.value ); ++ui; } } @@ -208,20 +207,19 @@ void hb_codeblockDelete( HB_ITEM_PTR pItem ) HB_TRACE(HB_TR_DEBUG, ("hb_codeblockDelete(%p)", pItem)); - HB_TRACE(HB_TR_INFO, ("deleting a codeblock (%li) %lx", pCBlock->ulCounter, pCBlock)); + HB_TRACE(HB_TR_INFO, ("deleting a codeblock (%lu) %p", pCBlock->ulCounter, pCBlock)); + + if( pCBlock->pLocals ) + { + USHORT ui = pCBlock->uiLocals; + while( ui ) + hb_memvarValueDecRef( pCBlock->pLocals[ ui-- ].item.asMemvar.value ); + } if( --pCBlock->ulCounter == 0 ) { - /* free space allocated for local variables - */ if( pCBlock->pLocals ) { - USHORT ui = 1; - while( ui <= pCBlock->uiLocals ) - { - hb_memvarValueDecRef( pCBlock->pLocals[ ui ].item.asMemvar.value ); - ++ui; - } /* decrement the table reference counter and release memory if * it was the last reference */ @@ -229,7 +227,7 @@ void hb_codeblockDelete( HB_ITEM_PTR pItem ) hb_xfree( pCBlock->pLocals ); } - /* free space allocated for pcodes - if it was macro-compiled codeblock + /* free space allocated for pcodes - if it was a macro-compiled codeblock */ if( pCBlock->dynBuffer ) hb_xfree( pCBlock->pCode ); @@ -237,8 +235,6 @@ void hb_codeblockDelete( HB_ITEM_PTR pItem ) /* free space allocated for a CODEBLOCK structure */ hb_gcFree( pCBlock ); - - HB_TRACE(HB_TR_INFO, ("codeblock deleted (%li) %lx", pCBlock->ulCounter, pCBlock)); } } @@ -249,7 +245,7 @@ HB_GARBAGE_FUNC( hb_codeblockDeleteGarbage ) HB_CODEBLOCK_PTR pCBlock = ( HB_CODEBLOCK_PTR ) Cargo; HB_TRACE(HB_TR_DEBUG, ("hb_codeblockDeleteGarbage(%p)", Cargo)); - + /* free space allocated for local variables */ if( pCBlock->pLocals ) @@ -283,17 +279,12 @@ HB_GARBAGE_FUNC( hb_codeblockDeleteGarbage ) void hb_codeblockEvaluate( HB_ITEM_PTR pItem ) { int iStatics = hb_stack.iStatics; - ULONG ulPrivateBase = hb_memvarGetPrivatesBase(); - /* NOTE: All PRIVATE variables created during codeblock evaluation have - * a scope of a codeblock where they were created. - */ HB_TRACE(HB_TR_DEBUG, ("hb_codeblockEvaluate(%p)", pItem)); hb_stack.iStatics = pItem->item.asBlock.statics; hb_vmExecute( pItem->item.asBlock.value->pCode, pItem->item.asBlock.value->pSymbols ); hb_stack.iStatics = iStatics; - hb_memvarSetPrivatesBase( ulPrivateBase ); } /* Get local variable referenced in a codeblock @@ -319,16 +310,47 @@ PHB_ITEM hb_codeblockGetRef( PHB_ITEM pItem, PHB_ITEM pRefer ) return pCBlock->pLocals - pRefer->item.asRefer.value; } -/* Copy the codeblock - * TODO: check if such simple pointer coping will allow to evaluate - * codeblocks recursively +/* Increment reference counter for a codeblock and all detached variables */ -void hb_codeblockCopy( PHB_ITEM pDest, PHB_ITEM pSource ) +void hb_codeblockIncRef( PHB_ITEM pItem ) { - HB_TRACE(HB_TR_DEBUG, ("hb_codeblockCopy(%p, %p)", pDest, pSource)); + HB_CODEBLOCK_PTR pCBlock = pItem->item.asBlock.value; - pDest->item.asBlock.value = pSource->item.asBlock.value; - pDest->item.asBlock.value->ulCounter++; + HB_TRACE(HB_TR_DEBUG, ("hb_codeblockIncRef(%p)", pItem)); - HB_TRACE(HB_TR_INFO, ("copied a codeblock (%li) %lx", pSource->item.asBlock.value->ulCounter, pSource->item.asBlock.value)); + ++pCBlock->ulCounter; + if( pCBlock->pLocals ) + { + USHORT ui = pCBlock->uiLocals; + while( ui ) + { + if( pItem == hb_itemUnRef( pCBlock->pLocals + ui ) ) + ++pCBlock->ulCounter; + else + hb_memvarValueIncRef( pCBlock->pLocals[ ui ].item.asMemvar.value ); + --ui; + } + } +} + +/* Decrement reference counter for a codeblock and all detached variables + */ +void hb_codeblockDecRef( PHB_ITEM pItem ) +{ + HB_CODEBLOCK_PTR pCBlock = pItem->item.asBlock.value; + + --pCBlock->ulCounter; + HB_TRACE(HB_TR_DEBUG, ("hb_codeblockDecRef(%p)%lu", pItem, pCBlock->ulCounter)); + if( pCBlock->pLocals ) + { + USHORT ui = pCBlock->uiLocals; + while( ui ) + { + if( pItem == hb_itemUnRef( pCBlock->pLocals + ui ) ) + --pCBlock->ulCounter; + else + hb_memvarValueDecRef( pCBlock->pLocals[ ui ].item.asMemvar.value ); + --ui; + } + } } diff --git a/harbour/source/vm/itemapi.c b/harbour/source/vm/itemapi.c index 9ffa054000..b2e492f4e3 100644 --- a/harbour/source/vm/itemapi.c +++ b/harbour/source/vm/itemapi.c @@ -98,14 +98,14 @@ BOOL hb_evalNew( PEVALINFO pEvalInfo, PHB_ITEM pItem ) /* NOTE: CA-Cl*pper is buggy and will not check if more parameters are added than the maximum (9). [vszakats] */ -/* NOTE: CA-Cl*pper NG suggest that the Items passed as parameters should/may +/* NOTE: CA-Cl*pper NG suggest that the Items passed as parameters should/may be released by the programmer explicitly. But in fact hb_evalRelease() - will automatically release all of them. The sample programs in the - NG are doing it that way. Releasing the parameters explicitly in - Harbour will cause an internal error, while it will be silently - ignored (?) in CA-Cl*pper. This is due to the different internal - handling of the Items, but IIRC it causes leak in CA-Clipper. All in - all, don't release the eval parameter Items explicitly to make both + will automatically release all of them. The sample programs in the + NG are doing it that way. Releasing the parameters explicitly in + Harbour will cause an internal error, while it will be silently + ignored (?) in CA-Cl*pper. This is due to the different internal + handling of the Items, but IIRC it causes leak in CA-Clipper. All in + all, don't release the eval parameter Items explicitly to make both Harbour and CA-Clipper happy. [vszakats] */ BOOL hb_evalPutParam( PEVALINFO pEvalInfo, PHB_ITEM pItem ) @@ -163,8 +163,8 @@ PHB_ITEM hb_evalLaunch( PEVALINFO pEvalInfo ) return pResult; } -/* NOTE: CA-Clipper NG states that hb_evalLaunch() must be called at least - once and only once before calling hb_evalRelease(). Harbour doesn't +/* NOTE: CA-Clipper NG states that hb_evalLaunch() must be called at least + once and only once before calling hb_evalRelease(). Harbour doesn't have these requirements. [vszakats] */ BOOL hb_evalRelease( PEVALINFO pEvalInfo ) @@ -455,7 +455,7 @@ PHB_ITEM hb_itemPutCL( PHB_ITEM pItem, char * szText, ULONG ulLen ) pItem = hb_itemNew( NULL ); /* NOTE: CA-Clipper seems to be buggy here, it will return ulLen bytes of - trash if the szText buffer is NULL, at least with hb_retclen(). + trash if the szText buffer is NULL, at least with hb_retclen(). [vszakats] */ if( szText == NULL ) @@ -492,7 +492,7 @@ PHB_ITEM hb_itemPutCPtr( PHB_ITEM pItem, char * szText, ULONG ulLen ) void hb_itemSetCMemo( PHB_ITEM pItem ) { - if( pItem && HB_IS_STRING( pItem ) ) + if( pItem && HB_IS_STRING( pItem ) ) pItem->type |= HB_IT_MEMOFLAG; } @@ -571,7 +571,7 @@ BOOL hb_itemFreeC( char * szText ) /* NOTE: Clipper is buggy and will not append a trailing zero, although the NG says that it will. Check your buffers, since what may have worked with Clipper could overrun the buffer with Harbour. - The correct buffer size is 9 bytes: char szDate[ 9 ] + The correct buffer size is 9 bytes: char szDate[ 9 ] [vszakats] */ char * hb_itemGetDS( PHB_ITEM pItem, char * szDate ) @@ -1057,11 +1057,6 @@ void hb_itemCopy( PHB_ITEM pDest, PHB_ITEM pSource ) { HB_TRACE(HB_TR_DEBUG, ("hb_itemCopy(%p, %p)", pDest, pSource)); -/* Disabled temporary - It is causes GPF when inline method is called - rglab - if( HB_IS_BYREF( pDest ) ) - pDest = hb_itemUnRef( pDest ); -*/ if( pDest->type ) hb_itemClear( pDest ); @@ -1078,15 +1073,54 @@ void hb_itemCopy( PHB_ITEM pDest, PHB_ITEM pSource ) } else if( HB_IS_ARRAY( pSource ) ) + { ( pSource->item.asArray.value )->uiHolders++; - + } else if( HB_IS_BLOCK( pSource ) ) - hb_codeblockCopy( pDest, pSource ); + hb_codeblockIncRef( pSource ); else if( HB_IS_MEMVAR( pSource ) ) hb_memvarValueIncRef( pSource->item.asMemvar.value ); } +/* Internal API, not standard Clipper */ +HB_ITEM_PTR hb_itemIncRef( HB_ITEM_PTR pItem ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_itemIncRef(%p)", pItem)); + + if( HB_IS_ARRAY( pItem ) ) + { + ( pItem->item.asArray.value )->uiHolders++; + } + else if( HB_IS_BLOCK( pItem ) ) + hb_codeblockIncRef( pItem ); + else if( HB_IS_MEMVAR( pItem ) ) + hb_memvarValueIncRef( pItem->item.asMemvar.value ); + else if( HB_IS_BYREF( pItem ) ) + pItem = hb_itemIncRef( hb_itemUnRef( pItem ) ); + + return pItem; +} + +/* Internal API, not standard Clipper */ +HB_ITEM_PTR hb_itemDecRef( HB_ITEM_PTR pItem ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_itemDecRef(%p)", pItem)); + + if( HB_IS_ARRAY( pItem ) ) + { + ( pItem->item.asArray.value )->uiHolders--; + } + else if( HB_IS_BLOCK( pItem ) ) + hb_codeblockDecRef( pItem ); + else if( HB_IS_MEMVAR( pItem ) ) + hb_memvarValueDecRef( pItem->item.asMemvar.value ); + else if( HB_IS_BYREF( pItem ) ) + pItem = hb_itemIncRef( hb_itemUnRef( pItem ) ); + + return pItem; +} + void hb_itemSwap( PHB_ITEM pItem1, PHB_ITEM pItem2 ) { HB_ITEM temp; diff --git a/harbour/source/vm/memvars.c b/harbour/source/vm/memvars.c index dd2b0ede1c..49f794ef95 100644 --- a/harbour/source/vm/memvars.c +++ b/harbour/source/vm/memvars.c @@ -96,7 +96,7 @@ void hb_memvarsInit( void ) s_privateStackCnt = s_privateStackBase = 0; } -/* clear all variables except the detached ones +/* clear all variables except the detached ones * Should be called at application exit only */ void hb_memvarsRelease( void ) @@ -112,7 +112,6 @@ void hb_memvarsRelease( void ) if( s_globalTable[ ulCnt ].counter && s_globalTable[ ulCnt ].hPrevMemvar != ( HB_HANDLE )-1 ) { hb_itemClear( &s_globalTable[ ulCnt ].item ); - s_globalTable[ ulCnt ].counter = 0; } --ulCnt; } @@ -204,15 +203,17 @@ HB_HANDLE hb_memvarValueNew( HB_ITEM_PTR pSource, BOOL bTrueMemvar ) pValue = s_globalTable + hValue; pValue->counter = 1; + pValue->item.type = HB_IT_NIL; if( pSource ) { if( bTrueMemvar ) hb_itemCopy( &pValue->item, pSource ); else - memcpy( &pValue->item, pSource, sizeof( HB_ITEM ) ); + { + memcpy( &pValue->item, pSource, sizeof(HB_ITEM) ); + hb_itemIncRef( pSource ); + } } - else - pValue->item.type = HB_IT_NIL; if( bTrueMemvar ) pValue->hPrevMemvar = 0; @@ -288,9 +289,24 @@ void hb_memvarSetPrivatesBase( ULONG ulBase ) */ void hb_memvarValueIncRef( HB_HANDLE hValue ) { - HB_TRACE(HB_TR_DEBUG, ("hb_memvarValueIncRef(%p)", hValue)); + HB_TRACE(HB_TR_DEBUG, ("hb_memvarValueIncRef(%lu)", hValue)); s_globalTable[ hValue ].counter++; + /* Increment reference counter for value stored in the detached item + * The value can be shared with other non-detached variables that also + * handles the reference counter + */ + if( HB_IS_MEMVAR( &s_globalTable[ hValue ].item ) ) + { + HB_ITEM_PTR pItem = &s_globalTable[ hValue ].item; + /* do not fall into recursive calls loop */ + if( pItem->item.asMemvar.value == hValue ) + s_globalTable[ hValue ].counter++; + else + hb_itemIncRef( pItem ); + } + else + hb_itemIncRef( &s_globalTable[ hValue ].item ); HB_TRACE(HB_TR_INFO, ("Memvar item (%i) increment refCounter=%li", hValue, s_globalTable[ hValue ].counter)); } @@ -304,7 +320,7 @@ void hb_memvarValueDecRef( HB_HANDLE hValue ) { HB_VALUE_PTR pValue; - HB_TRACE(HB_TR_DEBUG, ("hb_memvarValueDecRef(%p)", hValue)); + HB_TRACE(HB_TR_DEBUG, ("hb_memvarValueDecRef(%lu)", hValue)); pValue = s_globalTable + hValue; @@ -343,6 +359,19 @@ void hb_memvarValueDecRef( HB_HANDLE hValue ) HB_TRACE(HB_TR_INFO, ("Memvar item (%i) deleted", hValue)); } + else + { + if( HB_IS_MEMVAR( &pValue->item ) ) + { + /* do not fall into recursive calls loop */ + if( pValue->item.item.asMemvar.value == hValue ) + --pValue->counter; + else + hb_itemDecRef( &pValue->item ); + } + else + hb_itemDecRef( &pValue->item ); + } } } @@ -462,6 +491,7 @@ void hb_memvarGetRefer( HB_ITEM_PTR pItem, PHB_SYMB pMemvarSymb ) pItem->item.asMemvar.value = pDyn->hMemvar; pItem->item.asMemvar.itemsbase = &s_globalTable; ++s_globalTable[ pDyn->hMemvar ].counter; + hb_itemIncRef( &s_globalTable[ pDyn->hMemvar ].item ); } else { @@ -487,6 +517,7 @@ void hb_memvarGetRefer( HB_ITEM_PTR pItem, PHB_SYMB pMemvarSymb ) pItem->item.asMemvar.value = pDyn->hMemvar; pItem->item.asMemvar.itemsbase = &s_globalTable; ++s_globalTable[ pDyn->hMemvar ].counter; + hb_itemIncRef( &s_globalTable[ pDyn->hMemvar ].item ); uiAction = E_DEFAULT; } }