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

ChangeLog 2000-11-04 13:35 UTC+0100

Browse Source
This commit is contained in:
Ryszard Glab
2000-11-04 12:39:40 +00:00
parent 266d3fdfdf
commit 92e1ff661f
19 changed files with 438 additions and 202 deletions
Download Patch File Download Diff File Expand all files Collapse all files

53
harbour/ChangeLog
View File

@@ -1,3 +1,56 @@
2000-11-04 13:35 UTC+0100 Ryszard Glab <rglab@imid.med.pl>
+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 <ron@profit-master.com>
* 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

8
harbour/hb_slex.bc
View File

@@ -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$@

3
harbour/include/hbapi.h
View File

@@ -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 */

2
harbour/include/hbapiitm.h
View File

@@ -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 */

97
harbour/include/hbexpra.c
View File

@@ -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 )
{

59
harbour/include/hbrddcdx.h
View File

@@ -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;

7
harbour/makefile.bc
View File

@@ -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$@

1
harbour/makefile.vc
View File

@@ -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 \

2
harbour/source/compiler/expropta.c
View File

@@ -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"

12
harbour/source/compiler/harbour.l
View File

@@ -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 )

79
harbour/source/compiler/harbour.y
View File

@@ -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 <asExpr> DimIndex DimList
%type <asExpr> FieldAlias FieldVarAlias
%type <asExpr> PostOp
%type <asExpr> 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( $<asExpr>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( $<asExpr>0, $2 ); }
| IndexList ',' Expression { $$ = hb_compExprNewArrayAt( $1, $3 ); }
| IndexList ']' '[' Expression { $$ = hb_compExprNewArrayAt( $1, $4 ); }
;
ElemList : Argument { $$ = hb_compExprNewList( $1 ); }
@@ -1001,58 +986,6 @@ CodeBlock : '{' '|' { $<asExpr>$ = hb_compExprNewCodeBlock(); } BlockNoVar
'|' BlockExpList '}' { $$ = $<asExpr>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( $<asExpr>-2, $1 ); }

2
harbour/source/macro/macroa.c
View File

@@ -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

2
harbour/source/pp/pptable.c
View File

@@ -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]",

1
harbour/source/rtl/Makefile
View File

@@ -142,6 +142,7 @@ PRG_SOURCES=\
terror.prg \
text.prg \
tget.prg \
tgetint.prg \
tgetlist.prg \
tlabel.prg \
tmenuitm.prg \

36
harbour/source/rtl/tget.prg
View File

@@ -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) */

81
harbour/source/rtl/tgetint.prg Normal file
View File

@@ -0,0 +1,81 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Get Class
*
* Copyright 1999 Ignacio Ortiz de Z£niga <ignacio@fivetech.com>
* 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 )

78
harbour/source/vm/codebloc.c
View File

@@ -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;
}
}
}

72
harbour/source/vm/itemapi.c
View File

@@ -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;

45
harbour/source/vm/memvars.c
View File

@@ -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;
}
}